#30diasdegraficos Parte 2

La segunda parte, A seguir aprendiendo sobre todas las posibilidades que highcharts a través de R nos puede brindar.

spanish
highcharts
data-visualization
ggplot2
Author

Joshua Kunst Fuentes

Published

May 22, 2020

Modified

March 26, 2024

Introducción

Seguiremos utilizando los mismos paquetes que la parte anterior.

Code
# ejecutar estas líneas para poder instalar {datos}
# install.packages("remotes")
# remotes::install_github("cienciadedatos/datos")

library(datos)       # datos
library(highcharter) # gráficos
library(ggplot2)     # más gráficos  
library(dplyr)       # manipulación de datos
library(tidyr)       # más manipulación de datos

Cambiando configuración para el español.

Code
newlang_opts <- getOption("highcharter.lang")

f <- Sys.Date()
dias <- weekdays((f - lubridate::days(lubridate::wday(f) - 1)) + lubridate::days(0:6))

newlang_opts$weekdays <- dias
newlang_opts$months <- as.character(lubridate::month(1:12, label = TRUE, abbr = FALSE))
newlang_opts$shortMonths <- as.character(lubridate::month(1:12, label = TRUE, abbr = TRUE))
newlang_opts$thousandsSep <- ","

options(highcharter.lang = newlang_opts)

Día 11: mapas de calor

Mapa de calor. Usualmente se utiliza para visualizar relaciones entre dos variables categorícas (o 2 contínuas categorizandolas). En este ejemplo utilizaremos día y hora como una variables “numericas discretas”.

Caso de heatmaps son los visualizar distancia entre observaciones/individuos.

Code
mtautos2 <- mtautos[1:20, ]
matriz_distancias <- dist(mtautos2)

hchart(matriz_distancias) %>% 
  hc_title(text = "Distancia entre características de los vehículos")

Y también explorar correlaciones:

Code
hchart(cor(mtautos))

Medio/Avanzado. Es la implementación de este ejemplo https://www.highcharts.com/demo/heatmap-canvas. Notar la relación de opciones en HighchartsJS y {highcharter}.

Code
# install.packages("aimsir17")
library(lubridate)

data(observations, package = "aimsir17")

temperaturas <- observations %>% 
  filter(station == "KNOCK AIRPORT") %>% 
  select(fecha = date, hora = hour, temperatura = temp) %>% 
  mutate(fecha = as.Date(fecha))

# temperaturas %>% 
#   count(fecha, hora) %>% 
#   count(n)

hc11 <- hchart(
  temperaturas,
  "heatmap",
  hcaes(datetime_to_timestamp(fecha), hora, value = temperatura),
  colsize =  36e5 * 24 # 1 hour * 24 = 1 day
  ) %>%
  hc_title(text = "Temperaturas del aeropuerto Knock") %>%
  hc_subtitle(text = "Datos obtenidos del paquete {aimsir17}.") %>%
  hc_chart(zoomType = "x") %>%
  hc_xAxis(
    type = "datetime",
    title = list(text = FALSE),
    showLastLabel = FALSE
    ) %>%
  hc_yAxis(
    minPadding = 0,
    maxPadding = 0,
    startOnTick = FALSE,
    endOnTick = FALSE,
    tickPositions = list(0, 6, 12, 18, 24),
    tickWidth = 1,
    min = 0,
    max = 23,
    reversed = TRUE,
    labels = list(format = "{value}:00"),
    title = list(text = FALSE)
  ) %>%
  hc_tooltip(
    headerFormat = "Temperatura<br/>",
    pointFormat =  "{point.x:%e %b, %Y} {point.y}:00: <b>{point.value} ℃</b>"
  ) %>%
  hc_colorAxis(
    stops = color_stops(10, colors = scales::viridis_pal(option = "B")(10)),
    # fuerza a utilzar mejor el espectro de colores para que HJS no amplie el
    # eje para tener numero "redondos
    startOnTick = FALSE,
    endOnTick =  FALSE
  ) %>%
  hc_legend(
    align = "right",
    layout = "vertical",
    verticalAlign = "top"
   )

hc11

Día 12: paleta (lollipop)

Gráfico que se utiliza en forma general para describir una variable numérica para un set de individuos/registros (a diferencia de gráfico de barra que usualmente se utiliza sumando cantidades por categoría).

Los datos a utilizar son mtautos del paquete {datos} pero pasando algunas variables a las métricas que usualemente utilizamos: libras a kilos, pulgadas cúbicas a centímeotrs cúbicos, etc.

Code
mtautos2 <- as_tibble(mtautos) %>% 
  mutate(auto = rownames(mtautos)) %>% 
  arrange(desc(caballos)) %>% 
  mutate(
    auto = forcats::fct_inorder(factor(auto)),
    peso_kg = round(0.4535923 * peso * 1000),
    cilindrada_cc = round(16.387 * cilindrada)
    ) 
  
mtautos2
# A tibble: 32 × 14
   millas cilindros cilindrada caballos   eje  peso velocidad forma transmision
    <dbl>     <dbl>      <dbl>    <dbl> <dbl> <dbl>     <dbl> <dbl>       <dbl>
 1   15           8       301       335  3.54  3.57      14.6     0           1
 2   15.8         8       351       264  4.22  3.17      14.5     0           1
 3   14.3         8       360       245  3.21  3.57      15.8     0           0
 4   13.3         8       350       245  3.73  3.84      15.4     0           0
 5   14.7         8       440       230  3.23  5.34      17.4     0           0
 6   10.4         8       460       215  3     5.42      17.8     0           0
 7   10.4         8       472       205  2.93  5.25      18.0     0           0
 8   16.4         8       276.      180  3.07  4.07      17.4     0           0
 9   17.3         8       276.      180  3.07  3.73      17.6     0           0
10   15.2         8       276.      180  3.07  3.78      18       0           0
# ℹ 22 more rows
# ℹ 5 more variables: cambios <dbl>, carburadores <dbl>, auto <fct>,
#   peso_kg <dbl>, cilindrada_cc <dbl>

La implementación en {highcharter} es directa, solamente usar el mapeo de name para la variable categórica y low para la numérica (low dado que esta es una modificación del gráfico de dumbbell que utiliza además high).

Basico/Medio. En esta oportunidad haremos un tooltip de tipo tabla con el fin de mostrar más información que los HP de cada vehículo. Para esto usaremos la función auxiliar tooltip_table en el argumento pointFormat.

Code
x <- c("Caballos:", "Peso", "Cilindrada")
y <- c(
  "{point.y} HP",
  "{point.peso_kg} kg",
  "{point.cilindrada_cc} cc"
)

hc12 <- hchart(mtautos2, "lollipop", hcaes(name = auto, low = caballos), name = "caballos (HP)") %>% 
  hc_xAxis(type = "category") %>% 
  hc_yAxis(labels = list(format = "{value} HP")) %>% 
  hc_tooltip(
    useHTML = TRUE,
    pointFormat = tooltip_table(x, y)
    ) %>% 
  hc_title(
    text = "Caballos de fuerza para autómóviles de Motor Trend"
  ) %>% 
  hc_subtitle(
    text = "Los datos fueron extraídos de la revista Motor Trend de Estados 
    Unidos de 1974, y tiene datos de consumo de combustible y 10 aspectos de diseño 
    y rendimiento para 32 automóviles (modelos de 1973-1974)."
  )

hc12

Día 13: visualizar datos temporales

Notar que el último gráfico del día 11 es un caso particular de de visualizar datos temporales.

Usualmente en R los datos temporales o serie de tiempo vienen en un objecto de clase ts (time series) que básicamente son valores numéricos asociado a una fecha (o índice). Notar que también datos temporales pueden perfectamente almacenarse en un data.frame, nota los datos observations del día 11.

Para grafica objectos de clase ts en {highcharter} es bastante directo dado que hchart es una función genérica. Esto significa que la función dependiendo de la clase del objeto la interpretará/graficará de la forma que corresponde. Por ejemplo ts y data.frame son clases que la función hchart reconoce, y existen muuuchas más clases que hchart puede interpretar, intenta correr methods("hchart") para listar todas las clases que actualmente esta función soporta.

Volviendo a nuestro gráfico en R existe los datos co2 que son una serie de tiempo (clase ts).

Code
data(co2)

str(co2)
 Time-Series [1:468] from 1959 to 1998: 315 316 316 318 318 ...
Code
hc13 <- hchart(co2, name = "Concentración") %>% 
  hc_title(
    # para poder usar el tag html "sub" para subindices
    useHTML = TRUE,
    text = "Concentración atomsférica de CO<sub>2</sub> en Mauna Loa"
  ) %>% 
  hc_subtitle(
    text = "Las concentraciones atmosféricas de CO2 se expresan en partes por 
    millón (ppm) y se informan en la escala preliminar de fracción molar
    manométrica SIO de 1997."
  )

hc13

Aprovechando que estamos revisando series de tiempo, podemos hacer una descomposición usando Loess (suavizamiento). La función stl toma un serie de tiempo descomponiéndola en tendencia, componente estacional y ruido.

Como veremos, el gráfico se realiza simplemente como hchart(descomposicion):

Code
descomposicion <- stl(co2, "per")

hc132 <- hchart(descomposicion) %>% 
  hc_tooltip(valueDecimals = 2) %>% 
  hc_title(
    useHTML = TRUE,
    text = "Descomposición de la Concentración atomsférica de CO<sub>2</sub> en
    Mauna Loa utilizando la funcion <code>stl</code>"
  ) %>% 
  hc_subtitle(
    text = "<b>Descripción del comando <code>stl</code></b>:
    El componente estacional se encuentra al suavizar loess la sub-serie
    estacional (la serie de todos los valores de enero, ...); si s.window = 
    'periódico' suavizado se reemplaza efectivamente tomando la media. Los 
    valores estacionales se eliminan y el resto se suaviza para encontrar la 
    tendencia. El nivel general se elimina del componente estacional y se agrega
    al componente de tendencia. Este proceso se repite varias veces. El componente
    restante son los residuos del ajuste estacional más tendencial."
  ) %>% 
  hc_tooltip(table = TRUE) %>% 
  hc_size(height = "700px")

hc132

Para finalizar ejemplificaremos la integración de {highcharter} con el paquete {forecast} con el cual se puede realizar predicciones de los datos de forma simple.

Code
library(forecast)

pronosticos <- forecast(ets(USAccDeaths), h = 48, level = 95)

hc133 <- hchart(pronosticos) %>% 
  hc_title(
    text = "Muertes por accidentes en los EE. UU. 1973–1978 más predicciones
    generadas utilizando {forecast}"
  ) %>% 
  hc_tooltip(shared = TRUE, valueDecimals = 2)

hc133

Día 14: treemaps

Es un buen gráfico para sustituir el gráfico de barras cuando la cantidad de categorías aumentan. También sirve como alternativa a los gráficos de torta o dunut (ñami!)

Code
conteo_clases <- count(millas, clase)
conteo_clases
# A tibble: 7 × 2
  clase           n
  <chr>       <int>
1 2asientos       5
2 compacto       47
3 mediano        41
4 minivan        11
5 pickup         33
6 subcompacto    35
7 suv            62
Code
hchart(
  conteo_clases,
  "treemap",
  hcaes(clase, value = n, colorValue = n),
  borderColor = NA # elimina border y se tiene un aspecto más limpio imho
  ) %>% 
  hc_colorAxis(stops  = color_stops()) %>% 
  hc_title(text = "Conteo de tipos de automóviles en los datos 'millas'") %>% 
  hc_colorAxis(endOnTick = FALSE)

Avanzado. Este es una guia en español para hacer un treemap mostrando la cardinalidad de cada tipo y subtipo de pokemon. Primero descargaremos los datos desde el repositorio https://github.com/PokeAPI/pokeapi/tree/master/data/v2/csv.

Partiremos con la lista de pokemon:

Code
library(readr)

url_base <- "https://raw.githubusercontent.com/PokeAPI/pokeapi/master/data/v2/csv"

pkmnes <- read_csv(file.path(url_base, "pokemon.csv"))
pkmnes
# A tibble: 1,302 × 8
      id identifier species_id height weight base_experience order is_default
   <dbl> <chr>           <dbl>  <dbl>  <dbl>           <dbl> <dbl>      <dbl>
 1     1 bulbasaur           1      7     69              64     1          1
 2     2 ivysaur             2     10    130             142     2          1
 3     3 venusaur            3     20   1000             263     3          1
 4     4 charmander          4      6     85              62     5          1
 5     5 charmeleon          5     11    190             142     6          1
 6     6 charizard           6     17    905             267     7          1
 7     7 squirtle            7      5     90              63    10          1
 8     8 wartortle           8     10    225             142    11          1
 9     9 blastoise           9     16    855             265    12          1
10    10 caterpie           10      3     29              39    14          1
# ℹ 1,292 more rows

Ahora los tipos de pokemon:

Code
pkmn_nombre_tipos <- read_csv(file.path(url_base, "type_names.csv")) %>% 
  # inglés es 9, Japonez es 1, español 7
  filter(local_language_id == 9)

pkmn_tipo <- read_csv(file.path(url_base, "pokemon_types.csv"))
pkmn_tipo <- pkmn_tipo %>% 
  mutate(slot = paste0("type_", slot)) %>% 
  left_join(pkmn_nombre_tipos, by = "type_id") %>% 
  select(pokemon_id, slot, name) %>% 
  spread(slot, name)

Ahora, la gracia del treemap que haremos es que serán los colores. Esto es lo que hara llamativo nuestro gráfico.

Code
pkmn_colores_tipo <- pkmn_nombre_tipos %>% 
  pull(name) %>% 
  setdiff(c("???", "Shadow")) %>% 
  purrr::map_df(function(t){
  # t <- "psychic"
  message(t)
  
  col <- "http://pokemon-uranium.wikia.com/wiki/Template:%s_color" %>% 
    sprintf(t) %>%
    xml2::read_html() %>% 
    rvest::html_nodes("span > b") %>% 
    rvest::html_text()
  
  tibble(type = t, color = paste0("#", col))
})

Ahora, calcularemos todas las combinaciones entre todos los colores para luego promediarlos y generar un matiz entre el color con el del segundo tipo. Esto se hace con la función colorRampPalette.

Code
pkmn_colores_tipo2 <- crossing(
  color_1 = pkmn_colores_tipo$color,
  color_2 = pkmn_colores_tipo$color
  ) %>% 
  mutate(
    color_f = purrr::map2_chr(
      color_1,
      color_2,
      ~ colorRampPalette(c(.x, .y))(100)[round(100 * .25)])
    )

pkmn_colores_tipo2
# A tibble: 324 × 3
   color_1 color_2 color_f
   <chr>   <chr>   <chr>  
 1 #6890F0 #6890F0 #6890F0
 2 #6890F0 #7038F8 #697AF1
 3 #6890F0 #705848 #6982C7
 4 #6890F0 #705898 #6982DA
 5 #6890F0 #78C850 #6B9DC9
 6 #6890F0 #98D8D8 #73A1EA
 7 #6890F0 #A040A0 #757CDC
 8 #6890F0 #A890F0 #7790F0
 9 #6890F0 #A8A878 #7795D2
10 #6890F0 #A8B820 #7799BD
# ℹ 314 more rows

Los datos! EL JOIN.

Code
pkmn <- pkmnes %>% 
  left_join(pkmn_tipo, by = c("id" = "pokemon_id")) %>% 
  left_join(pkmn_colores_tipo %>% rename(type_1 = type, color_1 = color), by = "type_1") %>% 
  left_join(pkmn_colores_tipo %>% rename(type_2 = type, color_2 = color), by = "type_2") %>% 
  left_join(pkmn_colores_tipo2, by =  c("color_1", "color_2")) %>% 
  mutate(color_f = ifelse(is.na(color_f), color_1, color_f))

Ahora obtendremos los prin

Code
dprinc <- pkmn %>% 
  select(name = type_1, color = color_1) %>% 
  distinct() %>% 
  mutate(id = str_to_id(name))

dsecun <- pkmn %>% 
  count(type_1, type_2, color_f) %>% 
  # los siguiente nombre de columnas son para que highcharts los use 
  # internamente.
  transmute(
    name =  ifelse(is.na(type_2), paste("only", type_1), type_2),
    parent = str_to_id(type_1),
    color = color_f,
    value = n
    ) %>% 
  mutate(id = as.character(row_number()))

dd <- list(dprinc, dsecun) %>%
  purrr::map(mutate_if, is.factor, as.character) %>% 
  bind_rows() %>% 
  list_parse() %>% 
  purrr::map(function(x) x[!is.na(x)])

A continuación, finalmente, uno de los treemaps del cual estoy orgulloso! :)

Code
hc14 <- highchart() %>% 
  hc_chart(type = "treemap") %>% 
  hc_title(
    text = "Pokemon por tipos"
  ) %>% 
  hc_add_series(
    data = dd,
    allowDrillToNode = TRUE,
    levelIsConstant = FALSE,
    textOverflow = "clip",
    dataLabels = list(color = "white"),
    levels = list(
      list(
        level = 1,
        borderWidth = 1,
        dataLabels = list(
          enabled = TRUE,
          verticalAlign = "top",
          align = "left",
          style = list(fontSize = "12px", textOutline = FALSE)
          )
        ),
      list(
        level = 2,
        borderWidth = 0,
        dataLabels = list(enabled = FALSE)
        )
      )
    ) %>% 
  # esto es para que el primer nivel, que no tiene color asigando, 
  # sea transparente.
  hc_colors("trasnparent")

hc14 %>% 
  hc_size(height = 800)

D