Skip to content

Commit

Permalink
order the variables/factors
Browse files Browse the repository at this point in the history 
ref #3
  • Loading branch information
@wibeasley
wibeasley committed Sep 1, 2018
1 parent b6572a2 commit e84f766
Show file tree
Hide file tree
Showing 3 changed files with 116 additions and 73 deletions.
48 changes: 39 additions & 9 deletions R/table-nih-enrollment.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,7 @@
#' ) %>%
#' dplyr::select(-gender, -ethnicity) %>%
#' tidyr::spread(key=gender_ethnicity, value=n)
#' }
#' }
#'
#' ds_2 <- tibble::tribble(
#' ~subject_id, ~gender , ~race , ~ethnicity ,
Expand All @@ -67,12 +67,12 @@
#' "Unknown" , "Unknown/Not Reported Ethnicity"
#' )
#' table_nih_enrollment(ds_2, d_lu_ethnicity=ds_lu_ethnicity)
#' table_nih_enrollment_pretty(ds_2)
#' table_nih_enrollment_pretty(ds_2, d_lu_ethnicity=ds_lu_ethnicity)
#'
#' ## Read a 500-patient fake dataset
#' library(magrittr)
#' path <- system.file("misc/example-data-1.csv", package="codified")
#' ds_2 <- readr::read_csv(path) %>%
#' ds_3 <- readr::read_csv(path) %>%
#' dplyr::mutate(
#' gender = as.character(gender),
#' race = as.character(race),
Expand Down Expand Up @@ -101,12 +101,21 @@
#' "1" , "Hispanic or Latino" ,
#' "0" , "Unknown/Not Reported Ethnicity"
#' )
#'
#' table_nih_enrollment(
#' d = ds_2,
#' d = ds_3,
#' d_lu_gender = ds_lu_gender,
#' d_lu_race = ds_lu_race,
#' d_lu_ethnicity = ds_lu_ethnicity
#' )
#'
#' table_nih_enrollment_pretty(
#' d = ds_3,
#' d_lu_gender = ds_lu_gender,
#' d_lu_race = ds_lu_race,
#' d_lu_ethnicity = ds_lu_ethnicity
#' )
#'

#' @export
table_nih_enrollment <- function( d, d_lu_gender=NULL, d_lu_race=NULL, d_lu_ethnicity=NULL ) {
Expand Down Expand Up @@ -140,7 +149,12 @@ table_nih_enrollment <- function( d, d_lu_gender=NULL, d_lu_race=NULL, d_lu_ethn
gender = levels_gender,
race = levels_race,
ethnicity = levels_ethnicity
)
) #%>%
# dplyr::transmute(
# gender_ethnicity = paste0(.data$gender, " by ", .data$ethnicity)
# ) %>%
# dplyr::pull(gender_ethnicity) %>%
# dput()

d_count <- d %>%
dplyr::count(.data$gender, .data$race, .data$ethnicity)
Expand Down Expand Up @@ -169,15 +183,18 @@ table_nih_enrollment <- function( d, d_lu_gender=NULL, d_lu_race=NULL, d_lu_ethn
d_count %>%
dplyr::full_join(d_possible, by = c("gender", "race", "ethnicity")) %>%
dplyr::mutate(
gender = factor(.data$gender , levels=levels_gender ),
race = factor(.data$race , levels=levels_race ),
ethnicity = factor(.data$ethnicity, levels=levels_ethnicity ),
n = dplyr::coalesce(.data$n, 0L)
) %>%
dplyr::select(.data$gender, .data$race, .data$ethnicity, .data$n)
dplyr::select(.data$gender, .data$race, .data$ethnicity, .data$n) %>%
dplyr::arrange(.data$gender, .data$race, .data$ethnicity)
}

#' @export
table_nih_enrollment_pretty <- function(d, d_lu_gender, d_lu_race, d_lu_ethnicity ) {
d %>%
table_nih_enrollment() %>%
table_nih_enrollment_pretty <- function(d, d_lu_gender=NULL, d_lu_race=NULL, d_lu_ethnicity=NULL ) {
table_nih_enrollment(d, d_lu_gender, d_lu_race, d_lu_ethnicity) %>%
dplyr::mutate(
gender_ethnicity = paste0(.data$gender, " by ", .data$ethnicity)
) %>%
Expand All @@ -191,3 +208,16 @@ table_nih_enrollment_pretty <- function(d, d_lu_gender, d_lu_race, d_lu_ethnicit
full_width = FALSE
)
}
# levels_wide <- c(
# "Female by Not Hispanic or Latino",
# "Male by Not Hispanic or Latino",
# "Unknown/Not Reported by Not Hispanic or Latino",
#
# "Female by Hispanic or Latino",
# "Male by Hispanic or Latino",
# "Unknown/Not Reported by Hispanic or Latino",
#
# "Female by Unknown/Not Reported Ethnicity",
# "Male by Unknown/Not Reported Ethnicity",
# "Unknown/Not Reported by Unknown/Not Reported Ethnicity"
# )
17 changes: 13 additions & 4 deletions man/table_nih_enrollment.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

124 changes: 64 additions & 60 deletions tests/testthat/test-table-nih-enrollment.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,66 +2,30 @@ library(testthat)
context("NIH Table")

expected_1 <- structure(
list(gender = c("Female", "Female", "Male", "Male",
"Male", "Female", "Female", "Female", "Female", "Female", "Female",
"Female", "Female", "Female", "Female", "Female", "Female", "Female",
"Female", "Female", "Female", "Female", "Female", "Female", "Male",
"Male", "Male", "Male", "Male", "Male", "Male", "Male", "Male",
"Male", "Male", "Male", "Male", "Male", "Male", "Male", "Male",
"Male", "Unknown/Not Reported", "Unknown/Not Reported", "Unknown/Not Reported",
"Unknown/Not Reported", "Unknown/Not Reported", "Unknown/Not Reported",
"Unknown/Not Reported", "Unknown/Not Reported", "Unknown/Not Reported",
"Unknown/Not Reported", "Unknown/Not Reported", "Unknown/Not Reported",
"Unknown/Not Reported", "Unknown/Not Reported", "Unknown/Not Reported",
"Unknown/Not Reported", "Unknown/Not Reported", "Unknown/Not Reported",
"Unknown/Not Reported", "Unknown/Not Reported", "Unknown/Not Reported"
), race = c("Black or African American", "White", "Black or African American",
"White", "White", "American Indian/Alaska Native", "American Indian/Alaska Native",
"American Indian/Alaska Native", "Asian", "Asian", "Asian", "Black or African American",
"Black or African American", "More than One Race", "More than One Race",
"More than One Race", "Native Hawaiian or Other Pacific Islander",
"Native Hawaiian or Other Pacific Islander", "Native Hawaiian or Other Pacific Islander",
"Unknown or Not Reported", "Unknown or Not Reported", "Unknown or Not Reported",
"White", "White", "American Indian/Alaska Native", "American Indian/Alaska Native",
"American Indian/Alaska Native", "Asian", "Asian", "Asian", "Black or African American",
"Black or African American", "More than One Race", "More than One Race",
"More than One Race", "Native Hawaiian or Other Pacific Islander",
"Native Hawaiian or Other Pacific Islander", "Native Hawaiian or Other Pacific Islander",
"Unknown or Not Reported", "Unknown or Not Reported", "Unknown or Not Reported",
"White", "American Indian/Alaska Native", "American Indian/Alaska Native",
"American Indian/Alaska Native", "Asian", "Asian", "Asian", "Black or African American",
"Black or African American", "Black or African American", "More than One Race",
"More than One Race", "More than One Race", "Native Hawaiian or Other Pacific Islander",
"Native Hawaiian or Other Pacific Islander", "Native Hawaiian or Other Pacific Islander",
"Unknown or Not Reported", "Unknown or Not Reported", "Unknown or Not Reported",
"White", "White", "White"), ethnicity = c("Unknown/Not Reported Ethnicity",
"Not Hispanic or Latino", "Not Hispanic or Latino", "Hispanic or Latino",
"Not Hispanic or Latino", "Hispanic or Latino", "Not Hispanic or Latino",
"Unknown/Not Reported Ethnicity", "Hispanic or Latino", "Not Hispanic or Latino",
"Unknown/Not Reported Ethnicity", "Hispanic or Latino", "Not Hispanic or Latino",
"Hispanic or Latino", "Not Hispanic or Latino", "Unknown/Not Reported Ethnicity",
"Hispanic or Latino", "Not Hispanic or Latino", "Unknown/Not Reported Ethnicity",
"Hispanic or Latino", "Not Hispanic or Latino", "Unknown/Not Reported Ethnicity",
"Hispanic or Latino", "Unknown/Not Reported Ethnicity", "Hispanic or Latino",
"Not Hispanic or Latino", "Unknown/Not Reported Ethnicity", "Hispanic or Latino",
"Not Hispanic or Latino", "Unknown/Not Reported Ethnicity", "Hispanic or Latino",
"Unknown/Not Reported Ethnicity", "Hispanic or Latino", "Not Hispanic or Latino",
"Unknown/Not Reported Ethnicity", "Hispanic or Latino", "Not Hispanic or Latino",
"Unknown/Not Reported Ethnicity", "Hispanic or Latino", "Not Hispanic or Latino",
"Unknown/Not Reported Ethnicity", "Unknown/Not Reported Ethnicity",
"Hispanic or Latino", "Not Hispanic or Latino", "Unknown/Not Reported Ethnicity",
"Hispanic or Latino", "Not Hispanic or Latino", "Unknown/Not Reported Ethnicity",
"Hispanic or Latino", "Not Hispanic or Latino", "Unknown/Not Reported Ethnicity",
"Hispanic or Latino", "Not Hispanic or Latino", "Unknown/Not Reported Ethnicity",
"Hispanic or Latino", "Not Hispanic or Latino", "Unknown/Not Reported Ethnicity",
"Hispanic or Latino", "Not Hispanic or Latino", "Unknown/Not Reported Ethnicity",
"Hispanic or Latino", "Not Hispanic or Latino", "Unknown/Not Reported Ethnicity"
), n = c(1L, 1L, 2L, 2L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA,
-63L)
list(gender = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("Female", "Male",
"Unknown/Not Reported"), class = "factor"), race = structure(c(1L,
1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 4L, 4L, 4L, 5L, 5L, 5L, 6L, 6L,
6L, 7L, 7L, 7L, 1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 4L, 4L, 4L,
5L, 5L, 5L, 6L, 6L, 6L, 7L, 7L, 7L, 1L, 1L, 1L, 2L, 2L, 2L, 3L,
3L, 3L, 4L, 4L, 4L, 5L, 5L, 5L, 6L, 6L, 6L, 7L, 7L, 7L), .Label = c("American Indian/Alaska Native",
"Asian", "Native Hawaiian or Other Pacific Islander", "Black or African American",
"White", "More than One Race", "Unknown or Not Reported"), class = "factor"),
ethnicity = structure(c(1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L,
1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L,
1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L,
1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L,
1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L), .Label = c("Not Hispanic or Latino",
"Hispanic or Latino", "Unknown/Not Reported Ethnicity"), class = "factor"),
n = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 2L, 0L, 0L, 2L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L)), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -63L)
)


Expand Down Expand Up @@ -151,3 +115,43 @@ test_that("ds_1c --all metadata required", {
observed <- table_nih_enrollment(d_1c, d_lu_gender=d_lu_gender, d_lu_race=d_lu_race, d_lu_ethnicity=d_lu_ethnicity)
expect_equal(observed, expected_1)
})

test_that("ds_2 --500 patients w/ numeric codes", {

# library(magrittr)
path <- system.file("misc/example-data-1.csv", package="codified")
d_2 <- readr::read_csv(path) %>%
dplyr::mutate(
gender = as.character(gender),
race = as.character(race),
ethnicity = as.character(ethnicity)
)
d_lu_gender <- tibble::tribble(
~input, ~displayed ,
"0" , "Female",
"1" , "Male",
"U" , "Unknown/Not Reported"
)
d_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"
)
d_lu_ethnicity <- tibble::tribble(
~input, ~displayed ,
"2" , "Not Hispanic or Latino" ,
"1" , "Hispanic or Latino" ,
"0" , "Unknown/Not Reported Ethnicity"
)
table_nih_enrollment(
d = d_2,
d_lu_gender = d_lu_gender,
d_lu_race = d_lu_race,
d_lu_ethnicity = d_lu_ethnicity
)
})

0 comments on commit e84f766

Please sign in to comment.