| 50896 |
falcon |
1 |
## array subsetting tests
|
|
|
2 |
##
|
|
|
3 |
## Tests should be written to raise an error on test failure
|
|
|
4 |
##
|
|
|
5 |
|
|
|
6 |
## Test for subsetting of an array using a matrix with ncol == length(dim(x))
|
|
|
7 |
|
|
|
8 |
## first matrix case
|
|
|
9 |
m <- matrix(1:25, ncol=5, dimnames = list(letters[1:5], LETTERS[1:5]))
|
|
|
10 |
|
|
|
11 |
si <- matrix(c(1, 1, 2, 3, 3, 4), ncol = 2, byrow = TRUE)
|
|
|
12 |
ss <- matrix(c("a", "A", "b", "C", "c", "D"), ncol = 2, byrow = TRUE)
|
|
|
13 |
|
|
|
14 |
stopifnot(identical(m[si], m[ss]))
|
|
|
15 |
stopifnot(identical(c(1L, 12L, 18L), m[ss]))
|
|
|
16 |
|
|
|
17 |
## test behavior of NA entries in subset matrix.
|
|
|
18 |
## NA in character matrix should propagate and should not
|
|
|
19 |
## match an NA in a dimname.
|
|
|
20 |
|
|
|
21 |
## An NA in either column propagates to result
|
|
|
22 |
ssna <- ss; ssna[2, 2] <- NA
|
|
|
23 |
stopifnot(identical(c(1L, NA, 18L), m[ssna]))
|
|
|
24 |
ssna <- ss; ssna[2, 1] <- NA
|
|
|
25 |
stopifnot(identical(c(1L, NA, 18L), m[ssna]))
|
|
|
26 |
|
|
|
27 |
## An NA in row/column names is not matched
|
|
|
28 |
mnadim <- m
|
|
|
29 |
tmp <- rownames(mnadim)
|
|
|
30 |
tmp[5] <- NA
|
|
|
31 |
rownames(mnadim) <- tmp
|
|
|
32 |
stopifnot(identical(c(1L, NA, 18L), m[ssna]))
|
|
|
33 |
|
|
|
34 |
## Unmatched subscripts raise an error
|
|
|
35 |
ssnm <- ss
|
|
|
36 |
ssnm[2, 2] <- "NOMATCH"
|
|
|
37 |
stopifnot(inherits(try(m[ssnm], silent=TRUE), "try-error"))
|
|
|
38 |
|
|
|
39 |
## "" does not match and so raises an error
|
|
|
40 |
mnadim <- m
|
|
|
41 |
tmp <- rownames(mnadim)
|
|
|
42 |
tmp[5] <- ""
|
|
|
43 |
rownames(mnadim) <- tmp
|
|
|
44 |
ssnm <- ss
|
|
|
45 |
ssnm[2, 2] <- ""
|
|
|
46 |
stopifnot(inherits(try(mnadim[ssnm], silent=TRUE), "try-error"))
|
|
|
47 |
|
|
|
48 |
|
|
|
49 |
## test assignment
|
|
|
50 |
m3 <- m2 <- m
|
|
|
51 |
m2[si] <- c(100L, 200L, 300L)
|
|
|
52 |
m3[ss] <- c(100L, 200L, 300L)
|
|
|
53 |
stopifnot(identical(m2, m3))
|
|
|
54 |
|
|
|
55 |
## now an array case
|
|
|
56 |
a <- array(1:75, dim = c(5, 5, 3),
|
|
|
57 |
dimnames = list(letters[1:5], LETTERS[1:5], letters[24:26]))
|
|
|
58 |
|
|
|
59 |
si <- matrix(c(1, 1, 1,
|
|
|
60 |
2, 3, 1,
|
|
|
61 |
3, 4, 1,
|
|
|
62 |
5, 1, 3),
|
|
|
63 |
ncol = 3, byrow = TRUE)
|
|
|
64 |
|
|
|
65 |
ss <- matrix(c("a", "A", "x",
|
|
|
66 |
"b", "C", "x",
|
|
|
67 |
"c", "D", "x",
|
|
|
68 |
"e", "A", "z"),
|
|
|
69 |
ncol = 3, byrow = TRUE)
|
|
|
70 |
|
|
|
71 |
stopifnot(identical(a[si], a[ss]))
|
|
|
72 |
stopifnot(identical(c(1L, 12L, 18L, 55L), a[ss]))
|
|
|
73 |
|
|
|
74 |
a2 <- a1 <- a
|
|
|
75 |
a1[si] <- c(100L, 1200L, 1800L, 5500L)
|
|
|
76 |
a2[ss] <- c(100L, 1200L, 1800L, 5500L)
|
|
|
77 |
stopifnot(identical(a1, a2))
|
|
|
78 |
|
|
|
79 |
## it is an error to subset if some dimnames are missing NOTE: this
|
|
|
80 |
## gives a subscript out of bounds error, might want something more
|
|
|
81 |
## informative?
|
|
|
82 |
a3 <- a
|
|
|
83 |
dn <- dimnames(a3)
|
|
|
84 |
dn[2] <- list(NULL)
|
|
|
85 |
dimnames(a3) <- dn
|
|
|
86 |
stopifnot(inherits(try(a3[ss], silent=TRUE), "try-error"))
|
The R Project SVN
R