CODEWITHSUNDEEP
rarraysmultidimensional-arrayapplycustom-function
Mikey Johnson
Mikey Johnson

Reputation: 55

Using multiple 3D arrays and the Apply function in r

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.

Upvotes: 1

Views: 111

Answers (1)

akrun
akrun

Reputation: 887501

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 arrays (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

Upvotes: 2

Related Questions