Instantly share code, notes, and snippets.

Embed
What would you like to do?
library(tidyverse)
modifier <- function(x) {
floor((x - 10) / 2)
}
skill_ability <- tribble(
~skill, ~ability_code_upper,
#-------|------------------
"athletics", "STR",
"acrobatics", "DEX",
"sleight_of_hand", "DEX",
"stealth", "DEX",
"arcana", "INT",
"history", "INT",
"investigation", "INT",
"nature", "INT",
"religion", "INT",
"animal_handling", "WIS",
"insight", "WIS",
"medicine", "WIS",
"perception", "WIS",
"survival", "WIS",
"deception", "CHA",
"intimidation", "CHA",
"performance", "CHA",
"persuasion", "CHA",
)
extract_bracketed <- function(x) {
if (!grepl("\\(.*\\)", x)) {
return(NA)
} else {
gsub(".*\\((.*?)\\).*", "\\1", x)
}
}
identify_bold_text <- function(x, bold_text) {
grepl(paste0("\\*\\*", bold_text, "\\*\\*"), x, ignore.case = TRUE)
}
strip_bold_text <- function(x) {
gsub("\\*\\*(.*?)\\*\\*", "", x, ignore.case = TRUE) %>% trimws
}
extract_from_bold_text <- function(lines, bold_text) {
lines %>%
filter(identify_bold_text(value, bold_text)) %>%
as.character %>%
strip_bold_text
}
extract_from_colon_heading <- function(lines, heading) {
lines %>%
filter(grepl(paste0(heading, ":"), value)) %>%
gsub(paste0(heading, ":"), "", .) %>%
as.character %>%
trimws
}
parse_monster <- function(monster) {
lines <- monster %>%
stringi::stri_split_lines(omit_empty = TRUE) %>%
unlist %>%
as_tibble %>% # much easier to deal with than lists
mutate_all(trimws) %>%
mutate_all(function(x) gsub("_", "", x)) # remove italics
monster_name <- lines %>% extract_from_colon_heading("name")
header_regex <- paste0("# ", gsub("\\s*\\([^\\)]+\\)", "", monster_name)) # remove bracketed material
main_header <- min(which(grepl(header_regex, lines$value, ignore.case = TRUE), arr.ind = TRUE))
monster_summary <- lines$value[main_header + 1] %>% trimws # eg. "Medium humanoid (any race), any non-lawful alignment"
monster_size <- stringr::word(monster_summary) # first word
monster_race <- gsub(paste0(".*", monster_size, "(.*?),.*"), "\\1", monster_summary) %>% trimws
monster_alignment <- gsub(".*,(.*?)", "\\1", monster_summary) %>% trimws
description_header_row <- which(lines == "### Description", arr.ind = TRUE)[,"row"]
if (length(description_header_row) == 0) {
monster_description <- NA
} else {
monster_description <- lines[description_header_row + 1,] %>% as.character
}
header_rows <- which(grepl("###", lines$value), arr.ind = TRUE)
actions_header_row <- which(lines == "### Actions", arr.ind = TRUE)[,"row"]
if (length(actions_header_row) == 0) {
monster_actions <- NA
} else {
if (max(header_rows) == actions_header_row) {
last_action = nrow(lines) # in this case, the actions are the last lines
} else {
last_action <- min(header_rows[header_rows > actions_header_row]) - 1 # the row before the heading that comes after ### Actions
}
action_rows <- seq(actions_header_row + 1, last_action)
monster_actions <- lines$value[action_rows]
monster_actions <- monster_actions %>% purrr::map(function(x) {
action_name <- gsub(".*\\*\\*(.*?)\\.\\*\\*.*", "\\1", x)
action <- x %>% strip_bold_text %>% trimws
names(action) <- action_name
action
}) %>% purrr::reduce(c)
}
ability_header <- min(which(grepl("\\| STR", lines$value), arr.ind = TRUE))
ability_text <- lines$value[ability_header + 2]
ability_vector <- ability_text %>% strsplit("\\|") %>% unlist
monster_ability <- readr::parse_number(ability_vector[!(ability_vector == "")])
names(monster_ability) <- c("STR", "DEX", "CON", "INT", "WIS", "CHA")
monster_modifiers <- monster_ability %>%
as.list %>%
as_tibble %>%
mutate_all(modifier) %>%
gather(key = ability_code_upper, value = modifier)
base_skills <- skill_ability %>%
left_join(monster_modifiers, by = "ability_code_upper") %>%
select(skill, modifier)
listed_skills <- lines %>%
extract_from_bold_text("Skills") %>%
strsplit(", ") %>%
unlist %>%
lapply(function(x) {
skill_name <- word(x)
skill_modifier <- c(readr::parse_number(x))
names(skill_modifier) <- tolower(skill_name)
skill_modifier
}) %>%
unlist %>% # This is
as.list %>% # so weird
as_tibble %>%
gather(key = skill, value = modifier) %>%
mutate(skill = gsub(" ", "_", skill)) # keep naming conventions (underscores)
monster_skills <- if (length(listed_skills) == 0) {
base_skills
} else {
listed_skills %>% rbind(
anti_join(base_skills, listed_skills, by = "skill")
)
}
monster_skills <- monster_skills[match(base_skills$skill, monster_skills$skill),] # maintain skill order
tibble(
name = monster_name,
type = lines %>% extract_from_colon_heading("type"),
size = monster_size,
alignment = monster_alignment,
cr = lines %>% extract_from_colon_heading("cr") %>% as.numeric,
xp = lines %>% extract_from_bold_text("challenge") %>% extract_bracketed %>% readr::parse_number(),
ac = lines %>% extract_from_bold_text("Armor Class") %>% readr::parse_number(),
ac_note = lines %>% extract_from_bold_text("Armor Class") %>% extract_bracketed,
hp_avg = lines %>% extract_from_bold_text("Hit Points") %>% readr::parse_number(),
hp = lines %>% extract_from_bold_text("Hit Points") %>% extract_bracketed,
str = monster_ability["STR"],
dex = monster_ability["DEX"],
con = monster_ability["CON"],
int = monster_ability["INT"],
wis = monster_ability["WIS"],
cha = monster_ability["CHA"],
senses = lines %>% extract_from_bold_text("Senses"),
languages = lines %>% extract_from_bold_text("Languages"),
speed = lines %>% extract_from_bold_text("Speed"),
actions = monster_actions %>% list,
description = monster_description
) %>%
cbind(spread(monster_skills, skill, modifier)) %>%
as_tibble
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment