library(tidyverse)
library(scales)
theme_set(theme_light())
dftotal <- readr::read_csv("full_trains.csv") %>%
mutate(pct_atraso_partida = num_late_at_departure / total_num_trips,
estacao_chegada = str_to_title(arrival_station),
estacao_partida = str_to_title(departure_station),
data = as.Date(sprintf("%d-%02d-01", year, month))) %>%
arrange(estacao_partida, estacao_chegada, month) %>%
fill(service)
novembro_2018 <- dftotal %>%
filter(year == 2018, month == 11)
novembro_2018
## # A tibble: 130 × 31
## year month service depart…¹ arriv…² journ…³ total…⁴ num_o…⁵ comme…⁶ num_l…⁷
## <dbl> <dbl> <chr> <chr> <chr> <dbl> <dbl> <dbl> <lgl> <dbl>
## 1 2018 11 National AIX EN … PARIS … 183. 391 0 NA 164
## 2 2018 11 National ANGERS … PARIS … 96.7 371 8 NA 184
## 3 2018 11 National ANGOULE… PARIS … 128. 266 9 NA 155
## 4 2018 11 National ANNECY PARIS … 225. 188 1 NA 8
## 5 2018 11 National ARRAS PARIS … 51.0 325 3 NA 141
## 6 2018 11 National AVIGNON… PARIS … 160. 522 2 NA 267
## 7 2018 11 National BARCELO… PARIS … 390. 60 0 NA 34
## 8 2018 11 National BELLEGA… PARIS … 163. 219 3 NA 119
## 9 2018 11 National BESANCO… PARIS … 131. 197 2 NA 32
## 10 2018 11 National BORDEAU… PARIS … 144. 808 20 NA 232
## # … with 120 more rows, 21 more variables: avg_delay_late_at_departure <dbl>,
## # avg_delay_all_departing <dbl>, comment_delays_at_departure <lgl>,
## # num_arriving_late <dbl>, avg_delay_late_on_arrival <dbl>,
## # avg_delay_all_arriving <dbl>, comment_delays_on_arrival <chr>,
## # delay_cause_external_cause <dbl>, delay_cause_rail_infrastructure <dbl>,
## # delay_cause_traffic_management <dbl>, delay_cause_rolling_stock <dbl>,
## # delay_cause_station_management <dbl>, delay_cause_travelers <dbl>, …
## # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names
novembro_2018 %>%
ggplot(aes(pct_atraso_partida)) +
geom_histogram(binwidth = .05) +
scale_x_continuous(labels = percent_format()) +
labs(x = "Percentual de atrasos",
y = "Frequencia",
title = "Histograma")

novembro_2018 %>%
mutate(estacao_partida = fct_lump(estacao_partida, 3)) %>%
ggplot(aes(estacao_partida, pct_atraso_partida)) +
geom_boxplot() +
scale_y_continuous(labels = percent_format())+
labs(x = "Estações",
y = "Percentual de atrassos na partida",
title = "Variação nos Atrasos")

novembro_2018 %>%
# mutate(estacao_chegada = fct_infreq(fct_lump(estacao_chegada, prop = .01))) %>%
# mutate(estacao_partida = fct_infreq(fct_lump(estacao_partida, prop = .01))) %>%
mutate(estacao_chegada = fct_reorder(fct_lump(estacao_chegada, prop = .01), pct_atraso_partida)) %>%
mutate(estacao_partida = fct_reorder(fct_lump(estacao_partida, prop = .01), pct_atraso_partida)) %>%
group_by(estacao_chegada, estacao_partida) %>%
summarize(pct_atraso_partida = sum(num_late_at_departure) / sum(total_num_trips)) %>%
ggplot(aes(estacao_chegada, estacao_partida, fill = pct_atraso_partida)) +
geom_tile() +
scale_fill_gradient2(low = "blue", high = "red", midpoint = .25, labels = percent_format()) +
theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
labs(x = "Estação de Chegada",
y = "Estação de Partida",
fill = "% de Atraso de partida",
title = "Quais rotas têm os trens mais atrasados em novembro de 2018?",
subtitle = "As estações com apenas uma rota de chegada/partida foram agrupadas em 'Outras'")

Histórico
dftotal %>%
filter(estacao_partida == "Lyon Part Dieu") %>%
ggplot(aes(data, pct_atraso_partida, color = estacao_chegada)) +
geom_line() +
scale_y_continuous(labels = percent_format()) +
expand_limits(y = 0)+
labs(x = "Mês",
y = "Percentual de Atraso de partida",
color = "Estação de chegada")

PartidasPorMesEstacao <- dftotal %>%
group_by(estacao_partida = fct_lump(estacao_partida, prop = .01),
data) %>%
summarize_at(vars(contains("num")), sum) %>%
ungroup() %>%
mutate(pct_atraso_partida = num_late_at_departure / total_num_trips)
PartidasPorMesEstacao %>%
mutate(estacao_partida = fct_reorder(estacao_partida, -pct_atraso_partida, last)) %>%
ggplot(aes(data, pct_atraso_partida, color = estacao_partida)) +
geom_line() +
scale_y_continuous(labels = percent_format()) +
labs(x = "Mês",
y = "Percentual de Atraso de partida",
color = "Estação de partida")

PartidasPorMesEstacao <- dftotal %>%
group_by(estacao_partida = ifelse(service == "International",
paste0(estacao_partida, " (International)"),
estacao_partida),
service,
year,
month = fct_reorder(month.name[month], month)) %>%
summarize_at(vars(contains("num")), sum) %>%
ungroup() %>%
mutate(pct_atraso_partida = num_late_at_departure / total_num_trips)
PartidasPorMesEstacao %>%
mutate(estacao_partida = fct_reorder(estacao_partida, (service != "International") + pct_atraso_partida, mean)) %>%
ggplot(aes(month, estacao_partida, fill = pct_atraso_partida)) +
geom_tile() +
scale_fill_gradient2(low = "blue", high = "red", midpoint = .25, labels = percent_format()) +
facet_wrap(~ year, nrow = 1, scales = "free_x") +
theme(axis.text.x = element_text(angle = 90, hjust = 1),
axis.ticks = element_blank(),
panel.grid = element_blank()) +
labs(fill = "% de Atraso de partida") +
labs(x = "Mês",
y = "Estação de partida",
title = "Quais estações tiveram atrasos em quais meses?",
subtitle = "Ordenado pelo atraso médio, com rotas internacionais na parte inferior")
