tests/eval-etc-2.Rout.save

R version 3.6.2 Patched (2020-02-12 r77795) -- "Dark and Stormy Night"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> ####  eval / parse / deparse / substitute ...
> 
> ####  Part 2
> ####  ======  Recommended packages allowed  .. output tests *sloppily*
> 
> source(file.path(Sys.getenv("SRCDIR"), "eval-fns.R"), echo = TRUE)

> pd0 <- function(expr, backtick = TRUE, ...) parse(text = deparse(expr, 
+     backtick = backtick, ...))

> id_epd <- function(expr, control = c("all", "digits17"), 
+     ...) eval(pd0(expr, control = control, ...))

> dPut <- function(x, control = c("all", "digits17")) dput(x, 
+     control = control)

> hasReal <- function(x) {
+     if (is.double(x) || is.complex(x)) 
+         !all((x == round(x, 3)) | is.na(x))
+     else if (is.logical(x) || is. .... [TRUNCATED] 

> isMissObj <- function(obj) identical(obj, alist(a = )[[1]])

> hasMissObj <- function(obj) {
+     if (is.recursive(obj)) {
+         if (is.function(obj) || is.language(obj)) 
+             FALSE
+         else .... [TRUNCATED] 

> check_EPD <- function(obj, show = !hasReal(obj), oNam = deparse(substitute(obj)), 
+     control = c("keepInteger", "showAttributes", "keepNA"), not .... [TRUNCATED] 

> runEPD_checks <- function(env = .GlobalEnv) {
+     stopifnot(is.environment(env))
+     for (nm in ls(envir = env)) {
+         cat(nm, ": ", sep = .... [TRUNCATED] 
>                                         #---------
> 
> if(require("Matrix")) withAutoprint({ cat("Trying some Matrix objects, too\n")
+     D5. <- Diagonal(x = 5:1)
+     D5N <- D5.; D5N[5,5] <- NA
+     example(Matrix)
+     ## a subset from  example(sparseMatrix) :
+     i <- c(1,3:8); j <- c(2,9,6:10); x <- 7 * (1:7)
+     A <- sparseMatrix(i, j, x = x)
+     sA <- sparseMatrix(i, j, x = x, symmetric = TRUE)
+     tA <- sparseMatrix(i, j, x = x, triangular= TRUE)
+     ## dims can be larger than the maximum row or column indices
+     AA <- sparseMatrix(c(1,3:8), c(2,9,6:10), x = 7 * (1:7), dims = c(10,20))
+     ## i, j and x can be in an arbitrary order, as long as they are consistent
+     set.seed(1); (perm <- sample(1:7))
+     A1 <- sparseMatrix(i[perm], j[perm], x = x[perm])
+     ## the (i,j) pairs can be repeated, in which case the x's are summed
+     args <- data.frame(i = c(i, 1), j = c(j, 2), x = c(x, 2))
+     Aa <- do.call(sparseMatrix, args)
+     A. <- do.call(sparseMatrix, c(args, list(use.last.ij = TRUE)))
+     ## for a pattern matrix, of course there is no "summing":
+     nA <- do.call(sparseMatrix, args[c("i","j")])
+     dn <- list(LETTERS[1:3], letters[1:5])
+     ## pointer vectors can be used, and the (i,x) slots are sorted if necessary:
+     m <- sparseMatrix(i = c(3,1, 3:2, 2:1), p= c(0:2, 4,4,6), x = 1:6, dimnames = dn)
+     ## no 'x' --> patter*n* matrix:
+     n <- sparseMatrix(i=1:6, j=rev(2:7))
+     ## an empty sparse matrix:
+     e <- sparseMatrix(dims = c(4,6), i={}, j={})
+     ## a symmetric one:
+     sy <- sparseMatrix(i= c(2,4,3:5), j= c(4,7:5,5), x = 1:5,
+                        dims = c(7,7), symmetric=TRUE)
+ })
Loading required package: Matrix
> cat("Trying some Matrix objects, too\n")
Trying some Matrix objects, too
> D5. <- Diagonal(x = 5:1)
> D5N <- D5.
> D5N[5, 5] <- NA
> example(Matrix)

Matrix> Matrix(0, 3, 2)             # 3 by 2 matrix of zeros -> sparse
3 x 2 sparse Matrix of class "dgCMatrix"
        
[1,] . .
[2,] . .
[3,] . .

Matrix> Matrix(0, 3, 2, sparse=FALSE)# -> 'dense'
3 x 2 Matrix of class "dgeMatrix"
     [,1] [,2]
[1,]    0    0
[2,]    0    0
[3,]    0    0

Matrix> Matrix(0, 2, 2, sparse=FALSE)# diagonal !
2 x 2 diagonal matrix of class "ddiMatrix"
     [,1] [,2]
[1,]    0    .
[2,]    .    0

Matrix> Matrix(0, 2, 2, sparse=FALSE, doDiag=FALSE)# -> dense
2 x 2 Matrix of class "dsyMatrix"
     [,1] [,2]
[1,]    0    0
[2,]    0    0

Matrix> Matrix(1:6, 3, 2)           # a 3 by 2 matrix (+ integer warning)
3 x 2 Matrix of class "dgeMatrix"
     [,1] [,2]
[1,]    1    4
[2,]    2    5
[3,]    3    6

Matrix> Matrix(1:6 + 1, nrow=3)
3 x 2 Matrix of class "dgeMatrix"
     [,1] [,2]
[1,]    2    5
[2,]    3    6
[3,]    4    7

Matrix> ## logical ones:
Matrix> Matrix(diag(4) >  0)# -> "ldiMatrix" with diag = "U"
4 x 4 diagonal matrix of class "ldiMatrix"
     [,1] [,2] [,3] [,4]
[1,] TRUE    .    .    .
[2,]    . TRUE    .    .
[3,]    .    . TRUE    .
[4,]    .    .    . TRUE

Matrix> Matrix(diag(4) >  0, sparse=TRUE)# -> sparse...
4 x 4 sparse Matrix of class "lsCMatrix"
            
[1,] | . . .
[2,] . | . .
[3,] . . | .
[4,] . . . |

Matrix> Matrix(diag(4) >= 0)# -> "lsyMatrix" (of all 'TRUE')
4 x 4 Matrix of class "lsyMatrix"
     [,1] [,2] [,3] [,4]
[1,] TRUE TRUE TRUE TRUE
[2,] TRUE TRUE TRUE TRUE
[3,] TRUE TRUE TRUE TRUE
[4,] TRUE TRUE TRUE TRUE

Matrix> ## triangular
Matrix> l3 <- upper.tri(matrix(,3,3))

Matrix> (M <- Matrix(l3))  # -> "ltCMatrix"
3 x 3 sparse Matrix of class "ltCMatrix"
          
[1,] . | |
[2,] . . |
[3,] . . .

Matrix> Matrix(! l3)# -> "ltrMatrix"
3 x 3 Matrix of class "ltrMatrix"
     [,1]  [,2]  [,3] 
[1,]  TRUE     .     .
[2,]  TRUE  TRUE     .
[3,]  TRUE  TRUE  TRUE

Matrix> as(l3, "CsparseMatrix")
3 x 3 sparse Matrix of class "lgCMatrix"
          
[1,] . | |
[2,] . . |
[3,] . . .

Matrix> Matrix(1:9, nrow=3,
Matrix+        dimnames = list(c("a", "b", "c"), c("A", "B", "C")))
3 x 3 Matrix of class "dgeMatrix"
  A B C
a 1 4 7
b 2 5 8
c 3 6 9

Matrix> (I3 <- Matrix(diag(3)))# identity, i.e., unit "diagonalMatrix"
3 x 3 diagonal matrix of class "ddiMatrix"
     [,1] [,2] [,3]
[1,]    1    .    .
[2,]    .    1    .
[3,]    .    .    1

Matrix> str(I3) # note the empty 'x' slot
Formal class 'ddiMatrix' [package "Matrix"] with 4 slots
  ..@ diag    : chr "U"
  ..@ Dim     : int [1:2] 3 3
  ..@ Dimnames:List of 2
  .. ..$ : NULL
  .. ..$ : NULL
  ..@ x       : num(0) 

Matrix> (A <- cbind(a=c(2,1), b=1:2))# symmetric *apart* from dimnames
     a b
[1,] 2 1
[2,] 1 2

Matrix> Matrix(A)                    # hence 'dgeMatrix'
2 x 2 Matrix of class "dgeMatrix"
     a b
[1,] 2 1
[2,] 1 2

Matrix> (As <- Matrix(A, dimnames = list(NULL,NULL)))# -> symmetric
2 x 2 Matrix of class "dsyMatrix"
     [,1] [,2]
[1,]    2    1
[2,]    1    2

Matrix> stopifnot(is(As, "symmetricMatrix"),
Matrix+           is(Matrix(0, 3,3), "sparseMatrix"),
Matrix+           is(Matrix(FALSE, 1,1), "sparseMatrix"))
> i <- c(1, 3:8)
> j <- c(2, 9, 6:10)
> x <- 7 * (1:7)
> A <- sparseMatrix(i, j, x = x)
> sA <- sparseMatrix(i, j, x = x, symmetric = TRUE)
> tA <- sparseMatrix(i, j, x = x, triangular = TRUE)
> AA <- sparseMatrix(c(1, 3:8), c(2, 9, 6:10), x = 7 * (1:7), dims = c(10, 
+     20))
> set.seed(1)
> (perm <- sample(1:7))
[1] 1 4 7 2 5 3 6
> A1 <- sparseMatrix(i[perm], j[perm], x = x[perm])
> args <- data.frame(i = c(i, 1), j = c(j, 2), x = c(x, 2))
> Aa <- do.call(sparseMatrix, args)
> A. <- do.call(sparseMatrix, c(args, list(use.last.ij = TRUE)))
> nA <- do.call(sparseMatrix, args[c("i", "j")])
> dn <- list(LETTERS[1:3], letters[1:5])
> m <- sparseMatrix(i = c(3, 1, 3:2, 2:1), p = c(0:2, 4, 4, 6), x = 1:6, 
+     dimnames = dn)
> n <- sparseMatrix(i = 1:6, j = rev(2:7))
> e <- sparseMatrix(dims = c(4, 6), i = {
+ }, j = {
+ })
> sy <- sparseMatrix(i = c(2, 4, 3:5), j = c(4, 7:5, 5), x = 1:5, dims = c(7, 
+     7), symmetric = TRUE)
> 
> runEPD_checks() # Action!
A: new("dgCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 
0L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L), Dim = c(8L, 10L), Dimnames = list(
    NULL, NULL), x = c(7, 21, 28, 35, 14, 42, 49), factors = list())
 --> checking list(*): Ok
--=--=--=--=--
A.: new("dgCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 
0L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L), Dim = c(8L, 10L), Dimnames = list(
    NULL, NULL), x = c(2, 21, 28, 35, 14, 42, 49), factors = list())
 --> checking list(*): Ok
--=--=--=--=--
A1: new("dgCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 
0L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L), Dim = c(8L, 10L), Dimnames = list(
    NULL, NULL), x = c(7, 21, 28, 35, 14, 42, 49), factors = list())
 --> checking list(*): Ok
--=--=--=--=--
AA: new("dgCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 
0L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 
7L, 7L, 7L, 7L), Dim = c(10L, 20L), Dimnames = list(NULL, NULL), 
    x = c(7, 21, 28, 35, 14, 42, 49), factors = list())
 --> checking list(*): Ok
--=--=--=--=--
Aa: new("dgCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 
0L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L), Dim = c(8L, 10L), Dimnames = list(
    NULL, NULL), x = c(9, 21, 28, 35, 14, 42, 49), factors = list())
 --> checking list(*): Ok
--=--=--=--=--
As: new("dsyMatrix", x = c(2, 1, 1, 2), Dim = c(2L, 2L), Dimnames = list(
    NULL, NULL), uplo = "U", factors = list())
 --> checking list(*): Ok
--=--=--=--=--
D5.: new("ddiMatrix", diag = "N", Dim = c(5L, 5L), Dimnames = list(
    NULL, NULL), x = c(5, 4, 3, 2, 1))
 --> checking list(*): Ok
--=--=--=--=--
D5N: new("ddiMatrix", diag = "N", Dim = c(5L, 5L), Dimnames = list(
    NULL, NULL), x = c(5, 4, 3, 2, NA))
 --> checking list(*): Ok
--=--=--=--=--
I3: new("ddiMatrix", diag = "U", Dim = c(3L, 3L), Dimnames = list(
    NULL, NULL), x = numeric(0))
 --> checking list(*): Ok
--=--=--=--=--
M: new("ltCMatrix", i = c(0L, 0L, 1L), p = c(0L, 0L, 1L, 3L), Dim = c(3L, 
3L), Dimnames = list(NULL, NULL), x = c(TRUE, TRUE, TRUE), uplo = "U", 
    diag = "N")
 --> checking list(*): Ok
--=--=--=--=--
args: structure(list(i = c(1, 3, 4, 5, 6, 7, 8, 1), j = c(2, 9, 6, 
7, 8, 9, 10, 2), x = c(7, 14, 21, 28, 35, 42, 49, 2)), class = "data.frame", row.names = c(NA, 
-8L))
 --> checking list(*): Ok
--=--=--=--=--
check_EPD: function (obj, show = !hasReal(obj), oNam = deparse(substitute(obj)), 
    control = c("keepInteger", "showAttributes", "keepNA"), not.identical.ldouble = if (!interactive()) c("t1", 
        "t2", "ydata"), eq.tol = if (noLdbl) 2 * .Machine$double.eps else 0) 
{
    stopifnot(is.character(oNam))
    if (show) 
        dPut(obj)
    if (is.environment(obj) || hasMissObj(obj)) {
        cat("__ not parse()able __:", if (is.environment(obj)) 
            "environment"
        else "hasMissObj(.) is true", "\n")
        return(invisible(obj))
    }
    ob2 <- id_epd(obj)
    po <- tryCatch(pd0(obj, control = control), error = function(e) {
        cat("default parse(*, deparse(obj)) failed:\n  ", conditionMessage(e), 
            "\n  but deparse(*, control='all') should work.\n")
        pd0(obj, control = "all")
    })
    noLdbl <- (.Machine$sizeof.longdouble <= 8)
    if (!identical(obj, ob2, ignore.environment = TRUE, ignore.bytecode = TRUE, 
        ignore.srcref = TRUE)) {
        ae <- all.equal(obj, ob2, tolerance = eq.tol)
        if (is.na(match(oNam, not.identical.ldouble))) {
            ae.txt <- "all.equal(*,*, tol = ..)"
            cat("not identical(*, ignore.env=T),", if (isTRUE(ae)) 
                paste("but", ae.txt), "\n")
        }
        if (!isTRUE(ae)) 
            stop("Not equal: ", ae.txt, paste(c(" giving", head(ae, 
                2), if (length(ae) > 2) "...."), collapse = "\n  "))
    }
    if (!is.language(obj)) {
        ob2. <- eval(obj)
    }
    if (show || !is.list(obj)) {
        cat(" --> checking list(*): ")
        check_EPD(list(.chk = obj), show = FALSE, oNam = oNam, 
            eq.tol = eq.tol)
        cat("Ok\n")
    }
    invisible(obj)
}
 --> checking list(*): Ok
checking body(.):
quote({
    stopifnot(is.character(oNam))
    if (show) 
        dPut(obj)
    if (is.environment(obj) || hasMissObj(obj)) {
        cat("__ not parse()able __:", if (is.environment(obj)) 
            "environment"
        else "hasMissObj(.) is true", "\n")
        return(invisible(obj))
    }
    ob2 <- id_epd(obj)
    po <- tryCatch(pd0(obj, control = control), error = function(e) {
        cat("default parse(*, deparse(obj)) failed:\n  ", conditionMessage(e), 
            "\n  but deparse(*, control='all') should work.\n")
        pd0(obj, control = "all")
    })
    noLdbl <- (.Machine$sizeof.longdouble <= 8)
    if (!identical(obj, ob2, ignore.environment = TRUE, ignore.bytecode = TRUE, 
        ignore.srcref = TRUE)) {
        ae <- all.equal(obj, ob2, tolerance = eq.tol)
        if (is.na(match(oNam, not.identical.ldouble))) {
            ae.txt <- "all.equal(*,*, tol = ..)"
            cat("not identical(*, ignore.env=T),", if (isTRUE(ae)) 
                paste("but", ae.txt), "\n")
        }
        if (!isTRUE(ae)) 
            stop("Not equal: ", ae.txt, paste(c(" giving", head(ae, 
                2), if (length(ae) > 2) "...."), collapse = "\n  "))
    }
    if (!is.language(obj)) {
        ob2. <- eval(obj)
    }
    if (show || !is.list(obj)) {
        cat(" --> checking list(*): ")
        check_EPD(list(.chk = obj), show = FALSE, oNam = oNam, 
            eq.tol = eq.tol)
        cat("Ok\n")
    }
    invisible(obj)
})
 --> checking list(*): Ok
checking formals(.):
as.pairlist(alist(obj = , show = quote(!hasReal(obj)), oNam = quote(deparse(substitute(obj))), control = quote(c("keepInteger", 
    "showAttributes", "keepNA")), not.identical.ldouble = quote(if (!interactive()) c("t1", 
    "t2", "ydata")), eq.tol = quote(if (noLdbl) 2 * .Machine$double.eps else 0)))
__ not parse()able __: hasMissObj(.) is true 
--=--=--=--=--
dPut: function (x, control = c("all", "digits17")) 
dput(x, control = control)
 --> checking list(*): Ok
checking body(.):
quote(dput(x, control = control))
 --> checking list(*): Ok
checking formals(.):
as.pairlist(alist(x = , control = quote(c("all", "digits17"))))
__ not parse()able __: hasMissObj(.) is true 
--=--=--=--=--
dn: list(c("A", "B", "C"), c("a", "b", "c", "d", "e"))
 --> checking list(*): Ok
--=--=--=--=--
e: new("ngCMatrix", i = integer(0), p = c(0L, 0L, 0L, 0L, 0L, 0L, 
0L), Dim = c(4L, 6L), Dimnames = list(NULL, NULL), factors = list())
 --> checking list(*): Ok
--=--=--=--=--
hasMissObj: function (obj) 
{
    if (is.recursive(obj)) {
        if (is.function(obj) || is.language(obj)) 
            FALSE
        else any(vapply(obj, hasMissObj, NA))
    }
    else isMissObj(obj)
}
 --> checking list(*): Ok
checking body(.):
quote({
    if (is.recursive(obj)) {
        if (is.function(obj) || is.language(obj)) 
            FALSE
        else any(vapply(obj, hasMissObj, NA))
    }
    else isMissObj(obj)
})
 --> checking list(*): Ok
checking formals(.):
as.pairlist(alist(obj = ))
__ not parse()able __: hasMissObj(.) is true 
--=--=--=--=--
hasReal: function (x) 
{
    if (is.double(x) || is.complex(x)) 
        !all((x == round(x, 3)) | is.na(x))
    else if (is.logical(x) || is.integer(x) || is.symbol(x) || 
        is.call(x) || is.environment(x) || is.character(x)) 
        FALSE
    else if (is.recursive(x)) 
        any(vapply(x, hasReal, NA))
    else if (isS4(x)) {
        if (length(sn <- slotNames(x))) 
            any(vapply(sn, function(s) hasReal(slot(x, s)), NA))
        else FALSE
    }
    else FALSE
}
 --> checking list(*): Ok
checking body(.):
quote({
    if (is.double(x) || is.complex(x)) 
        !all((x == round(x, 3)) | is.na(x))
    else if (is.logical(x) || is.integer(x) || is.symbol(x) || 
        is.call(x) || is.environment(x) || is.character(x)) 
        FALSE
    else if (is.recursive(x)) 
        any(vapply(x, hasReal, NA))
    else if (isS4(x)) {
        if (length(sn <- slotNames(x))) 
            any(vapply(sn, function(s) hasReal(slot(x, s)), NA))
        else FALSE
    }
    else FALSE
})
 --> checking list(*): Ok
checking formals(.):
as.pairlist(alist(x = ))
__ not parse()able __: hasMissObj(.) is true 
--=--=--=--=--
i: c(1, 3, 4, 5, 6, 7, 8)
 --> checking list(*): Ok
--=--=--=--=--
id_epd: function (expr, control = c("all", "digits17"), ...) 
eval(pd0(expr, control = control, ...))
 --> checking list(*): Ok
checking body(.):
quote(eval(pd0(expr, control = control, ...)))
 --> checking list(*): Ok
checking formals(.):
as.pairlist(alist(expr = , control = quote(c("all", "digits17")), ... = ))
__ not parse()able __: hasMissObj(.) is true 
--=--=--=--=--
isMissObj: function (obj) 
identical(obj, alist(a = )[[1]])
 --> checking list(*): Ok
checking body(.):
quote(identical(obj, alist(a = )[[1]]))
 --> checking list(*): Ok
checking formals(.):
as.pairlist(alist(obj = ))
__ not parse()able __: hasMissObj(.) is true 
--=--=--=--=--
j: c(2, 9, 6, 7, 8, 9, 10)
 --> checking list(*): Ok
--=--=--=--=--
l3: structure(c(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, 
FALSE), .Dim = c(3L, 3L))
 --> checking list(*): Ok
--=--=--=--=--
m: new("dgCMatrix", i = c(2L, 0L, 1L, 2L, 0L, 1L), p = c(0L, 1L, 
2L, 4L, 4L, 6L), Dim = c(3L, 5L), Dimnames = list(c("A", "B", 
"C"), c("a", "b", "c", "d", "e")), x = c(1, 2, 4, 3, 6, 5), factors = list())
 --> checking list(*): Ok
--=--=--=--=--
n: new("ngCMatrix", i = 5:0, p = c(0L, 0L, 1L, 2L, 3L, 4L, 5L, 6L
), Dim = 6:7, Dimnames = list(NULL, NULL), factors = list())
 --> checking list(*): Ok
--=--=--=--=--
nA: new("ngCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 
0L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L), Dim = c(8L, 10L), Dimnames = list(
    NULL, NULL), factors = list())
 --> checking list(*): Ok
--=--=--=--=--
pd0: function (expr, backtick = TRUE, ...) 
parse(text = deparse(expr, backtick = backtick, ...))
 --> checking list(*): Ok
checking body(.):
quote(parse(text = deparse(expr, backtick = backtick, ...)))
 --> checking list(*): Ok
checking formals(.):
as.pairlist(alist(expr = , backtick = TRUE, ... = ))
__ not parse()able __: hasMissObj(.) is true 
--=--=--=--=--
perm: c(1L, 4L, 7L, 2L, 5L, 3L, 6L)
 --> checking list(*): Ok
--=--=--=--=--
runEPD_checks: function (env = .GlobalEnv) 
{
    stopifnot(is.environment(env))
    for (nm in ls(envir = env)) {
        cat(nm, ": ", sep = "")
        x <- env[[nm]]
        check_EPD(x, oNam = nm)
        if (is.function(x) && !inherits(x, "classGeneratorFunction")) {
            cat("checking body(.):\n")
            check_EPD(if (is.language(bx <- body(x))) 
                removeSource(bx)
            else bx)
            cat("checking formals(.):\n")
            check_EPD(formals(x))
        }
        cat("--=--=--=--=--\n")
    }
}
 --> checking list(*): Ok
checking body(.):
quote({
    stopifnot(is.environment(env))
    for (nm in ls(envir = env)) {
        cat(nm, ": ", sep = "")
        x <- env[[nm]]
        check_EPD(x, oNam = nm)
        if (is.function(x) && !inherits(x, "classGeneratorFunction")) {
            cat("checking body(.):\n")
            check_EPD(if (is.language(bx <- body(x))) 
                removeSource(bx)
            else bx)
            cat("checking formals(.):\n")
            check_EPD(formals(x))
        }
        cat("--=--=--=--=--\n")
    }
})
 --> checking list(*): Ok
checking formals(.):
pairlist(env = quote(.GlobalEnv))
 --> checking list(*): Ok
--=--=--=--=--
sA: new("dsCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 
0L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L), Dim = c(10L, 10L), Dimnames = list(
    NULL, NULL), x = c(7, 21, 28, 35, 14, 42, 49), uplo = "U", 
    factors = list())
 --> checking list(*): Ok
--=--=--=--=--
sy: new("dsCMatrix", i = c(1L, 3L, 4L, 2L, 3L), p = c(0L, 0L, 0L, 
0L, 1L, 3L, 4L, 5L), Dim = c(7L, 7L), Dimnames = list(NULL, NULL), 
    x = c(1, 4, 5, 3, 2), uplo = "U", factors = list())
 --> checking list(*): Ok
--=--=--=--=--
tA: new("dtCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 
0L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L), Dim = c(10L, 10L), Dimnames = list(
    NULL, NULL), x = c(7, 21, 28, 35, 14, 42, 49), uplo = "U", 
    diag = "N")
 --> checking list(*): Ok
--=--=--=--=--
x: c(7, 14, 21, 28, 35, 42, 49)
 --> checking list(*): Ok
--=--=--=--=--
> 
> summary(warnings())
Length  Class   Mode 
     0   NULL   NULL 
> ## at the very end
> cat('Time elapsed: ', proc.time(), "\n")
Time elapsed:  1.373 0.124 1.534 0.004 0.003 
>