R中的多维数组乘法

我想执行一些复杂的多维数组乘法,其中我乘以数组的特定边距.

考虑这个例子,我在群体的某些边缘流行分组特征(A和B):

# setup data

random=runif(4)

group.prevalence <- aperm (array(c(random,1-random),
                  dim=c(2,2,2), 
                  dimnames=list(age=c("young","old"),
                                gender=c("male","female"),
                                group=c("A","B"))) , c(3,1,2) )

group.prevalence 
# A + B = 1

假设我现在有一群兴趣…

population <- round(array(runif(4, min=100,max=200) %o% c(1,1*(1+random[1]),1*(1+random[1])^2), 
                          dim=c(2,2,3), dimnames=list(age=c("young","old"),
                                                      gender=c("male","female"),
                                                      year=c("year1","year2","year3"))))

population

…我想计算“A”和“B”的流行程度.

糟糕的解决方案是在循环中填充所有内容:

# bad solution
grouped.population <- array(NA, dim=c(2,2,2,3), 
                            dimnames=list(group=c("A","B"),
                                          age=c("young","old"),
                                          gender=c("male","female"),
                                          year=c("year1","year2","year3")))

for (group in c("A","B"))
  for(gender in c("male","female"))
    for (age in c("young","old")) 
      grouped.population[group,age,gender,] <- group.prevalence[group,age,gender] * population[age,gender,]

但我认为某种应用可能派上用场,可能是plyr的aaply,因为结果的尺寸应该保留.我试过了:

library(plyr)
aaply(population, c(1,2), function(x) x * group.prevalence)
# too many dimensions

我欢迎任何建议.

最佳答案
对于您的特定情况,您可以计算:

out <- rep(group.prevalence, times=last(dim(population))) * 
       rep(population, each=first(dim(group.prevalence)))

然后你可以设置这个数组的尺寸:

array(out, dim=c(2,2,2,3), 
      dimnames=list(group=c("A","B"),
                    age=c("young","old"),
                    gender=c("male","female"),
                    year=c("year1","year2","year3")))

关键是通过转换尺寸和扩展/复制来对齐两个阵列的尺寸,以填充另一个阵列中缺少的尺寸.一般来说,程序是:

>识别相交的尺寸.在这里,它是(年龄,性别).
>对于乘法的左侧参数group.prevalence,置换维度(使用精子),以便所有非交叉维度(即组)是第一个.然后,复制该数组N次(使用次数),其中N是右侧参数,种群的非交叉维度(即年份)的大小.
>对于乘法,群体的右侧参数,置换维度,使所有非交叉维度(即年份)最后.然后,复制数组的每个元素M次(使用每个),其中M是左手侧参数group.prevalence的非相交维度(即,组)的大小.
>然后只是(数组)相乘,这是矢量化和快速的.
>结果的联合维度只是左侧参数的非交叉维度,后面是交叉维度,后面是右侧的非交叉维度(即,组,年龄,性别,年份) )).然后,您可以根据需要在输出中置换这些尺寸,以获得您想要的效果.

作为检查:

# bad solution
grouped.population <- array(NA, dim=c(2,2,2,3), 
                            dimnames=list(group=c("A","B"),
                                          age=c("young","old"),
                                          gender=c("male","female"),
                                          year=c("year1","year2","year3")))

for (group in c("A","B"))
  for(gender in c("male","female"))
    for (age in c("young","old")) 
      grouped.population[group,age,gender,] <- group.prevalence[group,age,gender] * population[age,gender,]

# another approach
grouped.population2 <- array(rep(group.prevalence, times=last(dim(population))) * 
                             rep(population, each=first(dim(group.prevalence))), 
                             dim=c(2,2,2,3), 
                             dimnames=list(group=c("A","B"),
                                           age=c("young","old"),
                                           gender=c("male","female"),
                                           year=c("year1","year2","year3")))

# check
all.equal(grouped.population,grouped.population2)
##[1] TRUE

更新了基准:

library(microbenchmark)

f1 <- function(group.prevalence, population) {
  grouped.population <- array(NA, dim=c(2,2,2,3), 
                              dimnames=list(group=c("A","B"),
                                            age=c("young","old"),
                                            gender=c("male","female"),
                                            year=c("year1","year2","year3")))
  for (group in c("A","B")) {
    for(gender in c("male","female")) {
      for (age in c("young","old")) {
        grouped.population[group,age,gender,] <- group.prevalence[group,age,gender] * population[age,gender,]}}}
}

f2 <- function(group.prevalence, population) {
  grouped.population2 <- array(rep(group.prevalence, times=last(dim(population))) * 
                               rep(population, each=first(dim(group.prevalence))), 
                               dim=c(2,2,2,3), 
                               dimnames=list(group=c("A","B"),
                                             age=c("young","old"),
                                             gender=c("male","female"),
                                             year=c("year1","year2","year3")))
}

print(microbenchmark(f1(group.prevalence, population)))
##Unit: microseconds
##                             expr     min      lq     mean   median      uq     max neval
## f1(group.prevalence, population) 101.473 103.998 149.2562 106.8865 115.372 1185.32   100
print(microbenchmark(f2(group.prevalence, population)))
##Unit: microseconds
##                             expr    min     lq     mean median      uq     max neval
## f2(group.prevalence, population) 66.392 67.672 70.19873 68.454 69.4205 173.284   100

我相信随着每个尺寸的尺寸和尺寸的增加,性能会更加分散.

转载注明原文:R中的多维数组乘法 - 代码日志