RleArray-class {DelayedArray} | R Documentation |
The RleArray class is a DelayedArray subclass for representing an in-memory Run Length Encoded array-like dataset.
All the operations available for DelayedArray objects work on RleArray objects.
## Constructor function: RleArray(data, dim, dimnames, chunksize=NULL)
data |
An Rle object, or an ordinary list of Rle objects,
or an RleList object, or a DataFrame
object where all the columns are Rle objects. More generally speaking,
|
dim |
The dimensions of the object to be created, that is, an integer vector of length one or more giving the maximal indices in each dimension. |
dimnames |
The dimnames of the object to be created. Must be |
chunksize |
Experimental. Don't use! |
An RleArray object.
Rle and DataFrame objects in the S4Vectors package and RleList objects in the IRanges package.
DelayedArray objects.
DelayedArray-utils for common operations on DelayedArray objects.
realize
for realizing a DelayedArray object in memory
or on disk.
HDF5Array objects in the HDF5Array package.
The RleArraySeed helper class.
## --------------------------------------------------------------------- ## A. BASIC EXAMPLE ## --------------------------------------------------------------------- data <- Rle(sample(6L, 500000, replace=TRUE), 8) a <- array(data, dim=c(50, 20, 4000)) # array() expands the Rle object # internally with as.vector() A <- RleArray(data, dim=c(50, 20, 4000)) # Rle object is NOT expanded A object.size(a) object.size(A) stopifnot(identical(a, as.array(A))) as(A, "Rle") # deconstruction toto <- function(x) (5 * x[ , , 1] ^ 3 + 1L) * log(x[, , 2]) m1 <- toto(a) head(m1) M1 <- toto(A) # very fast! (operations are delayed) M1 stopifnot(identical(m1, as.array(M1))) cs <- colSums(m1) CS <- colSums(M1) stopifnot(identical(cs, CS)) ## Coercing a DelayedMatrix object to DataFrame produces a DataFrame ## object with Rle columns: as(M1, "DataFrame") ## --------------------------------------------------------------------- ## B. MAKING AN RleArray OBJECT FROM A LIST-LIKE OBJECT OF Rle OBJECTS ## --------------------------------------------------------------------- ## From a DataFrame object: DF <- DataFrame(A=Rle(sample(3L, 100, replace=TRUE)), B=Rle(sample(3L, 100, replace=TRUE)), C=Rle(sample(3L, 100, replace=TRUE) - 0.5), row.names=sprintf("ID%03d", 1:100)) M2 <- RleArray(DF) M2 A3 <- RleArray(DF, dim=c(25, 6, 2)) A3 M4 <- RleArray(DF, dim=c(25, 12), dimnames=list(LETTERS[1:25], NULL)) M4 ## From an ordinary list: ## If all the supplied Rle objects have the same length and if the 'dim' ## argument is not specified, then the RleArray() constructor returns an ## RleMatrix object with 1 column per Rle object. If the 'dimnames' ## argument is not specified, then the names on the list are propagated ## as the colnames of the returned object. data <- as.list(DF) M2b <- RleArray(data) A3b <- RleArray(data, dim=c(25, 6, 2)) M4b <- RleArray(data, dim=c(25, 12), dimnames=list(LETTERS[1:25], NULL)) data2 <- list(Rle(sample(3L, 9, replace=TRUE)) * 11L, Rle(sample(3L, 15, replace=TRUE))) ## Not run: RleArray(data2) # error! (cannot infer the dim) ## End(Not run) RleArray(data2, dim=c(4, 6)) ## From an RleList object: data <- RleList(data) M2c <- RleArray(data) A3c <- RleArray(data, dim=c(25, 6, 2)) M4c <- RleArray(data, dim=c(25, 12), dimnames=list(LETTERS[1:25], NULL)) data2 <- RleList(data2) ## Not run: RleArray(data2) # error! (cannot infer the dim) ## End(Not run) RleArray(data2, dim=4:2) ## Sanity checks: data0 <- as.vector(unlist(DF, use.names=FALSE)) m2 <- matrix(data0, ncol=3, dimnames=dimnames(M2)) stopifnot(identical(m2, as.matrix(M2))) rownames(m2) <- NULL stopifnot(identical(m2, as.matrix(M2b))) stopifnot(identical(m2, as.matrix(M2c))) a3 <- array(data0, dim=c(25, 6, 2)) stopifnot(identical(a3, as.array(A3))) stopifnot(identical(a3, as.array(A3b))) stopifnot(identical(a3, as.array(A3c))) m4 <- matrix(data0, ncol=12, dimnames=dimnames(M4)) stopifnot(identical(m4, as.matrix(M4))) stopifnot(identical(m4, as.matrix(M4b))) stopifnot(identical(m4, as.matrix(M4c))) ## --------------------------------------------------------------------- ## C. COERCING FROM RleList OR DataFrame TO RleMatrix ## --------------------------------------------------------------------- ## Coercing an RleList object to RleMatrix only works if all the list ## elements in the former have the same length. x <- RleList(A=Rle(sample(3L, 20, replace=TRUE)), B=Rle(sample(3L, 20, replace=TRUE))) M <- as(x, "RleMatrix") stopifnot(identical(x, as(M, "RleList"))) x <- DataFrame(A=x[[1]], B=x[[2]], row.names=letters[1:20]) M <- as(x, "RleMatrix") stopifnot(identical(x, as(M, "DataFrame"))) ## --------------------------------------------------------------------- ## D. CONSTRUCTING A LARGE RleArray OBJECT ## --------------------------------------------------------------------- ## The RleArray() constructor does not accept a long Rle object at the ## moment: ## Not run: RleArray(Rle(5, 3e9), dim=c(3, 1e9)) # error! ## End(Not run) ## The workaround is to supply a list of Rle objects instead: data <- lapply(1:500, function(j) Rle(runif(99), 1e6 + 99:1)) dim <- c(6750, 73337, 100) A <- RleArray(data, dim) A ## Because all the Rle objects in 'data' have the same length, we can ## call RleArray() on it without specifying the 'dim' argument. This ## returns an RleMatrix object where each column corresponds to an Rle ## object in 'data': M <- RleArray(data) M stopifnot(identical(as(data, "RleList"), as(M, "RleList")))