Commit d996b127 authored by Nicolau Manubens's avatar Nicolau Manubens
Browse files

Added parameters 'use_attributes' and 'extra_info'. Tests pending.

parent bf4b09fc
......@@ -8,6 +8,8 @@
#' @param ... Additional fixed arguments expected by the function provided in the parameter 'fun'.
#' @param output_dims Optional list of vectors containing the names of the dimensions to be output from the fun for each of the objects it returns (or a single vector if the function has only one output).
#' @param 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.
#' @param 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').
#' @param 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'.
#' @param 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).
#' @param ncores The number of parallel processes to spawn for the use for parallel computation in multiple cores.
#' @param split_factor Factor telling to which degree the input data should be split into smaller pieces to be processed by the available cores. By default (split_factor = 1) the data is split into 4 pieces for each of the cores (as specified in ncores). A split_factor of 2 will result in 8 pieces for each of the cores, and so on. The special value 'greatest' will split the input data into as many pieces as possible.
......@@ -31,7 +33,9 @@
#' @importFrom plyr splat llply
#' @importFrom utils capture.output
Apply <- function(data, target_dims = NULL, fun, ...,
output_dims = NULL, margins = NULL, guess_dim_names = TRUE,
output_dims = NULL, margins = NULL,
use_attributes = NULL, extra_info = NULL,
guess_dim_names = TRUE,
ncores = NULL, split_factor = 1) {
# Check data
if (!is.list(data)) {
......@@ -294,6 +298,76 @@ Apply <- function(data, target_dims = NULL, fun, ...,
}
}
# Check use_attributes
if (!is.null(use_attributes)) {
if (!is.list(use_attributes)) {
stop("Parameter 'use_attributes' must be a list.")
}
if (is.null(names(data)) && !is.null(names(use_attributes))) {
warning("Parameter 'use_attributes' provided with names, but ",
"no names provided for 'data'. All names will be ",
"disregarded.")
names(use_attributes) <- NULL
}
if (!is.null(names(use_attributes))) {
if (!all(sapply(names(use_attributes), function(x) nchar(x) > 0))) {
stop("If providing names for the list 'use_attributes', all ",
"components must be named.")
}
if (length(unique(names(use_attributes))) !=
length(names(use_attributes))) {
stop("The list in parameter 'use_attributes' must not ",
"contain repeated names.")
}
if (any(!(names(use_attributes) %in% names(data)))) {
stop("Provided some names in parameter 'use_attributes' not present ",
"in parameter 'data'.")
}
use_attributes <- use_attributes[names(data)]
} else {
if (length(use_attributes) != length(data)) {
warning("Provided different number of items in 'use_attributes' ",
"and in 'data'. Assuming same order.")
}
use_attributes <- use_attributes[1:length(data)]
}
} else {
use_attributes <- vector('list', length = length(data))
}
for (i in 1:length(data)) {
if (any(!(use_attributes[[i]] %in% names(attributes(data[[i]]))))) {
stop("Parameter 'use_attributes' contains some attribute names ",
"that are not present in the attributes of the corresponding ",
"object in parameter 'data'.")
}
}
# Check extra_info
if (is.null(extra_info)) {
extra_info <- list()
}
raise_error <- FALSE
if (!is.list(extra_info)) {
raise_error <- TRUE
}
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), '.')
}
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 ncores
if (is.null(ncores)) {
ncores <- 1
......@@ -434,10 +508,22 @@ Apply <- function(data, target_dims = NULL, fun, ...,
names(first_marg_indices) <- names(mad)
sub_arrays_of_results <- list()
found_first_sub_result <- FALSE
attributes_to_send <- vector('list', length = length(data))
iteration_indices_to_take <- list()
for (i in 1:length(data)) {
iteration_indices_to_take[[i]] <- as.list(rep(TRUE, length(dim(data[[i]]))))
names(iteration_indices_to_take[[i]]) <- names(dim(data[[i]]))
if (length(use_attributes[[i]]) > 0) {
attributes_to_send[[i]] <- attributes(data[[i]])
if ('dim' %in% names(attributes_to_send[[i]])) {
attributes_to_send[[i]][['dim']] <- NULL
}
attributes_to_send[[i]] <- attributes_to_send[[i]][use_attributes[[i]]]
}
}
for (i in 1:length(extra_info)) {
assign(names(extra_info)[i], extra_info[[i]])
}
add_one_multidim <- function(index, dims) {
......@@ -480,6 +566,8 @@ Apply <- function(data, target_dims = NULL, fun, ...,
#if only one dim remains, make as.vector
}
}
attributes(iteration_input[[i]]) <- c(attributes(iteration_input[[i]]),
attributes_to_send[[i]])
}
if (!is.null(mad)) {
first_marg_indices <- add_one_multidim(first_marg_indices, mad)
......
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