0

ベクトル化に関する質問がありますが、オンラインで解決策が見つからないようです。非常に大きなデータフレームがあり、現在、次のループを使用してフィルタリングしてラグ値を取得しています:

rowtype <-c('A','B','A','A','B','B','B','B','A','B','B','A','B','A','B','B','A','A');
values1<-c(2,1,8,5,-4,6,42,10,20,5,7,8,-2,8,9,3,2,5); 
index<-seq(1:length(values1));

df<-data.frame(rowtype, values1, index);

mininumBsize <- 2;

df$firstBLagged<-0;
df$secondBLagged<-0;
df$thirdBLagged<-0;

for (idx in which(df$rowtype=='A') )
{
  #get the past 5 lagged values of type 'B' that exceed a threshold
  laggedValues <- rev(df[df$rowtype=='B' & df$values1 > mininumBsize & df$index < idx,]$values1)[1:5];

  #take out any NA values here
  laggedValues[is.na(laggedValues)]<-0;

  #store those lagged values back into the dataframe
  df$firstBLagged[idx]<-laggedValues[1];
  df$secondBLagged[idx]<-laggedValues[2];
  df$thirdBLagged[idx]<-laggedValues[3];
}

データフレームの出力は次のようになります。

> df
   rowtype values1 index firstBLagged secondBLagged thirdBLagged
1        A       2     1            0             0            0
2        B       1     2            0             0            0
3        A       8     3            0             0            0
4        A       5     4            0             0            0
5        B      -4     5            0             0            0
6        B       6     6            0             0            0
7        B      42     7            0             0            0
8        B      10     8            0             0            0
9        A      20     9           10            42            6
10       B       5    10            0             0            0
11       B       7    11            0             0            0
12       A       8    12            7             5           10
13       B      -2    13            0             0            0
14       A       8    14            7             5           10
15       B       9    15            0             0            0
16       B       3    16            0             0            0
17       A       2    17            3             9            7
18       A       5    18            3             9            7

基本的に、タイプ「A」の行ごとに、特定のしきい値「mininumBsize」を超えるタイプ「B」の過去 5 つの値を取得したいと考えています。次に、データフレームの df$firstBlagged などに保存して、後で回帰やその他の分析に使用できるようにします。

残念ながら、このコードは実行に時間がかかりすぎます (また、R をより適切に記述する方法も理解したいと考えています)。オンラインの例のほとんどは、行自体のみをフィルタリングする方法を示していますが、条件に基づいて遅延値を取得する方法は示していません。この問題を解決する方法を知っている人はいますか？ありがとう！

4

1 に答える 1

1

これを完全にベクトル化する簡単な方法はわかりませんが、もしあればそれを学びたいと思います。しかし、私はそれをより効率的にすることができます。

より大きな data.frame を使用してみましょうsystem.time。

rowtype <-rep(c('A','B','A','A','B','B','B','B','A','B','B','A','B','A','B','B','A','A'),1000)
values1<-rep(c(2,1,8,5,-4,6,42,10,20,5,7,8,-2,8,9,3,2,5),1000) 
index<-seq(1:length(values1))

df<-data.frame(rowtype, values1, index)

次に、コードを関数にラップします。

addlagged<-function(df,mininumBsize = 2){
  df$firstBLagged<-0;
  df$secondBLagged<-0;
  df$thirdBLagged<-0;

  for (idx in which(df$rowtype=='A') )
  {
    #get the past 5 lagged values of type 'B' that exceed a threshold
    laggedValues <- rev(df[df$rowtype=='B' & df$values1 > mininumBsize & df$index < idx,]$values1)[1:5];

    #take out any NA values here
    laggedValues[is.na(laggedValues)]<-0;

    #store those lagged values back into the dataframe
    df$firstBLagged[idx]<-laggedValues[1];
    df$secondBLagged[idx]<-laggedValues[2];
    df$thirdBLagged[idx]<-laggedValues[3];
    }
  return(df)
}

より効率的な関数:

  addlagged2<-function(df,mininumBsize = 2){  
  #make sure rowtype is not a factor, but a character
  df$rowtype<-as.character(df$rowtype)
  #subset before the loop
  df2<-subset(df,!(rowtype=="B" & values1<mininumBsize))


  #initialize vectors
  firstBLagged <- rep(0,nrow(df2))
  secondBLagged <- rep(0,nrow(df2))
  thirdBLagged <- rep(0,nrow(df2))

  for (idx in which(df2$rowtype=='A') )
  {
    #get the past 3 lagged values of type 'B'    
    laggedValues <- df2$values1[1:idx][df2$rowtype[1:idx]=='B']
    #do not use rev
    laggedValues <- laggedValues[length(laggedValues):(length(laggedValues)-2)]

    #don't save to data.frame inside loop, use vectors
    firstBLagged[idx]<-laggedValues[1];
    secondBLagged[idx]<-laggedValues[2];
    thirdBLagged[idx]<-laggedValues[3];
  }
  #take out any NA values here (do it only ones and not inside the loop)
  firstBLagged[is.na(firstBLagged)]<-0
  secondBLagged[is.na(secondBLagged)]<-0
  thirdBLagged[is.na(thirdBLagged)]<-0

  #create columns in df     
  df$firstBLagged<-0
  df$secondBLagged<-0
  df$thirdBLagged<-0

  #transfer results to df
  df$firstBLagged[!(as.character(df$rowtype)=="B" & df$values1<mininumBsize)]<-firstBLagged
  df$secondBLagged[!(as.character(df$rowtype)=="B" & df$values1<mininumBsize)]<-secondBLagged
  df$thirdBLagged[!(as.character(df$rowtype)=="B" & df$values1<mininumBsize)]<-thirdBLagged
  return(df)
}

速いですか？

> system.time(df2<-addlagged(df))
       User      System verstrichen 
     37.157      24.591      61.735 
> system.time(df3<-addlagged2(df))
       User      System verstrichen 
      2.866       0.517       3.382

結果は同じですか？

> df3$rowtype<-factor(df3$rowtype)
> identical(df2,df3)
[1] TRUE

改善された関数の計算時間の大半を占めているのは何ですか? の出力を見てみましょうRprof:

> summaryRprof()
$by.self
                 self.time self.pct total.time total.pct
"=="                 0.346    61.79      0.346     61.79
":"                  0.189    33.75      0.189     33.75
"$"                  0.016     2.86      0.016      2.86
"$<-.data.frame"     0.005     0.89      0.005      0.89
"try"                0.001     0.18      0.002      0.36
"-"                  0.001     0.18      0.001      0.18
"is.na"              0.001     0.18      0.001      0.18
"tryCatch"           0.001     0.18      0.001      0.18

$by.total
                 total.time total.pct self.time self.pct
"=="                  0.346     61.79     0.346    61.79
":"                   0.189     33.75     0.189    33.75
"$"                   0.016      2.86     0.016     2.86
"$<-.data.frame"      0.005      0.89     0.005     0.89
"$<-"                 0.005      0.89     0.000     0.00
"try"                 0.002      0.36     0.001     0.18
"-"                   0.001      0.18     0.001     0.18
"is.na"               0.001      0.18     0.001     0.18
"tryCatch"            0.001      0.18     0.001     0.18

$sample.interval
[1] 0.001

$sampling.time
[1] 0.56

ほとんどの時間は、ループ内のすべてのサブセット化とシーケンスの作成に費やされます。*apply 関数を使用しても、それは役に立ちません。data.table とそのバイナリ検索を使用しようとしましたが、役に立ちませんでした。おそらく、ループ内にキーを設定する必要があったためです。私は data.table の経験があまりないので、おそらく何か間違ったことをしたのでしょう。

結局、これはコード レビューであり、実際には Stack Overflow に属していません。

于 2012-07-21T12:31:25.257 に答える