|
|
@@ -1,5 +1,5 @@ |
|
|
|
|
|
R Under development (unstable) (2017-10-29 r73639) -- "Unsuffered Consequences" |
|
|
R Under development (unstable) (2017-11-09 r73692) -- "Unsuffered Consequences" |
|
|
Copyright (C) 2017 The R Foundation for Statistical Computing |
|
|
Platform: x86_64-pc-linux-gnu (64-bit) |
|
|
|
|
|
@@ -217,6 +217,8 @@ Levels: a b <NA> |
|
|
> id_epd <- function(expr, control = c("all","digits17"), ...) |
|
|
+ eval(pd0(expr, control=control, ...)) |
|
|
> dPut <- function(x, control = c("all","digits17")) dput(x, control=control) |
|
|
> ##' Does 'x' contain "real" numbers |
|
|
> ##' with > 3 digits after "." where deparse may be platform dependent? |
|
|
> hasReal <- function(x) { |
|
|
+ if(is.double(x) || is.complex(x)) |
|
|
+ !all((x == round(x, 3)) | is.na(x)) |
|
|
@@ -234,14 +236,23 @@ Levels: a b <NA> |
|
|
+ else FALSE |
|
|
+ } |
|
|
> isMissObj <- function(obj) identical(obj, alist(a=)[[1]]) |
|
|
> ##' Does 'obj' contain "the missing object" ? |
|
|
> ##' @note defined recursively! |
|
|
> hasMissObj <- function(obj) { |
|
|
+ if(is.recursive(obj)) { |
|
|
+ if(is.function(obj) || is.language(obj)) |
|
|
+ FALSE |
|
|
+ else # incl pairlist()s |
|
|
+ any(vapply(obj, hasMissObj, NA)) |
|
|
+ } else isMissObj(obj) |
|
|
+ } |
|
|
> check_EPD <- function(obj, show = !hasReal(obj), |
|
|
+ eq.tol = if(.Machine$sizeof.longdouble <= 8) # no long-double |
|
|
+ 2*.Machine$double.eps else 0) { |
|
|
+ if(show) dPut(obj) |
|
|
+ if(is.environment(obj) || |
|
|
+ (is.pairlist(obj) && any(vapply(obj, isMissObj, NA)))) |
|
|
+ { |
|
|
+ cat("__ not parse()able __\n") |
|
|
+ if(is.environment(obj) || hasMissObj(obj)) { |
|
|
+ cat("__ not parse()able __:", |
|
|
+ if(is.environment(obj)) "environment" else "hasMissObj(.) is true", "\n") |
|
|
+ return(invisible(obj)) # cannot parse it |
|
|
+ } |
|
|
+ ob2 <- id_epd(obj) |
|
|
@@ -282,16 +293,53 @@ Levels: a b <NA> |
|
|
> 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)) |
|
|
> |
|
|
> ## Creating a collection of S4 objects, ensuring deparse <-> parse are inverses |
|
|
> library(methods) |
|
|
> example(new) # creating t1 & t2 at least |
|
|
> 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 |
|
|
+ if(require("Matrix")) { 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) |
|
|
+ } |
|
|
+ }# S4 deparse()ing only since R 3.5.0 |
|
|
|
|
|
new> ## using the definition of class "track" from setClass |
|
|
new> |
|
|
@@ -345,37 +393,6 @@ new> ## End(Don't show) |
|
|
new> |
|
|
new> |
|
|
new> |
|
|
> if(require("Matrix")) { 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 |
|
|
Trying some Matrix objects, too |
|
|
|
|
|
@@ -513,6 +530,7 @@ Matrix> stopifnot(is(As, "symmetricMatrix"), |
|
|
Matrix+ is(Matrix(0, 3,3), "sparseMatrix"), |
|
|
Matrix+ is(Matrix(FALSE, 1,1), "sparseMatrix")) |
|
|
> |
|
|
> ## Action! Check deparse <--> parse consistency for *all* objects: |
|
|
> for(nm in ls(env=.GlobalEnv)) { |
|
|
+ cat(nm,": ", sep="") |
|
|
+ ## if(!any(nm == "r1")) ## 'r1' fails |
|
|
@@ -567,7 +585,7 @@ quote(match.call()) |
|
|
--> checking list(*): Ok |
|
|
checking formals(.): |
|
|
pairlist(... = ) |
|
|
__ not parse()able __ |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
CO: function (..., file = NULL, append = FALSE, type = c("output", |
|
|
"message"), split = FALSE) |
|
|
@@ -659,7 +677,7 @@ quote({ |
|
|
checking formals(.): |
|
|
pairlist(... = , file = NULL, append = FALSE, type = quote(c("output", |
|
|
"message")), split = FALSE) |
|
|
__ not parse()able __ |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
D5.: new("ddiMatrix", |
|
|
diag = "N", Dim = c(5L, 5L), Dimnames = list( |
|
|
@@ -679,7 +697,7 @@ quote(CC(...)) |
|
|
--> checking list(*): Ok |
|
|
checking formals(.): |
|
|
pairlist(... = ) |
|
|
__ not parse()able __ |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
I3: new("ddiMatrix", |
|
|
diag = "U", Dim = c(3L, 3L), Dimnames = list( |
|
|
@@ -707,6 +725,9 @@ L6: list(L = structure(5:6, .Names = c("e", "f"))) |
|
|
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 |
|
|
--=--=--=--=-- |
|
|
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", |
|
|
@@ -767,9 +788,10 @@ check_EPD: function (obj, show = !hasReal(obj), eq.tol = if (.Machine$sizeof.lon |
|
|
{ |
|
|
if (show) |
|
|
dPut(obj) |
|
|
if (is.environment(obj) || (is.pairlist(obj) && any(vapply(obj, |
|
|
isMissObj, NA)))) { |
|
|
cat("__ not parse()able __\n") |
|
|
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) |
|
|
@@ -802,9 +824,10 @@ checking body(.): |
|
|
quote({ |
|
|
if (show) |
|
|
dPut(obj) |
|
|
if (is.environment(obj) || (is.pairlist(obj) && any(vapply(obj, |
|
|
isMissObj, NA)))) { |
|
|
cat("__ not parse()able __\n") |
|
|
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) |
|
|
@@ -836,7 +859,7 @@ quote({ |
|
|
checking formals(.): |
|
|
pairlist(obj = , show = quote(!hasReal(obj)), eq.tol = quote(if (.Machine$sizeof.longdouble <= |
|
|
8) 2 * .Machine$double.eps else 0)) |
|
|
__ not parse()able __ |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
dPut: function (x, control = c("all", "digits17")) |
|
|
dput(x, control = control) |
|
|
@@ -846,7 +869,7 @@ quote(dput(x, control = control)) |
|
|
--> checking list(*): Ok |
|
|
checking formals(.): |
|
|
pairlist(x = , control = quote(c("all", "digits17"))) |
|
|
__ not parse()able __ |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
dn: list(c("A", "B", "C"), c("a", "b", "c", "d", "e")) |
|
|
--> checking list(*): Ok |
|
|
@@ -874,7 +897,7 @@ quote(substitute(list(x, ...))) |
|
|
--> checking list(*): Ok |
|
|
checking formals(.): |
|
|
pairlist(x = , ... = ) |
|
|
__ not parse()able __ |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
fx: structure(c(1L, 3L, 2L), .Label = c("a", "b", NA), class = "factor") |
|
|
--> checking list(*): Ok |
|
|
@@ -887,7 +910,7 @@ quote(h(f(...))) |
|
|
--> checking list(*): Ok |
|
|
checking formals(.): |
|
|
pairlist(... = ) |
|
|
__ not parse()able __ |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
h: function (...) |
|
|
list(...) |
|
|
@@ -897,7 +920,31 @@ quote(list(...)) |
|
|
--> checking list(*): Ok |
|
|
checking formals(.): |
|
|
pairlist(... = ) |
|
|
__ not parse()able __ |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
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(.): |
|
|
pairlist(obj = ) |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
hasReal: function (x) |
|
|
{ |
|
|
@@ -935,7 +982,7 @@ quote({ |
|
|
--> checking list(*): Ok |
|
|
checking formals(.): |
|
|
pairlist(x = ) |
|
|
__ not parse()able __ |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
i: c(1, 3, 4, 5, 6, 7, 8) |
|
|
--> checking list(*): Ok |
|
|
@@ -949,6 +996,9 @@ i00: structure(integer(0), .Names = character(0)) |
|
|
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 = c("all", "digits17"), ...) |
|
|
eval(pd0(expr, control = control, ...)) |
|
|
--> checking list(*): Ok |
|
|
@@ -957,7 +1007,7 @@ quote(eval(pd0(expr, control = control, ...))) |
|
|
--> checking list(*): Ok |
|
|
checking formals(.): |
|
|
pairlist(expr = , control = quote(c("all", "digits17")), ... = ) |
|
|
__ not parse()able __ |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
isMissObj: function (obj) |
|
|
identical(obj, alist(a = )[[1]]) |
|
|
@@ -967,7 +1017,7 @@ quote(identical(obj, alist(a = )[[1]])) |
|
|
--> checking list(*): Ok |
|
|
checking formals(.): |
|
|
pairlist(obj = ) |
|
|
__ not parse()able __ |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
j: c(2, 9, 6, 7, 8, 9, 10) |
|
|
--> checking list(*): Ok |
|
|
@@ -980,7 +1030,7 @@ quote(g(...)) |
|
|
--> checking list(*): Ok |
|
|
checking formals(.): |
|
|
pairlist(... = ) |
|
|
__ not parse()able __ |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
l3: structure(c(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, |
|
|
FALSE), .Dim = c(3L, 3L)) |
|
|
@@ -992,6 +1042,9 @@ i = c(2L, 0L, 1L, 2L, 0L, 1L), p = c(0L, 1L, |
|
|
"C"), c("a", "b", "c", "d", "e")), x = c(1, 2, 4, 3, 6, 5), factors = list()) |
|
|
--> checking list(*): Ok |
|
|
--=--=--=--=-- |
|
|
missL: structure(list(, , ), .Names = c("", NA, "c")) |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
mycaller: function (x = 1, callme = pi) |
|
|
{ |
|
|
callme(x) |
|
|
@@ -1032,7 +1085,7 @@ quote(parse(text = deparse(expr, backtick = backtick, control = control, |
|
|
checking formals(.): |
|
|
pairlist(expr = , backtick = TRUE, control = quote(c("keepInteger", |
|
|
"showAttributes", "keepNA")), ... = ) |
|
|
__ not parse()able __ |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
perm: c(2L, 3L, 6L, 4L, 1L, 7L, 5L) |
|
|
--> checking list(*): Ok |
|
|
@@ -1128,7 +1181,7 @@ quote({ |
|
|
--> checking list(*): Ok |
|
|
checking formals(.): |
|
|
pairlist(x = ) |
|
|
__ not parse()able __ |
|
|
__ not parse()able __: hasMissObj(.) is true |
|
|
--=--=--=--=-- |
|
|
u: --> checking list(*): Ok |
|
|
--=--=--=--=-- |
|
|
|