Tidytuesday 2020-04-21: agregaciones a varios niveles

Cambiar la estructura

Para cambiar la estructura de los datos vamos a partir del post de Julia Silge Modeling #TidyTuesday GDPR violations with tidymodels. Para cambiar la estructura, primero extrae los artículos de la variable articles_violated con str_extract_all() (se crea un vector de tipo cadena con los resultados obtenidos) y posteriormente usa la función unnest() sobre esa nueva variable (asigna una fila a cada valor del vector; el resto de datos se copian de la fila original).

Como más adelante vamos a querer calcular las cuantías de las multas agrupadas por distintas variables, tenemos que corregir la variable price, ya que de otra forma puede en algunos casos el valor original se duplicará, triplicará… dependiendo del número de artículos que hubiera infringido originalmente. A falta de un dato desagregado por artículos, lo que hacemos es dividir la cuantía total de cada caso entre el número de artículos infringidos en cada caso.

gdpr_tidy <- gdpr_raw %>%
  transmute(
    id,
    price,
    article_violated,
    articles = str_extract_all(
      article_violated,
      "Art. ?[:digit:]+"
    )
  ) %>%
  mutate(total_articles = map_int(articles, length)) %>%
  unnest(articles) %>%
  mutate(articles = as.numeric(str_extract(articles, "\\d+")),
         price = price / total_articles)

head(gdpr_tidy)

## # A tibble: 6 x 5
##      id price article_violated                           articles total_articles
##   <dbl> <dbl> <chr>                                         <dbl>          <int>
## 1     1  9380 Art. 28 GDPR                                     28              1
## 2     2   625 Art. 12 GDPR|Art. 13 GDPR|Art. 5 (1) c) G~       12              4
## 3     2   625 Art. 12 GDPR|Art. 13 GDPR|Art. 5 (1) c) G~       13              4
## 4     2   625 Art. 12 GDPR|Art. 13 GDPR|Art. 5 (1) c) G~        5              4
## 5     2   625 Art. 12 GDPR|Art. 13 GDPR|Art. 5 (1) c) G~        6              4
## 6     3 30000 Art. 5 GDPR|Art. 6 GDPR                           5              2

Antes de seguir transformando los datos, vamos a crear otro objeto para obtener la lista de artículos que NO han sido multados. Para ello partimos del conjunto de datos niveles, que contiene la lista con todos los artículos, y usamos anti_join() para quedarnos únicamente con los artículos que no han sido infringidos.

Además, añadimos una nueva variable ranking que más adelante nos permitirá ordenar los elementos en el gráfico correspondiente.

nulos <- niveles %>%
  anti_join(gdpr_tidy) %>%
  group_by(level) %>% 
  mutate(ranking = row_number(articles))

Las variables y cálculos con los que vamos a trabajar serán:

• Recuento de elementos en los diversos niveles de agregación, y proporciones correspondientes.
• Suma acumulada de las multas por diversos niveles de agregación, y proporciones correspondientes.

Asimismo, vamos a trabajar con tres niveles de detalle:

• A nivel de artículo: nivel más desagregado con el que vamos a crear nuestros gráficos, aunque primero vamos a tener que agregar los datos originales (que realmente están más deagregados, por caso y artículo).
• A nivel de tipo de multa: con tres posibles niveles, los dos marcados por la ley y uno tercero porque tal y como veremos aparecen algunos artículos que no conllevan pena económica.
• A nivel de todo el conjunto de datos (nivel de agregación superior).

Para mantener una lógica a la hora de nombrar las nuevas variables que vamos a generar usaremos el siguiente patrón:

(Variable)_(variables de agrupación (nivel de agregación de los datos))_(cálculo)

En el primer paso usaremos la función summarise() para reestructurar el conjunto de datos original y agregar los datos a nivel de artículo.

datos <- gdpr_tidy %>%
  # nivel más granular (23 niveles, uno por cada artículo infringido)
  group_by(articles) %>%
  summarise(art_n = n(),
            price_art_sum = sum(price)) %>%
  ungroup()

Calcular las nuevas variables

Una vez que ya tenemos nuestra estructura básica, procedemos a realizar los cálculos a distintos niveles de agregación.

datos <- datos %>% 
    # completamos los datos para poder usar el tipo de multa como agrupación
  left_join(niveles) %>%
  # nivel intermedio de agregación (3 niveles)
  arrange(level, articles) %>% # solo para escanear más fácil la tabla
  group_by(level) %>%
  mutate(
    lev_n = sum(art_n),
    lev_n_prop = art_n / lev_n,
    price_lev_sum = sum(price_art_sum),
    price_lev_n_prop = price_art_sum / price_lev_sum,
    lev_n_rank = dense_rank(desc(art_n)),
    price_lev_rank = dense_rank(desc(price_art_sum))
  ) %>% 
  ungroup()

Después de realizar los cálculos en el nivel de agrupación/agregación de interés volvemos a desagrupar los datos, y podemos pasar a otro nivel de agregación.

datos <- datos %>%
  # nivel más agregado (1 nivel)
  mutate(
    tot_n_prop = art_n / sum(art_n),
    tot_n_rank = dense_rank(desc(art_n)),
    price_tot_sum = sum(price_art_sum),
    price_tot_prop = price_art_sum / sum(price_art_sum),
    price_tot_rank = dense_rank(desc(price_art_sum))
  ) 

Para uno de los gráficos que vamos a crear es necesario realizar una última transformación a la estructura de los datos, ya que para poder crear las líneas correctamente tenemos que pivotar los datos a partir de dos nuevas variables.

Hasta ahora hemos usado la función dense_rank() para conocer el puesto que ocupa cada artículo con respecto a otra variable y en determinado nivel de agregación. Estos datos, sin embargo, no son adecuados para crear un gráfico en el que cada artículo aparezca en una “fila”, que además tiene que estar alineada con otros dos gráficos (los gráficos de barras). En el caso de que haya “empate” entre varios artículos, dense_rank() asigna el mismo ranking, por lo que si usamos dichos valores para posicionar las marcas gráficas, estarán solapadas.

Para que cada marca gráfica tenga su propio espacio y no se solape con el resto, usaremos la función row_number(). Tenemos que crear dos rankings con esta fórmula, uno para el número de apariciones y otro para la cuantía acumulada. Una vez que tengamos esas dos variables, podemos pivotar los datos.

datos_pivot <- datos %>% 
  select(articles, art_n, price_art_sum, level, tot_n_prop, price_tot_prop, title) %>% 
  arrange(desc(art_n)) %>% 
  mutate(puesto_n = row_number()) %>% 
  arrange(desc(price_art_sum)) %>% 
  mutate(puesto_price = row_number()) %>% 
  pivot_longer(starts_with("puesto"), names_to ="pos_X", values_to = "ranking")

Gráficos de barras

Los dos gráficos de barras son prácticamente, simplemente varía la variable que mapearemos a X: el número de apariciones en el gráfico de la izquierda, y el de la cuantía acumulada en el de la derecha.

Vamos a usar la versión pivotada de los datos, por lo que tenemos que filtrar una de cada dos filas.

IMPORTANTE: para poder usar el operador %>% a la hora de filtrar los datos dentro de ggplot, es necesario que identifiquemos el parámetro data =, ya que de otra forma dará error.

Además, invertimos el eje X del gráfico de la izquierda, y cambiamos los atributos gráficos del título para que aparezca alineado a la derecha (más adelante cambiaremos la alineación de todos los títulos con patchwork)

(
  items <-
    ggplot(
      data = datos_pivot %>% filter(pos_X == "puesto_n"),
      aes(art_n, fct_reorder(as.factor(articles), desc(ranking)), fill = as.factor(level))
    ) +
    geom_col() +
    scale_x_continuous(trans = "reverse", expand = c(0, 0)) +
    guides(fill = FALSE) +
    labs(title = "Número de infracciones") +
    theme(
      plot.title = element_textbox_simple(
        color = "#2e3440",
        fill = "#d8dee9",
        size = 16,
        padding = margin(5.5, 5.5, 5.5, 5.5),
        width = unit(0.99, "npc"),
        halign = 1
      )
    )
)

(
  cuantia <-
    ggplot(
      data = datos_pivot %>% filter(pos_X == "puesto_price"),
      aes(price_art_sum, fct_reorder(as.factor(articles), desc(ranking)), fill = as.factor(level))
    ) +
    geom_col() +
    scale_x_continuous(expand = c(0, 0), limits = c(0, max(
      datos$price_art_sum
    ) * 1.025)) +
    guides(fill = FALSE) +
    labs(title = "Cuantía acumulada")
)

Gráfico de líneas

En este caso usamos el conjunto de datos pivotado para poder dibujar las líneas correctamente. Añadimos las etiquetas correspondientes a cada una de las columnas que se generan concatenando varios datos.

Además, invertimos el eje Y para que los elementos se posicionen correctamente. También añadimos algo de espacio para que se lean todos los textos jugando con los argumentos limits = y expand = de las escalas correspondientes.

Finalmente, el título es &nbsp (espacio en blanco en HTML) para que la barra del título tenga las dimensiones correctas pero no muestre ningún texto, una vez que apliquemos las modificaciones a la apariencia de los gráficos.

IMPORTANTE: para que la función dollar_format() del paquete scales funcione correctamente, la variable a la que se le pasará la función se da fuera de la función propiamente dicha.

scales::dollar_format(prefix = "", suffix = "€")(price_art_sum)

(
  slope <- ggplot(datos_pivot,
      aes(pos_X, ranking, group = articles, color = as.factor(level))) +
    geom_line() +
    geom_point(size = 1.5) +
    geom_text(
      data = datos_pivot %>% filter(pos_X == "puesto_n"),
      aes(
        x = pos_X,
        y = ranking,
        label = paste0(art_n, " - ", scales::percent(tot_n_prop, accuracy = 0.01))
      ),
      hjust = 1,
      nudge_x = -0.04,
      size = 5
    ) +
    geom_text(
      data = datos_pivot %>% filter(pos_X == "puesto_price"),
      aes(
        x = pos_X,
        y = ranking,
        label = paste0(
          scales::dollar_format(prefix = "", suffix = "€")(price_art_sum),
          " - ",
          scales::percent(price_tot_prop, accuracy = 0.01)
        )
      ),
      hjust = 0,
      nudge_x = 0.055,
      size = 5
    ) +
    scale_y_continuous(trans = "reverse", expand = c(0, 0.5)) +
    scale_x_discrete(expand = c(0.15, 2)) +
    guides(color = FALSE) +
    labs(title = "&nbsp;")
)

Treemap

Para crear el gráfico de tipo treemap usamos el paquete treemapify.

(treemap <- ggplot(datos, aes(
  area = price_art_sum,
  subgroup = price_art_sum,
  label = paste0("Art. ", articles, "\n", scales::dollar_format(prefix ="", suffix ="€", big.mark =".", decimal.mark = ",")(price_art_sum), "\n", scales::percent(price_tot_prop, accuracy = 0.01)),
  fill = as.factor(level)
)) +
  geom_treemap() +
  geom_treemap_text(
    grow = FALSE,
    reflow = TRUE,
    color = "#2e3440",
    padding.x = grid::unit(2, "mm"),
    padding.y = grid::unit(2, "mm")
  ) +
  geom_treemap_subgroup_border(colour = "#3e3d40", size = 3) +
  guides(fill = FALSE) +
  labs(title = scales::dollar_format(prefix="",suffix = "€")(sum(datos_pivot$price_art_sum) / 2))
)

Listas de artículos

Vamos a generar dos listas de artículos:

• Artículos sancionados, que tienen que alinearse correctamente con el gráfico de barras por número de infracciones.
• A modo de información contextual, también mostraremos una lista con los artículos sancionables que NO aparecen en los datos. Para este gráfico usaremos el conjunto de datos nulos que hemos creado anteriormente. Facetaremos esta lista por tipo de multa. Este gráfico no forma parte del bloque principal, por lo que el título está estilizado de una forma distinta al resto de los gráficos.

En ambas listas mostraremos el título del artículo.

(
  lista_articulos_si <-
    ggplot(
      data = datos_pivot %>% filter(pos_X == "puesto_n"),
      aes(1, ranking, color = as.factor(level))
    ) +
    geom_text(aes(label = paste0(
      "Art. ", articles, " - ", title
    )), hjust = 0, size = 5) +
    scale_y_continuous(trans = "reverse", expand = c(0, 0.5)) +
    scale_x_continuous(limits = c(0.99, 12)) +
    guides(color = FALSE) +
    labs(title = "Artículo infringido")
)

(
  lista_articulos_no <-
    ggplot(nulos, aes(1, ranking, color = as.factor(level))) +
    geom_text(aes(label = paste0(
      "Art. ", articles, " - ", title
    )), hjust = 0, size = 4) +
    facet_wrap( ~ level, nrow = 1) +
    scale_y_continuous(trans = "reverse", expand = c(0, 0.5)) +
    scale_x_continuous(limits = c(0.99, 12)) +
    guides(color = FALSE) +
    labs(title = "Artículos no sancionados") +
    theme(
      plot.title = element_textbox_simple(
        color = "#d8dee9",
        size = 16,
        padding = margin(5.5, 5.5, 5.5, 5.5),
        width = unit(0.99, "npc"),
        halign = 0
      ),
      plot.margin = unit(c(1, 1, 2, 1), "cm"),
      strip.text = element_blank()
    )
)

Tema

Creamos una paleta de colores y modificamos el título del tema theme_void() que aplicaremos a todos los gráficos (esta modificación sólo afectará a los gráficos que no tengan ya el título modificado).

colores <- c("#d08770", "#8fbcbb", "#81a1c1")

theme_set(theme_void(base_size = 11, base_family = "Bahnschrift"))
theme_update(plot.title = element_textbox_simple(color = "#2e3440", fill = "#d8dee9", size = 16, padding = margin(5.5, 5.5, 5.5, 5.5), width = unit(0.99, "npc")))

Composición

Para la composición final usaremos patchwork

• Igualamos las dimensiones de los gráficos para que se alineen correctamente
• Creamos el sistema de retícula: patchwork permite indicar las retículas de varias formas: operadores (+, -, |, /), mediante letras o números, o indicando expresamente las áreas que ocuparán cada uno de los gráficos. Esta última opción es probablemente la más compleja, pero también la más versátil. En cualquier caso, si indicamos el sistema de esta forma, no debemos combinarlo con el de operadores (más allá del operador +, ya que es posible generar un error de interpretación).

max_dims <- get_max_dim(lista_articulos_si, items, slope, cuantia, treemap)
set_dim(lista_articulos_si, max_dims)

set_dim(items, max_dims)

set_dim(slope, max_dims)

set_dim(cuantia, max_dims)

set_dim(treemap, max_dims)

layout <- c(
 area(1,5,1,7),
 area(2,1,3,2),
 area(2,3,3,3),
 area(2,4,3,5),
 area(2,6,3,6),
 area(2,7,3,7)
)

plot(layout)

infografia <- lista_articulos_no +
  lista_articulos_si + items + slope + cuantia + treemap +
  plot_layout(design = layout) &
  plot_annotation(subtitle = "<span style='font-size:20pt;font-weight:bold;'>**Multas por la GDPR desglosadas por artículos**</span><br><br>El artículo 83 de la GDPR recoge <span style='color:#8fbcbb'>multas de hasta **10.000.000 €**</span> y <span style='color:#81a1c1'>multas de hasta **20.000.000 €**</span> (los artículos <span style='color:#d08770'>83 y 4</span> parecen estar<br>mal codificados, ya que no comportan cuantías económicas).<br><br>Las multas analizadas pueden recoger más de una infracción de distintos artículos de la ley; los datos de las multas se han desglosado<br>por artículo, a fin de poder análizar cuáles son los artículos más infringidos, <br>así como la cuantía acumulada por cada artículo.<br><br>**NOTA**: no hay datos desagregadosen para aquellos casos en los que se ha multado más de una infracción, por lo que se ha procedido<br>a dividir el monto total entre el número de artículos infringidos.",
                  caption ="@neregauzak | #tidytuesday 2020-04-21 | data: privacyaffairs.com") &
  scale_color_manual(values = colores) &
  scale_fill_manual(values = colores) &
  theme(plot.background = element_rect(fill = "#2e3440", color = "#2e3440"),
        plot.subtitle = element_markdown(color = "#d8dee9", size = 16, margin = unit(c(5, 5, 10, 5), "mm")),
        plot.caption = element_markdown(color = "#d8dee9", size = 16, margin = unit(c(5,5,5,5),"mm"))
  )

Lamentablemente, no he dado con la forma de hacer “flotar” (a la CSS) el bloque con el título y el subtítulo, por lo que el montaje final lo he terminado con Gimp (simplemente consiste en bajar es bloque y recortar la imagen).

ggsave("infografia.png", infografia, dpi = 96, width = 25, height = 15)

Resultado final (con mínima edición en gimp)