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

时间:2018-07-11 08:21:51

标签: r dplyr

我仍在学习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分钟的时间间隔内添加观看的节目,然后添加该人观看了下一个节目。谢谢

2 个答案:

答案 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)