Giúp tăng tốc vòng lặp trong R

Question

về cơ bản tôi muốn thực hiện trung bình đường chéo trong R. Dưới đây là một số mã được điều chỉnh từ gói simsalabim để làm trung bình đường chéo. Chỉ có điều này là chậm.

Bất kỳ đề xuất nào để vector hóa điều này thay vì sử dụng một cách thủ công?

reconSSA <- function(S,v,group=1){ 
### S : matrix 
### v : vector 

    N <- length(v) 
    L <- nrow(S) 
    K <- N-L+1 
    XX <- matrix(0,nrow=L,ncol=K) 
    IND <- row(XX)+col(XX)-1 
    XX <- matrix(v[row(XX)+col(XX)-1],nrow=L,ncol=K) 
    XX <- S[,group] %*% t(t(XX) %*% S[,group]) 

    ##Diagonal Averaging 
    .intFun <- function(i,x,ind) mean(x[ind==i]) 

    RC <- sapply(1:N,.intFun,x=XX,ind=IND) 
    return(RC) 
} 

Đối với dữ liệu bạn có thể sử dụng sau đây

data(AirPassengers) 
v <- AirPassengers 
L <- 30 
T <- length(v) 
K <- T-L+1 

x.b <- matrix(nrow=L,ncol=K) 
x.b <- matrix(v[row(x.b)+col(x.b)-1],nrow=L,ncol=K) 
S <- eigen(x.b %*% t(x.b))[["vectors"]] 
out <- reconSSA(S, v, 1:10) 

Answer 1

Bạn có thể tăng tốc độ tính toán bằng gần 10 lần với sự giúp đỡ của một thủ thuật rất chuyên ngành với rowsum:

reconSSA_1 <- function(S,v,group=1){ 
### S : matrix 
### v : vector 
    N <- length(v) 
    L <- nrow(S) 
    K <- N-L+1 
    XX <- matrix(0,nrow=L,ncol=K) 
    IND <- row(XX)+col(XX)-1 
    XX <- matrix(v[row(XX)+col(XX)-1],nrow=L,ncol=K) 
    XX <- S[,group] %*% t(t(XX) %*% S[,group]) 
    ##Diagonal Averaging 
    SUMS <- rowsum.default(c(XX), c(IND)) 
    counts <- if(L <= K) c(1:L, rep(L, K-L-1), L:1) 
    else c(1:K, rep(K, L-K-1), K:1) 
    c(SUMS/counts) 
} 

all.equal(reconSSA(S, v, 1:10), reconSSA_1(S, v, 1:10)) 
[1] TRUE 

library(rbenchmark) 

benchmark(SSA = reconSSA(S, v, 1:10), 
      SSA_1 = reconSSA_1(S, v, 1:10), 
      columns = c("test", "elapsed", "relative"), 
      order = "relative") 


    test elapsed relative 
2 SSA_1 0.23 1.0000 
1 SSA 2.08 9.0435 

[Cập nhật: Như Joshua gợi ý nó có thể tăng tốc độ hơn nữa bằng cách sử dụng mấu chốt của mã rowsum:

reconSSA_2 <- function(S,v,group=1){ 
### S : matrix 
### v : vector 
    N <- length(v) 
    L <- nrow(S) 
    K <- N-L+1 
    XX <- matrix(0,nrow=L,ncol=K) 
    IND <- c(row(XX)+col(XX)-1L) 
    XX <- matrix(v[row(XX)+col(XX)-1],nrow=L,ncol=K) 
    XX <- c(S[,group] %*% t(t(XX) %*% S[,group])) 
    ##Diagonal Averaging 
    SUMS <- .Call("Rrowsum_matrix", XX, 1L, IND, 1:N, 
        TRUE, PACKAGE = "base") 
    counts <- if(L <= K) c(1:L, rep(L, K-L-1), L:1) 
    else c(1:K, rep(K, L-K-1), K:1) 
    c(SUMS/counts) 
} 

    test elapsed relative 
3 SSA_2 0.156 1.000000 
2 SSA_1 0.559 3.583333 
1 SSA 5.389 34.544872 

Một sự tăng tốc của x34.5 so với mã gốc !!

]

Answer 2

tôi không thể có được ví dụ của bạn để tạo ra kết quả hợp lý. Tôi nghĩ rằng có một số lỗi trong chức năng của bạn.

1. XX được sử dụng trong sapply, nhưng không được định nghĩa trong hàm
2. sapply công trình trên 1:N, nơi N=144 trong ví dụ của bạn, nhưng x.b chỉ có 115 cột
3. reconSSA chỉ đơn giản trả x

Bất kể, tôi nghĩ bạn muốn:

data(AirPassengers) 
x <- AirPassengers 
rowMeans(embed(x,30)) 

---

CẬP NHẬT: Tôi đã làm việc lại và lược tả chức năng. Phần lớn thời gian được sử dụng trong mean, vì vậy có thể khó có thể sử dụng mã R này nhanh hơn nhiều. Điều đó nói rằng, bạn có thể tăng tốc 20% bằng cách sử dụng sum thay thế.

reconSSA <- function(S,v,group=1){ 

    N <- length(v) 
    L <- nrow(S) 
    K <- N-L+1 
    XX <- matrix(0,nrow=L,ncol=K) 
    IND <- row(XX)+col(XX)-1 
    XX <- matrix(v[row(XX)+col(XX)-1],nrow=L,ncol=K) 
    XX <- S[,group] %*% t(t(XX) %*% S[,group]) 

    ##Diagonal Averaging 
    .intFun <- function(i,x,ind) { 
     I <- ind==i 
     sum(x[I])/sum(I) 
    } 

    RC <- sapply(1:N,.intFun,x=XX,ind=IND) 
    return(RC) 
}