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