Пошаговая работа с адаптивным диапазоном с использованием 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 минут (т. Е. Пассажир 1, прибывающий в 07:24, сговорится с другим пассажиром, когда он прибыть до 07:54), я хотел бы записать все случаи, когда пары пассажиров удовлетворяют этому условию, и записать boarding_stop, boarding_time и их smartcard ID.

Например, я бы обнаружил, что пассажиры 1 и 3 колокатаются в C23 в 07:37:19. В конечном счете, я хотел бы получить вывод в виде

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, которые ищут отдельные пары информации о поездке, и определить, записаны ли эти две поездки на вокзале. в течение получаса Найдя, добавьте новую строку с информацией о времени, пассажирах смарт-карты и местонахождении.

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 захватить колокейшн . Я благодарю @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

^{Создано в 2020-04-25 с помощью пакета Представить (v0.3.0)}