platform-BLAS/Lapack checks >> `platform-sessionInfo.R`

(which should kept "synced" from pkg `robustbase`!)

DESCRIPTION

 Package: CLA
-Version: 0.95-0
-Date: 2019-03-13
+Version: 0.95-1
+Date: 2019-03-18
 Title: Critical Line Algorithm in Pure R
 Author: Yanhao Shi <syhelena@163.com>,
 	Martin Maechler <maechler@stat.math.ethz.ch>

inst/NEWS.Rd

@@ -4,6 +4,25 @@
 \title{News for \R Package \pkg{CLA}}% MM: look into ../svn-log-from.all
 \newcommand{\CRANpkg}{\href{https://CRAN.R-project.org/package=#1}{\pkg{#1}}}
 
+\section{Changes in version 0.95-1 (2019-..-..)}{
+  \subsection{New Features}{
+    \itemize{
+      \item (none)
+    }
+  }
+  \subsection{Bug Fixes}{
+    \itemize{
+      \item (none)
+    }
+  }
+  \subsection{Testing}{
+    \itemize{
+      \item modularized partly platform dependent testing into
+      \code{moreSessionInfo()} in \file{./xtraR/platform-sessionInfo.R}.
+    }
+  }
+}
+
 \section{Changes in version 0.95-0 (2019-03-13)}{
   \subsection{New Features}{
     \itemize{

inst/xtraR/platform-sessionInfo.R

+## <---> sync with ~/R/Pkgs/robustbase/inst/xtraR/platform-sessionInfo.R
+##                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+##' return 'x' unless it is NULL where you'd use 'orElse'
+`%||%` <- function(x, orElse) if(!is.null(x)) x else orElse
+
+##'  not %in%  :
+`%nin%` <- function (x, table) is.na(match(x, table))
+
+##' Derive more sessionInfo() like information, notably about BLAS, LAPACK, arithmetic, etc
+moreSessionInfo <- function(print. = FALSE) {
+    .M <- .Machine
+    if(print.) str(.M[grep("^sizeof", names(.M))]) ## differentiate long-double..
+    b64 <- .M$sizeof.pointer == 8
+    onWindows <- .Platform$OS.type == "windows"
+    ## Do we have 64bit but no-long-double ?
+    arch <- Sys.info()[["machine"]]
+    b64nLD <- (arch == "x86_64" && .M$sizeof.longdouble != 16)
+    if(b64nLD) arch <- paste0(arch, "--no-long-double")
+    if(print.)
+        cat(sprintf("%d bit platform type '%s'  ==> onWindows: %s\narch: %s\n",
+                    if(b64) 64 else 32, .Platform$OS.type, onWindows, arch))
+    sInfo <- sessionInfo()
+    if(!exists("osVersion")) osVersion <- sInfo$running
+    if(print.) cat("osVersion (0):", osVersion, "\n")
+    if(is.null(osVersion)) osVersion <- "Fedora" # very last resort
+    if(!length(BLAS.is.LAPACK <- sInfo$BLAS == sInfo$LAPACK))
+        BLAS.is.LAPACK <- NA # R versions <= 3.3.x
+    if(print.)
+        cat("osVersion:", osVersion, "| ",
+            'BLAS "is" Lapack:', BLAS.is.LAPACK, "\n")
+    ## NB: sessionInfo() really gets these:
+    if(getRversion() >= "3.4") local({
+        is.BLAS.LAPACK <- exists("La_library", mode="function") && ## R 3.4.0 and newer
+            identical(La_library(), extSoftVersion()[["BLAS"]])
+        stopifnot(isTRUE(is.BLAS.LAPACK == BLAS.is.LAPACK))
+    })
+    ## also TRUE for Windows [since both are "" !!]
+
+    ## Find out if we are running Micrsoft R Open
+    is.MS.Ropen <- {
+        file.exists(Rpr <- file.path(R.home("etc"), "Rprofile.site")) &&
+            length(lnsRpr <- readLines(Rpr)) &&
+            ## length(grep("[Mm]icrosoft", lnsRpr)) > 3 # MRO 3.5.1 has '20' times "[Mm]icrosoft"
+            length(grep("Microsoft R Open", lnsRpr, fixed=TRUE, value=TRUE)) > 0 ## MRO 3.5.1 has it twice
+    }
+    if(print. && is.MS.Ropen) cat("We are running 'Microsoft R Open'\n")
+
+    ## I'd really would want to know which of (OpenBLAS | ATLAS | MKL | R's own BLAS+LAPACK)
+    ##
+    ## Next best, I'd really like
+    ##
+    ##    strictR <- we_are_using_Rs_own_BLAS_and_Lapack()  [ ==> BLAS != Lapack ]
+    ##
+    ## Actually the following is currently (2019-03)  equivalent to
+    ## strictR <- !(using ATLAS || OpenBLAS || MKL )
+    if(TRUE) {
+        strictR <- !BLAS.is.LAPACK && !is.MS.Ropen
+    } else { ## workaround:
+        strictR <- print(Sys.info()[["user"]]) == "maechler"# actually
+        ## but not when testing with /usr/bin/R [OpenBLAS!] (as "maechler"):
+        if(strictR && substr(osVersion, 1,6) == "Fedora" && R.home() == "/usr/lib64/R")
+            strictR <- FALSE
+    }
+    if(print.) cat("strictR:", strictR, "\n")
+    structure(class = "moreSessionInfo",
+              list(
+                  arch = arch
+                , b64 = b64 # 64-bit (:<==> sizeof.pointer == 8 )
+                , b64nLD = b64nLD # 64-bit, but --no-long-double (sizeof.longdouble != 16)
+                , BLAS.is.LAPACK = BLAS.is.LAPACK
+                , is.MS.Ropen = is.MS.Ropen # is the R a version of Microsoft R Open (==> MKL-linked BLAS)
+                , onWindows = onWindows
+                , osVersion = osVersion
+                , strictR = strictR # are BLAS & Lapack from R's source, and "otherwise known safe platform"
+              ))
+}
+
+if(getRversion() < "3.4.0") withAutoprint <- function(x, ...) x
+if(isTRUE(getOption("chk.moreSessionInfo"))) withAutoprint({
+    ms1 <- moreSessionInfo()
+    ms. <- moreSessionInfo(print. = TRUE)
+    stopifnot(is.list(ms1), length(ms1) > 1, identical(ms1, ms.) )
+})
+

tests/SP500-ex.R

 require(CLA)
 
-b64 <- .Machine$sizeof.pointer == 8
-cat(sprintf("%d bit platform type '%s'\n", if(b64) 64 else 32, .Platform$OS.type))
-(nonWindows <- .Platform$OS.type != "windows")
-arch <- Sys.info()[["machine"]]
-.M <- .Machine; str(.M[grep("^sizeof", names(.M))]) ## differentiate long-double..
-## Do we have 64bit but no-long-double ?
-b64nLD <- (arch == "x86_64" && .M$sizeof.longdouble != 16)
-if(b64nLD) arch <- paste0(arch, "--no-long-double")
-arch
-
-## <---> sync with ~/R/Pkgs/robustbase/tests/mc-strict.R
-##                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-sInfo <- sessionInfo()
-if(!exists("osVersion")) osVersion <- sInfo$running
-cat("osVersion:", osVersion, "\n")
-if(!is.null(osVersion)) "Fedora" # last resort
-BLAS.is.LAPACK <- sInfo$BLAS == sInfo$LAPACK
-cat("osVersion:", osVersion, "| ",
-    'BLAS "is" Lapack:', BLAS.is.LAPACK, "\n")
-
-## Find out if we are running Micrsoft R Open
-is.MS.Ropen <- {
-    file.exists(Rpr <- file.path(R.home("etc"), "Rprofile.site")) &&
-    length(lnsRpr <- readLines(Rpr)) &&
-        ## length(grep("[Mm]icrosoft", lnsRpr)) > 3 # MRO 3.5.1 has '20' times "[Mm]icrosoft"
-    length(grep("Microsoft R Open", lnsRpr, fixed=TRUE, value=TRUE)) > 0 ## MRO 3.5.1 has it twice
-}
-if(is.MS.Ropen) cat("We are running 'Microsoft R Open'\n")
-
-## I'd really want
-##
-##    strict <- we_are_using_Rs_own_BLAS_and_Lapack()  [ ==> BLAS != Lapack ]
-##
-## Actually the following is currently (2019-03)  equivalent to
-## strict <- !(using ATLAS || OpenBLAS || MKL )
-if(TRUE) {
-    strict <- !BLAS.is.LAPACK && !is.MS.Ropen
-} else { ## workaround:
-    strict <- print(Sys.info()[["user"]]) == "maechler"# actually
-    ## but not when testing with /usr/bin/R [OpenBLAS!] (as "maechler"):
-    if(strict && substr(osVersion, 1,6) == "Fedora" && R.home() == "/usr/lib64/R")
-        strict <- FALSE
-}
-cat("strict:", strict, "\n")
-
+source(system.file("xtraR", "platform-sessionInfo.R",
+		   package = "CLA", mustWork=TRUE)) # moreSessionInfo(), withAutoprint() ..
+mS <- moreSessionInfo(print. = TRUE)
 
 data(muS.sp500)
 
@@ -93,8 +51,6 @@ if(doExtras) {
 
 op <- options(width = max(500, getOption("width"))) # then it actually fits
 
-if(getRversion() < "3.4.0") withAutoprint <- function(x, ...) x
-
 if(require(Matrix)) withAutoprint(local = FALSE, {
     ## visualize how weights change "along turning points"
     spWts <- Matrix(CLs5c.0.120$weights_set, sparse=TRUE)
@@ -129,6 +85,7 @@ if(differWts) {
         ncol(wtsn0.ref), "\n")
     strict <- FALSE # !
 } else {
+    strict <- mS$strictR
     stopifnot(all.equal(target = wtsn0.ref, current = wts.non0,
                         tol = 1e-13))
 }
@@ -167,7 +124,7 @@ nn <- c("ADSK", "BCR", "BDX", "BUD", "CTL", "FE", "MCD", "SII", "SYK")
 b64nLD.n0[nn] <- b64.n0[nn] - 1L
 b64nLD.n0[["XTO"]] <- 99L # = b...  - 3L
 
-non.0.TARG <- if(b64) { if(b64nLD) b64nLD.n0 else b64.n0
+non.0.TARG <- if(mS$ b64) { if(mS$ b64nLD) b64nLD.n0 else b64.n0
               } else b32.n0
 
 ## see on all platforms what we get;  typically no diff on 64bit *and* using R's BLAS/Lapack
@@ -215,8 +172,8 @@ if(all(non.0.assets == non.0.TARG)) { ## show differences:
 stopifnot(exprs = {
     identical(names(b64.n0), names(b32.n0))
 
-    if(b64) !strict || identical(non.0.assets, non.0.TARG) # identical(*) fails on ATLAS, MKL, OpenBLAS
-    else if(nonWindows) identical(non.0.assets, b32.n0)
+    if(mS$ b64) !strict || identical(non.0.assets, non.0.TARG) # identical(*) fails on ATLAS, MKL, OpenBLAS
+    else if(.Platform$OS.type != "windows") identical(non.0.assets, b32.n0)
     else ## 32-bit Windows
         TRUE ## for now