parse_monster.R

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
}