Skip to content

# wch/r-source

Fetching contributors…
Cannot retrieve contributors at this time
105 lines (99 sloc) 3.08 KB
 R version 2.11.0 Under development (unstable) (2010-01-06 r50904) Copyright (C) 2010 The R Foundation for Statistical Computing ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## array subsetting tests > ## > ## Tests should be written to raise an error on test failure > ## > > ## Test for subsetting of an array using a matrix with ncol == length(dim(x)) > > ## first matrix case > m <- matrix(1:25, ncol=5, dimnames = list(letters[1:5], LETTERS[1:5])) > > si <- matrix(c(1, 1, 2, 3, 3, 4), ncol = 2, byrow = TRUE) > ss <- matrix(c("a", "A", "b", "C", "c", "D"), ncol = 2, byrow = TRUE) > > stopifnot(identical(m[si], m[ss])) > stopifnot(identical(c(1L, 12L, 18L), m[ss])) > > ## test behavior of NA entries in subset matrix. > ## NA in character matrix should propagate and should not > ## match an NA in a dimname. > > ## An NA in either column propagates to result > ssna <- ss; ssna[2, 2] <- NA > stopifnot(identical(c(1L, NA, 18L), m[ssna])) > ssna <- ss; ssna[2, 1] <- NA > stopifnot(identical(c(1L, NA, 18L), m[ssna])) > > ## An NA in row/column names is not matched > mnadim <- m > tmp <- rownames(mnadim) > tmp[5] <- NA > rownames(mnadim) <- tmp > stopifnot(identical(c(1L, NA, 18L), m[ssna])) > > ## Unmatched subscripts raise an error > ssnm <- ss > ssnm[2, 2] <- "NOMATCH" > stopifnot(inherits(try(m[ssnm], silent=TRUE), "try-error")) > > ## "" does not match and so raises an error > mnadim <- m > tmp <- rownames(mnadim) > tmp[5] <- "" > rownames(mnadim) <- tmp > ssnm <- ss > ssnm[2, 2] <- "" > stopifnot(inherits(try(mnadim[ssnm], silent=TRUE), "try-error")) > > > ## test assignment > m3 <- m2 <- m > m2[si] <- c(100L, 200L, 300L) > m3[ss] <- c(100L, 200L, 300L) > stopifnot(identical(m2, m3)) > > ## now an array case > a <- array(1:75, dim = c(5, 5, 3), + dimnames = list(letters[1:5], LETTERS[1:5], letters[24:26])) > > si <- matrix(c(1, 1, 1, + 2, 3, 1, + 3, 4, 1, + 5, 1, 3), + ncol = 3, byrow = TRUE) > > ss <- matrix(c("a", "A", "x", + "b", "C", "x", + "c", "D", "x", + "e", "A", "z"), + ncol = 3, byrow = TRUE) > > stopifnot(identical(a[si], a[ss])) > stopifnot(identical(c(1L, 12L, 18L, 55L), a[ss])) > > a2 <- a1 <- a > a1[si] <- c(100L, 1200L, 1800L, 5500L) > a2[ss] <- c(100L, 1200L, 1800L, 5500L) > stopifnot(identical(a1, a2)) > > ## it is an error to subset if some dimnames are missing NOTE: this > ## gives a subscript out of bounds error, might want something more > ## informative? > a3 <- a > dn <- dimnames(a3) > dn[2] <- list(NULL) > dimnames(a3) <- dn > stopifnot(inherits(try(a3[ss], silent=TRUE), "try-error")) >
Something went wrong with that request. Please try again.