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

时间:2013-04-21 12:28:59

标签: r matrix apply lsa

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

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

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

我确信使用 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

1 个答案:

答案 0 :(得分:5)

好的,感谢可重复的例子。这是一个可能的解决方案。我们首先将您的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])