Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 87 lines (69 sloc) 2.353 kb
96749a8 Allow n-dim arrays to be subsetted by an n-column character matrix
falcon authored
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"))
Something went wrong with that request. Please try again.