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")