TP 5
Candelaria David
6/19/2021
TAREA 5: Analizando y visualizando flujos de viajes urbanos
library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──## ✓ ggplot2 3.3.3 ✓ purrr 0.3.4
## ✓ tibble 3.1.1 ✓ dplyr 1.0.5
## ✓ tidyr 1.1.3 ✓ stringr 1.4.0
## ✓ readr 1.4.0 ✓ forcats 0.5.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(sf)## Linking to GEOS 3.8.1, GDAL 3.1.4, PROJ 6.3.1library(ggmap)## Google's Terms of Service: https://cloud.google.com/maps-platform/terms/.## Please cite ggmap if you use it! See citation("ggmap") for details.library(leaflet)
library(osrm)## Data: (c) OpenStreetMap contributors, ODbL 1.0 - http://www.openstreetmap.org/copyright## Routing: OSRM - http://project-osrm.org/Cargamos el set de datos de los recorridos en bicileta realizados en 2021 en la Ciudad de Buenos Aires:
recorridos_realizados <- read.csv ("recorridos_realizados_2021.csv", stringsAsFactors = TRUE)summary (recorridos_realizados)## duracion_recorrido id_estacion_origen fecha_origen_recorrido
## Min. : 0 Min. : 2.0 2021-03-04 21:39:05: 8
## 1st Qu.: 656 1st Qu.: 75.0 2021-01-27 18:14:00: 7
## Median : 1035 Median :162.0 2021-01-28 18:08:59: 7
## Mean : 1196 Mean :166.8 2021-03-02 15:55:16: 7
## 3rd Qu.: 1526 3rd Qu.:235.0 2021-01-07 18:32:09: 5
## Max. :548595 Max. :449.0 2021-01-09 17:41:17: 5
## (Other) :647123
## nombre_estacion_origen fecha_destino_recorrido
## 029 - Parque Centenario : 9514 2021-03-04 21:39:07: 8
## 014 - Pacifico : 9498 2021-01-08 19:56:13: 7
## 160 - Godoy Cruz y Libertador: 9004 2021-01-07 12:25:31: 5
## 255 - BARRANCAS DE BELGRANO : 7556 2021-01-08 17:39:30: 5
## 292 - PLAZA BOLIVIA : 7414 2021-01-13 19:09:59: 5
## 005 - Plaza Italia : 6999 2021-01-20 20:55:26: 5
## (Other) :597177 (Other) :647127
## id_estacion_destino nombre_estacion_destino id_usuario
## Min. : 2 160 - Godoy Cruz y Libertador: 9138 Min. : 38
## 1st Qu.: 76 029 - Parque Centenario : 9041 1st Qu.:195320
## Median :163 014 - Pacifico : 8692 Median :569922
## Mean :168 255 - BARRANCAS DE BELGRANO : 7687 Mean :463098
## 3rd Qu.:235 292 - PLAZA BOLIVIA : 7572 3rd Qu.:707265
## Max. :449 096 - Carlos Gardel : 7062 Max. :754621
## (Other) :597970
## direccion_estacion_origen
## Av. Patricias Argentinas & Estivao : 9514
## Santa Fe Av. & Bullrich, Int. Av. : 9498
## Godoy Cruz 3279 y Libertador : 9004
## Sucre, Antonio Jose De, Mcal. Y Vertiz Virrey Av.: 7556
## Olleros Av. & Del Libertador Av. : 7414
## Av. Sarmiento 2601 : 6999
## (Other) :597177
## long_estacion_origen lat_estacion_origen
## Min. :-58.49 Min. :-34.65
## 1st Qu.:-58.44 1st Qu.:-34.61
## Median :-58.42 Median :-34.60
## Mean :-58.42 Mean :-34.60
## 3rd Qu.:-58.40 3rd Qu.:-34.58
## Max. :-58.36 Max. :-34.54
##
## direccion_estacion_destino
## Godoy Cruz 3279 y Libertador : 9138
## Av. Patricias Argentinas & Estivao : 9041
## Santa Fe Av. & Bullrich, Int. Av. : 8692
## Sucre, Antonio Jose De, Mcal. Y Vertiz Virrey Av.: 7687
## Olleros Av. & Del Libertador Av. : 7572
## 3302 Guardia Vieja & Aguero : 7062
## (Other) :597970
## long_estacion_destino lat_estacion_destino periodo
## Min. :-58.49 Min. :-34.65 Min. :2020
## 1st Qu.:-58.44 1st Qu.:-34.61 1st Qu.:2020
## Median :-58.42 Median :-34.60 Median :2020
## Mean :-58.42 Mean :-34.60 Mean :2020
## 3rd Qu.:-58.40 3rd Qu.:-34.58 3rd Qu.:2020
## Max. :-58.36 Max. :-34.54 Max. :2020
## Vemos que en los datos tenemos: la duración del recorrido, la fecha y hora de la salida de la estacion de origen y de la llegada a la estacion de destino, el nombre de estacion origen y de destino, el id de la estacion de origen y de destino, las coordenadas geograficas, entre otras.
Ahora vamos a calcular la cantidad de viajes realizados y a visualizar los datos en un histograma
viajes_2021 <- recorridos_realizados%>%
group_by(id_estacion_origen, nombre_estacion_origen, fecha_origen_recorrido, long_estacion_origen, lat_estacion_origen, id_estacion_destino, nombre_estacion_destino, fecha_destino_recorrido, long_estacion_destino, lat_estacion_destino) %>%
summarise(cant_viajes = n())## `summarise()` has grouped output by 'id_estacion_origen', 'nombre_estacion_origen', 'fecha_origen_recorrido', 'long_estacion_origen', 'lat_estacion_origen', 'id_estacion_destino', 'nombre_estacion_destino', 'fecha_destino_recorrido', 'long_estacion_destino'. You can override using the `.groups` argument.options (scipen=999)ggplot(viajes_2021)+
geom_histogram(aes(x=cant_viajes)) +
labs(title="Cantidad de recorridos realizados",
subtitle="CABA")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Vemos que todos los viajes realizados en 2021 se realizaron una sola vez. Vamos a ver el top 20 de viajes, para verificar si hay algun viaje que se repitio mas veces o si realmente todos se realizaron una única vez.
top_20 <- viajes_2021 %>%
filter(nombre_estacion_origen != nombre_estacion_destino) %>%
arrange(desc(cant_viajes)) %>%
head(20)top_20## # A tibble: 20 x 11
## # Groups: id_estacion_origen, nombre_estacion_origen, fecha_origen_recorrido,
## # long_estacion_origen, lat_estacion_origen, id_estacion_destino,
## # nombre_estacion_destino, fecha_destino_recorrido, long_estacion_destino
## # [20]
## id_estacion_orig… nombre_estacion_orig… fecha_origen_recor… long_estacion_or…
## <int> <fct> <fct> <dbl>
## 1 56 056 - Plaza Palermo … 2021-03-04 21:39:05 -58.4
## 2 56 056 - Plaza Palermo … 2021-03-02 15:55:16 -58.4
## 3 56 056 - Plaza Palermo … 2021-03-03 21:14:43 -58.4
## 4 3 003 - ADUANA 2021-02-28 16:52:18 -58.4
## 5 5 005 - Plaza Italia 2021-01-01 16:18:03 -58.4
## 6 5 005 - Plaza Italia 2021-01-13 19:21:27 -58.4
## 7 5 005 - Plaza Italia 2021-02-06 01:08:56 -58.4
## 8 5 005 - Plaza Italia 2021-02-06 12:37:18 -58.4
## 9 5 005 - Plaza Italia 2021-02-12 18:26:55 -58.4
## 10 5 005 - Plaza Italia 2021-02-18 23:13:07 -58.4
## 11 5 005 - Plaza Italia 2021-02-27 19:32:55 -58.4
## 12 5 005 - Plaza Italia 2021-03-02 23:31:48 -58.4
## 13 6 006 - Parque Lezama 2021-01-01 05:44:37 -58.4
## 14 8 008 - Congreso 2021-01-18 08:08:10 -58.4
## 15 8 008 - Congreso 2021-02-03 00:06:16 -58.4
## 16 12 012 - Plaza Vicente … 2021-01-04 17:30:24 -58.4
## 17 13 013 - ONCE 2021-02-06 22:22:36 -58.4
## 18 13 013 - ONCE 2021-02-20 00:48:08 -58.4
## 19 17 017 - Plaza Almagro 2021-01-10 21:13:49 -58.4
## 20 20 020 - Distrito Audio… 2021-01-09 16:16:10 -58.4
## # … with 7 more variables: lat_estacion_origen <dbl>,
## # id_estacion_destino <int>, nombre_estacion_destino <fct>,
## # fecha_destino_recorrido <fct>, long_estacion_destino <dbl>,
## # lat_estacion_destino <dbl>, cant_viajes <int>Vemos que los viajes que salieron de la estación de la Plaza Palermo Viejo con destino a Plaza Libertad fueron los que mas se repitieron, con una cantidad de 7 veces (aunque muy pocas), Le siguen los viajes que salieron de Plaza Palermo Viejo con destino a Billinghurst y a Plaza Italia, con una cantidad de 3 viajes. Por debajo, el resto del top 20 lo ocupan viajes que se repitieron solo dos veces. Esto nos lleva a pensar que el sistema de bicicletas públicas en CABA se utiliza para mas que nada para el turismo.
ggplot() +
geom_tile(data = top_20,
aes(x = as.factor(id_estacion_origen),
y = as.factor(id_estacion_destino),
fill = cant_viajes)) +
scale_fill_distiller(palette = "RdYlGn") +
labs(title="Matriz Origen-Destino",
subtitle="Top 20 Recorridos en Bicicleta - CABA",
x="Estacion Origen",
y="Estación Destino",
fill="Viajes")
** Ruteo simple:**
Vamos a ver el trayecto del viaje que más se repitio, es decir, de viaje que salió de Plaza Palermo Viejo a Plaza Libertad.
viaje1 <- top_20 %>%
ungroup() %>%
filter(cant_viajes==max(cant_viajes))ruteo_viaje1 <- osrmRoute(src = c(viaje1$id_estacion_origen, viaje1$long_estacion_origen, viaje1$lat_estacion_origen),
dst = c(viaje1$id_estacion_destino, viaje1$long_estacion_destino, viaje1$lat_estacion_destino),
returnclass = "sf",
overview = "full",
osrm.profile = "bike")ruteo_viaje1## Simple feature collection with 1 feature and 4 fields
## Geometry type: LINESTRING
## Dimension: XY
## Bounding box: xmin: -58.426 ymin: -34.59697 xmax: -58.38268 ymax: -34.58358
## Geodetic CRS: WGS 84
## src dst duration distance geometry
## 56_38 56 38 20.795 4.808 LINESTRING (-58.426 -34.588...Para poder hacer el gráfico espacial, cargamos el dataset con las coordenadas geográficas de las estaciones de biciletas de la Ciudad de Buenos Aires:
estaciones<- read.csv("estaciones.csv", stringsAsFactors = TRUE)summary (estaciones)## id_estacion nombre_estacion long_estacion lat_estacion
## Min. : 1.00 15 de Noviembre : 1 Min. :-58.46 Min. :-34.64
## 1st Qu.: 49.75 25 de Mayo : 1 1st Qu.:-58.42 1st Qu.:-34.62
## Median : 99.50 9 de Julio : 1 Median :-58.40 Median :-34.60
## Mean : 99.90 Acevedo : 1 Mean :-58.40 Mean :-34.61
## 3rd Qu.:149.25 Acuña de Figueroa: 1 3rd Qu.:-58.38 3rd Qu.:-34.59
## Max. :200.00 Aduana : 1 Max. :-58.36 Max. :-34.57
## NA's :4 (Other) :198 NA's :6 NA's :6
## domicilio_estacion
## : 6
## Plaza Fuerza Aérea: Av. Dr. J. Ramos Mejia y Av Del Libertador: 2
## 15 de Noviembre de 1889 2687 entre Catamarca y Jujuy : 1
## 25 de Mayo y Lavalle : 1
## 33 Orientales 1439, entre Av. Pavón y Av. Garay : 1
## 9 de Julio y Moreno : 1
## (Other) :192
## tipo_estacion observaciones
## : 11 Abril 2015 (pasó de ser Manual a Automática): 24
## AUTOMÁTICA:193 Marzo 2017 : 17
## Mayo 2017 : 16
## Abril 2017 : 15
## : 11
## Agosto 2017 : 11
## (Other) :110
## horario_estacion
## : 11
## Estación automática: disponibilidad las 24 horas:193
##
##
##
##
## bbox_caba <- make_bbox(estaciones$long_estacion, estaciones$lat_estacion)mapa_caba <- get_stamenmap(bbox_caba,
zoom = 12)## Source : http://tile.stamen.com/terrain/12/1382/2467.png## Source : http://tile.stamen.com/terrain/12/1383/2467.png## Source : http://tile.stamen.com/terrain/12/1384/2467.png## Source : http://tile.stamen.com/terrain/12/1382/2468.png## Source : http://tile.stamen.com/terrain/12/1383/2468.png## Source : http://tile.stamen.com/terrain/12/1384/2468.pngggmap(mapa_caba)+
geom_point(data=estaciones, aes(x=long_estacion, y=lat_estacion), inherit.aes = FALSE)+
geom_sf(data=ruteo_viaje1, color="red", size=1.5, inherit.aes = FALSE)+
labs(title="Recorrido más Realizado en Bicicleta",
subtitle="CABA") +
theme_void()## Coordinate system already present. Adding new coordinate system, which will replace the existing one.## Warning: Removed 6 rows containing missing values (geom_point).
Hacemos un mapa interactivo para observar bien el recorrido:
leaflet(ruteo_viaje1) %>%
addTiles() %>%
addPolylines(color = "red",
label = paste("Distancia:", ruteo_viaje1$distance, "|",
"Duración:", ruteo_viaje1$duration))Vemos que el viaje que más veces se repitió salió de Palermo y recorrió todo Avenida Santa Fe hasta llegar a Plaza Libertad en Retiro. Probablemente haya sido un viaje de recreación dado que el destino fue una plaza.
RUTEO MULTIPLE:
Vamos a rutear el resto de los viajes del top20:
ruteo_bicis <- function(nombre_estacion_origen, long_estacion_origen, lat_estacion_origen,
nombre_estacion_destino, long_estacion_destino, lat_estacion_destino) {
ruta <- osrmRoute(src = c(nombre_estacion_origen, long_estacion_origen, lat_estacion_origen),
dst = c(nombre_estacion_destino, long_estacion_destino, lat_estacion_destino),
returnclass = "sf",
overview = "full",
osrm.profile = "bike")
cbind(ORIGEN = nombre_estacion_origen, DESTINO = nombre_estacion_destino, ruta)
}ruteotop20 <- list(top_20$nombre_estacion_origen, top_20$long_estacion_origen, top_20$lat_estacion_origen,
top_20$nombre_estacion_destino, top_20$long_estacion_destino, top_20$lat_estacion_destino)ruteotop20 <- pmap(ruteotop20, ruteo_bicis) %>%
reduce(rbind)summary (ruteotop20)## ORIGEN DESTINO src
## 005 - Plaza Italia :8 003 - ADUANA : 1 Min. : 3.00
## 056 - Plaza Palermo Viejo:3 005 - Plaza Italia : 1 1st Qu.: 5.00
## 008 - Congreso :2 007 - OBELISCO : 1 Median : 7.00
## 013 - ONCE :2 025 - Plaza Guemes : 1 Mean :12.20
## 003 - ADUANA :1 027 - Montevideo : 1 3rd Qu.:11.75
## 006 - Parque Lezama :1 038 - Plaza Libertad: 1 Max. :39.00
## (Other) :3 (Other) :14
## dst duration distance geometry
## Min. : 3.00 Min. : 4.288 Min. :0.8532 LINESTRING :20
## 1st Qu.: 28.25 1st Qu.: 7.317 1st Qu.:1.3417 epsg:4326 : 0
## Median : 80.00 Median :11.703 Median :2.4343 +proj=long...: 0
## Mean : 82.80 Mean :15.275 Mean :3.2867
## 3rd Qu.:118.00 3rd Qu.:21.369 3rd Qu.:4.9378
## Max. :196.00 Max. :33.215 Max. :7.5092
## ggmap(mapa_caba)+
geom_sf(data=ruteotop20, color="red", size=1.5, inherit.aes = FALSE)+
labs(title="Top 20 Recorridos más Realizados en Bicicleta",
subtitle="CABA",
caption="Fuente: BAdata")+
scale_color_viridis_c(direction=-1)+
theme_void()## Coordinate system already present. Adding new coordinate system, which will replace the existing one.
bbox_zoom <- as.numeric(st_bbox(ruteotop20))mapa_zoom <- get_stamenmap(bbox_zoom,
color="bw",
zoom = 13)## Source : http://tile.stamen.com/terrain/13/2765/4935.png## Source : http://tile.stamen.com/terrain/13/2766/4935.png## Source : http://tile.stamen.com/terrain/13/2767/4935.png## Source : http://tile.stamen.com/terrain/13/2765/4936.png## Source : http://tile.stamen.com/terrain/13/2766/4936.png## Source : http://tile.stamen.com/terrain/13/2767/4936.pngggmap(mapa_zoom)
ggmap(mapa_zoom)+
geom_sf(data=ruteotop20, aes(color=duration), size=2, inherit.aes = FALSE)+
labs(title="Top 20 Recorridos más Realizados en Bicicleta",
subtitle="CABA",
caption="Fuente: BAdata")+
scale_color_viridis_c(direction=-1)+
theme_void()## Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Vemos que la mayoría de los viajes se mueven de norte a sur a lo largo de capital federal, habiendo un par de excepciones. Todos son recorridos cortos y la mayoría de los destinos son en Palermo o zona centro. Algunos también llegan a los parques sobre Av, Libertador de la Ciudad.
Realizamos un mapa interactivo:
ruteotop20 <- ruteotop20 %>%
mutate(RUTA = paste("Desde", ORIGEN,"hasta", DESTINO))paleta <- c(low="gold", high= "deeppink4")
labels <- sprintf(
"<strong>%s</strong><br/>%g km <br/>%g min",
ruteotop20$RUTA, round(ruteotop20$distance, 2), round(ruteotop20$duration, 0)
) %>% lapply(htmltools::HTML)
leaflet(ruteotop20) %>%
addTiles() %>%
addProviderTiles(providers$CartoDB) %>%
addPolylines(color = ~colorNumeric(paleta, ruteotop20$distance)(distance),
weight = 6,
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "2px 5px"),
textsize = "10px",
direction = "top"),
highlight = highlightOptions(weight = 8,
bringToFront = TRUE)) %>%
addLegend("bottomright", pal = colorNumeric(paleta, ruteotop20$distance), values = ~distance,
title = "Distancia",
labFormat = labelFormat(suffix = "km"),
opacity = 0.75)