Arrange multiple plots into a grid

There are two avalaible options to arrange ggiraph outputs into a grid. As ggiraph is mainly only new geoms, package cowplot and patchwork can be used seamlessly.

library(ggplot2)
library(ggiraph)
library(patchwork)
library(cowplot)

mtcars <- mtcars
mtcars$tooltip <- rownames(mtcars)

gg1 <- ggplot(mtcars) +
  geom_point_interactive(aes(x = drat, y = wt, color = qsec, 
    tooltip = tooltip, data_id = tooltip ), size = 4) 

gg2 <- ggplot(mtcars) +
  geom_point_interactive(aes(x = qsec, y = disp, color = mpg, 
    tooltip = tooltip, data_id = tooltip ), size = 4)

Using cowplot

Mouseover points to see where they are located in the other graph.

girafe( ggobj = plot_grid(gg1, gg2), width_svg = 8, height_svg = 4)

Using patchwork

Mouseover points to see where they are located in the other graph.

girafe( code = print(gg1 + gg2), width_svg = 8, height_svg = 4)

Inversed hovering

library(ggplot2)
library(ggiraph)
library(data.table)
library(charlatan)

species <- ch_taxonomic_species(n = 10)
dat <- lapply(species, function(species, n){
  data.table(
    date = as.Date(seq_len(n), origin = "2018-10-25"),
    sales = cumsum(runif(n, -1, 1)),
    species = species,
    name = ch_name(n = n)
  )
}, n = 200)
dat <- rbindlist(dat)

gg <- ggplot(dat, aes(x = date, y = sales, 
                      colour = species, group = species)) +
  geom_line_interactive(aes(tooltip = name, data_id = species)) +
  scale_color_viridis_d() + 
  labs(title = "move mouse over lines")

x <- girafe(ggobj = gg, width_svg = 8, height_svg = 6,
  options = list(
    opts_hover_inv(css = "opacity:0.1;"),
    opts_hover(css = "stroke-width:2;")
  ))
x

CEO voluntary and involuntary departures

Thank to Martín Pons (@MartinPonsM) that kindly shared his code with us.

First of all, we add some code to correctly manage the “Open Sans” fonts that must be embedded in the Web page but also used to generate the graphic.

library(gfonts)
library(systemfonts)

if(!dir.exists("fonts")) dir.create("fonts")
variants <- c("regular", "italic", "700", "700italic")
if(!file.exists("fonts/css/open-sans.css"))
  setup_font(id = "open-sans", output_dir = "fonts", 
    variants = variants, prefer_local_source = FALSE)

if(!font_family_exists("Open Sans")){
  register_font(name = "Open Sans", 
                plain = list("fonts/fonts/open-sans-v18-latin-regular.woff", 0), 
                bold = list("fonts/fonts/open-sans-v18-latin-700.woff", 0), 
                italic = list("fonts/fonts/open-sans-v18-latin-italic.woff", 0),
                bolditalic = list("fonts/fonts/open-sans-v18-latin-700italic.woff", 0)
  )
}
use_font("open-sans", "fonts/css/open-sans.css", selector = ".dummy-selector")

The following code is a slight adaptation of Martin’s script (https://github.com/MartinPons/tidytuesday_MartinPons/blob/master/2021-17/ceos.R) where only the “Open Sans” font is used.

# Tidytuesday 2021-17. CEO departures
# data comes from Gentry et al. by way of DatalsPlural
library(tidyverse)
library(ggtext)
library(ggiraph)
library(glue)
library(cowplot)
departures <- readRDS(file = "data/departures.RDS")

# DATA WRANGLING ----------------------------------------------------------

departures <- departures %>%
  mutate(
    coname = str_remove(coname, " +INC|CO?(RP)$"),
    motive = case_when(
      departure_code == 1 ~ "Death",
      departure_code == 2 ~ "Health Concerns",
      departure_code == 3 ~ "Job performance",
      departure_code == 4 ~ "Policy related problems",
      departure_code == 5 ~ "Voluntary turnover",
      departure_code == 6 ~ "When to work in other company",
      departure_code == 7 ~ "Departure following a marger adquisition",
      departure_code %in% 8:9 ~ "Unknown"
    )
  )


#  top firms
top_departure_firms_df <- departures %>%
  drop_na(departure_code) %>%
  count(coname) %>%
  arrange(desc(n)) %>%
  slice_max(n,
    n = 20,
    with_ties = F
  )

top_departure_firms <- top_departure_firms_df$coname

# get number of voluntary and involuntary departures
departure_firms_main_cause <- departures %>%
  filter(coname %in% top_departure_firms) %>%
  count(coname, ceo_dismissal) %>%
  mutate(main_cause = case_when(
    ceo_dismissal == 0 ~ "voluntary",
    ceo_dismissal == 1 ~ "involuntary",
    TRUE ~ "unknown"
  )) %>%
  select(-ceo_dismissal) %>%
  pivot_wider(
    names_from = main_cause, values_from = n,
    values_fill = 0
  )

# VISUALIZATION -------------------------------------------------

palette <- c("#894843", "#887d74")
bg_color <- "#d7e0da"


g_bar <-
  # aditional wrangling
  departures %>%
  drop_na(ceo_dismissal) %>%
  filter(coname %in% top_departure_firms) %>%
  left_join(departure_firms_main_cause, by = "coname") %>%
  # to get n of vol and invol. dep. in main data layer

  # plot
  ggplot(aes(fyear)) +

  # bars
  geom_bar_interactive(aes(
    y = 1,
    fill = as.factor(ceo_dismissal),
    tooltip = glue("Firm: {coname}\nCEO: {exec_fullname}\nYear: {fyear}\nMotive: {motive}"),
    data_id = coname
  ),
  color = bg_color,
  stat = "identity",
  size = 1,
  show.legend = F
  ) +
  # firm name text
  geom_text_interactive(aes(1993, 9.2,
    label = glue("Firm: {coname}"),
    data_id = coname
  ),
  color = bg_color,
  size = 2.5,
  hjust = "left",
  # total transparency to hide text when cursor is not hovering over squares
  alpha = 0
  ) +

  # firm vol. and invol. departures text
  geom_text_interactive(
    aes(1993, 8.35,
      label = glue("Voluntary departures: {voluntary}
                     Involuntary departures: {involuntary}"),
      data_id = coname
    ),
    color = bg_color,
    size = 2,
    hjust = "left",
    alpha = 0,
    lineheight = 1
  ) +
  labs(
    title = paste("CEO", "DEPARTURES", sep = "\t"),
    subtitle = "CEO **<span style = 'color:#894843'>voluntary</span>** and 
       **<span style= 'color:#887d74'>involuntary</span>** departures 
       in the 20 *S&P 1500* firms with most CEO rotation between 1993 and 2018",
    caption = "Data comes from Gentry et al. Facilitated by DatalsPlural. Visualization by Martín Pons | @MartinPonsM"
  ) +
  scale_fill_manual(values = palette) +
  scale_x_continuous(limits = c(1992, 2019), labels = c(2000, 2010), breaks = c(2000, 2010)) +
  theme_minimal_hgrid(12) +
  theme(
    text = element_text(color = "#1f3225", family = "Open Sans"),
    plot.title = element_text(hjust = 0.5),
    plot.subtitle = element_textbox(family = "Open Sans", size = 8),
    plot.caption = element_text(size = 6),
    plot.background = element_rect(fill = bg_color, color = bg_color),
    panel.background = element_rect(fill = bg_color, color = bg_color),
    axis.title = element_blank(),
    axis.text.y = element_blank(),
    axis.ticks = element_blank(),
    legend.position = "top"
  ) +
  coord_equal()

Let’s convert the static graphic to a dynamic graphic:

g_inter <- girafe(
  ggobj = g_bar, 
  width_svg = 7, height_svg = 4, bg = "#D7E0DA",
  options = list(
    opts_tooltip(
      opacity = 0.8, use_fill = TRUE,
      use_stroke = FALSE, 
      css = "padding:5pt;font-family: Open Sans;color:white"),
    opts_hover_inv(css = "opacity:0.5"), 
    opts_hover(css = "fill:#4c6061;")
  )
)
g_inter

Facets and interactive strip labels

We will use package ggh4x to make nice nested facets.

We need to use labeller_interactive() to make interactive strip labels.

Let’s create the theme object.

my_theme <- theme(
  text = element_text_interactive(),
  panel.spacing = unit(0, "npc"),
  strip.switch.pad.grid = unit(0, "cm"),
  strip.text = element_text_interactive(color = "white"),
  strip.background = element_rect(fill = "black", colour = "white"),
  strip.placement = "outside",
  axis.text.x = element_blank(), 
  panel.grid = element_blank(),
  panel.grid.major.y = element_line(colour = "#CCCCCC66"),
  panel.background = element_blank(),
  axis.ticks.x = element_blank(),
  axis.line.y = element_line()
)

You must use labeller_interactive() to process the labels:

gg_jitter <- ggplot(diamonds, aes(y = z)) +
  geom_boxplot_interactive(aes(data_id=color, tooltip=color)) +
  facet_nested(~ cut + color ,
    switch = "x", scales = "free_x",
    labeller = labeller(
      cut = labeller_interactive(aes(tooltip = paste("cut:", cut))),
      color = labeller_interactive(aes(tooltip = paste("color:", color)))
    )
  ) + 
  coord_cartesian(ylim = c(0, 9)) +
  labs(x = "", y = "") + 
  my_theme

Finally, let’s create the girafe object:

girafe(
  ggobj = gg_jitter, 
  options = list(
    opts_hover(css = "fill:#5eba7d88;cursor:pointer;"),
    opts_hover_theme(css = "fill:red;cursor:pointer;"),
    opts_selection(css = "fill:#5eba7d;cursor:pointer;", only_shiny = FALSE, selected = "J"),
    opts_tooltip(css = "background-color:white;padding:5px;border-radius:2px;border: black 1px solid;color:black;")
  ),
  width_svg = 8, 
  height_svg = 5
)