R- 在持续时间/间隔内合并两个数据集

Question

我仍在学习 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”之间运行的节目，并添加该人每次在该时间间隔内观看的节目。例如，

The wanted output

  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分钟时添加该人观看的节目，然后添加该人观看的下一个节目。谢谢

Answer 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)