使用快速计算创建用户会话答案

【问题标题】：Creating user sessions with fast computation使用快速计算创建用户会话
【发布时间】：2018-04-18 17:01:46
【问题描述】：

我有一个包含三列的数据框：“uuid”（即类因子）和“created_at”（即类 POSIXct）和“trainer_item_id”（因子），我创建了名为“会话”的第三列”。 Sessions 列表示每个 uuid 按时间排序的时间会话，因此任何连续事件对之间的时间差最多为一小时（3600 秒）。

我使用“for 循环”和迭代创建了 Sessions 列。问题是我有超过一百万的观察结果，创建会话需要 8 个小时。有没有比我下面的代码更容易和更快的方法来创建它？提前感谢您的帮助！

这里是原始数据集的样本 --> https://gist.github.com/einsiol/5b4e633ce69d3a8e43252f383231e4b8

这是我的代码 -->

library(dplyr)
    # Converting the data frame trial to tibble in order to use the function group_by
    trial <- tbl_df(trial); trial <- group_by(trial, uuid)

    # Ordering by timestamp (created_at)
    trial <- arrange(trial, created_at)

    # Creating empty vector of time difference tdiff
    time <- trial$created_at
    tdiff <- vector(mode = "numeric",length = 0)
    trial$Sessions <- vector(mode = "character",length = length(trial))

        count <-1

            for(i in 1:(length(trial$uuid)-1)) {

                tdiff[i] <- difftime(time[i+1], time[i],units = "secs")

                # If same user ID

                if (trial$uuid[i+1]==trial$uuid[i]){

                    if (tdiff[i]<3600){
                        trial$Sessions[i] <- count
                        trial$Sessions[i+1] <- count


                    }else{
                        trial$Sessions[i] <- count
                        trial$Sessions[i+1] <- count
                        count <- count+1
                    }

                    # If different user ID
                }else{

                    if (tdiff[i]<3600){
                        trial$Sessions[i] <- count
                        trial$Sessions[i+1] <- count

                    }else{
                        trial$Sessions[i] <- count
                        trial$Sessions[i+1] <- count
                        count <- count+1
                    }

                    count <- 1
                }
            }

更新：我已经找到了我的问题的答案以及您可以在下面找到的此代码的快速替代方案！

【问题讨论】：

除了用散文来描述你的数据集，你能包含一个可重现的例子来测试你的代码吗？
dput( head( trial, 20 ) 会有所帮助
@DavidKlotz 感谢您的建设性反馈，我已经添加了我的数据集示例 :)
是的，但是下次如果您输入dput(head(trial, 20))，它是可复制/可粘贴的并保留结构（如列类）。下次请使用dput分享数据。

标签： r performance session for-loop large-data

【解决方案1】：

既然您已经开始使用 dplyr：

trial <- 

trial %>% 
  arrange(uuid, created_at) %>% 
  group_by(uuid) %>% 
  mutate(diff = difftime(created_at, lag(created_at), units = 'secs'), # calculate timediff for each row
    diff = as.numeric(diff >= 3600), # flags each new session with the number 1
    diff = ifelse(is.na(diff), 1, diff), %>% #replaces the first row of each group with 1 
    Sessions = cumsum(diff)) %>% #sum all the sessions for each group
  select(-diff) # remove diff column

【讨论】：

【解决方案2】：

您可以尝试使用data.table：

require(data.table)
N <- 4

trial <- data.table(uuid = rep(1:2, each = N),
                    created_at = as.POSIXct(60* 10 *rep(1:N, times = 2)*
                                              rep(1:N, times = 2),
                                            origin = "1990-01-01"))

setkey(trial, uuid, created_at)
trial
#    uuid          created_at
# 1:    1 1990-01-01 02:10:00
# 2:    1 1990-01-01 02:40:00
# 3:    1 1990-01-01 03:30:00
# 4:    1 1990-01-01 04:40:00
# 5:    2 1990-01-01 02:10:00
# 6:    2 1990-01-01 02:40:00
# 7:    2 1990-01-01 03:30:00
# 8:    2 1990-01-01 04:40:00

trial[, dif := c(1, as.numeric(diff(created_at), units = "secs"))]
trial[, ii := .GRP, by = uuid]
trial[, ii := ii - lag(ii)]
trial[is.na(ii), ii := 1L]
trial[, i := ifelse(dif < 3600, 0L, 1L)]
trial[ii == 1L, i := 0L]
trial[, Sessions := cumsum(i), by = uuid]
trial[, Sessions := Sessions + 1L, by = uuid]
trial
#    uuid          created_at   dif ii i Sessions
# 1:    1 1990-01-01 02:10:00     1  1 0        1
# 2:    1 1990-01-01 02:40:00  1800  0 0        1
# 3:    1 1990-01-01 03:30:00  3000  0 0        1
# 4:    1 1990-01-01 04:40:00  4200  0 1        2
# 5:    2 1990-01-01 02:10:00 -9000  1 0        1
# 6:    2 1990-01-01 02:40:00  1800  0 0        1
# 7:    2 1990-01-01 03:30:00  3000  0 0        1
# 8:    2 1990-01-01 04:40:00  4200  0 1        2

【讨论】：

【解决方案3】：

我找到了一种非常有效且快速的方法来使用矢量微积分使其工作。我花了 30 秒来运行代码（而不是平均 5 小时！）

   library(data.table);library(sqldf)

        # Ordering by uuid and created_at
        LID<-LID[order(LID$uuid,LID$created_at),]

        # Computing time difference (sec) between the current and previous ligne 
        LID$created_at <- as.POSIXct(as.character(LID$created_at)) 
        LID$diff<-c(9999,LID$created_at[-1]-LID$created_at[-nrow(LID)])
        options(stringAsFactor = FALSE) 

        # Lines corresponding to a new uuid 
        w<-which(LID$uuid[-1]!=LID$uuid[-nrow(LID)])

        # Putting the duration to NA when there is a change of uuid
        LID$diff[w+1]<-9999

        # Identifying sessions changes that are greater than 3600 sec (1 hour)
        LID$chg_session<-as.numeric(LID$diff>3600)

        # Cumulating and determining the id_sessions with the inverse of Differencing
        LID$idsession<-diffinv(LID$chg_session)[-1]

【讨论】：