Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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