Search code examples
rhydrogof

Nesting apply in lapply to loop over columns of a list of matrices


I have a list of matrices, and I'm trying to apply a function to each column of each of the matrices. The natural way to do that, I would think, is to nest apply in an lapply, but when I do that, it gives me an error:

library(hydroGOF)  # for the mse function

# Create a vector for comparison
A <- rnorm(10)

# Create a list of matrices to be looped over
B <- rnorm(10 * 5 * 3)
list.element.number <- rep(1:3, 50)
B.list <- split(B, list.element.number)
B.list <- lapply(B.list, matrix, ncol = 5, nrow = 10)  # A 3 element list of 10 x 5 matrices

# Wrapper function for mse
my.mse <- function(sim) {
  mse(sim, A)
}

# I'm trying to loop through each column of B.list and compare it to A
lapply(B.list, apply, MARGIN = 2, FUN = my.mse)
# Error in FUN(X[[1L]], ...) : 
#   unused arguments (function (X, MARGIN, FUN, ...) 
#   {
#     FUN <- match.fun(FUN)
#     dl <- length(dim(X))
#     if (!dl) stop("dim(X) must have a positive length")
#     if (is.object(X)) X <- if (dl == 2) as.matrix(X) else as.array(X)
#     d <- dim(X)
#     dn <- dimnames(X)
#     ds <- seq_len(dl)
#     if (is.character(MARGIN)) {
#       if (is.null(dnn <- names(dn))) stop("'X' must have named dimnames")
#       MARGIN <- match(MARGIN, dnn)
#       if (anyNA(MARGIN)) stop("not all elements of 'MARGIN' are names of dimensions")
#     }
#     s.call <- ds[-MARGIN]
#     s.ans <- ds[MARGIN]
#     d.call <- d[-MARGIN]
#     d.ans <- d[MARGIN]
#     dn.call <- dn[-MARGIN]
#     dn.ans <- dn[MARGIN]
#     d2 <- prod(d.ans)
#     if (d2 == 0) {
#       newX <- array(vector(typeof(X), 1), dim = c(prod(d.call), 1))
#       ans <- FUN(if (length(d.call) < 2) newX[, 1] else array(newX[, 1], d.call, dn.call), ...)
#       return(if (is.null(ans)) ans else if (length(d.ans) < 2) ans[1][-1] else array(ans, d.ans, dn.a

Ideally, this would give me a 3 element list, where each element is a 5 element vector, but instead I get an error. Does anyone know how to fix this (other than a for loop, which feels inelegant), or what's going wrong?


Solution

  • FUN=my.mse is hijacking your attempt to lapply apply. I think you want:

    lapply(B.list, function(x) apply(x, 2, my.mse))
    

    You can't specify FUN for both lapply and apply in the same call (unless you use positional matching as Konrad suggests). What's happening is that your call is getting matched like so:

    lapply(B.list, FUN=my.mse, ...=list(apply, MARGIN=2))
    

    Which then in your first iteration leads to the attempt to evaluate:

    my.mse(B.list[[1]], apply, MARGIN=2)
    

    instead of your expected apply(B.list[[1]], 2, my.mse). Since my.mse only accepts one argument, you get the error about "unused argument". If you look closely, the "unused argument" is the body of the apply function.