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

Question

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

В настоящее время я делаю это с вложенными петлями, и это monstrously slow. В приведенном ниже коде есть 150 исходных идентификаторов и 6413 targetIDs, в общей сложности 961,950 сравнений. Спустя полтора часа на моей машине с номером-хрустом она достигла всего ~ 300 тыс. Из них.

Для получения дополнительной информации, sourceIDs и targetIDs векторы имен столбцов, загруженные в двух файлов, содержащих эти имена. Я хочу применить косинусную функцию между всеми парами source-> target. Столбцы индексируются по имени документа, которое является строкой.

Я уверен, что существует гораздо более быстрый способ сделать это с помощью применить, но я просто не могу обернуть вокруг себя голову.

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) 

Edit: Воспроизводимые пример

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

EDIT:

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

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

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