inst/doc/nih-enrollment-html.R

In codified: Produce Standard/Formalized Demographics Tables

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(echo = TRUE)

## ----declare, echo = F--------------------------------------------------------

## ----install-codified---------------------------------------------------------
# if( !requireNamespace("codified", quietly = TRUE) )
#   remotes::install_github(repo = "OuhscBbmc/codified")

library(codified)

## ----local-establish----------------------------------------------------------
path <- system.file("misc/example-data-1.csv", package = "codified")
col_types <- readr::cols_only(
  record_id = readr::col_integer(),
  name_last = readr::col_character(),
  dob       = readr::col_date(format = ""),
  gender    = readr::col_integer(),
  race      = readr::col_integer(),
  ethnicity = readr::col_integer()
)
ds <- readr::read_csv(path, col_types = col_types) |>
  dplyr::mutate(
    gender     = as.character(gender),
    race       = as.character(race),
    ethnicity  = as.character(ethnicity)
  )
ds |>
  head(10) |>
  knitr::kable(caption = "Observed Dataset (first ten rows)")

ds_lu_gender <- tibble::tribble(
  ~input,   ~displayed            ,
  "0"   ,  "Female"               ,
  "1"   ,  "Male"                 ,
  "U"   ,  "Unknown/Not Reported"
)
knitr::kable(ds_lu_gender, caption = "Gender Mapping")

ds_lu_race <- tibble::tribble(
  ~input , ~displayed                                   ,
  "1"    , "American Indian/Alaska Native"              ,
  "2"    , "Asian"                                      ,
  "3"    , "Native Hawaiian or Other Pacific Islander"  ,
  "4"    , "Black or African American"                  ,
  "5"    , "White"                                      ,
  "M"    , "More than One Race"                         ,
  "6"    , "Unknown or Not Reported"
)
knitr::kable(ds_lu_race, caption = "Race Mapping")

ds_lu_ethnicity <- tibble::tribble(
  ~input,   ~displayed                      ,
  "2"   ,  "Not Hispanic or Latino"         ,
  "1"   ,  "Hispanic or Latino"             ,
  "0"   ,  "Unknown/Not Reported Ethnicity"
)
knitr::kable(ds_lu_ethnicity, caption = "Ethnicity Mapping")

## ----local-apply-map----------------------------------------------------------
ds_summary_long <- codified::table_nih_enrollment(
  d              = ds,
  d_lu_gender    = ds_lu_gender,
  d_lu_race      = ds_lu_race,
  d_lu_ethnicity = ds_lu_ethnicity
)

knitr::kable(ds_summary_long, caption = "Counts of Each Subgroup")

## ----local-cosmetically-format------------------------------------------------
codified::table_nih_enrollment_pretty(
  d              = ds,
  d_lu_gender    = ds_lu_gender,
  d_lu_race      = ds_lu_race,
  d_lu_ethnicity = ds_lu_ethnicity
)

## ----install-redcapr----------------------------------------------------------
# if( !requireNamespace("REDCapR", quietly = TRUE) )
#   remotes::install_github("OuhscBbmc/REDCapR")

library(REDCapR)

## ----redcap-establish---------------------------------------------------------
ds_2 <-
  readr::read_csv(
    file      = system.file("misc/example-data-2.csv", package = "codified"),
    col_types = readr::cols(.default = readr::col_character())
  )

## ----redcap-local-cosmetically-format-----------------------------------------
table_nih_enrollment_pretty(
  d               = ds_2,
  d_lu_gender     = ds_lu_gender,
  d_lu_race       = ds_lu_race,
  d_lu_ethnicity  = ds_lu_ethnicity
)

## ----collapsing-levels--------------------------------------------------------
ds_lu_race_3 <- tibble::tribble(
  ~input                      , ~displayed                                  ,
  "American Indian"           , "American Indian/Alaska Native"             , # Combine w/ Alaska Native
  "Alaska Native"             , "American Indian/Alaska Native"             , # Combine w/ American Indian
  "Asian"                     , "Asian"                                     ,
  "Native Hawaiian"           , "Native Hawaiian or Other Pacific Islander" , # Combine w/ Pacific Islanders
  "Pacific Islander"          , "Native Hawaiian or Other Pacific Islander" , # Combine w/ Hawaiian
  "Black or African American" , "Black or African American"                 ,
  "White"                     , "White"                                     ,
  "More than One Race"        , "More than One Race"                        ,
  "Unknown or Not Reported"   , "Unknown or Not Reported"
)

ds_3 <- tibble::tribble(
  ~subject_id,   ~gender  , ~race            ,  ~ethnicity                 ,
           1L,   "Female" , "American Indian",  "Not Hispanic or Latino"   ,
           2L,   "Male"   , "American Indian",  "Not Hispanic or Latino"   ,
           3L,   "Male"   , "American Indian",  "Not Hispanic or Latino"   ,
           4L,   "Female" , "Alaska Native"  ,  "Not Hispanic or Latino"   ,
           5L,   "Male"   , "Alaska Native"  ,  "Not Hispanic or Latino"   ,
           6L,   "Male"   , "Alaska Native"  ,  "Not Hispanic or Latino"   ,
           7L,   "Male"   , "White"          ,  "Not Hispanic or Latino"   ,
           8L,   "Male"   , "White"          ,  "Not Hispanic or Latino"
)

table_nih_enrollment_pretty(
  d               = ds_3,
  d_lu_race       = ds_lu_race_3
)