#30diasdegraficos Parte 2

Introducción

Seguiremos utilizando los mismos paquetes que la parte anterior.

# 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.

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.

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:

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}.

# 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.

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.

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).

data(co2)

str(co2)

 Time-Series [1:468] from 1959 to 1998: 315 316 316 318 318 ...

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):

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.

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!)

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

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:

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,351 × 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             236     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             240     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             239    12          1
10    10 caterpie           10      3     29              39    14          1
# ℹ 1,341 more rows

Ahora los tipos de pokemon:

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.

# The original post scraped these colors from a wiki that is no longer
# available. Keeping the palette here makes the example reproducible.
pkmn_colores_tipo <- tribble(
  ~type,      ~color,
  "normal",  "#A8A878",
  "fighting","#C03028",
  "flying",  "#A890F0",
  "poison",  "#A040A0",
  "ground",  "#E0C068",
  "rock",    "#B8A038",
  "bug",     "#A8B820",
  "ghost",   "#705898",
  "steel",   "#B8B8D0",
  "fire",    "#F08030",
  "water",   "#6890F0",
  "grass",   "#78C850",
  "electric","#F8D030",
  "psychic", "#F85888",
  "ice",     "#98D8D8",
  "dragon",  "#7038F8",
  "dark",    "#705848",
  "fairy",   "#EE99AC"
)

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.

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.

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

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! :)

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ía 15: dendogramas

Los dendogramas son una 2da iteración a la visualización de distancia entre individuos o registros en una tabla como lo es el primer gráfico del día 11. Los dendogramás son complejos de leer pues traen mucha más información debido a que podemos ver como se van agrupando (en términos de distancia) las observaciones. Que una esté cerca de otra significa que sus carácterísticas son similares.

Para gráficar en {highcharter} haremos ya el conocido truco de extraer la información luego de generer un ggplot con la información. Un paquete para generar dendogramas usando {ggplot2} es {ggdendro}.

Los dendogramas salen como un resultado a partir de un “agrupamiento jerárquico” que viene a su vez de una matriz de distancias, por lo que calcularemos la clasterización antes de graficar el dendograma.

# install.packages("ggdendro")
library(ggdendro)

hc <- hclust(dist(mtautos), "ave")

ggd <- ggdendrogram(hc, rotate=TRUE)

dd15 <- as_tibble(ggplot2::layer_data(ggd, 2))

dd152 <- dd15 %>% 
  select(x, xend, y, yend) %>% 
  mutate(id = row_number()) %>% 
  gather(key, value, -id) %>% 
  mutate(key = stringr::str_remove(key, "end")) %>% 
  group_by(id, key) %>% 
  mutate(id2 = row_number()) %>% 
  spread(key, value) %>% 
  ungroup() %>% 
  select(-id2) %>% 
  mutate_if(is.numeric, round, 3)

hc15 <- hchart(
  dd152,
  "line",
  # x - 1 pues al colocar categorúías 
  hcaes(x - 1, y, group = id),
  color = "red",
  showInLegend = FALSE
  ) %>% 
  # https://stackoverflow.com/questions/43638810/how-to-get-labels-from-hclust-result
  hc_xAxis(
    categories = hc$labels[hc$order], 
    title = list(text = "Vehículos")
    ) %>% 
  hc_yAxis(
    title = list(text = "Distancia"),
    endOnTick = FALSE,
    crosshair = TRUE
    ) %>% 
  hc_tooltip(
    headerFormat = "",
    pointFormat = "<b>x</b>: {point.x}<br><b>y</b>:{point.y}",
    valueDecimals = 2
    ) %>% 
  hc_title(
    useHTML = TRUE,
    text = "Dendograma en el dataset <code>mtautos</code>"
    )
  
hc15

Día 16: gráficos de waffle

También conocidos como pie cuadrados los gráficos de waffle son una alternativa a los pie charts. Em highchartsJS -por tanto en {highcharter}- el equivalente es “item”.

set.seed(123)

diamantes_cortes_1000 <- diamantes %>% 
  sample_n(1000) %>% 
  count(corte)

diamantes_cortes_1000

# A tibble: 5 × 2
  corte         n
  <ord>     <int>
1 Regular      29
2 Bueno       101
3 Muy bueno   227
4 Premium     250
5 Ideal       393

hc16 <- hchart(
  diamantes_cortes_1000,
  "item", 
  hcaes(name = corte, y = n),
  name = "cortes",
  marker = list(symbol = "square"),
  showInLegend = TRUE
  ) %>% 
  hc_title(
    text = "Distribución de cortes en una muestra de 1000 diamantes"
  )

hc16

También tiene se puede configurar para que en realidad parezca un “parlamento”.

hchart(
  diamantes_cortes_1000,
  "item", 
  hcaes(name = corte, y = n),
  name = "cortes",
  # marker = list(symbol = "square"),
  showInLegend = TRUE,
  size = "100%",
  center = list("50%", "75%"),
  startAngle = -100,
  endAngle  = 100
  ) %>% 
  hc_title(
    text = "Distribución de cortes en una muestra de 1000 diamantes con
    un layout de <i>Parlamento</i>"
  ) %>% 
  hc_legend(
    labelFormat = '{name} <span style="opacity: 0.4">{y}</span>'
  )

Día 17: diagramas de sankey

Con los sankey plots se puede estudiar las distribución de más variables y como se distribuyen las categorías con las categorías de las variables adyacentes:

Medio. Usualmente, los sankey necesitan un formato de datos donde se especifique desde, hacia y el peso. En una tabla usual, tidy de debe calcular los contedos de combinaciones de categorías. Para ello generamos un código el cual puede ser reusado en otra ocación con otros datos.

encuesta2014 <- encuesta %>% 
  filter(anio == 2014) %>% 
  filter(complete.cases(.)) %>% 
  mutate(edad = ggplot2::cut_number(edad, 4)) %>% 
  select(estado_civil, edad, religion) %>% 
  mutate(
    estado_civil = forcats::fct_lump_lowfreq(estado_civil, other_level = "Otro estado civil"),
    religion = forcats::fct_lump_lowfreq(religion, other_level = "Otra religion")
  )

combinaciones <- tibble(
  var1 = names(encuesta2014),
  var2 = lead(var1)
) %>% 
  filter(var1 != "n" | var2 != "n") %>% 
  filter(complete.cases(.))

encuenta2014_flujo <- combinaciones %>% 
  purrr::pmap_df(function(var1 = "estado_civil", var2 = "edad"){
    
    encuesta2014 %>% 
      select(all_of(var1) , all_of(var2)) %>% 
      group_by_all() %>% 
      count() %>% 
      ungroup() %>% 
      setNames(c("desde", "hacia", "peso")) %>% 
      mutate_if(is.factor, as.character)
  })

hc17 <- hchart(
  encuenta2014_flujo, 
  "sankey",
  hcaes(from = desde, to = hacia, weight = peso),
  name = "Encuesta 2014"
  ) %>% 
  hc_title(
  text = "Distribución de las variables edad, estado civil y religión para los 
  datos <em>encuesta</em> para el año 2014"
  )

hc17

Día 18: datos espaciales

Hay muchos tipos de datos y formas de representar espaciales:

Coropletas
Puntos/burbujas
Arcos
Contornos
Y supongo que muchos más.

En esta oportunidad haremos coropletas que viene a colorear regiones de acuerdo a valores o categoría de una variable. En highcarter podemos utilizar como entrada archivos geojson los cuales representan características grográficas.

Utilizaremos un geojson del gran Santiago que está en el repositorio de @robsalasco (su twitter y github). También utilizaremos su paquete {sinimr} para acceder al sistema de información de municipalidades de Chile.

Primero, los datos grográficos:

# remotes::install_github("robsalasco/sinimr")
library(geojsonio)

url_gs_geojson <- "https://raw.githubusercontent.com/robsalasco/precenso_2016_geojson_chile/87bc72ea23ad19a116ae9af02fa1cb5ae06f29f3/Extras/GRAN_SANTIAGO.geojson"

gransantiago <- jsonlite::fromJSON(url_gs_geojson, simplifyVector = FALSE)

# str(gransantiago, max.level = 4)

dcomuna <- gransantiago$features %>% 
  purrr::map_df("properties") %>% 
  rename_all(stringr::str_to_lower) %>% 
  select(comuna, nom_comuna) %>% 
  mutate(
    comuna = as.numeric(comuna),
    nom_comuna = stringr::str_to_title(nom_comuna)
    )

dcomuna

gransantiago_geojson <- geojsonio::as.json(gransantiago)

Ahora datos para rellenarlos. Como mencionamos utilizaremos el paquete {sinimr} https://github.com/robsalasco/sinimr:

# remotes::install_github("robsalasco/sinimr")
library(sinimr)

varcode <- 882

nombre_variable <- sinimr::get_sinim_var_name(varcode)
nombre_variable <- stringr::str_to_title(nombre_variable)

dvar <- get_sinim(varcode, 2018, region = 13, truevalue = TRUE) %>% 
  as_tibble() %>% 
  select(code, value) 
  
dvar <- dvar %>% 
  left_join(dcomuna, by = c("code" = "comuna")) %>% 
  mutate(value = round(value/1e6))

dvar

En higcharter los datos goeográficos van en el arguemnto mapData y los datos que tienen la información para pintar van en el data. Notar que necesitamos parsear los datos a lista con la función list_parse y que los datos deben venir con la columna value la cual se utilizará tanto para le color, leyenda, etc. Otra cosa importante es el joinBy que viene a ser lo que en un left_join es el arguemnto by.

highchart(type = "map") %>%
  hc_add_series(
    mapData = gransantiago_geojson,
    data = list_parse(dvar),
    # "COMUNA" es la key en el geojson, "code" es la key en nuestros datos: dvar
    joinBy = c("COMUNA", "code"),
    showInLegend = FALSE,
    name = nombre_variable,
    dataLabels = list(enabled = TRUE, format = "{point.nom_comuna}")
    ) %>% 
  hc_colorAxis(minColor = "white", maxColor = "red", endOnTick = FALSE) %>% 
  hc_tooltip(
    # estos campos son de los datos dvar
    pointFormat = "<b>{point.nom_comuna}</b>: ${point.value} MM"
  ) %>% 
  hc_title(
    text = "Ingresos propios por comunas del gran Santiago para el año 2018"
  ) %>% 
  hc_subtitle(
    text = "Datos obtenidos del paquete {sinimr} por @robsalasco"
  ) %>% 
  hc_size(height = 800)

Avanzado. Utilizaremos unas de las funcionalidades más entretenidas de {highcharter} que es poner gráficos dentro de un tooltip! Para esto es necesario tener una data parseada en lista (de nuevo list_parse) para luego utilizarla en conjunto con la función tooltip_chart en el argumento pointFormatter en la función hc_tooltip.

Los datos para este ejemplo son los del Ministerio de Ciencia que cuenta por comuna los casos registrados por COVID-19.

library(scales) # para viridis_pal

dcovid <- read_csv("https://raw.githubusercontent.com/MinCiencia/Datos-COVID19/master/output/producto1/Covid-19.csv")

dcovid_largo <- dcovid %>% 
  filter(`Codigo region` == 13) %>% 
  rename(comuna = `Codigo comuna`) %>% 
  select(comuna, matches("[0-9]{4}")) %>% 
  gather(fecha, casos, -comuna) %>% 
  mutate(fecha = lubridate::ymd(fecha))

dcovid_ultimo <- dcovid_largo %>% 
  group_by(comuna) %>% 
  filter(fecha == max(fecha)) %>% 
  ungroup()

dcovid_largo <- dcovid_largo %>% 
  rename(x = fecha, y = casos) %>% 
  mutate(x = datetime_to_timestamp(x)) %>% 
  group_by(comuna) %>% 
  nest() %>% 
  rename(ttdata = data) %>% 
  mutate(ttdata = purrr::map(ttdata, list_parse))

dcovid <- left_join(
  dcovid_ultimo,
  dcovid_largo,
  by = "comuna"
  ) %>% 
  mutate(comuna = as.numeric(comuna)) %>% 
  inner_join(dcomuna, by = "comuna") %>% 
  rename(value = casos)

dcovid

maxfecha <- dcovid %>% 
  pull(fecha) %>% 
  max() %>% 
  format("%A %e de %B")

hc18 <- highchart(type = "map") %>%
  hc_add_series(
    mapData = gransantiago_geojson,
    data = list_parse(dcovid),
    # "COMUNA" es la key en el geojson, "code" es la key en nuestros datos: dvar
    joinBy = c("COMUNA", "comuna"),
    showInLegend = FALSE,
    name = "Covid",
    borderColor = 'transparent',
    borderWidth = 0.1,     
    dataLabels = list(
      enabled = TRUE,
      format = "{point.nom_comuna}",
      style = list(fontSize = "12px", color = "#F5F5F5")
      )
    ) %>% 
  hc_colorAxis(
    stops = color_stops(n = 10, viridis_pal(option = "B", end = 0.95)(10)),
    # fuerza a utilzar mejor el espectro de colores para que HJS no amplie el
    # eje para tener numero "redondos
    endOnTick =  FALSE
    ) %>% 
  hc_tooltip(
    useHTML = TRUE,
    headerFormat = "{point.key}",
    pointFormatter = tooltip_chart(
      accesor = "ttdata",
      hc_opts = list(
        subtitle = list(text = "point.nom_comuna"),
        chart = list(backgroundColor = "white"),
        xAxis = list(type = "datetime", showLastLabel = TRUE, endOnTick = FALSE),
        yAxis = list(showLastLabel = TRUE, endOnTick = FALSE),
        credits = list(enabled = FALSE)
        ),
      height = 225,
      width = 400
      )
  ) %>% 
  hc_title(
    text = "Casos COVID-19 en el Gran Santiago",
    align = "center"
    ) %>% 
  hc_subtitle(
    text = paste("Datos Ministerio de Ciencia; con última actualización el", maxfecha),
    align = "center"
    ) %>% 
  hc_legend(symbolWidth = 500, align = "center", verticalAlign = "top")

hc18 %>% 
  hc_size(height = 800)

Día 19: streamgraph

El steamgraph puede crearse a partir de un gráfico de áreas apiladas cuando en el eje x se utiliza una variable temporal. ¿Recuerdan el gráfico de áreas apiladas que hicimos en la parte 1? En el ejemplo teníamos en el eje x una variable asociada al tiempo por lo que podemos reutilizar el código simplemente cambiado el tipo de gráfico de "area" a "streamgraph".

Por tanto reutilizaremos el mismo código:

Code

library(scales) # para viridis_pal

data(movies, package = "ggplot2movies")

colores <- viridis_pal(option = "B", end = 0.8)(7)

peliculas <- movies %>% 
  select(anio = year, Action:Short) %>% 
  gather(categoria, cantidad, -anio) %>% 
  group_by(anio, categoria) %>% 
  summarise(cantidad = sum(cantidad)) %>% 
  mutate(
    categoria = case_when(
      categoria == "Action" ~ "Acción",
      categoria == "Animation" ~ "Animación",
      categoria == "Comedy" ~ "Comedia",
      categoria == "Documentary" ~ "Documental",
      categoria == "Drama" ~ "Drama",
      categoria == "Romance" ~ "Romance",
      categoria == "Short" ~ "Cortometraje",
      TRUE ~ NA_character_
    )
  )

eventos <- tibble(
  anio = c(1930, 1941, 1990),
  texto = c(
    "Comienzo era dorada<br>en Hollywood.",
    "Aparición<br>de la televisión.",
    "Comienzo aumento<br>del cine independiente.")
)

data_plotLine <- eventos %>% 
  transmute(
    value = anio,
    label = purrr::map(texto, ~ list(text = .x))
  ) %>% 
  mutate(color = "#666", width = 2, zIndex = 5)

hc19 <- hchart(peliculas, "streamgraph", hcaes(anio, cantidad, group = categoria)) %>%
  hc_yAxis(visible = FALSE) %>% # no tiene mucho sentido el
  hc_colors(colores) %>% 
  hc_tooltip(table = TRUE, sort = TRUE) %>% 
   hc_xAxis(
    plotLines = list_parse(data_plotLine)
  ) %>% 
  hc_title(
    text = "Cantidad de películas por Género"
  ) %>% 
  hc_caption(
    text = "Datos provenientes de <b>IMDB</b> a través del paquete ggplot2movies.<br>
    La Mayoria de eventos fueron obtenidos a partir de lectura flash en <b>Wikipedia</b>."
  ) %>% 
  # https://jsfiddle.net/gh/get/library/pure/highcharts/highcharts/tree/master/samples/highcharts/legend/verticalalign/
  hc_chart(
    marginRight = 120
  ) %>% 
  hc_legend(
    align = "right",
    verticalAlign = "top",
    layout = "vertical",
    itemMarginBottom = 10,
    x = 0,
    y = 150
  )

hc19

Dia 20: redes

Tomamos el ejemplo del paquete {economiccomplexity} en donde realiza un análisis de proximidad basado en lo que exporta cada país https://pacha.dev/economiccomplexity/articles/basic-usage.html

# install.packages("economiccomplexity")
library(economiccomplexity)
library(igraph)
library(Matrix)

data(world_trade_avg_1998_to_2000)

glimpse(world_trade_avg_1998_to_2000)

Rows: 124,336
Columns: 3
$ country <chr> "afg", "afg", "afg", "afg", "afg", "afg", "afg", "afg", "afg",…
$ product <chr> "0011", "0012", "0111", "0112", "0113", "0116", "0223", "0224"…
$ value   <dbl> 30068, 16366, 19273, 893, 350, 1561, 851, 12884, 114673, 67796…

world_trade_avg_1998_to_2000 <- world_trade_avg_1998_to_2000 %>% 
  ungroup() %>%
  filter(!(country %in% c("ant", "rom", "scg", "fsm", "umi")))

bi <- balassa_index(world_trade_avg_1998_to_2000)

pro <- proximity(bi)

net <- projections(pro$proximity_country, pro$proximity_product)

dfaggregated_countries <- aggregate(
  world_trade_avg_1998_to_2000$value,
  by = list(country = world_trade_avg_1998_to_2000$country),
  FUN = sum
)

aggregated_countries <- setNames(dfaggregated_countries$x, dfaggregated_countries$country)

V(net$network_country)$size <- aggregated_countries[match(V(net$network_country)$name, names(aggregated_countries))]

red <- net$network_country

library(ggraph)

ggraph(red, layout = "auto") +
  geom_edge_link(edge_colour = "#a8a8a8") +
  geom_node_point(aes(size = size), color = "#86494d") +
  geom_node_text(aes(label = name), size = 2, vjust = 2.2) +
  ggtitle("Proximity Based Network Projection for Products") +
  theme_void()

Avanzado. Acá a partir del objeto igraph obtendremos un layout basado en el paquete {graphlayouts}. Luego dibujaremos independiente los vertices, las aristas y la información de las aristas.

Code

library(countrycode)

dfvertices <- graphlayouts::layout_igraph_stress(net$network_country) %>% 
  as_tibble() 

dfvertices <- dfvertices %>% 
  mutate(
    exportacion_millones = round(size/1e6),
    iso3c = toupper(name)
    ) %>% 
  left_join(
    countrycode::codelist %>% 
      select(iso3c, iso2c, nombre = cldr.name.es_cl),
    by = "iso3c"
  )

dfvertices <- dfvertices %>% 
  ungroup() %>% 
  mutate(
    color = colorize(size/max(size), colors = scales::viridis_pal(option = "B")(10))
  ) %>% 
  rowwise() %>% 
  mutate(marker = list(marker = list(fillColor = color))) %>% 
  select(-color)

# glimpse(dfvertices)
# glimpse(countrycode::codelist) 


# aristas
dfaristas <- red %>%
  get.edgelist() %>%
  data.frame(stringsAsFactors = FALSE) %>%
  tibble::as_tibble() %>%
  setNames(c("from", "to")) 

dfaristas <- dfaristas %>%
  left_join(
    dfvertices %>% select(from = name, xf = x, yf = y),
    by = "from")

dfaristas <- dfaristas %>%
    left_join(
      dfvertices %>% select(to = name, xt = x, yt = y),
      by = "to")

dfaristas2 <- red %>%
    edge_attr() %>%
    data.frame(stringsAsFactors = FALSE) %>%
    tibble::as_tibble()

dfaristas <- bind_cols(dfaristas, dfaristas2)

dfaristas <- dfaristas %>% 
  mutate(id = row_number()) %>% 
  gather(key, value, -weight, -from, -to, -id) %>% 
  mutate(key = stringr::str_remove_all(key, "f|t")) %>% 
  group_by(id, key) %>% 
  mutate(id2 = row_number()) %>% 
  spread(key, value)


dfaristas_info <- dfaristas %>% 
  group_by(from, to, weight, id) %>% 
  summarise_at(vars(x, y), mean) %>% 
  ungroup() %>% 
  mutate(
    weight = round(100*weight, 2),
    from_iso2 = countrycode::countrycode(from, origin = "iso3c", destination = "iso2c"),
    to_iso2 = countrycode::countrycode(to, origin = "iso3c", destination = "iso2c")
  )

dfaristas <- dfaristas %>% 
  select(x, y, id) %>% 
  ungroup()

Code

hc20 <- highchart() %>% 
  # opciones generales
  hc_plotOptions(
    series = list(
      color = hex_to_rgba("gray", 0.2),
      marker = list(enabled = FALSE),
      states = list(
        inactive = list(
          opacity = 1
          )
        )
      )
    ) %>% 
  hc_boost(enabled = FALSE) %>% 
  hc_chart(zoomType = "xy") %>% 
  hc_tooltip(useHTML = TRUE) %>% 
  hc_xAxis(visible = FALSE) %>% 
  hc_yAxis(visible = FALSE) %>% 
  hc_legend(verticalAlign = "top", align = "left") %>% 
  hc_title(text = "Red basada en proyección de proximidad") %>%
  hc_subtitle(
      text = "Datos y análisis provisto en el paquete {economiccomplexity}<br>
      El tamaño corresponde a la exportación promedio de cada país entre los años 98 y 2000"
      ) %>%  
  # vertices
  hc_add_series(
    dfvertices,
    "bubble",
    hcaes(x, y, size = size, colorValue = size),
    tooltip = list(
      headerFormat = "",
      pointFormat = "
      <center>
      <b>{point.nombre}</b><br>
      Exportaciones ${point.exportacion_millones} millones USD
      <table style=\" height:20px;\">
      <center>
      <img src=\"https://www.countryflags.io/{point.iso2c}/shiny/64.png\" style=\"text-align: center\">
      </center>
      <table>
      </center>"
    ),
    name = "Países",
    minSize = 5,
    maxSize = 25,
    marker = list(enabled = TRUE, fillOpacity = 1)
  ) %>% 
  # aristas
  hc_add_series(
    dfaristas,
    "line",
    hcaes(x, y, group = id),
    showInLegend = FALSE,
    enableMouseTracking = FALSE,
    zIndex = -10
    ) %>%
  # info aristas
  hc_add_series(
    dfaristas_info,
    "scatter",
    hcaes(x, y),
    marker = list(
      radius = 1
    ),
    legend = list(
      symbolHeight = 11,
      symbolWidth = 11,
      symbolRadius = 5
    ),
    tooltip = list(
      headerFormat = "",
      pointFormat = "<center>
      <b>Proximidad</b><br>
      {point.weight}%<br>
      <table style=\"height:20px!important\">
      <tr>
      <img src=\"https://www.countryflags.io/{point.from_iso2}/shiny/64.png\" width=\"50%\">
      <img src=\"https://www.countryflags.io/{point.to_iso2}/shiny/64.png\" width=\"50%\">
      </tr>
      </table>
      </center>"
    ),
    name = "Información artistas"
  ) 

hc20