Utilización de Eco Bicis en CABA

Calendar plot para entender cómo fue la utilización durante el 2019

Show code

library(dplyr)
library(ggplot2)
library(lubridate)
library(tidyr)
library(biscale)
library(cowplot)
library(scales)
library(gt)

🚴 Introducción

A veces en series temporales es difícil entender cómo es el comportamiento por día de la semana o del mes por lo que hace unos días vengo probando armar 📆 Calendar Plots. Este ejemplo utiliza datos de de recorridos de EcoBicis (2019) en la Ciudad Autónoma de Buenos Aires con el objetivo de entender en qué días hubieron más viajes y cuándo fueron de mayor duración.

📊 Datos

Los datos fueron obtenidos de Recorridos de Eco Bicis durante el 2019.

Show code

df <- read.csv('https://cdn.buenosaires.gob.ar/datosabiertos/datasets/transporte/bicicletas-publicas/recorridos-realizados-2019.csv', 
               stringsAsFactors = FALSE)

df <- df %>%
  # Proxy de minutos de duración del recorrido:
  separate(duracion_recorrido, into=c('duration_dias','duration_string','duration_horas'), sep=" ") %>%
  mutate(
    duracion_minutos = 60*hour(as.POSIXct(duration_horas, format="%H:%M:%S"))+
                       minute(as.POSIXct(duration_horas, format="%H:%M:%S"))) %>%
  # Renombro variables:
  select(fecha=fecha_origen_recorrido,
         duracion = duracion_minutos) %>%
  # Formato de fecha:
  mutate(fecha = as.Date(fecha, format = "%Y-%m-%d")) %>%
  # Cantidad de viajes, duración promedio y total por fecha
  group_by(fecha) %>%
  summarise(n=n(),
            duracion_prom=mean(duracion, na.rm = TRUE),
            duracion_sum=sum(duracion, na.rm = TRUE)) %>%
  ungroup()

Inicialmente los datos incluyen la cantidad de recorridos por fecha y la duración promedio de los viajes. A continuación se muestran las primeras 5 observaciones.

Show code

df %>% 
  head(5) %>% 
  gt() %>%
  tab_header(
    title = "Recorridos Eco Bicis 2019",
    subtitle = "Fuente: GCBA") %>%
  fmt_date(
    columns = vars(fecha),
    date_style = 1
  ) %>%
  fmt_number(
    columns = vars(n, duracion_prom),
    suffixing = TRUE
  ) %>% 
  cols_label(fecha='Fecha', n='Cantidad de viajes', duracion_prom='Duracion promedio')

Recorridos Eco Bicis 2019
Fuente: GCBA
Fecha	Cantidad de viajes	Duracion promedio
2019-01-01	828.00	17.83
2019-01-02	2.78K	15.76
2019-01-03	5.08K	15.99
2019-01-04	5.86K	16.05
2019-01-05	3.79K	16.35

⚙️Procesamiento

Algunas transformaciones necesarias para realizar un calendar plot en R

Primero es necesario completar las fechas faltantes si las hubiera. Para ello, se crean las fechas completas y se unen al df.

Show code

fechas  <- tibble(fecha = seq(
  dmy("01/01/2019"),
  dmy("31/12/2019"),
  "days"
))

df <- merge(df, fechas,  by='fecha', all.x=TRUE, all.y=TRUE)

Luego se generan las variables temporales:

• Día de la semana
• Mes
• Fecha
• Semana

Show code

df <- df %>% mutate(
  weekday = wday(fecha, label = T, week_start = 7), 
  month = month(fecha, label = T),
  date = yday(fecha),
  week = epiweek(fecha)
)

La última semana de Diciembre (Dec) como 1 entonces la pasamos a 53:

Show code

df$week[df$month=="Dec" & df$week ==1] = 53

Finalmente, se genera la variable monthweek

Show code

df = df %>% 
  group_by(month) %>% 
  mutate(monthweek = 1 + week - min(week)) 

📈 Gráficos

Primero se visualiza con un 📆 Calendar Plot la cantidad de recorridos por día. Luego, comparando la evolución en cantidad de recorridos contra la duración promedio se puede ver específicamente qué pasó cada día de cada mes, y para ello se construye un Calendar Plot con Biscale, que permite añadir escala bivariada en los colores utilizados.

1. Calendar plot

Este primer Calendar Plot sólo toma en cuenta una variable numérica (cantidad de viajes por día).

Para obtener los colores a utilizar, se toman los colores incluidos en la paleta DkBlue de bi_pal.

Show code

show_col(bi_pal('DkBlue', dim = 3, preview = FALSE))

Show code

low  <- '#5AC8C8'
high <- '#BE64AC'

colores <- c(low,high)

Se genera el primer Calendar Plot con ggplot:

En los códigos ocultos se pueden ver cuestiones estéticas para mejorar los gráficos.

df %>%
  ggplot(aes(weekday,-week, fill = n)) +
  geom_tile(colour = "white") +
  labs(title='Cantidad de viajes en EcoBicis 2019')  + 
  geom_text(aes(label = day(fecha)), size = 2.5, color = "black") +
  scale_fill_gradient(low=low, high=high, na.value = 'white')+
  facet_wrap(~month, nrow = 3, ncol = 4, scales = "free")

Show code

g1 <- df %>%
  ggplot(aes(weekday,-week, fill = n)) +
  geom_tile(colour = "white") +
  labs(title='Cantidad de viajes en EcoBicis 2019')  + 
  geom_text(aes(label = day(fecha)), size = 2.5, color = "black") +
  scale_fill_gradient(low=low, high=high, na.value = 'white')+
  facet_wrap(~month, nrow = 3, ncol = 4, scales = "free") +
  theme(aspect.ratio = 1/2,
        legend.position = "none",
        legend.key.width = unit(3, "cm"),
        axis.title.x = element_blank(),
        axis.title.y = element_blank(),
        axis.text.y = element_blank(),
        axis.text.x = element_text(size=7),
        panel.grid = element_blank(),
        axis.ticks = element_blank(),
        panel.background = element_blank(),
        legend.title.align = 0.5,
        strip.background = element_blank(),
        strip.text = element_text(face = "bold", size = 15),
        panel.border = element_rect(colour = "grey", fill=NA, size=1),
        plot.title = element_text(hjust = 0, size = 14, face = "bold",
                                  margin = margin(0,0,0.5,0, unit = "cm"))
        
  )

ggdraw() +
  draw_plot(g1, x=0, y=0, width=1, height = 0.8)

2. Evolución

Se visualizan las series de cantidad de recorridos y duración promedio. Se observa cierta estacionalidad semanal.

df %>% 
  filter(!is.na(fecha) & !is.na(duracion_prom)) %>% 
  ggplot(aes(x=fecha, y=duracion_prom, group=1))+
    geom_path(color=colores[2], size=1)+
    geom_line(aes(y = n/1000), color = colores[1], size=1) + 
    scale_y_continuous(name = "Duración promedio (minutos)", 
                       sec.axis = sec_axis(~.*1000, name = "Cantidad")) + 
    labs(x='', title='Duración y cantidad de viajes en EcoBicis en 2019')

Show code

g2 <- df %>% 
  filter(!is.na(fecha) & !is.na(duracion_prom)) %>% 
  ggplot(aes(x=fecha, y=duracion_prom, group=1))+
    geom_path(color=colores[2], size=1)+
    geom_line(aes(y = n/1000), color = colores[1], size=1) + 
    scale_y_continuous(name = "Duración promedio (minutos)", 
                       sec.axis = sec_axis(~.*1000, name = "Cantidad")) + 
    labs(x='', title='Duración y cantidad de viajes en EcoBicis en 2019')+
  theme(aspect.ratio = 1/2,
        legend.position = "none",
        panel.grid = element_blank(),
        axis.ticks = element_blank(),
        axis.text.y.right=element_text(colour=colores[1]),
        axis.title.y.right=element_text(colour=colores[1], size=10),
        axis.text.y=element_text(colour=colores[2]),
        axis.title.y=element_text(colour=colores[2], size=10),
        panel.background = element_blank(),
        strip.background = element_blank(),
        strip.text = element_text(face = "bold", size = 15),
        panel.border = element_rect(colour = "grey", fill=NA, size=1),
        plot.title = element_text(hjust = 0.5, size = 21, face = "bold",
                                  margin = margin(0,0,0.5,0, unit = "cm"))) 


g2

3. Calendar Plot con Biscale

Para sumar 2 variables en un mismo Calendar Plot se utiliza bi_class para generar los datos en ese formato.

data_biscale <- bi_class(df %>% filter(!is.na(duracion_prom) & !is.na(n)), 
                         x='n',
                         y='duracion_prom', 
                         style="quantile",dim=3)

Show code

data_biscale %>% 
  ungroup() %>% select(-weekday, -date, -week, -monthweek, -month) %>% 
  head(5) %>% 
  gt() %>%
  tab_header(
    title = "Datos con escala bivariada") %>% 
  fmt_date(
    columns = vars(fecha),
    date_style = 1
  ) %>%
  fmt_number(
    columns = vars(n, duracion_prom),
    suffixing = TRUE
  ) %>% 
  cols_label(
    fecha='Fecha', 
    n='Cantidad', 
    duracion_prom='Duracion promedio', 
    bi_class='Escala Bivariada'
  )

Datos con escala bivariada
Fecha	Cantidad	Duracion promedio	Escala Bivariada
2019-01-01	828.00	17.83	1-1
2019-01-02	2.78K	15.76	1-1
2019-01-03	5.08K	15.99	1-1
2019-01-04	5.86K	16.05	1-1
2019-01-05	3.79K	16.35	1-1

Luego es posible generar el Calendar Plot utilizando esos datos, con fill según la variable bi_class.

data_biscale %>%
  filter(!is.na(fecha)) %>% 
  ggplot(aes(weekday,-week, fill = bi_class)) +
  geom_tile(colour = "white")  + 
  geom_text(aes(label = day(fecha)), size = 2.5, color = "black") +
  bi_scale_fill(pal = "DkBlue", dim = 3) +
  facet_wrap(~month, nrow = 3, ncol = 4, scales = "free") 

Es necesario también generar un objeto legend, para identificar las escalas de colores en el gráfico:

legend <- bi_legend(pal = "DkBlue",
                    dim = 3,
                    xlab = "Cantidad",
                    ylab = "Duración promedio",
                    size = 7)

Visualizando el Calendar Plot se observa qué días de la semana hubo más uso y cómo fue la duración de los recorridos

Show code

ggdraw() +
  draw_plot(g1, x=0, y=0, width=1, height = 0.8) +
  draw_plot(legend, x=0.8, y=0.78, width=0.2, height=0.2)+
  draw_label(x=0.01,y=0.95, hjust=0, color = "black", size = 16,
             ' Cantidad y duración de viajes en EcoBicis (2019)')+
  draw_label(x=0.01, y=0.85, hjust=0, color='grey', size=12,
             ' Los colores representan mayor cantidad/duración en base a la escala 
             \n de la derecha, donde cada variable está dividida en 3 cuantiles')+
  draw_label(x=0.7, y=0.02, color='grey', size=12,
             'Elaboración propia en base a datos del GCBA, @karbartolome')

4. Uniendo los gráficos

Finalmente, se unen ambos gráficos en una misma imágen y se guarda como png.

Show code

g <- ggdraw() +
  draw_plot(g1, x=0, y=0.29, width=1, height = 0.5, hjust=0) +
  draw_plot(legend, x=0.8, y=0.84, width=0.18, height=0.18)+
  draw_plot(g2, x=0, y=0, width=1, height=0.29, hjust=0)+
  draw_label(x=0.01,y=0.95, hjust=0, color = "black", size = 16,
             ' Cantidad y duración de viajes en EcoBicis (2019)')+
  draw_label(x=0.01, y=0.87, hjust=0, color='grey', size=12,
             'Los colores representan mayor cantidad/duración en base a la escala 
             \n de la derecha, donde cada variable está dividida en 3 cuantiles')+
  draw_label(x=0.7, y=0.02, color='grey', size=12,
             'Elaboración propia en base a datos del GCBA, @karbartolome')

ggsave("biscale-calendarplot.png", plot=last_plot(), width = 22, height = 22, units = "cm")