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 回答