Как объединить 2 таблицы данных по временному интервалу и суммировать перекрывающиеся и не перекрывающиеся периоды времени по факторной переменной - PullRequest
0 голосов
/ 01 октября 2018

У меня есть 2 таблицы данных, в каждой из которых перечислены периоды наблюдательного усилия и тип усилия (A, B, C).Я хотел бы знать продолжительность времени для перекрывающихся и непересекающихся периодов усилий.

Я пытался сделать это с data.table и foverlaps, но не могу понять, как включить всенепересекающиеся периоды.

Вот мои примеры данных.Сначала я создал 2 таблицы данных, содержащие периоды усилий.Мой набор данных будет включать периоды времени, когда один наблюдатель находится в процессе.

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)

Затем я использую фаверлапы, чтобы найти, где усилие перекрывается.Я установил nomatch = NA, но это только дает мне правильное внешнее соединение.Я хотел бы полное внешнее соединение.И поэтому мне интересно, какой была бы более подходящая функция.

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

Я продолжил здесь, чтобы показать, как я пытался определить продолжительность всех перекрывающихся и непересекающихся времен сдвига.Но я не думаю, что у меня тоже есть эта часть правильная.

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

Затем я хотел бы подвести итог времени наблюдения для каждой группировки "EffortType"

Ив итоге получится что-то вроде этого (цифры приведены только для примера, потому что мне не удалось понять, как правильно рассчитать это, даже в Excel)

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

1 Ответ

0 голосов
/ 01 октября 2018

Не весь ответ (см. Последний абзац) .. но я думаю, что это даст вам то, что вы хотите.

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

приводит к

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

Иногда происходит событие 2-3 раза за одну и ту же минуту, как

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

Не уверен, как вы хотите суммировать это ...

Если вы можете рассматривать их как одну минуту, то: * 1012Я думаю, *

> 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

сделает все возможное, чтобы получить длительность в минутах (хотя, вероятно, это можно сделать гораздо умнее)

...