﻿ R中的多维数组乘法 - 代码日志

#### R中的多维数组乘法

``````# 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,]
``````

``````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
``````