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