From 2e14ddb1fef4c70d591c491b963fa8db930b68ea Mon Sep 17 00:00:00 2001 From: ahunter Date: Mon, 2 Oct 2017 09:10:24 +0200 Subject: [PATCH 1/3] Fixed output dim names when AtomicFun returns object with more than one dim --- R/Apply.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Apply.R b/R/Apply.R index cafa3b5..33b553a 100644 --- a/R/Apply.R +++ b/R/Apply.R @@ -108,7 +108,7 @@ Apply <- function(data, margins = NULL, AtomicFun, ..., inverse_margins = NULL, WrapperFun <- splatted_f(data, ...) } if (!is.null(dim(WrapperFun))) { - names(dim(WrapperFun)) <- c(AtomicFun, names) + names(dim(WrapperFun))[(length(dim(WrapperFun)) - length(names) + 1) : length(dim(WrapperFun))] <- c(names) } out <- WrapperFun } -- GitLab From f2b49ee68f552e8d346c42992857d5231129af4f Mon Sep 17 00:00:00 2001 From: ahunter Date: Mon, 2 Oct 2017 09:15:22 +0200 Subject: [PATCH 2/3] Change inverse_margins to target_dims --- R/Apply.R | 22 +++++++++++----------- man/Apply.Rd | 6 +++--- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/R/Apply.R b/R/Apply.R index 33b553a..3359837 100644 --- a/R/Apply.R +++ b/R/Apply.R @@ -2,10 +2,10 @@ #' #' The Apply function is an extension of the mapply function, which instead of taking lists of unidimensional objects as input, takes lists of multidimensional objects as input, which may have different numbers of dimensions and dimension lengths. The user can specify which dimensions of each array (or matrix) the function is to be applied over with the margins option. #' @param data A single object (vector, matrix or array) or a list of objects. They must be in the same order as expected by AtomicFun. -#' @param margins List of vectors containing the margins for the input objects to be split by. Or, if there is a single vector of margins specified and a list of objects in data, then the single set of margins is applied over all objects. These vectors can contain either integers specifying the dimension position, or characters corresponding to the dimension names. If both margins and inverse_margins are specified, margins takes priority over inverse_margins. +#' @param margins List of vectors containing the margins for the input objects to be split by. Or, if there is a single vector of margins specified and a list of objects in data, then the single set of margins is applied over all objects. These vectors can contain either integers specifying the dimension position, or characters corresponding to the dimension names. If both margins and target_dims are specified, margins takes priority over target_dims. #' @param AtomicFun Function to be applied to the arrays. #' @param ... Additional arguments to be used in the AtomicFun. -#' @param inverse_margins List of vectors containing the dimensions to be input into AtomicFun for each of the objects in the data. These vectors can contain either integers specifying the dimension position, or characters corresponding to the dimension names. If both margins and inverse_margins are specified, margins takes priority over inverse_margins. +#' @param target_dims List of vectors containing the dimensions to be input into AtomicFun for each of the objects in the data. These vectors can contain either integers specifying the dimension position, or characters corresponding to the dimension names. If both margins and target_dims are specified, margins takes priority over target_dims. #' @param parallel Logical, should the function be applied in parallel. #' @param ncores The number of cores to use for parallel computation. #' @details When using a single object as input, Apply is almost identical to the apply function. For multiple input objects, the output array will have dimensions equal to the dimensions specified in 'margins'. @@ -21,29 +21,29 @@ #' (sum(y > z) / (length(y)))) * 100} #' margins = list(c(1, 2), c(1, 2), c(1,2)) #' test <- Apply(data, margins, AtomicFun = "test_fun") -Apply <- function(data, margins = NULL, AtomicFun, ..., inverse_margins = NULL, parallel = FALSE, ncores = NULL) { +Apply <- function(data, margins = NULL, AtomicFun, ..., target_dims = NULL, parallel = FALSE, ncores = NULL) { if (!is.list(data)) { data <- list(data) } if (!is.null(margins)) { - inverse_margins <- NULL + target_dims <- NULL } - if (!is.null(inverse_margins)) { - if (!is.list(inverse_margins)) { - inverse_margins <- rep(list(inverse_margins), length(data)) + if (!is.null(target_dims)) { + if (!is.list(target_dims)) { + target_dims <- rep(list(target_dims), length(data)) } - if (is.character(unlist(inverse_margins[1]))) { - margins2 <- inverse_margins + if (is.character(unlist(target_dims[1]))) { + margins2 <- target_dims for (i in 1 : length(data)) { margins_new <- c() for (j in 1 : length(margins2[[i]])) { margins_new[j] <- which(names(dim(data[[i]])) == margins2[[i]][[j]]) } - inverse_margins[[i]] <- c(margins_new) + target_dims[[i]] <- c(margins_new) } } for (i in 1 : length(data)) { - margins[[i]] <- c(1 :length(dim(data[[i]])))[-c(inverse_margins[[i]])] + margins[[i]] <- c(1 :length(dim(data[[i]])))[-c(target_dims[[i]])] } } if (!is.null(margins)) { diff --git a/man/Apply.Rd b/man/Apply.Rd index 4a09caf..7cf39f2 100644 --- a/man/Apply.Rd +++ b/man/Apply.Rd @@ -4,19 +4,19 @@ \alias{Apply} \title{Wrapper for Applying Atomic Functions to Arrays.} \usage{ -Apply(data, margins = NULL, AtomicFun, ..., inverse_margins = NULL, parallel = FALSE, +Apply(data, margins = NULL, AtomicFun, ..., target_dims = NULL, parallel = FALSE, ncores = NULL) } \arguments{ \item{data}{A single object (vector, matrix or array) or a list of objects. They must be in the same order as expected by AtomicFun.} -\item{margins}{List of vectors containing the margins for the input objects to be split by. Or, if there is a single vector of margins specified and a list of objects in data, then the single set of margins is applied over all objects. These vectors can contain either integers specifying the dimension position, or characters corresponding to the dimension names. If both margins and inverse_margins are specified, margins takes priority over inverse_margins.} +\item{margins}{List of vectors containing the margins for the input objects to be split by. Or, if there is a single vector of margins specified and a list of objects in data, then the single set of margins is applied over all objects. These vectors can contain either integers specifying the dimension position, or characters corresponding to the dimension names. If both margins and target_dims are specified, margins takes priority over target_dims.} \item{AtomicFun}{Function to be applied to the arrays.} \item{...}{Additional arguments to be used in the AtomicFun.} -\item{inverse_margins}{List of vectors containing the dimensions to be input into AtomicFun for each of the objects in the data. These vectors can contain either integers specifying the dimension position, or characters corresponding to the dimension names. If both margins and inverse_margins are specified, margins takes priority over inverse_margins.} +\item{target_dims}{List of vectors containing the dimensions to be input into AtomicFun for each of the objects in the data. These vectors can contain either integers specifying the dimension position, or characters corresponding to the dimension names. If both margins and target_dims are specified, margins takes priority over target_dims.} \item{parallel}{Logical, should the function be applied in parallel.} -- GitLab From 410fcafc64e3f0c36b637ea802793e39cd7cf4a7 Mon Sep 17 00:00:00 2001 From: ahunter Date: Mon, 2 Oct 2017 09:40:17 +0200 Subject: [PATCH 3/3] Automatic sorting of target_dims --- R/Apply.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/R/Apply.R b/R/Apply.R index 3359837..c9d35ee 100644 --- a/R/Apply.R +++ b/R/Apply.R @@ -42,7 +42,13 @@ Apply <- function(data, margins = NULL, AtomicFun, ..., target_dims = NULL, para target_dims[[i]] <- c(margins_new) } } - for (i in 1 : length(data)) { + for (i in 1 : length(data)) { + if (is.unsorted(target_dims[[i]])) { + targ_dims <- sort(target_dims[[i]]) + marg_dims <- c(1 : length(dim(data[[i]])))[- target_dims[[i]]] + data[[i]] <- aperm(data[[i]], c(targ_dims, marg_dims)) + target_dims[[i]] <- 1 : length(targ_dims) + } margins[[i]] <- c(1 :length(dim(data[[i]])))[-c(target_dims[[i]])] } } -- GitLab