R/baxter.R

In SchlossLab/exception-handling: What the Package Does (One Line, Title Case)

library(dplyr)
library(readxl)
library(readr)
library(rlang)

#' Reads and cleans raw metadata
#'
#' @return The cleaned metadata as a dataframe
#' @examples
#' metadata <- get_metadata()
get_metadata <- function(filepath = "inst/extdata/baxter.metadata.xlsx") {
    baxter_metadata <- read_excel(
        path = filepath,
        col_types = c(
            sample = "text",
            fit_result = "numeric",
            Site = "text",
            Dx_Bin = "text",
            dx = "text",
            Hx_Prev = "logical",
            Hx_of_Polyps = "logical",
            Age = "numeric",
            Gender = "text",
            Smoke = "logical",
            Diabetic = "logical",
            Hx_Fam_CRC = "logical",
            Height = "numeric",
            Weight = "numeric",
            NSAID = "logical",
            Diabetes_Med = "logical",
            stage = "text"
        )
    )
    baxter_metadata[["Height"]] <- na_if(baxter_metadata[["Height"]], 0)
    baxter_metadata[["Weight"]] <- na_if(baxter_metadata[["Weight"]], 0)
    baxter_metadata[["Site"]] <-
        recode(.x = baxter_metadata[["Site"]], "U of Michigan" = "U Michigan")
    baxter_metadata[["Dx_Bin"]] <-
        recode(.x = baxter_metadata[["Dx_Bin"]], "Cancer." = "Cancer")
    baxter_metadata[["Gender"]] <- recode(.x = baxter_metadata[["Gender"]], "m" = "male")
    baxter_metadata[["Gender"]] <-
        recode(.x = baxter_metadata[["Gender"]], "f" = "female")
    baxter_metadata <- rename_all(.tbl = baxter_metadata, .funs = tolower)
    baxter_metadata <- rename(
        .data = baxter_metadata,
        previous_history = hx_prev,
        history_of_polyps = hx_of_polyps,
        family_history_of_crc = hx_fam_crc,
        diagnosis_bin = dx_bin,
        diagnosis = dx,
        sex = gender
    )
    baxter_metadata <-
        mutate(baxter_metadata, diagnosis = factor(diagnosis, levels = c("normal", "adenoma", "cancer")))
    return(baxter_metadata)
}

#' Returns an individual's body mass index, given metric units.
#'
#' The squared value of weight in kilograms
#' divided by height in meters, which is
#' converted by dividing cm by 100.
#'
#' @param weight_kg Weight in kilograms, a number.
#' @param height_cm Height in centimeters, a number.
#' @return The BMI of a given individual, a number.
#' @examples
#' get_bmi(80, 182)
#' get_bmi(50, 160)
get_bmi <- function(weight_kg, height_cm){
    return(weight_kg / (height_cm/100) ^ 2)
}

#' Determine BMI category from get_bmi function results
#'
#' @param weight_kg patient weight in kilograms
#' @param height_cm patient height in centimeters
#' @return return BMI category for input
#' @examples
#' get_bmi_category(100, 200)
#' get_bmi_category(50, 198)
#' get_bmi_category(180, 150)
get_bmi_category <- function(weight_kg, height_cm){
    bmi <- get_bmi(weight_kg, height_cm)
    bmi_cat <- case_when(bmi >= 30 ~ "obese",
                         bmi >= 25 ~ "overweight",
                         bmi >= 18.5 ~ "normal",
                         TRUE ~ "underweight")
    return(bmi_cat)
}

#' Determining whether a patient is obese from get_bmi_category
#'
#' @param weight_kg patient weight in kilograms
#' @param height_cm patient height in centimeters
#' @return True or false for obesity
#' @examples
#' get_bmi_category(100, 200)
#' get_bmi_category(50, 198)
#' get_bmi_category(180, 150)
is_obese <- function(weight_kg, height_cm){
    bmi_category <- get_bmi_category(weight_kg, height_cm)
    return(bmi_category == "obese")
}