5.5 Calculando tempos e intervalos de tempo

Um de nossos objetivos no projeto das especializações é estimar o tempo dos processos por fase. Para isso, precisamos filtrar as movimentações e obter intervalos de tempo que façam sentido.

Nesse contexto, uma função de interesse poderia ter o código abaixo.

summarise_dt <- function(dt, txt, re, .fun, ignore_case = TRUE) {
  .fun(dt[str_detect(txt, regex(re, ignore_case = ignore_case))])
}

A função summarise_dt() faz o seguinte:

  • Recebe um vetor de datas dt e um vetor de movimentações txt de entrada,
  • Filtra as datas cujos textos são compatíveis com uma regex,
  • aplica uma função .fun para sumarizar essas datas.

5.5.1 estatísticas de movimentações

Queremos aplicar summarise_dt() com diversos parâmetros diferentes, para a tabela de movimentações de cada processo. Vamos analisar a função abaixo.

summarise_movs <- function(m) {
  
  # partial assignment de summarise_dt
  partial_summarise_mov <- partial(summarise_dt, dt = m$data_mov, txt = m$mov)
  
  # calcula várias estatísticas das movimentações
  summary_movs <- tribble(
    ~tipo, ~name, ~re, ~.fun,
    # contagens
    "n", "julg", "Trânsito|Julgado", length,
    "n", "baix", "Baixa", length,
    "n", "recu", "Recurso", length,
    "n", "sent", "- Sentença", length,
    "n", "tudo", ".*", length,
    # datas
    "dt", "julg", "Trânsito|Julgado", min,
    "dt", "baix", "Baixa", min,
    "dt", "recu", "Recurso", min,
    "dt", "sent", "- Sentença", min,
    "dt", "min", ".*", min,
    "dt", "max", ".*", max) %>%
    mutate(val = map2(re, .fun, quietly(partial_summarise_mov)),
           val = map_dbl(val, "result")) %>%
    unite(variavel, tipo, name) %>%
    select(variavel, val) %>%
    # joga tudo para as colunas
    spread(variavel, val) %>%
    # refaz colunas de datas
    mutate(tempo_total = dt_max - dt_min) %>%
    mutate_at(vars(starts_with("dt_")),
              funs(as.Date(., origin = "1970-01-01")))
}

Exercícios:

  1. O que faz a função tribble()?
  2. No código abaixo, quais funções são do dplyr, quais são do tidyr e quais são do purrr?
  3. O que faz mutate_at()?

5.5.2 Calculando intervalos de tempo

O segredo para calcular intervalos de tempo é utilizar a função lag(). Esta é uma das funções do tipo janela, que são muito úteis para séries temporais e outras aplicações.

summarise_decisions <- function(d_movs) {
  # algumas regex
  re_decisao <- regex("- Decisão| - Despacho", ignore_case = TRUE)
  re_concluso <- regex("Concluso", ignore_case = TRUE)
  
  d_movs %>%
    arrange(data_mov) %>%
    # dados com lag
    mutate(last_mov = lag(mov), 
           last_data_mov = lag(data_mov)) %>%
    # somente movimentações em que há decisão
    filter(str_detect(mov, re_decisao)) %>%
    # tempo entre movimentação atual e movimentação anterior
    mutate(tempo = data_mov - last_data_mov,
           tem_concluso = str_detect(mov, re_concluso)) %>%
    # restrição: somamos apenas os casos em que não há concluso na mov
    # (pode ser que existam conclusos na movimentação com lag)
    summarise(n_deci_e_desp = length(mov),
              n_deci_n_nula = sum(!tem_concluso),
              t_deci = sum((!tem_concluso) * tempo, na.rm = TRUE))
}

Finalmente, juntamos essas funções numa função que recebe uma tibble de movimentações e retorna uma tibble sumarizada.

calcular_resumos <- function(d_movs) {
  # limpeza das movimentações
  clean_movs <- d_movs %>%
    filter(!str_detect("Agravo", mov)) %>%
    mutate(data_mov = dmy(data_mov)) %>%
    group_by(data_mov) %>%
    summarise(mov = str_c(mov, collapse = ", "))

  # funções definidas acima
  summ_movs <- summarise_movs(clean_movs)
  summ_decisions <- summarise_decisions(clean_movs)
  
  # concatena os dois sumários
  bind_cols(summ_movs, summ_decisions)
}

5.5.3 Resultados

Quando a função é muito demorada, pode ser útil utilizar barras de progresso para acompanhar o andamento do download. É possível utilizar barras de progresso com o pacote progress, com uma pequena adaptação da função original. Exemplo:

pb <- progress::progress_bar$new(total = nrow(d_espec))
calcular_resumos_pb <- function(x) {
  pb$tick()
  calcular_resumos(x)
}

Exercício:

  1. quais outras opções interessantes temos para barras de progresso?
  2. nãrd question: qual o tipo de objeto do progress?
## NAO RODE
d_espec_resumida <- d_espec %>% 
  # não vamos usar partes na análise
  select(id_lawsuit, d_infos, d_movs) %>% 
  # vamos abrir d_infos, já que tem só uma linha por processo
  unnest(d_infos) %>% 
  # vamos apenas analisar as varas cíveis do João Mendes
  filter(str_detect(vara, regex("vara cível", ignore_case = TRUE))) %>% 
  # adicionar as contagens!
  mutate(d_contas = map(d_movs, calcular_resumos_pb)) %>% 
  select(-d_movs) %>% 
  # explodir as contas
  unnest(d_contas)
# leia aqui
d_espec_resumida <- read_rds("data-raw/espec/d_espec_resumida.rds")
glimpse(d_espec_resumida)
#> Observations: 27,892
#> Variables: 22
#> $ id_lawsuit    <chr> "0004007-47.2013.8.26.0368", "0001909-75.2013.8....
#> $ comarca       <chr> "Foro Central Cível", "Foro Central Cível", "For...
#> $ foro          <chr> "Foro Central Cível", "Foro Central Cível", "For...
#> $ vara          <chr> "39ª Vara Cível", "34ª Vara Cível", "14ª Vara Cí...
#> $ classe        <chr> "Procedimento Comum", "Exibição", "Procedimento ...
#> $ assunto       <chr> "Obrigação de Fazer / Não Fazer", "Medida Cautel...
#> $ data_dist     <chr> "23/08/2013", "17/01/2013", "10/05/2013", "14/05...
#> $ dt_baix       <date> NA, NA, NA, 2015-01-07, NA, 2014-02-13, 2014-03...
#> $ dt_julg       <date> NA, NA, NA, 2015-01-07, NA, 2013-11-12, 2014-01...
#> $ dt_max        <date> 2015-05-13, 2016-03-18, 2016-06-13, 2015-01-07,...
#> $ dt_min        <date> 2013-08-23, 2013-01-17, 2013-05-10, 2013-05-14,...
#> $ dt_recu       <date> 2014-10-01, NA, NA, NA, NA, NA, NA, NA, NA, NA,...
#> $ dt_sent       <date> 2014-07-14, 2015-05-21, 2014-01-27, 2014-11-19,...
#> $ n_baix        <dbl> 0, 0, 0, 1, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, ...
#> $ n_julg        <dbl> 0, 0, 0, 1, 0, 2, 2, 0, 3, 0, 0, 0, 0, 0, 0, 0, ...
#> $ n_recu        <dbl> 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ...
#> $ n_sent        <dbl> 1, 1, 1, 1, 2, 1, 1, 0, 1, 1, 0, 0, 1, 1, 0, 0, ...
#> $ n_tudo        <dbl> 41, 35, 38, 50, 65, 27, 25, 3, 64, 33, 15, 30, 4...
#> $ tempo_total   <dbl> 628, 1156, 1130, 603, 795, 254, 267, 218, 962, 1...
#> $ n_deci_e_desp <int> 6, 3, 4, 4, 6, 5, 2, 0, 3, 4, 2, 2, 5, 5, 4, 9, ...
#> $ n_deci_n_nula <int> 6, 3, 1, 3, 5, 1, 0, 0, 2, 4, 1, 2, 4, 5, 2, 7, ...
#> $ t_deci        <time> 239 days, 184 days, 8 days, 22 days, 5 days, 13...
library(survival)
d_surv <- d_espec_resumida %>% 
  mutate(t_deci = as.numeric(t_deci)) %>% 
  gather(tipo_tempo, tempo, tempo_total, t_deci) %>% 
  mutate(obs = n_baix > 0 | n_julg > 0 | n_sent > 0) %>% 
  filter(tempo >= 0, tempo < 1400)

fit <- survfit(Surv(tempo, obs) ~ tipo_tempo, data = d_surv)

survminer::ggsurvplot(fit, risk.table = TRUE)

5.5.4 Wrap-up de hoje

  • Terminamos o projeto das câmaras
    • Aprendemos tidyr no meio do caminho
    • revisitamos ggplot2 e brincamos de visualização.
  • Aprendemos as funções do purrr. Principais: map(), map_*().
  • Montamos a base de dados do projeto de especialização.
    • Usando todos os pacotes juntos.

Próxima aula: Modelos! - Sobrevivência - Captcha - Rede bayesiana (se der tempo)