From 61aba68cb8cec70b24770a21a31cf161a765008a Mon Sep 17 00:00:00 2001 From: Will Beasley Date: Wed, 5 Sep 2018 23:37:03 -0500 Subject: [PATCH] Allow different variable names closes #3 --- R/table-nih-enrollment.R | 27 +++++++++++++++++---- man/table_nih_enrollment.Rd | 9 ++++++- tests/testthat/test-table-nih-enrollment.R | 28 +++++++++++++++------- 3 files changed, 51 insertions(+), 13 deletions(-) diff --git a/R/table-nih-enrollment.R b/R/table-nih-enrollment.R index 2fdb2aa..b65e69c 100644 --- a/R/table-nih-enrollment.R +++ b/R/table-nih-enrollment.R @@ -9,7 +9,9 @@ #' @param d_lu_gender [data.frame] that maps the observed levels of gender to the NIH-recommended levels of gender. Required only if the levels are not the same. #' @param d_lu_race [data.frame] that maps the observed levels of gender to the NIH-recommended levels of gender. Required only if the levels are not the same. #' @param d_lu_ethnicity [data.frame] that maps the observed levels of gender to the NIH-recommended levels of gender. Required only if the levels are not the same. -#' +#' @param variable_gender name of the gender variable in the `d` [data.frame]. Defaults to gender. +#' @param variable_race name of the race variable in the `d` [data.frame]. Defaults to race. +#' @param variable_ethnicity name of the ethnicity variable in the `d` [data.frame]. Defaults to ethnicity. #' @return Table for publication #' #' @details @@ -116,11 +118,18 @@ #' @export -table_nih_enrollment <- function( d, d_lu_gender=NULL, d_lu_race=NULL, d_lu_ethnicity=NULL ) { +table_nih_enrollment <- function( + d, + d_lu_gender=NULL, d_lu_race=NULL, d_lu_ethnicity=NULL, + variable_gender="gender", variable_race="race", variable_ethnicity="ethnicity" +) { checkmate::assert_data_frame(d , any.missing=F) checkmate::assert_data_frame(d_lu_gender , any.missing=F, null.ok=T) checkmate::assert_data_frame(d_lu_race , any.missing=F, null.ok=T) checkmate::assert_data_frame(d_lu_ethnicity , any.missing=F, null.ok=T) + checkmate::assert_character( variable_gender , any.missing=F, min.chars=1, len=1) + checkmate::assert_character( variable_race , any.missing=F, min.chars=1, len=1) + checkmate::assert_character( variable_ethnicity , any.missing=F, min.chars=1, len=1) levels_gender <- c( "Female", @@ -149,6 +158,12 @@ table_nih_enrollment <- function( d, d_lu_gender=NULL, d_lu_race=NULL, d_lu_ethn ethnicity = levels_ethnicity ) + d <- d %>% + dplyr::select_( + "gender" = variable_gender , + "race" = variable_race , + "ethnicity" = variable_ethnicity + ) if( !is.null(d_lu_gender) ) { d <- d %>% dplyr::left_join(d_lu_gender, by=c("gender" = "input")) %>% @@ -184,7 +199,11 @@ table_nih_enrollment <- function( d, d_lu_gender=NULL, d_lu_race=NULL, d_lu_ethn } #' @export -table_nih_enrollment_pretty <- function(d, d_lu_gender=NULL, d_lu_race=NULL, d_lu_ethnicity=NULL ) { +table_nih_enrollment_pretty <- function( + d, + d_lu_gender=NULL, d_lu_race=NULL, d_lu_ethnicity=NULL, + variable_gender="gender", variable_race="race", variable_ethnicity="ethnicity" +) { column_order <- c( "race", @@ -201,7 +220,7 @@ table_nih_enrollment_pretty <- function(d, d_lu_gender=NULL, d_lu_race=NULL, d_l "Unknown/Not Reported by Unknown/Not Reported Ethnicity" ) - table_nih_enrollment(d, d_lu_gender, d_lu_race, d_lu_ethnicity) %>% + table_nih_enrollment(d, d_lu_gender, d_lu_race, d_lu_ethnicity, variable_gender, variable_race, variable_ethnicity) %>% dplyr::mutate( gender_ethnicity = paste0(.data$gender, " by ", .data$ethnicity) ) %>% diff --git a/man/table_nih_enrollment.Rd b/man/table_nih_enrollment.Rd index 035d03c..81f76f2 100644 --- a/man/table_nih_enrollment.Rd +++ b/man/table_nih_enrollment.Rd @@ -6,7 +6,8 @@ \title{Produce an NIH-compliant enrolment table.} \usage{ table_nih_enrollment(d, d_lu_gender = NULL, d_lu_race = NULL, - d_lu_ethnicity = NULL) + d_lu_ethnicity = NULL, variable_gender = "gender", + variable_race = "race", variable_ethnicity = "ethnicity") } \arguments{ \item{d}{\link{data.frame} of observed values in the investigation. Required.} @@ -16,6 +17,12 @@ table_nih_enrollment(d, d_lu_gender = NULL, d_lu_race = NULL, \item{d_lu_race}{\link{data.frame} that maps the observed levels of gender to the NIH-recommended levels of gender. Required only if the levels are not the same.} \item{d_lu_ethnicity}{\link{data.frame} that maps the observed levels of gender to the NIH-recommended levels of gender. Required only if the levels are not the same.} + +\item{variable_gender}{name of the gender variable in the \code{d} \link{data.frame}. Defaults to gender.} + +\item{variable_race}{name of the race variable in the \code{d} \link{data.frame}. Defaults to race.} + +\item{variable_ethnicity}{name of the ethnicity variable in the \code{d} \link{data.frame}. Defaults to ethnicity.} } \value{ Table for publication diff --git a/tests/testthat/test-table-nih-enrollment.R b/tests/testthat/test-table-nih-enrollment.R index fd6b421..cd6bdbf 100644 --- a/tests/testthat/test-table-nih-enrollment.R +++ b/tests/testthat/test-table-nih-enrollment.R @@ -79,14 +79,14 @@ test_that("ds_1b --ethnicity metadata required", { test_that("ds_1c --all metadata required", { d_1c <- tibble::tribble( ~subject_id, ~gender , ~race , ~ethnicity , - 1L, "M" , "B" , "Not Latino" , - 2L, "M" , "B" , "Not Latino" , - 3L, "F" , "B" , "Unknown" , - 4L, "M" , "W" , "Not Latino" , - 5L, "M" , "W" , "Not Latino" , - 6L, "F" , "W" , "Not Latino" , - 7L, "M" , "W" , "Latino" , - 8L, "M" , "W" , "Latino" + 1L, "M" , "B" , "Not Latino" , + 2L, "M" , "B" , "Not Latino" , + 3L, "F" , "B" , "Unknown" , + 4L, "M" , "W" , "Not Latino" , + 5L, "M" , "W" , "Not Latino" , + 6L, "F" , "W" , "Not Latino" , + 7L, "M" , "W" , "Latino" , + 8L, "M" , "W" , "Latino" ) d_lu_gender <- tibble::tribble( @@ -116,6 +116,18 @@ test_that("ds_1c --all metadata required", { expect_equal(observed, expected_1) }) +test_that("ds_1d --different variable names", { + ds_1d <- ds_1a %>% + dplyr::rename( + vg = gender, + vr = race, + ve = ethnicity + ) + + observed <- table_nih_enrollment(ds_1d, variable_gender="vg", variable_race="vr", variable_ethnicity="ve") + expect_equal(observed, expected_1) +}) + test_that("ds_2 --500 patients w/ numeric codes", { # library(magrittr)