ค้นหาช่วงเวลาที่ทับซ้อนกันในกลุ่มและรักษาช่วงเวลาที่ไม่ทับซ้อนกันมากที่สุด

ปัญหา ฉันมี dataframe ที่จัดกลุ่มโดยมีช่วงเวลาที่ทับซ้อนกัน (วันที่เป็น ymd) ฉันต้องการเก็บเฉพาะช่วงเวลาที่ไม่ทับซ้อนกันมากที่สุดในแต่ละกลุ่ม

ข้อมูลตัวอย่าง

# Packages
library(tidyverse)
library(lubridate)

# Example data
df <- tibble(
  group = c(1, 1, 1, 2, 2, 3, 3, 3, 3),
  start = as_date(
    c("2019-01-10", "2019-02-01", "2019-10-05", "2018-07-01", "2019-01-01", "2019-10-01", "2019-10-01", "2019-11-30","2019-11-20")),
  end = as_date(
    c("2019-02-07", "2019-05-01", "2019-11-15", "2018-07-31", "2019-05-05", "2019-11-06", "2019-10-07", "2019-12-10","2019-12-31"))) %>%
  mutate(intval = interval(start, end),
         intval_length = intval / days(1))

df
#> # A tibble: 9 x 5
#>   group start      end        intval                         intval_length
#>   <dbl> <date>     <date>     <Interval>                             <dbl>
#> 1     1 2019-01-10 2019-02-07 2019-01-10 UTC--2019-02-07 UTC            28
#> 2     1 2019-02-01 2019-05-01 2019-02-01 UTC--2019-05-01 UTC            89
#> 3     1 2019-10-05 2019-11-15 2019-10-05 UTC--2019-11-15 UTC            41
#> 4     2 2018-07-01 2018-07-31 2018-07-01 UTC--2018-07-31 UTC            30
#> 5     2 2019-01-01 2019-05-05 2019-01-01 UTC--2019-05-05 UTC           124
#> 6     3 2019-10-01 2019-11-06 2019-10-01 UTC--2019-11-06 UTC            36
#> 7     3 2019-10-01 2019-10-07 2019-10-01 UTC--2019-10-07 UTC             6
#> 8     3 2019-11-30 2019-12-10 2019-11-30 UTC--2019-12-10 UTC            10
#> 9     3 2019-11-20 2019-12-31 2019-11-20 UTC--2019-12-31 UTC            41

# Goal
# Row: 1 and 2; 6 to 9 have overlaps; Keep rows with largest intervals (in days)
df1 <- df[-c(1, 7, 8),]

df1
#> # A tibble: 6 x 5
#>   group start      end        intval                         intval_length
#>   <dbl> <date>     <date>     <Interval>                             <dbl>
#> 1     1 2019-02-01 2019-05-01 2019-02-01 UTC--2019-05-01 UTC            89
#> 2     1 2019-10-05 2019-11-15 2019-10-05 UTC--2019-11-15 UTC            41
#> 3     2 2018-07-01 2018-07-31 2018-07-01 UTC--2018-07-31 UTC            30
#> 4     2 2019-01-01 2019-05-05 2019-01-01 UTC--2019-05-05 UTC           124
#> 5     3 2019-10-01 2019-11-06 2019-10-01 UTC--2019-11-06 UTC            36
#> 6     3 2019-11-20 2019-12-31 2019-11-20 UTC--2019-12-31 UTC            41

แนวทางปัจจุบัน ฉันพบคำถามที่เกี่ยวข้องในกระทู้อื่น (ดู: ค้นหาวันที่ภายในช่วงเวลาตามกลุ่ม) อย่างไรก็ตาม โซลูชันที่เกี่ยวข้องจะระบุแถวที่ทับซ้อนกันทั้งหมดตามกลุ่ม ด้วยวิธีนี้ ฉันไม่สามารถระบุช่วงเวลาที่ไม่ทับซ้อนกันมากที่สุดได้

df$overlap <- unlist(tapply(df$intval, #loop through intervals
                            df$group,  #grouped by id
                            function(x) rowSums(outer(x,x,int_overlaps)) > 1))

เป็นตัวอย่าง พิจารณากลุ่ม 3 ในข้อมูลตัวอย่างของฉัน แถวนี้ 6/7 และ 8/9 ทับซ้อนกัน เนื่องจากแถวที่ 6 และ 9 เป็นช่วงที่ไม่ทับซ้อนกันมากที่สุด ฉันต้องการลบแถวที่ 7 และ 8

ฉันจะขอบคุณมากถ้ามีคนสามารถระบุวิธีแก้ปัญหาให้ฉันได้


r dplyr lubridate
person Fabian.Fuchs.    schedule 30.11.2020    source แหล่งที่มา
comment
สิ่งนี้ดูไม่สำคัญ หากข้อมูลของคุณไม่ใหญ่เกินไป คุณสามารถบังคับมันได้ มิฉะนั้นคุณจะต้องมีอัลกอริธึม นี่ไม่ใช่คำถาม R จริงๆ   -  person Michael Dewar    schedule 01.12.2020

คำตอบ (1)


arrow_upward
0
arrow_downward

หลังจากค้นหาปัญหาที่เกี่ยวข้องกับ stackoverflow ฉันพบว่าวิธีการต่อไปนี้ (ที่นี่: ยุบและรวม ช่วงเวลาที่ทับซ้อนกัน) และ (ที่นี่: วิธีการ การรวมระยะเวลาที่ทับซ้อนกัน/รวม) สามารถปรับให้เข้ากับปัญหาของฉันได้

# Solution adapted from:
# here https://stackoverflow.com/questions/53213418/collapse-and-merge-overlapping-time-intervals
# and here: https://stackoverflow.com/questions/28938147/how-to-flatten-merge-overlapping-time-periods/28938694#28938694 

# Note: df and df1 created in the initial reprex (above)

df2 <- df %>%
  group_by(group) %>%
  arrange(group, start) %>%
  mutate(indx = c(0, cumsum(as.numeric(lead(start))  >            # find overlaps
                              cummax(as.numeric(end)))[-n()])) %>%
  ungroup() %>%
  group_by(group, indx) %>%
  arrange(desc(intval_length)) %>%                                # retain largest interval
  filter(row_number() == 1) %>%
  ungroup() %>%
  select(-indx) %>%
  arrange(group, start)

# Desired output?
identical(df1, df2)
#> [1] TRUE
person Fabian.Fuchs.    schedule 01.12.2020