Show Code
#Load dependencies
library(tidyverse)
library(tidytuesdayR)Dungeons and Dragons Monsters
Facet grid
Barplot
R
Load Data
Show Code
# Load data
tuesdata <- tidytuesdayR::tt_load(2025, week = 21)
monsters <- tuesdata$monsters
rm(tuesdata)
#View(monsters)Examine Data
Show Code
summary(monsters) name category cr size
Length:330 Length:330 Min. : 0.000 Length:330
Class :character Class :character 1st Qu.: 0.500 Class :character
Mode :character Mode :character Median : 2.000 Mode :character
Mean : 4.551
3rd Qu.: 6.000
Max. :30.000
type descriptive_tags alignment ac
Length:330 Length:330 Length:330 Min. : 5.00
Class :character Class :character Class :character 1st Qu.:12.00
Mode :character Mode :character Mode :character Median :14.00
Mean :14.29
3rd Qu.:17.00
Max. :25.00
initiative hp hp_number speed
Min. :-5.000 Length:330 Min. : 1.00 Length:330
1st Qu.: 1.000 Class :character 1st Qu.: 18.25 Class :character
Median : 2.000 Mode :character Median : 52.00 Mode :character
Mean : 3.148 Mean : 86.67
3rd Qu.: 4.000 3rd Qu.:119.00
Max. :20.000 Max. :697.00
speed_base_number str dex con
Min. : 5.00 Min. : 1.00 Min. : 1.00 Min. : 8.00
1st Qu.:30.00 1st Qu.:11.00 1st Qu.:10.00 1st Qu.:12.00
Median :30.00 Median :16.00 Median :13.00 Median :14.50
Mean :30.88 Mean :15.38 Mean :12.83 Mean :15.18
3rd Qu.:40.00 3rd Qu.:19.00 3rd Qu.:15.00 3rd Qu.:17.00
Max. :60.00 Max. :30.00 Max. :28.00 Max. :30.00
int wis cha str_save
Min. : 1.000 Min. : 3.00 Min. : 1.000 Min. :-5.000
1st Qu.: 2.000 1st Qu.:10.00 1st Qu.: 5.000 1st Qu.: 0.000
Median : 7.000 Median :12.00 Median : 8.000 Median : 3.000
Mean : 7.864 Mean :11.82 Mean : 9.918 Mean : 2.676
3rd Qu.:12.000 3rd Qu.:13.00 3rd Qu.:14.000 3rd Qu.: 4.000
Max. :25.000 Max. :25.00 Max. :30.000 Max. :17.000
dex_save con_save int_save wis_save
Min. :-5.000 Min. :-1.000 Min. :-5.000 Min. :-4.000
1st Qu.: 1.000 1st Qu.: 1.000 1st Qu.:-4.000 1st Qu.: 0.000
Median : 2.000 Median : 2.000 Median :-2.000 Median : 1.000
Mean : 2.118 Mean : 2.785 Mean :-1.094 Mean : 1.873
3rd Qu.: 3.000 3rd Qu.: 4.000 3rd Qu.: 1.000 3rd Qu.: 3.000
Max. :10.000 Max. :15.000 Max. :12.000 Max. :12.000
cha_save skills resistances vulnerabilities
Min. :-5.00000 Length:330 Length:330 Length:330
1st Qu.:-3.00000 Class :character Class :character Class :character
Median :-1.00000 Mode :character Mode :character Mode :character
Mean : 0.00303
3rd Qu.: 2.00000
Max. :12.00000
immunities gear senses languages
Length:330 Length:330 Length:330 Length:330
Class :character Class :character Class :character Class :character
Mode :character Mode :character Mode :character Mode :character
full_text
Length:330
Class :character
Mode :character
Show Code
# Check for Unique Values
unique(monsters$type) [1] "Aberration" "Elemental" "Construct"
[4] "Monstrosity" "Humanoid" "Plant"
[7] "Fiend" "Dragon" "Ooze"
[10] "Fey" "Giant" "Celestial"
[13] "Swarm of Tiny Undead" "Undead" "Beast"
[16] "Swarm of Tiny Beasts"Show Code
unique(monsters$size)[1] "Large" "Medium" "Small" "Medium or Small"
[5] "Huge" "Gargantuan" "Tiny" Show Code
unique(monsters$alignment) [1] "Lawful Evil" "Neutral" "Unaligned" "Lawful Neutral"
[5] "Chaotic Evil" "Neutral Evil" "Lawful Good" "Chaotic Good"
[9] "Neutral Good" "Chaotic Neutral"Tidy
Show Code
# Remove columns that won't be necessary
monsters_clean <- monsters |>
select(-c(descriptive_tags, hp, speed, skills, resistances, vulnerabilities, immunities, gear, senses, languages, full_text))
#View(monsters_clean)Show Code
library(fastDummies)
# One-hot encode Size
monsters_clean <- dummy_cols(monsters_clean, select_columns = "size", remove_first_dummy = TRUE, remove_selected_columns = TRUE)
# One-hot encode Alignment
monsters_clean <- dummy_cols(monsters_clean, select_columns = "alignment", remove_first_dummy = TRUE, remove_selected_columns = TRUE)
#View(monsters_clean)Show Code
# Clean column names
library(janitor)
monsters_clean <- janitor::clean_names(monsters_clean)Show Code
# Get means of various attributes grouped by monster type
monster_means <- monsters_clean |>
group_by(type) |>
summarize('Challenge Rating' = mean(cr, na.rm = TRUE),
Armor = mean(ac, na.rm = TRUE),
'Hit Points' = mean(hp_number, na.rm = TRUE),
Speed = mean(speed_base_number, na.rm = TRUE),
Strength = mean(str, na.rm = TRUE),
Dexterity = mean(dex, na.rm = TRUE),
Constitution = mean(con, na.rm = TRUE),
Intelligence = mean(int, na.rm = TRUE),
Wisdom = mean(wis, na.rm = TRUE),
Charisma = mean(cha, na.rm = TRUE),
)
monster_meansShow Code
# Rescale means from 0 to 10
library(scales)
monster_means_rescaled <- monster_means |>
mutate(across(where(is.numeric), ~ scales::rescale(., to = c(0, 10))))
monster_means_rescaledShow Code
# Get list of types
#types <- unique(monster_means_rescaled$type)
#cat(paste0('"', types, '"', collapse = ", "))
# Lookup table for monster icons
icon_lookup <- tibble(
type = c("Aberration", "Beast", "Celestial", "Construct", "Dragon", "Elemental", "Fey", "Fiend", "Giant", "Humanoid", "Monstrosity", "Ooze", "Plant", "Swarm of Tiny Beasts", "Swarm of Tiny Undead", "Undead"),
icon = c(
"<img src='misc/images/aberration.jpg' width='25'/>",
"<img src='misc/images/beast.jpg' width='25'/>",
"<img src='misc/images/celestial.jpg' width='25'/>",
"<img src='misc/images/construct.jpg' width='25'/>",
"<img src='misc/images/dragon.jpg' width='25'/>",
"<img src='misc/images/elemental.jpg' width='25'/>",
"<img src='misc/images/fey.jpg' width='25'/>",
"<img src='misc/images/fiend.jpg' width='25'/>",
"<img src='misc/images/giant.jpg' width='25'/>",
"<img src='misc/images/humanoid.jpg' width='25'/>",
"<img src='misc/images/monstrosity.jpg' width='25'/>",
"<img src='misc/images/ooze.jpg' width='25'/>",
"<img src='misc/images/plant.jpg' width='25'/>",
"<img src='misc/images/swarm_of_beasts.jpg' width='25'/>",
"<img src='misc/images/swarm_of_undead.jpg' width='25'/>",
"<img src='misc/images/undead.jpg' width='25'/>"
)
)
icon_lookupShow Code
# Pivot longer
monster_long <- monster_means_rescaled |>
pivot_longer(
cols = -type,
names_to = "attribute",
values_to = "score"
)
# Left join location of icon images
monster_long <- left_join(monster_long, icon_lookup, by = "type") |>
mutate(type_label = paste0(icon, " ", type))
# Convert type to factor
monster_long$type <- factor(monster_long$type)
head(monster_long)Visualization
Show Code
library(ggtext)
library(showtext)
# Load font
font_add_google("Lato", "lato")
showtext_opts(dpi = 300)
# Make bar plots faceted by type
monster_plot <- ggplot(monster_long, aes(x = attribute, y = score, fill = attribute)) +
geom_col(width = 0.7) +
facet_wrap(
~ type_label,
ncol = 4, nrow = 4
) +
scale_fill_viridis_d(option = "viridis") +
labs(
title = "An attribute profile of the Monsters in Dungeons and Dragons",
subtitle = "Given the name of the game, Dragons are unsurprisingly the most powerful Monsters in the game. Celestials and \nFiends are also strong across all attributes.",
x = NULL,
y = "Scaled Score (0–10)",
caption = "\n\nChart produced by Steven Villalon for Tidy Tuesday exercise on May 27, 2025"
) +
theme_minimal(base_size = 13) +
theme(
plot.title = element_text(size = 20, face = "bold"),
plot.caption = element_text(hjust = 0),
strip.text = ggtext::element_markdown(size = 13, face = "bold"),
legend.position = "top",
legend.title = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
panel.border = element_rect(colour = "black", fill = NA, linewidth = 1),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
)
monster_plot
Show Code
# Save plot
ggsave("output/tidy_tuesday_dungeons_&_dragons_barplots.png", plot = monster_plot, bg = "white", width = 10, height = 10, dpi = 300)Modeling
Tried principal components and factor analysis to get the number of predictors to a more manageable number. The first few principal components only described 50% of the variation. It would have taken a lot more components to get an explainable chart. Likewise, factor analysis gave warnings that the datapoints were likely to correlated with one another.
Leaving these below for future reference.
Show Code
# Remove non-numerical columns
predictors <- monsters_clean |>
select(-c(name, category, type))
# Run PCA
pca <- prcomp(predictors, center = TRUE, scale. = TRUE)
summary(pca)Importance of components:
PC1 PC2 PC3 PC4 PC5 PC6 PC7
Standard deviation 3.3326 1.7954 1.39622 1.2484 1.1920 1.1730 1.07667
Proportion of Variance 0.3471 0.1007 0.06092 0.0487 0.0444 0.0430 0.03623
Cumulative Proportion 0.3471 0.4478 0.50872 0.5574 0.6018 0.6448 0.68104
PC8 PC9 PC10 PC11 PC12 PC13 PC14
Standard deviation 1.05443 1.03831 1.03055 1.00133 0.98237 0.89069 0.85025
Proportion of Variance 0.03474 0.03369 0.03319 0.03133 0.03016 0.02479 0.02259
Cumulative Proportion 0.71579 0.74948 0.78267 0.81400 0.84416 0.86895 0.89154
PC15 PC16 PC17 PC18 PC19 PC20 PC21
Standard deviation 0.78273 0.72854 0.72359 0.5572 0.53641 0.49143 0.45131
Proportion of Variance 0.01915 0.01659 0.01636 0.0097 0.00899 0.00755 0.00637
Cumulative Proportion 0.91069 0.92727 0.94364 0.9533 0.96233 0.96988 0.97624
PC22 PC23 PC24 PC25 PC26 PC27 PC28
Standard deviation 0.40341 0.37444 0.37306 0.29857 0.27379 0.2113 0.19666
Proportion of Variance 0.00509 0.00438 0.00435 0.00279 0.00234 0.0014 0.00121
Cumulative Proportion 0.98133 0.98571 0.99006 0.99284 0.99519 0.9966 0.99779
PC29 PC30 PC31 PC32
Standard deviation 0.15457 0.14085 0.13057 0.09979
Proportion of Variance 0.00075 0.00062 0.00053 0.00031
Cumulative Proportion 0.99854 0.99916 0.99969 1.00000Show Code
#pca$rotation
# Sort contributing variables in decreasing order for PC1 and PC2
top_PC1 <- sort(abs(pca$rotation[, "PC1"]), decreasing = TRUE)
top_PC2 <- sort(abs(pca$rotation[, "PC2"]), decreasing = TRUE)
# View top 10 contributors
head(top_PC1, 10) cr wis_save cha_save cha hp_number initiative con
0.2722902 0.2719477 0.2655940 0.2652942 0.2617644 0.2495072 0.2480373
con_save int_save ac
0.2462558 0.2455558 0.2454615 Show Code
head(top_PC2, 10) dex str str_save
0.3336794 0.3189999 0.3044974
alignment_unaligned int con
0.2544162 0.2422776 0.2417245
int_save size_large size_medium_or_small
0.2283471 0.2250583 0.2230876
dex_save
0.2135419 Show Code
# Factor Analysis - calculate optimal # of factors
library(psych)
fa.parallel(predictors, fa = "fa")
Parallel analysis suggests that the number of factors = 6 and the number of components = NA Show Code
# Factor analysis scores
fa_result <- fa(predictors, nfactors = 6, rotate = "varimax", scores = TRUE)Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
The estimated weights for the factor scores are probably incorrect. Try a
different factor score estimation method.Warning in fac(r = r, nfactors = nfactors, n.obs = n.obs, rotate = rotate, : An
ultra-Heywood case was detected. Examine the results carefullyShow Code
print(fa_result$loadings, cutoff = 0.3)
Loadings:
MR1 MR2 MR3 MR4 MR5 MR6
cr 0.773 0.474
ac 0.763
initiative 0.861
hp_number 0.715 0.506
speed_base_number
str 0.444 0.778
dex 0.372 -0.604
con 0.586 0.691
int 0.878 0.321
wis 0.726
cha 0.910
str_save 0.460 0.733
dex_save 0.806
con_save 0.611 0.594
int_save 0.869
wis_save 0.870
cha_save 0.906
size_huge 0.367
size_large 0.940
size_medium -0.972
size_medium_or_small 0.751
size_small -0.518
size_tiny -0.482
alignment_chaotic_good
alignment_chaotic_neutral -0.375
alignment_lawful_evil
alignment_lawful_good 0.384
alignment_lawful_neutral
alignment_neutral 0.713
alignment_neutral_evil
alignment_neutral_good
alignment_unaligned -0.585 -0.463 0.352
MR1 MR2 MR3 MR4 MR5 MR6
SS loadings 9.528 3.571 1.735 1.462 1.309 1.101
Proportion Var 0.298 0.112 0.054 0.046 0.041 0.034
Cumulative Var 0.298 0.409 0.464 0.509 0.550 0.585