Un heatmap como calendario

Recientemente buscaba una representación visual para mostrar los cambios diarios de la temperatura, precipitación y el viento en una aplicación xeo81.shinyapps.io/MeteoExtremosGalicia, lo que me llevó a usar un heatmap en forma de calendario. La aplicación shiny se actualiza cada cuatro horas con nuevos datos mostrando calendarios de cada estación meteorológica. El heatmap como calendario permite visualizar cualquier variable con una referencia temporal diaria.

Paquetes

En este post usaremos los siguientes paquetes:

Paquete Descripción
tidyverse Conjunto de paquetes (visualización y manipulación de datos): ggplot2, dplyr, purrr,etc.
lubridate Fácil manipulación de fechas y tiempos
ragg Salidas gráficas para R basados en la librería AGG
# instalamos los paquetes si hace falta
if(!require("tidyverse")) install.packages("tidyverse")
if(!require("ragg")) install.packages("ragg")
if(!require("lubridate")) install.packages("lubridate")

# paquetes
library(tidyverse)
library(lubridate)
library(ragg)

Para aquellos con menos experiencia con tidyverse, recomiendo una breve introducción en este blog post.

Datos

En este ejemplo usaremos la precipitación diaria de Santiago de Compostela de este año 2020 (hasta el 20 de diciembre) descarga.

# importamos los datos
dat_pr <- read_csv("precipitation_santiago.csv")
dat_pr
## # A tibble: 355 x 2
##    date          pr
##    <date>     <dbl>
##  1 2020-01-01   0  
##  2 2020-01-02   0  
##  3 2020-01-03   5.4
##  4 2020-01-04   0  
##  5 2020-01-05   0  
##  6 2020-01-06   0  
##  7 2020-01-07   0  
##  8 2020-01-08   1  
##  9 2020-01-09   3.8
## 10 2020-01-10   0  
## # ... with 345 more rows

Preparación

En el primer paso debemos 1) complementar la serie temporal desde el 21 al 31 de diciembre con NA, 2) añadir el día de la semana, el mes, el número de la semana y el día. En función de si queremos que cada semana comience por Domingo o Lunes debemos indicarlo en la función wday().

dat_pr <- dat_pr %>% 
          complete(date = seq(ymd("2020-01-01"), 
                              ymd("2020-12-31"), 
                              "day")) %>%
          mutate(weekday = wday(date, label = T, week_start = 1), 
                 month = month(date, label = T, abbr = F),
                 week = isoweek(date),
                 day = day(date))

En el siguiente paso corregimos las etiquetas de los días de la semana, es un bug dentro del paquete lubridate. Además debemos hacer un cambio en la semana del año, lo que se debe a que en ciertos años pueden quedar, por ejemplo, unos días al final de año como primera semana del siguiente año. También creamos dos nuevas columnas. Por una parte, categorizamos la precipitación en 14 clases y por otra definimos un color de texto blanco para tonos más oscuros.

dat_pr <- mutate(dat_pr, 
                 weekday = factor(weekday, 
                                  levels(weekday),
                                  str_sub(levels(weekday), 1, 2)),
                 week = case_when(month == "diciembre" & week == 1 ~ 53,
                                  month == "enero" & week %in% 52:53 ~ 0,
                                  TRUE ~ week),
                 pcat = cut(pr, c(-1, 0, .5, 1:5, 7, 9, 15, 20, 25, 30, 300)),
                 text_col = ifelse(pcat %in% c("(15,20]", "(20,25]", "(25,30]", "(30,300]"), 
                                   "white", "black")) 
      
dat_pr  
## # A tibble: 366 x 8
##    date          pr weekday month  week   day pcat    text_col
##    <date>     <dbl> <ord>   <ord> <dbl> <int> <fct>   <chr>   
##  1 2020-01-01   0   mi      enero     1     1 (-1,0]  black   
##  2 2020-01-02   0   ju      enero     1     2 (-1,0]  black   
##  3 2020-01-03   5.4 vi      enero     1     3 (5,7]   black   
##  4 2020-01-04   0   sá      enero     1     4 (-1,0]  black   
##  5 2020-01-05   0   do      enero     1     5 (-1,0]  black   
##  6 2020-01-06   0   lu      enero     2     6 (-1,0]  black   
##  7 2020-01-07   0   ma      enero     2     7 (-1,0]  black   
##  8 2020-01-08   1   mi      enero     2     8 (0.5,1] black   
##  9 2020-01-09   3.8 ju      enero     2     9 (3,4]   black   
## 10 2020-01-10   0   vi      enero     2    10 (-1,0]  black   
## # ... with 356 more rows

Visualización

Primero creamos una rampa de color a partir de colores Brewer.

# rampa de color
pubu <- RColorBrewer::brewer.pal(9, "PuBu")
col_p <- colorRampPalette(pubu)

Antes de construir el gráfico definimos un estilo personalizado como función. Para ello, especificamos todos los elementos y sus modificaciones con ayuda de la función theme().

theme_calendar <- function(){

 theme(aspect.ratio = 1/2,
       
       axis.title = element_blank(),
       axis.ticks = element_blank(),
       axis.text.y = element_blank(),
       axis.text = element_text(family = "Montserrat"),
       
       panel.grid = element_blank(),
       panel.background = element_blank(),
       
       strip.background = element_blank(),
       strip.text = element_text(family = "Montserrat", face = "bold", size = 15),
       
       legend.position = "top",
       legend.text = element_text(family = "Montserrat", hjust = .5),
       legend.title = element_text(family = "Montserrat", size = 9, hjust = 1),
       
       plot.caption =  element_text(family = "Montserrat", hjust = 1, size = 8),
       panel.border = element_rect(colour = "grey", fill=NA, size=1),
       plot.title = element_text(family = "Montserrat", hjust = .5, size = 26, 
                                 face = "bold", 
                                 margin = margin(0,0,0.5,0, unit = "cm")),
       plot.subtitle = element_text(family = "Montserrat", hjust = .5, size = 16)
  )
}

Finalmente, creamos el gráfico usando geom_tile() y especificamos como eje X el día de la semana y como eje Y el número de la semana. Como podéis observar en la variable de la semana (-week) cambio el signo con el objetivo de que el primer día de cada mes este en la primera fila. Con geom_text() añadimos el número de cada día con su color según lo que definimos anteriormente. En guides hacemos los ajustes de la barra de color y en scale_fill/colour_manual() definimos los colores correspondientes. Un importante paso lo encontramos en facet_wrap() donde especificamos las facetas de cada mes. Las facetas deben tener escalas libres y lo óptimo sería una distribución de 4x3 facetas. Es posible modificar la posición del número de día a otra posición usando los argumentos nudge_* en geom_text() (por ej. esquina abajo derecha: nudge_x = .35, nudge_y = -.25).

    ggplot(dat_pr, 
           aes(weekday, -week, fill = pcat)) +
      geom_tile(colour = "white", size = .4)  + 
      geom_text(aes(label = day, colour = text_col), size = 2.5) +
      guides(fill = guide_colorsteps(barwidth = 25, 
                                     barheight = .4,
                                    title.position = "top")) +
       scale_fill_manual(values = c("white", col_p(13)),
                         na.value = "grey90", drop = FALSE) +
       scale_colour_manual(values = c("black", "white"), guide = FALSE) + 
       facet_wrap(~ month, nrow = 4, ncol = 3, scales = "free") +
       labs(title = "¿Cómo está siendo el 2020 en Santiago?", 
             subtitle = "Precipitación",
             caption = "Datos: Meteogalicia",
             fill = "mm") +
       theme_calendar()

Para exportar haremos uso del paquete ragg, que proporciona mayor rendimiento y mayor calidad que los dispositivos ráster estándar proporcionados por grDevices.

ggsave("pr_calendar.png", height = 10, width = 8, device = agg_png())

En otros calendarios he añadido la dirección predominante del viento de cada día como flecha usando geom_arrow() del paquete metR (se puede ver en la mencionada aplicación).

Buy Me A Coffee

Dr. Dominic Royé
Dr. Dominic Royé
Investigador postdoctoral senior

Relacionado