Newer
Older
#'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
#'a <- array(rnorm(24), dim = c(2, 3, 4))
#'MeanDims(a, 2)
#'MeanDims(a, c(2, 3))
MeanDims <- function(data, dims, na.rm = TRUE, ncores = NULL) {
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
# 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 {
res <- Apply(list(data), target_dims = list(dims), fun = mean,
na.rm = na.rm, ncores = ncores)$output1