From 547907c818117b6e468932a0a377674ea4824a75 Mon Sep 17 00:00:00 2001 From: nperez Date: Fri, 18 Dec 2020 10:52:59 +0100 Subject: [PATCH 1/4] MeanDims using Apply --- R/MeanDims.R | 61 +++++++++++++++++++++++++++---------------------- man/MeanDims.Rd | 25 ++++++++++++-------- 2 files changed, 49 insertions(+), 37 deletions(-) diff --git a/R/MeanDims.R b/R/MeanDims.R index 2da3144..14399e8 100644 --- a/R/MeanDims.R +++ b/R/MeanDims.R @@ -3,26 +3,28 @@ #'This function returns the mean of an array along a set of dimensions and #'preserves the dimension names if it has. #' -#'@details It is recommended to use \code{'apply(x, dim, mean)'} to improve the -#' efficiency when the dimension to be averaged is only one. -#' #'@param data An array to be averaged. #'@param dims A vector of numeric or charactor string, indicating along which #' dimensions to average. #'@param na.rm A logical value indicating whether to ignore NA values (TRUE) or -#' not (FALSE). The default value is FALSE. -#' +#' not (FALSE). +#'@param ncores A integer indicating the number of cores to use in parallel computation. #'@return An array with the same dimension as parameter 'data' except the 'dims' #' dimensions. #' removed. #' +#'@keywords datagen +#'@author History:\cr +#'0.1 - 2011-04 (V. Guemas, \email{vguemas@@ic3.cat}) - Original code\cr +#'1.0 - 2013-09 (N. Manubens, \email{nicolau.manubens@@ic3.cat}) - Formatting to R CRAN\cr +#'1.1 - 2015-03 (N. Manubens, \email{nicolau.manubens@@ic3.cat}) - Improved memory usage +#'3.0 - 2020-01 (A. Ho, \email{an.ho@bsc.es}) - Preserve dimension names #'@examples -#'a <- array(rnorm(24), dim = c(a = 2, b= 3, c = 4)) -#'print(dim(MeanDims(a, 2))) -#'print(dim(MeanDims(a, c(2, 3)))) -#'print(dim(MeanDims(a, c('a', 'b')))) +#'a <- array(rnorm(24), dim = c(2, 3, 4)) +#'MeanDims(a, 2) +#'MeanDims(a, c(2, 3)) #'@export -MeanDims <- function(data, dims, na.rm = FALSE) { +MeanDims <- function(data, dims, na.rm = TRUE, ncores = NULL) { # Check inputs ## data @@ -63,26 +65,31 @@ MeanDims <- function(data, dims, na.rm = FALSE) { ############################### # Calculate MeanDims - - ## Change character dims into indices - if (is.character(dims)) { - tmp <- rep(0, length(dims)) - for (i in 1:length(dims)) { - tmp[i] <- which(names(dim(data)) == dims[i]) - } - dims <- tmp + if (length(dims) == length(dim(data)) || length(dim(data)) == 1) { + res <- mean(data, na.rm = na.rm) + } else { + res <- Apply(list(data), target_dims = list(dims), fun = mean, + na.rm = na.rm, ncores = ncores)$output1 } + ## Change character dims into indices + #if (is.character(dims)) { + # tmp <- rep(0, length(dims)) + # for (i in 1:length(dims)) { + # tmp[i] <- which(names(dim(data)) == dims[i]) + # } + #dims <- tmp + #} - if (length(dim(data)) == 1) { - res <- mean(data, na.rm = na.rm) - } else { + #if (length(dim(data)) == 1) { + # res <- mean(data, na.rm = na.rm) + #} else { - margins <- setdiff(c(1:length(dim(data))), dims) - res <- as.array(apply(data, margins, mean, na.rm = na.rm)) - if (!is.null(names(dim(data))[margins]) & is.null(names(dim(res)))) { - names(dim(res)) <- names(dim(data))[margins] - } - } + # margins <- setdiff(c(1:length(dim(data))), dims) + # res <- as.array(apply(data, margins, mean, na.rm = na.rm)) + # if (!is.null(names(dim(data))[margins]) & is.null(names(dim(res)))) { + # names(dim(res)) <- names(dim(data))[margins] + # } + #} return(res) diff --git a/man/MeanDims.Rd b/man/MeanDims.Rd index 2e6022f..f200023 100644 --- a/man/MeanDims.Rd +++ b/man/MeanDims.Rd @@ -4,7 +4,7 @@ \alias{MeanDims} \title{Average an array along multiple dimensions} \usage{ -MeanDims(data, dims, na.rm = FALSE) +MeanDims(data, dims, na.rm = TRUE, ncores = NULL) } \arguments{ \item{data}{An array to be averaged.} @@ -13,7 +13,9 @@ MeanDims(data, dims, na.rm = FALSE) dimensions to average.} \item{na.rm}{A logical value indicating whether to ignore NA values (TRUE) or -not (FALSE). The default value is FALSE.} +not (FALSE).} + +\item{ncores}{A integer indicating the number of cores to use in parallel computation.} } \value{ An array with the same dimension as parameter 'data' except the 'dims' @@ -24,14 +26,17 @@ An array with the same dimension as parameter 'data' except the 'dims' This function returns the mean of an array along a set of dimensions and preserves the dimension names if it has. } -\details{ -It is recommended to use \code{'apply(x, dim, mean)'} to improve the - efficiency when the dimension to be averaged is only one. -} \examples{ -a <- array(rnorm(24), dim = c(a = 2, b= 3, c = 4)) -print(dim(MeanDims(a, 2))) -print(dim(MeanDims(a, c(2, 3)))) -print(dim(MeanDims(a, c('a', 'b')))) +a <- array(rnorm(24), dim = c(2, 3, 4)) +MeanDims(a, 2) +MeanDims(a, c(2, 3)) +} +\author{ +History:\cr +0.1 - 2011-04 (V. Guemas, \email{vguemas@ic3.cat}) - Original code\cr +1.0 - 2013-09 (N. Manubens, \email{nicolau.manubens@ic3.cat}) - Formatting to R CRAN\cr +1.1 - 2015-03 (N. Manubens, \email{nicolau.manubens@ic3.cat}) - Improved memory usage +3.0 - 2020-01 (A. Ho, \email{an.ho@bsc.es}) - Preserve dimension names } +\keyword{datagen} -- GitLab From e7b854a6f00c6ca2a0f2fa3c137ff292cc2440e6 Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 7 Jan 2021 12:44:54 +0100 Subject: [PATCH 2/4] apply for 1 dim --- R/MeanDims.R | 27 ++++++--------------------- 1 file changed, 6 insertions(+), 21 deletions(-) diff --git a/R/MeanDims.R b/R/MeanDims.R index 14399e8..8beb41a 100644 --- a/R/MeanDims.R +++ b/R/MeanDims.R @@ -67,31 +67,16 @@ MeanDims <- function(data, dims, na.rm = TRUE, ncores = NULL) { # Calculate MeanDims if (length(dims) == length(dim(data)) || length(dim(data)) == 1) { res <- mean(data, na.rm = na.rm) + } else if (length(dims) == 1) { + if (is.character(dims)) { + pos <- which(names(dim(data)) == dims) + } + pos <- (1:length(dim(data)))[-pos] + res <- apply(data, pos, mean, na.rm = na.rm) } else { res <- Apply(list(data), target_dims = list(dims), fun = mean, na.rm = na.rm, ncores = ncores)$output1 } - ## Change character dims into indices - #if (is.character(dims)) { - # tmp <- rep(0, length(dims)) - # for (i in 1:length(dims)) { - # tmp[i] <- which(names(dim(data)) == dims[i]) - # } - #dims <- tmp - #} - - #if (length(dim(data)) == 1) { - # res <- mean(data, na.rm = na.rm) - #} else { - - # margins <- setdiff(c(1:length(dim(data))), dims) - # res <- as.array(apply(data, margins, mean, na.rm = na.rm)) - # if (!is.null(names(dim(data))[margins]) & is.null(names(dim(res)))) { - # names(dim(res)) <- names(dim(data))[margins] - # } - #} - return(res) - } -- GitLab From 9d4711883bac053371343fdcd977f82dc4324115 Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 7 Jan 2021 12:49:30 +0100 Subject: [PATCH 3/4] Fix when dims is numeric --- R/MeanDims.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/MeanDims.R b/R/MeanDims.R index 8beb41a..1a808b8 100644 --- a/R/MeanDims.R +++ b/R/MeanDims.R @@ -69,9 +69,9 @@ MeanDims <- function(data, dims, na.rm = TRUE, ncores = NULL) { res <- mean(data, na.rm = na.rm) } else if (length(dims) == 1) { if (is.character(dims)) { - pos <- which(names(dim(data)) == dims) + dims <- which(names(dim(data)) == dims) } - pos <- (1:length(dim(data)))[-pos] + pos <- (1:length(dim(data)))[-dims] res <- apply(data, pos, mean, na.rm = na.rm) } else { res <- Apply(list(data), target_dims = list(dims), fun = mean, -- GitLab From 487dcc7c6eef663679928e6d7d15dd4e1e77fd6a Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 7 Jan 2021 13:11:02 +0100 Subject: [PATCH 4/4] na.rm default to FALSE --- R/MeanDims.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/MeanDims.R b/R/MeanDims.R index 1a808b8..4b22d51 100644 --- a/R/MeanDims.R +++ b/R/MeanDims.R @@ -24,7 +24,7 @@ #'MeanDims(a, 2) #'MeanDims(a, c(2, 3)) #'@export -MeanDims <- function(data, dims, na.rm = TRUE, ncores = NULL) { +MeanDims <- function(data, dims, na.rm = FALSE, ncores = NULL) { # Check inputs ## data -- GitLab