Using multiple 3D arrays and the Apply function in r

Question

I am trying to apply a function to the z-axis of multiple 3D arrays using the "Apply" function in R.

set.seed(1963)
array1 <- array(sample(1:100, 5^3, replace=T), c(5,5,5))
array2 <- array(sample(1:100, 5^3, replace=T), c(5,5,5))
array3 <- array(sample(1:100, 5^3, replace=T), c(5,5,5))

mean_daily_LW <- function(albedo=array1[1,1,],
                          qlin=array2[1,1,],
                          qlem=array3[1,1,]){
  tmp1 <- which(albedo >= 40)
  tmp2 <- qlin[tmp1]
  tmp3 <- qlem[tmp1]
  tmp4 <- tmp2+tmp3
  tmp5 <- mean(tmp4)
  return(tmp5)
}

mean_daily_LW(albedo=array1[1,1,], qlin=array2[1,1,], qlem=array3[1,1,]) # I calculate 107.4

apply(array1, c(1,2), FUN=mean_daily_LW, qlin=array2, qlem=array3)[1,1] # I calculate 98.8

I am not sure if I am indexing the x-axis and y-axis correctly. I would prefer to do this without the use of a loop.

Answer 1

It wouldn't work because the qlin and qlem are getting the full dataset. Instead, loop over the 1st and 2nd dim attribute of one of the array s (as all of them have the same dim ) with Map , extract the data based on index and apply the function

unlist(Map(function(i, j)
    mean_daily_LW(albedo = array1[i, j, ],
                    qlin = array2[i, j, ],
                    qlem = array3[i, j,]), 
          seq(dim(array1)[1]),  seq(dim(array1)[2])))
#[1] 104.00 108.25 123.20 128.00 145.00

-checking on the output of 1,1

mean_daily_LW(albedo=array1[1,1,], qlin=array2[1,1,], qlem=array3[1,1,]) 
[1] 104

---

if we want all the combinations,

library(dplyr)
library(tidyr)
library(tibble)
crossing(i =  seq(dim(array1)[1]), j = seq(dim(array1)[2])) %>%
    rowwise %>% 
    mutate(value = mean_daily_LW(albedo = array1[i, j,], 
                                 qlin = array2[i, j, ], 
                                 qlem = array3[i, j, ])) %>% 
    ungroup %>%                              
    pivot_wider(names_from = j, values_from = value) %>% 
    column_to_rownames('i')
#         1         2        3     4     5
#1 104.0000  89.75000  85.0000 113.5  59.0
#2 128.6667 108.25000 109.6667 125.0  99.0
#3 101.0000  68.50000 123.2000 174.0 115.5
#4  95.2500 116.00000 131.5000 128.0  83.0
#5  77.2000  62.66667 112.5000 100.0 145.0

---

Or use outer in base R

outer(seq(dim(array1)[1]), seq(dim(array1)[2]), 
     FUN = Vectorize(function(i, j) mean_daily_LW(albedo = array1[i, j, ],
                    qlin = array2[i, j, ],
                    qlem = array3[i, j,])))
#        [,1]      [,2]     [,3]  [,4]  [,5]
#[1,] 104.0000  89.75000  85.0000 113.5  59.0
#[2,] 128.6667 108.25000 109.6667 125.0  99.0
#[3,] 101.0000  68.50000 123.2000 174.0 115.5
#[4,]  95.2500 116.00000 131.5000 128.0  83.0
#[5,]  77.2000  62.66667 112.5000 100.0 145.0