Movilidad urbana-digital

El arquitecto Jean Nouvel define a las ciudades como el lugar de la concreción de las relaciones humanas, el de los encuentros y los intercambios. Así, una de las características principales es la de estar en continuo movimiento. Estudiar, trabajar, pasear, comprar, manifestarse, comer, encontrarse con otros implica trasladarse de un punto a otro, moverse. Y el modo en que nos movemos a lo largo y a lo ancho habla de la ciudad y habla de nosotros (quienes habitamos la ciudad). Vivimos en un contexto de exponencial digitalización de nuestras vidas, donde prácticamente todo lo que hacemos tiene una huella digital, un dato. Esta tendencia está siendo acompañada de una creciente disponibilidad de datos, tanto desde gobiernos como de empresas. Hoy estamos inundados de datos que hacen que nuestra capacidad para analizar, entender y comprender nuestra vida en las ciudades sea increiblemente enorme.

Un sistema, millones de viajes

Uno de los datos más valiosos, y codiciados, para analizar la dinámica de movilidad urbana son los que surgen del uso del sistema SUBE. ¿Quién no se toma el bondi, tren o subte en su día a día? Millones y millones de huellas digitales que hablan sobre nuestro modo de movernos por la ciudad. Para el Hackaton de Datos Urbanos organizado por el Gobierno de la Ciudad Autónoma de Buenos Aires Nación Servicios (operador de SUBE) liberó un dataset que contiene transacciones SUBE promedio por hora, modo y día a nivel radio censal. Wow!

library(data.table)
library(sf)
library(tidyverse)
library(gganimate)
library(ggplot2)
library(viridis)
library(gifski)
library(osmdata)
library(ggmap)
library(leaflet)
options(scipen=999)

sube <- fread("C:/Users/20332842324/Desktop/hackaton/ext_dataton_v1.csv")
radios <- read_sf("C:/Users/20332842324/Desktop/hackaton/sh_caba_rc/sh_caba_rc.shp")

sube <- sube %>% 
  rename(link=ID_RADIO) %>% 
  mutate(DIA=case_when(grepl(1,DIA_SEMANA)~"LUNES",
                      grepl(2,DIA_SEMANA)~"MARTES",
                      grepl(3,DIA_SEMANA)~"MIÉRCOLES",
                      grepl(4,DIA_SEMANA)~"JUEVES",
                      grepl(5,DIA_SEMANA)~"VIERNES",
                      grepl(6,DIA_SEMANA)~"SÁBADO",
                      grepl(7,DIA_SEMANA)~"DOMINGO"))

radios <- radios %>% 
  mutate(link=as.integer(link))


#Transacciones por día y modo
sube_dia_modo <-  sube %>%
  filter(MES==201711) %>% 
  group_by(MODO,DIA,DIA_SEMANA) %>% 
  summarise(total = sum(NTRX_PROM))


#Transacciones totales por dia
sube_dia <- sube_dia_modo %>% 
  group_by(DIA_SEMANA,DIA) %>% 
  summarise(total_dia=sum(total))

sube_dia <- sube_dia %>%  
  mutate(pct_dia=(total_dia*100)/sum(sube_dia$total_dia))

ggplot(data=sube_dia_modo,
       aes(x=reorder(DIA,DIA_SEMANA),
           y=total,
           fill=MODO))+
  geom_col()+
  labs(title = "Cantidad de transacciones SUBE por día y modo",
         subtitle = "Ciudad Autónoma de Buenos Aires - 2018",
         x = "Día",
         y = "Cantidad transacciones")+
  theme_minimal()

sube_dia

## # A tibble: 7 x 4
## # Groups:   DIA_SEMANA [7]
##   DIA_SEMANA DIA       total_dia pct_dia
##        <int> <chr>         <dbl>   <dbl>
## 1          1 LUNES      3993379.   13.1 
## 2          2 MARTES     5475134    17.9 
## 3          3 MIÉRCOLES  5474376    17.9 
## 4          4 JUEVES     5329617.   17.4 
## 5          5 VIERNES    5611302.   18.4 
## 6          6 SÁBADO     2926936.    9.58
## 7          7 DOMINGO    1750110.    5.73

sum(sube_dia$total_dia)

## [1] 30560855

En una semana se realizan un promedio de 30 millones de transacciones entre colectivo, subte y tren! La distribución es medianamante la esperada, con más transacciones los días de semana que los fines de semana. De todos modos llama la atención la baja en los días lunes (13% del total), lo cual podría deberse a gente que se queda a dormir en la Provincia durante el fin de semana y retorna el lunes a trabajar por lo que ese día su viaje de SUBE no se origina dentro de Capital Federal. Luego la cantidad se estabiliza alrededor del 18% por día, baja al 9% los sábados y al 5% los domingos como es de esperar.

En cuanto a la distribución modal la misma se mantiene estable de lunes a viernes alrededor del 62%, subiendo levemente los sábados, mientras que los domingos prácticamente que 1/4 de los viajes en CABA es en el colectivo. El modo que más terreno pierde los domingos es el subte, medio de transporte más caracterizado por su uso laboral (por su fuerte conexión con el microcentro portaño).

ggplot(data=sube_dia_modo,
       aes(x=reorder(DIA,DIA_SEMANA),
           y=total,
           fill=MODO,
           label=total))+
  geom_col(position="fill")+
  labs(title = "Distribución de transacciones SUBE por día y modo",
         subtitle = "Ciudad Autónoma de Buenos Aires - 2018",
         x = "Día",
         y = "Porcentaje transacciones")+
  theme_minimal()

De la casa al trabajo, del trabajo a casa

El ritmo de las transacciones SUBE está marcado por el horario laboral, con picos durante la mañana (7-9h) y la tarde (18-20) y un leve rebote al mediodía durante los días de semana. El tren tiene un comportamiento “anomalo”, con sostenido crecimiento hasta lograr su pico durante la tarde pero esto se debe a que sólo estamos teniendo en cuenta las transacciones realizadas dentro de los límites de Capital, excluyéndo así a todas las personas que se toman el tren a la mañana en la Provincia para trasladarse a la Ciudad. Los sábadps el crecimiento es algo más lento y tiene su pico al mediodía para luego descender, mientras que los domingos el pico se da a la tarde. La causa de esto podría ser un uso más recreacional del transporte público en estos días.

#Nos quedamos solo con las transacciones de la semana
sube_dia_hora_modo <- sube %>% 
  group_by(MODO,HORA,DIA,MES,DIA_SEMANA) %>% 
  summarise(total = sum(NTRX_PROM))

#Hacemos promedio de transacciones para días de la semana
sube_dia_hora_modo_2 <-  sube_dia_hora_modo %>% 
  group_by(MODO,HORA,DIA,DIA_SEMANA) %>% 
  summarise(total = mean(total)) %>% 
  arrange(DIA_SEMANA)

#Creo variables nuevas para los titulos del gráfico
dia.labs <- c("LUNES", "MARTES","MIÉRCOLES","JUEVES","VIERNES","SÁBADO","DOMINGO")
names(dia.labs) <- c("1", "2","3","4","5","6","7")

sube_hora_gif <- ggplot(data=sube_dia_hora_modo_2,aes(HORA,total,color=MODO)) + 
  geom_line()+
  facet_wrap(~DIA_SEMANA,labeller = labeller(DIA_SEMANA = dia.labs))+
  labs(title = "Distribución de transacciones SUBE por día, hora y modo",
         subtitle = "Ciudad Autónoma de Buenos Aires - 2018",
         x = "Hora",
         y = "Cantidad transacciones")+
  theme_minimal()+
  transition_reveal(HORA)
  
anim_save("sube_hora.gif", sube_hora_gif)

La ciudad al ritmo de la SUBE

Poder situar estos patrones temporales en el espacio nos permitirá ver con mayor claridad cómo late la ciudad al ritmo de la SUBE. Como habíamos dicho al principio los datos están desagregados a nivel radio censal, unidades geográficas que aproximadamente agrupan en promedio 300 viviendas. La Ciudad tiene algo así como 3553 radios censales, algunos muy grandes como el de Costanera Norte y otro muy chicos como en el Microcentro.

En primer lugar veamos cómo se distribuyen las transacciones a lo largo de los radios censales. Hacemos un promedio de transacciones para el día lunes.

#Hacemos mapa con los datos de un lunes cualquiera
sube_lun <- sube %>% 
  filter(DIA_SEMANA==1) %>% 
  filter(MES==201711) %>% 
  group_by(HORA,link) %>% 
  summarise(total = sum(NTRX_PROM))

#Hacemoos el promedio diario de transacciones en cada radio
sube_lun_prm <- sube_lun %>% 
  group_by(link) %>% 
  summarise(promedio=mean(total))

#Histograma para ver cómo es la distribución de la columna total
ggplot()+
  geom_histogram(data=sube_lun_prm,aes(x=promedio))

La distribución de cantidad de transacciones está muy concentrada. Hay muchos radios que tienen, en promedio, entre 0 y 1500 transacciones diarias, después hay uno que tiene más de 10.000. Esto nos va a jugar una mala pasada al querer ver los valores en el mapa. Suavizamos la distribución creando una variable que sea el logaritmo del promedio de viajes diarios por radio.

#Reconvertimos la columna total a escala log para suavizar su distribución
sube_lun_prm <- sube_lun_prm %>%
  filter(!(is.na(promedio))) %>% 
  mutate(prom_log=log(promedio))

#Vemos como queda el histograma del log de total
ggplot()+
  geom_histogram(data=sube_lun_prm,aes(x=prom_log))

Ahora que quedo una distribución más aceptable pasamos a mapear los resultados. Aprovechamos la librería leaflet para hacer un mapa intercativo.

#Join radios
sube_lun_prm_radio <-left_join(radios,sube_lun_prm)

#Definimos la paleta de colores
binpal <- colorBin("inferno", sube_lun_prm$prom_log, 6, pretty = FALSE)

leaflet() %>% 
  setView(lng = -58.446216, lat = -34.615766, zoom = 12) %>% 
  addTiles() %>% 
  addPolygons(data=sube_lun_prm_radio, stroke=FALSE, smoothFactor = 0.2, fillOpacity = .8,
    color = ~binpal(prom_log),popup=paste(sube_lun_prm_radio$link,"<br>",sube_lun_prm_radio$barrio,"<br>",
                                          "Transacciones promedio:",sube_lun_prm_radio$promedio,sube_lun_prm_radio$link,"<br>")) %>% 
  addProviderTiles(providers$CartoDB.Positron)

En primer lugar se destacan Once, Constitución, Retiro, todas cabeceras de líneas de tren, lo cual no sorprende para nada. En menor medida Microcentro (zona Obelisco), Chacarita, Liniers, Flores, Plaza Italia y Ciudad Universitaria tienen un gran caudal de viajes en promedio.

Pero los radios censales nos pueden jugar una mala pasada ya que su superficie desigual hace que nuestra atención se desvíe inmediatamente a polígonos más extensos (Costanera Norte y Sur por ejemplo), captando la atención por sobre otros a priori más importantes (como Constitución, que es muy chico pero el que más transacciones tiene).

Por eso tal vez es mejor convertir los radios censales a centroides y asi mostrar la misma información pero de un modo distinto y más entendible por el usuario. Además podemos seguir aprovechando la librería gganimate para hacer gifs, algo que a todos nos encanta, o no?

#Extraemos centroides de radios
radios_c <- st_point_on_surface(radios)

#Join radios
sube_lun_radio_c <-left_join(radios_c,sube_lun)

#Extraigo las lat/long de la columna geometry y creamos variable con log de total
sube_lun_radio_c <- sube_lun_radio_c %>% 
  mutate(x=st_coordinates(sube_lun_radio_c)[,1]) %>% 
  mutate(y=st_coordinates(sube_lun_radio_c)[,2]) %>% 
  mutate(HORA=as.numeric(HORA)) %>% 
  mutate(total_log=log(total))

#BoundingBox de CABA
bbox <- getbb("Ciudad Autónoma de Buenos Aires,Argentina")
CABA <- get_stamenmap(bbox = bbox,
                      maptype = "toner-background",zoom=13)

mapa_gif <- ggmap(CABA)+
  geom_point(data=sube_lun_radio_c,aes(x = x, y = y, size = total,color=total_log),show.legend = FALSE) +
  scale_colour_viridis_c(option="inferno",guide=FALSE)+
  transition_states(HORA,transition_length = 0,state_length = 0.05)+
  enter_fade() + 
  exit_shrink() +
  ease_aes('sine-in-out')+
  ggtitle('Transacciones SUBE: Ciudad de Buenos Aires',
          subtitle='{closest_state} hs.' )+
  guides(fill=FALSE)+
  scale_size_continuous(range = c(1,30))

anim_save("mapa_hora.gif", mapa_gif)

Ahí va queriendo más. La ciudad late al ritmo de la SUBE. Explota (¿de amor?) en Constitución, Retiro y los lugares ya antes destacados pero ahora el patrón es más claro. Además permite ver con mayor detalle el corredor Rivadavia como un gran concentrados de transacciones.

Zoom

Sigamos indagando un poco más y miremos cómo varían las transacciones hora a hora en los 3 lugares más destacados: Constitución, Retiro y Once.

#Filtramos con los radios de Constitución, Once y Retiro para transacciones de lunes
sube_centralidades_lun <- sube %>% 
  filter(DIA_SEMANA==1) %>% 
  filter(MES==201711) %>% 
  filter(link==20012708 | link==20030906 | link==20030910 | link==20031001 | link==20010321 | link==20010702  ) %>%
  mutate(centralidad=case_when(grepl(20012708,link) ~ "CONSTITUCIÓN",grepl(20030906,link) | grepl(20030910,link) |  
  grepl(20031001,link)~"ONCE",TRUE ~ "RETIRO")) %>% 
  group_by(HORA,MODO,centralidad) %>% 
  summarise(total = sum(NTRX_PROM)) %>% 
  mutate(dia="LUNES")


ggplot(data=sube_centralidades_lun,aes(HORA,total,color=MODO)) + 
  geom_line()+
  facet_wrap(~centralidad)+
  labs(title = "Cantidad de transacciones SUBE por hora y modo los Lunes",
         subtitle = "Constitución, Once y Retiro - CABA - 2018",
         x = "Hora",
         y = "Cantidad transacciones")+
  theme_minimal()

#Filtramos con los radios de Constitución, Once y Retiro para transacciones de sábado
sube_centralidades_sab <- sube %>% 
  filter(DIA_SEMANA==6) %>% 
  filter(MES==201711) %>% 
  filter(link==20012708 | link==20030906 | link==20030910 | link==20031001 | link==20010321 | link==20010702  ) %>%
  mutate(centralidad=case_when(grepl(20012708,link) ~ "CONSTITUCIÓN",grepl(20030906,link) | grepl(20030910,link) |  
  grepl(20031001,link)~"ONCE",TRUE ~ "RETIRO")) %>% 
  group_by(HORA,MODO,centralidad) %>% 
  summarise(total = sum(NTRX_PROM)) %>% 
  mutate(dia="SÁBADO")

#Filtramos con los radios de Constitución, Once y Retiro para transacciones de domingo
sube_centralidades_dom <- sube %>% 
  filter(DIA_SEMANA==7) %>% 
  filter(MES==201711) %>% 
  filter(link==20012708 | link==20030906 | link==20030910 | link==20031001 | link==20010321 | link==20010702  ) %>%
  mutate(centralidad=case_when(grepl(20012708,link) ~ "CONSTITUCIÓN",grepl(20030906,link) | grepl(20030910,link) |  
  grepl(20031001,link)~"ONCE",TRUE ~ "RETIRO")) %>% 
  group_by(HORA,MODO,centralidad) %>% 
  summarise(total = sum(NTRX_PROM)) %>% 
  mutate(dia="DOMINGO")

sube_centralidades_finde <- rbind(sube_centralidades_dom, sube_centralidades_sab)

ggplot(data=sube_centralidades_finde,aes(HORA,total,color=MODO)) + 
  geom_line()+
  facet_wrap(dia~centralidad)+
  labs(title = "Cantidad de transacciones SUBE por hora y modo los Sábados y Domingo",
         subtitle = "Constitución, Once y Retiro - CABA - 2018",
         x = "Hora",
         y = "Cantidad transacciones")+
  theme_minimal()