---
title: "D&D Encounter Design: Celestials Dominate Skill-Based Challenges"
subtitle: "For skill-heavy encounters, Celestials offer 45% expert abilities vs. 24-25% for Dragons and Giants"
description: "An analysis of skill distributions across D&D monster types using TidyTuesday data. This visualization reveals that expert-level skills (11+ bonus) are highly concentrated, with Celestials leading at 45% expert abilities, followed by Giants (25%) and Dragons (24%). Most monster types rely on basic skills, making this insight valuable for DMs planning skill-heavy encounters."
author: "Steven Ponce"
date: "2025-05-26"
categories: ["TidyTuesday", "2025"]
tags: [
"dungeons-and-dragons", "dnd", "monster-analysis","skill-distribution", "stacked-bar-chart",
"ggplot2", "viridis", "cividis", "data-storytelling", "encounter-design", "rpg","tabletop-gaming",
]
image: "thumbnails/tt_2025_21.png"
format:
html:
toc: true
toc-depth: 5
code-link: true
code-fold: true
code-tools: true
code-summary: "Show code"
editor_options:
chunk_output_type: inline
execute:
freeze: true
cache: true
error: false
message: false
warning: false
eval: true
---
{#fig-1}
### <mark> **Steps to Create this Graphic** </mark>
#### 1. Load Packages & Setup
```{r}
#| label: load
#| warning: false
#| message: false
#| results: "hide"
## 1. LOAD PACKAGES & SETUP ----
suppressPackageStartupMessages({
if (!require("pacman")) install.packages("pacman")
pacman::p_load(
tidyverse, # Easily Install and Load the 'Tidyverse'
ggtext, # Improved Text Rendering Support for 'ggplot2'
showtext, # Using Fonts More Easily in R Graphs
janitor, # Simple Tools for Examining and Cleaning Dirty Data
scales, # Scale Functions for Visualization
glue # Interpreted String Literals
)
})
### |- figure size ----
camcorder::gg_record(
dir = here::here("temp_plots"),
device = "png",
width = 8,
height = 10,
units = "in",
dpi = 320
)
# Source utility functions
suppressMessages(source(here::here("R/utils/fonts.R")))
source(here::here("R/utils/social_icons.R"))
source(here::here("R/utils/image_utils.R"))
source(here::here("R/themes/base_theme.R"))
```
#### 2. Read in the Data
```{r}
#| label: read
#| include: true
#| eval: true
#| warning: false
tt <- tidytuesdayR::tt_load(2025, week = 21)
monsters_raw <- tt$monsters |> clean_names()
tidytuesdayR::readme(tt)
rm(tt)
```
#### 3. Examine the Data
```{r}
#| label: examine
#| include: true
#| eval: true
#| results: 'hide'
#| warning: false
glimpse(monsters_raw)
skimr::skim(monsters_raw)
```
#### 4. Tidy Data
```{r}
#| label: tidy
#| warning: false
### |- tidy data ----
monsters_skill <- monsters_raw |>
filter(!is.na(skills)) |>
separate_rows(skills, sep = ",") |>
mutate(
skills = str_trim(skills),
skill_name = str_extract(skills, "^[A-Za-z ]+"),
skill_bonus = str_extract(skills, "\\+\\d+"),
skill_bonus = as.numeric(str_remove(skill_bonus, "\\+"))
) |>
filter(!is.na(skill_name), !is.na(skill_bonus)) |>
mutate(
skill_tier = case_when(
skill_bonus <= 3 ~ "Low (1-3)",
skill_bonus <= 6 ~ "Medium (4-6)",
skill_bonus <= 10 ~ "High (7-10)",
TRUE ~ "Expert (11+)"
),
skill_tier = factor(skill_tier, levels = c("Low (1-3)", "Medium (4-6)", "High (7-10)", "Expert (11+)"))
) |>
count(type, skill_tier) |>
filter(n >= 2) |>
group_by(type) |>
mutate(
total_skills = sum(n),
proportion = n / total_skills,
# Calculate expert percentage for ordering
expert_pct = if_else(skill_tier == "Expert (11+)", proportion, 0)
) |>
group_by(type) |>
mutate(max_expert_pct = max(expert_pct)) |>
ungroup()
```
#### 5. Visualization Parameters
```{r}
#| label: params
#| include: true
#| warning: false
### |- plot aesthetics ----
colors <- get_theme_colors(
palette = c(
"#feb078", "#00204d",
"coral", "coral3", "coral4", "navy"
)
)
### |- titles and caption ----
title_text <- str_glue("D&D Encounter Design: Celestials Dominate Skill-Based\nChallenges")
subtitle_text <- str_glue(
"For skill-heavy encounters, Celestials offer 45% expert abilities vs. 24-25% for \n",
"Dragons and Giants"
)
caption_text <- create_social_caption(
tt_year = 2025,
tt_week = 21,
source_text = "D&D System Reference Document v5.2.1"
)
### |- fonts ----
setup_fonts()
fonts <- get_font_families()
### |- plot theme ----
# Start with base theme
base_theme <- create_base_theme(colors)
# Add weekly-specific theme elements
weekly_theme <- extend_weekly_theme(
base_theme,
theme(
# Axis elements
axis.title = element_text(color = colors$text, face = "bold", size = rel(0.8)),
axis.text = element_text(color = colors$text, size = rel(0.7)),
# Grid elements
panel.grid.minor = element_blank(),
panel.grid.major = element_blank(),
# Legend elements
legend.position = "top",
legend.direction = "horizontal",
legend.title = element_text(family = fonts$tsubtitle, color = colors$text, size = rel(0.8), face = "bold"),
legend.text = element_text(family = fonts$tsubtitle, color = colors$text, size = rel(0.7)),
# Plot margins
plot.margin = margin(t = 15, r = 15, b = 15, l = 15),
)
)
# Set theme
theme_set(weekly_theme)
```
#### 6. Plot
```{r}
#| label: plot
#| warning: false
# Final plot -----
p <- monsters_skill |>
ggplot(aes(x = fct_reorder(type, max_expert_pct), y = proportion, fill = skill_tier)) +
# Geoms
geom_col(position = "fill", alpha = 0.9) +
geom_text(
data = monsters_skill %>%
filter(skill_tier == "Expert (11+)", max_expert_pct > 0.15),
aes(
label = paste0(round(proportion * 100), "%"),
y = proportion / 2
),
color = "black", size = 3.5, fontface = "bold"
) +
# Annotations
annotate("rect",
xmin = 8.5, xmax = 11.5, ymin = -0.01, ymax = 1.01,
fill = colors$palette[3], alpha = 0.12, color = colors$palette[4],
linetype = "solid", linewidth = 1
) +
annotate("rect",
xmin = 0.5, xmax = 3.5, ymin = -0.01, ymax = 1.01,
fill = colors$palette[6], alpha = 0.08, color = colors$palette[6],
linetype = "solid", linewidth = 1
) +
annotate("text",
x = 10.5, y = 1.12, label = "SKILL ELITES",
hjust = 0.5, size = 3.5, fontface = "bold", color = colors$palette[5]
) +
annotate("text",
x = 1.5, y = 1.12, label = "SURPRISINGLY\nLOW-SKILLED",
hjust = 0.5, size = 3.2, fontface = "bold", color = colors$palette[6]
) +
# Scales
scale_fill_viridis_d(option = "cividis", name = "Skill Tier") +
scale_x_discrete() +
scale_y_continuous(
labels = scales::percent_format(),
expand = expansion(mult = c(0.05, 0.05)),
breaks = c(0, 0.3, 0.6, 0.9, NA)
) +
coord_flip(ylim = c(0, 1.15)) +
# Labs
labs(
title = title_text,
subtitle = subtitle_text,
caption = caption_text,
x = NULL,
y = "Proportion of Skills",
fill = "Status",
) +
# Theme
theme(
plot.title = element_text(
size = rel(1.6),
family = fonts$title,
face = "bold",
color = colors$title,
lineheight = 1.1,
margin = margin(t = 5, b = 15)
),
plot.subtitle = element_text(
size = rel(0.9),
family = fonts$subtitle,
color = alpha(colors$subtitle, 0.9),
lineheight = 1.2,
margin = margin(t = 5, b = 20)
),
plot.caption = element_markdown(
size = rel(0.62),
family = fonts$caption,
color = colors$caption,
hjust = 0.5,
margin = margin(t = 10)
)
)
```
#### 7. Save
```{r}
#| label: save
#| warning: false
### |- plot image ----
save_plot(
plot = p,
type = "tidytuesday",
year = 2025,
week = 21,
width = 8,
height = 10
)
```
#### 8. Session Info
::: {.callout-tip collapse="true"}
##### Expand for Session Info
```{r, echo = FALSE}
#| eval: true
#| warning: false
sessionInfo()
```
:::
#### 9. GitHub Repository
::: {.callout-tip collapse="true"}
##### Expand for GitHub Repo
The complete code for this analysis is available in [`tt_2025_21.qmd`](https://github.com/poncest/personal-website/blob/master/data_visualizations/TidyTuesday/2025/tt_2025_21.qmd).
For the full repository, [click here](https://github.com/poncest/personal-website/).
:::
#### 10. References
::: {.callout-tip collapse="true"}
##### Expand for References
1. Data Sources:
- TidyTuesday 2025 Week 21: [Dungeons and Dragons Monsters (2024)](https://github.com/rfordatascience/tidytuesday/blob/main/data/2025/2025-05-27)
:::