The R Project SVN R

Rev

Rev 68769 | Only display areas with differences | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 68769 Rev 68809
1 
 
 1 
 
2 
R Under development (unstable) (2015-07-31 r68768) -- "Unsuffered Consequences"
 2 
R Under development (unstable) (2015-08-03 r68808) -- "Unsuffered Consequences"
3 
Copyright (C) 2015 The R Foundation for Statistical Computing
 3 
Copyright (C) 2015 The R Foundation for Statistical Computing
4 
Platform: x86_64-unknown-linux-gnu (64-bit)
 4 
Platform: x86_64-pc-linux-gnu (64-bit)
5 
 
 5 
 
6 
R is free software and comes with ABSOLUTELY NO WARRANTY.
 6 
R is free software and comes with ABSOLUTELY NO WARRANTY.
7 
You are welcome to redistribute it under certain conditions.
 7 
You are welcome to redistribute it under certain conditions.
8 
Type 'license()' or 'licence()' for distribution details.
 8 
Type 'license()' or 'licence()' for distribution details.
9 
 
 9 
 
10 
R is a collaborative project with many contributors.
 10 
R is a collaborative project with many contributors.
11 
Type 'contributors()' for more information and
 11 
Type 'contributors()' for more information and
12 
'citation()' on how to cite R or R packages in publications.
 12 
'citation()' on how to cite R or R packages in publications.
13 
 
 13 
 
14 
Type 'demo()' for some demos, 'help()' for on-line help, or
 14 
Type 'demo()' for some demos, 'help()' for on-line help, or
15 
'help.start()' for an HTML browser interface to help.
 15 
'help.start()' for an HTML browser interface to help.
16 
Type 'q()' to quit R.
 16 
Type 'q()' to quit R.
17 
 
 17 
 
18 
> ## array subsetting tests
 18 
> ## array subsetting tests
19 
> ##
 19 
> ##
20 
> ## Tests should be written to raise an error on test failure
 20 
> ## Tests should be written to raise an error on test failure
21 
> ##
 21 
> ##
22 
>
22 
>
23 
> ## Test for subsetting of an array using a matrix with ncol == length(dim(x))
 23 
> ## Test for subsetting of an array using a matrix with ncol == length(dim(x))
24 
>
24 
>
25 
> ## first matrix case
 25 
> ## first matrix case
26 
> m <- matrix(1:25, ncol=5, dimnames = list(letters[1:5], LETTERS[1:5]))
 26 
> m <- matrix(1:25, ncol=5, dimnames = list(letters[1:5], LETTERS[1:5]))
27 
>
27 
>
28 
> si <- matrix(c(1, 1, 2, 3, 3, 4), ncol = 2, byrow = TRUE)
 28 
> si <- matrix(c(1, 1, 2, 3, 3, 4), ncol = 2, byrow = TRUE)
29 
> ss <- matrix(c("a", "A", "b", "C", "c", "D"), ncol = 2, byrow = TRUE)
 29 
> ss <- matrix(c("a", "A", "b", "C", "c", "D"), ncol = 2, byrow = TRUE)
30 
>
30 
>
31 
> stopifnot(identical(m[si], m[ss]))
 31 
> stopifnot(identical(m[si], m[ss]))
32 
> stopifnot(identical(c(1L, 12L, 18L), m[ss]))
 32 
> stopifnot(identical(c(1L, 12L, 18L), m[ss]))
33 
>
33 
>
34 
> ## test behavior of NA entries in subset matrix.
 34 
> ## test behavior of NA entries in subset matrix.
35 
> ## NA in character matrix should propagate and should not
 35 
> ## NA in character matrix should propagate and should not
36 
> ## match an NA in a dimname.
 36 
> ## match an NA in a dimname.
37 
>
37 
>
38 
> ## An NA in either column propagates to result
 38 
> ## An NA in either column propagates to result
39 
> ssna <- ss; ssna[2, 2] <- NA
 39 
> ssna <- ss; ssna[2, 2] <- NA
40 
> stopifnot(identical(c(1L, NA, 18L), m[ssna]))
 40 
> stopifnot(identical(c(1L, NA, 18L), m[ssna]))
41 
> ssna <- ss; ssna[2, 1] <- NA
 41 
> ssna <- ss; ssna[2, 1] <- NA
42 
> stopifnot(identical(c(1L, NA, 18L), m[ssna]))
 42 
> stopifnot(identical(c(1L, NA, 18L), m[ssna]))
43 
>
43 
>
44 
> ## An NA in row/column names is not matched
 44 
> ## An NA in row/column names is not matched
45 
> mnadim <- m
 45 
> mnadim <- m
46 
> tmp <- rownames(mnadim)
 46 
> tmp <- rownames(mnadim)
47 
> tmp[5] <- NA
 47 
> tmp[5] <- NA
48 
> rownames(mnadim) <- tmp
 48 
> rownames(mnadim) <- tmp
49 
> stopifnot(identical(c(1L, NA, 18L), m[ssna]))
 49 
> stopifnot(identical(c(1L, NA, 18L), m[ssna]))
50 
>
50 
>
51 
> ## Unmatched subscripts raise an error
 51 
> ## Unmatched subscripts raise an error
52 
> ssnm <- ss
 52 
> ssnm <- ss
53 
> ssnm[2, 2] <- "NOMATCH"
 53 
> ssnm[2, 2] <- "NOMATCH"
54 
> stopifnot(inherits(try(m[ssnm], silent=TRUE), "try-error"))
 54 
> stopifnot(inherits(try(m[ssnm], silent=TRUE), "try-error"))
55 
>
55 
>
56 
> ## "" does not match and so raises an error
 56 
> ## "" does not match and so raises an error
57 
> mnadim <- m
 57 
> mnadim <- m
58 
> tmp <- rownames(mnadim)
 58 
> tmp <- rownames(mnadim)
59 
> tmp[5] <- ""
 59 
> tmp[5] <- ""
60 
> rownames(mnadim) <- tmp
 60 
> rownames(mnadim) <- tmp
61 
> ssnm <- ss
 61 
> ssnm <- ss
62 
> ssnm[2, 2] <- ""
 62 
> ssnm[2, 2] <- ""
63 
> stopifnot(inherits(try(mnadim[ssnm], silent=TRUE), "try-error"))
 63 
> stopifnot(inherits(try(mnadim[ssnm], silent=TRUE), "try-error"))
64 
>
64 
>
65 
>
65 
>
66 
> ## test assignment
 66 
> ## test assignment
67 
> m3 <- m2 <- m
 67 
> m3 <- m2 <- m
68 
> m2[si] <- c(100L, 200L, 300L)
 68 
> m2[si] <- c(100L, 200L, 300L)
69 
> m3[ss] <- c(100L, 200L, 300L)
 69 
> m3[ss] <- c(100L, 200L, 300L)
70 
> stopifnot(identical(m2, m3))
 70 
> stopifnot(identical(m2, m3))
71 
>
71 
>
72 
> ## now an array case
 72 
> ## now an array case
73 
> a <- array(1:75, dim = c(5, 5, 3),
 73 
> a <- array(1:75, dim = c(5, 5, 3),
74 
+            dimnames = list(letters[1:5], LETTERS[1:5], letters[24:26]))
 74 
+            dimnames = list(letters[1:5], LETTERS[1:5], letters[24:26]))
75 
>
75 
>
76 
> si <- matrix(c(1, 1, 1,
 76 
> si <- matrix(c(1, 1, 1,
77 
+                2, 3, 1,
 77 
+                2, 3, 1,
78 
+                3, 4, 1,
 78 
+                3, 4, 1,
79 
+                5, 1, 3),
 79 
+                5, 1, 3),
80 
+              ncol = 3, byrow = TRUE)
 80 
+              ncol = 3, byrow = TRUE)
81 
>
81 
>
82 
> ss <- matrix(c("a", "A", "x",
 82 
> ss <- matrix(c("a", "A", "x",
83 
+                "b", "C", "x",
 83 
+                "b", "C", "x",
84 
+                "c", "D", "x",
 84 
+                "c", "D", "x",
85 
+                "e", "A", "z"),
 85 
+                "e", "A", "z"),
86 
+              ncol = 3, byrow = TRUE)
 86 
+              ncol = 3, byrow = TRUE)
87 
>
87 
>
88 
> stopifnot(identical(a[si], a[ss]))
 88 
> stopifnot(identical(a[si], a[ss]))
89 
> stopifnot(identical(c(1L, 12L, 18L, 55L), a[ss]))
 89 
> stopifnot(identical(c(1L, 12L, 18L, 55L), a[ss]))
90 
>
90 
>
91 
> a2 <- a1 <- a
 91 
> a2 <- a1 <- a
92 
> a1[si] <- c(100L, 1200L, 1800L, 5500L)
 92 
> a1[si] <- c(100L, 1200L, 1800L, 5500L)
93 
> a2[ss] <- c(100L, 1200L, 1800L, 5500L)
 93 
> a2[ss] <- c(100L, 1200L, 1800L, 5500L)
94 
> stopifnot(identical(a1, a2))
 94 
> stopifnot(identical(a1, a2))
95 
>
95 
>
96 
> ## it is an error to subset if some dimnames are missing NOTE: this
 96 
> ## it is an error to subset if some dimnames are missing NOTE: this
97 
> ## gives a subscript out of bounds error, might want something more
 97 
> ## gives a subscript out of bounds error, might want something more
98 
> ## informative?
 98 
> ## informative?
99 
> a3 <- a
 99 
> a3 <- a
100 
> dn <- dimnames(a3)
 100 
> dn <- dimnames(a3)
101 
> dn[2] <- list(NULL)
 101 
> dn[2] <- list(NULL)
102 
> dimnames(a3) <- dn
 102 
> dimnames(a3) <- dn
103 
> stopifnot(inherits(try(a3[ss], silent=TRUE), "try-error"))
 103 
> stopifnot(inherits(try(a3[ss], silent=TRUE), "try-error"))
104 
>
104 
>