Commit a11b7bb0 authored by Martin Maechler's avatar Martin Maechler
Browse files

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

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

DESCRIPTION

+2 −2
Original line number Diff line number Diff line 
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

+19 −0
Original line number Diff line number Diff line
@@ -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

0 → 100644
+85 −0
Original line number Diff line number Diff line 
## <---> 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

+7 −50
Original line number Diff line number Diff line 
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