Merge pull request #49 from getwilds/vignette

Vignette

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"

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",

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))
+}

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)
 })

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"))
+})

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
@@ -201,4 +201,80 @@ population3 <- demo_population(area = "usa",
                                race = "all races (includes hispanic)",
                                sex = "both sexes")
 
-head(population3, n=3)
+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
+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)
+```

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)
+```
+
+
+
+
+
+
+
+