SCM

SCM Repository

[matrix] Annotation of /pkg/Matrix/tests/abIndex-tsts.R
ViewVC logotype

Annotation of /pkg/Matrix/tests/abIndex-tsts.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2903 - (view) (download)

1 : mmaechler 2497 #### Testing consistency of "abIndex" == "abstract-indexing vectors" class :
2 :     library(Matrix)
3 :    
4 :     source(system.file("test-tools.R", package = "Matrix"))# identical3() etc
5 :    
6 :     validObject(ab <- new("abIndex"))
7 :     str(ab)
8 :    
9 :     set.seed(1)
10 : mmaechler 2500 ex. <- list(2:1000, 0:10, sample(100), c(-3:40, 20:70),
11 :     c(1:100,77L, 50:40, 10L), c(17L, 3L*(12:3)))
12 : mmaechler 2497 ## we know which kinds will come out: "compressed" for all but random:
13 : mmaechler 2500 rD <- "rleDiff"; kinds <- c(rD,rD,"int32", rD, rD, rD)
14 : mmaechler 2497 isCmpr <- kinds == rD
15 :     ab. <- lapply(ex., as, Class = "abIndex")
16 :     nu. <- lapply(ab., as, Class = "numeric")
17 :     in. <- lapply(ab., as, Class = "integer")
18 :     rles <- lapply(ab.[isCmpr], function(u) u@rleD@rle)
19 :     r.x <- lapply(ex.[isCmpr], function(.) rle(diff(.)))
20 :    
21 :     stopifnot(sapply(ab., validObject),
22 :     identical(ex., nu.),
23 :     identical(ex., in.),
24 :     ## Check that the relevant cases really *are* "compressed":
25 :     sapply(ab., slot, "kind") == kinds,
26 :     ## Using rle(diff(.)) is equivalent to using our C code:
27 : mmaechler 2500 identical(rles, r.x),
28 :     ## Checking Group Methods - "Summary" :
29 :     sapply(ab., range) == sapply(ex., range),
30 :     sapply(ab., any) == sapply(ex., any),
31 :     TRUE)
32 : mmaechler 2497
33 : mmaechler 2507 ## testing c() method, i.e. currently c.abIndex():
34 :     tst.c.abI <- function(lii) {
35 :     stopifnot(is.list(lii),
36 :     all(unlist(lapply(lii, mode)) == "numeric"))
37 :     aii <- lapply(lii, as, "abIndex")
38 :     v.i <- do.call(c, lii)
39 :     a.i <- do.call(c, aii)
40 :     avi <- as(v.i, "abIndex")
41 :     ## identical() is too hard, as values & lengths can be double/integer
42 :     stopifnot(all.equal(a.i, avi, tol = 0))
43 :     }
44 :     tst.c.abI(list(2:6, 70:50, 5:-2))
45 :     ## now an example where *all* are uncompressed:
46 :     tst.c.abI(list(c(5, 3, 2, 4, 7, 1, 6), 3:4, 1:-1))
47 :     ## and one with parts that are already non-trivial:
48 :     exc <- ex.[isCmpr]
49 :     tst.c.abI(exc)
50 :     set.seed(101)
51 :     N <- length(exc) # 5
52 :     for(i in 1:10) {
53 :     tst.c.abI(exc[sample(N, replace=TRUE)])
54 :     tst.c.abI(exc[sample(N, N-1)])
55 :     tst.c.abI(exc[sample(N, N-2)])
56 :     }
57 :    
58 : mmaechler 2497 for(n in 1:120) {
59 :     cat(".")
60 :     k <- 1 + 4*rpois(1, 5) # >= 1
61 :     ## "random" rle -- NB: consecutive values *must* differ (for uniqueness)
62 :     v <- as.integer(1+ 10*rnorm(k))
63 :     while(any(dv <- duplicated(v)))
64 :     v[dv] <- v[dv] + 1L
65 :     rl <- structure(list(lengths = as.integer(1 + rpois(k, 10)), values = v),
66 :     class = "rle")
67 :     ai <- new("abIndex", kind = "rleDiff",
68 :     rleD = new("rleDiff", first = rpois(1, 20), rle = rl))
69 :     validObject(ai)
70 :     ii <- as(ai, "numeric")
71 : mmaechler 2507 iN <- ii; iN[180] <- NA; aiN <- as(iN,"abIndex")
72 :     iN <- as(aiN, "numeric") ## NA from 180 on
73 : mmaechler 2497 stopifnot(is.numeric(ii), ii == round(ii),
74 : mmaechler 2507 identical(ai, as(ii, "abIndex")),
75 :     identical(is.na(ai), is.na(ii)),
76 :     identical(is.na(aiN), is.na(iN)),
77 :     identical(is.finite (aiN), is.finite(iN)),
78 :     identical(is.infinite(aiN), is.infinite(iN))
79 :     )
80 : mmaechler 2497 if(n %% 40 == 0) cat(n,"\n")
81 :     }
82 :    
83 : mmaechler 2507 ## we have : identical(lapply(ex., as, "abIndex"), ab.)
84 :    
85 :     mkStr <- function(ch, n) paste(rep.int(ch, n), collapse="")
86 :    
87 :     ##O for(grMeth in getGroupMembers("Ops")) {
88 :     ##O cat(sprintf("\n%s :\n%s\n", grMeth, mkStr("=", nchar(grMeth))))
89 :     grMeth <- "Arith"
90 :     for(ng in getGroupMembers(grMeth)) {
91 :     cat(ng, ": ")
92 :     G <- get(ng)
93 : mmaechler 2903 t.tol <- if(ng == "/") 1e-12 else 0
94 :     ## "/" with no long double (e.g. on Sparc Solaris): 1.125e-14
95 :     AEq <- function(a,b, ...) assert.EQ(a, b, tol=t.tol, giveRE=TRUE)
96 : mmaechler 2507 for(v in ex.) {
97 :     va <- as(v, "abIndex")
98 : mmaechler 2903 for(s in list(-1, 17L, TRUE, FALSE)) # numeric *and* logical
99 :     if(!((identical(s, FALSE) && ng == "/"))) { ## division by 0 may "fail"
100 :    
101 :     AEq(as(G(v, s), "abIndex"), G(va, s))
102 :     AEq(as(G(s, v), "abIndex"), G(s, va))
103 :     }
104 : mmaechler 2507 cat(".")
105 :     }
106 :     cat(" [Ok]\n")
107 :     }
108 :     ##O }
109 :    
110 : mmaechler 2661 ## check the abIndex versions of indDiag() and indTri() :
111 :     for(n in 1:7)
112 :     stopifnot(isValid(ii <- Matrix:::abIindDiag(n), "abIndex"),
113 :     ii@kind == "rleDiff",
114 :     Matrix:::indDiag(n) == as(ii, "numeric"))
115 :    
116 :     for(n in 0:7)
117 :     for(diag in c(TRUE,FALSE))
118 :     for(upper in c(TRUE,FALSE))
119 :     stopifnot(isValid(ii <- Matrix:::abIindTri(n, diag=diag,upper=upper), "abIndex"),
120 :     Matrix:::indTri(n, diag=diag,upper=upper) == as(ii, "numeric"))
121 :    
122 : mmaechler 2497 cat('Time elapsed: ', (.pt <- proc.time()),'\n') # "stats"

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge