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 2500 - (view) (download)
Original Path: pkg/tests/abIndex-tsts.R

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 :     for(n in 1:120) {
34 :     cat(".")
35 :     k <- 1 + 4*rpois(1, 5) # >= 1
36 :     ## "random" rle -- NB: consecutive values *must* differ (for uniqueness)
37 :     v <- as.integer(1+ 10*rnorm(k))
38 :     while(any(dv <- duplicated(v)))
39 :     v[dv] <- v[dv] + 1L
40 :     rl <- structure(list(lengths = as.integer(1 + rpois(k, 10)), values = v),
41 :     class = "rle")
42 :     ai <- new("abIndex", kind = "rleDiff",
43 :     rleD = new("rleDiff", first = rpois(1, 20), rle = rl))
44 :     validObject(ai)
45 :     ii <- as(ai, "numeric")
46 :     stopifnot(is.numeric(ii), ii == round(ii),
47 :     identical(ai, as(ii, "abIndex")))
48 :     if(n %% 40 == 0) cat(n,"\n")
49 :     }
50 :    
51 :     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