R - (Tidyverse) Compression de plusieurs observations en une seule

Question

J'ai un jeu de données qui contient plusieurs variables, dont deux sont des dates (date de début, date de fin). Parfois, un intervalle de dates a été divisé en séquences :

Démarrage : 1990-12-12, Arrêt : 1990-12-13 Début : 1990-12-13, Arrêt : 1990-12-14

Plutôt que de

Démarrage : 1990-12-12, Fin : 1990-12-14

Ce que je veux faire, c'est isoler ces chaînes de séquences et les regrouper en une seule observation de sorte que toutes les observations de la fin de la séquence soient sauvegardées et que les autres soient écrasées (à l'exception de la première date de début). Voici un exemple de base :

library(tidyverse)
library(lubridate)

tib_ex <- tibble(
  id = rep(1,5),
  date1 = ymd(c('1990-11-05', '1990-12-01', 
                '1990-12-05', '1990-12-08', 
                '1990-12-15')),
  date2 = ymd(c('1990-11-28', '1990-12-05', 
                '1990-12-08', '1990-12-12', 
                '1990-12-31')),
  var1 = 2:6,
  var2 = 7:11,
  var3 = 12:16,
  var4 = c(0, 1, 0 ,0, 1)
)

On obtient ainsi le tableau suivant :

# A tibble: 5 x 7
     id date1      date2       var1  var2  var3  var4
  <dbl> <date>     <date>     <int> <int> <int> <dbl>
1     1 1990-11-05 1990-11-28     2     7    12     0
2     1 1990-12-01 1990-12-05     3     8    13     1
3     1 1990-12-05 1990-12-08     4     9    14     0
4     1 1990-12-08 1990-12-12     5    10    15     0
5     1 1990-12-15 1990-12-31     6    11    16     1

Que je souhaite transformer en tibble suivant :

# A tibble: 3 x 7
     id date1      date2       var1  var2  var3  var4
  <dbl> <chr>      <chr>      <dbl> <dbl> <dbl> <dbl>
1     1 1990-11-05 1990-11-28     2     7    12     0
2     1 1990-12-01 1990-12-12     5    10    15     0
3     1 1990-12-15 1990-12-31     6    11    16     1

J'ai pensé à l'imbrication par id, date1 et date2, qui regroupe le reste des variables dans un tibble par ligne, ce qui facilite l'écrasement, mais je ne sais pas comment réduire efficacement les dates de la ligne 2 à la ligne 4.

J'ai essayé de créer une variable binaire qui indique si la date de fin d'une observation correspond à la date de début de l'observation suivante, mais je rencontre également des difficultés à ce niveau.

Answer 1

Recherchez les lignes contenant les dates de début et de fin en les comparant à la ligne suivante/précédente et combinez les résultats d'une manière appropriée :

date_info <- 
  tib_ex %>% 
  ## find indices of start and end dates by comparing with date in next / previous row
  mutate(is_startdate = date1 != lag(date2),
         is_enddate = date2 != lead(date1)) %>% 
  ## NA's appear at the beginning (start_date) and end (end_date) and should thus be interpreted as TRUE
  replace_na(list(is_startdate = T, is_enddate = T))

## combine the start- and end-dates
date_info %>% 
  filter(is_enddate) %>% 
  mutate(date1 = date_info$date1[date_info$is_startdate]) %>% 
  select(-starts_with("is_"))

-------
# A tibble: 3 x 7
id date1      date2       var1  var2  var3  var4
<dbl> <date>     <date>     <int> <int> <int> <dbl>
1  1.00 1990-11-05 1990-11-28     2     7    12  0   
2  1.00 1990-12-01 1990-12-12     5    10    15  0   
3  1.00 1990-12-15 1990-12-31     6    11    16  1.00

Answer 2

Voici une autre approche qui fonctionnera également si l'ensemble de données contient plus d'un individu id . Selon le résultat attendu par l'OP, les variables additionnelles var1 a var4 sont agrégées/résumées en choisissant la valeur à la fin de chaque période effondrée.

L'approche ci-dessous

• utilise cumsum() y lag() pour identifier les lignes qui appartiennent à une même période,
• utilise summarize() pour réduire les dates de début et de fin,
• et se joint à l'ensemble de données original pour sélectionner les valeurs à la fin de chaque période effondrée.

La dernière étape consiste à éviter d'inclure toutes les variables supplémentaires dans l'appel à summarize() .

tib_ex %>% 
  arrange(id, date1, date2) %>%   # this is important!
  group_by(id) %>% 
  mutate(period = cumsum(lag(date2, default = date1[1]) < date1)) %>% 
  right_join(
    (.) %>% group_by(id, period) %>% 
      summarize(date1 = first(date1), date2 = last(date2)),
    by = c("id", "period", "date2"), suffix = c("", ".y")) %>% 
  select(-period, -date1.y) 

# A tibble: 3 x 7
# Groups:   id [1]
     id date1      date2       var1  var2  var3  var4
  <dbl> <date>     <date>     <int> <int> <int> <dbl>
1     1 1990-11-05 1990-11-28     2     7    12     0
2     1 1990-12-08 1990-12-12     5    10    15     0
3     1 1990-12-15 1990-12-31     6    11    16     1

---

Voici un test qui montre que l'approche fonctionne pour plusieurs personnes. id :

tib_ex %>% 
  bind_rows(
  (.) %>% mutate(id = 2))

duplique l'ensemble des données des PO pour id = 2 :

# A tibble: 10 x 7
      id date1      date2       var1  var2  var3  var4
   <dbl> <date>     <date>     <int> <int> <int> <dbl>
 1     1 1990-11-05 1990-11-28     2     7    12     0
 2     1 1990-12-01 1990-12-05     3     8    13     1
 3     1 1990-12-05 1990-12-08     4     9    14     0
 4     1 1990-12-08 1990-12-12     5    10    15     0
 5     1 1990-12-15 1990-12-31     6    11    16     1
 6     2 1990-11-05 1990-11-28     2     7    12     0
 7     2 1990-12-01 1990-12-05     3     8    13     1
 8     2 1990-12-05 1990-12-08     4     9    14     0
 9     2 1990-12-08 1990-12-12     5    10    15     0
10     2 1990-12-15 1990-12-31     6    11    16     1

tib_ex %>% 
  bind_rows(
    (.) %>% mutate(id = 2)) %>%
  arrange(id, date1, date2) %>%   # this is important!
  group_by(id) %>% 
  mutate(period = cumsum(lag(date2, default = date1[1]) < date1)) %>% 
  right_join(
    (.) %>% group_by(id, period) %>% 
      summarize(date1 = first(date1), date2 = last(date2)),
    by = c("id", "period", "date2"), suffix = c("", ".y")) %>% 
  select(-period, -date1.y) 

# A tibble: 6 x 7
# Groups:   id [2]
     id date1      date2       var1  var2  var3  var4
  <dbl> <date>     <date>     <int> <int> <int> <dbl>
1     1 1990-11-05 1990-11-28     2     7    12     0
2     1 1990-12-08 1990-12-12     5    10    15     0
3     1 1990-12-15 1990-12-31     6    11    16     1
4     2 1990-11-05 1990-11-28     2     7    12     0
5     2 1990-12-08 1990-12-12     5    10    15     0
6     2 1990-12-15 1990-12-31     6    11    16     1