r date datetime lubridate

Cómo aplanar/fusionar períodos de tiempo superpuestos



date datetime (4)

Tengo un gran conjunto de datos de períodos de tiempo, definidos por una columna ''inicio'' y ''final''. Algunos de los períodos se superponen.

Me gustaría combinar (aplanar / fusionar / contraer) todos los períodos de tiempo superpuestos para tener un valor ''inicial'' y un valor ''final''.

Algunos datos de ejemplo:

ID start end 1 A 2013-01-01 2013-01-05 2 A 2013-01-01 2013-01-05 3 A 2013-01-02 2013-01-03 4 A 2013-01-04 2013-01-06 5 A 2013-01-07 2013-01-09 6 A 2013-01-08 2013-01-11 7 A 2013-01-12 2013-01-15

Resultado deseado:

ID start end 1 A 2013-01-01 2013-01-06 2 A 2013-01-07 2013-01-11 3 A 2013-01-12 2013-01-15

Lo que he intentado:

require(dplyr) data <- structure(list(ID = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L), class = "factor", .Label = "A"), start = structure(c(1356998400, 1356998400, 1357084800, 1357257600, 1357516800, 1357603200, 1357948800), tzone = "UTC", class = c("POSIXct", "POSIXt")), end = structure(c(1357344000, 1357344000, 1357171200, 1357430400, 1357689600, 1357862400, 1358208000), tzone = "UTC", class = c("POSIXct", "POSIXt"))), .Names = c("ID", "start", "end"), row.names = c(NA, -7L), class = "data.frame") remove.overlaps <- function(data){ data2 <- data for ( i in 1:length(unique(data$start))) { x3 <- filter(data2, start>=data$start[i] & start<=data$end[i]) x4 <- x3[1,] x4$end <- max(x3$end) data2 <- filter(data2, start<data$start[i] | start>data$end[i]) data2 <- rbind(data2,x4) } data2 <- na.omit(data2)} data <- remove.overlaps(data)


Aquí hay una posible solución. La idea básica aquí es comparar la fecha de start retrasada con la fecha de finalización máxima "hasta ahora" utilizando la función cummax y crear un índice que separe los datos en grupos

data %>% arrange(ID, start) %>% # as suggested by @Jonno in case the data is unsorted group_by(ID) %>% mutate(indx = c(0, cumsum(as.numeric(lead(start)) > cummax(as.numeric(end)))[-n()])) %>% group_by(ID, indx) %>% summarise(start = first(start), end = last(end)) # Source: local data frame [3 x 4] # Groups: ID # # ID indx start end # 1 A 0 2013-01-01 2013-01-06 # 2 A 1 2013-01-07 2013-01-11 # 3 A 2 2013-01-12 2013-01-15


En aras de la exhaustividad, el paquete IRanges en Bioconductor tiene algunas funciones ordenadas que se pueden utilizar para tratar los rangos de fecha o fecha y hora. Una de ellas es la función reduce() que combina rangos superpuestos o adyacentes.

Sin embargo, hay un inconveniente porque IRanges funciona en rangos de enteros (de ahí el nombre), por lo que la conveniencia de usar IRanges funciones de IRanges produce a expensas de convertir objetos Date o POSIXct para allá.

Además, parece que dplyr no funciona bien con IRanges (al menos juzgado por mi experiencia limitada con dplyr ), así que uso data.table :

library(data.table) options(datatable.print.class = TRUE) library(IRanges) library(lubridate) setDT(data)[, { ir <- reduce(IRanges(as.numeric(start), as.numeric(end))) .(start = as_datetime(start(ir)), end = as_datetime(end(ir))) }, by = ID]

ID start end <fctr> <POSc> <POSc> 1: A 2013-01-01 2013-01-06 2: A 2013-01-07 2013-01-11 3: A 2013-01-12 2013-01-15

Una variante de código es

setDT(data)[, as.data.table(reduce(IRanges(as.numeric(start), as.numeric(end))))[ , lapply(.SD, as_datetime), .SDcols = -"width"], by = ID]

En ambas variantes, se as_datetime() de los paquetes lubridate , que ahorra para especificar el origen al convertir números a objetos POSIXct .

Sería interesante ver una comparación comparativa de los enfoques de IRanges frente a la respuesta de David .


La respuesta de @David Arenburg es excelente, pero me encontré con un problema en el que un intervalo anterior terminó después de un intervalo posterior, pero usar el last en la llamada de summarise resultó en una fecha de finalización incorrecta. Sugeriría cambiar first(start) y last(end) a min(start) y max(end)

data %>% group_by(ID) %>% mutate(indx = c(0, cumsum(as.numeric(lead(start)) > cummax(as.numeric(end)))[-n()])) %>% group_by(ID, indx) %>% summarise(start = min(start), end = max(end))

Además, como mencionó @Jonno Bourne, es importante ordenar por start y cualquier variable de agrupación antes de aplicar el método.


Parece que llegué un poco tarde a la fiesta, pero tomé el código de data.table y lo data.table usando data.table continuación. No hice pruebas exhaustivas, pero parecía funcionar un 20% más rápido que la versión tidy . (No pude probar el método IRange porque el paquete aún no está disponible para R 3.5.1)

Además, la respuesta aceptada no captura el caso límite en el que un intervalo de fechas está totalmente dentro de otro (por ejemplo, 2018-07-07 a 2017-07-14 está dentro de 2018-05-01 a 2018-12-01 ) La respuesta de @zach captura ese caso extremo.

library(data.table) start_col = c("2018-01-01","2018-03-01","2018-03-10","2018-03-20","2018-04-10","2018-05-01","2018-05-05","2018-05-10","2018-07-07") end_col = c("2018-01-21","2018-03-21","2018-03-31","2018-04-09","2018-04-30","2018-05-21","2018-05-26","2018-05-30","2018-07-14") # create fake data, double it, add ID # change row 17, such that each ID grouping is a little different # also adds an edge case in which one date range is totally within another # (this is the edge case not currently captured by the accepted answer) d <- data.table(start_col = as.Date(start_col), end_col = as.Date(end_col)) d2<- rbind(d,d) d2[1:(.N/2), ID := 1] d2[(.N/2 +1):.N, ID := 2] d2[17,end_col := as.Date(''2018-12-01'')] # set keys (also orders) setkey(d2, ID, start_col, end_col) # get rid of overlapping transactions and do the date math squished <- d2[,.(START_DT = start_col, END_DT = end_col, indx = c(0, cumsum(as.numeric(lead(start_col)) > cummax(as.numeric(end_col)))[-.N])), keyby=ID ][,.(start=min(START_DT), end = max(END_DT)), by=c("ID","indx") ]