在R中使此循环更快

Question

如何加快以下（菜鸟）代码的速度：

#"mymatrix" is the matrix of word counts (docs X terms) 
#"tfidfmatrix" is the transformed matrix
tfidfmatrix = Matrix(mymatrix, nrow=num_of_docs, ncol=num_of_words, sparse=T)

#Apply a transformation on each row of the matrix
for(i in 1:dim(mymatrix)[[1]]){
  r = mymatrix[i,]
  s = sapply(r, function(x) ifelse(x==0, 0, (1+log(x))*log((1+ndocs)/(1+x)) ) )
  tfmat[i,] = s/sqrt(sum(s^2))
}
return (tfidfmatrix)

问题是我正在处理的矩阵相当大（〜40kX100k），并且此代码非常慢。

我不使用“ apply”（而不是使用for循环和sapply）的原因是apply会给我所需矩阵的转置-我想要num_of_docs X num_of_words，但是apply会给我转置。 然后，我将不得不花费更多的时间来计算转置并重新分配它。

有什么想法可以加快速度吗？

非常感谢。

编辑：我发现下面的建议大大加快了我的代码（除了使我感到愚蠢）。 关于在哪里可以学习编写“优化的” R代码的任何建议？

编辑2：好，所以有些不对劲。 一旦我执行s.vec[!is.finite(s.vec)] <- 0 ，s.vec的每个元素都将设置为0。仅重申一下我的原始矩阵是一个包含整数的稀疏矩阵。 这是由于我使用的Matrix软件包有些古怪。 当我执行s.vec[which(s.vec==-Inf)] <- 0工作正常。 有什么想法吗？

Answer 1

根据我的评论，

#Slightly larger example data
mymatrix <- matrix(runif(10000),nrow=10)
mymatrix[sample(10000,100)] <- 0
tfmat <- matrix(nrow=10, ncol=1000)
ndocs <- 1

justin <- function(){
    s.vec <- ifelse(mymatrix==0, 0, (1 + log(mymatrix)) * log((1 + ndocs)/(1 + mymatrix)))
    tfmat.vec <- s.vec/sqrt(rowSums(s.vec^2))
}

joran <- function(){
    s.vec <- (1 + log(mymatrix)) * log((1 + ndocs)/(1 + mymatrix))
    s.vec[!is.finite(s.vec)] <- 0
    tfmat.vec <- s.vec/sqrt(rowSums(s.vec^2))
}

require(rbenchmark)    
benchmark(justin(),joran(),replications = 1000)

  test replications elapsed relative user.self sys.self user.child sys.child
2  joran()         1000   0.940  1.00000     0.842    0.105          0         0
1 justin()         1000   2.786  2.96383     2.617    0.187          0         0

因此大约快了3倍。

Answer 2

不知道什么ndocs是，但ifelse已经是矢量，所以你应该能够使用ifelse声明，非经行和矩阵行走sapply沿行。 最终计算也可以这样说。

但是，您尚未提供完整的示例来进行复制...

mymatrix <- matrix(runif(100),nrow=10)
tfmat <- matrix(nrow=10, ncol=10)
ndocs <- 1

s.vec <- ifelse(mymatrix==0, 0, 1 + log(mymatrix)) * log((1 + ndocs)/(1 + mymatrix))

for(i in 1:dim(mymatrix)[[1]]){
  r = mymatrix[i,]
  s = sapply(r, function(x) ifelse(x==0, 0, (1+log(x))*log((1+ndocs)/(1+x)) ) )
  tfmat[i,] <- s
}

all.equal(s.vec, tfmat)

因此唯一缺少的是最终计算中的rowSums 。

tfmat.vec <- s.vec/sqrt(rowSums(s.vec^2))

for(i in 1:dim(mymatrix)[[1]]){
  r = mymatrix[i,]
  s = sapply(r, function(x) ifelse(x==0, 0, (1+log(x))*log((1+ndocs)/(1+x)) ) )
  tfmat[i,] = s/sqrt(sum(s^2))
}

all.equal(tfmat, tfmat.vec)