1 2R version 4.1.0 Patched (2021-06-17 r80511) -- "Camp Pontanezen" 3Copyright (C) 2021 The R Foundation for Statistical Computing 4Platform: x86_64-pc-linux-gnu (64-bit) 5 6R is free software and comes with ABSOLUTELY NO WARRANTY. 7You are welcome to redistribute it under certain conditions. 8Type 'license()' or 'licence()' for distribution details. 9 10R is a collaborative project with many contributors. 11Type 'contributors()' for more information and 12'citation()' on how to cite R or R packages in publications. 13 14Type 'demo()' for some demos, 'help()' for on-line help, or 15'help.start()' for an HTML browser interface to help. 16Type 'q()' to quit R. 17 18> #### eval / parse / deparse / substitute ... 19> 20> #### Part 2 21> #### ====== Recommended packages allowed .. output tests *sloppily* 22> 23> #### This file is skipped without recommended packages. 24> 25> srcdir <- file.path(Sys.getenv("SRCDIR"), "eval-fns.R") 26> source(if(file.exists(srcdir)) srcdir else "./eval-fns.R", echo = TRUE) 27 28> pd0 <- function(expr, backtick = TRUE, ...) parse(text = deparse(expr, 29+ backtick = backtick, ...)) 30 31> id_epd <- function(expr, control = "all", ...) eval(pd0(expr, 32+ control = control, ...)) 33 34> dPut <- function(x, control = "all") dput(x, control = control) 35 36> hasReal <- function(x) { 37+ if (is.double(x) || is.complex(x)) 38+ !all((x == round(x, 3)) | is.na(x)) 39+ else if (is.logical(x) || is. .... [TRUNCATED] 40 41> isMissObj <- function(obj) identical(obj, alist(a = )[[1]]) 42 43> hasMissObj <- function(obj) { 44+ if (is.recursive(obj)) { 45+ if (is.function(obj) || is.language(obj)) 46+ FALSE 47+ else .... [TRUNCATED] 48 49> check_EPD <- function(obj, show = !hasReal(obj), oNam = deparse(substitute(obj)), 50+ control = c("keepInteger", "showAttributes", "keepNA"), not .... [TRUNCATED] 51 52> runEPD_checks <- function(env = .GlobalEnv) { 53+ stopifnot(is.environment(env)) 54+ for (nm in ls(envir = env)) { 55+ cat(nm, ": ", sep = .... [TRUNCATED] 56> rm("srcdir") 57> 58> require("Matrix") 59Loading required package: Matrix 60> D5. <- Diagonal(x = 5:1) 61> D5N <- D5.; D5N[5,5] <- NA 62> ## a subset/version of example(Matrix) : -------------------------------- 63> 64> (Z32 <- Matrix(0, 3, 2)) # 3 by 2 matrix of zeros -> sparse 653 x 2 sparse Matrix of class "dgCMatrix" 66 67[1,] . . 68[2,] . . 69[3,] . . 70> (z32 <- Matrix(0, 3, 2, sparse=FALSE))# -> 'dense' 713 x 2 Matrix of class "dgeMatrix" 72 [,1] [,2] 73[1,] 0 0 74[2,] 0 0 75[3,] 0 0 76> 77> ## 4 cases - 3 different results : 78> ## TODO (Z22 <- Matrix(0, 2, 2)) # diagonal from Matrix 1.3.* on 79> (Z22. <- Matrix(0, 2, 2, sparse=FALSE))# (ditto) 802 x 2 diagonal matrix of class "ddiMatrix" 81 [,1] [,2] 82[1,] 0 . 83[2,] . 0 84> (Z22s <- Matrix(0, 2, 2, doDiag=FALSE))# -> sparse symm. "dsCMatrix" 852 x 2 sparse Matrix of class "dsCMatrix" 86 87[1,] . . 88[2,] . . 89> (Z22d <- Matrix(0, 2, 2, sparse=FALSE, doDiag=FALSE))# -> dense symm. "dsyMatrix" 902 x 2 Matrix of class "dsyMatrix" 91 [,1] [,2] 92[1,] 0 0 93[2,] 0 0 94> 95> ## logical ones: 96> (L4 <- Matrix(diag(4) > 0)) # -> "ldiMatrix" with diag = "U" 974 x 4 diagonal matrix of class "ldiMatrix" 98 [,1] [,2] [,3] [,4] 99[1,] TRUE . . . 100[2,] . TRUE . . 101[3,] . . TRUE . 102[4,] . . . TRUE 103> ## TODO (L4. <- Matrix(diag(4) > 0, sparse=TRUE)) # ditto, from Matrix 1.3.* on 104> (L4d <- Matrix(diag(4) >= 0)) # -> "lsyMatrix" (of all 'TRUE') 1054 x 4 Matrix of class "lsyMatrix" 106 [,1] [,2] [,3] [,4] 107[1,] TRUE TRUE TRUE TRUE 108[2,] TRUE TRUE TRUE TRUE 109[3,] TRUE TRUE TRUE TRUE 110[4,] TRUE TRUE TRUE TRUE 111> ## triangular 112> l3 <- upper.tri(matrix(,3,3)) 113> (M <- Matrix(l3)) # "ltCMatrix" 1143 x 3 sparse Matrix of class "ltCMatrix" 115 116[1,] . | | 117[2,] . . | 118[3,] . . . 119> (Nl3 <- Matrix(! l3)) # "ltrMatrix" 1203 x 3 Matrix of class "ltrMatrix" 121 [,1] [,2] [,3] 122[1,] TRUE . . 123[2,] TRUE TRUE . 124[3,] TRUE TRUE TRUE 125> (l3s <- as(l3, "CsparseMatrix"))# "lgCMatrix" 1263 x 3 sparse Matrix of class "lgCMatrix" 127 128[1,] . | | 129[2,] . . | 130[3,] . . . 131> 132> (I3 <- Matrix(diag(3)))# identity, i.e., unit "diagonalMatrix" 1333 x 3 diagonal matrix of class "ddiMatrix" 134 [,1] [,2] [,3] 135[1,] 1 . . 136[2,] . 1 . 137[3,] . . 1 138> 139> (ad <- cbind(a=c(2,1), b=1:2))# symmetric *apart* from dimnames 140 a b 141[1,] 2 1 142[2,] 1 2 143> (As <- Matrix(ad, dimnames = list(NULL,NULL)))# -> symmetric 1442 x 2 Matrix of class "dsyMatrix" 145 [,1] [,2] 146[1,] 2 1 147[2,] 1 2 148> forceSymmetric(ad) # also symmetric, w/ symm. dimnames 1492 x 2 Matrix of class "dsyMatrix" 150 a b 151a 2 1 152b 1 2 153> stopifnot(is(As, "symmetricMatrix"), 154+ is(Matrix(0, 3,3), "sparseMatrix"), 155+ is(Matrix(FALSE, 1,1), "sparseMatrix")) 156> 157> ## a subset from example(sparseMatrix) : ------------------------------- 158> i <- c(1,3:8); j <- c(2,9,6:10); x <- 7 * (1:7) 159> A <- sparseMatrix(i, j, x = x) 160> sA <- sparseMatrix(i, j, x = x, symmetric = TRUE) 161> tA <- sparseMatrix(i, j, x = x, triangular= TRUE) 162> ## dims can be larger than the maximum row or column indices 163> AA <- sparseMatrix(c(1,3:8), c(2,9,6:10), x = 7 * (1:7), dims = c(10,20)) 164> ## i, j and x can be in an arbitrary order, as long as they are consistent 165> set.seed(1); (perm <- sample(1:7)) 166[1] 1 4 7 2 5 3 6 167> A1 <- sparseMatrix(i[perm], j[perm], x = x[perm]) 168> ## the (i,j) pairs can be repeated, in which case the x's are summed 169> args <- data.frame(i = c(i, 1), j = c(j, 2), x = c(x, 2)) 170> Aa <- do.call(sparseMatrix, args) 171> A. <- do.call(sparseMatrix, c(args, list(use.last.ij = TRUE))) 172> ## for a pattern matrix, of course there is no "summing": 173> nA <- do.call(sparseMatrix, args[c("i","j")]) 174> dn <- list(LETTERS[1:3], letters[1:5]) 175> ## pointer vectors can be used, and the (i,x) slots are sorted if necessary: 176> m <- sparseMatrix(i = c(3,1, 3:2, 2:1), p= c(0:2, 4,4,6), x = 1:6, dimnames = dn) 177> ## no 'x' --> patter*n* matrix: 178> n <- sparseMatrix(i=1:6, j=rev(2:7)) 179> ## an empty sparse matrix: 180> e <- sparseMatrix(dims = c(4,6), i={}, j={}) 181> ## a symmetric one: 182> sy <- sparseMatrix(i= c(2,4,3:5), j= c(4,7:5,5), x = 1:5, 183+ dims = c(7,7), symmetric=TRUE) 184> 185> 186> runEPD_checks() # Action! 187A: new("dgCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 1880L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L), Dim = c(8L, 10L), Dimnames = list( 189 NULL, NULL), x = c(7, 21, 28, 35, 14, 42, 49), factors = list()) 190 --> checking list(*): Ok 191--=--=--=--=-- 192A.: new("dgCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 1930L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L), Dim = c(8L, 10L), Dimnames = list( 194 NULL, NULL), x = c(2, 21, 28, 35, 14, 42, 49), factors = list()) 195 --> checking list(*): Ok 196--=--=--=--=-- 197A1: new("dgCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 1980L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L), Dim = c(8L, 10L), Dimnames = list( 199 NULL, NULL), x = c(7, 21, 28, 35, 14, 42, 49), factors = list()) 200 --> checking list(*): Ok 201--=--=--=--=-- 202AA: new("dgCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 2030L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 2047L, 7L, 7L, 7L), Dim = c(10L, 20L), Dimnames = list(NULL, NULL), 205 x = c(7, 21, 28, 35, 14, 42, 49), factors = list()) 206 --> checking list(*): Ok 207--=--=--=--=-- 208Aa: new("dgCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 2090L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L), Dim = c(8L, 10L), Dimnames = list( 210 NULL, NULL), x = c(9, 21, 28, 35, 14, 42, 49), factors = list()) 211 --> checking list(*): Ok 212--=--=--=--=-- 213As: new("dsyMatrix", x = c(2, 1, 1, 2), Dim = c(2L, 2L), Dimnames = list( 214 NULL, NULL), uplo = "U", factors = list()) 215 --> checking list(*): Ok 216--=--=--=--=-- 217D5.: new("ddiMatrix", diag = "N", Dim = c(5L, 5L), Dimnames = list( 218 NULL, NULL), x = c(5, 4, 3, 2, 1)) 219 --> checking list(*): Ok 220--=--=--=--=-- 221D5N: new("ddiMatrix", diag = "N", Dim = c(5L, 5L), Dimnames = list( 222 NULL, NULL), x = c(5, 4, 3, 2, NA)) 223 --> checking list(*): Ok 224--=--=--=--=-- 225I3: new("ddiMatrix", diag = "U", Dim = c(3L, 3L), Dimnames = list( 226 NULL, NULL), x = numeric(0)) 227 --> checking list(*): Ok 228--=--=--=--=-- 229L4: new("ldiMatrix", diag = "U", Dim = c(4L, 4L), Dimnames = list( 230 NULL, NULL), x = logical(0)) 231 --> checking list(*): Ok 232--=--=--=--=-- 233L4d: new("lsyMatrix", x = c(TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 234TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE), Dim = c(4L, 2354L), Dimnames = list(NULL, NULL), uplo = "U", factors = list()) 236 --> checking list(*): Ok 237--=--=--=--=-- 238M: new("ltCMatrix", i = c(0L, 0L, 1L), p = c(0L, 0L, 1L, 3L), Dim = c(3L, 2393L), Dimnames = list(NULL, NULL), x = c(TRUE, TRUE, TRUE), uplo = "U", 240 diag = "N") 241 --> checking list(*): Ok 242--=--=--=--=-- 243Nl3: new("ltrMatrix", x = c(TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE, 244FALSE, TRUE), Dim = c(3L, 3L), Dimnames = list(NULL, NULL), uplo = "L", 245 diag = "N") 246 --> checking list(*): Ok 247--=--=--=--=-- 248Z22.: new("ddiMatrix", diag = "N", Dim = c(2L, 2L), Dimnames = list( 249 NULL, NULL), x = c(0, 0)) 250 --> checking list(*): Ok 251--=--=--=--=-- 252Z22d: new("dsyMatrix", x = c(0, 0, 0, 0), Dim = c(2L, 2L), Dimnames = list( 253 NULL, NULL), uplo = "U", factors = list()) 254 --> checking list(*): Ok 255--=--=--=--=-- 256Z22s: new("dsCMatrix", i = integer(0), p = c(0L, 0L, 0L), Dim = c(2L, 2572L), Dimnames = list(NULL, NULL), x = numeric(0), uplo = "U", 258 factors = list()) 259 --> checking list(*): Ok 260--=--=--=--=-- 261Z32: new("dgCMatrix", i = integer(0), p = c(0L, 0L, 0L), Dim = 3:2, 262 Dimnames = list(NULL, NULL), x = numeric(0), factors = list()) 263 --> checking list(*): Ok 264--=--=--=--=-- 265ad: structure(c(2, 1, 1, 2), .Dim = c(2L, 2L), .Dimnames = list(NULL, 266 c("a", "b"))) 267 --> checking list(*): Ok 268--=--=--=--=-- 269args: structure(list(i = c(1, 3, 4, 5, 6, 7, 8, 1), j = c(2, 9, 6, 2707, 8, 9, 10, 2), x = c(7, 14, 21, 28, 35, 42, 49, 2)), class = "data.frame", row.names = c(NA, 271-8L)) 272 --> checking list(*): Ok 273--=--=--=--=-- 274check_EPD: function (obj, show = !hasReal(obj), oNam = deparse(substitute(obj)), 275 control = c("keepInteger", "showAttributes", "keepNA"), not.identical.ldouble = if (!interactive()) c("t1", 276 "t2", "ydata"), eq.tol = if (noLdbl) 2 * .Machine$double.eps else 0) 277{ 278 stopifnot(is.character(oNam)) 279 if (show) 280 dPut(obj) 281 if (is.environment(obj) || hasMissObj(obj)) { 282 cat("__ not parse()able __:", if (is.environment(obj)) 283 "environment" 284 else "hasMissObj(.) is true", "\n") 285 return(invisible(obj)) 286 } 287 ob2 <- id_epd(obj) 288 po <- tryCatch(pd0(obj, control = control), error = function(e) { 289 cat("default parse(*, deparse(obj)) failed:\n ", conditionMessage(e), 290 "\n but deparse(*, control='all') should work.\n") 291 pd0(obj, control = "all") 292 }) 293 noLdbl <- (.Machine$sizeof.longdouble <= 8) 294 if (!identical(obj, ob2, ignore.environment = TRUE, ignore.bytecode = TRUE, 295 ignore.srcref = TRUE)) { 296 ae <- all.equal(obj, ob2, tolerance = eq.tol, check.environment = FALSE) 297 if (is.na(match(oNam, not.identical.ldouble))) { 298 ae.txt <- "all.equal(*,*, tol = ..)" 299 cat("not identical(*, ignore.env=T),", if (isTRUE(ae)) 300 paste("but", ae.txt), "\n") 301 } 302 if (!isTRUE(ae)) 303 stop("Not equal: ", ae.txt, paste(c(" giving", head(ae, 304 2), if (length(ae) > 2) "...."), collapse = "\n ")) 305 } 306 if (!is.language(obj)) { 307 ob2. <- eval(obj) 308 } 309 if (show || !is.list(obj)) { 310 cat(" --> checking list(*): ") 311 check_EPD(list(.chk = obj), show = FALSE, oNam = oNam, 312 eq.tol = eq.tol) 313 cat("Ok\n") 314 } 315 invisible(obj) 316} 317 --> checking list(*): Ok 318checking body(.): 319quote({ 320 stopifnot(is.character(oNam)) 321 if (show) 322 dPut(obj) 323 if (is.environment(obj) || hasMissObj(obj)) { 324 cat("__ not parse()able __:", if (is.environment(obj)) 325 "environment" 326 else "hasMissObj(.) is true", "\n") 327 return(invisible(obj)) 328 } 329 ob2 <- id_epd(obj) 330 po <- tryCatch(pd0(obj, control = control), error = function(e) { 331 cat("default parse(*, deparse(obj)) failed:\n ", conditionMessage(e), 332 "\n but deparse(*, control='all') should work.\n") 333 pd0(obj, control = "all") 334 }) 335 noLdbl <- (.Machine$sizeof.longdouble <= 8) 336 if (!identical(obj, ob2, ignore.environment = TRUE, ignore.bytecode = TRUE, 337 ignore.srcref = TRUE)) { 338 ae <- all.equal(obj, ob2, tolerance = eq.tol, check.environment = FALSE) 339 if (is.na(match(oNam, not.identical.ldouble))) { 340 ae.txt <- "all.equal(*,*, tol = ..)" 341 cat("not identical(*, ignore.env=T),", if (isTRUE(ae)) 342 paste("but", ae.txt), "\n") 343 } 344 if (!isTRUE(ae)) 345 stop("Not equal: ", ae.txt, paste(c(" giving", head(ae, 346 2), if (length(ae) > 2) "...."), collapse = "\n ")) 347 } 348 if (!is.language(obj)) { 349 ob2. <- eval(obj) 350 } 351 if (show || !is.list(obj)) { 352 cat(" --> checking list(*): ") 353 check_EPD(list(.chk = obj), show = FALSE, oNam = oNam, 354 eq.tol = eq.tol) 355 cat("Ok\n") 356 } 357 invisible(obj) 358}) 359 --> checking list(*): Ok 360checking formals(.): 361as.pairlist(alist(obj = , show = quote(!hasReal(obj)), oNam = quote(deparse(substitute(obj))), control = quote(c("keepInteger", 362 "showAttributes", "keepNA")), not.identical.ldouble = quote(if (!interactive()) c("t1", 363 "t2", "ydata")), eq.tol = quote(if (noLdbl) 2 * .Machine$double.eps else 0))) 364__ not parse()able __: hasMissObj(.) is true 365--=--=--=--=-- 366dPut: function (x, control = "all") 367dput(x, control = control) 368 --> checking list(*): Ok 369checking body(.): 370quote(dput(x, control = control)) 371 --> checking list(*): Ok 372checking formals(.): 373as.pairlist(alist(x = , control = "all")) 374__ not parse()able __: hasMissObj(.) is true 375--=--=--=--=-- 376dn: list(c("A", "B", "C"), c("a", "b", "c", "d", "e")) 377 --> checking list(*): Ok 378--=--=--=--=-- 379e: new("ngCMatrix", i = integer(0), p = c(0L, 0L, 0L, 0L, 0L, 0L, 3800L), Dim = c(4L, 6L), Dimnames = list(NULL, NULL), factors = list()) 381 --> checking list(*): Ok 382--=--=--=--=-- 383hasMissObj: function (obj) 384{ 385 if (is.recursive(obj)) { 386 if (is.function(obj) || is.language(obj)) 387 FALSE 388 else any(vapply(obj, hasMissObj, NA)) 389 } 390 else isMissObj(obj) 391} 392 --> checking list(*): Ok 393checking body(.): 394quote({ 395 if (is.recursive(obj)) { 396 if (is.function(obj) || is.language(obj)) 397 FALSE 398 else any(vapply(obj, hasMissObj, NA)) 399 } 400 else isMissObj(obj) 401}) 402 --> checking list(*): Ok 403checking formals(.): 404as.pairlist(alist(obj = )) 405__ not parse()able __: hasMissObj(.) is true 406--=--=--=--=-- 407hasReal: function (x) 408{ 409 if (is.double(x) || is.complex(x)) 410 !all((x == round(x, 3)) | is.na(x)) 411 else if (is.logical(x) || is.integer(x) || is.symbol(x) || 412 is.call(x) || is.environment(x) || is.character(x)) 413 FALSE 414 else if (is.recursive(x)) 415 any(vapply(x, hasReal, NA)) 416 else if (isS4(x)) { 417 if (length(sn <- slotNames(x))) 418 any(vapply(sn, function(s) hasReal(slot(x, s)), NA)) 419 else FALSE 420 } 421 else FALSE 422} 423 --> checking list(*): Ok 424checking body(.): 425quote({ 426 if (is.double(x) || is.complex(x)) 427 !all((x == round(x, 3)) | is.na(x)) 428 else if (is.logical(x) || is.integer(x) || is.symbol(x) || 429 is.call(x) || is.environment(x) || is.character(x)) 430 FALSE 431 else if (is.recursive(x)) 432 any(vapply(x, hasReal, NA)) 433 else if (isS4(x)) { 434 if (length(sn <- slotNames(x))) 435 any(vapply(sn, function(s) hasReal(slot(x, s)), NA)) 436 else FALSE 437 } 438 else FALSE 439}) 440 --> checking list(*): Ok 441checking formals(.): 442as.pairlist(alist(x = )) 443__ not parse()able __: hasMissObj(.) is true 444--=--=--=--=-- 445i: c(1, 3, 4, 5, 6, 7, 8) 446 --> checking list(*): Ok 447--=--=--=--=-- 448id_epd: function (expr, control = "all", ...) 449eval(pd0(expr, control = control, ...)) 450 --> checking list(*): Ok 451checking body(.): 452quote(eval(pd0(expr, control = control, ...))) 453 --> checking list(*): Ok 454checking formals(.): 455as.pairlist(alist(expr = , control = "all", ... = )) 456__ not parse()able __: hasMissObj(.) is true 457--=--=--=--=-- 458isMissObj: function (obj) 459identical(obj, alist(a = )[[1]]) 460 --> checking list(*): Ok 461checking body(.): 462quote(identical(obj, alist(a = )[[1]])) 463 --> checking list(*): Ok 464checking formals(.): 465as.pairlist(alist(obj = )) 466__ not parse()able __: hasMissObj(.) is true 467--=--=--=--=-- 468j: c(2, 9, 6, 7, 8, 9, 10) 469 --> checking list(*): Ok 470--=--=--=--=-- 471l3: structure(c(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, 472FALSE), .Dim = c(3L, 3L)) 473 --> checking list(*): Ok 474--=--=--=--=-- 475l3s: new("lgCMatrix", i = c(0L, 0L, 1L), p = c(0L, 0L, 1L, 3L), Dim = c(3L, 4763L), Dimnames = list(NULL, NULL), x = c(TRUE, TRUE, TRUE), factors = list()) 477 --> checking list(*): Ok 478--=--=--=--=-- 479m: new("dgCMatrix", i = c(2L, 0L, 1L, 2L, 0L, 1L), p = c(0L, 1L, 4802L, 4L, 4L, 6L), Dim = c(3L, 5L), Dimnames = list(c("A", "B", 481"C"), c("a", "b", "c", "d", "e")), x = c(1, 2, 4, 3, 6, 5), factors = list()) 482 --> checking list(*): Ok 483--=--=--=--=-- 484n: new("ngCMatrix", i = 5:0, p = c(0L, 0L, 1L, 2L, 3L, 4L, 5L, 6L 485), Dim = 6:7, Dimnames = list(NULL, NULL), factors = list()) 486 --> checking list(*): Ok 487--=--=--=--=-- 488nA: new("ngCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 4890L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L), Dim = c(8L, 10L), Dimnames = list( 490 NULL, NULL), factors = list()) 491 --> checking list(*): Ok 492--=--=--=--=-- 493pd0: function (expr, backtick = TRUE, ...) 494parse(text = deparse(expr, backtick = backtick, ...)) 495 --> checking list(*): Ok 496checking body(.): 497quote(parse(text = deparse(expr, backtick = backtick, ...))) 498 --> checking list(*): Ok 499checking formals(.): 500as.pairlist(alist(expr = , backtick = TRUE, ... = )) 501__ not parse()able __: hasMissObj(.) is true 502--=--=--=--=-- 503perm: c(1L, 4L, 7L, 2L, 5L, 3L, 6L) 504 --> checking list(*): Ok 505--=--=--=--=-- 506runEPD_checks: function (env = .GlobalEnv) 507{ 508 stopifnot(is.environment(env)) 509 for (nm in ls(envir = env)) { 510 cat(nm, ": ", sep = "") 511 x <- env[[nm]] 512 check_EPD(x, oNam = nm) 513 if (is.function(x) && !inherits(x, "classGeneratorFunction")) { 514 cat("checking body(.):\n") 515 check_EPD(if (is.language(bx <- body(x))) 516 removeSource(bx) 517 else bx) 518 cat("checking formals(.):\n") 519 check_EPD(formals(x)) 520 } 521 cat("--=--=--=--=--\n") 522 } 523} 524 --> checking list(*): Ok 525checking body(.): 526quote({ 527 stopifnot(is.environment(env)) 528 for (nm in ls(envir = env)) { 529 cat(nm, ": ", sep = "") 530 x <- env[[nm]] 531 check_EPD(x, oNam = nm) 532 if (is.function(x) && !inherits(x, "classGeneratorFunction")) { 533 cat("checking body(.):\n") 534 check_EPD(if (is.language(bx <- body(x))) 535 removeSource(bx) 536 else bx) 537 cat("checking formals(.):\n") 538 check_EPD(formals(x)) 539 } 540 cat("--=--=--=--=--\n") 541 } 542}) 543 --> checking list(*): Ok 544checking formals(.): 545pairlist(env = quote(.GlobalEnv)) 546 --> checking list(*): Ok 547--=--=--=--=-- 548sA: new("dsCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 5490L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L), Dim = c(10L, 10L), Dimnames = list( 550 NULL, NULL), x = c(7, 21, 28, 35, 14, 42, 49), uplo = "U", 551 factors = list()) 552 --> checking list(*): Ok 553--=--=--=--=-- 554sy: new("dsCMatrix", i = c(1L, 3L, 4L, 2L, 3L), p = c(0L, 0L, 0L, 5550L, 1L, 3L, 4L, 5L), Dim = c(7L, 7L), Dimnames = list(NULL, NULL), 556 x = c(1, 4, 5, 3, 2), uplo = "U", factors = list()) 557 --> checking list(*): Ok 558--=--=--=--=-- 559tA: new("dtCMatrix", i = c(0L, 3L, 4L, 5L, 2L, 6L, 7L), p = c(0L, 5600L, 1L, 1L, 1L, 1L, 2L, 3L, 4L, 6L, 7L), Dim = c(10L, 10L), Dimnames = list( 561 NULL, NULL), x = c(7, 21, 28, 35, 14, 42, 49), uplo = "U", 562 diag = "N") 563 --> checking list(*): Ok 564--=--=--=--=-- 565x: c(7, 14, 21, 28, 35, 42, 49) 566 --> checking list(*): Ok 567--=--=--=--=-- 568z32: new("dgeMatrix", x = c(0, 0, 0, 0, 0, 0), Dim = 3:2, Dimnames = list( 569 NULL, NULL), factors = list()) 570 --> checking list(*): Ok 571--=--=--=--=-- 572> 573> summary(warnings()) 574Length Class Mode 575 0 NULL NULL 576> ## at the very end 577> cat('Time elapsed: ', proc.time(), "\n") 578Time elapsed: 1.452 0.123 1.582 0.002 0.004 579> 580