我仍在学习R,并且在尝试合并来自两个不同data.table的两个数据集并在时间间隔内进行匹配时遇到了麻烦。例如,给定table1_schedule和table2_schedule:
table1_schedule
Channel Program program_Date start_time
HBO Mov A 1/1/2018 21:00
HBO Mov B 1/1/2018 23:00
HBO Mov C 1/1/2018 23:59
NatGeo Doc A 1/1/2018 11:00
NatGeo Doc B 1/1/2018 11:30
NatGeo Doc C 1/1/2018 12:00
NatGeo Doc D 1/1/2018 14:00
table2_watch
Person Channel program_Date start_time end_time
Name A NatGeo 1/1/2018 11:00 12:00
Name B NatGeo 1/1/2018 12:30 14:00
Name B HBO 1/1/2018 21:30 22:00
Name B HBO 1/1/2018 22:30 23:30
目标是合并在table2_watch表的“ start_time”和“ end_time”之间运行的程序,并添加该时间间隔内该人每次观看的程序。例如,
所需的输出
Person Channel program_Date start_time end_time Prog1 Prog2 Prog3
Name A NatGeo 1/1/2018 11:00 12:00 Doc A Doc B Doc C
Name B NatGeo 1/1/2018 12:30 14:00 Doc C Doc D -NA-
Name B HBO 1/1/2018 21:30 22:00 Mov A -NA- -NA-
Name B HBO 1/1/2018 22:30 23:30 Mov A Mov B -NA-
是否有一种以最简单,最有效的方式执行此操作的方法,例如使用dplyr
或其他最适合此类问题的R命令?并且仅在超过10分钟的时间间隔内添加观看的节目,然后添加该人观看了下一个节目。谢谢
答案 0 :(得分:1)
这就是我要做的事情。请注意,我已将您的一些文件重命名。
> cat schedule
Channel Program Date StartTime
HBO Mov A 1/1/2018 21:00
HBO Mov B 1/1/2018 23:00
HBO Mov C 1/1/2018 23:59
NatGeo Doc A 1/1/2018 11:00
NatGeo Doc B 1/1/2018 11:30
NatGeo Doc C 1/1/2018 12:00
NatGeo Doc D 1/1/2018 14:00
> cat watch
Person Channel Date StartTime EndTime
Name A NatGeo 1/1/2018 11:00 12:00
Name B NatGeo 1/1/2018 12:30 14:00
Name B HBO 1/1/2018 21:30 22:00
Name B HBO 1/1/2018 22:30 23:30
现在,请确保我们使用readr
正确阅读了这些内容。换句话说,为日期和时间指定正确的格式。
library(dplyr)
library(readr)
library(lubridate)
schedule <- read_table("schedule",
col_types=cols_only(Channel=col_character(),
Program=col_character(),
Date=col_date("%d/%m/%Y"),
StartTime=col_time("%H:%M")))
watch <- read_table("watch",
col_types=cols_only(Person=col_character(),
Channel=col_character(),
Date=col_date("%d/%m/%Y"),
StartTime=col_time("%H:%M"),
EndTime=col_time("%H:%M")))
接下来,我们将所有日期和时间转换为日期时间,并在计划中添加结束日期时间。
schedule <- schedule %>%
mutate(StartDateTime=ymd_hms(paste(Date, StartTime))) %>%
group_by(Channel) %>%
mutate(EndDateTime=lead(StartDateTime, default=as_datetime(Inf))) %>%
ungroup() %>%
select(Channel, Program, StartDateTime, EndDateTime)
watch <- watch %>%
mutate(StartDateTime=ymd_hms(paste(Date, StartTime))) %>%
mutate(EndDateTime=ymd_hms(paste(Date, EndTime))) %>%
select(Person, Channel, StartDateTime, EndDateTime)
我们可以执行联接,并检查监视和计划时间间隔是否重叠(您可以修改它以适应我相信的10分钟评论,尽管我并不完全理解您的意思)。
watch %>%
inner_join(schedule,
by=c("Channel" = "Channel"),
suffix=c(".Watch", ".Schedule")) %>%
filter(int_overlaps(interval(StartDateTime.Watch, EndDateTime.Watch),
interval(StartDateTime.Schedule, EndDateTime.Schedule))) %>%
select(Person, Channel, Program, StartDateTime.Watch, EndDateTime.Watch) %>%
rename_at(.vars=vars(ends_with(".Watch")),
.funs=funs(sub("\\.Watch$", "", .)))
# A tibble: 8 x 5
Person Channel Program StartDateTime EndDateTime
<chr> <chr> <chr> <dttm> <dttm>
1 Name A NatGeo Doc A 2018-01-01 11:00:00 2018-01-01 12:00:00
2 Name A NatGeo Doc B 2018-01-01 11:00:00 2018-01-01 12:00:00
3 Name A NatGeo Doc C 2018-01-01 11:00:00 2018-01-01 12:00:00
4 Name B NatGeo Doc C 2018-01-01 12:30:00 2018-01-01 14:00:00
5 Name B NatGeo Doc D 2018-01-01 12:30:00 2018-01-01 14:00:00
6 Name B HBO Mov A 2018-01-01 21:30:00 2018-01-01 22:00:00
7 Name B HBO Mov A 2018-01-01 22:30:00 2018-01-01 23:30:00
8 Name B HBO Mov B 2018-01-01 22:30:00 2018-01-01 23:30:00
要获得所需的输出,您将必须按Program
以外的所有内容进行分组,并将结果分组“分解”为多列。但是,我不确定这是否是个好主意,所以我没有这样做。
答案 1 :(得分:1)
这里是data.table
的解决方案,我们可以在其中使用foverlap
。
我正在用简短的评论显示每一步,希望对理解有所帮助。
library(data.table)
# Convert date & time to POSIXct
# Note that foverlap requires a start and end date, so we create an end date
# from the next start date per channel using shift for df1
setDT(df1)[, `:=`(
time1 = as.POSIXct(paste(program_Date, start_time), format = "%d/%m/%Y %H:%M"),
time2 = as.POSIXct(paste(program_Date, shift(start_time, 1, type = "lead", fill = start_time[.N])), format = "%d/%m/%Y %H:%M")), by = Channel]
setDT(df2)[, `:=`(
start = as.POSIXct(paste(program_Date, start_time), format = "%d/%m/%Y %H:%M"),
end = as.POSIXct(paste(program_Date, end_time), format = "%d/%m/%Y %H:%M"))]
# Remove unnecessary columns in preparation for final output
df1[, `:=`(program_Date = NULL, start_time = NULL)]
df2[, `:=`(program_Date = NULL, start_time = NULL, end_time = NULL)]
# Join on channel and overlapping intervals
# Once joined, remove time1 and time2
setkey(df1, Channel, time1, time2)
dt <- foverlaps(df2, df1, by.x = c("Channel", "start", "end"), nomatch = 0L)
dt[, `:=`(time1 = NULL, time2 = NULL)]
# Spread long to wide
dt[, idx := paste0("Prog",1:.N), by = c("Channel", "Person", "start")]
dcast(dt, Channel + Person + start + end ~ idx, value.var = "Program")[order(Person, start)]
# Channel Person start end Prog1 Prog2 Prog3
#1: NatGeo Name A 2018-01-01 11:00:00 2018-01-01 12:00:00 Doc A Doc B Doc C
#2: NatGeo Name B 2018-01-01 12:30:00 2018-01-01 14:00:00 Doc C Doc D NA
#3: HBO Name B 2018-01-01 21:30:00 2018-01-01 22:00:00 Mov A NA NA
#4: HBO Name B 2018-01-01 22:30:00 2018-01-01 23:30:00 Mov A Mov B NA
df1 <- read.table(text =
"Channel Program program_Date start_time
HBO 'Mov A' 1/1/2018 21:00
HBO 'Mov B' 1/1/2018 23:00
HBO 'Mov C' 1/1/2018 23:59
NatGeo 'Doc A' 1/1/2018 11:00
NatGeo 'Doc B' 1/1/2018 11:30
NatGeo 'Doc C' 1/1/2018 12:00
NatGeo 'Doc D' 1/1/2018 14:00", header = T)
df2 <- read.table(text =
"Person Channel program_Date start_time end_time
'Name A' NatGeo 1/1/2018 11:00 12:00
'Name B' NatGeo 1/1/2018 12:30 14:00
'Name B' HBO 1/1/2018 21:30 22:00
'Name B' HBO 1/1/2018 22:30 23:30", header = T)