Question

我正在为以下问题寻找有效的解决方案：

b <- matrix(c(0,0,0,1,1,0), nrow = 2, byrow = T)
weight <- c(1,1)

times <- 5

abc <- do.call(rbind, replicate(times, b, simplify=FALSE))
weight <- rep.int(weight,times)

sum1 <- as.numeric(rep.int(NA,nrow(abc)))

##Rprof()
for(j in 1:nrow(abc)){
  a <- abc[j,]
  sum1[j] <- sum(weight[rowSums(t(a == t(abc)) + 0) == ncol(abc)])

}
##Rprof(NULL)
##summaryRprof()

有更快的方法吗？ Rprof表明rowSums（），t（），==和+非常慢。如果nrows为20,000，则需要21秒。

感谢您的帮助！

编辑：我有一个矩阵abc和一个长度等于nrow（abc）的向量权重。第一个权重值对应于矩阵abc的第一行，依此类推......现在，我想确定矩阵abc的哪一行是相等的。然后，我想记住那些行的位置，以便总结具有相同位置的相应权重。我希望为每一行存储适当的金额。

Answer 1

这是一种看起来有效且快速的方法：

ff <- function(mat, weights)
{
   rs <- apply(mat, 1, paste, collapse = ";")
   unlist(lapply(unique(rs), 
                 function(x) 
                      sum(weights[match(rs, x, 0) > 0])))[match(rs, unique(rs))]
}

ff(abc, weight)
# [1] 5 5 5 5 5 5 5 5 5 5

与你的功能相比：

ffOP <- function(mat, weights) 
{
   sum1 <- as.numeric(rep.int(NA,nrow(mat)))
   for(j in 1:nrow(mat)) {
       a <- mat[j,]
       sum1[j] <- sum(weights[rowSums(t(a == t(mat)) + 0) == ncol(mat)])
   }
   sum1
}
ffOP(abc, weight)
# [1] 5 5 5 5 5 5 5 5 5 5

library(microbenchmark)
m = do.call(rbind, replicate(1e3, matrix(0:11, 3, 4), simplify = F))
set.seed(101); w = runif(1e3*3)
all.equal(ffOP(m, w), ff(m, w))
#[1] TRUE
microbenchmark(ffOP(m, w), ff(m, w), times = 10)
#Unit: milliseconds
#       expr       min        lq    median         uq        max neval
# ffOP(m, w) 969.83968 986.47941 996.68563 1015.53552 1051.23847    10
#   ff(m, w)  20.42426  20.64002  21.36508   21.97182   22.59127    10

为了记录，我也用C实现了你的方法，这里是基准：

#> microbenchmark(ffOP(m, w), ff(m, w), ffC(m, w), times = 10)
#Unit: milliseconds
#       expr       min        lq    median         uq        max neval
# ffOP(m, w) 957.66691 967.09429 991.35232 1000.53070 1016.74100    10
#   ff(m, w)  20.60243  20.85578  21.70578   22.13434   23.04924    10
#  ffC(m, w)  36.24618  36.40940  37.18927   37.39877   38.83358    10

将每行与其他矩阵行进行比较

1 个答案: