ANALIZANDO EL FLUJO DE VIAJES URBANOS

La duración de los recorridos que se realizan a diario en la Ciudad y las distancias entre los diferentes puntos de interés son un tema muy interesante a la hora de analizar las dinámicas urbanas. Por suerte desde R podemos conectarnos al servicio de ruteo de “OSRM” (http://project-osrm.org/), un paquete de uso libre, basado en datos de OpenStreetMap (https://www.openstreetmap.org/), que es muy útil a la hora de calcular distancias (km) y tiempos de viaje (minutos) entre 2 o más puntos georreferenciados.

El paquete se compone de 4 funciones que son:

En la clase de hoy trabajaremos con la función osrmRoute() para analizar los viajes realizados en bicicleta en la Ciudad de Boston durante la primer semana del mes de Mayo 2021. Pero antes de comenzar, carguemos las librerías tidyverse, sf, ggmap, leaflet e instalemos y activemos osrm:

#install.packages("tidyverse")
library(tidyverse)
#install.packages("sf")
library(sf)
#install.packages("ggmap")
library(ggmap)
#install.packages("leaflet")
library(leaflet)
#install.packages("osrm")
library(osrm)

Hoy trabajaremos con 2 dataset: el de las estaciones y el de los recorridos. Primero carguemos el csv de estaciones:

boston_station_xy <- read.csv("boston_station_xy.csv", stringsAsFactors = TRUE)

Revisemos que info tenemos:

dim(boston_station_xy)
## [1] 368   4

El dataset de estaciones de bicicletas públicas Blue Bike"* en Boston tiene 368 registros (estaciones) y 4 columnas. Veamos de que se trata la info que trae:

summary(boston_station_xy)
##    station_id                                 station_name   station_x     
##  Min.   :  1.0   160 Arsenal                        :  1   Min.   :-71.23  
##  1st Qu.:103.8   175 N Harvard St                   :  1   1st Qu.:-71.12  
##  Median :214.5   18 Dorrance Warehouse              :  1   Median :-71.09  
##  Mean   :246.6   191 Beacon St                      :  1   Mean   :-71.09  
##  3rd Qu.:394.2   2 Hummingbird Lane at Olmsted Green:  1   3rd Qu.:-71.06  
##  Max.   :510.0   30 Dane St                         :  1   Max.   :-71.01  
##                  (Other)                            :362                   
##    station_y    
##  Min.   :42.27  
##  1st Qu.:42.34  
##  Median :42.36  
##  Mean   :42.35  
##  3rd Qu.:42.37  
##  Max.   :42.42  
## 

Las columnas son:

*station_id: contiene un ID de estación

*station_name: contiene el nombre de la estación

*station_x: contiene la longitud (coordenada x) de la estación

*station_y: contiene la latitud (coordenada y) de la estaciónm

Ya que tenemos las coordenadas, hagamos una bounding box con ggmap y descarguemos un mapa de fondo:

bbox_boston <- make_bbox(boston_station_xy$station_x, boston_station_xy$station_y)
mapa_boston <- get_stamenmap(bbox_boston,
                             zoom = 12)
ggmap(mapa_boston)

Ubiquemos las 368 estaciones sobre el mapa:

ggmap(mapa_boston)+
  geom_point(data=boston_station_xy, aes(x=station_x, y=station_y), inherit.aes = FALSE)+
  labs(title="Estaciones de Bicicleta",
       subtitle="Blue Bike - Boston",
       caption="Fuente: https://www.bluebikes.com/system-data")+
  theme_void()

Podemos observar que la red de estaciones de bicicletas de Blue Bike se distribuye por todo Boston, pero la mayor cantidad se concentra en el centro.

Ahora carguemos el dataset de viajes en bicicletas de la primera semana de mayo 2021 (1 al 7/05):

boston_bikes <- read.csv("boston_bikes.csv", stringsAsFactors = TRUE)
dim(boston_bikes)
## [1] 45673     9

Hay 45673 registros y 9 columnas. Es decir, que durante la primer semana de mayo hubo 45673 viajes en bicicletas. Investiguemos un poco más:

summary(boston_bikes)
##                start_time    start_station_id
##  2021-05-01 18:29:56:    5   Min.   :  1.0   
##  2021-05-01 21:52:08:    5   1st Qu.: 58.0   
##  2021-05-01 15:47:15:    4   Median :108.0   
##  2021-05-01 16:24:52:    4   Mean   :168.9   
##  2021-05-01 17:28:10:    4   3rd Qu.:296.0   
##  2021-05-01 18:41:38:    4   Max.   :510.0   
##  (Other)            :45647                   
##                                                    start_station_name
##  MIT at Mass Ave / Amherst St                               : 1038   
##  Central Square at Mass Ave / Essex St                      :  770   
##  Charles Circle - Charles St at Cambridge St                :  733   
##  Christian Science Plaza - Massachusetts Ave at Westland Ave:  649   
##  Beacon St at Massachusetts Ave                             :  584   
##  Cross St at Hanover St                                     :  568   
##  (Other)                                                    :41331   
##  start_station_y start_station_x  end_station_id 
##  Min.   :42.27   Min.   :-71.23   Min.   :  1.0  
##  1st Qu.:42.35   1st Qu.:-71.11   1st Qu.: 56.0  
##  Median :42.36   Median :-71.09   Median :107.0  
##  Mean   :42.36   Mean   :-71.09   Mean   :168.2  
##  3rd Qu.:42.37   3rd Qu.:-71.07   3rd Qu.:282.0  
##  Max.   :42.42   Max.   :-71.01   Max.   :510.0  
##                                                  
##                                                     end_station_name
##  MIT at Mass Ave / Amherst St                               : 1067  
##  Central Square at Mass Ave / Essex St                      :  783  
##  Charles Circle - Charles St at Cambridge St                :  748  
##  Christian Science Plaza - Massachusetts Ave at Westland Ave:  649  
##  Beacon St at Massachusetts Ave                             :  585  
##  Cross St at Hanover St                                     :  564  
##  (Other)                                                    :41277  
##  end_station_y   end_station_x   
##  Min.   :42.27   Min.   :-71.23  
##  1st Qu.:42.35   1st Qu.:-71.11  
##  Median :42.36   Median :-71.09  
##  Mean   :42.36   Mean   :-71.09  
##  3rd Qu.:42.37   3rd Qu.:-71.07  
##  Max.   :42.42   Max.   :-71.01  
## 

Por ejemplo, podemos ver que la estación en donde más viajes se originan y finalizan es MIT at Mass Ave / Amherst St.

Analicemos cual es el recorrido que más se realizó, es decir la agrupación origen destino que aparece con mayor frecuencia en la base de datos:

viajes <- boston_bikes %>% 
    group_by(start_station_id, start_station_name, start_station_x, start_station_y, end_station_id, end_station_name, end_station_x, end_station_y) %>% 
    summarise(cant_viajes = n())

Observemos la distribución de la nueva variable en un histograma:

ggplot(viajes)+
  geom_histogram(aes(x=cant_viajes))
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Veamos los resultados en un gráfico de matriz:

ggplot() + 
    geom_tile(data = viajes, aes(x = start_station_id, y = end_station_id, fill = cant_viajes))+
    scale_fill_distiller(palette = "RdYlGn")

Quedan muchos espacios en blanco porque R interpreta que los ids son continuos y los que no están en la base los deja vacios. Mejoremos un poco esto convirtiendo los id en factor:

ggplot() + 
    geom_tile(data = viajes, aes(x = as.factor(start_station_id), y = as.factor(end_station_id), fill = cant_viajes)) +
    scale_fill_distiller(palette = "RdYlGn")+
    labs(title="Matriz Origen-Destino")

La visualización es bastante difícil de interpetar ya que la mayoría de combinaciones origen-destino tienen menos de 20 viajes, pero se ven algunos detalles como por ejemplo una línea perfecta a 45°. ¿Qué significa esto? Que hay varios viajes circulares, es decir que tienen el origen y destino en la misma estación. Esto puede deberse a viajes recreativos por ejemplo.

Veamos el top 20 de recorridos más realizados (sin tener en cuenta los viajes circulares):

top_20 <- viajes %>%
          filter(start_station_id != end_station_id) %>% 
          arrange(desc(cant_viajes)) %>%
          head(20)
top_20
## # A tibble: 20 x 9
## # Groups:   start_station_id, start_station_name, start_station_x,
## #   start_station_y, end_station_id, end_station_name, end_station_x [20]
##    start_station_id start_station_name           start_station_x start_station_y
##               <int> <fct>                                  <dbl>           <dbl>
##  1               67 MIT at Mass Ave / Amherst St           -71.1            42.4
##  2              179 MIT Vassar St                          -71.1            42.4
##  3               68 Central Square at Mass Ave ~           -71.1            42.4
##  4               68 Central Square at Mass Ave ~           -71.1            42.4
##  5               67 MIT at Mass Ave / Amherst St           -71.1            42.4
##  6                9 Commonwealth Ave at Agganis~           -71.1            42.4
##  7               67 MIT at Mass Ave / Amherst St           -71.1            42.4
##  8              157 Seaport Blvd at Sleeper St             -71.0            42.4
##  9              178 MIT Pacific St at Purringto~           -71.1            42.4
## 10              178 MIT Pacific St at Purringto~           -71.1            42.4
## 11               27 Roxbury Crossing T Stop - C~           -71.1            42.3
## 12               53 Beacon St at Massachusetts ~           -71.1            42.4
## 13              380 Mass Ave at Albany St                  -71.1            42.4
## 14               12 Ruggles T Stop - Columbus A~           -71.1            42.3
## 15              178 MIT Pacific St at Purringto~           -71.1            42.4
## 16              471 MIT Carleton St at Amherst ~           -71.1            42.4
## 17               67 MIT at Mass Ave / Amherst St           -71.1            42.4
## 18               47 Cross St at Hanover St                 -71.1            42.4
## 19               75 Lafayette Square at Mass Av~           -71.1            42.4
## 20               67 MIT at Mass Ave / Amherst St           -71.1            42.4
## # ... with 5 more variables: end_station_id <int>, end_station_name <fct>,
## #   end_station_x <dbl>, end_station_y <dbl>, cant_viajes <int>

El recorrido que más veces se realizó fue desde la estación MIT at Mass Ave / Amherst St hasta la estación MIT Vassar St y se registró 67 veces. Veamos esto gráficamente:

ggplot() + 
    geom_tile(data = top_20, 
              aes(x = as.factor(start_station_id),
                  y = as.factor(end_station_id),
                  fill = cant_viajes)) +
    scale_fill_distiller(palette = "RdYlGn") +
    labs(title="Matriz Origen-Destino",
         subtitle="Top 20 Recorridos en Bicicleta - Boston",
         x="Estacion Origen",
         y="Estación Destino",
         fill="Viajes")

RUTEO SIMPLE

Para hacer nuestro primer ruteo, quedémonos con el recorrido más realizado:

viaje1 <- top_20 %>%
  ungroup() %>%
  filter(cant_viajes==max(cant_viajes))

Y hagamos un ruteo con osrmRoute() para poder calcular la distancia y el tiempo de viaje entre la estación de origen y la de destino:

ruteo_viaje1 <- osrmRoute(src = c(viaje1$start_station_id, viaje1$start_station_x, viaje1$start_station_y), 
                          dst = c(viaje1$end_station_id, viaje1$end_station_x, viaje1$end_station_y), 
                          returnclass = "sf", 
                          overview = "full",
                          osrm.profile = "bike")

Como verán tuvimos que asignar 5 parámetros a la función:

  1. En src tenemos que indicar el origen del ruteo con un identificador de estación (id en este caso) y sus coordenadas.

  2. En dst tenemos que indicar el destino del ruteo con un identificador de estación (id en este caso) y sus coordenadas.

  3. En returnclass tenemos que indicar el tipo de objeto que queremos que nos devuelva la función, en este caso, un objeto espacial sf.

  4. En overview debemos indicar la calidad con la que se genera la geometría: full para obtener la mayor precisión, simplified para menor precisión y FALSE para obtener solo tiempo y distancia (sin geometría).

  5. En osrm.profile indicaremos el modo de transporte en el que queremos realizar el ruteo: car, bike o foot.

Veamos el resultado que obtuvimos:

ruteo_viaje1
## Simple feature collection with 1 feature and 4 fields
## Geometry type: LINESTRING
## Dimension:     XY
## Bounding box:  xmin: -71.10395 ymin: 42.35483 xmax: -71.09321 ymax: 42.35814
## Geodetic CRS:  WGS 84
##        src dst duration distance                       geometry
## 67_179  67 179 5.361667   1.0905 LINESTRING (-71.09321 42.35...

Para el viaje más realizado en bicicleta, que fue desde la estación id 67 a la estación id 179, se estima una distancia de 1,09 km con una duración de 5,36 min.

Reflejemos este recorrido en el mapa:

ggmap(mapa_boston)+
  geom_point(data=boston_station_xy, aes(x=station_x, y=station_y), 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="Blue Bike - Boston",
       caption="Fuente: https://www.bluebikes.com/system-data")+
  theme_void()
## Coordinate system already present. Adding new coordinate system, which will replace the existing one.

Se ve que el recorrido es dentro de Cambridge pero hagamos un mapa interactivo que nos permita hacer zoom para obtener mayor detalle:

leaflet(ruteo_viaje1) %>% 
    addTiles() %>% 
    addPolylines(color = "red",
                 label = paste("Distancia:", ruteo_viaje1$distance, "|",
                               "Duración:", ruteo_viaje1$duration))

RUTEANDO MÚLTIPLES RECORRIDOS A LA VEZ

¿Cómo calculamos todos los recorridos del top 20 en simultáneo? Esta tarea requerirá de un conocimiento extra ya que vamos a tener que realizar lo que en R le llamamos función y luce así:

nombre <- function(argumentos) { operaciones }

  • El nombre que le asignamos nos servirá luego para ejecutarla, al igual que a cualquier otra función de R que ya conozcamos.

  • Los argumentos son las variables que la función va a utilizar al momento de realizar las operaciones. Se escriben entre “()” y se separan por “,”.

  • El cuerpo contiene entre “{}” las operaciones que se realizarán cuando la función sea ejecutada.

Dicho esto, hagamos nuestra primer función que la llamaremos “ruteo_bikes”:

ruteo_viaje2 <- osrmRoute(src = c(top_20$start_station_id, top_20$start_station_x, top_20$start_station_y), 
                          dst = c(top_20$end_station_id, top_20$end_station_x, top_20$end_station_y), 
                          returnclass = "sf", 
                          overview = "full",
                          osrm.profile = "bike")
## The OSRM server returned an error:
## Error in open.connection(con, "rb"): HTTP error 400.
ruteo_bikes <- function(start_station_name, start_station_x, start_station_y,
                        end_station_name, end_station_x, end_station_y) {
  ruta <- osrmRoute(src = c(start_station_name, start_station_x, start_station_y),
                    dst = c(end_station_name, end_station_x, end_station_y), 
                    returnclass = "sf",
                    overview = "full",
                    osrm.profile = "bike")
  
  cbind(ORIGEN = start_station_name, DESTINO = end_station_name, ruta)
}
ruteo_top20 <- list(top_20$start_station_name, top_20$start_station_x, top_20$start_station_y,
                   top_20$end_station_name, top_20$end_station_x, top_20$end_station_y)
ruteo_top20 <- pmap(ruteo_top20, ruteo_bikes) %>% 
  reduce(rbind)

Veamos que ocurrió:

summary(ruteo_top20)
##                                    ORIGEN 
##  MIT at Mass Ave / Amherst St         :5  
##  MIT Pacific St at Purrington St      :3  
##  Central Square at Mass Ave / Essex St:2  
##  Beacon St at Massachusetts Ave       :1  
##  Commonwealth Ave at Agganis Way      :1  
##  Cross St at Hanover St               :1  
##  (Other)                              :7  
##                                   DESTINO       src             dst       
##  MIT at Mass Ave / Amherst St         :5   Min.   : 37.0   Min.   : 11.0  
##  Central Square at Mass Ave / Essex St:3   1st Qu.:183.5   1st Qu.: 84.0  
##  700 Commonwealth Ave.                :1   Median :232.0   Median :231.0  
##  Ames St at Main St                   :1   Mean   :202.1   Mean   :177.7  
##  Beacon St at Massachusetts Ave       :1   3rd Qu.:235.0   3rd Qu.:234.2  
##  Cross St at Hanover St               :1   Max.   :285.0   Max.   :284.0  
##  (Other)                              :8                                  
##     duration        distance              geometry 
##  Min.   :3.367   Min.   :0.710   LINESTRING   :20  
##  1st Qu.:4.061   1st Qu.:0.887   epsg:4326    : 0  
##  Median :5.110   Median :0.916   +proj=long...: 0  
##  Mean   :5.367   Mean   :1.051                     
##  3rd Qu.:5.861   3rd Qu.:1.165                     
##  Max.   :9.115   Max.   :1.556                     
## 

Se agregaron 2 nuevos campos llamados duration y distance donde podemos ver que:

  • La duración promedio de los viajes es de 5,36 min, mientras que la distancia promedio es de 1,05 km.

  • El recorrido más corto es de 0,71 km y el más largo de 1,55 km.

  • El recorrido de menor duración es en 3,36 min y el de mayor es 9,11 min.

Veamos las geometrías en un mapa:

ggmap(mapa_boston)+
  geom_sf(data=ruteo_top20, color="red", size=1.5, inherit.aes = FALSE)+
  labs(title="Top 20 Recorridos más Realizados en Bicicleta",
       subtitle="Blue Bike - Boston",
       caption="Fuente: https://www.bluebikes.com/system-data")+
  scale_color_viridis_c(direction=-1)+
  theme_void()
## Coordinate system already present. Adding new coordinate system, which will replace the existing one.

Hagamos zoom a partir de una nueva bounding box:

bbox_zoom <- as.numeric(st_bbox(ruteo_top20))
mapa_zoom <- get_stamenmap(bbox_zoom,
                           color="bw",
                           zoom = 13)
ggmap(mapa_zoom)

ggmap(mapa_zoom)+
  geom_sf(data=ruteo_top20, aes(color=duration), size=2, inherit.aes = FALSE)+
  labs(title="Top 20 Recorridos más Realizados en Bicicleta",
       subtitle="Blue Bike - Boston",
       caption="Fuente: https://www.bluebikes.com/system-data")+
  scale_color_viridis_c(direction=-1)+
  theme_void()
## Coordinate system already present. Adding new coordinate system, which will replace the existing one.

Y mapiemos según cantidad de viajes:

ruteo_top20 <- ruteo_top20 %>%
  left_join(top_20, by=c("ORIGEN"="start_station_name", "DESTINO"="end_station_name"))
ggmap(mapa_zoom)+
  geom_sf(data=ruteo_top20, aes(color=cant_viajes, size=cant_viajes), inherit.aes = FALSE)+
  labs(title="Top 20 Recorridos más Realizados en Bicicleta",
       subtitle="Blue Bike - Boston",
       caption="Fuente: https://www.bluebikes.com/system-data")+
  scale_color_viridis_c(direction=-1)+
  theme_void()
## Coordinate system already present. Adding new coordinate system, which will replace the existing one.

Y veamos esto mismo en un mapa interactivo:

ruteo_top20 <- ruteo_top20 %>%
  mutate(RUTA = paste("Desde", ORIGEN,"hasta", DESTINO))
paleta <- c(low="gold", high= "deeppink4")

labels <- sprintf(
  "<strong>%s</strong><br/>%g km <br/>%g min",
  ruteo_top20$RUTA, round(ruteo_top20$distance, 2), round(ruteo_top20$duration, 0)
) %>% lapply(htmltools::HTML)

leaflet(ruteo_top20) %>%
  addTiles() %>%
  addProviderTiles(providers$CartoDB) %>%
  addPolylines(color = ~colorNumeric(paleta, ruteo_top20$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, ruteo_top20$distance), values = ~distance,
            title = "Distancia",
            labFormat = labelFormat(suffix = "km"),
            opacity = 0.75)

Y listo! Ahora les toca practicar a uds!

EJERCICIOS DE PRÁCTICA

  1. Elegir UNA SOLA de las siguientes opciones:

1.a. Un dataset que contenga viajes origen-destino (por ejemplo bicicletas públicas) de la Ciudad con la que están trabajando.

1.b. Un dataset que contenga servicios esenciales (hospitales, escuelas, comisarías, etc) de la Ciudad con la que están trabajando. En este caso deberán elegir un barrio cualquiera y calcular el centroide con st_centroid(). Los datos pueden ser descargados del portal open data de la ciudad y deben tener ubicación geográfica.

  1. Según la opción elegida en el punto 1, deberán:

2.a. Viajes origen-destino: Calcular los 10 recorridos más realizados, describir los resultados obtenidos y hacer un mapa con los ruteos.

2.b. Servicios esenciales: Estimar la distancia entre el centroide calculado en el punto 1 y los ítems que componen la capa descargada. Describir los resultados obtenidos y hacer un mapa con los ruteos. Para resolver este ejercicio pueden ver el siguiente ejemplo: https://elradar.github.io/2019/10/25/obteniendo-rutas-tiempo-y-distancia-de-viajes-con-open-source-routing-machine/