TP 5: Analizando y visualizando flujos de viajes urbanos
library(ggmap)## Warning: package 'ggmap' was built under R version 3.6.1## Loading required package: ggplot2## Registered S3 methods overwritten by 'ggplot2':
## method from
## [.quosures rlang
## c.quosures rlang
## print.quosures rlang## 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(tidyverse)## Registered S3 method overwritten by 'rvest':
## method from
## read_xml.response xml2## -- Attaching packages -------------------------------------------------- tidyverse 1.2.1 --## v tibble 2.1.1 v purrr 0.3.2
## v tidyr 0.8.3 v dplyr 0.8.0.1
## v readr 1.3.1 v stringr 1.4.0
## v tibble 2.1.1 v forcats 0.4.0## -- Conflicts ----------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(sf)## Linking to GEOS 3.6.1, GDAL 2.2.3, PROJ 4.9.3library(osmdata)## Warning: package 'osmdata' was built under R version 3.6.1## Data (c) OpenStreetMap contributors, ODbL 1.0. http://www.openstreetmap.org/copyrightlibrary(leaflet)## Warning: package 'leaflet' was built under R version 3.6.1Vamos a analizar los viajes origen-destino del sistema de EcoBici 2018
bici <- read.csv('C:/MEU (DiTella)/2019 - A2/2 Trimestre/MU115 - Ciencia de datos 2/Datos2/BA/bici/recorridos-realizados-2018.csv', encoding = "UTF-8")Exploramos el dataset
dim(bici)## [1] 2619968 9names(bici)## [1] "bici_id_usuario" "bici_Fecha_hora_retiro"
## [3] "bici_tiempo_uso" "bici_nombre_estacion_origen"
## [5] "bici_estacion_origen" "bici_nombre_estacion_destino"
## [7] "bici_estacion_destino" "bici_sexo"
## [9] "bici_edad"summary(bici)head(bici)## bici_id_usuario bici_Fecha_hora_retiro bici_tiempo_uso
## 1 5453 2018-01-01 00:08:05 0 days 00:19:53.000000000
## 2 673 2018-01-01 00:18:05 0 days 00:26:19.000000000
## 3 179119 2018-01-01 00:20:14 0 days 00:27:39.000000000
## 4 400147 2018-01-01 00:20:22 0 days 00:48:51.000000000
## 5 400156 2018-01-01 00:20:31 0 days 00:49:27.000000000
## 6 476733 2018-01-01 00:21:01 0 days 00:36:10.000000000
## bici_nombre_estacion_origen bici_estacion_origen
## 1 Uruguay 45
## 2 Posadas 189
## 3 Hospital Rivadavia 50
## 4 Macacha Güemes 111
## 5 Macacha Güemes 111
## 6 Yatay 121
## bici_nombre_estacion_destino bici_estacion_destino bici_sexo bici_edad
## 1 Virrey Cevallos 183 M 45
## 2 Guardia Vieja 110 M 61
## 3 Padilla 31 F 52
## 4 Acuña de Figueroa 54 M 27
## 5 Acuña de Figueroa 54 F 27
## 6 Billinghurst y Valentin Gomez 143 F 31Tenemos la cantidad de viajes, pero queremos conocer la cantidad de estaciones, por lo que creamos un contador
conteo.est <- bici %>%
group_by(bici_nombre_estacion_origen) %>%
summarise(cantidad = n())dim(conteo.est)## [1] 199 2Ya tenemos los recorridos y cantidad de estaciones, ahora vamos a descargar el dataset de Estaciones para ver la ubicacion, que es el dato que nos esta faltando.
estaciones <- read.csv('C:/MEU (DiTella)/2019 - A2/2 Trimestre/MU115 - Ciencia de datos 2/Datos2/BA/bici/estaciones-de-bicicletas-publicas.csv', encoding = "UTF-8")Exploramos
names(estaciones)## [1] "long" "lat" "nombre" "domicilio" "imagen"
## [6] "automat" "observ" "nro_est" "horario" "dire_norm"dim(estaciones)## [1] 199 10Ambos datasets nos indican que hay 199 estaciones. Vamos a visualizarlas
Definimos el BoundingBox
library(ggmap)
bbox <- make_bbox(estaciones$X, estaciones$Y)## Warning in min(x, na.rm = na.rm): ningún argumento finito para min;
## retornando Inf## Warning in max(x, na.rm = na.rm): ningun argumento finito para max;
## retornando -Inf## Warning in min(x, na.rm = na.rm): ningún argumento finito para min;
## retornando Inf## Warning in max(x, na.rm = na.rm): ningun argumento finito para max;
## retornando -Infbbox## left bottom right top
## -Inf -Inf Inf Infbbox <- c(min(estaciones$lon),
min(estaciones$lat),
max(estaciones$lon),
max(estaciones$lat))mapa_base <- get_stamenmap(bbox, 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/2768/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.png## Source : http://tile.stamen.com/terrain/13/2768/4936.png## Source : http://tile.stamen.com/terrain/13/2765/4937.png## Source : http://tile.stamen.com/terrain/13/2766/4937.png## Source : http://tile.stamen.com/terrain/13/2767/4937.png## Source : http://tile.stamen.com/terrain/13/2768/4937.pngggmap(mapa_base) +
geom_point(data = estaciones,
aes(x = long, y = lat),
alpha = .8,
color = "orange")
Si queremos saber cuales son los trayectos mas populares, podemos armar un contador que contabilize pares de estaciones
conteo <- bici %>%
group_by(bici_estacion_origen, bici_estacion_destino) %>%
summarise(total = n())Vamos a hacer un heatmap para evaluar el grado de interconexion, que muestre la cantidad de viaje entre pares.
ggplot() +
geom_tile(data = conteo, aes(x = bici_estacion_origen, y = bici_estacion_destino, fill = total)) +
scale_fill_distiller(palette = "Spectral")
La numeración discontinua de la estaciones dificulta la lectura del mismo.
Para evitar el bache en el mapa de calor vamos a tratar a las estaciones como una variable categórica (un factor) en lugar de numérica.
ggplot() +
geom_tile(data = conteo,
aes(x = as.factor(bici_estacion_origen),
y = as.factor(bici_estacion_destino),
fill = total)) +
scale_fill_distiller(palette = "Spectral")
La densidad del grafico hace dificil sacar conclusiones, pero podemos ver en la linea verde que la mayoria de los viajes empiezan y terminan en la misma estación. Podria ser por una cuestion recreativa, el usuario da una vuelta y la deja en el mismo lugar. Otra explicación podria ser que al sacarla ven que no esta en condiciones óptimas y deciden dejarla para agarrar otra. Esto último se podría verificar por ejemplo filtrando los viajes menores a 1 minuto.
Otra información que nos proporciona el gráfico es la concentración de puntos rojos (mucha cantidad) hacia el cero del eje de coordenadas, es decir proximo a la estación cero. Esto indica que estos viajes son en la zona centrica, donde se pusieron las primeras estaciones y por lo tanto la que tienen numero de serie menor.
Vamos a obtener los 30 viajes mas populares, descartando los viajes “circulares” (con el mismo origen y destino):
top30 <- conteo %>%
ungroup() %>%
filter(bici_estacion_origen != bici_estacion_destino) %>%
top_n(30)## Selecting by totaltop30## # A tibble: 30 x 3
## bici_estacion_origen bici_estacion_destino total
## <int> <int> <int>
## 1 1 2 1111
## 2 1 103 1219
## 3 1 131 1408
## 4 2 1 932
## 5 5 14 1023
## 6 5 44 1307
## 7 5 160 1151
## 8 5 177 2213
## 9 9 30 967
## 10 9 66 1091
## # ... with 20 more rowsggplot() +
geom_tile(data = top30,
aes(x = as.factor(bici_estacion_origen),
y = as.factor(bici_estacion_destino),
fill = total)) +
scale_fill_distiller(palette = "Spectral")
y el top 10
top10 <- conteo %>%
ungroup() %>%
filter(bici_estacion_origen != bici_estacion_destino) %>%
arrange(desc(total)) %>%
top_n(10)## Selecting by totaltop10## # A tibble: 10 x 3
## bici_estacion_origen bici_estacion_destino total
## <int> <int> <int>
## 1 177 5 2323
## 2 5 177 2213
## 3 14 160 1560
## 4 1 131 1408
## 5 131 1 1407
## 6 26 131 1362
## 7 5 44 1307
## 8 103 1 1270
## 9 160 14 1253
## 10 14 159 1232ggplot() +
geom_tile(data = top10,
aes(x = as.factor(bici_estacion_origen),
y = as.factor(bici_estacion_destino),
fill = total)) +
scale_fill_distiller(palette = "Spectral")
y el top 5
top5 <- conteo %>%
ungroup() %>%
filter(bici_estacion_origen != bici_estacion_destino) %>%
arrange(desc(total)) %>%
top_n(5)## Selecting by totaltop5## # A tibble: 5 x 3
## bici_estacion_origen bici_estacion_destino total
## <int> <int> <int>
## 1 177 5 2323
## 2 5 177 2213
## 3 14 160 1560
## 4 1 131 1408
## 5 131 1 1407Ahora vamos a mapear estos 5 viajes mas frecuentes
Primero hacemos un join del dataframe con el conteo de viajes contra el de posición de estaciones, para agregar las coordenadas
top10 <- top10 %>%
left_join(estaciones[c("long", "lat", "nombre", "nro_est")],
by = c("bici_estacion_origen" = "nro_est")) %>%
rename(ORIGEN_X = long,
ORIGEN_Y = lat,
ORIGEN_NOMBRE = nombre)top10## # A tibble: 10 x 6
## bici_estacion_or~ bici_estacion_d~ total ORIGEN_X ORIGEN_Y ORIGEN_NOMBRE
## <int> <int> <int> <dbl> <dbl> <fct>
## 1 177 5 2323 -58.4 -34.6 Planetario
## 2 5 177 2213 -58.4 -34.6 Plaza Italia
## 3 14 160 1560 -58.4 -34.6 Pacífico
## 4 1 131 1408 -58.4 -34.6 Facultad de ~
## 5 131 1 1407 -58.4 -34.6 Retiro III
## 6 26 131 1362 -58.4 -34.6 Juana Manso
## 7 5 44 1307 -58.4 -34.6 Plaza Italia
## 8 103 1 1270 -58.4 -34.6 Malba
## 9 160 14 1253 -58.4 -34.6 Godoy Cruz y~
## 10 14 159 1232 -58.4 -34.6 Pacíficoy hacemos lo propio con las estaciones de destino
top10 <- top10 %>%
left_join(estaciones[c("long", "lat", "nombre", "nro_est")],
by = c("bici_estacion_destino" = "nro_est")) %>%
rename(DESTINO_X = long,
DESTINO_Y = lat,
DESTINO_NOMBRE = nombre)
top10## # A tibble: 10 x 9
## bici_estacion_o~ bici_estacion_d~ total ORIGEN_X ORIGEN_Y ORIGEN_NOMBRE
## <int> <int> <int> <dbl> <dbl> <fct>
## 1 177 5 2323 -58.4 -34.6 Planetario
## 2 5 177 2213 -58.4 -34.6 Plaza Italia
## 3 14 160 1560 -58.4 -34.6 Pacífico
## 4 1 131 1408 -58.4 -34.6 Facultad de ~
## 5 131 1 1407 -58.4 -34.6 Retiro III
## 6 26 131 1362 -58.4 -34.6 Juana Manso
## 7 5 44 1307 -58.4 -34.6 Plaza Italia
## 8 103 1 1270 -58.4 -34.6 Malba
## 9 160 14 1253 -58.4 -34.6 Godoy Cruz y~
## 10 14 159 1232 -58.4 -34.6 Pacífico
## # ... with 3 more variables: DESTINO_X <dbl>, DESTINO_Y <dbl>,
## # DESTINO_NOMBRE <fct>Vamos a mapear el recorrido del viaje mas popular: Planetario - Pza. Italia
viaje <- top10[1,]
planet_a_italia <- osrmRoute(src = c(viaje$bici_estacion_origen, viaje$ORIGEN_X, viaje$ORIGEN_Y),
dst = c(viaje$bici_estacion_destino, viaje$DESTINO_X, viaje$DESTINO_Y),
sp = TRUE,
overview = "full")## Warning: sp is deprecated; use returnclass instead.planet_a_italia@data## src dst duration distance
## 177_5 177 5 15.54667 2.0442leaflet(planet_a_italia) %>%
addTiles() %>%
addPolylines(color = "blue")Y los 4 siguientes para completar el top5
viaje2 <- top10[2,]
v2 <- osrmRoute(src = c(viaje2$bici_estacion_origen, viaje2$ORIGEN_X, viaje2$ORIGEN_Y),
dst = c(viaje2$bici_estacion_destino, viaje2$DESTINO_X, viaje2$DESTINO_Y),
sp = TRUE,
overview = "full")## Warning: sp is deprecated; use returnclass instead.v2@data## src dst duration distance
## 5_177 5 177 16.85333 4.437leaflet(v2) %>%
addTiles() %>%
addPolylines(color = "red")viaje3 <- top10[3,]
v3 <- osrmRoute(src = c(viaje3$bici_estacion_origen, viaje3$ORIGEN_X, viaje3$ORIGEN_Y),
dst = c(viaje2$bici_estacion_destino, viaje3$DESTINO_X, viaje3$DESTINO_Y),
sp = TRUE,
overview = "full")## Warning: sp is deprecated; use returnclass instead.v3@data## src dst duration distance
## 14_177 14 177 4.113333 1.0292leaflet(v3) %>%
addTiles() %>%
addPolylines(color = "green")viaje4 <- top10[4,]
v4 <- osrmRoute(src = c(viaje4$bici_estacion_origen, viaje4$ORIGEN_X, viaje4$ORIGEN_Y),
dst = c(viaje4$bici_estacion_destino, viaje4$DESTINO_X, viaje4$DESTINO_Y),
sp = TRUE,
overview = "full")## Warning: sp is deprecated; use returnclass instead.v4@data## src dst duration distance
## 1_131 1 131 16.28833 5.3237leaflet(v4) %>%
addTiles() %>%
addPolylines(color = "purple")viaje5 <- top10[5,]
v5 <- osrmRoute(src = c(viaje5$bici_estacion_origen, viaje5$ORIGEN_X, viaje5$ORIGEN_Y),
dst = c(viaje5$bici_estacion_destino, viaje5$DESTINO_X, viaje5$DESTINO_Y),
sp = TRUE,
overview = "full")## Warning: sp is deprecated; use returnclass instead.v5@data## src dst duration distance
## 131_1 131 1 8.363333 2.3975leaflet(v5) %>%
addTiles() %>%
addPolylines(color = "cyan")