R/parse_sessionInfo.R

In federicomarini/sessionDiffo: What the Package Does (One Line, Title Case)

#' Parse a `sessionInfo` object
#'
#' Parse a `sessionInfo` object
#'
#' @details The output of `sessionInfo()` should start with `> sessionInfo()`,
#' so be sure to copy that part as well
#'
#' @param si Character string, with either the path to the plain text file
#' containing the output (if `source` is equal to "filename"), or the content
#' itself (if `source` is "editor")
#' @param source Character string, indicating the format in which the object is
#' provided
#'
#' @return A list with two elements:
#' - a character string, `Rversion`
#' - a data frame (`packages`) with the attached packages and their versions
#' @export
#'
#' @examples
#' si1_output <- system.file("extdata", "si1.txt", package = "sessionDiffo")
#' si1 <- parse_si(si1_output)
parse_si <- function(si, source = "filename") {

  source <- match.arg(source, c("filename", "editor"))
  if (source == "filename") {
    x <- readLines(si)
  } else if (source == "editor") {
  # x <- paste0(si,collapse="\n")
    x <- strsplit(si, split = "\n|\r")[[1]]
  }

  # TODO:
  # if it does not start with sessionInfo(), warn?
  # options: attached via namespace, include or not
  # system/platform to be included?

  sil <- list()

  if (any(grepl("other attached packages", x))) {
    print("yes")
    res <- .parse_si_utils(x)
  } else {
    print("no")
    res <- .parse_si_tv(x)
  }

  pkgs_df <- data.frame(
    package = unlist(lapply(strsplit(res$all_packages,split = "_"), function(arg) arg[[1]])),
    version = unlist(lapply(strsplit(res$all_packages,split = "_"), function(arg) arg[[2]])),
    stringsAsFactors = FALSE
  )

  sil[["Rversion"]] <- res$r_version
  sil[["packages"]] <- pkgs_df

  return(sil)

}

.parse_si_utils <- function(x) {
  idx1 <- which(x == "> sessionInfo()")
  if (length(idx1) == 0) {
    idx1 <- 0
  }
  idx2 <- which(x == "other attached packages:")
  idx3 <- which(x == "loaded via a namespace (and not attached):")
  all_packages <- c()
  if (length(idx1) != 0 & length(idx2) != 0 & length(idx3) != 0) {
    all_packages <-
      unique(c(all_packages,
               # x[idx1 + 1],
               do.call(c, lapply((idx2 + 1):(idx3 - 2), function(i) {
                 grep("\\[", setdiff(setdiff(strsplit(x[i], " ")[[1]], " "), ""),
                      value = TRUE, invert = TRUE)
               }))))
  }
  list(all_packages = all_packages, r_version = x[idx1 + 1])
}

.parse_si_tv <- function(x) {
  print(x)
  idx1 <- grep("Session info", x)
  idx2 <- grep("Packages", x)
  idx3 <- which(x == "")
  idx3 <- min(idx3[idx3 > idx2])
  all_packages <- c()
  if (length(idx1) != 0 & length(idx2) != 0 & length(idx3) != 0) {
    all_packages <-
      unique(c(all_packages,
               # x[idx1 + 1],
               do.call(c, lapply((idx2 + 2):(idx3 - 1), function(i) {
                 a <- setdiff(setdiff(setdiff(strsplit(x[i], " ")[[1]], " "), ""), "*")
                 paste(a[1], a[2], sep = "_")
               }))))
  }
  list(all_packages = all_packages, r_version = gsub(" version  ", "", x[idx1 + 2]))
}

#' Compare two `sessionInfo` objects
#'
#' Compare two `sessionInfo` objects, parsed by [parse_si()]
#'
#' @param si1 A list, corresponding to the first object, generated by [parse_si()]
#' @param si2 A list, corresponding to the second object, generated by [parse_si()]
#'
#' @return A data frame, with the packages, their versions, and the result of the
#' comparison of their versions
#' @export
#'
#' @examples
#' si1_output <- system.file("extdata", "si1.txt", package = "sessionDiffo")
#' si2_output <- system.file("extdata", "si2.txt", package = "sessionDiffo")
#' si1 <- parse_si(si1_output)
#' si2 <- parse_si(si2_output)
#' comparison_df <- compare_si(si1, si2)
compare_si <- function(si1, si2) {
  sil1 <- si1$packages
  sil2 <- si2$packages

  sils <- merge(sil1, sil2, by = "package", all = TRUE, suffixes = c("_si1", "_si2"))

  sils$comparison <- unlist(lapply(seq_len(nrow(sils)), function(pkg) {
    v_1 <- sils$version_si1[pkg]
    v_2 <- sils$version_si2[pkg]

    if (is.na(v_1)) {
      "Only in 2"
    } else if (is.na(v_2)) {
      "Only in 1"
    } else {
      cv <- compareVersion(v_1, v_2)
      car::recode(cv, "-1='older'; 0='equal'; 1='newer'")
    }
  }))
  return(sils)
}