R version 4.0.3 RC (2020-10-06 r79305) -- "Bunny-Wunnies Freak Out" 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* > > srcdir <- file.path(Sys.getenv("SRCDIR"), "eval-fns.R") > source(if(file.exists(srcdir)) srcdir else "./eval-fns.R", echo = TRUE) > pd0 <- function(expr, backtick = TRUE, ...) parse(text = deparse(expr, + backtick = backtick, ...)) > id_epd <- function(expr, control = "all", ...) eval(pd0(expr, + control = control, ...)) > dPut <- function(x, control = "all") 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] > rm("srcdir") > > if(require("Matrix")) withAutoprint({ cat("Trying some Matrix objects, too\n") + D5. <- Diagonal(x = 5:1) + D5N <- D5.; D5N[5,5] <- NA + ## a subset/version of example(Matrix) : -------------------------------- + + (Z32 <- Matrix(0, 3, 2)) # 3 by 2 matrix of zeros -> sparse + (z32 <- Matrix(0, 3, 2, sparse=FALSE))# -> 'dense' + + ## 4 cases - 3 different results : + ## TODO (Z22 <- Matrix(0, 2, 2)) # diagonal from Matrix 1.3.* on + (Z22. <- Matrix(0, 2, 2, sparse=FALSE))# (ditto) + (Z22s <- Matrix(0, 2, 2, doDiag=FALSE))# -> sparse symm. "dsCMatrix" + (Z22d <- Matrix(0, 2, 2, sparse=FALSE, doDiag=FALSE))# -> dense symm. "dsyMatrix" + + ## logical ones: + (L4 <- Matrix(diag(4) > 0)) # -> "ldiMatrix" with diag = "U" + ## TODO (L4. <- Matrix(diag(4) > 0, sparse=TRUE)) # ditto, from Matrix 1.3.* on + (L4d <- Matrix(diag(4) >= 0)) # -> "lsyMatrix" (of all 'TRUE') + ## triangular + l3 <- upper.tri(matrix(,3,3)) + (M <- Matrix(l3)) # "ltCMatrix" + (Nl3 <- Matrix(! l3)) # "ltrMatrix" + (l3s <- as(l3, "CsparseMatrix"))# "lgCMatrix" + + (I3 <- Matrix(diag(3)))# identity, i.e., unit "diagonalMatrix" + + (ad <- cbind(a=c(2,1), b=1:2))# symmetric *apart* from dimnames + (As <- Matrix(ad, dimnames = list(NULL,NULL)))# -> symmetric + forceSymmetric(ad) # also symmetric, w/ symm. dimnames + stopifnot(is(As, "symmetricMatrix"), + is(Matrix(0, 3,3), "sparseMatrix"), + is(Matrix(FALSE, 1,1), "sparseMatrix")) + + ## 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 > (Z32 <- Matrix(0, 3, 2)) 3 x 2 sparse Matrix of class "dgCMatrix" [1,] . . [2,] . . [3,] . . > (z32 <- Matrix(0, 3, 2, sparse = FALSE)) 3 x 2 Matrix of class "dgeMatrix" [,1] [,2] [1,] 0 0 [2,] 0 0 [3,] 0 0 > (Z22. <- Matrix(0, 2, 2, sparse = FALSE)) 2 x 2 diagonal matrix of class "ddiMatrix" [,1] [,2] [1,] 0 . [2,] . 0 > (Z22s <- Matrix(0, 2, 2, doDiag = FALSE)) 2 x 2 sparse Matrix of class "dsCMatrix" [1,] . . [2,] . . > (Z22d <- Matrix(0, 2, 2, sparse = FALSE, doDiag = FALSE)) 2 x 2 Matrix of class "dsyMatrix" [,1] [,2] [1,] 0 0 [2,] 0 0 > (L4 <- Matrix(diag(4) > 0)) 4 x 4 diagonal matrix of class "ldiMatrix" [,1] [,2] [,3] [,4] [1,] TRUE . . . [2,] . TRUE . . [3,] . . TRUE . [4,] . . . TRUE > (L4d <- Matrix(diag(4) >= 0)) 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 > l3 <- upper.tri(matrix(, 3, 3)) > (M <- Matrix(l3)) 3 x 3 sparse Matrix of class "ltCMatrix" [1,] . | | [2,] . . | [3,] . . . > (Nl3 <- Matrix(!l3)) 3 x 3 Matrix of class "ltrMatrix" [,1] [,2] [,3] [1,] TRUE . . [2,] TRUE TRUE . [3,] TRUE TRUE TRUE > (l3s <- as(l3, "CsparseMatrix")) 3 x 3 sparse Matrix of class "lgCMatrix" [1,] . | | [2,] . . | [3,] . . . > (I3 <- Matrix(diag(3))) 3 x 3 diagonal matrix of class "ddiMatrix" [,1] [,2] [,3] [1,] 1 . . [2,] . 1 . [3,] . . 1 > (ad <- cbind(a = c(2, 1), b = 1:2)) a b [1,] 2 1 [2,] 1 2 > (As <- Matrix(ad, dimnames = list(NULL, NULL))) 2 x 2 Matrix of class "dsyMatrix" [,1] [,2] [1,] 2 1 [2,] 1 2 > forceSymmetric(ad) 2 x 2 Matrix of class "dsyMatrix" a b a 2 1 b 1 2 > stopifnot(is(As, "symmetricMatrix"), is(Matrix(0, 3, 3), "sparseMatrix"), + 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 --=--=--=--=-- L4: new("ldiMatrix", diag = "U", Dim = c(4L, 4L), Dimnames = list( NULL, NULL), x = logical(0)) --> checking list(*): Ok --=--=--=--=-- L4d: new("lsyMatrix", x = c(TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE), Dim = c(4L, 4L), Dimnames = list(NULL, NULL), uplo = "U", factors = list()) --> 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 --=--=--=--=-- Nl3: new("ltrMatrix", x = c(TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE, FALSE, TRUE), Dim = c(3L, 3L), Dimnames = list(NULL, NULL), uplo = "L", diag = "N") --> checking list(*): Ok --=--=--=--=-- Z22.: new("ddiMatrix", diag = "N", Dim = c(2L, 2L), Dimnames = list( NULL, NULL), x = c(0, 0)) --> checking list(*): Ok --=--=--=--=-- Z22d: new("dsyMatrix", x = c(0, 0, 0, 0), Dim = c(2L, 2L), Dimnames = list( NULL, NULL), uplo = "U", factors = list()) --> checking list(*): Ok --=--=--=--=-- Z22s: new("dsCMatrix", i = integer(0), p = c(0L, 0L, 0L), Dim = c(2L, 2L), Dimnames = list(NULL, NULL), x = numeric(0), uplo = "U", factors = list()) --> checking list(*): Ok --=--=--=--=-- Z32: new("dgCMatrix", i = integer(0), p = c(0L, 0L, 0L), Dim = 3:2, Dimnames = list(NULL, NULL), x = numeric(0), factors = list()) --> checking list(*): Ok --=--=--=--=-- ad: structure(c(2, 1, 1, 2), .Dim = c(2L, 2L), .Dimnames = list(NULL, c("a", "b"))) --> 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 = "all") dput(x, control = control) --> checking list(*): Ok checking body(.): quote(dput(x, control = control)) --> checking list(*): Ok checking formals(.): as.pairlist(alist(x = , control = "all")) __ 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 = "all", ...) 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 = "all", ... = )) __ 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 --=--=--=--=-- l3s: new("lgCMatrix", i = c(0L, 0L, 1L), p = c(0L, 0L, 1L, 3L), Dim = c(3L, 3L), Dimnames = list(NULL, NULL), x = c(TRUE, TRUE, TRUE), factors = list()) --> 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 --=--=--=--=-- z32: new("dgeMatrix", x = c(0, 0, 0, 0, 0, 0), Dim = 3:2, Dimnames = list( NULL, NULL), factors = list()) --> checking list(*): Ok --=--=--=--=-- > > summary(warnings()) Length Class Mode 0 NULL NULL > ## at the very end > cat('Time elapsed: ', proc.time(), "\n") Time elapsed: 1.496 0.11 1.618 0.002 0.004 >