この単純なループをRでより効率的にするには？

Question

大きなデータセットをクリーニングしようとしています。私は日付順に価格の行列を持っています。最初の行には最新の日付、列には異なる在庫があります。特定の株式の価格が不足している場合、またはその日のNAがない場合は、前日の価格を使用します。最終日の価格がNAならば、私はそれを残す。

まず、行列全体をループし、各（i、j）ペアに対してIF文を使用します。これは非常に遅かったです。次のアプローチは、価格行列bについては次のようになります。インデックス化を使用してNAであるインデックスを検索し、これらのみを処理します。

for(j in 1:ncol(b)) 
{ 

Index<-which(is.na(b[,j]) | b[,j]==0) 
if(length(Index)==0) 
{print("0 Missings") 
Index<-c(1)#to ensure its not empty} 
for(k in length(Index):1)#backwards to fill from the bottom 
{ 
i=Index[k] 
#If the oldest date is missing, then set it to N/A so that N/A is passed forward as opposed to 0. 

if(i==nrow(b) & (b[[i,j]]==0 | is.na(b[[i,j]]))) 
{ 
    b[[i,j]]<-'#N/A' 
} 
else(b[[i,j]]==0 | is.na(b[[i,j]])) 
{ 
    b[[i,j]] <- b[[i+1,j]]#Take the price from the date before  
} 

} 

} 

これは少し高速ですが、それほど多くはありません。それでも400x6000のマトリックスでは1時間以上かかる。

b[[Index,j]]<-b[[Index+1,j]] 

は、しかし、私はRが順次更新された値を使用するとは思わない。私は私のような何かをした、完全にベクトル化アプローチ、を期待していました。これによって、新しい値が使用されるように、底から漸進的に更新されることはありません。これは、2つのNAエントリを連続して持つ場合に重要です。上記のベクトル化されたアプローチは1つしか満たさないからです。しかし、ある種の効率的な順次ベクトル化されたコードは、最初のものを更新し、これを使って2番目のものを更新します。何か案は？あなたの努力

Answer 1

私のR StudioはMOSSとZOOのパッケージをインストールできないので、na.locfに似たソリューションを用意しなければなりません。このコードは、誰でもこのアプローチを使用したい場合に備えています。

start.time<-Sys.time() 
nrow<-nrow(b) 
for(j in 2:ncol(b)) 
{ 

    ColumnReversed<-rev(b[,j]) #So we fill from the bottom - Oldest date first 
    Index<-!is.na(as.numeric(matrix(ColumnReversed,ncol=1))) #1 for valid, 0 for Missing 

    ValidVals <- c("NA",ColumnReversed[Index]) #[NA,final known, second final known,...,first known] 
    FilledIndex <- cumsum(Index) + 1 # [0,0,0,0,0...,1,1,1,1,...,2,2,2,2,2,...3,3,3,3,3...,k,k] + 1 
    #This line stores the index of ValidValues which contains the prices (and values to be filled) 
    b[,j]<-rev(matrix(ValidVals[FilledIndex],ncol=1))#Store in reversed order 

} 

タイミングが90分から65秒に改善されました。素晴らしい！

Answer 2

ため

多くのおかげでここMESSパッケージを使用可能だと基本的にあなたが書式設定を見ることができるので、私はここでしかそれを含めています上記のローランドさんのコメント@は異なるではありません。 filldown機能は、それがかなり速いですので、C++で書かれている：

x <- matrix(c(1, 2, 3, 4, NA, 6, NA, NA, NA, NA, 11, 12, 13, 14, 15, NA, 17, 18, NA, 20), nrow=5) 
x 
    [,1] [,2] [,3] [,4] 
[1,] 1 6 11 NA 
[2,] 2 NA 12 17 
[3,] 3 NA 13 18 
[4,] 4 NA 14 NA 
[5,] NA NA 15 20 

、その後

[,1] [,2] [,3] [,4] 
[1,] 1 6 11 NA 
[2,] 2 6 12 17 
[3,] 3 6 13 18 
[4,] 4 6 14 18 
[5,] 4 6 15 20 

Answer 3

あなたは完全にRバージョンをしたい場合は、私が検討を持っているが生成さ

library(MESS) 
apply(x, 2, filldown) 

を使用しますあなたのために：

最初に、適切な大きなテストを定義します。 et：

set.seed(42) 
nRow <- 1000 
nCol <- 500 
test <- matrix(rnorm(nRow * nCol), 
       nrow = nRow, 
       ncol = nCol) 
test[sample(nRow * nCol, nRow)] <- NA 

次に、ベクトル化（各列に適用）を使用して、必要な方法で下に通過するコードを記述します。恐ろしいExcelの「＃N/A」は、ストレージモード（つまり、numeric）を維持するNaNに変換されています。代替に対する試験それ

outerF <- function(x){ 

    # Run once 
    y <- innerF(x) 

    # Run till done 
    while(any((is.na(y) & !is.nan(y)) | 
      (!is.na(y) & y == 0L))){ 
    y <- innerF(y) 
    } 

    # Return 
    y 
} 

、及び（ヒント：使用MESSとそのC++）：....泣く：

innerF <- function(x){ 

    # Nothing to change 
    if(!any(idx <- is.na(x) | x == 0)) 
    return(x) 

    # Alter first value 
    if(is.na(x[1]) | x[1] == 0) 
    x[1] <- NaN 

    # First value altered 
    idx[1] <- FALSE 

    # Pass down 
    x[idx] <- x[which(idx) - 1] 

    # Return 
    x 
} 

そして発呼戦略を定義

library(microbenchmark) 
library(MESS) 

microbenchmark(apply(test, 2, outerF), times = 100) 
#Unit: microseconds 
#     expr min  lq  mean median  uq  max neval 
# apply(test, 2, outerF) 630.07 652.4505 806.4808 670.6965 686.234 3253.27 100 

microbenchmark(apply(test, 2, filldown), times = 100) 
#Unit: microseconds 
#     expr  min  lq  mean median  uq  max neval 
# apply(test, 2, filldown) 107.482 110.048 134.9092 112.329 114.895 1980.016 100