使用dplyr在自适应范围内进行行式操作 [英] Rowwise operation with adaptive range using dplyr
问题描述
根据我之前的问题，我想计算一下给定智能卡数据的 colocation （即两个人同时出现）实例。这是一个包含十个记录的虚构示例：
Based on my earlier question, I would like to calculate colocation (i.e. two people appearing at the same time) instances given a smartcard data. Here is a made-up sample consisting of ten records:
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之前到达 colocate ），我想记录所有成对乘客都满足此条件的实例，并记录 boarding_stop ， boarding_time 及其智能卡 ID。
Given a colocation buffer of 30 minutes (i.e. passenger 1 arriving at 07:24 would colocate with another passenger when they arrive before 07:54), I would like to record all instances that pairs of passengers satisfy this condition, and record the boarding_stop, boarding_time, and their smartcard ID.
例如，我会发现乘客1和3都位于07:37:19的 C23 处。最终，我希望得到以下格式的输出
For example, I would find that passenger 1 and 3 colocate at C23 at 07:37:19. Ultimately, I would want an output of the form
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 循环进行编码，这些循环查找各个旅行信息对，并确定两者每半小时在火车站记录一次旅行。找到后，然后在新行中附加有关时间，智能卡乘客和位置的信息。
My earlier attempt is to code through several for loops that lookup individual pairs of trip information and identify whether the two trips are recorded at the train station within a half-hour interval. Once found, then append a new row with information on time, smartcard passengers and location.
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 和 summary 捕获代管。感谢@Matt在先前的问题中的回答。任何帮助，将不胜感激。
My initial approach using dplyr would involve group_by to first group unique stations. But since the half-hour buffer time changes for each pair of trips, I don't think I can simply mutate and summarise to capture colocation. I thank @Matt for his answer in the earlier question. Any help on this would be greatly appreciated.
推荐答案
编辑： 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 ，所以我想您需要使用过滤器来做到这一点。
This is a data.table solution. I am not familiar with dplyr so I guess you need to play around filter to do this.
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通过 reprex软件包（v0.3.0）
Created on 2020-04-25 by the reprex package (v0.3.0)
这篇关于使用dplyr在自适应范围内进行行式操作的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
