r语言 - 创建替换计算会话列中的NAs的功能

Question

我有一个数据框架，它看起来像下面的示例数据框架:

#sample data frame
   clientId actual_time           session
1  A        2016-11-01 00:00:00   1             
2  A        2016-11-01 00:05:00   1
3  A        2016-11-01 00:35:01   2
4  A        2016-11-01 00:40:00   NA
5  A        2016-11-01 01:10:01   NA         
6  B        2016-11-01 01:00:00   1
7  B        2016-11-01 01:05:00   1
8  B        2016-11-01 01:30:00   1
9  B        2016-11-01 01:40:00   1
10 B        2016-11-01 01:50:00   NA
11 C        2016-11-01 02:00:00   NA
12 C        2016-11-01 02:35:00   NA
13 C        2016-11-01 04:35:00   NA

我想用逻辑定义的值填充列' session '中的NAs:

• 对于同一个" clientId "，如果后面两行的时间差>= 30分钟，则新行将在一个新的会话中(等于旧行的会话加1);如果后面两行的时间差为<30分钟，则两行在同一会话中，会话号相同。
• 会话号是一个从1开始的累积数，即对于一个新的clientId，会话号从1开始。

填满NA后，数据帧如下:

#sample data frame (result)
   clientId actual_time           session
1  A        2016-11-01 00:00:00   1             
2  A        2016-11-01 00:05:00   1
3  A        2016-11-01 00:35:01   2
4  A        2016-11-01 00:40:00   2
5  A        2016-11-01 01:10:00   3         
6  B        2016-11-01 01:00:00   1
7  B        2016-11-01 01:05:00   1
8  B        2016-11-01 01:30:00   1
9  B        2016-11-01 01:40:00   1
10 B        2016-11-01 01:50:00   1
11 C        2016-11-01 02:00:00   1
12 C        2016-11-01 02:35:00   2
13 C        2016-11-01 04:35:00   3

I have try:

df<-data.frame(clientId=c(rep('A',5),rep('B',5),rep('C',3)),
       actual_time=as.POSIXct(c("2016-11-01 00:00:00","2016-11-01 00:05:00","2016-11-01 00:35:01","2016-11-01 00:40:00","2016-11-01 01:10:01",
                       "2016-11-01 01:00:00","2016-11-01 01:05:00","2016-11-01 01:30:00","2016-11-01 01:40:00","2016-11-01 01:50:00",
                       "2016-11-01 02:00:00","2016-11-01 02:35:00","2016-11-01 04:35:00")),
       session=c(1,1,2,NA,NA,1,1,1,1,NA,NA,NA,NA))  
my_session<- function(df){
  for (i in 2:(dim(df)[1])){
    if(is.na(df$session[i])){
      if (df$clientId[i]==df$clientId[i-1]){
        if(as.numeric(difftime(df$actual_time[i], 
                               df$actual_time[i-1], Asia/Taipei,units =     "mins"))>30){
          df$session[i]<- df$session[i-1]+1
        }else{df$session[i]<- df$session[i-1]}
      }else{df$session[i]<- 1}
    }
  }
  return(df)
}
df2<-my_session(df)

函数确实起作用了。但是，它非常慢，因为我的实际数据帧有800万行(4G csv文件)。

我认为时间是在运行for循环时消耗的。有没有一种方法来编写一个函数，填补NAs没有for循环?

Answer 1

我将提出一种data.table方法，它的可伸缩性应该比您现有的功能好得多。

library(data.table)
DT <- as.data.table(df) # or setDT(df)
DT[, session := cumsum(difftime(actual_time, shift(actual_time, 
               fill = min(actual_time)), units = "mins") > 30) +1L, 
    by = clientId]

它的作用:它按clientId组计算两个actual_time相差超过30分钟的累计次数。当然，你必须确保数据是按实际时间排序的。

结果表如下所示:

 #   clientId         actual_time session
 #1:        A 2016-11-01 00:00:00       1
 #2:        A 2016-11-01 00:05:00       1
 #3:        A 2016-11-01 00:35:01       2
 #4:        A 2016-11-01 00:40:00       2
 #5:        A 2016-11-01 01:10:01       3
 #6:        B 2016-11-01 01:00:00       1
 #7:        B 2016-11-01 01:05:00       1
 #8:        B 2016-11-01 01:30:00       1
 #9:        B 2016-11-01 01:40:00       1
#10:        B 2016-11-01 01:50:00       1
#11:        C 2016-11-01 02:00:00       1
#12:        C 2016-11-01 02:35:00       2
#13:        C 2016-11-01 04:35:00       3

Answer 2

我正在使用ddply()来解决这个问题。

df$actual_time <- as.POSIXct(df$actual_time)
library(plyr)
ddply(df, .(clientId),transform, x2 = c(0,cumsum(diff(actual_time) > 30))+1 )
     clientId         actual_time session x2
1         A 2016-11-01 00:00:00       1  1
2         A 2016-11-01 00:05:00       1  1
3         A 2016-11-01 00:35:01       2  2
4         A 2016-11-01 00:40:00      NA  2
5         A 2016-11-01 01:10:01      NA  3
6         B 2016-11-01 01:00:00       1  1
7         B 2016-11-01 01:05:00       1  1
8         B 2016-11-01 01:30:00       1  1
9         B 2016-11-01 01:40:00       1  1
10        B 2016-11-01 01:50:00      NA  1
11        C 2016-11-01 02:00:00      NA  1
12        C 2016-11-01 02:35:00      NA  2
13        C 2016-11-01 04:35:00      NA  3

Answer 3

我建议您使用split函数将您的数据帧分解为数据帧列表，每个数据帧对应于相同的clientId，并使用lapply遍历列表:

dat.split <- split(x = sample.data, f = as.factor(sample.data$clientId))
replace.nas <- lapply(dat.split, function(df) { 
                        # Fix the na problem here 
                        # return fixed dataframe})
dat.final <- do.call(rbind.data.frame, replace.nas)