1#' An indexed array. 2#' 3#' Create a indexed array, a space efficient way of indexing into a large 4#' array. 5#' 6#' @param env environment containing data frame 7#' @param index list of indices 8#' @keywords internal 9#' @aliases indexed_array [[.indexed_array names.indexed_array 10#' length.indexed_array 11indexed_array <- function(env, index) { 12 exact <- all(unlist(llply(index, is.numeric))) 13 14 # Situations that should use [ 15 # * data.frame 16 # * normal array 17 # * normal vector 18 # * list-array with inexact indexing 19 # 20 # Situations that should use [[ 21 # * list 22 # * list-array with exact indexing 23 24 if (is.list(env$data)) { 25 if (is.data.frame(env$data) || (is.array(env$data) && !exact)) { 26 subs <- "[" 27 } else { 28 subs <- "[[" 29 } 30 } else { 31 subs <- "[" 32 } 33 34 # Don't drop if data is a data frame 35 drop <- !is.data.frame(env$data) 36 37 structure( 38 list(env = env, index = index, drop = drop, subs = as.name(subs)), 39 class = c("indexed_array", "indexed") 40 ) 41} 42 43#' @export 44length.indexed_array <- function(x) nrow(x$index) 45 46#' @export 47"[[.indexed_array" <- function(x, i) { 48 indices <- unname(x$index[i, , drop = TRUE]) 49 indices <- lapply(indices, function(x) if (x == "") bquote() else x) 50 51 call <- as.call(c( 52 list(x$subs, quote(x$env$data)), 53 indices, 54 list(drop = x$drop))) 55 eval(call) 56} 57 58#' @export 59names.indexed_array <- function(x) rownames(x$index) 60