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)
library(magrittr)
## 
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
## 
##     set_names
## The following object is masked from 'package:tidyr':
## 
##     extract
library(hrbrthemes)
## NOTE: Either Arial Narrow or Roboto Condensed fonts are required to use these themes.
##       Please use hrbrthemes::import_roboto_condensed() to install Roboto Condensed and
##       if Arial Narrow is not on your system, please see http://bit.ly/arialnarrow
library(ggplot2)

library(rgeos)
## Loading required package: sp
## Warning in fun(libname, pkgname): rgeos: versions of GEOS runtime 3.7.1-CAPI-1.11.1
## and GEOS at installation 3.5.0-CAPI-1.9.0differ
## rgeos version: 0.5-2, (SVN revision 621)
##  GEOS runtime version: 3.7.1-CAPI-1.11.1 
##  Linking to sp version: 1.3-1 
##  Polygon checking: TRUE
library(sp)
library(rgdal)
## rgdal: version: 1.4-8, (SVN revision 845)
##  Geospatial Data Abstraction Library extensions to R successfully loaded
##  Loaded GDAL runtime: GDAL 2.2.2, released 2017/09/15
##  Path to GDAL shared files: /usr/share/gdal/2.2
##  GDAL binary built with GEOS: TRUE 
##  Loaded PROJ.4 runtime: Rel. 4.9.2, 08 September 2015, [PJ_VERSION: 492]
##  Path to PROJ.4 shared files: (autodetected)
##  Linking to sp version: 1.3-1
options(scipen = 999)
options(warn=-1)
estimated_trips_result <- read_csv("/local/juninho/estimated-trips_analysis/data/od-matrix/full/output_sd/result.csv", col_types = list(
    date = col_date(format = ""),
    week_day = col_double(),
    route = col_character(),
    start_hour = col_double(),
    quantity_trips = col_double(),
    duration_median = col_double(),
    dist_median = col_double()
  )
)

irrelevant_routes <- estimated_trips_result %>% 
  group_by(route) %>% 
  summarise(total_trips = sum(quantity_trips)) %>% 
  filter(total_trips < 300)

estimated_trips_relevant_routes <- 
  estimated_trips_result %>% 
  filter(!route %in% irrelevant_routes$route) %>% 
  filter(!is.na(duration_median),duration_median > 0) %>% 
  filter(!is.na(dist_median),dist_median > 0) %>% 
  mutate(speed = ((dist_median/1000) / duration_median *60)) %>% 
  group_by(date, week_day, route, start_hour, quantity_trips, speed, duration_median, duration_sd, dist_median) %>% 
  expand(trips = seq(1:quantity_trips))

expanded <- estimated_trips_relevant_routes %>% group_by(date, week_day, route, start_hour, quantity_trips, duration_median, duration_sd, dist_median, speed) %>% expand(trips = seq(1:quantity_trips))
  1. Análise de segunda-sexta e terça-quarta-quinta.

1.1) Quantidade de viagens (na mediana)

day_group <- data.frame(week_day = c(2:6),
                        day_group = c("SS", "TQ", "TQ", "TQ", "SS"))

days <- estimated_trips_result %>%
  group_by(route, week_day) %>% 
  summarise(qntt = sum(quantity_trips)) %>% 
  merge(day_group) %>% 
  group_by(day_group, route) %>% 
  summarise(qntt = median(qntt))

segunda_sexta <- days %>% 
  filter(day_group == "SS") %>% 
  top_n(10)
## Selecting by qntt
terça_quinta <- days %>% 
  filter(day_group == "TQ") %>% 
  top_n(10)
## Selecting by qntt
data_comparation <- segunda_sexta %>% 
  mutate(Segunda_Sexta = segunda_sexta$qntt, Terca_Quarta_Quinta = terça_quinta$qntt)

comp_long <- gather(data_comparation, key="measure", value="value", c("Segunda_Sexta", "Terca_Quarta_Quinta"))
comp_long <- comp_long %>% mutate(value_adjusted = value)

ggplot(comp_long, aes(fill = measure, x = reorder(route, -value_adjusted), y = value_adjusted)) + geom_col(position="dodge", stat='identity') + labs(x = "rota", y = "quantidade de viagens")

Como podemos ver, algumas rotas se destacam apresentando um número de viagens maior na mediana nos dias da semana de segunda e sexta em comparação com o período dos dias de terça a quinta, sendo elas a 203, 602 e 040. As duas últimas rotas ligam regiões periféricas da cidade a outras. Por outro lado, rotas como 303, segunda mais popular no geral, 503 e 023 apresentam uma maior quantidade de viagens no período de terça a quinta. Essas três rotas citadas ligam pontos da cidade ao Centro.

1.2) Distância percorrida

day_group <- data.frame(week_day = c(2:6),
                        day_group = c("SS", "TQ", "TQ", "TQ", "SS"))

days <- estimated_trips_result %>%
  group_by(route, week_day) %>% 
  summarise(dist = median(dist_median)) %>% 
  merge(day_group) %>% 
  group_by(day_group, route) %>% 
  summarise(dist = median(dist))

segunda_sexta <- days %>% 
  filter(day_group == "SS") %>% 
  top_n(10)
## Selecting by dist
terça_quinta <- days %>% 
  filter(day_group == "TQ") %>% 
  top_n(10)
## Selecting by dist
data_comparation <- segunda_sexta %>% 
  mutate(Segunda_Sexta = segunda_sexta$dist, Terca_Quarta_Quinta = terça_quinta$dist)

comp_long <- gather(data_comparation, key="measure", value="value", c("Segunda_Sexta", "Terca_Quarta_Quinta"))
comp_long <- comp_long %>% mutate(value_adjusted = value)

ggplot(comp_long, aes(fill = measure, x = reorder(route, -value_adjusted), y = value_adjusted)) + geom_col(position="dodge", stat='identity') + labs(x = "rota", y = "distância da viagem")

Observamos agora as rotas que na mediana percorrem uma maior distância. A rota 474 apresenta uma distância consideravalmente maior nas suas viagens no período de terça, quarta e quinta. A mesma liga regiões afastadas, como o bairro Uberaba, ao centro da cidade. Outra rota de comportamento similar é a 617. Essa liga também regiões afastadas, como o bairro Tutuquara, mas a bairros periféricos, como Capão Raso e Pinheirinho. Por outro lado, apresentando um comportamento contrário, ou seja, tendo a distância consideravelmente maior no período de segunda e sexta, a 646 liga uma bairro de características rurais a centros de comércio popular, como o bairro Pinheirinho.

  1. Quantidade de viagens durante as horas do dia
hour_group <- data.frame(start_hour = c(4:23),
                         hour_group = c("I", "I", "M", "M", "M", "I", "I", "T", "T", "T", "I", "I", "I", "N", "N", "N", "I", "I", "I", "I"))

hours <- estimated_trips_result %>% 
  group_by(route, start_hour) %>% 
  summarise(qntt = sum(quantity_trips)) %>% 
  merge(hour_group) %>% 
  group_by(hour_group) %>% 
  summarise(qntt = sum(qntt))

hours <- hours %>% filter(hour_group != "I")

ggplot(hours, aes(x = reorder(hour_group, -qntt), y = qntt)) + geom_col(position="dodge", stat='identity') + labs(x = "route", y = "trips quantity")

Como vemos, o horário da manhã (das 6h as 8h) é o que concentra a maior quantidade de viagens feitas, seguido da noite (das 17h as 19h) e a tarde (das 11h as 13h). Esses são os horários de pico, ou seja, os horários onde a movimentação no transporte público é maior.

  1. Análise pelos horários do dia: manhã, tarde e noite

3.1) Quantidade de viagens

hour_group <- data.frame(start_hour = c(4:23),
                         hour_group = c("I", "I", "M", "M", "M", "I", "I", "T", "T", "T", "I", "I", "I", "N", "N", "N", "I", "I", "I", "I"))

hours <- estimated_trips_result %>% 
  group_by(route, start_hour) %>% 
  summarise(qntt = sum(quantity_trips)) %>% 
  merge(hour_group) %>% 
  group_by(hour_group, route) %>% 
  summarise(qntt = median(qntt))

seis_oito <- hours %>% 
  filter(hour_group == "M") %>% 
  top_n(12)
## Selecting by qntt
onze_uma <- hours %>% 
  filter(hour_group == "T") %>%
  top_n(12) 
## Selecting by qntt
cinco_sete <- hours %>% 
  filter(hour_group == "N") %>% 
  top_n(12)
## Selecting by qntt
data_comparation2 <- merge(x = seis_oito, y = onze_uma, by = "route")

data_comparation3 <- merge(x = data_comparation2, y = cinco_sete, by = "route")

data_comparation3 <- data_comparation3 %>% mutate(Manhã = qntt.x, Tarde = qntt.y, Noite = qntt)

comp_long1 <- gather(data_comparation3, key="measure", value="value", c("Manhã", "Tarde", "Noite"))
comp_long1 <- comp_long1 %>% mutate(value_adjusted = value)

ggplot(comp_long1, aes(fill = measure, x = reorder(route, -value_adjusted), y = value_adjusted)) + geom_col(position="dodge", stat='identity') + labs(x = "rota", y = "quantidade de viagens")

Como podemos observar, pela manhã a rota 303 ultrapassa em quantidade de viagens a rota 203. A noite e a tarde a 203 volta a exercer robusta liderança. Observando também as rotas 203, 503, 602, 023 e 502 vemos que suas viagens são mais populares a noite. Por outro lado, as rotas 303, 022, 040, 030, 603, 507, 204 e as que se seguem são mais populares pela manhã, que é a faixa de horário mais popular durante todo o dia. Não vemos nenhuma rota sendo mais popular no horário da tarde, ou seja, aquela que se encontra entre as 11h e as 13h. Um destaque evidente fica por conta da rota 503, que dispara no horário da noite, ultrapassando a rota 303 e se aproximando da 203. A 503 é uma rota predominantemente noturna.

3.2) Distância percorrida

hours2 <- estimated_trips_result %>% 
  group_by(route, start_hour) %>% 
  summarise(dist = median(dist_median)) %>% 
  merge(hour_group) %>% 
  group_by(hour_group, route) %>% 
  summarise(dist = median(dist))

seis_oito2 <- hours2 %>% 
  filter(hour_group == "M") %>% 
  top_n(20)
## Selecting by dist
onze_uma2 <- hours2 %>% 
  filter(hour_group == "T") %>%
  top_n(20) 
## Selecting by dist
cinco_sete2 <- hours2 %>% 
  filter(hour_group == "N") %>% 
  top_n(20)
## Selecting by dist
data_comparation4 <- merge(x = seis_oito2, y = onze_uma2, by = "route")

data_comparation5 <- merge(x = data_comparation4, y = cinco_sete2, by = "route")

data_comparation5 <- data_comparation5 %>% mutate(distManha = dist.x, distTarde = dist.y, distNoite = dist)

comp_long1 <- gather(data_comparation5, key="measure", value="value", c("distManha", "distTarde", "distNoite"))

ggplot(comp_long1, aes(fill = measure, x = reorder(route, -value), y = value)) + geom_col(position="dodge", stat='identity') + labs(x = "route", y = "distância percorrida")

Apesar das 11h as 13h ser o horário com o menor número de viagens no geral entre os três principais horários, rotas como 506, 646 e 617 apresentam suas viagens como mais longas na mediana nesse horário. A rota 305, curiosamente, apresenta a mesma mediana de distância nos três horários. Para o horário da manhã, aquele que concentra a maior quantidade de viagens, são apenas três as rotas que aprensentam suas viagens mais longas nesse horário, a 659, 508 e 684.

3.3) Velocidade

3.3.1) Mais rápidas

hours3 <- estimated_trips_relevant_routes %>% 
  group_by(route, start_hour) %>% 
  summarise(speed = median(speed)) %>% 
  merge(hour_group) %>% 
  group_by(hour_group, route) %>% 
  summarise(speed = median(speed))

seis_oito3 <- hours3 %>% 
  filter(hour_group == "M") %>% 
  top_n(20)
## Selecting by speed
onze_uma3 <- hours3 %>% 
  filter(hour_group == "T") %>% 
  top_n(20)
## Selecting by speed
cinco_sete3 <- hours3 %>% 
  filter(hour_group == "N") %>% 
  top_n(20)
## Selecting by speed
data_comparation4 <- merge(x = seis_oito3, y = onze_uma3, by = "route")

data_comparation5 <- merge(x = data_comparation4, y = cinco_sete3, by = "route")

data_comparation5 <- data_comparation5 %>% mutate(Manha = speed.x, Tarde = speed.y, Noite = speed)

comp_long1 <- gather(data_comparation5, key="measure", value="value", c("Manha", "Tarde", "Noite"))

ggplot(comp_long1, aes(fill = measure, x = reorder(route, -value), y = value)) + geom_col(position="dodge", stat='identity') + labs(x = "route", y = "velocidade (km/h)")

Podemos observar que a tarde é o horário que, predominantemente, apresenta as viagens como sendo mais rápidas e a noite mais lentas, entre as rotas mais lentas no geral.

3.3.2) Mais lentas

seis_oito3 <- hours3 %>% 
  filter(hour_group == "M") %>% 
  top_n(-20)
## Selecting by speed
onze_uma3 <- hours3 %>% 
  filter(hour_group == "T") %>% 
  top_n(-20)
## Selecting by speed
cinco_sete3 <- hours3 %>% 
  filter(hour_group == "N") %>% 
  top_n(-20)
## Selecting by speed
data_comparation4 <- merge(x = seis_oito3, y = onze_uma3, by = "route")

data_comparation5 <- merge(x = data_comparation4, y = cinco_sete3, by = "route")

data_comparation5 <- data_comparation5 %>% mutate(Manha = speed.x, Tarde = speed.y, Noite = speed)

comp_long1 <- gather(data_comparation5, key="measure", value="value", c("Manha", "Tarde", "Noite"))

ggplot(comp_long1, aes(fill = measure, x = reorder(route, value), y = value)) + geom_col(position="dodge", stat='identity') + labs(x = "route", y = "velocidade (km/h)")

Dentre as rotas mais lentas, a manhã é o horário onde a maioria delas anda mais rápido e a noite como mais lentas. Porém algumas rotas, apresentam comportamentos peculiares, como a 631, 822 e 714.

  1. Histogramas: velocidade, distância e duração das viagens.

4.1) Velocidade

expanded %>% 
  ggplot(aes(speed)) + 
  geom_histogram(xlab="Speed",  
      fill=I("black"), 
      col=I("blue"), 
      alpha=I(.30)) + labs(x = "velocidade", y = "quantidade de viagens") + scale_x_continuous(trans = 'log2') + scale_y_continuous(trans = 'log10')
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Vemos que a maioria das viagens feitas demoram em mediana cerca de 16 minutos a serem realizadas. Vemos que há uma boa quantidade de viagens realizadas acima e abaixo dessa faixa de tempo, chegando a ter viagens com 2 minutos e outras com 2 horas.

4.2) Distância

expanded %>% 
  ggplot(aes(dist_median)) + 
  geom_histogram(xlab="Distance",  
      fill=I("black"), 
      col=I("blue"), 
      alpha=I(.30)) + labs(x = "distância") + scale_x_continuous(trans = 'log2')
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Vemos que a distância percorrida nas viagens tem sua maior concentração na faixa de valor dos 4 quilômetros percorridos.

4.3) Duração

expanded %>% 
  ggplot(aes(duration_median)) + 
  geom_histogram(xlab="Duration",  
      fill=I("black"), 
      col=I("blue"), 
      alpha=I(.30)) + labs(x = "duration") + scale_x_continuous(trans = 'log2')
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Observamos que a duração das viagens se concentra na faixa de valor dos 15 minutos, o que é um tempo razoável considerando o tamanho geográfico da cidade de Curitiba.