Search code examples
rdata.tableoverlap

How to join 2 data tables by time interval and summarize overlapping and non-overlapping time periods by factor variable


I have 2 data tables, each lists periods of observation effort, and type of effort (A,B,C). I would like to know the duration of time for the overlapping and non-overlapping periods of effort.

I've tried to do this with data.table and foverlaps, but can't figure out how to include all the non-overlapping periods.

Here is my example data. I first created 2 data tables containing periods of effort. My dataset will include periods of time when a single observer is on effort.

library(data.table)
library(lubridate)

# times have been edited so not fixed to minute intervals - to make more realistic
set.seed(13)
EffortType = sample(c("A","B","C"), 100, replace = TRUE)
On = sample(seq(as.POSIXct('2016/01/01 01:00:00'), as.POSIXct('2016/01/03 01:00:00'), by = "1 sec"), 100, replace=F)
Off = On + minutes(sample(1:60, 100, replace=T))
Effort1 = data.table(EffortType, On, Off)

EffortType2 = sample(c("A","B","C"), 100, replace = TRUE)
On2 = sample(seq(as.POSIXct('2016/01/01 12:00:00'), as.POSIXct('2016/01/03 12:00:00'), by = "1 sec"), 100, replace=F)
Off2 = On2 + minutes(sample(1:60, 100, replace=T))
Effort2 = data.table(EffortType2, On2, Off2)

#prep for using foverlaps
setkey(Effort1, On, Off)
setkey(Effort2, On2, Off2)

Then I use foverlaps to find where the effort overlaps. I've set nomatch=NA, but this just gives me the right outer join. I would like the full outer join. And so i wonder what the more appropriate function would be.

matches = foverlaps(Effort1,Effort2,type="any",nomatch=NA)

I've continued on here to show how I've tried to determine the duration of all the overlapping and non-overlapping shift times. But I don't think I've got this part correct either.

# find start and end of intersection of all shifts
matches$start = pmax(matches$On, matches$On2, na.rm=T)
matches$end = pmin(matches$Off, matches$Off2, na.rm=T)

# create intervals and find durations
matches$int = interval(matches$start, matches$end)
matches$dur = as.duration(matches$int)

I would then like sum up the amount of observation effort time for each grouping of "EffortType"

And end up with something like this (numbers are examples only because I have not managed to figure out how to calculate this correctly, even in excel)

EffortType  Duration(in minutes)
A           10
B           20
C           12
AA          8
BB          6
CC          1
AC          160
AB          200
BC          150

Solution

  • Not the entire answer (see last paragraph).. but I think this will get you what you want.

    library( data.table )
    library( lubridate )
    
    set.seed(13)
    EffortType = sample(c("A","B","C"), 100, replace = TRUE)
    On = sample(seq(as.POSIXct('2016/01/01 01:00:00'), as.POSIXct('2016/01/03 01:00:00'), by = "15 mins"), 100, replace=T)
    Off = On + minutes(sample(1:60, 100, replace=T))
    Effort1 = data.table(EffortType, On, Off)
    
    EffortType2 = sample(c("A","B","C"), 100, replace = TRUE)
    On = sample(seq(as.POSIXct('2016/01/01 12:00:00'), as.POSIXct('2016/01/03 12:00:00'), by = "15 mins"), 100, replace=T)
    Off = On + minutes(sample(1:60, 100, replace=T))
    Effort2 = data.table(EffortType2, On, Off)
    
    #create DT of minutes, spanning your entire period.
    dt.minutes <- data.table( On = seq(as.POSIXct('2016/01/01 01:00:00'), as.POSIXct('2016/01/03 12:00:00'), by = "1 mins"), 
                              Off = seq(as.POSIXct('2016/01/01 01:00:00'), as.POSIXct('2016/01/03 12:00:00'), by = "1 mins") + 60 )
    
    #prep for using foverlaps
    setkey(Effort1, On, Off)
    setkey(Effort2, On, Off)
    
    #overlap join both efforts on the dt.minutes. note the use of "within" an "nomatch" to throw away minutes without events.
    
    m1 <- foverlaps(dt.minutes, Effort1 ,type="within",nomatch=0L)
    m2 <- foverlaps(dt.minutes, Effort2 ,type="within",nomatch=0L)
    
    #bind together
    result <- rbindlist(list(m1,m2))[, `:=`(On=i.On, Off = i.Off)][, `:=`(i.On = NULL, i.Off = NULL)]
    
    #cast the result
    result.cast <- dcast( result, On + Off ~ EffortType, value.var = "EffortType")
    

    results in

    head( result.cast, 10)
    
    #                      On                 Off A B C
    #  1: 2016-01-01 01:00:00 2016-01-01 01:01:00 1 0 1
    #  2: 2016-01-01 01:01:00 2016-01-01 01:02:00 1 0 1
    #  3: 2016-01-01 01:02:00 2016-01-01 01:03:00 1 0 1
    #  4: 2016-01-01 01:03:00 2016-01-01 01:04:00 1 0 1
    #  5: 2016-01-01 01:04:00 2016-01-01 01:05:00 1 0 1
    #  6: 2016-01-01 01:05:00 2016-01-01 01:06:00 1 0 1
    #  7: 2016-01-01 01:06:00 2016-01-01 01:07:00 1 0 1
    #  8: 2016-01-01 01:07:00 2016-01-01 01:08:00 1 0 1
    #  9: 2016-01-01 01:08:00 2016-01-01 01:09:00 1 0 1
    # 10: 2016-01-01 01:09:00 2016-01-01 01:10:00 1 0 1
    

    Sometimes a event occurs 2-3 times within the same minute, like

    #                     On                 Off A B C
    #53: 2016-01-02 14:36:00 2016-01-02 14:37:00 2 2 3
    

    Not sure on how you want to sum that...

    If you can treat them as a single minute, then:

    > sum( result.cast[A>0 & B==0, C==0, ] )
    [1] 476
    > sum( result.cast[A==0 & B>0, C==0, ] )
    [1] 386
    > sum( result.cast[A==0 & B==0, C>0, ] )
    [1] 504
    > sum( result.cast[A>0 & B>0, C==0, ] )
    [1] 371
    > sum( result.cast[A==0 & B>0, C>0, ] )
    [1] 341
    > sum( result.cast[A>0 & B==0, C>0, ] )
    [1] 472
    > sum( result.cast[A>0 & B>0, C>0, ] )
    [1] 265
    

    will do the trick to get duration in minutes, I think (although this can probably be done in a much smarter way)