From 7426c2609834ef512ae41147df7fcb7d0858e576 Mon Sep 17 00:00:00 2001 From: realbp Date: Fri, 1 Mar 2024 14:08:26 -0800 Subject: [PATCH 1/2] created handle and test for workforce --- R/demo-crowding.R | 5 +++ R/demo-workforce.R | 8 +++- R/handle-workforce.R | 31 ++++++++++++++ man/demo_workforce.Rd | 7 +++- tests/testthat/test-demo-workforce.R | 9 ++-- tests/testthat/test-handle-workforce.R | 13 ++++++ vignettes/demographics-vignette.Rmd | 58 +++++++++++++++++++++++++- 7 files changed, 124 insertions(+), 7 deletions(-) create mode 100644 R/handle-workforce.R create mode 100644 tests/testthat/test-handle-workforce.R diff --git a/R/demo-crowding.R b/R/demo-crowding.R index a006ede..8595e7a 100644 --- a/R/demo-crowding.R +++ b/R/demo-crowding.R @@ -68,3 +68,8 @@ demo_crowding <- function(area, areatype, crowding, race) { resp %>% setNames(c(areatype_title, areacode_title, "Percent", "Households", "Rank")) } + +area = "wa" +areatype = "county" +race = "all races (includes hispanic)" +crowding = "household with >1 person per room" diff --git a/R/demo-workforce.R b/R/demo-workforce.R index 904ad3d..95a733e 100644 --- a/R/demo-workforce.R +++ b/R/demo-workforce.R @@ -4,6 +4,7 @@ #' #' @param area A state/territory abbreviation or USA. #' @param areatype Either "county", "hsa" (Health service area), or "state" +#' @param workforce "unemployed" #' @param race One of the following values: "All Races (includes Hispanic)", "white (includes hispanic)" = "01", #' "white non-hispanic","black","amer. indian/alaskan native (includes hispanic)", #' "asian or pacific islander (includes hispanic)","hispanic (any race) @@ -20,20 +21,23 @@ #' \dontrun{ #' demo_workforce(area = "WA", #' areatype = "county", +#' workforce = "unemployed", #' race = "all races (includes hispanic)", #' sex = "both sexes") #' #' demo_workforce(area = "usa", #' areatype = "state", +#' workforce = "unemployed", #' race = "all races (includes hispanic)", #' sex = "females") #' #' demo_workforce(area = "pr", #' areatype = "hsa", +#' workforce = "unemployed", #' race = "all races (includes hispanic)", #' sex = "both sexes") #' } -demo_workforce <- function(area, areatype, race, sex) { +demo_workforce <- function(area, areatype, workforce, race, sex) { req <- create_request("demographics") @@ -42,7 +46,7 @@ demo_workforce <- function(area, areatype, race, sex) { stateFIPS=fips_scp(area), areatype=tolower(areatype), topic="crowd", - demo="00012", + demo=handle_workforce(workforce), race=handle_race(race), sex=handle_sex(sex), type="manyareacensus", diff --git a/R/handle-workforce.R b/R/handle-workforce.R new file mode 100644 index 0000000..a4587d6 --- /dev/null +++ b/R/handle-workforce.R @@ -0,0 +1,31 @@ +#' Handles workforce Values to Code +#' +#' This function returns a matching code value for workforce for the api to use to get data from State Cancer Profiles +#' +#' @param workforce "unemployed" +#' +#' @importFrom rlang is_na +#' +#' @returns A string for its respective workforce Value +#' +#' @noRd +#' +#' @examples +#' \dontrun{ +#' handle_workforce("unemployed") +#' } +handle_workforce <- function(workforce) { + workforce <- tolower(workforce) + + workforce_mapping <- c( + "unemployed" = "00012" + ) + + workforce_code <- workforce_mapping[workforce] + + if (is_na(workforce_code)) { + stop("Invalid workforce input, please check the documentation for valid inputs") + } + + return(as.character(workforce_code)) +} \ No newline at end of file diff --git a/man/demo_workforce.Rd b/man/demo_workforce.Rd index a10a194..1ed5c08 100644 --- a/man/demo_workforce.Rd +++ b/man/demo_workforce.Rd @@ -4,13 +4,15 @@ \alias{demo_workforce} \title{Access to Workforce Data} \usage{ -demo_workforce(area, areatype, race, sex) +demo_workforce(area, areatype, workforce, race, sex) } \arguments{ \item{area}{A state/territory abbreviation or USA.} \item{areatype}{Either "county", "hsa" (Health service area), or "state"} +\item{workforce}{"unemployed"} + \item{race}{One of the following values: "All Races (includes Hispanic)", "white (includes hispanic)" = "01", "white non-hispanic","black","amer. indian/alaskan native (includes hispanic)", "asian or pacific islander (includes hispanic)","hispanic (any race)} @@ -27,16 +29,19 @@ This function returns a data frame from Workforce in State Cancer Profiles \dontrun{ demo_workforce(area = "WA", areatype = "county", + workforce = "unemployed", race = "all races (includes hispanic)", sex = "both sexes") demo_workforce(area = "usa", areatype = "state", + workforce = "unemployed", race = "all races (includes hispanic)", sex = "females") demo_workforce(area = "pr", areatype = "hsa", + workforce = "unemployed", race = "all races (includes hispanic)", sex = "both sexes") } diff --git a/tests/testthat/test-demo-workforce.R b/tests/testthat/test-demo-workforce.R index 6cf61f7..045f213 100644 --- a/tests/testthat/test-demo-workforce.R +++ b/tests/testthat/test-demo-workforce.R @@ -4,20 +4,23 @@ #' #tests class and typeof output test_that("Output data type is correct", { - output <- demo_workforce("wa", "county", "all races (includes hispanic)", "both sexes") + output <- demo_workforce("wa", "county", "unemployed", + "all races (includes hispanic)", "both sexes") expect_true(inherits(output, "data.frame")) }) #Ensures that variables are present and working on SCP test_that("demo-workforce returns non-empty data frame", { - workforce1 <- demo_workforce("wa", "county", "all races (includes hispanic)", "both sexes") + workforce1 <- demo_workforce("wa", "county", "unemployed", + "all races (includes hispanic)", "both sexes") expect_true(is.data.frame(workforce1)) }) #demo-workforce must have 5 columns test_that("demo-workforce has correct number of columns", { - df <- demo_workforce("wa", "county", "all races (includes hispanic)", "both sexes") + df <- demo_workforce("wa", "county", "unemployed", + "all races (includes hispanic)", "both sexes") expected_columns <- 5 expect_equal(ncol(df), expected_columns) }) diff --git a/tests/testthat/test-handle-workforce.R b/tests/testthat/test-handle-workforce.R new file mode 100644 index 0000000..103ea05 --- /dev/null +++ b/tests/testthat/test-handle-workforce.R @@ -0,0 +1,13 @@ +#' Test Handle workforce +#' +#' This testthat file tests the handle-workforce function +test_that("handle workforce correctly maps workforce", { + result <- sapply(c("unemployed"), handle_workforce) + expected <- c(`unemployed` = "00012") + + expect_equal(result, expected) +}) + +test_that("handle workforce expects errors for incorrect arguments", { + expect_error(handle_workforce("carrot")) +}) \ No newline at end of file diff --git a/vignettes/demographics-vignette.Rmd b/vignettes/demographics-vignette.Rmd index ff56684..db4bfc2 100644 --- a/vignettes/demographics-vignette.Rmd +++ b/vignettes/demographics-vignette.Rmd @@ -201,4 +201,60 @@ population3 <- demo_population(area = "usa", race = "all races (includes hispanic)", sex = "both sexes") -head(population3, n=3) \ No newline at end of file +head(population3, n=3) +``` + +### Demo Poverty +Demo poverty has 5 arguments: area, areatype, poverty, race, sex. The function defaults to "all ages" + +The "persistent poverty" and "persons <150% of poverty" poverty argument will default to "all races", "both sexes", "all ages". + +The "families below poverty" poverty argument will require a race argument and default to "both sexes" and "all ages". + +The "persons below poverty" poverty argument will require a race argument and a sex argument, and default to "all ages". + +```{r poverty} +#Persistent poverty +poverty1 <- demo_poverty(area = "WA", + areatype = "county", + poverty = "persistent poverty") + +head(poverty1, n=3) + +#Families below poverty +poverty2 <- demo_poverty(area = "usa", + areatype = "state", + poverty = "families below poverty", + race = "black") + +head(poverty2, n=3) + +#Persons below poverty +poverty3 <- demo_poverty(area = "usa", + areatype = "state", + poverty = "persons below poverty", + race = "black", + sex = "males") + +head(poverty3, n=3) +``` + +### Demo Social Vulnerability Index (SVI) +Demo svi **Always** requires 2 arguments: area, svi. The function defaults to "all races", "both sexes", "all ages." + +*Please note that the areatype argument is not available for this function because areatype is limited to "county"* + +```{r svi} +svi1 <- demo_svi(area = "WA", + svi = "overall") + +head(svi1, n=3) + + +svi2 <- demo_svi(area = "usa", + svi = "socioeconomic status") + +head(svi2, n=3) +``` + +### Workforce From ab2e90048943a2bdc1498ddb65d8ac02de71329c Mon Sep 17 00:00:00 2001 From: realbp Date: Mon, 4 Mar 2024 09:57:16 -0800 Subject: [PATCH 2/2] started risk vignette --- vignettes/demographics-vignette.Rmd | 24 +++++++++++-- vignettes/risks-vignette.Rmd | 55 ++++++++++++++++++++++++++++- 2 files changed, 76 insertions(+), 3 deletions(-) diff --git a/vignettes/demographics-vignette.Rmd b/vignettes/demographics-vignette.Rmd index db4bfc2..adc948c 100644 --- a/vignettes/demographics-vignette.Rmd +++ b/vignettes/demographics-vignette.Rmd @@ -31,11 +31,11 @@ Each of these functions require various parameters that must be specified to pul Demo crowding **Always** requires 4 arguments: area, areatype, crowding, and race ```{r crowding} -results <- demo_crowding(area = "WA", +crowding <- demo_crowding(area = "WA", areatype = "county", crowding = "household with >1 person per room", race = "All Races (includes Hispanic)") -head(results, n=3) +head(crowding, n=3) ``` ### Demo Education @@ -258,3 +258,23 @@ head(svi2, n=3) ``` ### Workforce +Demo svi **Always** requires 5 arguments: area, areatype, workforce, race, sex. The function defaults to "ages 16+" + +```{r workforce} +workforce1 <- demo_workforce(area = "WA", + areatype = "county", + workforce = "unemployed", + race = "all races (includes hispanic)", + sex = "both sexes") + +head(workforce1, n=3) + + +workforce2 <- demo_workforce(area = "usa", + areatype = "state", + workforce = "unemployed", + race = "all races (includes hispanic)", + sex = "females") + +head(workforce2, n=3) +``` \ No newline at end of file diff --git a/vignettes/risks-vignette.Rmd b/vignettes/risks-vignette.Rmd index f4c7aeb..7639c04 100644 --- a/vignettes/risks-vignette.Rmd +++ b/vignettes/risks-vignette.Rmd @@ -1,5 +1,5 @@ --- -title: "risks-vignette" +title: "Screening and Risk Factors" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{risks-vignette} @@ -14,6 +14,59 @@ knitr::opts_chunk$set( ) ``` +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +## Load the package ```{r setup} library(cancerprof) ``` + +## Retrieving Data + +The Screening and Risk Factors category of cancerprof contains 6 unique functions to pull data from the demographics page of [State Cancer Profile](https://statecancerprofiles.cancer.gov/demographics/index.php). + +These functions are: `risk_alcohol()`, `risk_colorectal_screening()`, `risk_diet_exercise()`, `risk_smoking()`, `risk_vaccines()`, `risk_womens_health()` + +Each of these functions require various parameters that must be specified to pull data. Please refer to function documentation for more details. + +### Risk Alcohol +Risk Alcohol requires 3 arguments: alcohol, race, sex + +```{r alcohol} +alcohol1 <- risk_alcohol(alcohol = paste("binge drinking (4+ drinks on one occasion for women,", + "5+ drinks for one occasion for men), ages 21+"), + race = "all races (includes hispanic)", + sex = "both sexes") +head(alcohol1, n=3) +``` + +### Risk Colorectal Screening +Risk Colorectal Screening has 4 arguments: screening, race, sex, area + +"home blood stool test in the past year, ages 45-75" and "received at least one recommended crc test, ages 45-75" for the screening arguments requires a race argument and a sex argument and defaults to "direct estimates", "US by state". + +"ever had fobt, ages 50-75", "guidance sufficient crc, ages 50-75", "had colonoscopy in past 10 years, ages 50-75" for the screening arguments defaults to "all races", "both sexes", and "county level modeled estimates" + +```{r colorectal screening} +screening1 <- risk_colorectal_screening(screening = "home blood stool test in the past year, ages 45-75", + race = "all races (includes hispanic)", + sex = "both sexes") +head(screening1, n=3) + +screening2 <- risk_colorectal_screening(screening = "ever had fobt, ages 50-75", + area="usa") +head(screening2, n=3) +``` + + + + + + + +