library (ggplot2)
# Theming and styling elements ----
# Named colour vector, good for everyone's sanity
licorice_gargle_colours <- c (
"Licorice" = "#39496a" ,
"Sugar" = "#c592c7" ,
"Highlight" = "#f8f28b" ,
"Dark text" = "#1A2231" ,
"Light text" = "#383F4C" ,
"Background" = "#F8F1F8"
)
# Our theme (we dropped the marquee styling because it didn't play nicely with ggiraph
theme_licorice <- function (base_text_size = 20 ) {
theme_minimal (base_size = base_text_size) +
theme (
text = element_text (family = "Atkinson Hyperlegible" ),
geom = element_geom (
ink = licorice_gargle_colours["Light text" ],
borderwidth = 0.5 ,
linewidth = 0.2 ,
family = "Atkinson Hyperlegible"
),
plot.background = element_rect (
fill = licorice_gargle_colours["Background" ],
colour = licorice_gargle_colours["Background" ]
),
panel.grid = element_line (colour = "white" ),
axis.line.x = element_line (
colour = licorice_gargle_colours["Light text" ],
linewidth = 0.2
),
axis.text.x = element_text (size = rel (1.2 ), face = "bold" ),
plot.title = marquee:: element_marquee (
size = rel (1.5 ),
colour = licorice_gargle_colours["Dark text" ],
width = 1 ,
vjust = 0 ,
margin = margin (base_text_size * 1.5 , 0 , 0 , 0 ),
style = highlight_style,
lineheight = 1.05
),
plot.subtitle = ggtext:: element_textbox_simple (
colour = licorice_gargle_colours["Light text" ],
lineheight = 1.3 ,
margin = margin (base_text_size * 0.75 , 0 , base_text_size, 0 )
),
legend.position = "none" ,
plot.margin = margin_auto (base_text_size * 1.5 )
)
}
# Our background-to-red gradient
bg_to_red <- grid:: linearGradient (
colours = c (licorice_gargle_colours["Background" ], "red" ),
x1 = 0 ,
y1 = 0 ,
x2 = 0 ,
y2 = 1 ,
group = TRUE
)
# Marquee styling (we don't end up using this)
highlight_style <- marquee:: classic_style (weight = "bold" ) |>
marquee:: modify_style (
"sugar" ,
background = licorice_gargle_colours["Sugar" ],
# US spelling of colour/color required!
color = licorice_gargle_colours["Dark text" ],
padding = marquee:: trbl (marquee:: em (0.1 ))
) |>
marquee:: modify_style (
"licorice" ,
background = licorice_gargle_colours["Licorice" ],
color = "white" ,
padding = marquee:: trbl (marquee:: em (0.1 ))
)
# Getting the data ready ----
# For our first plot
tidied_data <- medicaldata:: licorice_gargle |>
dplyr:: mutate (
gender = factor (
dplyr:: case_when (
preOp_gender == 0 ~ "Male" ,
preOp_gender == 1 ~ "Female"
)
),
id = dplyr:: row_number (),
treatment = factor (dplyr:: case_when (
treat == 0 ~ "Sugar" ,
treat == 1 ~ "Licorice"
))
) |>
dplyr:: left_join (
babynames:: babynames |>
dplyr:: group_by (sex) |>
dplyr:: mutate (id = dplyr:: row_number ()) |>
dplyr:: select (sex, name, id) |>
dplyr:: mutate (
sex = factor (dplyr:: case_when (
sex == "F" ~ "Female" ,
sex == "M" ~ "Male"
))
),
by = dplyr:: join_by (gender == sex, id == id)
) |>
dplyr:: rowwise () |>
dplyr:: mutate (
praise = paste (
sample (
praise:: praise_parts$ adverb_manner,
1
),
sample (praise:: praise_parts$ adjective, 1 )
)
) |>
dplyr:: ungroup ()
# For our timeline plot
timeline_data <- tidied_data |>
dplyr:: select (
gender,
name,
praise,
treatment,
preOp_age,
pacu30min_throatPain,
pacu90min_throatPain,
postOp4hour_throatPain,
pod1am_throatPain
) |>
tidyr:: pivot_longer (
- c (gender, name, praise, treatment, preOp_age),
names_to = "timeline" ,
values_to = "pain"
) |>
dplyr:: mutate (
timeline = factor (
timeline,
levels = c (
"pacu30min_throatPain" ,
"pacu90min_throatPain" ,
"postOp4hour_throatPain" ,
"pod1am_throatPain"
),
labels = c ("30mins" , "90mins" , "4hours" , "Next morning" ),
ordered = TRUE
)
)
# For our rectangles in the timeline data plot
mean_pain <- timeline_data |>
dplyr:: group_by (timeline, treatment, gender) |>
dplyr:: summarise (mean_pain = mean (pain, na.rm = TRUE )) |>
dplyr:: ungroup ()
# The plots ----
interactive_cough_plot <- ggplot (
tidied_data,
aes (x = gender, y = pod1am_cough, fill = treatment)
) +
geom_rect (
data = tidied_data |> tail (1 ),
aes (xmin = I (0.1 ), xmax = I (0.9 ), ymin = 0 , ymax = 3.5 ),
fill = bg_to_red,
alpha = 0.1
) +
ggiraph:: geom_point_interactive (
aes (
tooltip = paste0 ("<b>" , name, "</b>, " , preOp_age, ", is " , praise),
data_id = name,
group = treatment
),
alpha = 0.8 ,
position = position_jitterdodge (
jitter.height = 0.05 ,
jitter.width = 0.2 ,
dodge.width = 0.25
),
shape = 21 ,
size = 5
) +
stat_summary (
aes (ymin = after_stat (y), ymax = after_stat (y), colour = treatment),
fun = function (x) mean (x, na.rm = TRUE ),
geom = "crossbar" ,
width = 0.5
) +
stat_summary (
aes (
label = janitor:: round_half_up (after_stat (y), 2 ),
group = treatment
),
fun = function (x) mean (x, na.rm = TRUE ),
geom = "text" ,
position = position_nudge (y = 0.06 ),
colour = "black" ,
size = 16 ,
size.unit = "pt"
) +
geom_text (
data = tibble:: tibble (
y_coord = c (0 , 1 , 2 , 3 ),
severity = c ("No cough" , "Mild" , "Moderate" , "Severe cough" )
),
aes (
x = I (0.5 ),
y = y_coord,
label = severity,
fill = NULL
)
) +
labs (
title = paste0 (
"Patients who gargled <span style='color:" ,
licorice_gargle_colours["Licorice" ],
"'>Licorice</span> reported a slightly less severe cough than those who gargled <span style='color:" ,
licorice_gargle_colours["Sugar" ],
"'>Sugar</span>"
),
subtitle = "The effect was similar across Female and Male patients, on the morning after surgery."
) +
scale_fill_manual (values = licorice_gargle_colours) +
scale_colour_manual (values = licorice_gargle_colours) +
theme_licorice () +
theme (
plot.title = ggtext:: element_textbox_simple (
size = rel (1.5 ),
face = "bold" ,
margin = margin (30 , 0 , 15 , 0 ),
vjust = 0
),
axis.title.y = element_blank (),
axis.text.y = element_blank (),
axis.title.x = element_blank (),
legend.title = element_blank (),
panel.grid.major.x = element_blank (),
panel.grid.major.y = element_blank ()
)
# This is used by layout = "fixed" later
update_geom_defaults (
geom = "point" ,
aes (
colour = "white" ,
fill = licorice_gargle_colours["Light text" ],
shape = 21 ,
size = 4 ,
alpha = 0.5
)
)
timeline_graph <- ggplot (timeline_data, aes (x = timeline, y = pain)) +
geom_rect (
data = mean_pain,
aes (
xmin = as.numeric (timeline) - 0.5 ,
xmax = as.numeric (timeline) + 0.5 ,
ymin = - Inf ,
ymax = Inf ,
fill = "red" ,
alpha = mean_pain
),
inherit.aes = FALSE
) +
scale_alpha (range = c (0.05 , 0.25 )) +
# Slight fudge!
geom_point (
layout = "fixed" ,
alpha = 0.1
) +
# Move lines to back for easier interaction
ggiraph:: geom_line_interactive (
aes (
group = name,
colour = treatment,
data_id = name,
tooltip = paste0 ("<b>" , name, "</b>, " , preOp_age, ", is " , praise)
),
alpha = 0.3
) +
ggiraph:: geom_jitter_interactive (
aes (
x = timeline,
y = pain,
colour = treatment,
data_id = name,
tooltip = paste0 ("<b>" , name, "</b>, " , preOp_age, ", is " , praise)
),
height = 0.1 ,
width = 0.1 ,
alpha = 0.6
) +
scale_colour_manual (values = c ("Sugar" = "#c592c7" , "Licorice" = "#39496a" )) +
scale_x_discrete (labels = function (x) {
# Thank you, Claude!
stringr:: str_wrap (gsub ("([0-9])([a-zA-Z])" , " \\ 1 \\ 2" , x), 5 )
}) +
facet_grid (treatment ~ gender) +
labs (
title = "The Licorice effect on pain reduction was most visible within the first 4 hours after surgery" ,
subtitle = "Pain was rated 0 = no pain to 10 = worst pain, but the maximum pain reported was 6."
) +
theme_licorice () +
theme (
legend.position = "none" ,
axis.title.y = element_blank (),
axis.title.x = element_blank (),
strip.text.y = element_text (angle = 0 ),
# To get the two titles to look the same; I probably should have edited our reusable theme instead!
plot.title = ggtext:: element_textbox_simple (
size = rel (1.5 ),
face = "bold" ,
margin = margin (30 , 0 , 15 , 0 ),
vjust = 0
)
)
# Tie the plots together ----
# The key here is a common data_id. If you look carefully, you'll see
# we have both a female and a male patient called Ora.
# Be careful what you choose as your data_id!
library (patchwork)
ggiraph:: girafe (
ggobj = interactive_cough_plot +
timeline_graph +
plot_layout (heights = c (1 , 1 ), widths = c (1 , 1 ), nrow = 1 ),
height_svg = 15 ,
width_svg = 25 ,
options = list (
ggiraph:: opts_hover (
css = "stroke:#f8f28b;stroke-width:5px;stroke-opacity:1;opacity:1;fill:#f8f28b;"
),
ggiraph:: opts_tooltip (
css = "background-color:#383F4C;color:#F8F1F8;padding:7.5px;letter-spacing:0.025em;line-height:1.3;border-radius:5px;font-family:'Atkinson Hyperlegible';" ,
opacity = 0.9 ,
offy = 10
),
ggiraph:: opts_sizing (width = 1 ),
ggiraph:: opts_hover_inv (css = "opacity:0.5" )
)
)