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分钟!!我有超过60米的行要处理，有没有办法让这个过程更有效率？

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
}

对于10.000行，

f1比原始解决方案快约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。 Vectorize，Vectorize

虽然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

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

1 个答案:

1。摆脱嵌套的ifelse

2。矢量化

3。 Vectorize，Vectorize