6

I am looking to combine lubridate intervals such that if they overlap, take the min value from the internal first in time and the max value from the internal last in time and summarise to create a new interval that spans the entire period. Here is a reprex:

library(lubridate, warn.conflicts = FALSE)
library(dplyr, warn.conflicts = FALSE)
library(tibble)

dat <- tibble(
  animal = rep(c("elk", "wolf", "moose"), each = 2),
  date_interval = c(
    interval(as.Date("2020-04-01"), as.Date("2020-04-05")),
    interval(as.Date("2020-04-10"), as.Date("2020-04-15")),
    interval(as.Date("2020-03-01"), as.Date("2020-04-01")),
    interval(as.Date("2020-02-15"), as.Date("2020-03-15")),
    interval(as.Date("2020-10-01"), as.Date("2020-11-01")),
    interval(as.Date("2020-09-15"), as.Date("2020-10-15"))
  )
)

dat
#> # A tibble: 6 x 2
#>   animal date_interval                 
#>   <chr>  <Interval>                    
#> 1 elk    2020-04-01 UTC--2020-04-05 UTC
#> 2 elk    2020-04-10 UTC--2020-04-15 UTC
#> 3 wolf   2020-03-01 UTC--2020-04-01 UTC
#> 4 wolf   2020-02-15 UTC--2020-03-15 UTC
#> 5 moose  2020-10-01 UTC--2020-11-01 UTC
#> 6 moose  2020-09-15 UTC--2020-10-15 UTC

Ok so in the wolf and moose levels, we have overlapping intervals. Assuming that this is the same wolf and moose something like would double count the days:

dat %>%
  group_by(animal) %>%
  mutate(time = time_length(date_interval)) %>%
  summarise(time_cumu = sum(time))
#> `summarise()` ungrouping output (override with `.groups` argument)
#> # A tibble: 3 x 2
#>   animal time_cumu
#>   <chr>      <dbl>
#> 1 elk       777600
#> 2 moose    5270400
#> 3 wolf     5184000

This is the type of output I would like to get that summarises the overlapping intervals:

tibble(
  animal = c("elk", "elk", "wolf", "moose"),
  date_interval = c(
    interval(as.Date("2020-04-01"), as.Date("2020-04-05")),
    interval(as.Date("2020-04-10"), as.Date("2020-04-15")),
    interval(as.Date("2020-02-15"), as.Date("2020-04-01")),
    interval(as.Date("2020-09-15"), as.Date("2020-11-01"))
  )
)
#> # A tibble: 4 x 2
#>   animal date_interval                 
#>   <chr>  <Interval>                    
#> 1 elk    2020-04-01 UTC--2020-04-05 UTC
#> 2 elk    2020-04-10 UTC--2020-04-15 UTC
#> 3 wolf   2020-02-15 UTC--2020-04-01 UTC
#> 4 moose  2020-09-15 UTC--2020-11-01 UTC

Ideas?

boshek
  • 4,100
  • 1
  • 31
  • 55

2 Answers2

6

There doesn't seem to be a function in lubridate for merging a vector of intervals into a vector of non-overlapping intervals.

Here is one way to implement it:

int_merge <- function(x) {
  if(length(x) == 1) return(x)
  x <- x[order(int_start(x))]
  y <- x[1]
  for(i in 2:length(x)){
    if(int_overlaps(y[length(y)], x[i]))
      y[length(y)] <- interval(start = min(int_start(c(y[length(y)], x[i]))),
                               end = max(int_end(c(y[length(y)], x[i]))))
    else
      y <- c(y, x[i])
  }
  return(y)
}

This allows you to do:

dat %>% 
   group_by(animal) %>% 
   summarize(date_interval = int_merge(date_interval))

#> # A tibble: 4 x 2
#> # Groups:   animal [3]
#>   animal date_interval                 
#>   <chr>  <Interval>                    
#> 1 elk    2020-04-01 UTC--2020-04-05 UTC
#> 2 elk    2020-04-10 UTC--2020-04-15 UTC
#> 3 moose  2020-09-15 UTC--2020-11-01 UTC
#> 4 wolf   2020-02-15 UTC--2020-04-01 UTC
Allan Cameron
  • 147,086
  • 7
  • 49
  • 87
0

The bed_merge() function of the valr package may be something to look at. It does the job super fast and easy!

Teun Siebers
  • 21
  • 5