| # File src/library/utils/R/sessionInfo.R | |
| # Part of the R package, https://www.R-project.org | |
| # | |
| # Copyright (C) 1995-2019 The R Core Team | |
| # | |
| # This program is free software; you can redistribute it and/or modify | |
| # it under the terms of the GNU General Public License as published by | |
| # the Free Software Foundation; either version 2 of the License, or | |
| # (at your option) any later version. | |
| # | |
| # This program is distributed in the hope that it will be useful, | |
| # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| # GNU General Public License for more details. | |
| # | |
| # A copy of the GNU General Public License is available at | |
| # https://www.R-project.org/Licenses/ | |
| .RNGdefaults <- RNGkind() # run once at install time and retain for comparison | |
| ## FIXME? alternatively, just define 'osVersion' directly in .onLoad() in zzz.R | |
| .osVersion <- function() { | |
| ## Now try to figure out the OS we are running under | |
| if (.Platform$OS.type == "windows") { | |
| win.version() | |
| } else if (nzchar(Sys.which('uname'))) { ## we could try /usr/bin/uname | |
| uname <- system("uname -a", intern = TRUE) | |
| os <- sub(" .*", "", uname) | |
| switch(os, | |
| "Linux" = | |
| if(file.exists("/etc/os-release")) { | |
| ## http://www.freedesktop.org/software/systemd/man/os-release.html | |
| tmp <- readLines("/etc/os-release") | |
| t2 <- if (any(startsWith(tmp, "PRETTY_NAME="))) | |
| sub("^PRETTY_NAME=", "", | |
| grep("^PRETTY_NAME=", tmp, value = TRUE)[1L]) | |
| else if (any(startsWith(tmp, "NAME"))) | |
| ## could check for VERSION or VERSION_ID | |
| sub("^NAME=", "", | |
| grep("^NAME=", tmp, value = TRUE)[1L]) | |
| else "Linux (unknown distro)" | |
| sub('"(.*)"', "\\1", t2) | |
| } else if(file.exists("/etc/system-release")) { | |
| ## RHEL-like | |
| readLines("/etc/system-release") | |
| }, | |
| "Darwin" = { | |
| ver <- readLines("/System/Library/CoreServices/SystemVersion.plist") | |
| ind <- grep("ProductUserVisibleVersion", ver) | |
| ver <- ver[ind + 1L] | |
| ver <- sub(".*<string>", "", ver) | |
| ver <- sub("</string>$", "", ver) | |
| ver1 <- strsplit(ver, ".", fixed = TRUE)[[1L]][2L] | |
| sprintf("%s %s %s", | |
| ifelse(as.numeric(ver1) < 12, "OS X", "macOS"), | |
| switch(ver1, | |
| ## 10.6 is earliest that can be installed | |
| "6" = "Snow Leopard", | |
| "7" = "Lion", | |
| "8" = "Mountain Lion", | |
| "9" = "Mavericks", | |
| "10" = "Yosemite", | |
| "11" = "El Capitan", | |
| "12" = "Sierra", | |
| "13" = "High Sierra", | |
| "14" = "Mojave", | |
| "15" = "Catalina", | |
| ""), ver) | |
| }, | |
| "SunOS" = { | |
| ver <- system('uname -r', intern = TRUE) | |
| paste("Solaris", | |
| strsplit(ver, ".", fixed = TRUE)[[1L]][2L]) | |
| }, | |
| uname) | |
| } # using system('uname ..') | |
| ## else NULL | |
| } | |
| sessionInfo <- function(package = NULL) | |
| { | |
| z <- list() | |
| z$R.version <- R.Version() | |
| z$platform <- z$R.version$platform | |
| if(nzchar(.Platform$r_arch)) | |
| z$platform <- paste(z$platform, .Platform$r_arch, sep = "/") | |
| z$platform <- paste0(z$platform, " (", 8*.Machine$sizeof.pointer, "-bit)") | |
| z$locale <- Sys.getlocale() | |
| z$running <- osVersion | |
| z$RNGkind <- RNGkind() | |
| if(is.null(package)){ | |
| package <- grep("^package:", search(), value=TRUE) | |
| # weed out environments which are not really packages | |
| keep <- vapply(package, function(x) x == "package:base" | |
| || !is.null(attr(as.environment(x), "path")), NA) | |
| package <- .rmpkg(package[keep]) | |
| } | |
| ## no need to re-encode given what we extract. | |
| pkgDesc <- lapply(package, packageDescription, encoding = NA) | |
| if(length(package) == 0) stop("no valid packages were specified") | |
| basePkgs <- sapply(pkgDesc, | |
| function(x) !is.null(x$Priority) && x$Priority=="base") | |
| ## Hmm, see tools:::.get_standard_package_names()$base | |
| z$basePkgs <- package[basePkgs] | |
| if(any(!basePkgs)){ | |
| z$otherPkgs <- pkgDesc[!basePkgs] | |
| names(z$otherPkgs) <- package[!basePkgs] | |
| } | |
| loadedOnly <- loadedNamespaces() | |
| loadedOnly <- loadedOnly[!(loadedOnly %in% package)] | |
| if (length(loadedOnly)) { | |
| names(loadedOnly) <- loadedOnly | |
| pkgDesc <- c(pkgDesc, lapply(loadedOnly, packageDescription)) | |
| z$loadedOnly <- pkgDesc[loadedOnly] | |
| } | |
| z$matprod <- as.character(options("matprod")) | |
| es <- extSoftVersion() | |
| z$BLAS <- as.character(es["BLAS"]) #drop name | |
| z$LAPACK <- La_library() | |
| class(z) <- "sessionInfo" | |
| z | |
| } | |
| print.sessionInfo <- function(x, locale = TRUE, | |
| RNG = !identical(x$RNGkind, .RNGdefaults), | |
| ...) | |
| { | |
| mkLabel <- function(L, n) { | |
| vers <- sapply(L[[n]], function(x) x[["Version"]]) | |
| pkg <- sapply(L[[n]], function(x) x[["Package"]]) | |
| paste(pkg, vers, sep = "_") | |
| } | |
| cat(x$R.version$version.string, "\n", sep = "") | |
| cat("Platform: ", x$platform, "\n", sep = "") | |
| if (!is.null(x$running)) cat("Running under: ", x$running, "\n", sep = "") | |
| cat("\n") | |
| cat("Matrix products: ", x$matprod, "\n", sep = "") | |
| blas <- x$BLAS | |
| if (is.null(blas)) blas <- "" | |
| lapack <- x$LAPACK | |
| if (is.null(lapack)) lapack <- "" | |
| if (blas == lapack && nzchar(blas)) | |
| cat("BLAS/LAPACK: ", blas, "\n", sep = "") | |
| else { | |
| if(nzchar(blas)) cat("BLAS: ", blas, "\n", sep = "") | |
| if(nzchar(lapack)) cat("LAPACK: ", lapack, "\n", sep = "") | |
| } | |
| cat("\n") | |
| if(RNG) { | |
| cat("Random number generation:\n" | |
| , "RNG: ", x$RNGkind[1], "\n" | |
| , "Normal: ", x$RNGkind[2], "\n" | |
| , "Sample: ", x$RNGkind[3], "\n" | |
| , "\n") | |
| } | |
| if(locale) { | |
| cat("locale:\n") | |
| print(strsplit(x$locale, ";", fixed=TRUE)[[1]], quote=FALSE, ...) | |
| cat("\n") | |
| } | |
| cat("attached base packages:\n") | |
| print(x$basePkgs, quote=FALSE, ...) | |
| if(!is.null(x$otherPkgs)){ | |
| cat("\nother attached packages:\n") | |
| print(mkLabel(x, "otherPkgs"), quote = FALSE, ...) | |
| } | |
| if(!is.null(x$loadedOnly)){ | |
| cat("\nloaded via a namespace (and not attached):\n") | |
| print(mkLabel(x, "loadedOnly"), quote = FALSE, ...) | |
| } | |
| invisible(x) | |
| } | |
| ##' From a list of packageDescription()s, | |
| ##' construct string "<p1>~<ver>, <p2>~<ver>, ..., <pn>~<ver>" | |
| toLatexPDlist <- function(pdList, sep = "~") { | |
| if(length(ver <- vapply(pdList, `[[`, "", "Version"))) { | |
| ver <- ver[sort(names(ver))] | |
| paste(names(ver), ver, sep = sep, collapse = ", ") | |
| } else ver | |
| } | |
| toLatex.sessionInfo <- | |
| function(object, locale = TRUE, | |
| RNG = !identical(object$RNGkind, .RNGdefaults), | |
| ...) | |
| { | |
| z <- c("\\begin{itemize}\\raggedright", | |
| paste0(" \\item ", object$R.version$version.string, | |
| ", \\verb|", object$R.version$platform, "|"), | |
| if(locale) | |
| paste0(" \\item Locale: \\verb|", | |
| gsub(";","|, \\\\verb|", object$locale) , "|"), | |
| paste0(" \\item Running under: \\verb|", | |
| gsub(";","|, \\\\verb|", object$running) , "|"), | |
| if(RNG) | |
| paste0(" \\item Random number generation:" | |
| , " \\item RNG: \\verb|", object$RNGkind[1], "|" | |
| , " \\item Normal: \\verb|", object$RNGkind[2], "|" | |
| , " \\item Sample: \\verb|", object$RNGkind[3], "|" | |
| ) | |
| , paste0(" \\item Matrix products: ", object$matprod) | |
| ) | |
| blas <- object$BLAS | |
| if (is.null(blas)) blas <- "" | |
| lapack <- object$LAPACK | |
| if (is.null(lapack)) lapack <- "" | |
| if (blas == lapack && nzchar(blas)) | |
| z <- c(z, paste0(" \\item BLAS/LAPACK: \\verb|", blas, "|")) | |
| else { | |
| if (nzchar(blas)) | |
| z <- c(z, paste0(" \\item BLAS: \\verb|", blas, "|")) | |
| if (nzchar(lapack)) | |
| z <- c(z, paste0(" \\item LAPACK: \\verb|", lapack, "|")) | |
| } | |
| z <- c(z, strwrap(paste("\\item Base packages: ", | |
| paste(sort(object$basePkgs), collapse = ", ")), | |
| indent = 2, exdent = 4)) | |
| if(length(o.ver <- toLatexPDlist(object$otherPkg))) | |
| z <- c(z, | |
| strwrap(paste(" \\item Other packages: ", o.ver), | |
| indent = 2, exdent = 4)) | |
| if(length(n.ver <- toLatexPDlist(object$loadedOnly))) | |
| z <- c(z, | |
| strwrap(paste(" \\item Loaded via a namespace (and not attached): ", | |
| n.ver), | |
| indent = 2, exdent = 4)) | |
| z <- c(z, "\\end{itemize}") | |
| class(z) <- "Latex" | |
| z | |
| } |