Regroupement d'une trame de données par date: résoudre le bug des périodes manquantes

Question

J'ai identifié, si je ne l'ai pas moi-même créé, un bogue difficile à résoudre dans un bon code reçu d'un généreux répondant ici sur StackOverflow il y a quelques semaines pourrait utiliser une nouvelle aide aujourd'hui.

données d'échantillon (appelé objet eh ci-dessous):

ID  2013-03-20 2013-04-09 2013-04-11 2013-04-17 2013-04-25 2013-05-15 2013-05-24 2013-05-25 2013-05-26 
    5167f   0   0   0   0   0   0   0   0   0 
    1214m   0   0   0   0   0   0   0   0   0 
    1844f   0   0   0   0   0   0   0   0   0 
    2113m   0   0   0   0   0   0   0   0   0 
    2254m   0   0   0   0   0   0   0   0   0 
    2721f   0   0   0   0   0   0   0   0   0 
    3121f   0   0   0   0   0   0   0   0   0 
    3486f   0   0   0   0   0   0   0   0   0 
    3540f   0   0   0   0   0   0   0   0   0 
    4175m   0   0   0   0   0   0   0   0   0 

Je dois être en mesure de groupe 0s et 1s par la période dans laquelle la date de leur colonne respective tombe (par exemple, tous les 1, 2, 3 , ou 4 semaines). Chaque fois qu'un 1 tombe au moins une fois dans une plage de dates spécifique (Period), alors un 1 est résumé pour ce ID dans ce Period (0, else). Je commence par la routine récapitulative d'une semaine à titre d'exemple. Mon principal problème est que la sortie finale générée manque une partie du total possible 1-semaine Periods au cours de la série chronologique "2013-03-20" à "2015-12-31".

Avis dans cette sortie par exemple, dans lequel les lignes sont pour uniques IDs et les colonnes sont pour Periods uniques, comment Periods 2, 5, 7 et 9 sont portés disparus:

1 3 4 6 8 10 11 12 13 14 
    0 0 0 0 0 0 0 0 0 0 
    0 0 0 0 0 0 0 0 0 0 
    0 0 0 0 0 0 0 0 0 0 
    0 0 0 0 0 0 0 0 0 0 
    0 0 0 0 0 0 0 0 0 0 
    0 0 0 0 0 0 0 0 0 0 

Voici la routine complète pour grouper la trame de données d'origine (voir les données ci-dessus) échantillons partagés:

#Convert to data table from original data frame, eh 
    dt <- as.data.table(eh) 

    #One week summarized encounter histories 
    dt_merge <- data_frame(
     # Create a column showing the beginning date 
     Date1 = seq(from = ymd("2013-03-20"), to = ymd("2015-12-31"), by = "1 week")) %>% 
     # Create a column showing the end date of each period 
     mutate(Date2 = lead(Date1)) %>% 
     # Adjust Date1 
     mutate(Date1 = if_else(Date1 == ymd("2013-03-20"), Date1, Date1 + 1)) %>% 
     # Remove the last row 
     drop_na(Date2) %>% 
     # Create date list 
     mutate(Dates = map2(Date1, Date2, function(x, y){ seq(x, y, by = "day") })) %>% 
     unnest() %>% 
     # Create Group ID 
     mutate(RunID = group_indices_(., dots. = c("Date1", "Date2"))) %>% 
     # Create Period ID 
     mutate(Period = paste0(RunID)) %>% 
     # Add a column showing Month 
     mutate(Month = month(Dates)) %>% 
     # Add a column showing Year 
     mutate(Year = year(Dates)) %>% 
     # Add a column showing season 
     mutate(Season = case_when(
     Month %in% 3:5   ~ "Spring", 
     Month %in% 6:8   ~ "Summer", 
     Month %in% 9:11   ~ "Fall", 
     Month %in% c(12, 1, 2) ~ "Winter", 
     TRUE      ~ NA_character_ 
    )) %>% 
     # Combine Season and Year 
     mutate(SeasonYear = paste0(Season, Year)) %>% 
     select(-Date1, -Date2, -RunID) 
    dt2 <- dt %>% 
     # Reshape the data frame 
     gather(Date, Value, -ID) %>% 
     # Convert Date to date class 
     mutate(Date = ymd(Date)) %>% 
     # Join dt_merge 
     left_join(dt_merge, by = c("Date" = "Dates")) 
    one.week <- dt2 %>% 
     group_by(ID, Period) %>% 
     summarise(Value = max(Value)) %>% 
     spread(Period, Value) 

    #Finished product 
    one.week <- as.data.frame(one.week) 

    #Missing weeks 2, 5, 7, and 9... 
    one.week 

quelqu'un peut-il me aider à comprendre où je suis allé mal? Merci d'avance!

-AD

Answer 1

Cela se produit parce que les semaines sont absents des eh données. Par exemple, si vous regardez les dates qui composent la semaine 2:

dt_merge %>% 
    filter(Period == 2) 
#> # A tibble: 7 x 6 
#>  Dates Period Month Year Season SeasonYear 
#>  <date> <chr> <dbl> <dbl> <chr>  <chr> 
#> 1 2013-03-28  2  3 2013 Spring Spring2013 
#> 2 2013-03-29  2  3 2013 Spring Spring2013 
#> 3 2013-03-30  2  3 2013 Spring Spring2013 
#> 4 2013-03-31  2  3 2013 Spring Spring2013 
#> 5 2013-04-01  2  4 2013 Spring Spring2013 
#> 6 2013-04-02  2  4 2013 Spring Spring2013 
#> 7 2013-04-03  2  4 2013 Spring Spring2013 

Vous pouvez voir qu'aucun de ces dates sont dans les colonnes de eh, qui sautent de 20/03/2013 à 2013-04- 09 Parce que vous utilisez un left_join lors de la création dt2, seules les dates (et donc les semaines) dans eh sont conservées.

Cela peut être corrigé en utilisant complete() à partir du package tidyr pour créer les combinaisons manquantes d'ID et de date.

dt2 <- dt %>% 
    # Reshape the data frame 
    gather(Date, Value, -ID) %>% 
    # Convert Date to date class 
    mutate(Date = ymd(Date)) %>% 
    # Create missing ID/Date combinations 
    complete(ID, Date = dt_merge$Dates) %>% 
    # Join dt_merge 
    left_join(dt_merge, by = c("Date" = "Dates")) 
one.week <- dt2 %>% 
    mutate(Period = as.numeric(Period)) %>% 
    group_by(ID, Period) %>% 
    summarise(Value = max(Value, na.rm = TRUE)) %>% 
    spread(Period, Value) 
one.week 
#> # A tibble: 10 x 146 
#> # Groups: ID [10] 
#>  ID `1` `2` `3` `4` `5` `6` `7` `8` `9` `10` `11` 
#> * <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> 
#> 1 1214m  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 2 1844f  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 3 2113m  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 4 2254m  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 5 2721f  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 6 3121f  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 7 3486f  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 8 3540f  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 9 4175m  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 10 5167f  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> # ... with 134 more variables: `12` <dbl>, `13` <dbl>, `14` <dbl>, 
#> # `15` <dbl>, `16` <dbl>, `17` <dbl>, `18` <dbl>, `19` <dbl>, 
#> # `20` <dbl>, `21` <dbl>, `22` <dbl>, `23` <dbl>, `24` <dbl>, 
#> # `25` <dbl>, `26` <dbl>, `27` <dbl>, `28` <dbl>, `29` <dbl>, 
#> # `30` <dbl>, `31` <dbl>, `32` <dbl>, `33` <dbl>, `34` <dbl>, 
#> # `35` <dbl>, `36` <dbl>, `37` <dbl>, `38` <dbl>, `39` <dbl>, 
#> # `40` <dbl>, `41` <dbl>, `42` <dbl>, `43` <dbl>, `44` <dbl>, 
#> # `45` <dbl>, `46` <dbl>, `47` <dbl>, `48` <dbl>, `49` <dbl>, 
#> # `50` <dbl>, `51` <dbl>, `52` <dbl>, `53` <dbl>, `54` <dbl>, 
#> # `55` <dbl>, `56` <dbl>, `57` <dbl>, `58` <dbl>, `59` <dbl>, 
#> # `60` <dbl>, `61` <dbl>, `62` <dbl>, `63` <dbl>, `64` <dbl>, 
#> # `65` <dbl>, `66` <dbl>, `67` <dbl>, `68` <dbl>, `69` <dbl>, 
#> # `70` <dbl>, `71` <dbl>, `72` <dbl>, `73` <dbl>, `74` <dbl>, 
#> # `75` <dbl>, `76` <dbl>, `77` <dbl>, `78` <dbl>, `79` <dbl>, 
#> # `80` <dbl>, `81` <dbl>, `82` <dbl>, `83` <dbl>, `84` <dbl>, 
#> # `85` <dbl>, `86` <dbl>, `87` <dbl>, `88` <dbl>, `89` <dbl>, 
#> # `90` <dbl>, `91` <dbl>, `92` <dbl>, `93` <dbl>, `94` <dbl>, 
#> # `95` <dbl>, `96` <dbl>, `97` <dbl>, `98` <dbl>, `99` <dbl>, 
#> # `100` <dbl>, `101` <dbl>, `102` <dbl>, `103` <dbl>, `104` <dbl>, 
#> # `105` <dbl>, `106` <dbl>, `107` <dbl>, `108` <dbl>, `109` <dbl>, 
#> # `110` <dbl>, `111` <dbl>, ... 

Ici -Inf est retourné s'il n'y avait pas de valeurs pour cet ID dans une semaine donnée. Alternativement, au lieu de remplir les valeurs manquantes avec NA, ils pourraient être remplis, par exemple 0, en utilisant complete(ID, Date = dt_merge$Dates, fill = list(Value = 0)). Cela rendra la variable de valeur 0 pour toutes les combinaisons ID et date non observées.