Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
#'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).
#'
#'@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))
#'print(a)
#'print(Mean1Dim(a, 2))
#'print(MeanListDim(a, c(2, 3)))
#'@export
MeanDims <- function(data, dims, na.rm = TRUE) {
# 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
## 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)
}