#'Average an array along multiple dimensions #' #'This function returns the mean of an array along a set of dimensions and #'preserves the dimension names if it has. #' #'@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). #'@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(2, 3, 4)) #'MeanDims(a, 2) #'MeanDims(a, c(2, 3)) #'@export MeanDims <- function(data, dims, na.rm = FALSE, ncores = NULL) { # Check inputs ## data if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") } if (!is.numeric(data)) { stop("Parameter 'data' must be a numeric array.") } if (is.null(dim(data))) { #is vector, turn into array data <- as.array(data) } ## dims if (is.null(dims)) { stop("Parameter 'dims' cannot be NULL.") } if (!is.vector(dims) | (is.vector(dims) & !is.numeric(dims) & !is.character(dims))) { stop("Parameter 'dims' must be a vector of numeric or character string.") } if (is.numeric(dims)) { if (any(dims < 1) | any(dims %% 1 != 0)) { stop("Parameter 'dims' must be positive integers.") } else if (any(dims > length(dim(data)))) { stop("Parameter 'dims' exceeds the dimension length of parameter 'data'.") } } if (is.character(dims)) { if (!all(dims %in% names(dim(data)))) { stop("Parameter 'dims' do not match the dimension names of parameter 'data'.") } } ## na.rm if (!is.logical(na.rm) | length(na.rm) > 1) { stop("Parameter 'na.rm' must be one logical value.") } ############################### # 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)) { dims <- which(names(dim(data)) == dims) } 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, na.rm = na.rm, ncores = ncores)$output1 } return(res) }