Script to run before R session

header.R

checkPackage <- function (pkg) {
  # Check if pkg is installed; if not then install it; if an update exists then update
  # Usage:
  # > checkPackage("data.table")
  if (is.character(pkg) == TRUE) {
    repos <- "https://cloud.r-project.org"
    if(pkg %in% rownames(installed.packages()) == FALSE) {
      install.packages(pkg, repos=repos, dependencies=TRUE)
      rowid <- which(installed.packages()[, "Package"] == pkg)
      pkgInfo <- installed.packages()[rowid, ]
      message(sprintf("checkPackage: %s %s was installed in %s",
                      pkg,
                      pkgInfo["Version"],
                      pkgInfo["LibPath"]))
    } else if(pkg %in% rownames(old.packages()) == TRUE) {
      update.packages(pkg, ask=FALSE, repos=repos, dependencies=TRUE)
      rowid <- which(old.packages()[, "Package"] == pkg)
      pkgInfo <- old.packages()[rowid, ]
      message(sprintf("checkPackage: %s was updated to version %s in %s",
                      pkg,
                      pkgInfo["ReposVer"],
                      pkgInfo["LibPath"]))
    } else {
      rowid <- which(installed.packages()[, "Package"] == pkg)
      pkgInfo <- installed.packages()[rowid, ]
      message(sprintf("checkPackage: %s %s is installed in %s",
                      pkg,
                      pkgInfo["Version"],
                      pkgInfo["LibPath"]))
    }
    library(pkg, character.only=TRUE)
  } else {warning("checkPackage: pkg should be character object")}
}

# NEED TO ADD COMMON PACKAGES TO LOAD

showSessionInfo <- function () {
  # Show R session information for reproducibility purposes
  # .timeStart <- Sys.time()  # Defined at start of Rmd
  # Usage:
  # > showSessionInfo()
  # > showSessionInfo()$timeEnd
  list(timeStart = ifelse(exists(".timeStart"), format(.timeStart), NA),
       timeEnd = Sys.time(),
       timeElapsed = ifelse(exists(".timeStart"),
                            format(Sys.time() - .timeStart, format=difftime),
                            NA),
       Sys.info = Sys.info(),
       sessionInfo = sessionInfo())
}

colorPalette <- function () {
  c(rgb(  1,  67, 134, maxColorValue=255),
    rgb(119, 120, 123, maxColorValue=255),
    rgb(139, 184, 234, maxColorValue=255),
    rgb(188, 190, 192, maxColorValue=255),
    rgb( 94, 122, 162, maxColorValue=255),
    rgb(223, 122,  28, maxColorValue=255))
}

diagramFlow <- function (x, switch=NULL) {
  # `x` is a character vector of items to diagram
  # switch is an optional vector (logical or integer)
  #   specifying if the element of `x` is run (TRUE or 1) or not (FALSE or 0)
  # Usage:
  # > diagramFlow(c("Part 1", "Part 2", "...", "Part N"),
  # +             c(TRUE, FALSE, ..., TRUE))
  require(DiagrammeR, quietly=TRUE)
  require(devtools, quietly=TRUE)
  source_gist("https://gist.github.com/benjamin-chan/3d569db12bb223e8b3c4", quiet=TRUE)
  require(extrafont, quietly=TRUE)
  choose_font(c("Lato", "sans"))
  n <- length(x)
  alpha <- rep(255, n)
  if (!is.null(switch)) {alpha[!switch] <- round(1/4 * 255)}
  nodes <- create_nodes(nodes=letters[1:n],
                        label=x,
                        style="filled",
                        fontcolor="white",
                        fontsize="30pt",
                        color=paste0(colorPalette()[1], sprintf("%x", alpha)),
                        shape="oval")
  edges <- create_edges(from=letters[1:n-1],
                        to  =letters[2:n])
  G <- create_graph(nodes_df=nodes, 
                    edges_df=edges,
                    graph_name="Processing sequence",
                    node_attrs="fontname=\"Lato\"", 
                    graph_attrs=c("layout=dot"))
  render_graph(G)
}

makeMetadata <- function(D, note=NULL) {
  # Examples:
  # makeMetadata(cars)
  # x <- 1
  # makeMetadata(x)  # Returns a warning
  if (is.data.frame(D)) {
    list(objectName = deparse(substitute(D)),
         timeStamp = sprintf("%s", Sys.time()),
         objectSize = format(object.size(D), units="auto"),
         note = note,
         rowCount = nrow(D),
         colCount = ncol(D),
         colNames = names(D),
         colClasses = sapply(D, class),
         sysInfo = Sys.info(),
         sessionInfo = sessionInfo())
  } else {
    warning(sprintf("Object %s is not a data.frame", deparse(substitute(D))))
  }
}