R:成对矩阵的矢量化循环

Question

我希望在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

Answer 1

这是一个带有outer的矢量化选项

sum(m * outer(p.order, p.order, FUN = `<`))
#[1] 5