1# File src/library/utils/R/sessionInfo.R 2# Part of the R package, https://www.R-project.org 3# 4# Copyright (C) 1995-2021 The R Core Team 5# 6# This program is free software; you can redistribute it and/or modify 7# it under the terms of the GNU General Public License as published by 8# the Free Software Foundation; either version 2 of the License, or 9# (at your option) any later version. 10# 11# This program is distributed in the hope that it will be useful, 12# but WITHOUT ANY WARRANTY; without even the implied warranty of 13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14# GNU General Public License for more details. 15# 16# A copy of the GNU General Public License is available at 17# https://www.R-project.org/Licenses/ 18 19.RNGdefaults <- RNGkind() # run once at install time and retain for comparison 20 21## FIXME? alternatively, just define 'osVersion' directly in .onLoad() in zzz.R 22.osVersion <- function() { 23 ## Now try to figure out the OS we are running under 24 if (.Platform$OS.type == "windows") { 25 win.version() 26 } else if (nzchar(Sys.which('uname'))) { ## we could try /usr/bin/uname 27 uname <- system("uname -a", intern = TRUE) 28 os <- sub(" .*", "", uname) 29 switch(os, 30 "Linux" = 31 if(file.exists("/etc/os-release")) { 32 ## http://www.freedesktop.org/software/systemd/man/os-release.html 33 tmp <- readLines("/etc/os-release") 34 t2 <- if (any(startsWith(tmp, "PRETTY_NAME="))) 35 sub("^PRETTY_NAME=", "", 36 grep("^PRETTY_NAME=", tmp, value = TRUE)[1L]) 37 else if (any(startsWith(tmp, "NAME"))) 38 ## could check for VERSION or VERSION_ID 39 sub("^NAME=", "", 40 grep("^NAME=", tmp, value = TRUE)[1L]) 41 else "Linux (unknown distro)" 42 sub('"(.*)"', "\\1", t2) 43 } else if(file.exists("/etc/system-release")) { 44 ## RHEL-like 45 readLines("/etc/system-release") 46 }, 47 "Darwin" = { 48 ver <- readLines("/System/Library/CoreServices/SystemVersion.plist") 49 ind <- grep("ProductUserVisibleVersion", ver) 50 ver <- ver[ind + 1L] 51 ver <- sub(".*<string>", "", ver) 52 ver <- sub("</string>$", "", ver) 53 ver1 <- strsplit(ver, ".", fixed = TRUE)[[1L]] 54 ver2 <- ver1[2L] 55 if(ver1[1L] == "10") 56 sprintf("%s %s %s", 57 ifelse(as.numeric(ver2) < 12, "OS X", "macOS"), 58 switch(ver2, 59 ## 10.6 is earliest that can be installed 60 "6" = "Snow Leopard", 61 "7" = "Lion", 62 "8" = "Mountain Lion", 63 "9" = "Mavericks", 64 "10" = "Yosemite", 65 "11" = "El Capitan", 66 "12" = "Sierra", 67 "13" = "High Sierra", 68 "14" = "Mojave", 69 "15" = "Catalina", 70 ## used for early pre-releases 71 ## and still reported by Xcode 10's SDK 72 "16" = "Big Sur", 73 ""), 74 ver) 75 else if(ver1[1L] <= "12") 76 sprintf("macOS %s %s", 77 switch(ver1[1L], 78 "11" = "Big Sur", 79 "12" = "Monterey"), 80 ver) 81 else 82 sprintf("macOS %s", ver) 83 }, 84 "SunOS" = { 85 ver <- system('uname -r', intern = TRUE) 86 paste("Solaris", 87 strsplit(ver, ".", fixed = TRUE)[[1L]][2L]) 88 }, 89 uname) 90 } # using system('uname ..') 91 ## else NULL 92} 93 94sessionInfo <- function(package = NULL) 95{ 96 z <- list() 97 z$R.version <- R.Version() 98 z$platform <- z$R.version$platform 99 if(nzchar(.Platform$r_arch)) 100 z$platform <- paste(z$platform, .Platform$r_arch, sep = "/") 101 z$platform <- paste0(z$platform, " (", 8*.Machine$sizeof.pointer, "-bit)") 102 z$locale <- Sys.getlocale() 103 z$running <- osVersion 104 z$RNGkind <- RNGkind() 105 if(is.null(package)){ 106 package <- grep("^package:", search(), value=TRUE) 107 # weed out environments which are not really packages 108 keep <- vapply(package, function(x) x == "package:base" 109 || !is.null(attr(as.environment(x), "path")), NA) 110 package <- .rmpkg(package[keep]) 111 } 112 113 ## no need to re-encode given what we extract. 114 pkgDesc <- lapply(package, packageDescription, encoding = NA) 115 if(length(package) == 0) stop("no valid packages were specified") 116 basePkgs <- sapply(pkgDesc, 117 function(x) !is.null(x$Priority) && x$Priority=="base") 118 ## Hmm, see tools:::.get_standard_package_names()$base 119 z$basePkgs <- package[basePkgs] 120 if(any(!basePkgs)){ 121 z$otherPkgs <- pkgDesc[!basePkgs] 122 names(z$otherPkgs) <- package[!basePkgs] 123 } 124 loadedOnly <- loadedNamespaces() 125 loadedOnly <- loadedOnly[!(loadedOnly %in% package)] 126 if (length(loadedOnly)) { 127 names(loadedOnly) <- loadedOnly 128 pkgDesc <- c(pkgDesc, lapply(loadedOnly, packageDescription)) 129 z$loadedOnly <- pkgDesc[loadedOnly] 130 } 131 z$matprod <- as.character(options("matprod")) 132 es <- extSoftVersion() 133 z$BLAS <- as.character(es["BLAS"]) #drop name 134 z$LAPACK <- La_library() 135 l10n <- l10n_info() 136 if (!is.null(l10n["system.codepage"])) 137 z$system.codepage <- as.character(l10n["system.codepage"]) 138 if (!is.null(l10n["codepage"])) 139 z$codepage <- as.character(l10n["codepage"]) 140 class(z) <- "sessionInfo" 141 z 142} 143 144print.sessionInfo <- function(x, locale = TRUE, 145 RNG = !identical(x$RNGkind, .RNGdefaults), 146 ...) 147{ 148 mkLabel <- function(L, n) { 149 vers <- sapply(L[[n]], function(x) x[["Version"]]) 150 pkg <- sapply(L[[n]], function(x) x[["Package"]]) 151 paste(pkg, vers, sep = "_") 152 } 153 154 cat(x$R.version$version.string, "\n", sep = "") 155 cat("Platform: ", x$platform, "\n", sep = "") 156 if (!is.null(x$running)) cat("Running under: ", x$running, "\n", sep = "") 157 cat("\n") 158 cat("Matrix products: ", x$matprod, "\n", sep = "") 159 blas <- x$BLAS 160 if (is.null(blas)) blas <- "" 161 lapack <- x$LAPACK 162 if (is.null(lapack)) lapack <- "" 163 if (blas == lapack && nzchar(blas)) 164 cat("BLAS/LAPACK: ", blas, "\n", sep = "") 165 else { 166 if(nzchar(blas)) cat("BLAS: ", blas, "\n", sep = "") 167 if(nzchar(lapack)) cat("LAPACK: ", lapack, "\n", sep = "") 168 } 169 cat("\n") 170 if(RNG) { 171 cat("Random number generation:\n" 172 , "RNG: ", x$RNGkind[1], "\n" 173 , "Normal: ", x$RNGkind[2], "\n" 174 , "Sample: ", x$RNGkind[3], "\n" 175 , "\n") 176 } 177 if(locale) { 178 cat("locale:\n") 179 print(strsplit(x$locale, ";", fixed=TRUE)[[1]], quote=FALSE, ...) 180 if (!is.null(x$system.codepage) && !is.null(x$codepage) && 181 x$system.codepage != x$codepage) 182 cat("system code page: ", x$system.codepage, "\n", sep = "") 183 cat("\n") 184 } 185 cat("attached base packages:\n") 186 print(x$basePkgs, quote=FALSE, ...) 187 if(!is.null(x$otherPkgs)){ 188 cat("\nother attached packages:\n") 189 print(mkLabel(x, "otherPkgs"), quote = FALSE, ...) 190 } 191 if(!is.null(x$loadedOnly)){ 192 cat("\nloaded via a namespace (and not attached):\n") 193 print(mkLabel(x, "loadedOnly"), quote = FALSE, ...) 194 } 195 invisible(x) 196} 197 198##' From a list of packageDescription()s, 199##' construct string "<p1>~<ver>, <p2>~<ver>, ..., <pn>~<ver>" 200toLatexPDlist <- function(pdList, sep = "~") { 201 if(length(ver <- vapply(pdList, `[[`, "", "Version"))) { 202 ver <- ver[sort(names(ver))] 203 paste(names(ver), ver, sep = sep, collapse = ", ") 204 } else ver 205} 206 207toLatex.sessionInfo <- 208 function(object, locale = TRUE, 209 RNG = !identical(object$RNGkind, .RNGdefaults), 210 ...) 211{ 212 z <- c("\\begin{itemize}\\raggedright", 213 paste0(" \\item ", object$R.version$version.string, 214 ", \\verb|", object$R.version$platform, "|"), 215 if(locale) 216 paste0(" \\item Locale: \\verb|", 217 gsub(";", "|, \\verb|", object$locale, fixed=TRUE), "|"), 218 paste0(" \\item Running under: \\verb|", 219 gsub(";", "|, \\verb|", object$running, fixed=TRUE), "|"), 220 if(RNG) 221 paste0(" \\item Random number generation:" 222 , " \\item RNG: \\verb|", object$RNGkind[1], "|" 223 , " \\item Normal: \\verb|", object$RNGkind[2], "|" 224 , " \\item Sample: \\verb|", object$RNGkind[3], "|" 225 ) 226 , paste0(" \\item Matrix products: ", object$matprod) 227 ) 228 blas <- object$BLAS 229 if (is.null(blas)) blas <- "" 230 lapack <- object$LAPACK 231 if (is.null(lapack)) lapack <- "" 232 233 if (blas == lapack && nzchar(blas)) 234 z <- c(z, paste0(" \\item BLAS/LAPACK: \\verb|", blas, "|")) 235 else { 236 if (nzchar(blas)) 237 z <- c(z, paste0(" \\item BLAS: \\verb|", blas, "|")) 238 if (nzchar(lapack)) 239 z <- c(z, paste0(" \\item LAPACK: \\verb|", lapack, "|")) 240 } 241 242 z <- c(z, strwrap(paste("\\item Base packages: ", 243 paste(sort(object$basePkgs), collapse = ", ")), 244 indent = 2, exdent = 4)) 245 246 if(length(o.ver <- toLatexPDlist(object$otherPkg))) 247 z <- c(z, 248 strwrap(paste(" \\item Other packages: ", o.ver), 249 indent = 2, exdent = 4)) 250 if(length(n.ver <- toLatexPDlist(object$loadedOnly))) 251 z <- c(z, 252 strwrap(paste(" \\item Loaded via a namespace (and not attached): ", 253 n.ver), 254 indent = 2, exdent = 4)) 255 z <- c(z, "\\end{itemize}") 256 class(z) <- "Latex" 257 z 258} 259