Commit 1a7ed156 authored by Nicolau Manubens's avatar Nicolau Manubens
Browse files

Progress and debugging.

parent d80722bd
......@@ -349,23 +349,22 @@ Apply <- function(data, target_dims = NULL, fun, ...,
raise_error <- FALSE
if (!is.list(extra_info)) {
raise_error <- TRUE
}
if (length(extra_info) > 0) {
} else if (length(extra_info) > 0) {
if (is.null(names(extra_info))) {
raise_error <- TRUE
}
if (any(sapply(names(extra_info), function(x) nchar(x) == 0))) {
raise_error <- TRUE
}
names(extra_info) <- paste0(names(extra_info), '.')
names(extra_info) <- paste0('.', names(extra_info))
}
if (raise_error) {
stop("Parameter 'extra_info' must be a list with all components named.")
}
# Check guess_dimnames
if (!is.logical(guess_dimnames)) {
stop("Parameter 'guess_dimnames' must be logical.")
# Check guess_dim_names
if (!is.logical(guess_dim_names)) {
stop("Parameter 'guess_dim_names' must be logical.")
}
# Check ncores
......@@ -480,6 +479,13 @@ Apply <- function(data, target_dims = NULL, fun, ...,
chunk_sizes <- c(chunk_sizes, total_size %% chunk_size)
}
fun_env <- new.env()
for (i in seq_along(extra_info)) {
assign(names(extra_info)[i], extra_info[[i]], envir = fun_env)
}
environment(fun) <- fun_env
splatted_f <- splat(fun)
input_margin_weights <- vector('list', length(data))
for (i in 1:length(data)) {
marg_sizes <- dim(data[[i]])[margins[[i]]]
......@@ -488,7 +494,6 @@ Apply <- function(data, target_dims = NULL, fun, ...,
}
# TODO: need to add progress bar
splatted_f <- splat(fun)
# For a selected use case, these are the timings:
# - total: 17 s
# - preparation + post: 1 s
......@@ -522,10 +527,6 @@ Apply <- function(data, target_dims = NULL, fun, ...,
}
}
for (i in 1:length(extra_info)) {
assign(names(extra_info)[i], extra_info[[i]])
}
add_one_multidim <- function(index, dims) {
stop_iterating <- FALSE
check_dim <- 1
......@@ -570,7 +571,7 @@ Apply <- function(data, target_dims = NULL, fun, ...,
attributes_to_send[[i]])
}
assign('.margin_indices', first_marg_indices)
assign('.margin_indices', as.list(first_marg_indices), envir = fun_env)
# SPLATTED_F
result <- splatted_f(iteration_input, ...)
......
......@@ -5,8 +5,8 @@
\title{Apply Functions to Multiple Multidimensional Arrays or Vectors}
\usage{
Apply(data, target_dims = NULL, fun, ..., output_dims = NULL,
margins = NULL, guess_dim_names = TRUE, ncores = NULL,
split_factor = 1)
margins = NULL, use_attributes = NULL, extra_info = NULL,
guess_dim_names = TRUE, ncores = NULL, split_factor = 1)
}
\arguments{
\item{data}{One or a list of numeric object (vector, matrix or array). They must be in the same order as expected by the function provided in the parameter 'fun'. The dimensions do not necessarily have to be ordered. If the 'target_dims' require a different order than the provided, \code{Apply} will automatically reorder the dimensions as needed.}
......@@ -21,6 +21,10 @@ Apply(data, target_dims = NULL, fun, ..., output_dims = NULL,
\item{margins}{One or a list of vectors (or NULLs) containing the 'margin' dimensions to be looped over for each input in 'data'. If a single vector of margins is specified and multiple inputs are provided in 'data', then the single set of margins is re-used for all of the inputs. These vectors can contain either integers specifying the position of the margins, or character strings corresponding to the dimension names. If both 'margins' and 'target_dims' are specified, 'margins' takes priority.}
\item{use_attributes}{List of vectors of character strings with names of attributes of each object in 'data' to be propagated to the subsets of data sent as inputs to the function specified in 'fun'. If this parameter is not specified (NULL), all attributes are dropped. This parameter can be specified as a named list (then the names of this list must match those of the names of parameter 'data'), or as an unnamed list (then the vectors of attribute names will be assigned in order to the input arrays in 'data').}
\item{extra_info}{Named list of extra variables to be defined for them to be accessible from within the function specified in 'fun'. The variable names will automatically be prepended a heading dot ('.'). So, if the variable 'name = "Tony"' is sent through this parameter, it will be accessible from within 'fun' via '.name'.}
\item{guess_dim_names}{Whether to automatically guess missing dimension names for dimensions of equal length across different inputs in 'data' with a warning (TRUE; default), or to crash whenever unnamed dimensions of equa length are identified across different inputs (FALSE).}
\item{ncores}{The number of parallel processes to spawn for the use for parallel computation in multiple cores.}
......
......@@ -1255,6 +1255,34 @@ test_that("real use case - standardization", {
})
# Test margin indices and extra info
test_that("Margin indices and extra info are provided correctly.", {
a <- array(1:prod(1:6), dim = c(a = 1, b = 2, c = 3, d = 4, e = 5, f = 6))
b <- array(1:prod(c(1, 2, 3, 5, 6)), dim = c(a = 1, b = 2, c = 3, e = 5, f = 6))
x <- NULL
y <- NULL
z <- NULL
f <- function(a, b) {
if (all(.margin_indices == 1)) {
x <<- .margin_indices
}
y <<- .margin_indices
z <<- .test_info
}
r <- multiApply::Apply(list(a, b),
list(c('b', 'c', 'd'),
c('b', 'c')),
extra_info = list(test_info = 'test'),
f)
expect_equal(x, list(a = 1, e = 1, f = 1))
expect_equal(y, list(a = 1, e = 5, f = 6))
expect_equal(z, 'test')
})
# Test .aperm2
test_that(".aperm2", {
data <- seq(as.POSIXct('1990-11-01'),
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment