make_beak_off_plot <- function (
df = penguin_df,
team_name,
grouping_variable = "species" ,
base_font = "Work Sans" ,
title_font = "Arial" ,
text_size = 16 ,
...
) {
df <- dplyr:: filter (df, ! is.na (get (grouping_variable)))
beak_means_df <- df |>
dplyr:: group_by (get (grouping_variable)) |>
dplyr:: summarise (mean_length = mean (culmen_length_mm, na.rm = TRUE )) |>
dplyr:: rename (group = ` get(grouping_variable) ` )
beak_range_df <- df |>
dplyr:: filter (
culmen_length_mm == max (culmen_length_mm, na.rm = TRUE ) |
culmen_length_mm == min (culmen_length_mm, na.rm = TRUE )
)
interactive_plot <- df |>
ggplot (aes (x = culmen_length_mm, y = get (grouping_variable))) +
geom_vline (
data = beak_range_df,
aes (xintercept = culmen_length_mm),
linetype = 3 ,
colour = "#1A242F"
) +
geom_segment (
data = beak_means_df,
aes (
x = mean_length,
xend = mean_length,
y = - Inf ,
yend = group
),
linetype = 3
) +
ggiraph:: geom_jitter_interactive (
aes (
x = culmen_length_mm,
y = get (grouping_variable),
fill = species,
size = body_mass_g,
tooltip = paste0 ("<b>" , individual_id, "</b> from " , island)
),
shape = 21 ,
width = 0 ,
height = 0.15 ,
colour = "#1A242F" ,
stroke = 0.5
) +
ggtext:: geom_textbox (
data = beak_range_df,
aes (
y = max (df |> dplyr:: pull (get (grouping_variable))),
label = dplyr:: case_when (
culmen_length_mm == min (culmen_length_mm) ~
paste0 ("🞀 " , culmen_length_mm, "mm" ),
TRUE ~ paste0 (culmen_length_mm, "mm" , " đźž‚" )
),
hjust = dplyr:: case_when (
culmen_length_mm == min (culmen_length_mm) ~ 0 ,
TRUE ~ 1
),
halign = dplyr:: case_when (
culmen_length_mm == min (culmen_length_mm) ~ 0 ,
TRUE ~ 1
)
),
family = base_font,
colour = "#1A242F" ,
fontface = "bold" ,
fill = NA ,
box.padding = unit (0 , "pt" ),
box.colour = NA ,
nudge_y = 0.33
) +
ggtext:: geom_textbox (
data = beak_means_df,
aes (
x = mean_length,
y = group,
label = paste0 (
stringr:: str_to_sentence (group),
" mean<br>**" ,
janitor:: round_half_up (mean_length),
"mm**"
)
),
hjust = 0 ,
nudge_y = - 0.3 ,
box.colour = NA ,
family = base_font,
colour = "#1A242F" ,
fill = "#F4F5F6"
) +
labs (
title = paste0 (
"Team " ,
team_name,
" - " ,
max (beak_range_df$ culmen_length_mm) -
min (beak_range_df$ culmen_length_mm),
"mm"
)
) +
scale_fill_manual (
values = c (
"Adelie" = "#F49F03" ,
"Chinstrap" = "#F4B9C4" ,
"Gentoo" = "#11541F"
)
) +
scale_x_continuous (
label = function (x) paste0 (x, "mm" ),
limits = c (30 , 62 )
) +
theme_beak_off (base_font = base_font,
title_font = title_font,
base_text_size = text_size) +
theme (axis.text.y = element_blank (),
...)
ggiraph:: girafe (
ggobj = interactive_plot,
options = list (ggiraph:: opts_tooltip (
css = paste0 ("background-color:#1A242F;color:#F4F5F6;padding:7.5px;letter-spacing:0.025em;line-height:1.3;border-radius:5px;" ,
"font-family:" , base_font, ";" )
)
)
)
}