The R Project SVN
R
(root)/branches/R-structure/tests/eval-etc.Rout.save – Rev 81427
Rev 81425 | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
R Under development (unstable) (2022-01-01 r81419) -- "Unsuffered Consequences"Copyright (C) 2022 The R Foundation for Statistical ComputingPlatform: aarch64-apple-darwin21.2.0 (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 etc>> set.seed(2017-08-24) # as we will deparse all objects *and* use *.Rout.save> .proctime00 <- proc.time() # start timing>> ##- From: Peter Dalgaard BSA <p.dalgaard@biostat.ku.dk>> ##- Subject: Re: source() / eval() bug ??? (PR#96)> ##- Date: 20 Jan 1999 14:56:24 +0100> e1 <- parse(text='c(F=(f <- .3), "Tail area" = 2 * if(f < 1) 30 else 90)')[[1]]> e1c(F = (f <- 0.3), `Tail area` = 2 * if (f < 1) 30 else 90)> str(eval(e1))Named num [1:2] 0.3 60- attr(*, "names")= chr [1:2] "F" "Tail area"> mode(e1)[1] "call">> ( e2 <- quote(c(a=1,b=2)) )c(a = 1, b = 2)> names(e2)[2] <- "a b c"> e2c(`a b c` = 1, b = 2)> parse(text=deparse(e2))expression(c(`a b c` = 1, b = 2))>> ##- From: Peter Dalgaard BSA <p.dalgaard@biostat.ku.dk>> ##- Date: 22 Jan 1999 11:47>> ( e3 <- quote(c(F=1,"tail area"=pf(1,1,1))) )c(F = 1, `tail area` = pf(1, 1, 1))> eval(e3)F tail area1.0 0.5> names(e3)[1] "" "F" "tail area">> names(e3)[2] <- "Variance ratio"> e3c(`Variance ratio` = 1, `tail area` = pf(1, 1, 1))> eval(e3)Variance ratio tail area1.0 0.5>>> ##- From: Peter Dalgaard BSA <p.dalgaard@biostat.ku.dk>> ##- Date: 2 Sep 1999>> ## The first failed in 0.65.0 :> attach(list(x=1))> evalq(dim(x) <- 1,as.environment(2))> dput(get("x", envir=as.environment(2)), control="all")structure(1, dim = 1L)>> e <- local({x <- 1;environment()})> evalq(dim(x) <- 1,e)> dput(get("x",envir=e), control="all")structure(1, dim = 1L)>> ### Substitute, Eval, Parse, etc>> ## PR#3 : "..." matching> ## Revised March 7 2001 -pd> A <- function(x, y, ...) {+ B <- function(a, b, ...) { match.call() }+ B(x+y, ...)+ }> (aa <- A(1,2,3))B(a = x + y, b = 3)> all.equal(as.list(aa),+ list(as.name("B"), a = expression(x+y)[[1]], b = 3))[1] TRUE> (a2 <- A(1,2, named = 3)) #A(1,2, named = 3)B(a = x + y, named = 3)> all.equal(as.list(a2),+ list(as.name("B"), a = expression(x+y)[[1]], named = 3))[1] TRUE>> CC <- function(...) match.call()> DD <- function(...) CC(...)> a3 <- DD(1,2,3)> all.equal(as.list(a3),+ list(as.name("CC"), 1, 2, 3))[1] TRUE>> ## More dots issues: March 19 2001 -pd> ## Didn't work up to and including 1.2.2>> f <- function(...) {+ val <- match.call(expand.dots=FALSE)$...+ x <- val[[1]]+ eval.parent(substitute(missing(x)))+ }> g <- function(...) h(f(...))> h <- function(...) list(...)> k <- function(...) g(...)> X <- k(a=)> all.equal(X, list(TRUE))[1] TRUE>> ## Bug PR#24> f <- function(x,...) substitute(list(x,...))> deparse(f(a, b)) == "list(a, b)" &&+ deparse(f(b, a)) == "list(b, a)" &&+ deparse(f(x, y)) == "list(x, y)" &&+ deparse(f(y, x)) == "list(y, x)"[1] TRUE>> tt <- function(x) { is.vector(x); deparse(substitute(x)) }> a <- list(b=3); tt(a$b) == "a$b" # tends to break when ...[1] TRUE>>> ## Parser:> 1 <+ 2[1] TRUE> 2 <=+ 3[1] TRUE> 4 >=+ 3[1] TRUE> 3 >+ 2[1] TRUE> 2 ==+ 2[1] TRUE> ## bug till ...> 1 !=+ 3[1] TRUE>> all(NULL == NULL)[1] TRUE>> ## PR #656 (related)> u <- runif(1); length(find(".Random.seed")) == 1[1] TRUE>> MyVaR <<- "val";length(find("MyVaR")) == 1[1] TRUE> rm(MyVaR); length(find("MyVaR")) == 0[1] TRUE>>> ## Martin Maechler: rare bad bug in sys.function() {or match.arg()} (PR#1409)> callme <- function(a = 1, mm = c("Abc", "Bde")) {+ mm <- match.arg(mm); cat("mm = "); str(mm) ; invisible()+ }> ## The first two were as desired:> callme()mm = chr "Abc"> callme(mm="B")mm = chr "Bde"> mycaller <- function(x = 1, callme = pi) { callme(x) }> mycaller()## wrongly gave `mm = NULL' now = "Abc"mm = chr "Abc">> CO <- utils::capture.output>> ## Garbage collection protection problem:> if(FALSE) ## only here to be run as part of 'make test-Gct'+ gctorture() # <- for manual testing> x <- c("a", NA, "b")> fx <- factor(x, exclude="")> ST <- if(interactive()) system.time else invisible> ST(r <- replicate(20, CO(print(fx))))> table(r[2,]) ## the '<NA>' levels part would be wrong occasionallyLevels: a b <NA>20> stopifnot(r[2,] == "Levels: a b <NA>") # in case of failure, see r[2,] above>>> ## withAutoprint() : must *not* evaluate twice *and* do it in calling environment:> stopifnot(+ identical(+ ## ensure it is only evaluated _once_ :+ CO(withAutoprint({ x <- 1:2; cat("x=",x,"\n") }))[1],+ paste0(getOption("prompt"), "x <- 1:2"))+ ,+ ## need "enough" deparseCtrl for this:+ grepl("1L, NA_integer_", CO(withAutoprint(x <- c(1L, NA_integer_, NA))))+ ,+ identical(CO(r1 <- withAutoprint({ formals(withAutoprint); body(withAutoprint) })),+ CO(r2 <- source(expr = list(quote(formals(withAutoprint)),+ quote(body(withAutoprint)) ),+ echo=TRUE))),+ identical(r1,r2)+ )> ## partly failed in R 3.4.0 alpha> rm(CO) # as its deparse() depends on if utils was installed w/ keep.source.pkgs=TRUE>> 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")>> library(stats)> ## some more "critical" cases> nmdExp <- expression(e1 = sin(pi), e2 = cos(-pi))> xn <- setNames(3.5^(1:3), paste0("3½^",1:3)) # 3.5: so have 'show'> ## "" in names :> x0 <- xn; names(x0)[2] <- ""> en0 <- setNames(0L, "")> en12 <- setNames(1:2, c("",""))> en24 <- setNames(2:4, c("two","","vier"))> enx0 <- `storage.mode<-`(en0, "double")> enx12 <- `storage.mode<-`(en12,"double")> enx24 <- `storage.mode<-`(en24,"double")> L1 <- list(c(A="Txt"))> L2 <- list(el = c(A=2.5))> ## "m:n" named integers and _inside list_> i6 <- setNames(5:6, letters[5:6])> L4 <- list(ii = 5:2) # not named> L6 <- list(L = i6)> L6a <- list(L = structure(rev(i6), myDoc = "info"))> ## these must use structure() to keep NA_character_ name:> LNA <- setNames(as.list(c(1,2,99)), c("A", "NA", NA))> iNA <- unlist(LNA)> missL <- setNames(rep(list(alist(.=)$.), 3), c("",NA,"c"))> ## empty *named* atomic vectors> i00 <- setNames(integer(), character()); i0 <- structure(i00, foo = "bar")> L00 <- setNames(logical(), character()); L0 <- structure(L00, class = "Logi")> r00 <- setNames(raw(), character())> sii <- structure(4:7, foo = list(B="bar", G="grizzly",+ vec=c(a=1L,b=2L), v2=i6, v0=L00))> fm <- y ~ f(x)> lf <- list(ff = fm, osf = ~ sin(x))> stopifnot(identical(deparse(lf, control="all"), # no longer quote()s+ deparse(lf)))Warning message:In deparse(lf, control = "all") : deparse may be incomplete> abc <- setNames(letters[1:4], c("one", "recursive", "use.names", "four"))> r13 <- i13 <- setNames(1:3, names(abc)[3:1]); mode(r13) <- "double"> if(getRversion() >= "3.5.0") {+ ## Creating a collection of S4 objects, ensuring deparse <-> parse are inverses+ library(methods)+ example(new) # creating t1 & t2 at least+ ## an S4 object of type "list" of "mp1" objects [see pkg 'Rmpfr']:+ setClass("mp1", slots = c(prec = "integer", d = "integer"))+ setClass("mp", contains = "list", ## of "mp" entries:+ validity = function(object) {+ if(all(vapply(object@.Data, class, "") == "mp1"))+ return(TRUE)+ ## else+ "Not all components are of class 'mp'"+ })+ validObject(m0 <- new("mp"))+ validObject(m1 <- new("mp", list(new("mp1"), new("mp1", prec=1L, d = 3:5))))+ typeof(m1)# "list", not "S4"+ dput(m1) # now *is* correct -- will be check_EPD()ed below+ ##+ mList <- setClass("mList", contains = "list")+ mForm <- setClass("mForm", contains = "formula")+ mExpr <- setClass("mExpr", contains = "expression")+ ## more to come+ attrS4 <- function(x)+ c(S4 = isS4(x), obj= is.object(x), type.S4 = typeof(x) == "S4")+ attrS4(ml <- mList(list(1, letters[1:3])))# use *unnamed* list+ attrS4(mf <- mForm( ~ f(x)))+ attrS4(E2 <- mExpr(expression(x^2)))+ ## Now works, but fails for deparse(*, control="all"): __FIXME__+ stopifnot(identical(mf, eval(parse(text=deparse(mf)))))+ ##+ }# S4 deparse()ing only since R 3.5.0new> ## using the definition of class "track" from setClassnew>new> ## Don't show:new> setClass("track", slots = c(x="numeric", y="numeric"))new> setClass("trackCurve", contains = "track",new+ slots = c(smooth = "numeric"))new> ydata <- stats::rnorm(10); ysmooth <- 1:10new> ## End(Don't show)new>new> ## a new object with two slots specifiednew> t1 <- new("track", x = seq_along(ydata), y = ydata)new> # a new object including an object from a superclass, plus a slotnew> t2 <- new("trackCurve", t1, smooth = ysmooth)new> ### define a method for initialize, to ensure that new objects havenew> ### equal-length x and y slots. In this version, the slots must still benew> ### supplied by name.new>new> setMethod("initialize", "track",new+ function(.Object, ...) {new+ .Object <- callNextMethod()new+ if(length(.Object@x) != length(.Object@y))new+ stop("specified x and y of different lengths")new+ .Objectnew+ })new> ### An alternative version that allows x and y to be suppliednew> ### unnamed. A still more friendly version would make the default xnew> ### a vector of the same length as y, and vice versa.new>new> setMethod("initialize", "track",new+ function(.Object, x = numeric(0), y = numeric(0), ...) {new+ .Object <- callNextMethod(.Object, ...)new+ if(length(x) != length(y))new+ stop("specified x and y of different lengths")new+ .Object@x <- xnew+ .Object@y <- ynew+ .Objectnew+ })new> ## Don't show:new> removeMethod("initialize", "track")[1] TRUEnew> ## End(Don't show)new>new>new>new("mp", .Data = list(new("mp1", prec = integer(0), d = integer(0)),new("mp1", prec = 1L, d = 3:5)))>> ## Action! Check deparse <--> parse consistency for *all* objects:> runEPD_checks()A: function (x, y, ...){B <- function(a, b, ...) {match.call()}B(x + y, ...)}--> checking list(*): Okchecking body(.):quote({B <- function(a, b, ...) {match.call()}B(x + y, ...)})--> checking list(*): Okchecking formals(.):as.pairlist(alist(x = , y = , ... = ))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--CC: function (...)match.call()--> checking list(*): Okchecking body(.):quote(match.call())--> checking list(*): Okchecking formals(.):as.pairlist(alist(... = ))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--DD: function (...)CC(...)--> checking list(*): Okchecking body(.):quote(CC(...))--> checking list(*): Okchecking formals(.):as.pairlist(alist(... = ))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--E2: new("mExpr", .Data = expression(x^2))--> checking list(*): Ok--=--=--=--=--L0: structure(logical(0), names = character(0), class = "Logi")--> checking list(*): Ok--=--=--=--=--L00: structure(logical(0), names = character(0))--> checking list(*): Ok--=--=--=--=--L1: list(c(A = "Txt"))--> checking list(*): Ok--=--=--=--=--L2: list(el = c(A = 2.5))--> checking list(*): Ok--=--=--=--=--L4: list(ii = 5:2)--> checking list(*): Ok--=--=--=--=--L6: list(L = structure(5:6, names = c("e", "f")))--> checking list(*): Ok--=--=--=--=--L6a: list(L = structure(6:5, names = c("f", "e"), myDoc = "info"))--> checking list(*): Ok--=--=--=--=--LNA: structure(list(1, 2, 99), names = c("A", "NA", NA))--> checking list(*): Ok--=--=--=--=--ST: .Primitive("invisible")--> checking list(*): Okchecking body(.):NULL--> checking list(*): Okchecking formals(.):NULL--> checking list(*): Ok--=--=--=--=--X: list(TRUE)--> checking list(*): Ok--=--=--=--=--a: list(b = 3)--> checking list(*): Ok--=--=--=--=--a2: quote(B(a = x + y, named = 3))--> checking list(*): Ok--=--=--=--=--a3: quote(CC(1, 2, 3))--> checking list(*): Ok--=--=--=--=--aa: quote(B(a = x + y, b = 3))--> checking list(*): Ok--=--=--=--=--abc: structure(c("a", "b", "c", "d"), names = c("one", "recursive","use.names", "four"))--> checking list(*): Ok--=--=--=--=--attrS4: function (x)c(S4 = isS4(x), obj = is.object(x), type.S4 = typeof(x) == "S4")--> checking list(*): Okchecking body(.):quote(c(S4 = isS4(x), obj = is.object(x), type.S4 = typeof(x) =="S4"))--> checking list(*): Okchecking formals(.):as.pairlist(alist(x = ))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--callme: function (a = 1, mm = c("Abc", "Bde")){mm <- match.arg(mm)cat("mm = ")str(mm)invisible()}--> checking list(*): Okchecking body(.):quote({mm <- match.arg(mm)cat("mm = ")str(mm)invisible()})--> checking list(*): Okchecking formals(.):pairlist(a = 1, mm = quote(c("Abc", "Bde")))--> 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, check.environment = FALSE)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(*): Okchecking 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, check.environment = FALSE)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(*): Okchecking 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(*): Okchecking body(.):quote(dput(x, control = control))--> checking list(*): Okchecking formals(.):as.pairlist(alist(x = , control = "all"))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--e: <environment>__ not parse()able __: environment--=--=--=--=--e1: quote(c(F = (f <- 0.29999999999999999), `Tail area` = 2 * if (f <1) 30 else 90))--> checking list(*): Ok--=--=--=--=--e2: quote(c(`a b c` = 1, b = 2))--> checking list(*): Ok--=--=--=--=--e3: quote(c(`Variance ratio` = 1, `tail area` = pf(1, 1, 1)))--> checking list(*): Ok--=--=--=--=--en0: structure(0L, names = "")--> checking list(*): Ok--=--=--=--=--en12: structure(1:2, names = c("", ""))--> checking list(*): Ok--=--=--=--=--en24: structure(2:4, names = c("two", "", "vier"))--> checking list(*): Ok--=--=--=--=--enx0: structure(0, names = "")--> checking list(*): Ok--=--=--=--=--enx12: structure(c(1, 2), names = c("", ""))--> checking list(*): Ok--=--=--=--=--enx24: c(two = 2, 3, vier = 4)--> checking list(*): Ok--=--=--=--=--f: function (x, ...)substitute(list(x, ...))--> checking list(*): Okchecking body(.):quote(substitute(list(x, ...)))--> checking list(*): Okchecking formals(.):as.pairlist(alist(x = , ... = ))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--fm: y ~ f(x)not identical(*, ignore.env=T), but all.equal(*,*, tol = ..)--> checking list(*): not identical(*, ignore.env=T), but all.equal(*,*, tol = ..)Ok--=--=--=--=--fx: structure(c(1L, 3L, 2L), levels = c("a", "b", NA), class = "factor")--> checking list(*): Ok--=--=--=--=--g: function (...)h(f(...))--> checking list(*): Okchecking body(.):quote(h(f(...)))--> checking list(*): Okchecking formals(.):as.pairlist(alist(... = ))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--h: function (...)list(...)--> checking list(*): Okchecking body(.):quote(list(...))--> checking list(*): Okchecking formals(.):as.pairlist(alist(... = ))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--hasMissObj: function (obj){if (is.recursive(obj)) {if (is.function(obj) || is.language(obj))FALSEelse any(vapply(obj, hasMissObj, NA))}else isMissObj(obj)}--> checking list(*): Okchecking body(.):quote({if (is.recursive(obj)) {if (is.function(obj) || is.language(obj))FALSEelse any(vapply(obj, hasMissObj, NA))}else isMissObj(obj)})--> checking list(*): Okchecking 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))FALSEelse 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(*): Okchecking 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))FALSEelse 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(*): Okchecking formals(.):as.pairlist(alist(x = ))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--i0: structure(integer(0), names = character(0), foo = "bar")--> checking list(*): Ok--=--=--=--=--i00: structure(integer(0), names = character(0))--> checking list(*): Ok--=--=--=--=--i13: structure(1:3, names = c("use.names", "recursive", "one"))--> checking list(*): Ok--=--=--=--=--i6: structure(5:6, names = c("e", "f"))--> checking list(*): Ok--=--=--=--=--iNA: structure(c(1, 2, 99), names = c("A", "NA", NA))--> checking list(*): Ok--=--=--=--=--id_epd: function (expr, control = "all", ...)eval(pd0(expr, control = control, ...))--> checking list(*): Okchecking body(.):quote(eval(pd0(expr, control = control, ...)))--> checking list(*): Okchecking formals(.):as.pairlist(alist(expr = , control = "all", ... = ))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--isMissObj: function (obj)identical(obj, alist(a = )[[1]])--> checking list(*): Okchecking body(.):quote(identical(obj, alist(a = )[[1]]))--> checking list(*): Okchecking formals(.):as.pairlist(alist(obj = ))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--k: function (...)g(...)--> checking list(*): Okchecking body(.):quote(g(...))--> checking list(*): Okchecking formals(.):as.pairlist(alist(... = ))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--lf: list(ff = y ~ f(x), osf = ~sin(x))not identical(*, ignore.env=T), but all.equal(*,*, tol = ..)--> checking list(*): not identical(*, ignore.env=T), but all.equal(*,*, tol = ..)Ok--=--=--=--=--m0: new("mp", .Data = list())--> checking list(*): Ok--=--=--=--=--m1: new("mp", .Data = list(new("mp1", prec = integer(0), d = integer(0)),new("mp1", prec = 1L, d = 3:5)))--> checking list(*): Ok--=--=--=--=--mExpr: new("classGeneratorFunction", .Data = function (...)new("mExpr", ...), className = structure("mExpr", package = ".GlobalEnv"),package = ".GlobalEnv")not identical(*, ignore.env=T), but all.equal(*,*, tol = ..)--> checking list(*): not identical(*, ignore.env=T), but all.equal(*,*, tol = ..)Ok--=--=--=--=--mForm: new("classGeneratorFunction", .Data = function (...)new("mForm", ...), className = structure("mForm", package = ".GlobalEnv"),package = ".GlobalEnv")not identical(*, ignore.env=T), but all.equal(*,*, tol = ..)--> checking list(*): not identical(*, ignore.env=T), but all.equal(*,*, tol = ..)Ok--=--=--=--=--mList: new("classGeneratorFunction", .Data = function (...)new("mList", ...), className = structure("mList", package = ".GlobalEnv"),package = ".GlobalEnv")not identical(*, ignore.env=T), but all.equal(*,*, tol = ..)--> checking list(*): not identical(*, ignore.env=T), but all.equal(*,*, tol = ..)Ok--=--=--=--=--mf: new("mForm", .S3Class = "formula", ~f(x))not identical(*, ignore.env=T), but all.equal(*,*, tol = ..)--> checking list(*): not identical(*, ignore.env=T), but all.equal(*,*, tol = ..)Ok--=--=--=--=--missL: structure(list(, , ), names = c("", NA, "c"))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--ml: new("mList", .Data = list(1, c("a", "b", "c")))--> checking list(*): Ok--=--=--=--=--mycaller: function (x = 1, callme = pi){callme(x)}--> checking list(*): Okchecking body(.):quote({callme(x)})--> checking list(*): Okchecking formals(.):pairlist(x = 1, callme = quote(pi))--> checking list(*): Ok--=--=--=--=--nmdExp: expression(e1 = sin(pi), e2 = cos(-pi))--> checking list(*): Ok--=--=--=--=--pd0: function (expr, backtick = TRUE, ...)parse(text = deparse(expr, backtick = backtick, ...))--> checking list(*): Okchecking body(.):quote(parse(text = deparse(expr, backtick = backtick, ...)))--> checking list(*): Okchecking formals(.):as.pairlist(alist(expr = , backtick = TRUE, ... = ))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--r: structure(c("[1] a <NA> b ", "Levels: a b <NA>", "[1] a <NA> b ","Levels: a b <NA>", "[1] a <NA> b ", "Levels: a b <NA>","[1] a <NA> b ", "Levels: a b <NA>", "[1] a <NA> b ","Levels: a b <NA>", "[1] a <NA> b ", "Levels: a b <NA>","[1] a <NA> b ", "Levels: a b <NA>", "[1] a <NA> b ","Levels: a b <NA>", "[1] a <NA> b ", "Levels: a b <NA>","[1] a <NA> b ", "Levels: a b <NA>", "[1] a <NA> b ","Levels: a b <NA>", "[1] a <NA> b ", "Levels: a b <NA>","[1] a <NA> b ", "Levels: a b <NA>", "[1] a <NA> b ","Levels: a b <NA>", "[1] a <NA> b ", "Levels: a b <NA>","[1] a <NA> b ", "Levels: a b <NA>", "[1] a <NA> b ","Levels: a b <NA>", "[1] a <NA> b ", "Levels: a b <NA>","[1] a <NA> b ", "Levels: a b <NA>", "[1] a <NA> b ","Levels: a b <NA>"), dim = c(2L, 20L))--> checking list(*): Ok--=--=--=--=--r00: structure(raw(0), names = character(0))--> checking list(*): Ok--=--=--=--=--r1: list(value = quote({if (!evaluated) {exprs <- substitute(exprs)if (is.call(exprs)) {if (exprs[[1]] == quote(`{`))exprs <- as.list(exprs[-1])}}source(exprs = exprs, local = local, print.eval = print.,echo = echo, max.deparse.length = max.deparse.length,width.cutoff = width.cutoff, deparseCtrl = deparseCtrl,...)}), visible = TRUE)--> checking list(*): Ok--=--=--=--=--r13: structure(c(1, 2, 3), names = c("use.names", "recursive", "one"))--> checking list(*): Ok--=--=--=--=--r2: list(value = quote({if (!evaluated) {exprs <- substitute(exprs)if (is.call(exprs)) {if (exprs[[1]] == quote(`{`))exprs <- as.list(exprs[-1])}}source(exprs = exprs, local = local, print.eval = print.,echo = echo, max.deparse.length = max.deparse.length,width.cutoff = width.cutoff, deparseCtrl = deparseCtrl,...)}), visible = TRUE)--> 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(*): Okchecking 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(*): Okchecking formals(.):pairlist(env = quote(.GlobalEnv))--> checking list(*): Ok--=--=--=--=--sii: structure(4:7, foo = list(B = "bar", G = "grizzly", vec = structure(1:2, names = c("a","b")), v2 = structure(5:6, names = c("e", "f")), v0 = structure(logical(0), names = character(0))))--> checking list(*): Ok--=--=--=--=--t1: --> checking list(*): Ok--=--=--=--=--t2: --> checking list(*): Ok--=--=--=--=--tt: function (x){is.vector(x)deparse(substitute(x))}--> checking list(*): Okchecking body(.):quote({is.vector(x)deparse(substitute(x))})--> checking list(*): Okchecking formals(.):as.pairlist(alist(x = ))__ not parse()able __: hasMissObj(.) is true--=--=--=--=--u: --> checking list(*): Ok--=--=--=--=--x: c(1L, NA, NA)--> checking list(*): Ok--=--=--=--=--x0: c(`3½^1` = 3.5, 12.25, `3½^3` = 42.875)--> checking list(*): Ok--=--=--=--=--xn: c(`3½^1` = 3.5, `3½^2` = 12.25, `3½^3` = 42.875)--> checking list(*): Ok--=--=--=--=--ydata: --> checking list(*): Ok--=--=--=--=--ysmooth: 1:10--> checking list(*): Ok--=--=--=--=--Warning messages:1: In dput(x, control = control) : deparse may be incomplete2: In dput(x, control = control) : deparse may be incomplete3: In deparse(expr, backtick = backtick, ...) : deparse may be incomplete4: In deparse(expr, backtick = backtick, ...) : deparse may be incomplete5: In dput(x, control = control) : deparse may be incomplete6: In deparse(expr, backtick = backtick, ...) : deparse may be incomplete7: In deparse(expr, backtick = backtick, ...) : deparse may be incomplete8: In dput(x, control = control) : deparse may be incomplete9: In deparse(expr, backtick = backtick, ...) : deparse may be incomplete10: In deparse(expr, backtick = backtick, ...) : deparse may be incomplete>> summary(warnings())Summary of (a total of 10) warning messages:4x : In dput(x, control = control) : deparse may be incomplete6x : In deparse(expr, backtick = backtick, ...) : deparse may be incomplete> ## "dput may be incomplete"> ## "deparse may be incomplete">>> ## at the very end> cat('Time elapsed: ', proc.time() - .proctime00,'\n')Time elapsed: 0.103 0.006 0.11 0 0>