68 lines
1.7 KiB
R
68 lines
1.7 KiB
R
#' Slice index selection
|
|
#'
|
|
#' @examples
|
|
#' # Exquivalent to
|
|
#' array(A[slice.index(A, mode) == index], dim = dim(A)[-mode])
|
|
#'
|
|
#' @export
|
|
slice.select <- function(A, mode, index) {
|
|
arg <- rep("", length(dim(A)))
|
|
arg[mode] <- "i"
|
|
expr <- str2lang(paste0("A[", paste0(arg, collapse = ","), "]", collapse = ""))
|
|
slice <- eval(expr, list(i = index))
|
|
dim(slice) <- dim(A)[-mode]
|
|
slice
|
|
}
|
|
|
|
#'
|
|
#' @export
|
|
slice.expr <- function(A, mode, index = "i", drop = TRUE, nr.axis = length(dim(A))) {
|
|
str <- as.character(substitute(A))
|
|
arg <- rep("", nr.axis)
|
|
arg[mode] <- as.character(substitute(index))
|
|
str2lang(paste0(str, "[", paste0(arg, collapse = ","),
|
|
if (drop) "]" else ",drop=FALSE]", collapse = ""))
|
|
}
|
|
|
|
|
|
#' @export
|
|
slice.assign.expr <- function(obj, nr.axis) {
|
|
assign.call <- as.call(c(
|
|
list(`[<-`, substitute(obj)),
|
|
rep(list(alist(a = )$a), nr.axis - 1L), # replicate empty symbol
|
|
substitute(index), substitute(x)
|
|
))
|
|
function(i, val) {
|
|
eval(assign.call, envir = list(index = i, x = val))
|
|
}
|
|
}
|
|
|
|
|
|
# n <- 1000
|
|
# p <- c(2, 4, 3)
|
|
# A <- array(seq_len(prod(n, p)), dim = c(p, n))
|
|
|
|
# mode <- 4
|
|
# index <- 7
|
|
|
|
# stopifnot(all.equal(
|
|
# A[, , , index],
|
|
# array(A[slice.index(A, mode) == index], dim = dim(A)[-mode])
|
|
# ))
|
|
# stopifnot(all.equal(
|
|
# A[, , , index],
|
|
# slice.select(A, mode, index)
|
|
# ))
|
|
|
|
# arg <- rep("", length(dim(A)))
|
|
# arg[mode] <- "i"
|
|
# `A[..., i]` <- str2lang(paste0("A[", paste0(arg, collapse = ","), "]", collapse = ""))
|
|
|
|
# microbenchmark::microbenchmark(
|
|
# A[, , , index],
|
|
# eval(`A[..., i]`, list(i = index)),
|
|
# slice.select(A, mode, index),
|
|
# array(A[slice.index(A, mode) == index], dim = dim(A)[-mode])
|
|
# )
|
|
|