Análise descritiva nos dados do transporte público de Curitiba-PR - dados agrupados: segunda-feira e sexta-feira
José Ivan Silva da Cruz Júnior
library(tidyverse)## ── Attaching packages ──────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──## ✔ ggplot2 3.2.1 ✔ purrr 0.3.3
## ✔ tibble 2.1.3 ✔ dplyr 0.8.3
## ✔ tidyr 1.0.0 ✔ stringr 1.4.0
## ✔ readr 1.3.1 ✔ forcats 0.4.0## ── Conflicts ─────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()library(geosphere)
library(dplyr)
options(scipen = 999)grouped_result <- read_csv("/local/juninho/aggregate_output/output/result.csv", col_types = list(
date = col_date(format = ""),
week_day = col_double(),
route = col_character(),
start_hour = col_double(),
end_hour = col_double(),
quantity_trips = col_double(),
duration_median = col_double(),
dist_median = col_double()
)
)
grouped_result <- grouped_result %>% filter(week_day == 2 | week_day == 6)Análise para os dias de segunda-feira e sexta-feira.
- Há uma relação entre a distância das viagens e a tempo delas?
grouped_result %>%
ggplot(aes(x = dist_median, y = duration_median, alpha = .001)) %>%
+ geom_point() + theme_classic() 
Como podemos ver, assim como nas outras análises, quanto maior a distância percorrida por uma rota maior o tempo gasto na viagem.
- Quais as rotas que, na mediana, percorrem uma maior distância?
grouped_result %>%
group_by(route) %>%
summarise(median_dist = median(dist_median)) %>%
top_n(20) %>%
ggplot(aes(x = reorder(route, -median_dist), y = median_dist)) + labs(x = "route") + geom_col() + theme_classic()## Selecting by median_dist
As rotas 659, 506 e 646 se destacam como aquelas que percorrem uma maior distância por viagem. Percorrem 8.9km, 8.8km e 8.6km, respectivamente.
- Quais as rotas que, na mediana, percorrem uma menor distância?
grouped_result %>%
group_by(route) %>%
summarise(median_dist = median(dist_median)) %>%
top_n(-20) %>%
ggplot(aes(x = reorder(route, median_dist), y = median_dist)) + labs(x = "route") + geom_col() + theme_classic()## Selecting by median_dist
As rotas 713, 829 e 331 se destacam como aquelas que percorrem uma menor distância por viagem. Percorrem 449m, 807m e 866m, respectivamente.
- Quais as rotas mais populares, ou seja, aquelas com mais viagens (levando em consideração o passageiro) durante todo o período?
grouped_result %>%
group_by(route) %>%
summarise(quantity = sum(quantity_trips)) %>%
top_n(20) %>%
ggplot(aes(x = reorder(route, -quantity), y = quantity)) + labs(x = "route", y = "trip quantity") + geom_bar(stat = "identity") + theme_classic()## Selecting by quantity
As rotas 203, 303 e 503 aparecem como as mais populares com 120mil, 93mil e 72mil, respectivamente.
4.1) Verificando a popularidade mês a mês, temos:
maio:
grouped_result %>%
filter(lubridate::month(lubridate::date(lubridate::ymd(date))) == 5) %>%
group_by(route) %>%
summarise(quantity = sum(quantity_trips)) %>%
top_n(20) %>%
ggplot(aes(x = reorder(route, -quantity), y = quantity)) + labs(x = "route", y = "trip quantity") + geom_bar(stat = "identity") + theme_classic()## Selecting by quantity
Analisando para o mês de maio, a mesma configuração de posições anterior se mantém, com a rota 203, 303 e 503 na liderança.
junho:
grouped_result %>%
filter(lubridate::month(lubridate::date(lubridate::ymd(date))) == 6) %>%
group_by(route) %>%
summarise(quantity = sum(quantity_trips)) %>%
top_n(20) %>%
ggplot(aes(x = reorder(route, -quantity), y = quantity)) + labs(x = "route", y = "trip quantity") + geom_bar(stat = "identity") + theme_classic()## Selecting by quantity
A popularidade das rotas, para as 3 primeiras posições se mantém, porém destaca-se as rotas 502 e 307, que no mês de junho apresentaram 10573 e 5674, respectivamente, enquanto que no mês de maio apresentaram 16378 e 13478, ou seja, comparando maio e junho, para a rota 502, tivemos uma queda no número de viagens de 36%, enquanto que para a rota 307 também tivemos queda no número de viagens, em cerca de 58%.
Destaque: 502, 307.
julho
grouped_result %>%
filter(lubridate::month(lubridate::date(lubridate::ymd(date))) == 7) %>%
group_by(route) %>%
summarise(quantity = sum(quantity_trips)) %>%
top_n(20) %>%
ggplot(aes(x = reorder(route, -quantity), y = quantity)) + labs(x = "route", y = "trip quantity") + geom_bar(stat = "identity") + theme_classic()## Selecting by quantity
Para o mês de julho, tivemos um destaque para a rota 603. No mês de maio tivemos um número de viagens para a rota de 17039, em junho 8152 e em julho 4998. Tivemos quedas sucessivas no número de viagens de 52%, de maio para junho, e 39% de junho para julho. De maio para julho a queda foi de 71%.
Destaque: rota 603
- Quais as rotas menos populares, ou seja, aquelas com menos viagens (levando em consideração o passageiro) durante todo o dia?
grouped_result %>%
group_by(route) %>%
summarise(quantity = sum(quantity_trips)) %>%
top_n(-20) %>%
ggplot(aes(x = reorder(route, quantity), y = quantity)) +
labs(x = "route", y = "trip quantity") +
geom_bar(stat = "identity") +
theme_classic()## Selecting by quantity
As rotas 331, 343 e 668 se destacam como aquelas que possuem a menor popularidade entre as rotas. A rota 331 registrou apenas 1 viagem, enquanto que a 343 realizou 3.
5.1) Mês a mês temos:
maio
grouped_result %>%
filter(lubridate::month(lubridate::date(lubridate::ymd(date))) == 5) %>%
group_by(route) %>%
summarise(quantity = sum(quantity_trips)) %>%
top_n(-20) %>%
ggplot(aes(x = reorder(route, quantity), y = quantity)) + labs(x = "route", y = "trip quantity") + geom_bar(stat = "identity") + theme_classic()## Selecting by quantity
junho:
grouped_result %>%
filter(lubridate::month(lubridate::date(lubridate::ymd(date))) == 6) %>%
group_by(route) %>%
summarise(quantity = sum(quantity_trips)) %>%
top_n(-20) %>%
ggplot(aes(x = reorder(route, quantity), y = quantity)) + labs(x = "route", y = "trip quantity") + geom_bar(stat = "identity") + theme_classic()## Selecting by quantity
As rotas 343 e 668 não apresentam nenhuma viagem no mês de junho
julho:
grouped_result %>%
filter(lubridate::month(lubridate::date(lubridate::ymd(date))) == 7) %>%
group_by(route) %>%
summarise(quantity = sum(quantity_trips)) %>%
top_n(-20) %>%
ggplot(aes(x = reorder(route, quantity), y = quantity)) + labs(x = "route", y = "trip quantity") + geom_bar(stat = "identity") + theme_classic()## Selecting by quantity
Como destaque, temos as rotas 001 e 732. Essa primeira apresenta uma queda em cerca de 50% no número de viagens, já a rota 732 apresenta uma queda ainda mais acentuada, de cerca de 82%.
Destaque: rota 001, 732.
- Quais as rotas cujas viagens são mais demoradas na mediana?
grouped_result %>%
group_by(route) %>%
summarise(duration = median(duration_median)) %>%
top_n(20) %>%
ggplot(aes(x = reorder(route, -duration), y = duration)) +
labs(x = "route", y = "trip duration (in minutes)") +
geom_bar(stat = "identity") +
theme_classic()## Selecting by duration
- Quais as rotas cujas viagens são mais rápidas na mediana?
grouped_result %>%
group_by(route) %>%
summarise(duration = median(duration_median)) %>%
top_n(-20) %>%
ggplot(aes(x = reorder(route, duration), y = duration)) +
labs(x = "route", y = "trip duration (in minutes)") +
geom_bar(stat = "identity") +
theme_classic()## Selecting by duration
- Quais as rotas mais populares (lotadas) das 6h as 8h?
grouped_result %>%
group_by(route) %>%
filter(start_hour >= 6 & start_hour <= 8) %>%
summarise(quantity = sum(quantity_trips)) %>%
top_n(20) %>%
ggplot(aes(x = reorder(route, -quantity), y = quantity)) +
labs(x = "route", y = "trips quantity") +
geom_col() +
theme_classic()## Selecting by quantity
- Quais as rotas mais populares (lotadas) das 11h as 13h?
grouped_result %>%
group_by(route) %>%
filter(start_hour >= 11 & start_hour <= 13) %>%
summarise(quantity = sum(quantity_trips)) %>%
top_n(20) %>%
ggplot(aes(x = reorder(route, -quantity), y = quantity)) +
labs(x = "route", y = "trips quantity") +
geom_col() +
theme_classic()## Selecting by quantity
- Quais as rotas mais populares (lotadas) das 17h as 19h?
grouped_result %>%
group_by(route) %>%
filter(start_hour >= 17 & start_hour <= 19) %>%
summarise(quantity = sum(quantity_trips)) %>%
top_n(20) %>%
ggplot(aes(x = reorder(route, -quantity), y = quantity)) +
labs(x = "route", y = "trips quantity") +
geom_col() +
theme_classic()## Selecting by quantity
grouped_result %>%
filter(route == "307") %>%
group_by(start_hour) %>%
summarise(quantity = sum(quantity_trips)) %>%
ggplot(aes(x = start_hour, y = quantity)) + geom_col() + theme_bw()
- A rota 204 apresenta comportamento interessante. Na faixa de horário das 17h as 18h a mesma apresenta uma quantidade de viagens 57% menor do que na faixa de horário das 6h as 8h. Vamos ver a distribuição da quantidade de viagens da rota ao longo de todo o dia.
grouped_result %>%
filter(route == "204") %>%
group_by(start_hour) %>%
summarise(quantity = sum(quantity_trips)) %>%
ggplot(aes(x = start_hour, y = quantity)) + geom_col() + theme_bw()
- Iremos analisar agora a rota 506, outra rota que mostra variação na quantidade de viagens nos horários de pico. Fez 4517 das 17h às 19h e 9661 das 6h às 8h, 53% a mais do que no outro horário.
grouped_result %>%
filter(route == "506") %>%
group_by(start_hour) %>%
summarise(quantity = sum(quantity_trips)) %>%
ggplot(aes(x = start_hour, y = quantity)) + geom_col() + theme_classic() 
- Iremos analisar agora a rota 550, pois a mesma apresenta uma forte queda na quantidade de viagens no horário de 11h as 13h. Nesse horário ela fez apenas 2191 viagens, enquanto que nos horários de 6h as 8h e de 17h as 19h fez 12322 e 5778, respectivamente.
grouped_result %>%
filter(route == "550") %>%
group_by(start_hour) %>%
summarise(quantity = sum(quantity_trips)) %>%
ggplot(aes(x = start_hour, y = quantity)) + geom_col() + theme_classic()