Introdução

O transporte público é essencial para a vida nas cidades, pois sua característica transversal assegura o funcionamento de uma vasta gama de atividades. A pandemia de COVID-19 gerou impactos deletérios sobre a demanda do transporte público urbano; além do aumento dos custos, houve perda significativa de receita tarifária pelas empresas concessionárias, em consequência da redução da demanda, de acordo com análise da FGV.

Objetivo

Com base nos dados disponíveis no Portal da Transparência da Prefeitura Municipal de Juiz de Fora, analisamos os efeitos da pandemia em âmbito local.

Recursos

Os dados podem ser obtidos em:
https://www.pjf.mg.gov.br/transparencia/transporte_publico/onibus/demanda/2013.php.
Último acesso em: 19/07/2023.

Bibliotecas

Carregamos as seguintes bibilotecas do R:

  • rvest - biblioteca para extração de dados web;
  • dplyr - pacote para manipulação de banco de dados;
  • stringr - ferramenta para manipulação de textos;
  • tidyverse - pacote para manipulação de dados;
  • lubridate - biblioteca para manipular dados no formato data/hora;
  • ggplot2 - ferramenta para visualização de dados;
  • ggthemes - adiciona funcionalidades extras ao ggplot;
  • prettydoc - temas adicionais para documentos Rmarkdown;
  • reshape2 - ferramenta para transformação de dados;
  • scales - utilizada para personalizar legendas;
  • DT - para incluir tabelas em relatórios Rmarkdown;
  • gridExtra - facilita a disposição dos gráficos na página.

Diretório de trabalho

Definimos o diretório de trabalho:

setwd("/home/gf/Scripts/Tujf")

Coleta de dados

Criamos uma função para baixar e extrair as tabelas

baixar_tabela <- function(ano) {
  url <- paste0(
    "https://www.pjf.mg.gov.br/transparencia/transporte_publico/onibus/demanda/", 
            ano, ".php")
  
  # Fazemos o download da página
  pagina <- read_html(url)
  
  # Extraímos a tabela
  tabela <- pagina %>%
    html_table(header = FALSE, fill = TRUE) %>%
    .[[3]]
  
  tabela <- tabela[-c(1, 2), ]
  
  # Adicionamos uma coluna com o ano
  tabela$Ano <- ano
  
  return(tabela)
}
tabelas <- list()

Iteramos para baixar as tabelas de 2013 a 2023

for (ano in 2013:2023) {
  tabela <- baixar_tabela(ano)
  tabelas[[as.character(ano)]] <- tabela
}

Combinamos todas as tabelas em um único data frame

tbl <- bind_rows(tabelas)

Pré-processamento dos dados

Criamos a coluna de data

rdo <- tbl %>% mutate(Referencia = paste0(Ano, "-", X1, "-01"))

Formatamos a coluna data

rdo$Referencia <- as.Date(lubridate::ymd(rdo$Referencia) |> format("%Y-%m-%d"))

Excluímos a primeira coluna

rdo <- rdo %>% select(-c(X1))

Renomeamos as demais colunas

rdo <- rdo %>% 
  rename(Tarifa = X2, Total = X3, Pagantes = X4, Grat_total = X5, Grat_perc = X6)

Visualizamos os dados

datatable(rdo, list(iDisplayLength = 5))

Verificamos a existência de valores nulos, em branco ou zerados

sum(is.na(list(df)))
## [1] 0

Atribuímos o valor da tarifa para o ano de 2013

rdo$Tarifa[rdo$Tarifa=="-"] <- 2.05

Removemos o símbolo da moeda

rdo <- rdo %>%
  mutate_if(~ any(str_detect(., '^R\\$'), na.rm = TRUE),
            ~ as.character(str_replace_all(., '[R\\$]', '')))

Removemos o símbolo de percentual existentes em algumas linhas da última coluna

rdo <- rdo %>%
  mutate_if(~ any(str_detect(., '%'), na.rm = TRUE),
            ~ as.character(str_replace_all(., '%(.*)', '')))

Alteramos o separador de milhar e decimal

rdo$Tarifa <- as.numeric(gsub("\\,", ".", rdo$Tarifa))
rdo$Grat_perc <- as.numeric(gsub("\\,", ".", rdo$Grat_perc))

Removemos sinais gráficos de pontuação

cols <- c("Total", "Pagantes", "Grat_total")
rdo[ , cols] <- lapply(rdo[ , cols], 
                       function(x){ as.numeric(gsub("\\.|-|,", "", x)) })

Verificamos se há valores repetidos na primeira coluna

if (any(duplicated(rdo$Referencia))) {
  # Calculamos a soma das colunas X3 e X4 
  # quando houver valores repetidos na coluna X1
  rdo <- rdo %>%
    group_by(Referencia) %>%
    summarise(Tarifa = weighted.mean(Tarifa, Total, na.rm = TRUE), 
              Total = sum(Total, na.rm = TRUE), 
              Pagantes = sum(Pagantes, na.rm = TRUE), 
              Grat_total = sum(Grat_total, na.rm = TRUE), 
              Grat_perc = mean(Grat_perc, na.rm = TRUE), 
              .groups = "drop")
}

Fazemos uma cópia do data frame

df <- rdo

Exibimos o resultado

datatable(df, list(iDisplayLength = 5))

Análise exploratória

Outliers

Valores extremos ou atípicos podem ser visualizados através do diagrama de caixa.

boxplot(df[,c('Total','Pagantes')])

Constatamos a existência de um valor destacadado, abaixo do limite inferior, no diagrama de caixa ou boxplot da coluna “Pagantes”. Precisamos investigar o motivo da discrepância, para descobrir se está relacionado a erro de registro. Apesar de os valores de todas as colunas terem sido obtidos diretamente do portal da transparência, optamos por avaliar somente as colunas “Total” e “Pagantes”, pois as demais subsequentes podem ser derivadas por operação aritmética.

Identificamos o valor atípico

head(sort(df$Pagantes),1)
## [1] 226316

Listamos o registro completo do valor atípico

outliner <- df[df$Pagantes == 226316, ] 
outliner
## # A tibble: 1 × 6
##   Referencia Tarifa   Total Pagantes Grat_total Grat_perc
##   <date>      <dbl>   <dbl>    <dbl>      <dbl>     <dbl>
## 1 2020-04-01   3.75 2651157   226316     387241      14.6

Corrigimos o valor atípico

Corrigimos o provável erro de inserção de dados, após calcularmos manualmente o valor de Pagantes, para a data de referência, através da fórmula [Pagantes = Total - Grat_total].

df$Pagantes[df$Referencia == '2020-04-01'] <- 2277916

Estatística descritiva

summary(df)
##    Referencia             Tarifa          Total             Pagantes      
##  Min.   :2013-01-01   Min.   :2.050   Min.   : 2651157   Min.   :2277916  
##  1st Qu.:2015-07-16   1st Qu.:2.250   1st Qu.: 6139794   1st Qu.:5188158  
##  Median :2018-02-01   Median :3.100   Median : 8513631   Median :7418298  
##  Mean   :2018-01-30   Mean   :2.995   Mean   : 7795440   Mean   :6798221  
##  3rd Qu.:2020-08-16   3rd Qu.:3.750   3rd Qu.: 9354978   3rd Qu.:8296101  
##  Max.   :2023-03-01   Max.   :3.750   Max.   :10327809   Max.   :9246669  
##    Grat_total        Grat_perc    
##  Min.   : 387241   Min.   : 9.10  
##  1st Qu.: 885037   1st Qu.:11.45  
##  Median :1045863   Median :13.50  
##  Mean   : 996652   Mean   :13.01  
##  3rd Qu.:1180802   3rd Qu.:14.20  
##  Max.   :1372989   Max.   :16.80

Quando correlacionamos o registro onde consta o valor atípico mencionado acima com o resumo estatístico fornecido pela função summary(), constatamos que a mínima corresponde ao movimento registrado no fatídico dia 01/04/2020, exceto quanto ao percentual mínimo de gratuidade, que não ocorreu na mesma data.

Qual foi o percentual mínimo de gratuidade?

head(sort(df$Grat_perc),1)
## [1] 9.1

Quando ocorreu o percentual mínimo de gratuidade?

permin <- df[df$Grat_perc == 9.10, ] 
permin
## # A tibble: 1 × 6
##   Referencia Tarifa   Total Pagantes Grat_total Grat_perc
##   <date>      <dbl>   <dbl>    <dbl>      <dbl>     <dbl>
## 1 2013-01-01   2.05 8995963  8181125     814838       9.1

Representação gráfica da demanda do transporte público em JF

Primeiro, ilustramos graficamente a evolução do preço da tarifa de ônibus.

g1 <- ggplot(df, aes(Referencia, Tarifa, group=1), fill = "white") +
  geom_line() +
  labs(title = "Evolução do preço da passagem de ônibus urbano em JF",
          subtitle = "Período: 01/2013 a 03/2023",
          caption = "Fonte: https://www.pjf.mg.gov.br/transparencia/transporte_publico/onibus/demanda/index.php") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) +
  theme(plot.title = element_text(lineheight=.8, face="bold", size = 12)) +
  theme(text = element_text(size=10)) +
  scale_x_date(limits = as.Date(c("2013-01-01","2023-03-01")), breaks = "6 month", labels=date_format("%Y-%m")) +
  xlab("Data")
g1

Ops! Ninguém cai em um fosso quando sobe a escada.
Vamos verificar o que aconteceu com o preço das passagens entre 2015 e 2016.
De qualquer forma, observem que desde 12/2019 a passagem não sofre aumento.

df %>%
  filter(Referencia >= '2016-01-01' & Referencia <= '2016-03-01') %>%
  select(Referencia, Tarifa)
## # A tibble: 3 × 2
##   Referencia Tarifa
##   <date>      <dbl>
## 1 2016-01-01   2.25
## 2 2016-02-01   2.25
## 3 2016-03-01   2.25

Mais uma vez, olha aí, a responsabilidade recai sobre o digitador(o problema da falibilidade humana na inserção de dados é resolvido com a captura diretamente da fonte).

Matéria do G1 dá conta de que a passagem aumentou de R$ 2,50 para R$ 2,75, em abril de 2016. O valor com a casa decimal estendida, que representa a média ponderada, denota que no mesmo mês foram praticadas as duas tarifas, ainda que a defasada responda por menos de 10% do volume mensal.

Correção do valor inserido incorretamente

df$Tarifa[df$Referencia >= '2016-01-01' & df$Referencia <= '2016-03-01'] <- 2.50

Reelaboramos o gráfico com base nos valores corrigidos

g1 <- ggplot(df, aes(Referencia, Tarifa, group=1), fill = "white") +
  geom_line() +
  labs(title = "Evolução do preço da passagem de ônibus urbano em JF",
          subtitle = "Período: 01/2013 a 03/2023",
          caption = "Fonte: https://www.pjf.mg.gov.br/transparencia/transporte_publico/onibus/demanda/index.php") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) +
  theme(plot.title = element_text(lineheight=.8, face="bold", size = 12)) +
  theme(text = element_text(size=10)) +
  scale_x_date(limits = as.Date(c("2013-01-01","2023-03-01")), breaks = "6 month", labels=date_format("%Y-%m")) +
  xlab("Data")
g1

Finalmente, temos uma escada difícil de subir a passos largos: a linha horizontal expressa a duração do preço da passagem e a vertical, a magnitude do aumento.

Remodelagem do conjunto de dados

Vamos remodelar o dataset para reproduzir em um gráfico de linha a série temporal da demanda do transporte público urbano de Juiz de Fora, e comparar a quantidade total de passageiros transportados com a quantidade de usuários pagantes.

new=melt(df,id.vars=c("Referencia"), variable.name = "quantidade")
new <- new %>%
  filter(!quantidade %in% c('Tarifa', 'Grat_total', 'Grat_perc'))

Qual a correlação entre total de passageiros, o número de pagantes e a gratuidade?

g2 <- ggplot(new, aes(Referencia, value/1000000, fill = quantidade, colour=quantidade)) +
  geom_line(linetype="solid", linewidth=1.5) +
  ggtitle("Demanda do transporte público de JF") +
  ylab("Número de passageiros(em milhões)") +
  theme(plot.title = element_text(lineheight=.8, face="bold",
                                  size = 12)) +
  theme(text = element_text(size=10))
g2
g3 <- ggplot(df, aes(Referencia, Grat_total/1000000)) +
  geom_line(col = 'darkblue', linewidth = 1) +
  ggtitle("Gratuidade no transporte público de Juiz de Fora") +
  ylab("Número de passageiros(em milhões)") +
  theme(plot.title = element_text(lineheight=.8, face="bold",
                                  size = 12)) +
  theme(text = element_text(size=10))
g3

Lado a lado, podemos intuir a correlação entre o total de passageiros, pagantes e gratuidade:

g2 = g2 + theme(legend.position = "top")
grid.arrange(g2, g3, ncol = 2)

No período pré-pandemia, há uma correlação negativa entre o número de pagantes e o volume da gratuidade; enquanto o primeiro diminui, o segundo aumenta. No pós-pandemia, há uma correlação positiva: ambos aumentam.

Estimativa da receita bruta mensal

df <- df %>% mutate(Receita_bruta = Pagantes*Tarifa)

g4 <- ggplot(df, aes(Referencia, Receita_bruta/1000000)) +
  geom_line(col = 'darkblue', linewidth = 1) +
  ggtitle("Receita bruta mensal das empresas de ônibus urbano - JF") +
  ylab("Receita bruta mensal(em R$ milhões)") +
  theme(plot.title = element_text(lineheight=.8, face="bold",
                                  size = 12)) +
  theme(text = element_text(size=10))
g4

Estimamos a receita bruta mensal mediante a multiplicação do número de passageiros pagantes pelo valor da tarifa. Nos casos em que houve o concurso de dois valores de tarifa em um mesmo mês, foi calculada a tarifa média ponderada. Não estão incluídos subsídios instituídos para custeio da operação do transporte público coletivo, tais como repasses de recursos do tesouro municipal e estímulos fiscais.

Estimativa da receita bruta anual

df$ano <- year(ymd(df$Referencia))

df <- df %>%
      group_by(ano) %>%
      summarise(Faturamento_anual = sum(Receita_bruta))


g7 <- ggplot(df, aes(x = ano, y = Faturamento_anual/1000000)) +
  geom_bar(position="dodge", stat="identity", aes(fill = ano > 2019)) +
  labs(title = "Impacto financeiro da Pandemia no sistema de transporte público de JF",
       subtitle = "Período: 01/2013 a 03/2023",
       caption = "Fonte: https://www.pjf.mg.gov.br/transparencia/transporte_publico/onibus/demanda/index.php") +
  theme(plot.title = element_text(lineheight=.8, face="bold", size = 12)) +
  theme(text = element_text(size=10)) +
  scale_fill_manual(guide = "none", breaks = c(FALSE, TRUE), values=c("dodgerblue", "firebrick1")) +  
  ylab("Faturamento anual(em milhões de reais)")
g7

O faturamento do setor em 2022 ficou abaixo do registrado em 2015. A estimativa de recuperação indica que, para atingir patamar pré-pandemia, o tempo esperado pode demorar de quatro a cinco anos, após o fim das medidas de distanciamento social.

Referências

Bradley Boehmke, Bradley (2018). “Scraping Data: UC Business Analytics R Programming Guide”. https://uc-r.github.io/scraping#scraping_HTML_tables.
Kabacoff, Robert I. (2011). R in Action - Data analysis and graphics with R. Maning Publications Co.