tensor_predictors/tensorPredictors/R/slice_select.R

68 lines
1.7 KiB
R
Raw Normal View History

#' 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])
# )