행렬의 특정 쌍 사이의 함수 적용 R

Question

R에서 lsa 패키지를 사용하여 행렬을 생성합니다. 행렬을 만든 후에 특정 쌍의 코사인 유사성을 계산하고 싶습니다. 열).

현재 중첩 된 for-loops로이 작업을 수행하고 있으며 괴물로입니다. 아래의 코드에는 150 소스 코드 및 6413 대상 ID이 있으며 총 961.950 회의 비교가 이루어집니다. 1 시간 반 동안 컴퓨터를 사용하다가 300K를 넘었습니다. 더 많은 정보를 들어

, sourceIDs 및 targetIDs 그 이름을 포함하는 두 개의 파일에서로드 열 이름의 벡터이다. 모든 소스 -> 목표 쌍 사이에 코사인 함수를 적용하고 싶습니다. 열은. 자열 인. 서 이름으로 색인화됩니다.

을 적용하면 훨씬 빠른 방법이 가능할 것으로 확신하지만, 그저 내 머리를 감쌀 수 없습니다.

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을 소스 및 대상 행렬로 나눕니다.

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

: 그럼 우리는 행렬 2의 모든 컬럼을 통해 루프 기능을 만듭니다

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

행렬 1 상수에서 하나의 열을 유지, 우리는 루프를 사용하지 않으므로 우리는 여기서 이름을 사용할 필요가 없습니다

마지막으로, 우리는 행렬 1의 모든 열이 기능을 제공합니다 :

(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])