An open API service indexing awesome lists of open source software.

https://github.com/japhir/dndraces

Simulating D&D Race heights and weights in R
https://github.com/japhir/dndraces

dice dplyr emacs ggplot2 org-mode purrr r simulation

Last synced: 2 months ago
JSON representation

Simulating D&D Race heights and weights in R

Awesome Lists containing this project

README

        

#+TITLE: Simulating D&D 5e Race Heights and Weights
#+OPTIONS: ^:{}

* D&D Character height and weight
In D&D you can roll dice to determine your character's height and weight based
on it's race.

This is the table of race size and weight in the D&D player handbook:

| Race | Base Height | Height Modifier | Base Weight | Weight Modifier |
|-----------------+-------------+-----------------+-------------+-----------------|
| Human | 4'8" | +2d10 | 110 lb. | × (2d4) lb. |
| Dwarf, hill | 3'8" | +2d4 | 115 lb. | × (2d6) lb. |
| Dwarf, mountain | 4' | +2d4 | 130 lb. | × (2d6) lb. |
| Elf, high | 4'6" | +2d10 | 90 lb. | × (1d4) lb. |
| Elf, wood | 4'6" | +2d10 | 100 lb. | × (1d4) lb. |
| Elf, drow | 4'5" | +2d6 | 75 lb. | × (1d6) lb. |
| Halfling | 2'7" | +2d4 | 35 lb. | × 1 lb. |
| Dragonborn | 5'6" | +2d8 | 175 lb. | × (2d6) lb. |
| Gnome | 2'11" | +2d4 | 35 lb. | × 1 lb. |
| Half-elf | 4'9" | +2d8 | 110 lb. | × (2d4) lb. |
| Half-orc | 4'10" | +2d10 | 140 lb. | × (2d6) lb. |
| Tiefling | 4'9" | +2d8 | 110 lb. | × (2d4) lb. |

To calculate the height, you have to add the ~Base Height~ to, e.g. 2d10 dice
rolls for the Human, which means you have to roll two 10-sided-die to determine
how much to add, in inches.

* Problem: I think metric
I don't think in terms of feet, inches, and pounds, so I thought I'd convert
some things to centimetres and kilogrammes in stead. Furthermore, I wanted to
better understand how these dice-rolls influence the final distribution of
weights and heights in the D&D universe.

And so I've simulated some dice-rolls to answer those questions!

* Rolling Virtual Dice
** Load libraries
# this is so that we work in an R session in emacs with ess
#+PROPERTY: header-args:R :session *R*

First load the libraries we use here:
#+begin_src R :results none
library(dplyr)
library(ggplot2)
library(purrr)
library(tidyr)
#+end_src

** Virtual dice
Then, let's figure out how to roll a virtual die in R. This function should do it:

#+begin_src R
roll_dice <- function(n = 1, d = 20) {
sum(sample(seq_len(d), size = n, replace = TRUE))
}
#+end_src

#+RESULTS:

By creating a vector of length ~d~, and sampling from it ~n~ times, with
replacement, and then taking the sum of those numbers we get simulated
dice-rolls!

Test if it works
#+begin_src R
c(roll_dice(), # 1d20
roll_dice(1, 10), # 1d10
roll_dice(2, 6), # 2d6
roll_dice(2, 4)) # 2d4
#+end_src

#+RESULTS:
| 9 |
| 2 |
| 8 |
| 8 |

| 10 |
| 7 |
| 7 |
| 3 |

This seems to work!

** Repeated rolls
Now we need to call the ~roll_die~ function many times for the simulations.

We can do this with ~replicate~ as follows:

#+begin_src R :results none
replicate(1e3, roll_dice(1, 20))
#+end_src

** Histogram of roll results
We can have a very quick glance at what this results in by creating a bargraph
with the resulting roll total on the x-axis, and the probability of getting
that roll on the y-axis.

#+begin_src R
make_hist <- function(vec) {
dat <- tibble(Result = vec)

pl <- dat %>%
ggplot(aes(Result)) +
geom_bar(aes(y = stat(count) / sum(stat(count)))) +
labs(y = "Probability")

pl
}
#+end_src

#+RESULTS:

#+begin_src R :results graphics file :file 1d20hist.png :height 300
replicate(1e5, roll_dice(1, 20)) %>%
make_hist() + labs(title = "Histogram of 1e5 simulations of a d20 roll")
#+end_src

#+RESULTS:

[[file:1d20hist.png]]

This seems ok.

What happens if we roll 2d4?
#+begin_src R :results graphics file :file 2d4hist.png :height 300
replicate(1e5, roll_dice(2, 4)) %>%
make_hist() + labs(title = "Histogram of 1e5 simulations of 2d4 rolls")
#+end_src

#+RESULTS:

[[file:2d4hist.png]]

Or 2d6?
#+begin_src R :results graphics file :file 2d6hist.png :height 300
replicate(1e5, roll_dice(2, 6)) %>%
make_hist() + labs(title = "Histogram of 1e5 simulations of 2d6 rolls")
#+end_src

#+RESULTS:

[[file:2d6hist.png]]

* Tidying of the table
Here I've quickly (manually) tidied the table up for use in R.

#+TBLNAME: races
| Race | Base Height | bh_f | bh_i | Height Modifier | n_height | d_height | Base Weight | Weight Modifier | n_weight | d_weight |
|-----------------+-------------+------+------+-----------------+----------+----------+-------------+-----------------+----------+----------|
| Human | "4\'8\"" | 4 | 8 | +2d10 | 2 | 10 | 110 | ×(2d4) lb. | 2 | 4 |
| Dwarf, hill | "3\'8\"" | 3 | 8 | +2d4 | 2 | 4 | 115 | ×(2d6) lb. | 2 | 6 |
| Dwarf, mountain | "4\'" | 4 | 0 | +2d4 | 2 | 4 | 130 | ×(2d6) lb. | 2 | 6 |
| Elf, high | "4\'6\"" | 4 | 6 | +2d10 | 2 | 10 | 90 | ×(1d4) lb. | 1 | 4 |
| Elf, wood | "4\'6\"" | 4 | 6 | +2d10 | 2 | 10 | 100 | ×(1d4) lb. | 1 | 4 |
| Elf, drow | "4\'5\"" | 4 | 5 | +2d6 | 2 | 6 | 75 | ×(1d6) lb. | 1 | 6 |
| Halfling | "2\'7\"" | 2 | 7 | +2d4 | 2 | 4 | 35 | ×1 lb. | | |
| Dragonborn | "5\'6\"" | 5 | 6 | +2d8 | 2 | 8 | 175 | ×(2d6) lb. | 2 | 6 |
| Gnome | "2\'11\"" | 2 | 11 | +2d4 | 2 | 4 | 35 | ×1 lb. | | |
| Half-elf | "4\'9\"" | 4 | 9 | +2d8 | 2 | 8 | 110 | ×(2d4) lb. | 2 | 4 |
| Half-orc | "4\'10\"" | 4 | 10 | +2d10 | 2 | 10 | 140 | ×(2d6) lb. | 2 | 6 |
| Tiefling | "4\'9\"" | 4 | 9 | +2d8 | 2 | 8 | 110 | ×(2d4) lb. | 2 | 4 |

NOTE: I'm using [[emacs'][emacs]] with [[https://ess.r-project.org/][ess]] in [[https://orgmode.org/][org-mode]], and this allows me to name the
sheet with ~#+TBLNAME:~ so that I can pass it into the header argument of a
codeblock later on with ~:var dat=races~. If you don't use emacs/org-mode but,
e.g. RStudio with RMarkdown, it's easier to save the table as a csv first.

** Sensible units
Now it's time to read in the data and do some simulations!

We also convert everything into sensible units.

#+begin_src R :var dat=races :colnames yes
races <- dat %>%
mutate(base_cm = bh_f * 30.48 + bh_i * 2.54,
base_kg = Base.Weight * 0.4535923) %>%
as_tibble()
#+end_src

| Race | Base.Height | bh_f | bh_i | Height.Modifier | n_height | d_height | Base.Weight | Weight.Modifier | n_weight | d_weight | base_cm | base_kg |
|-----------------+-------------+------+------+-----------------+----------+----------+-------------+-----------------+----------+----------+---------+------------|
| Human | 4 | 4 | 8 | +2d10 | 2 | 10 | 110 | ×(2d4) lb. | 2 | 4 | 142.24 | 49.895153 |
| Dwarf, hill | 3 | 3 | 8 | +2d4 | 2 | 4 | 115 | ×(2d6) lb. | 2 | 6 | 111.76 | 52.1631145 |
| Dwarf, mountain | 4 | 4 | 0 | +2d4 | 2 | 4 | 130 | ×(2d6) lb. | 2 | 6 | 121.92 | 58.966999 |
| Elf, high | 4 | 4 | 6 | +2d10 | 2 | 10 | 90 | ×(1d4) lb. | 1 | 4 | 137.16 | 40.823307 |
| Elf, wood | 4 | 4 | 6 | +2d10 | 2 | 10 | 100 | ×(1d4) lb. | 1 | 4 | 137.16 | 45.35923 |
| Elf, drow | 4 | 4 | 5 | +2d6 | 2 | 6 | 75 | ×(1d6) lb. | 1 | 6 | 134.62 | 34.0194225 |
| Halfling | 2 | 2 | 7 | +2d4 | 2 | 4 | 35 | ×1 lb. | nil | nil | 78.74 | 15.8757305 |
| Dragonborn | 5 | 5 | 6 | +2d8 | 2 | 8 | 175 | ×(2d6) lb. | 2 | 6 | 167.64 | 79.3786525 |
| Gnome | 2 | 2 | 11 | +2d4 | 2 | 4 | 35 | ×1 lb. | nil | nil | 88.9 | 15.8757305 |
| Half-elf | 4 | 4 | 9 | +2d8 | 2 | 8 | 110 | ×(2d4) lb. | 2 | 4 | 144.78 | 49.895153 |
| Half-orc | 4 | 4 | 10 | +2d10 | 2 | 10 | 140 | ×(2d6) lb. | 2 | 6 | 147.32 | 63.502922 |
| Tiefling | 4 | 4 | 9 | +2d8 | 2 | 8 | 110 | ×(2d4) lb. | 2 | 4 | 144.78 | 49.895153 |

* Simulate weight and height dice-rolls
Now let's simulate some dice-rolls! We're creating some new list-columns, using
~purrr::map~ and then unnesting them for easier calculations.

First we define a new function that replicates the analysis:
#+begin_src R
rep_dice <- function(n, d, n_sim = 1e5) {
replicate(n_sim, roll_dice(n, d))
}
#+end_src

#+RESULTS:

And then we run it for all the Races.

#+begin_src R
races_stats <- races %>%
mutate(height_rolls = map2(n_height, d_height, possibly(rep_dice, otherwise = 1)),
weight_rolls = map2(n_weight, d_weight, possibly(rep_dice, otherwise = 1))) %>%
unnest(cols = c(height_rolls, weight_rolls)) %>%
mutate(height = base_cm + height_rolls * 2.54, # convert roll from inches to cm
weight = base_kg + height_rolls * weight_rolls * 0.4535923) # convert rolls from lbs to kg
#+end_src

#+RESULTS:

Note the ~tidyr::possibly~ here, which allows me to ignore the weight rolls for
the Halfling and Gnome and instead set their value to 1.

* Averages
Then we calculate median height and weight and append them back to the original data.

We also convert Race to a factor, which is sorted by the average height.

#+begin_src R :colnames yes
races_sum <- races_stats %>%
group_by(Race) %>%
summarize(height_med = median(height),
weight_med = median(weight)) %>%
left_join(races, by = "Race") %>%
arrange(height_med) %>%
mutate(Race = factor(Race, levels = Race),
lab_kg = paste0(Height.Modifier, Weight.Modifier))
#+end_src

#+RESULTS:

| Race | height_med | weight_med | Base.Height | bh_f | bh_i | Height.Modifier | n_height | d_height | Base.Weight | Weight.Modifier | n_weight | d_weight | base_cm | base_kg | lab_kg |
|-----------------+------------+-------------+-------------+------+------+-----------------+----------+----------+-------------+-----------------+----------+----------+---------+------------+-----------------|
| Halfling | 91.44 | 18.143692 | 2 | 2 | 7 | +2d4 | 2 | 4 | 35 | ×1 lb. | nil | nil | 78.74 | 15.8757305 | +2d4×1 lb. |
| Gnome | 101.6 | 18.143692 | 2 | 2 | 11 | +2d4 | 2 | 4 | 35 | ×1 lb. | nil | nil | 88.9 | 15.8757305 | +2d4×1 lb. |
| Dwarf, hill | 124.46 | 66.6780681 | 3 | 3 | 8 | +2d4 | 2 | 4 | 115 | ×(2d6) lb. | 2 | 6 | 111.76 | 52.1631145 | +2d4×(2d6) lb. |
| Dwarf, mountain | 134.62 | 73.9355449 | 4 | 4 | 0 | +2d4 | 2 | 4 | 130 | ×(2d6) lb. | 2 | 6 | 121.92 | 58.966999 | +2d4×(2d6) lb. |
| Elf, drow | 152.4 | 43.5448608 | 4 | 4 | 5 | +2d6 | 2 | 6 | 75 | ×(1d6) lb. | 1 | 6 | 134.62 | 34.0194225 | +2d6×(1d6) lb. |
| Elf, high | 165.1 | 51.7095222 | 4 | 4 | 6 | +2d10 | 2 | 10 | 90 | ×(1d4) lb. | 1 | 4 | 137.16 | 40.823307 | +2d10×(1d4) lb. |
| Elf, wood | 165.1 | 56.2454452 | 4 | 4 | 6 | +2d10 | 2 | 10 | 100 | ×(1d4) lb. | 1 | 4 | 137.16 | 45.35923 | +2d10×(1d4) lb. |
| Half-elf | 167.64 | 68.9460296 | 4 | 4 | 9 | +2d8 | 2 | 8 | 110 | ×(2d4) lb. | 2 | 4 | 144.78 | 49.895153 | +2d8×(2d4) lb. |
| Tiefling | 167.64 | 68.9460296 | 4 | 4 | 9 | +2d8 | 2 | 8 | 110 | ×(2d4) lb. | 2 | 4 | 144.78 | 49.895153 | +2d8×(2d4) lb. |
| Human | 170.18 | 73.4819526 | 4 | 4 | 8 | +2d10 | 2 | 10 | 110 | ×(2d4) lb. | 2 | 4 | 142.24 | 49.895153 | +2d10×(2d4) lb. |
| Half-orc | 175.26 | 96.1615676 | 4 | 4 | 10 | +2d10 | 2 | 10 | 140 | ×(2d6) lb. | 2 | 6 | 147.32 | 63.502922 | +2d10×(2d6) lb. |
| Dragonborn | 190.5 | 106.5941905 | 5 | 5 | 6 | +2d8 | 2 | 8 | 175 | ×(2d6) lb. | 2 | 6 | 167.64 | 79.3786525 | +2d8×(2d6) lb. |

* Plot of Heights
Great! Now let's create a plot of the average height by race, with a violin
plot to illustrate the distribution.

I further annotate the plot with base height points and which modifier was used
to get the distribution of heights.

#+begin_src R :results graphics file :file raceheights.png :width 600
pl_h <- races_sum %>%
ggplot(aes(x = Race, y = height_med)) +
geom_bar(stat="identity", alpha = .5) +
geom_violin(aes(y = height), bw = 2.54, scale= "width", colour = NA, fill = "cornflowerblue", alpha = .8, data = races_stats) +
geom_text(aes(y = base_cm + 2, hjust = 0, label = paste0(Height.Modifier, "'")), angle = 90) +
geom_point(aes(y = base_cm)) +
ylim(c(0, NA)) +
labs(y = "Height (cm)") # +
## coord_flip()
pl_h
#+end_src

#+RESULTS:

[[file:raceheights.png]]

Notice the ~bw~ argument to ~geom_violin~: this is used to adjust the smoothing
kernel a bit. I've used the value to convert my units in cm back to inches,
because with lower values we get artificial jittering.

* Plot of Weights
Now we do the same for weight:
#+begin_src R :results graphics file :file raceweights.png :width 600
pl_w <- races_sum %>%
ggplot(aes(x = Race, y = weight_med)) +
geom_bar(stat="identity", alpha = .5) +
geom_violin(aes(y = weight), bw = 1 / 0.4535923, scale= "width", colour = NA, fill = "cornflowerblue", alpha = .8, data = races_stats) +
geom_point(aes(y = base_kg)) +
geom_text(aes(y = base_kg, label = lab_kg), hjust = -.05, angle = 90) +
ylim(c(0, NA)) +
labs(y = "Weight (kg)") # +
pl_w
#+end_src

#+RESULTS:

[[file:raceweights.png]]

(Again, we set ~bw~ to the value to convert kg to lbs.)

* Combined Plot
To ultimately combine the two into one figure using ~patchwork~.

#+begin_src R :results graphics file :file races_stats.png :width 600 :height 600
library(patchwork)
pl <- (pl_h + labs(title = "D&D 5e Race size and weight distributions based on rolls") &
theme(axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank())) /
(pl_w & theme(axis.text.x = element_text(size = 10, angle = 30, hjust = 1, face = "bold")))
pl
#+end_src

#+RESULTS:

[[file:races_stats.png]]

* Body Mass Index
Okay now for some more mental picturing, let's calculate the average BMI for
these races. BMI is a troublesome indicator for humans alone already, and will
certainly be wrong for the heavy-boned dwarfs, but it's nice to give us a
little bit more of a mental picture.

I found these BMI categories [[https://en.wikipedia.org/wiki/Body_mass_index#Categories][on the WikiPedia article on BMI]].

#+TBLNAME: bmi
| category | from | to |
|---------------------------------------+------+------|
| Very severely underweight | | 15 |
| Severely underweight | 15 | 16 |
| Underweight | 16 | 18.5 |
| Normal (healthy weight) | 18.5 | 25 |
| Overweight | 25 | 30 |
| Obese Class I (Moderately obese) | 30 | 35 |
| Obese Class II (Severely obese) | 35 | 40 |
| Obese Class III (Very severely obese) | 40 | |

#+begin_src R :var categories=bmi :results graphics file :file races_bmi.png :width 600
# clean up the categories
cat <- categories %>%
mutate(from = ifelse(is.na(from), -Inf, from),
to = ifelse(is.na(to), Inf, to),
category = factor(category, levels = rev(category), ordered = TRUE))

# calculate average bmi
bmi_avg <- races_sum %>% mutate(bmi = weight_med / (height_med/100)^2)

# calculate all bmi's
bmi <- races_stats %>%
mutate(bmi = weight / (height / 100)^2)

# plot them
bmi_avg %>%
ggplot(aes(x = Race, y = bmi)) +
# annotate the categories
geom_point() + # It looks like this is necessary to keep the factor levels in
# the right order
geom_rect(aes(xmin = -Inf, xmax = Inf,
ymin = from,
ymax = to,
fill = category),
inherit.aes = FALSE, data = cat) +
scale_fill_brewer(palette = "RdBu") +
geom_violin(data = bmi, bw = .8, fill = "gray", draw_quantiles = c(.25, .5, .75)) +
labs(fill = "BMI category\nif they would have been human", y = "BMI (kg /"~m^2*")") +
geom_point() +
theme(axis.text.x = element_text(angle = 30, hjust = 1, face = "bold"))
#+end_src

#+RESULTS:

[[file:races_bmi.png]]

So most dwarves are, according to the human BMI, very severely obese 😉.

And that's it! A quick dive into some simulations with R! Any feedback on how
to improve this workflow is welcome.
* Other Dice roll simulations
** Rolling With Advantage
In D&D-land you sometimes get to roll with advantage. This means that you roll
a d20 twice, and take the higher of the two. I also wanted to study what
happens when we do that, so we add a new function!

#+begin_src R
roll_with_advantage <- function(d = 20) {
max(sample(seq_len(d), size = 2, replace = TRUE))
}
#+end_src

#+RESULTS:

#+begin_src R :results graphics file :file d20_advantage.png :height 300
replicate(1e5, roll_with_advantage(20)) %>%
make_hist() + labs(title = "Histogram of 1e5 simulations of d20 rolls with advantage")
#+end_src

#+RESULTS:

[[file:d20_advantage.png]]

** Rolling With Disadvantage
When you're particularly unskilled at something, your DM may ask you to roll
with disadvantage. This means: roll 2d20 and take the lower.

#+begin_src R
roll_with_disadvantage <- function(d = 20) {
min(sample(seq_len(d), size = 2, replace = TRUE))
}
#+end_src

#+begin_src R :results graphics file :file d20_disadvantage.png :height 300
replicate(1e5, roll_with_disadvantage(20)) %>%
make_hist() + labs(title = "Histogram of 1e5 simulations of d20 rolls with disadvantage")
#+end_src

#+RESULTS:

[[file:d20_disadvantage.png]]

** Rolling for Stats
Some DM's let you roll for stats. The common way of doing so is by rolling 4d6
and dropping the lower. Then repeating this 6 times.

When I did this the first time, I got some pretty high rolls and I wondered
what the odds are. So again, time to simulate!

#+begin_src R :results none
stat_roll <- function() {
# roll 4d6, drop the lowest
rolls <- sample(1:6, 4, replace = TRUE)
# use the highest two values only
sum(sort(rolls)[-1])
}
#+end_src

So if you want to roll for stats without rolling any dice (BOOOOO!):
#+begin_src R
replicate(6, stat_roll())
#+end_src

#+RESULTS:
| 15 |
| 11 |
| 13 |
| 16 |
| 11 |
| 11 |

comparison to pointbuy and standard array
#+begin_src R :colnames "yes"
comparison <- tribble( ~ name, ~ array,
"standard", c(8, 10, 12, 13, 14, 15),
"pointbuy 3 high 3 low", c(15, 15, 15, 8, 8, 8),
"pointbuy all medium", c(13, 13, 13, 12, 12, 12),
) %>%
mutate(sum = map_dbl(array, sum))
comparison %>% select(-array)
#+end_src

#+RESULTS:
| name | sum |
|-----------------------+-----|
| standard | 72 |
| pointbuy 3 high 3 low | 69 |
| pointbuy all medium | 75 |

Let's visualize the likelihood of all the total values:
#+begin_src R :results graphics file :file stat_rolls.png :height 300
replicate(1e5, stat_roll()) %>%
make_hist() + labs(title = "Rolling for stats using the roll 4d6 drop lowest method") +
geom_bar(aes(x = array, y = stat(count) / sum(stat(count)), group = name, fill = name),
data = comparison %>% unnest(array),
width = .5,
alpha = .6)
#+end_src

#+RESULTS:
[[file:stat_rolls.png]]

[[file:stat_rolls.png]]
#+begin_src R :colnames yes
sr <- replicate(1e5, stat_roll()) %>%
as_tibble() %>%
mutate(name = "roll for stats") %>%
bind_rows(comparison %>% unnest(array) %>% rename(value=array)) %>%
group_by(name) %>%
summarize(min = min(value),
mean = mean(value),
median = median(value),
max = max(value))
#+end_src

#+RESULTS:
| name | min | mean | median | max |
|-----------------------+-----+----------+--------+-----|
| pointbuy 3 high 3 low | 8 | 11.5 | 11.5 | 15 |
| pointbuy all medium | 12 | 12.5 | 12.5 | 13 |
| roll for stats | 3 | 12.24506 | 12 | 18 |
| standard | 8 | 12 | 12.5 | 15 |

let's calculate when the sum of ability scores is highest

simulate 1e5 sets of 6 stats, take the sum
#+begin_src R
sr <- replicate(1e5, sum(replicate(6, stat_roll()))) %>%
as_tibble()
#+end_src

#+begin_src R :results output graphics file :file stat_sum_vs_stdarray.png :width 700 :height 300
make_hist(sr$value) +
geom_vline(aes(xintercept = sum, colour = name), data = comparison, size = 2, alpha = .5)
#+end_src

#+RESULTS:

[[file:stat_sum_vs_stdarray.png]]
do some calculations
#+begin_src R
sb <- sr %>%
mutate(
rbs = value > comparison$sum[[1]],
rbp1 = value > comparison$sum[[2]],
rbp2 = value > comparison$sum[[3]],
)
#+end_src

how often is rolling better than pointbuy or standard array?
#+begin_src R :colnames "yes"
tribble(~ name, ~ `P roll better than X`,
"standardarray", sum(sb$rbs) / nrow(sb),
"pointbuy 3 high 3 low", sum(sb$rbp1) / nrow(sb),
"pointbuy all medium", sum(sb$rbp2) / nrow(sb)
)
#+end_src

#+RESULTS:
| name | P roll better than X |
|-----------------------+----------------------|
| standardarray | 0.56215 |
| pointbuy 3 high 3 low | 0.71725 |
| pointbuy all medium | 0.39306 |