Data, Code and Visualization - #30diasdegraficos Parte 2

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

Code

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

Code

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

Code

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

Code

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.

Code

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:

Code

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

Code

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

Code

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.

Code

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

Code

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

Code

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

Code

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

Code

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) %>%
  tbl_df() %>%
  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) %>%
    tbl_df()

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

Reuse

https://creativecommons.org/licenses/by/4.0/

Citation

BibTeX citation:

@online{kunstfuentes2020,
  author = {Joshua Kunst Fuentes},
  title = {\#30diasdegraficos {Parte} 2},
  date = {2020-05-22},
  url = {https://jkunst.com/blog/posts/2020-05-22-30diasdegraficos-parte-2},
  langid = {en}
}

For attribution, please cite this work as:

Joshua Kunst Fuentes. 2020. “#30diasdegraficos Parte 2.” May 22, 2020. https://jkunst.com/blog/posts/2020-05-22-30diasdegraficos-parte-2.