Gruppieren Sie Datumsintervalle in der Nähe ihrer Anfangs- und Endzeiten

Question

Angenommen, ich habe eine Reihe von Beobachtungen, die Datumsintervalle darstellen, z.

library(dplyr) 
library(magrittr) 

df <- 
    data_frame(start = as.Date(c('2000-01-01', '2000-01-03', '2000-01-08', 
           '2000-01-20', '2000-01-22')), 
       end = as.Date(c('2000-01-02', '2000-01-05', '2000-01-10', 
           '2000-01-21', '2000-02-10'))) 

Ich mag diese Beobachtungen zu einer Gruppe, so dass die Startzeit der Beobachtung n innerhalb eines gewissen bestimmten Intervalls n-1 nach dem Enddatum der Beobachtung stattfindet. Zum Beispiel, wenn wir das Intervall 5 Tage sein, würden wir so etwas wie sehen:

#   start  end group 
#   (date)  (date) (dbl) 
# 1 2000-01-01 2000-01-02  1 
# 2 2000-01-03 2000-01-05  1 
# 3 2000-01-08 2000-01-10  1 
# 4 2000-01-20 2000-01-21  2 
# 5 2000-01-22 2000-02-10  2 

(Aus Gründen der Einfachheit, ich gehe davon aus keiner Überlappung in Datteln, obwohl dies nicht notwendigerweise der Fall ist in den Daten). Ich dachte über die Verwendung igraph, um eine gewichtete Edge-Liste zu erstellen, aber das schien übermäßig kompliziert. Effizienz ist, glaube ich, wichtig: Ich werde das auf etwa 4 Millionen Datengruppen mit jeweils etwa 5-10 Zeilen durchführen.

Während meine Lösung funktioniert, scheint es für mich fehleranfällig, langsam und klobig. Ich denke, ein Paket oder eine Vektorisierung würde die Sache wirklich verbessern.

group_dates <- function(df, interval){ 
    # assign first date to first group 
    df %<>% arrange(start, end) 
    df[1, 'group'] <- 1 

    # for each start date, determine if it is within `interval` days of the 
    # closest end date 
    lapply(df$start[-1], function(cur_start){ 
    earlier_data <- df[df$end <= cur_start, ] 
    diffs <- cur_start - earlier_data$end 
    min_interval <- diffs[which.min(diffs)] 
    closest_group <- earlier_data$group[which.min(diffs)] 

    if(min_interval <= interval){ 
     df[df$start == cur_start, 'group'] <<- closest_group 
    } else { 
     df[df$start == cur_start, 'group'] <<- closest_group + 1 
    } 
    }) 

    return(df) 
} 

Answer 1

Das geht relativ einfach mit dplyr.

Die Idee ist folgende:

1. Lag die Enddaten (es nach unten durch eine Verschiebung)
2. die Differenz zwischen Startdatum berechnen und den verzögerten Enddatum
3. ‚Haltepunkte‘ Hinzufügen - A Variable mit TRUE, wenn die Differenz mehr als 5 Tage beträgt und FALSE andernfalls
4. Berechnung der kumulativen Summe dieses Knickpunkts. Dies wird 1 hinzufügen, jedes Mal einen neuen Haltepunkt finden, so ein neues Intervall gestartet
wie dies sollte für Sie arbeiten

etwas sein soll:

df %>% 
    mutate(lagged_end = lag(end), 
     diff = start - lagged_end, 
     new_interval = diff > 5, 
     new_interval = ifelse(is.na(new_interval), FALSE, new_interval), 
     interval_number = cumsum(new_interval)) 

auch recht Dies sollte schnell sein, da sie alle in dplyr sind Diese

Answer 2

ist nicht so elegant wie Lorenzo Rossi-Lösung, bietet aber einen etwas anderen Ansatz mit cut.Date und 2 Zeilen Code:

breakpoints <- c(FALSE, sapply(2:nrow(df), function(x) df[x,"start"] - df[x-1,"end"]) > 5) 
clusterLabels <- as.numeric(cut.Date(df$start, c(min(df$start), df[breakpoints, "start"], max(df$start)+1)))