Lubridate & Dplyr

Tenho um banco de dados em formato longo. Um exemplo dele se encontra abaixo.

Nome: Banco_teste_datas

| Id | Data_Inicio | Data_Final|
1 |17/06/2020 | 28/06/2020|
1 |02/07/2020 | 24/07/2020|
2 |14/08/2020 | 01/09/2020|
2 |05/08/2020 | 14/08/2020|
3 |24/05/2020 | 28/05/2020|
3 |17/05/2020 | 24/05/2020|
3 |08/05/2020 | 17/05/2020|
4 |30/08/2020 | 09/09/2020|
4 |24/08/2020 | 13/09/2020|
5 |04/12/2020 | 18/12/2020|
5 |04/12/2020 | 18/12/2020|

Nesse banco tenho datas com:
(1°) intevalos concomitantes
(2°) intervalos diferentes
(3°) intervalos com Data_Inicio e Data_Final iguais para o mesmo Id
(4°) intervalos em que a Data_Final é igual a Data_Inicio para o mesmo Id

O que preciso fazer? Preciso contar os dias entre estes intervalos por Id. Mas veja que no caso (1°) que está demostrado no Id 4 do exemplo de BD, devo contar os dias entre a menor Data_Inicio e a maior Data_Final, e isso se estende aos casos (3°) e (4°). No caso (2°) por serem intervalos diferentes devo contar os dias dos dois intervalos.

Este processo não é trivial pra mim e, por isso, peço help.

A primeira tentativa foi criar uma coluna intervalo com o seguinte código:

`banco_teste_datas$Intervalo ← banco_teste_datas$Data_Final %–% banco_teste_datas$Data_Inicio

E após agrupar por Id:

banco_group <- banco_teste_datas %>%
 group_by(Id) %>%
 summarise(data_inicio = lubridate::int_start(Intervalo),
           data_final = lubridate::int_end(Intervalo)) 

Essa tentativa não rolou da forma que eu esperava. Outra tentativa vou tentar passar este banco de longo para largo com as funções do pacote Tidyr e novamente a missão não foi concluida.

Pelo vicio não consegui pensar em outras alternativas.

1 Curtida

Oi Fe, tudo bem?

Me parece que para a maior parte dos casos dá pra resolver usando uma conta de maior data menos menor data (quando são os casos 1, 3 e 4 que você citou). Eu entendi certo?
O que nao resolve assim é o caso 2 (intervalos diferentes, entao calcular a diferença para cada linha nesses ids, e somar as diferenças).

eu pensei em : identificar onde é o caso 2, separar a base, e fazer a “conta” separado (pensando na regra que vale pra cada um)

aqui vai um primeiro brainstorm. não está elegante o código… acho que podemos pensar em como melhorar. também seria bom testar para mais dados e verificar se dá certo.

library(magrittr, include.only = "%>%")

# criar a base
# vc comentou comigo que as vezes chega a ter 4 casos.
# adicionei mais uma  linha no id 3
banco_teste_datas <- tibble::tribble(
  ~Id, ~Data_Inicio,  ~Data_Final,
   1L, "17/06/2020", "28/06/2020",
   1L, "02/07/2020", "24/07/2020",
   2L, "14/08/2020", "01/09/2020",
   2L, "05/08/2020", "14/08/2020",
   3L, "24/05/2020", "28/05/2020",
   3L, "17/05/2020", "24/05/2020",
   3L, "08/05/2020", "17/05/2020",
   3L, "08/05/2020", "17/05/2020", # aqui dupliquei uma linha para ter 4 casos
   4L, "30/08/2020", "09/09/2020",
   4L, "24/08/2020", "13/09/2020",
   5L, "04/12/2020", "18/12/2020",
   5L, "04/12/2020", "18/12/2020"
  )


# olhar a base
dplyr::glimpse(banco_teste_datas)
#> Rows: 12
#> Columns: 3
#> $ Id          <int> 1, 1, 2, 2, 3, 3, 3, 3, 4, 4, 5, 5
#> $ Data_Inicio <chr> "17/06/2020", "02/07/2020", "14/08/2020", "05/08/2020", "2…
#> $ Data_Final  <chr> "28/06/2020", "24/07/2020", "01/09/2020", "14/08/2020", "2…


# arrumar as colunas
df <- banco_teste_datas %>%
  janitor::clean_names() %>%
  dplyr::mutate(
    data_inicio = readr::parse_date(data_inicio, format = "%d/%m/%Y"),
    data_final = readr::parse_date(data_final, format = "%d/%m/%Y")
  )


# aqui basicamente eu to tentando testar o que cai no caso 2!
teste_casos <- df %>%
  dplyr::mutate(intervalo = lubridate::interval(data_inicio, data_final)) %>%
  dplyr::select(-data_inicio, -data_final) %>%
  dplyr::group_by(id) %>%
  dplyr::mutate(ordem = dplyr::row_number()) %>%
  dplyr::ungroup() %>%
  tidyr::pivot_wider(
    id_cols = id,
    values_from = intervalo,
    names_from = ordem,
    names_prefix = "ordem_"
  ) %>%
  dplyr::mutate(
    overlap_1_2 = lubridate::int_overlaps(ordem_1, ordem_2),
    overlap_1_3 = lubridate::int_overlaps(ordem_1, ordem_3),
    overlap_1_4 = lubridate::int_overlaps(ordem_1, ordem_4),
    overlap_2_3 = lubridate::int_overlaps(ordem_2, ordem_3),
    overlap_2_4 = lubridate::int_overlaps(ordem_2, ordem_4),
    overlap_3_4 = lubridate::int_overlaps(ordem_3, ordem_4)
  ) %>%
  dplyr::mutate_at(
    dplyr::vars(overlap_1_2:overlap_3_4),
    ~ tidyr::replace_na(., 0)
  ) %>%
  dplyr::mutate(soma_overlap = overlap_1_2 + overlap_1_3 + overlap_1_4 + overlap_2_3 +
    overlap_2_4 + overlap_3_4)
# aqui quando a soma_overlap = 0 , é o caso 2.


# separar os IDs de cada caso
ids_caso_2 <-
  teste_casos %>%
  dplyr::filter(soma_overlap == 0) %>%
  dplyr::pull(id)

ids_outros_casos <-
  teste_casos %>%
  dplyr::filter(soma_overlap != 0) %>%
  dplyr::pull(id)

# calcular a diferenca para outros casos

diferenca_outros_casos <- df %>%
  dplyr::filter(id %in% ids_outros_casos) %>%
  tibble::rowid_to_column(var = "numero_linha") %>%
  tidyr::pivot_longer(
    names_to = "tipo_data",
    cols = c(data_inicio, data_final)
  ) %>%
  dplyr::group_by(id) %>%
  dplyr::filter(value == min(value) | value == max(value)) %>%
  dplyr::ungroup() %>%
  dplyr::distinct(id, tipo_data, value) %>%
  tidyr::pivot_wider(
    id_cols = id,
    names_from = tipo_data,
    values_from = value
  ) %>%
  dplyr::mutate(diferenca = data_final - data_inicio) %>%
  dplyr::select(id, diferenca)


diferenca_caso_2 <- df %>%
  dplyr::filter(id %in% ids_caso_2) %>%
  dplyr::mutate(diferenca = data_final - data_inicio) %>%
  dplyr::group_by(id) %>%
  dplyr::summarise(diferenca = sum(diferenca, na.rm = TRUE))



# juntar tudo na base
resposta <-
  dplyr::bind_rows(diferenca_outros_casos, diferenca_caso_2) %>%
  dplyr::arrange(id)

# o que queremos no final? um df com id e coluna com o valor calculado

resposta %>% knitr::kable()
id diferenca
1 33 days
2 27 days
3 20 days
4 20 days
5 14 days

Created on 2021-06-02 by the reprex package (v2.0.0.9000)

2 Curtidas

@Fernanda_Kelly e @beatrizmilz

Eu achei esse problema muito interessante! Ele tem formulação simples mas tem solução muito difícil.

A solução da bea cobre casos em que o período pode ser qualquer medida (dias, horas, segundos etc), mas parece que overfita para se ter no BD no max 4 linhas por ID (ordem_4 e tals).

Eu pensei numa versão que é o inverso: serve para qualquer quantidade de período por ID, mas serve apenas se for para contar DIAS (dá pra adaptar pra semanas, anos, etc, mas daí poderia ficar muito ineficiente).

library(tidyverse)

banco_teste_datas <- tibble::tribble(
    ~Id, ~Data_Inicio,  ~Data_Final,
    1L, "17/06/2020", "28/06/2020",
    1L, "02/07/2020", "24/07/2020",
    2L, "14/08/2020", "01/09/2020",
    2L, "05/08/2020", "14/08/2020",
    3L, "24/05/2020", "28/05/2020",
    3L, "17/05/2020", "24/05/2020",
    3L, "08/05/2020", "17/05/2020",
    3L, "08/05/2020", "17/05/2020", # aqui dupliquei uma linha para ter 4 casos
    4L, "30/08/2020", "09/09/2020",
    4L, "24/08/2020", "13/09/2020",
    5L, "04/12/2020", "18/12/2020",
    5L, "04/12/2020", "18/12/2020"
)

df <- banco_teste_datas %>%
    janitor::clean_names() %>%
    dplyr::mutate(
        data_inicio = readr::parse_date(data_inicio, format = "%d/%m/%Y"),
        data_final = readr::parse_date(data_final, format = "%d/%m/%Y")
    )

# 1) Cria-se um vetor de datas para cada linha, do data_inicio ao data_final.
df <- df %>%
    mutate(
        vetor_de_datas = map2(data_inicio, data_final, ~seq.Date(.x, .y, by = "1 day"))
    ) 
df
#> # A tibble: 12 x 4
#>       id data_inicio data_final vetor_de_datas
#>    <int> <date>      <date>     <list>        
#>  1     1 2020-06-17  2020-06-28 <date [12]>   
#>  2     1 2020-07-02  2020-07-24 <date [23]>   
#>  3     2 2020-08-14  2020-09-01 <date [19]>   
#>  4     2 2020-08-05  2020-08-14 <date [10]>   
#>  5     3 2020-05-24  2020-05-28 <date [5]>    
#>  6     3 2020-05-17  2020-05-24 <date [8]>    
#>  7     3 2020-05-08  2020-05-17 <date [10]>   
#>  8     3 2020-05-08  2020-05-17 <date [10]>   
#>  9     4 2020-08-30  2020-09-09 <date [11]>   
#> 10     4 2020-08-24  2020-09-13 <date [21]>   
#> 11     5 2020-12-04  2020-12-18 <date [15]>   
#> 12     5 2020-12-04  2020-12-18 <date [15]>

# finalmente, pra cada ID, juntam-se todas as datas num vetorzão só e 
# conta os n_distincts(): número de dias únicos que aparecem no vetor 
# de todos os intervalos juntos.
df %>%
    group_by(id) %>%
    summarise(
        dias = n_distinct(unlist(vetor_de_datas))
    )
#> # A tibble: 5 x 2
#>      id  dias
#>   <int> <int>
#> 1     1    35
#> 2     2    28
#> 3     3    21
#> 4     4    21
#> 5     5    15

Vou ver se tem alguma função já pronta pra medir união de intervalos (no R sempre tem kkk).

2 Curtidas

Só sei lhe agradecer IMENSAMENTE :purple_heart:

Compilei na minha base e funfou. Muito obrigada @Athos e @beatrizmilz pelo help. Vocês são feras!

1 Curtida