6 ‘flextable’ et les grid graphics

Une des fonctionnalités du package flextable est la capacité à travailler avec un format ‘grid graphics’. La fonction gen_grob() génére un ‘grob’ (Graphical Object) à partir d’un flextable, ce dernier peut ensuite être ajouté à un graphique ggplot grace au package ‘patchwork’ ou avec le package ‘grid’.

Ces fonctionnalités nécessitent l’utilisation d’une sortie graphique utilisant ‘systemfonts’ : svglite::svglite(), ragg::agg_png() ou ggiraph::dsvg(). Ces packages doivent être utilisés pour garantir que toutes les polices que vous utilisez seront reconnues par le moteur graphique R.

6.1 Illustration avec grid

6.1.1 Créer un tableau

Code

library(palmerpenguins)
ft <- as_flextable(penguins)
ft

species	island	bill_length_mm	bill_depth_mm	flipper_length_mm	body_mass_g	sex	year
factor	factor	numeric	numeric	integer	integer	factor	integer
Adelie	Torgersen	39.1	18.7	181	3,750	male	2,007
Adelie	Torgersen	39.5	17.4	186	3,800	female	2,007
Adelie	Torgersen	40.3	18.0	195	3,250	female	2,007
Adelie	Torgersen						2,007
Adelie	Torgersen	36.7	19.3	193	3,450	female	2,007
Adelie	Torgersen	39.3	20.6	190	3,650	male	2,007
Adelie	Torgersen	38.9	17.8	181	3,625	female	2,007
Adelie	Torgersen	39.2	19.6	195	4,675	male	2,007
Adelie	Torgersen	34.1	18.1	193	3,475		2,007
Adelie	Torgersen	42.0	20.2	190	4,250		2,007
n: 344

6.1.2 Utilisation de gen_grob et de grid

Le seul élément de flextable à utiliser est la fonction gen_grob(), le reste du code concerne des opérations ‘grid’.

Code

library(grid)
grid.raster(magick::image_read("img/lter_penguins.png"))
grid.rect(gp = gpar(col = "transparent", fill = radialGradient(
  colours = c(
    adjustcolor("white", .6),
    adjustcolor("#f2af00", .8),
    adjustcolor("#c32900", .7)
  ),
  stops = c(0, .7, 1)
)))
grid.text(y = .1, x = .95, just = "right",
  label = "Size measurements for adult foraging penguins near Palmer Station, Antarctica", 
  gp = gpar(col = "white", fontsize = 10, fontfamily = "Open Sans", fontface = "italic"))
grid.text(y = .9, 
  label = "Made with packages 'grid', 'flextable', 'ragg' and 'palmerpenguins'", 
  gp = gpar(col = "white", fontsize = 14, fontfamily = "Permanent Marker"))

pushViewport(viewport(width = .95, height = .75, gp = gpar(col = "transparent")))
grid.circle(gp = gpar(fill = adjustcolor("white", .9)), r = .4)
grid.draw(gen_grob(ft, just = "center", scaling = "min", fit = "width"))
popViewport()

6.2 Superposer avec un ggplot

La dataviz dont nous nous sommes inspiré est disponible à l’adresse https://insights.datylon.com/stories/oDHVikVxaCaCGWRFGMdPgA.

6.2.1 Récupérer les données

Code

library(readxl)
library(tidyverse)
library(magick)
## Linking to ImageMagick 6.9.11.60
## Enabled features: fontconfig, freetype, fftw, heic, lcms, pango, webp, x11
## Disabled features: cairo, ghostscript, raw, rsvg
## Using 2 threads

scoring_data <- read_excel("data/default_workbook.xlsx",
           sheet = "Scoring data") %>% 
  rename(name = NAME, pts = PTS, fgp = "FG%", group = Group) %>% 
  mutate(pts = as.double(pts),
         fgp = as.double(fgp))
scoring_data

name	fgp	pts	group
character	numeric	numeric	character
Joel Embiid	49.9	30.6	Ineffective high-scorer
LeBron James	52.4	30.3	Effective high-scorer
Giannis Antetokounmpo	55.3	29.9	Effective high-scorer
Kevin Durant	51.8	29.9	Effective high-scorer
Luka Doncic	45.7	28.4	Ineffective high-scorer
Trae Young	46.0	28.4	Ineffective high-scorer
DeMar DeRozan	50.4	27.9	Effective high-scorer
Kyrie Irving	46.9	27.4	Ineffective high-scorer
Ja Morant	49.3	27.4	Ineffective high-scorer
Nikola Jokic	58.3	27.1	Effective high-scorer
n: 581

Pour les images du tableau, il faut créer manuellement un data.frame. On va télécharger chaque image dans un fichier temporaire car flextable ne gère que les images disponible localement.

Code

head_shot <- tibble::tribble(
  ~name, ~url,
  "Joel Embiid", "https://cdn.nba.com/headshots/nba/latest/1040x760/203954.png",
  "LeBron James", "https://cdn.nba.com/headshots/nba/latest/1040x760/2544.png",
  "Giannis Antetokounmpo", "https://cdn.nba.com/headshots/nba/latest/1040x760/203507.png",
  "Kevin Durant", "https://cdn.nba.com/headshots/nba/latest/1040x760/201142.png",
  "Trae Young", "https://cdn.nba.com/headshots/nba/latest/1040x760/1629027.png",
  "Luka Doncic", "https://cdn.nba.com/headshots/nba/latest/1040x760/1629029.png"
) %>% 
  mutate(url = map_chr(url, function(z) {
    path <- tempfile(fileext = ".png")
    image_read(z) %>% 
      image_resize(geometry = "144x") %>% 
      image_write(path = path)
    path
  }))

Le tableau ‘Q3_data’ va être utilisé lors de la construction du ggplot.

Code

Q3_data <- summarise(scoring_data, 
          pts = quantile(pts, probs = .75),
          fgp = quantile(fgp, probs = .75)
          )
Q3_data

pts numeric	11.3
fgp numeric	50

Le tableau ‘scoring_highlight’ va être le tableau principal.

Code

scoring_highlight <- scoring_data %>% 
  arrange(desc(pts), desc(fgp)) %>% 
  slice_max(pts, n = 6) %>%
  left_join(head_shot, by = "name")
scoring_highlight

name	fgp	pts	group	url
character	numeric	numeric	character	character
Joel Embiid	49.9	30.6	Ineffective high-scorer	/tmp/Rtmpwonutx/file18777c329cc5.png
LeBron James	52.4	30.3	Effective high-scorer	/tmp/Rtmpwonutx/file18772ada6edc.png
Giannis Antetokounmpo	55.3	29.9	Effective high-scorer	/tmp/Rtmpwonutx/file187764944e64.png
Kevin Durant	51.8	29.9	Effective high-scorer	/tmp/Rtmpwonutx/file1877454c5c6f.png
Trae Young	46.0	28.4	Ineffective high-scorer	/tmp/Rtmpwonutx/file187767c86f32.png
Luka Doncic	45.7	28.4	Ineffective high-scorer	/tmp/Rtmpwonutx/file18773bf81b9c.png
n: 6

6.2.2 Créer le flextable

Code

theme_scorer <- function(x) {
  border_remove(x) %>% 
    valign(valign = "center", part = "all") %>% 
    align(align = "center", part = "all") %>% 
    fontsize(part = "all", size = 20) %>% 
    bold(part = "header", bold = TRUE) %>%
    bold(part = "body", j = 1, bold = TRUE) %>% 
    color(color = "#b17268", part = "header") %>% 
    bg(part = "header", bg = "transparent")
}

ft <- as_grouped_data(scoring_highlight, groups = c("name"), expand_single = TRUE) %>% 
  as_flextable(hide_grouplabel = TRUE, col_keys = c("url", "fgp", "pts")) %>% 
  set_header_labels(url = "", fgp = "Field goal", pts = "Points") %>%
  mk_par(j = "url", i = ~ !is.na(url),
         value = as_paragraph(
           as_image(url, width = .75, height = 0.54),
           "\n",
           as_i(name)
           )
         ) %>% 
  theme_scorer() %>% 
  align(i = ~!is.na(name), align = "left", part = "body") %>% 
  bg(i = ~ group %in% "Effective high-scorer", bg = "#f8b26399") %>%
  bg(i = ~ group %in% "Ineffective high-scorer", bg = "#b1726899") %>%
  hline(i = rep(c(FALSE, TRUE, FALSE, TRUE), length = nrow_part(.))) %>% 
  autofit()

Nous pouvons déjà transformer le tableau en un graphique.

Code

plot(ft, fit = "fixed", scaling = "fixed", just = "centre")

6.2.3 Création du ggplot

Code

gg <- scoring_data %>% 
  ggplot(mapping = aes(x = fgp, y = pts, color = group)) + 
  geom_point(size = 3, alpha = .7, show.legend = FALSE) +
  scale_color_manual(
    values = c(
      "Effective high-scorer" = "#f8b263",
      "Ineffective low-scorer" = "#819eb2",
      "Ineffective high-scorer" = "#b17268",
      "Effective low-scorer" = "#dad162"
      )) +
  scale_y_continuous(limits = c(0, 40)) + 
  geom_hline(data = Q3_data, aes(yintercept = `pts`)) +
  geom_vline(data = Q3_data, aes(xintercept = fgp)) +
  ggforce::geom_mark_rect(data = scoring_highlight, 
                   mapping = aes(color = NULL),
                   expand = unit(3, "mm"),
                   show.legend = FALSE) +
  annotate(geom = "text", x = 100, y = Q3_data$pts,
           label = "Effective\nhigh-scorer", color = "#f8b263",
           hjust = 1, vjust = -1) + 
  annotate(geom = "text", x = 100, y = Q3_data$pts,
           label = "Effective\nlow-scorer", color = "#dad162",
           hjust = 1, vjust = 2) + 
  annotate(geom = "text", x = 0, y = Q3_data$pts,
           label = "Low-Effective\nhigh-scorer", color = "#819eb2",
           hjust = 0.2, vjust = 2) + 
  annotate(geom = "text", x = 0, y = Q3_data$pts,
           label = "Low-Effective\nlow-scorer", color = "#b17268",
           hjust = .2, vjust = -1) + 
  theme_minimal()
gg

6.2.4 Ajout du flextable dans le ggplot

Code

library(patchwork)
gg + inset_element(
    gen_grob(ft, fit = "width"),
    left = 0.65, bottom = .65, 
    right = 1, top = 1
  )  + theme(
    plot.background = element_rect(fill = "transparent"),
    panel.background = element_rect(fill = "transparent")
  )

6.2.5 Ajout du flextable à côté du ggplot

Code

gg + gen_grob(ft, fit = "width")

Code

# gg + gen_grob(ft, fit = "width") + plot_layout(ncol = 2, widths = c(3, 1))