使用 dplyr 进行自适应范围的逐行操作

Question

根据我之前的问题，我想在给定智能卡数据的情况下计算托管（即两个人同时出现）实例。 这是一个由十条记录组成的虚构样本：

library(lubridate)

smartcard <- c(1,2,3,2,1,2,4,4,1,1)
boarding_stop <- c("C23", "C14", "C23", "C23", "C23", "C14", "C14", "C23", "C14", "C23")
boarding_time <- as.times(c("07:24:01", "07:26:18", "07:37:19", "08:29:22", "08:34:10", "15:55:23", 
  "16:20:22", "17:07:31", "17:13:34", "17:35:52"))
colocation <- data.frame(smartcard, boarding_time, boarding_stop)
colocation
   smartcard boarding_time boarding_stop
1          1      07:24:01           C23
2          2      07:26:18           C14
3          3      07:37:19           C23
4          2      08:29:22           C23
5          1      08:34:10           C23
6          2      15:55:23           C14
7          4      16:20:22           C14
8          4      17:07:31           C23
9          1      17:13:34           C14
10         1      17:35:52           C23

给定 30 分钟的托管缓冲区（即 07:24 到达的乘客 1 将在07:54之前到达时与另一位乘客托管），我想记录成对的乘客满足此条件的所有实例，并记录boarding_stop ， boarding_time和他们的smartcard ID。

例如，我会发现乘客 1 和 3 于 07:37:19 在C23共处一地。 最终，我想要一个形式为 output

boarding_stop boarding_time smartcard1 smartcard2
          C23      07:37:19          1          3
          C23      08:34:10          2          1
          C23      07:35:52          4          1
          C14      16:20:22          2          4

我之前的尝试是编写几个for循环来查找单独的旅行信息对，并确定两次旅行是否在半小时间隔内记录在火车站。 一旦找到，然后 append 一个新的行，其中包含有关时间、智能卡乘客和位置的信息。

Output<- read.table(text = "boarding_stop boarding_time smartcard1 smartcard2", header = TRUE)
for s in unique(colocaion$boarding_stop):
  for i in 1:nrow(colocation):
    for j in 1:nrow(colocation):
      if colocation$boarding_time[[j,2]] <= colocation$boarding_time[[i,2]] + "00:30:00" &
         colocation$boarding_time[[j,2]] >= colocation$boarding_time[[i,2]]:
           Output %>% add_row(boarding_stop = colocation$boarding_stop[[j,3]],
                              boarding_time = colocation$boarding_time[[j,2]],
                              smartcard1 = colocation$smartcard[[i,1]], 
                              smartcard2 = colocation$smartcard[[j,1]])
    end
  end
end

我使用dplyr的初始方法将涉及group_by到第一组唯一站。 但是由于每对行程的半小时缓冲时间都会发生变化，我认为我不能简单地mutate和summarise来捕获colocation 。 我感谢@Matt 在之前的问题中的回答。 对此的任何帮助将不胜感激。

Answer 1

编辑： dplyr解决方案

#Change to timestamp and create time range

dt <- dt %>% 
  mutate(boarding_time = parse_date_time(boarding_time,orders = "HMS"),
         boardtime_time_plus=boarding_time+hm("00:30"),
         boardtime_time_minus=boarding_time-hm("00:30"))

# cartesian join within each boarding_stop and then filter
dt %>% 
  mutate(fake_col=TRUE) %>% 
  left_join(dt %>% mutate(fake_col=TRUE),by=c("fake_col","boarding_stop")) %>% 
  group_by(boarding_stop) %>% 
  ungroup() %>% 
  filter(smartcard.x!=smartcard.y,boardtime_time_minus.x<=boarding_time.y,boardtime_time_plus.x>=boarding_time.y) %>% 
  select(boarding_stop,boarding_time=boarding_time.x,smartcard1=smartcard.x,smartcard2=smartcard.y) %>% 
  group_by(paste0(boarding_stop,"-",(smartcard1+smartcard2))) %>% 
  filter(boarding_time==max(boarding_time)) %>% 
  ungroup() %>% 
  mutate(boarding_time=format(boarding_time,"%H:%M:%S")) %>% 
  select(-5)
#> # A tibble: 4 x 4
#>   boarding_stop boarding_time smartcard1 smartcard2
#>   <chr>         <chr>              <int>      <int>
#> 1 C23           07:37:19               3          1
#> 2 C23           08:34:10               1          2
#> 3 C14           16:20:22               4          2
#> 4 C23           17:35:52               1          4

这是data.table解决方案。 我对dplyr不熟悉，所以我想你需要玩过filter才能做到这一点。

library(data.table)
library(lubridate)


dt <- fread('smartcard boarding_time boarding_stop
        1      07:24:01           C23
        2      07:26:18           C14
        3      07:37:19           C23
        2      08:29:22           C23
        1      08:34:10           C23
        2      15:55:23           C14
        4      16:20:22           C14
        4      17:07:31           C23
        1      17:13:34           C14
        1      17:35:52           C23')
#Change to timestamp
dt[,boarding_time:=parse_date_time(boarding_time,orders = "HMS")]

#Create time range
dt[,`:=`(boardtime_time_plus=boarding_time+hm("00:30"),
        boardtime_time_minus=boarding_time-hm("00:30"))]

#non equal join and excluding joined on itself
dtd <- dt[dt,on=.(boarding_stop,boardtime_time_minus<=boarding_time,boardtime_time_plus>=boarding_time)][smartcard!=i.smartcard,]

# a bit format and select the max datetime for each combination
# there definitely should have elegant way to do this but i havent figured out
dtd[,.(boarding_stop,boarding_time = format(boarding_time,"%H:%M:%S"),smartcard1=smartcard,smartcard2=i.smartcard)][
  dtd[,.I[boarding_time==max(boarding_time)],by=.(paste0(boarding_stop,"-",(smartcard1+smartcard2)))]$V1,]
#>    boarding_stop boarding_time smartcard1 smartcard2
#> 1:           C23      07:37:19          3          1
#> 2:           C23      08:34:10          1          2
#> 3:           C14      16:20:22          4          2
#> 4:           C23      17:35:52          1          4

^{由代表 package (v0.3.0) 于 2020 年 4 月 25 日创建}