R:成对矩阵的向量化循环
R: Vectorize loop for pairwise matrix
我希望对 R 中的一个循环进行矢量化,该循环计算与建议顺序相关的成对矩阵的元素。
这个问题用例子更容易理解:
给定一个示例矩阵
m <- matrix(c(0,2,1,0,0,2,2,1,0), nrow = 3)
row.names(m) <- colnames(m) <- c("apple", "orange", "pear")
您可以想象 m 的列来标识一个人选择一种水果而不是另一种水果的次数。比如m中有1个人选择了苹果而不是梨,但是有两个人选择了梨而不是苹果。
因此,给定一个表示三种水果受欢迎程度的建议顺序:
p.order <- c("apple" = 2, "orange" = 1, "pear" = 3)
我想统计p.order不能很好地代表他们的选择的人数。
为此,我有一个工作正常的循环:
new.m <- array(dim = c(nrow(m), nrow(m)))
for(p in 1:nrow(m)){
for(q in 1:nrow(m)){
new.m[p,q] <- 0 + (p.order[p] < p.order[q])
}
}
sum(m * new.m)
但是考虑到足够大的问题,这个循环很慢。
有没有办法矢量化(或加速)这个循环?
更新
根据要求,已接受解决方案的性能:
循环函数:
loop.function <- function(p.order, mat){
nt <- nrow(mat)
new.m <- array(dim=c(nt,nt))
for(p in 1:nt){ for(q in 1:nt){ new.m[p,q] <- 0 + (p.order[p] < p.order[q])}}
return(sum(mat * new.m))
}
矢量化函数:
vec.function <- function(p.order, mat){
return(sum(mat * outer(p.order, p.order, FUN = `<`)))
}
性能:
Unit: microseconds
expr min lq mean median uq max neval
loop.function(p.order, m) 14.4 14.7 93.049 14.9 15.15 7805.5 100
vec.function(p.order, m) 7.6 8.1 33.850 8.3 8.60 2474.9 100
cld
a
a
这是一个矢量化选项 outer
sum(m * outer(p.order, p.order, FUN = `<`))
#[1] 5
我希望对 R 中的一个循环进行矢量化,该循环计算与建议顺序相关的成对矩阵的元素。
这个问题用例子更容易理解:
给定一个示例矩阵
m <- matrix(c(0,2,1,0,0,2,2,1,0), nrow = 3)
row.names(m) <- colnames(m) <- c("apple", "orange", "pear")
您可以想象 m 的列来标识一个人选择一种水果而不是另一种水果的次数。比如m中有1个人选择了苹果而不是梨,但是有两个人选择了梨而不是苹果。
因此,给定一个表示三种水果受欢迎程度的建议顺序:
p.order <- c("apple" = 2, "orange" = 1, "pear" = 3)
我想统计p.order不能很好地代表他们的选择的人数。
为此,我有一个工作正常的循环:
new.m <- array(dim = c(nrow(m), nrow(m)))
for(p in 1:nrow(m)){
for(q in 1:nrow(m)){
new.m[p,q] <- 0 + (p.order[p] < p.order[q])
}
}
sum(m * new.m)
但是考虑到足够大的问题,这个循环很慢。
有没有办法矢量化(或加速)这个循环?
更新 根据要求,已接受解决方案的性能:
循环函数:
loop.function <- function(p.order, mat){
nt <- nrow(mat)
new.m <- array(dim=c(nt,nt))
for(p in 1:nt){ for(q in 1:nt){ new.m[p,q] <- 0 + (p.order[p] < p.order[q])}}
return(sum(mat * new.m))
}
矢量化函数:
vec.function <- function(p.order, mat){
return(sum(mat * outer(p.order, p.order, FUN = `<`)))
}
性能:
Unit: microseconds
expr min lq mean median uq max neval
loop.function(p.order, m) 14.4 14.7 93.049 14.9 15.15 7805.5 100
vec.function(p.order, m) 7.6 8.1 33.850 8.3 8.60 2474.9 100
cld
a
a
这是一个矢量化选项 outer
sum(m * outer(p.order, p.order, FUN = `<`))
#[1] 5