Paquetes

library(tidyverse)
library(waffle)
library(babynames)
library(extrafont)
library(highcharter)

El paquete waffle

En primer lugar vamos a realizar un waffle chart utilizando el paquete {waffle} previamente cargado. Utilizaremos el dataframe babynames del paquete con el mismo nombre, donde se recogen los nombres de los recién nacidos en Estados Unidos desde 1880 a 2017 diferenciando por sexo del bebé.

Pongamos que queremos representar en un waffle chart el porcentaje de recién nacidos niños y niñas que nacieron en el primer año del periodo, es decir, en 1880. Dichos porcentajes los podríamos calcular de la siguiente forma:

porcentajes_1880 <- babynames %>%
  filter(year == 1880) %>%
  group_by(sex) %>%
  summarise(total_sex = sum(n)) %>%
  mutate(total = sum(total_sex), porc = 100*(total_sex/total)) %>%
  select(sex, porc)

porcentajes_1880
## # A tibble: 2 x 2
##   sex    porc
##   <chr> <dbl>
## 1 F      45.2
## 2 M      54.8

 

En 1880 el porcentaje de recién nacidos niñas fue del 45,2% y. consecuentemente, el porcentaje de niños habría sido del 54,8%. Para representar estas cantidades en un waffle chart podríamos indicar el siguiente código:

waffle(c('F = 45.2%' = 45.2, 'M = 54.8%' = 54.8), rows = 10, colors = c("orange", "lightgrey"),
  title = 'Recién nacidos en 1880 por sexo (%)', legend_pos="bottom")

Por simple curiosidad vamos a representar diversos waffle charts donde se exponga dicha proporción a lo largo del periodo. Para ello en primer lugar realizaremos algunas modificaciones al dataframe original con el objetivo de establecer el porcentaje de recién nacidos según el sexo. En segundo lugar, debido a la longitud del dataframe, seleccionaremos algunos años para su representación gráfica.

porcentajes <- babynames %>%
  group_by(year, sex) %>%
  summarise(total_sex = sum(n)) %>%
  mutate(total = sum(total_sex), porc = 100*(total_sex/total)) %>%
  filter(year %in% c(1880, 1890, 1900, 1910, 1920, 1930, 1940, 1950, 1960, 1970, 1980, 1990, 2000, 2010, 2017)) %>%
  select(year, sex, porc)

porcentajes$porc <- formatC(porcentajes$porc, format = "f", digits = 1)

porcentajes
## # A tibble: 30 x 3
## # Groups:   year [15]
##     year sex   porc 
##    <dbl> <chr> <chr>
##  1  1880 F     45.2 
##  2  1880 M     54.8 
##  3  1890 F     63.2 
##  4  1890 M     36.8 
##  5  1900 F     66.6 
##  6  1900 M     33.4 
##  7  1910 F     67.1 
##  8  1910 M     32.9 
##  9  1920 F     53.0 
## 10  1920 M     47.0 
## # ... with 20 more rows

En esta ocasión guardaremos cada waffle por separado y, posteriormente, los aunaremos en un solo gráfico utilizando la función iron().

p_1880 <- waffle(c('F = 45,2%' = 45.2, 'M = 54,8%' = 54.8), rows = 5, colors = c("orange", "lightgrey"), title = 'Recién nacidos por sexo (%) \n\n\n1880')

p_1890 <- waffle(c('F = 63,2%' = 63.2, 'M = 36,8%' = 36.8), rows = 5, colors = c("orange", "lightgrey"), title = '1890')

p_1900 <- waffle(c('F = 66,6%' = 66.6, 'M = 33,4%' = 33.4), rows = 5, colors = c("orange", "lightgrey"), title = '1900')

p_1910 <- waffle(c('F = 67,1%' = 67.1, 'M = 32,9%' = 32.9), rows = 5, colors = c("orange", "lightgrey"), title = '1910')

p_1920 <- waffle(c('F = 53,0%' = 53.0, 'M = 47,0%' = 47.0), rows = 5, colors = c("orange", "lightgrey"), title = '1920')

p_1930 <- waffle(c('F = 50,6%' = 50.6, 'M = 49,4%' = 49.4), rows = 5, colors = c("orange", "lightgrey"), title = '1930')

p_1940 <- waffle(c('F = 49,7%' = 49.7, 'M = 50,3%' = 50.3), rows = 5, colors = c("orange", "lightgrey"), title = '1940')

p_1950 <- waffle(c('F = 48,9%' = 48.9, 'M = 51,1%' = 51.1), rows = 5, colors = c("orange", "lightgrey"), title = '1950')

p_1960 <- waffle(c('F = 48,7%' = 48.7, 'M = 51,3%' = 51.3), rows = 5, colors = c("orange", "lightgrey"), title = '1960')

p_1970 <- waffle(c('F = 48,5%' = 48.5, 'M = 51,5%' = 51.5), rows = 5, colors = c("orange", "lightgrey"), title = '1970')

p_1980 <- waffle(c('F = 48,2%' = 48.2, 'M = 51,8%' = 51.8), rows = 5, colors = c("orange", "lightgrey"), title = '1980')

p_1990 <- waffle(c('F = 48,0%' = 48.0, 'M = 52,0%' = 52.0), rows = 5, colors = c("orange", "lightgrey"), title = '1990')

p_2000 <- waffle(c('F = 48,0%' = 48.0, 'M = 52,0%' = 52.0), rows = 5, colors = c("orange", "lightgrey"), title = '2000')

p_2010 <- waffle(c('F = 48,1%' = 48.1, 'M = 51,9%' = 51.9), rows = 5, colors = c("orange", "lightgrey"), title = '2010')

p_2017 <- waffle(c('F = 48,3%' = 48.3, 'M = 51,7%' = 51.7), rows = 5, colors = c("orange", "lightgrey"), title = '2017')

iron(
  p_1880 + theme_minimal() + theme(plot.title = element_text(hjust=0.5)),
  p_1890 + theme_minimal() + theme(plot.title = element_text(hjust=0.5)),
  p_1900 + theme_minimal() + theme(plot.title = element_text(hjust=0.5)),
  p_1910 + theme_minimal() + theme(plot.title = element_text(hjust=0.5)),
  p_1920 + theme_minimal() + theme(plot.title = element_text(hjust=0.5)),
  p_1930 + theme_minimal() + theme(plot.title = element_text(hjust=0.5)),
  p_1940 + theme_minimal() + theme(plot.title = element_text(hjust=0.5)),
  p_1950 + theme_minimal() + theme(plot.title = element_text(hjust=0.5)),
  p_1960 + theme_minimal() + theme(plot.title = element_text(hjust=0.5)),
  p_1970 + theme_minimal() + theme(plot.title = element_text(hjust=0.5)),
  p_1980 + theme_minimal() + theme(plot.title = element_text(hjust=0.5)),
  p_1990 + theme_minimal() + theme(plot.title = element_text(hjust=0.5)),
  p_2000 + theme_minimal() + theme(plot.title = element_text(hjust=0.5)),
  p_2010 + theme_minimal() + theme(plot.title = element_text(hjust=0.5)),
  p_2017 + theme_minimal() + theme(plot.title = element_text(hjust=0.5))
) 

Resulta curioso que si bien la proporción de nacimientos de niños y niñas ha sido bastante equitativa en la mayor parte del periodo, quizá incluso con un mayor peso de los niños sobre las niñas, los datos evidencian que a finales del siglo XIX y principios del siglo XX la participación de nacimientos de niñas sobre el total de nacimientos era notablemente superior al de niños. Esta dinámica se refleja también en un antiguo post donde realizamos gráficos animados con el paquete gganimate.

Iconos en los waffle chart

En un post anterior se explicó cómo realizar infografías y pictogramas con R. Siguiendo los pasos ahí expuestos podemos, por ejemplo, utilizar un icono del paquete extrafont a la hora de realizar los waffle charts. Pongamos un ejemplo adecuado a los datos sobre los que trabajamos:

waffle(
  c('F = 48.3%' = 48.3, 'M = 51.7%' = 51.7), 
  use_glyph = "child", 
  glyph_size = 10,
  rows = 10, 
  colors = c("orange", "lightgrey"),
  title = 'Recién nacidos en 2017 por sexo (%)', 
  legend_pos="bottom"
)
## Warning: Removed 1 rows containing missing values (geom_text).

Otro ejemplo adicional, con información completamente inventada y con un icono escogido al azar, sería el siguiente:

waffle(
  c(`Facebook` =73, `Instagram` = 11, `Twitter` =9, `Otra` =7), 
  rows = 10, 
  colors = c("deepskyblue", "red1", "forestgreen", "gold"),
  use_glyph = "angellist", 
  glyph_size = 10 ,
  title = 'Uso de redes sociales') +
  theme_minimal()+ 
  theme(plot.title = element_text(hjust=0.5))

Waffle charts con {highcharter}

Otra posibilidad es utilizar la función hciconarray() del paquete {highcharter}. La operativa es muy sencilla. En su forma básica supongamos que tenemos dos elementos, A y B de los cuales tenemos 80 del primero y 20 del segundo. Podríamos representarlo gráficamente de la siguiente forma:

hciconarray(c("A", "B"), c(80, 20))
## Warning: `data_frame()` is deprecated as of tibble 1.1.0.
## Please use `tibble()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.
## Warning: `as_data_frame()` is deprecated as of tibble 2.0.0.
## Please use `as_tibble()` instead.
## The signature and semantics have changed, see `?as_tibble`.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.

hciconarray(c("A", "B"), c(80, 20), size = 10, color = c("orange", "grey"))