在 r 中使用多个 3D 数组和 Apply 函数

编程问答 2022-05-15

问题描述

我正在尝试使用 R 中的“应用”函数将函数应用于多个 3D 数组的 z 轴。

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

mean_daily_LW <- function(albedo=array1[1,1,],qlin=array2[1,qlem=array3[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,]) # I calculate 107.4

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

我不确定我是否正确索引了 x 轴和 y 轴。我更愿意在不使用循环的情况下执行此操作。

解决方法

它不起作用，因为 qlin 和 qlem 正在获取完整数据集。相反，使用 dim 循环遍历 array 之一的第一个和第二个 dim 属性（因为它们都具有相同的 Map），提取基于索引并应用函数

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

-检查 1,1 的输出

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

如果我们想要所有的组合，

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,])) %>% 
    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

或者在outer中使用base R

outer(seq(dim(array1)[1]),seq(dim(array1)[2]),FUN = Vectorize(function(i,j) mean_daily_LW(albedo = array1[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
applyarraysarraysarrayscustom-functionmultidimensional-arrayrr