如何筛选交通出行后0-1天内无对应地点记录的人员实例？

现有两个DataFrame：transportation（交通出行数据）和location（地点记录数据），需筛选满足以下条件的记录：

• 人员存在交通出行记录
• 该出行日期及出行后1天内无对应的地点记录

当前核心问题：无法正确处理0-1天的时间范围判断，例如某人1月4日出行，1月5日有地点记录则不属于问题，但现有方法无法识别这种情况。

library(tidyverse)

# 构建交通出行数据集
Date <- c("2022-01-01","2022-01-02","2022-01-03","2022-01-04","2022-01-04","2022-01-05", "2022-04-06", "2022-04-06")
Method <- c("train","taxi","train","bus","bus","bus", "train", "train")
Person <- c("A","B","C", "D", "E", "F", "G", "A")
transportation <- data.frame(Date,Method,Person)

# 构建地点记录数据集
Date2 <- c("2022-01-01","2022-01-02","2022-01-03","2022-01-05", "2022-05-10")
Reason <- c("x","Y","Z","W", "x")
Person2 <- c("A","B","C", "D", "E")
location <- data.frame(Date2,Reason,Person2)

# 现有方法1：仅匹配出行当天的地点记录，未考虑出行后1天
location %>% 
  right_join(transportation, by = c("Date2" = "Date", "Person2" = "Person"))

# 现有方法2：错误匹配跨时间范围的记录，比如A的1月1日地点记录匹配到4月6日的出行记录
location %>% 
  right_join(transportation, by = c("Person2" = "Person")) %>% 
  mutate(Date2 = as.Date(Date2),
         Date = as.Date(Date),
         date_gap = Date2 - Date,
         date_gap = as.double(date_gap)) %>% 
  filter(is.na(date_gap) == TRUE)

思路核心 #

先将日期转换为标准日期格式，对每个出行记录，检查该人员在出行当天和出行后1天这两个日期是否存在地点记录，最终筛选出无对应记录的出行条目。

方法1：分组判断匹配情况 #

library(tidyverse)

# 转换日期格式为Date类型
transportation <- transportation %>% mutate(Date = as.Date(Date))
location <- location %>% mutate(Date2 = as.Date(Date2))

# 关联数据并判断是否存在有效地点记录
transportation %>%
  # 按人员关联所有地点记录
  left_join(location, by = c("Person" = "Person2")) %>%
  # 计算地点记录与出行日期的差值
  mutate(date_diff = Date2 - Date) %>%
  # 按出行记录分组，判断是否有0-1天内的地点记录
  group_by(Person, Date, Method) %>%
  summarise(has_valid_location = any(date_diff >= 0 & date_diff <= 1, na.rm = TRUE)) %>%
  # 筛选出无有效地点记录的出行记录
  filter(!has_valid_location)

方法2：反连接排除有效记录 #

library(tidyverse)

# 转换日期格式
transportation <- transportation %>% mutate(Date = as.Date(Date))
location <- location %>% mutate(Date2 = as.Date(Date2))

# 生成每个出行记录需要检查的日期（当天+后1天）
check_dates <- transportation %>%
  mutate(check_date = map(Date, ~.x + days(0:1))) %>%
  unnest(check_date) %>%
  select(Person, check_date)

# 提取所有存在地点记录的人员-日期组合
valid_records <- location %>%
  transmute(Person = Person2, check_date = Date2)

# 反连接得到无有效地点记录的出行记录
transportation %>%
  anti_join(valid_records, by = c("Person", "Date" = "check_date")) %>%
  anti_join(valid_records, by = c("Person" = "Person", "Date" = "check_date") %>% mutate(Date = Date + days(1)))

内容的提问来源于stack exchange，提问作者Indescribled