使用 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 日創建}