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

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。vectorize

仔细检查后，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是逻辑向量，当cond为FALSE时，z[i] = z[i-1] + 1。这是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