R，for循环，可扩展的解决方案

Question

我的数据看起来像这样：

    char_column   date_column1 date_column2 integer_column

415  18JT9R6EKV   2014-08-28   2014-09-06              1
26   18JT9R6EKV   2014-12-08   2014-12-11              2
374  18JT9R6EKV   2015-03-03   2015-03-09              1
139  1PEGXAVCN5   2014-05-06   2014-05-10              3
969  1PEGXAVCN5   2014-06-11   2014-06-15              2
649  1PEGXAVCN5   2014-08-12   2014-08-16              3

我想执行一个循环来检查每一行与前一行，并在某些条件下为它们分配相同的数字（这样我以后可以对它们进行分组），关键是如果日期段足够接近，我会将它们折叠成一个片段。

我的尝试如下：

i <- 1
z <- 1
v <- 1
for (i in 2:nrow(df)){
   z[i] <-  ifelse(df[i,'char_column'] == df[i-1,'char_column'],
              ifelse((df[i,'date_column1'] - df[i-1,'date_column2']) <= 5, 
                     ifelse(df[i,'integer_column'] == df[i-1,'integer_column'], 
                            v, v<- v+1),
                     v <- v+1),
              v <- v+1)}

df$grouping <- z

然后我将使用 min(date_column1) 和 max(date_column2) 进行分组。

这种方法非常适用于 100,000 行（22.86 秒） 但是对于一百万行：33.18 分钟！我有超过 60m 行要处理， 有什么方法可以让流程更高效？

PS：要生成类似的表，您可以使用以下代码：

x <- NULL
for (i in 1:200) { x[i] <- paste(sample(c(LETTERS, 1:9), 10), collapse =   '')}
y <- sample((as.Date('2014-01-01')):as.Date('2015-05-01'), 1000, replace = T)
y2 <- y + sample(1:10)
df <- data.frame(char_column = sample(x, 1000, rep = T),
             date_column1 = as.Date(y, origin = '1970-01-01'),
             date_column2 = as.Date(y2,origin = '1970-01-01'),
             integer_column = sample(1:3,1000, replace = T),
             row.names = NULL)

df <- df[order(df$char_column, df$date_column1),]

Answer 1

由于data.table::rleid 不起作用，我发布另一个（希望）快速解决方案

1。摆脱嵌套的 ifelse

ifelse 通常很慢，尤其是对于标量计算，请使用if。

应尽可能避免嵌套ifelse：注意ifelse(A, ifelse(B, x, y), y) 可以适当地替换为if (A&B) x else y

f1 <- function(df){
  z <- rep(NA, nrow(df))
  z[1] <- 1
  char_col <- df[, 'char_column']
  date_col1 <- df[, 'date_column1']
  date_col2 <- df[, 'date_column2']
  int_col <- df[, 'integer_column']
  for (i in 2:nrow(df)){
    if((char_col[i] == char_col[i-1])&((date_col1[i] - date_col2[i-1]) <= 5)&(int_col[i] == int_col[i-1]))
    {
      z[i] <- z[i-1]
    }
    else 
    {
      z[i] <- z[i-1]+1
    }
  }
  z
}

f1 比 10.000 行的原始解决方案快约 40%。

system.time(f1(df))
   user  system elapsed 
   2.72    0.00    2.79 

2。矢量化

仔细检查后，if 内部的条件可以向量化

library(data.table)
f2 <- function(df){
  z <- rep(NA, nrow(df))
  z[1] <- 1
  char_col <- df[, 'char_column']
  date_col1 <- df[, 'date_column1']
  date_col2 <- df[, 'date_column2']
  int_col <- df[, 'integer_column']
  cond <- (char_col==shift(char_col))&(date_col1 - shift(date_col2) <= 5)&(int_col==shift(int_col))
  for (i in 2:nrow(df)){
    if(cond[i])
    {
      z[i] <- z[i-1]
    }
    else 
    {
      z[i] <- z[i-1]+1
    }
  }
  z
} 
# for 10000 rows
system.time(f2(df))
#   user  system elapsed 
#   0.01    0.00    0.02 

3。向量化，向量化

虽然f2 已经相当快，但可以进行进一步的矢量化。观察z是如何计算的：cond是一个逻辑向量，z[i] = z[i-1] + 1当cond是FALSE。这就是cumsum(!cond)。

f3 <- function(df){
  setDT(df)
  df[, cond := (char_column==shift(char_column))&(date_column1 - shift(date_column2) <= 5)&(integer_column==shift(integer_column)),]
  df[, group := cumsum(!c(FALSE, cond[-1L])),]
} 

1M 行

system.time(f3(df))
#   user  system elapsed 
#   0.05    0.05    0.09 
system.time(f2(df))
#   user  system elapsed 
#   1.83    0.05    1.87