5 Examples
5.1 CEO departures
Thank to Martín Pons that kindly shared his code with us.
The following code is an adaptation of Martin’s script (https://github.com/MartinPons/tidytuesday_MartinPons/blob/master/2021-17/ceos.R).
The following packages will be used:
library(ggtext)
library(tidyr)
library(dplyr)
library(ggplot2)
library(ggiraph)
library(glue)First let’s define some color variables and labels to make the ggplot code lighter and get a clear script.
voluntary_col <- "#894843"
involuntary_col <- "#887d74"
bg_color <- "#D7E0DA"
font_color <- "#1f3225"
hover_color <- "#4c6061"
title <- "CEO DEPARTURES"
subtitle <- glue("CEO **<span style = 'color:{voluntary_col}'>voluntary</span>** and
**<span style= 'color:{involuntary_col}'>involuntary</span>** departures
in the 20 *S&P 1500* firms<br>with most CEO rotation between 1993 and 2018")
caption <- "Data comes from Gentry et al. Facilitated by DatalsPlural. Visualization by Martín Pons | @MartinPonsM"The ggplot theme defined below is used to produce the graphic:
departures_theme <- theme(
text = element_text(color = font_color, family = "Open Sans"),
plot.title = element_text(hjust = 0.5),
plot.subtitle = element_textbox(halign = .5, hjust = .5, family = "Open Sans", size = 8),
plot.caption = element_text(size = 6, hjust = .9),
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(),
panel.grid = element_blank()
)The data is read and an aggregation is computed.
departures <- readRDS('data/departures.RDS')
departuresconame | main_cause | tooltip | fyear |
|---|---|---|---|
character | factor | glue | numeric |
BARRICK GOLD | voluntary | Firm: BARRICK GOLD | 1997 |
BARRICK GOLD | voluntary | Firm: BARRICK GOLD | 2008 |
BARRICK GOLD | voluntary | Firm: BARRICK GOLD | 2007 |
DANA | voluntary | Firm: DANA | 1998 |
n: 148 | |||
# get number of voluntary and involuntary departures
departure_firms_main_cause <- departures %>%
count(coname, main_cause) %>%
pivot_wider(
names_from = main_cause, values_from = n,
values_fill = 0) %>%
mutate(
firm_label = glue("{coname}:\nVoluntary departures: {voluntary}\nInvoluntary departures: {involuntary}")
)
departure_firms_main_causeconame | voluntary | involuntary | firm_label |
|---|---|---|---|
character | integer | integer | glue |
BARNES & NOBLE | 4 | 3 | BARNES & NOBLE: |
BARRICK GOLD | 5 | 3 | BARRICK GOLD : |
BIOLASE | 2 | 5 | BIOLASE: |
CALLAWAY GOLF CO | 4 | 3 | CALLAWAY GOLF CO: |
n: 20 | |||
It’s now easy to produce the code that will create the interactive (or static) ggplot graphic.
gg_departures <- ggplot(data = departures, mapping = aes(fyear)) +
geom_col_interactive(
mapping = aes(y = 1, fill = main_cause,
tooltip = tooltip, data_id = coname),
color = bg_color, linewidth = 1, show.legend = FALSE) +
geom_text_interactive(
data = departure_firms_main_cause,
aes(x = 1994, y = 9.2, label = firm_label, data_id = coname),
color = hover_color, size = 2.5, hjust = "left", alpha = 0) +
labs(title = title, subtitle = subtitle, caption = caption) +
scale_fill_manual(values = c(voluntary_col, involuntary_col)) +
scale_x_continuous(labels = formatC, breaks = seq(1995, 2015, by=5)) +
departures_theme +
coord_equal()Now let’s convert the static graphic to a dynamic graphic:
girafe(
ggobj = gg_departures,
bg = bg_color,
options = list(
opts_tooltip(
opacity = 0.8, use_fill = TRUE,
use_stroke = FALSE,
css = "padding:5pt;font-family: Open Sans;font-size:1rem;color:white"),
opts_hover_inv(css = "opacity:0.4"),
opts_toolbar(saveaspng = FALSE),
opts_zoom(max = 1),
opts_hover(
css = girafe_css(
css = glue("fill:{font_color};"),
text = glue("stroke:none;fill:{font_color};fill-opacity:1;")
))
)
)5.2 Interactive boxplot with outlier labels
This example shows how to build a boxplot that displays interactive outlier points and links them to a scatter plot via a shared data_id.
The approach is simple: use geom_boxplot_interactive() with outlier.shape = NA to suppress default outliers, then flag outlier rows in the data and add them as a separate interactive layer.
5.2.1 Data preparation
library(ggplot2)
library(ggiraph)
library(dplyr)
library(flextable)
library(patchwork)
dat <- mtcars |>
tibble::rownames_to_column("carname") |>
mutate(cyl = factor(cyl))
# flag outliers per group (same 1.5*IQR rule as geom_boxplot)
dat <- dat |>
mutate(
Q1 = quantile(mpg, 0.25),
Q3 = quantile(mpg, 0.75),
is_outlier = mpg < (Q1 - 1.5 * (Q3 - Q1)) | mpg > (Q3 + 1.5 * (Q3 - Q1)),
.by = cyl
)5.2.2 Boxplot with labelled outliers
The boxes are drawn by ggplot2’s default stat. Outlier points are added separately with their car name as tooltip and label:
gg_box <- ggplot(dat, aes(x = cyl, y = mpg)) +
geom_boxplot_interactive(
aes(fill = cyl, tooltip = cyl, data_id = cyl),
outlier.shape = NA,
show.legend = FALSE
) +
geom_quasirandom_interactive(
data = \(d) filter(d, is_outlier),
aes(tooltip = carname, data_id = carname),
color = "red", size = 2.5
) +
labs(y = "Miles per gallon", x = "Cylinders")
girafe(
ggobj = gg_box,
options = list(
opts_hover(css = "fill:orange;stroke:black;"),
opts_tooltip(css = "padding:5px;background:#333;color:white;border-radius:3px;")
)
)5.2.3 Linked boxplot and scatter plot
The same data_id = carname is used in both plots. Hovering a point in either plot highlights the same car in the other:
gg_box1 <- ggplot(dat, aes(x = cyl, y = disp)) +
geom_boxplot_interactive(
aes(fill = cyl, tooltip = cyl),
outlier.shape = NA,
show.legend = FALSE
) +
geom_quasirandom_interactive(
aes(tooltip = carname, data_id = carname),
size = 2, alpha = 0.7
)
gg_box2 <- ggplot(dat, aes(y = cyl, x = mpg)) +
geom_boxplot_interactive(
aes(fill = cyl, tooltip = cyl),
outlier.shape = NA,
show.legend = FALSE
) +
geom_quasirandom_interactive(
aes(tooltip = carname, data_id = carname),
size = 2, alpha = 0.7
)
gg_scatter <- ggplot(dat, aes(x = mpg, y = disp)) +
geom_point_interactive(
aes(
color = cyl,
tooltip = sprintf("<b>%s</b><br/>wt: %.1f | mpg: %.1f", carname, wt, mpg),
data_id = carname
),
hover_nearest = TRUE, size = 3
)
design <- "AB
CD"
ptch <- gg_box2 + guide_area() + gg_scatter + gg_box1 +
plot_layout(design = design, guides = 'collect')
girafe(
ggobj = ptch,
width_svg = 9, height_svg = 8,
options = list(
opts_hover(css = "fill:orange;stroke:black;r:5pt;"),
opts_hover_inv(css = "opacity:0.2;"),
opts_tooltip(css = "padding:5px;background:#333;color:white;border-radius:3px;")
)
)5.3 HTML tooltips with htmltools::HTML()
By default, ggiraph escapes HTML markup in tooltips and converts newline characters to <br/> tags. To use rich HTML content in tooltips, wrap the text with htmltools::HTML() so that the markup is preserved as-is.
library(ggplot2)
library(ggiraph)
library(htmltools)
dat <- mtcars |>
tibble::rownames_to_column("carname") |>
transform(cyl = factor(cyl))
dat$tooltip <- mapply(
\(car, mpg, hp, wt) {
HTML(sprintf(
"<div style='font-family:sans-serif;font-size:.85rem;'>
<b style='color:orange;'>%s</b><br/>
<table style='margin-top:4px;'>
<tr><td>mpg </td><td><b>%.1f</b></td></tr>
<tr><td>hp </td><td><b>%.0f</b></td></tr>
<tr><td>wt </td><td><b>%.2f</b></td></tr>
</table></div>",
car, mpg, hp, wt
))
},
dat$carname, dat$mpg, dat$hp, dat$wt
)
gg <- ggplot(dat, aes(x = wt, y = mpg)) +
geom_point_interactive(
aes(color = cyl, tooltip = tooltip, data_id = carname),
hover_nearest = TRUE, size = 3
) +
labs(x = "Weight (1000 lbs)", y = "Miles per gallon")
girafe(
ggobj = gg,
options = list(
opts_hover(css = "fill:orange;stroke:black;r:5pt;"),
opts_tooltip(css = "padding:8px;background:#333;color:white;border-radius:5px;")
)
)