2012-12-17 4 views
10

nx 행렬에서 대각선이 아닌 각 원소의 평균을 계산해야합니다. 아래쪽 삼각형과 위쪽 삼각형은 중복됩니다. 현재 사용중인 코드는 다음과 같습니다.대용량 행렬에서 대각선을 벗어난 평균을 더 빨리 계산하는 방법

A <- replicate(500, rnorm(500)) 
sapply(1:(nrow(A)-1), function(x) mean(A[row(A) == (col(A) - x)])) 

더 큰 매트릭스에서는 잘 작동하지 만 잘 변형되지 않습니다. 내가 가진 것들 2-5000^2 주위에 거대한 아니지만, 심지어 1000^2 내가 좋아하는 것보다 더 오래 복용 :

A <- replicate(1000, rnorm(1000)) 
system.time(sapply(1:(nrow(A)-1), function(x) mean(A[row(A) == (col(A) - x)]))) 
> user system elapsed 
> 26.662 4.846 31.494 

이 일을 더 똑똑한 방법이 있나요?

편집 분명히하기 위해 각 대각선의 평균을 개별적으로 나타내고 싶습니다. 를 위해 :

1 2 3 4 
1 2 3 4 
1 2 3 4 
1 2 3 4 

내가 좋아하는 것 :

mean(c(1,2,3)) 
mean(c(1,2)) 
mean(1) 

답변

14

당신이 얻을 수있는 속도가 매우 빠르고 바로 바로 해결 선형 사용하여 대각선을 추출하여 : superdiag 여기에 추출을 i 번째 superdiagonal A로부터 (I = 1 주 대각선)

> A <- replicate(1000, rnorm(1000)) 

> system.time(sapply(1:(nrow(A)-1), function(x) mean(A[row(A) == (col(A) - x)]))) 
    user system elapsed 
26.464 3.345 29.793 

> system.time(superdiagmeans(A)) 
    user system elapsed 
    0.033 0.006 0.039 

이 당신에게 결과를 제공하십시오 1K 정방 행렬에이 실행

superdiag <- function(A,i) { 
    n<-nrow(A); 
    len<-n-i+1; 
    r <- 1:len; 
    c <- i:n; 
    indices<-(c-1)*n+r; 
    A[indices] 
} 

superdiagmeans <- function(A) { 
    sapply(2:nrow(A), function(i){mean(superdiag(A,i))}) 
} 

~의 800x 속도 향상을 제공합니다 원본과 같은 순서로

+1

색인을 잘 사용합니다. 그것이 얼마나 강력한 지표가 될 수 있는지를 보여주기 때문에, 나는 이것을 받아 들여진 대답으로 투표한다. –

+1

고맙습니다.하지만 당신의 것이 훨씬 명확합니다. @ JorisMeys; 이 방법은 _lot_ 및 두 번째 광고의 10 분의 1을 수행해야하는 경우에만 추가 합병증의 가치가 있습니다. –

+0

매우 똑똑합니다. 나는 무엇이 진행되고 있었는지 이해하기 위해 색인 생성을해야했습니다. 답변을 주셔서 감사합니다 – blmoore

10

다음과 같은 기능을 사용할 수 있습니다 : 우리는 당신의 매트릭스에이를 확인하면

diagmean <- function(x){ 
    id <- row(x) - col(x) 
    sol <- tapply(x,id,mean) 
    sol[names(sol)!='0'] 
} 

을, 속도 이득이 상당하다 :

> system.time(diagmean(A)) 
    user system elapsed 
    2.58 0.00 2.58 

> system.time(sapply(1:(nrow(A)-1), function(x) mean(A[row(A) == (col(A) - x)]))) 
    user system elapsed 
    38.93 4.01 42.98 

이 함수는 위쪽 삼각형과 아래쪽 삼각형을 모두 계산합니다. 당신은 사용 예를 단지 낮은 삼각형을 계산할 수 있습니다 : 이것은 다른 속도 이득 결과

diagmean <- function(A){ 
    id <- row(A) - col(A) 
    id[id>=0] <- NA 
    tapply(A,id,mean) 
} 

합니다. 이 솔루션은 당신에 비해 반전됩니다 참고 :

> A <- matrix(rep(c(1,2,3,4),4),ncol=4) 

> sapply(1:(nrow(A)-1), function(x) mean(A[row(A) == (col(A) - x)])) 
[1] 2.0 1.5 1.0 

> diagmean(A) 
-3 -2 -1 
1.0 1.5 2.0 
+0

우수, 내 컴퓨터의 1k^2 행렬에 대해 1 초 미만입니다. 대단히 감사합니다. – blmoore

관련 문제