Применение функции между определенными парами столбцов в матрице в R

Я создаю матрицу с помощью пакета lsa в R. После создания матрицы я хотел бы рассчитать косинусное сходство между конкретными парами документов (столбцами) в матрице.

В настоящее время я делаю это с вложенными циклами for, и это чудовищно медленно. В приведенном ниже коде есть 150 sourceID и 6413 targetID, всего 961 950 сравнений. После полутора часов работы на моей вычислительной машине я просмотрел только около 300 000 из них.

Для получения дополнительной информации 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

person E. Moritz    schedule 21.04.2013    source источник
comment
Было бы проще, если бы вы предоставили более воспроизводимый пример, так как даже после установки lsa мне, по-видимому, нужно установить что-то еще (Java?). Я бы просто дал очень простой пример кадра данных с dput и ожидаемым результатом. Я полагаю, что сам пакет lsa не имеет отношения к проблеме заполнения матрицы.   -  person Maxim.K    schedule 21.04.2013
comment
Насколько я понял в вашем коде, у вас есть два вектора одинаковой длины, содержащие некоторые значения. На выходе вы хотите получить значения косинуса для всех комбинаций элементов этих начальных векторов. Если это так, то outer() вам, вероятно, поможет.   -  person Maxim.K    schedule 21.04.2013
comment
@ Максим, если это ответ, то ОП действительно в опасности!   -  person flodel    schedule 21.04.2013
comment
Я добавил воспроизводимый пример в исходный пост.   -  person E. Moritz    schedule 21.04.2013
comment
Это медленно, потому что вы не выделили заранее lsa.similarities.   -  person flodel    schedule 21.04.2013


Ответы (1)


Хорошо, спасибо за воспроизводимый пример. Вот возможное решение. Давайте сначала разделим вашу theMatrix на исходную и целевую матрицы. Здесь нам не нужно использовать имена, так как мы не будем использовать циклы:

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

Затем мы создадим функцию для перебора каждого столбца матрицы2, сохраняя константой один столбец матрицы1:

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, когда вы используете циклы, предварительно выделяйте свой (пустой) целевой объект в памяти, заполняя его, например. с Н.А. Выделение памяти является наиболее дорогостоящим с точки зрения времени, и именно поэтому ваш исходный цикл был таким медленным.

РЕДАКТИРОВАТЬ:

Лучшей формой с использованием чистой функции, вероятно, будет:

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

pairwiseCosine(theMatrix[,1:3],theMatrix[,4:7])
person Maxim.K    schedule 21.04.2013
comment
Большое тебе спасибо. Эта часть теперь занимает всего ~ 15 секунд. - person E. Moritz; 21.04.2013
comment
Я только что присоединился, и у меня недостаточно репутации, чтобы голосовать :-( Но как только я это сделаю... - person E. Moritz; 21.04.2013