在R中的矩阵中的特定列对之间应用函数

Question

我在R中使用lsa包生成矩阵.创建矩阵后,我想计算矩阵中特定文档对(列)之间的余弦相似度.

目前,我使用嵌套的for循环执行此操作,并且速度非常慢.在下面的代码中,有150个sourceID和6413个targetID,总共961.950个比较.在我的数字碾压机上一个半小时后,它只能通过~300k.

有关详细信息,sourceID和targetID是列名称的向量,从包含这些名称的两个文件加载.我想在所有源 - >目标对之间应用余弦函数.列由文档名称索引,文档名称是字符串.

我确信使用apply有一个更快的方法,但是我无法绕过它.

library(lsa)

# tf function
real_tf <- function(m)
{
    return (sweep(m, MARGIN=2, apply(m, 2, max), "/"))
}

#idf function
real_idf <- function(m)
{
    df = rowSums(lw_bintf(m), na.rm=TRUE)
    return (log(ncol(m)/df))
}

#load corpus
lsa.documents <- textmatrix(args[1], minWordLength=1, minDocFreq=0)

# compute tf-idf
lsa.weighted_documents <- real_tf(lsa.documents) * real_idf(lsa.documents)

# compute svd
lsa.nspace <- lsa(lsa.weighted_documents, dims = as.integer(args[5]))
lsa.matrix <- diag(lsa.nspace$sk) %*% t(lsa.nspace$dk)

# compute similarities
lsa.sourceIDs <- scan(args[2], what = character())
lsa.targetIDs <- scan(args[3], what = character())
lsa.similarities <- data.frame(SourceID=character(), TargetID=character(), Score=numeric(), stringsAsFactors=FALSE)
k <- 1
for (i in lsa.sourceIDs)
{
    for (j in lsa.targetIDs)
    {
        lsa.similarities[k,] <- c(i, j, cosine(lsa.matrix[,i], lsa.matrix[,j]))
        k <- k + 1
    }
}
lsa.ranklist <- lsa.similarities[order(lsa.similarities$Score, decreasing=TRUE),]

# save ranklist
write.table(lsa.ranklist, args[4], sep="\t", quote=FALSE, col.names=FALSE, row.names=FALSE)

编辑:可重复的示例

# cosine function from lsa package
cosine <- function( x, y )
{
    return ( crossprod(x,y) / sqrt( crossprod(x)*crossprod(y) ) )
}

theMatrix <- structure(c(-0.0264639232505822, -0.0141165039351167, -0.0280459775632757, 
-0.041211247161448, -0.00331565717239375, -0.0291161345945683, 
-0.0451167802746869, -0.0116214407383401, -0.0381080747718958, 
-1.36693644389599, 0.274747343110076, 0.128100677705483, -0.401760905661056, 
-1.24876927957167, 0.368479552862631, -0.459711112157286, -0.544344448332346, 
-0.765378939625159, -1.28612431910459, 0.293455499695499, 0.025167452173962
), .Dim = c(3L, 7L), .Dimnames = list(NULL, c("doc1", "doc2", "doc3", 
"doc4", "doc5", "doc6", "doc7")))

sources <- c("doc1", "doc2", "doc3")
targets <- c("doc4", "doc5", "doc6", "doc7")

similarities <- data.frame(SourceID=character(), TargetID=character(), Score=numeric(), stringsAsFactors=FALSE)
k <- 1

for (i in sources)
{
    for (j in targets)
    {
        similarities[k,] <- c(i, j, cosine(theMatrix[,i], theMatrix[,j]))
        k <- k + 1
    }
}

ranklist <- similarities[order(similarities$Score, decreasing=TRUE),]
write.table(ranklist, "C:\\Temp\\outputfile.txt", sep="\t", quote=FALSE, col.names=FALSE, row.names=FALSE)

哪个产生(outputfile.txt):

doc1    doc6    0.962195242094352
doc3    doc6    0.893461576046585
doc2    doc6    0.813856201398669
doc2    doc7    0.768837903803964
doc2    doc4    0.730093288388069
doc3    doc7    0.675640649189972
doc3    doc4    0.635982900340315
doc1    doc7    0.53871688669971
doc1    doc4    0.499235059782688
doc1    doc5    0.320383772495164
doc3    doc5    0.226751624753921
doc2    doc5    0.144680489733846

Answer 1

好的,感谢可重复的例子.这是一个可能的解决方案.让我们首先将您theMatrix分为源矩阵和目标矩阵.我们不需要在这里使用名称,因为我们不会使用循环:

matrix1 <- theMatrix[,1:3]
matrix2 <- theMatrix[,4:7]

然后我们将创建一个函数来遍历matrix2的每一列,保持matrix1中的一列不变:

cycleM2 <- function(x) {
    # x is a vector from matrix1 
    apply(matrix2,2,cosine,x)
}

最后,我们将这个函数提供给matrix1的每一列:

(mydata <- apply(matrix1,2,cycleM2))

#      doc1      doc2      doc3
# doc4 0.4992351 0.7300933 0.6359829
# doc5 0.3203838 0.1446805 0.2267516
# doc6 0.9621952 0.8138562 0.8934616
# doc7 0.5387169 0.7688379 0.6756406

最后,如果您确实需要原始数据格式:

require(reshape2)
melt(mydata)

这应该可以很好地加速您的代码.另外,正如@flodel所注意到的,当你使用循环时,在内存中预先分配你的(空)目标对象,例如用NA填充它.内存分配在时间上是最昂贵的,这就是原始循环速度太慢的原因.

编辑:

使用纯函数的更好形式可能是:

pairwiseCosine <- function(matrix1,matrix2) {
    apply(matrix1,2,function(x){
        apply(matrix2,2,cosine,x)
    })
}

pairwiseCosine(theMatrix[,1:3],theMatrix[,4:7])