2017-11-16 26 views
2

リストに格納されたベクトルのペアごとの組み合わせをすべて効率的に抽出する方法を探しています。このコードの目的は、100000回の反復でリサンプリングする手順の中で、可能なすべてのペアのデータベクトルの組み合わせの平均相関を計算することです。リスト内の要素の高速組み合わせR

# Data simulation 
set.seed(90) 
dummy_data <- matrix(runif(21120),33,640) 
dummy_list <- vector("list",length = 33) 
for (i in 1:33){ 
    dummy_list[[i]] <- dummy_data[i,] 
} 

私がこれまでに発見したソリューションです:それは本当に遅いですので、私はむしろ非効率的な見つけ

n_iter <- 100000 
cor_out <- vector("numeric",length = n_iter) 

# For each iteration 
for (z in 1:n_iter){ 

# Randomly shuffle the data 
dummy_list_resample <- lapply(dummy_list, FUN = function(x){sample(x,size = 640)}) 
all_ind <- length(dummy_list_resample) 
combs <- combn(all_ind,2) 

# Initialize list for storing all pairwise observations 
out_list <- vector("list",length(dim(combs)[2])) 

# For each pairwise combination 
for(i in 1:dim(combs)[2]){ 

    # Identify and extract the data for each pair of subject 
    pair <- combs[,i] 
    vec1 <- dummy_list_resample[[pair[1]]] 
    vec2 <- dummy_list_resample[[pair[2]]] 

    out_list[[i]] <- cbind(vec1,vec2) 
} 

# Compute correlation for each pairwise combination 
# and store the average value 
cor_iter <- sapply(out_list, FUN = function(x){cor(x[,1],x[,2])}) 
cor_out[z] <- mean(cor_iter) 
} 

(〜コンピューティングの12時間)

は、回避する方法はありますループ?私は反復を高速化する方法としてRcppを認識していますが、残念ながら私はC++に精通していません。ヒントや例があれば幸いです。

+0

あなたの例は機能しません - 確認してください –

+0

未定義の変数が原因でコードを実行できません。より具体的にすることができますか、またはあなたの期待される結果を理解するための実用的なコードを教えてください。 – JRR

+0

reprexを使用して、* repr * oducible * ex *を準備することができます。 http://reprex.tidyverse.org –

答えて

2

行列に連結することができ、cor関数は行列を取り込み、すべての列のペアごとの相関を計算します。

あなたの独創的なアプローチ:

list_cor <- function(seed=1) { 
    set.seed(seed) 
    dummy_list_resample <- lapply(dummy_list, FUN = function(x){sample(x,size = 640)}) 
    all_ind <- length(dummy_list_resample) 
    combs <- combn(all_ind,2) 
    # Initialize list for storing all pairwise observations 
    out_list <- vector("list",length(dim(combs)[2])) 

    # For each pairwise combination 
    for(i in 1:dim(combs)[2]){ 

    # Identify and extract the data for each pair of subject 
    pair <- combs[,i] 
    vec1 <- dummy_list_resample[[pair[1]]] 
    vec2 <- dummy_list_resample[[pair[2]]] 

    out_list[[i]] <- cbind(vec1,vec2) 
    } 

    # Compute correlation for each pairwise combination 
    # and store the average value 
    cor_iter <- sapply(out_list, FUN = function(x){cor(x[,1],x[,2])}) 
    mean(cor_iter) 
} 

マトリックスアプローチ:

mat_cor <- function(seed=1) { 
    set.seed(seed) 
    dummy_list_resample <- lapply(dummy_list, FUN = function(x){sample(x,size = 640)}) 
    dummy_mat <- do.call(cbind, dummy_list_resample) 
    cmat <- cor(dummy_mat) 
    mean(cmat[lower.tri(cmat)]) 
} 

スピードテスト:

library(microbenchmark) 
microbenchmark(sapply(1:10, mat_cor), sapply(1:10, list_cor), times=10) 

Unit: milliseconds 
        expr  min  lq  mean median  uq  max neval cld 
    sapply(1:10, mat_cor) 17.7916 19.00319 20.43652 20.68327 21.89248 22.72629 10 a 
sapply(1:10, list_cor) 609.1673 622.57560 631.03171 628.26800 633.77480 673.58373 10 b 

31.5倍速い〜のスピードアップ。

あなたは結果を確認することができますが(非常に小さな無関係な違いが原因浮動小数点精度にあります)同じです:あなたはまだこの後に、よりスピードアップが必要な場合

> mat_cor(1) 
[1] 3.210217e-05 
> list_cor(1) 
[1] 3.210217e-05 

、私は次に探してお勧めparallelパッケージ。

関連する問題