Merge pull request #43 from getwilds/vignette

created handle crowding

R/demo-crowding.R

@@ -23,30 +23,31 @@
 #' @examples
 #' \dontrun{
 #' demo_crowding(area = "WA", 
-#'               areatype = "hsa", 
+#'               areatype = "hsa",
+#'               crowding = "household with >1 person per room",
 #'               race = "All Races (includes Hispanic)")
 #'              
 #' demo_crowding(area = "usa",
 #'               areatype = "state",
+#'               crowding = "household with >1 person per room",
 #'               race = "All Races (includes Hispanic)")
 #'
 #' demo_crowding(area = "pr",
 #'               areatype = "hsa",
+#'               crowding = "household with >1 person per room",
 #'               race = "black")
 #' }
 #' 
-demo_crowding <- function(area, areatype, race) {
+demo_crowding <- function(area, areatype, crowding, race) {
 
-  crowding = "00027"
-
   req <- create_request("demographics")
 
   resp <- req %>% 
     req_url_query(
       stateFIPS=fips_scp(area),
       areatype=tolower(areatype),
       topic="crowd",
-      demo=crowding,
+      demo=handle_crowding(crowding),
       race=handle_race(race),
       type="manyareacensus",
       sortVariableName="value",

R/handle-crowding.R

@@ -0,0 +1,31 @@
+#' Handles Crowding Values to Code
+#' 
+#' This function returns a matching code value for Crowding for the api to use to get data from State Cancer Profiles
+#'
+#' @param crowding "household with >1 person per room"
+#' 
+#' @importFrom rlang is_na
+#' 
+#' @returns A string for its respective Crowding Value
+#' 
+#' @noRd
+#' 
+#' @examples
+#' \dontrun{
+#' handle_crowding("household with >1 person per room")
+#' }
+handle_crowding <- function(crowding) {
+  crowding <- tolower(crowding)
+
+  crowding_mapping <- c(
+    "household with >1 person per room" = "00027"
+  )
+
+  crowding_code <- crowding_mapping[crowding]
+
+  if (is_na(crowding_code)) {
+    stop("Invalid crowding input, please check the documentation for valid inputs")
+  }
+
+  return(as.character(crowding_code))
+}

tests/testthat/test-demo-crowding.R

@@ -4,20 +4,29 @@
 #' 
 #tests class and typeof output
 test_that("Output data type is correct", {
-  output <- demo_crowding("wa", "hsa", "All Races (includes Hispanic)")
+  output <- demo_crowding(area = "wa",
+                          areatype = "hsa", 
+                          crowding = "household with >1 person per room",
+                          race = "All Races (includes Hispanic)")
 
   expect_true(inherits(output, "data.frame"))
 })
 
 #Ensures that variables are present and working on SCP
 test_that("demo-crowding returns non-empty data frame", {
-  crowding1 <- demo_crowding("wa", "hsa", "All Races (includes Hispanic)")
+  crowding1 <- demo_crowding(area = "wa",
+                             areatype = "hsa", 
+                             crowding = "household with >1 person per room",
+                             race = "All Races (includes Hispanic)")
   expect_true(is.data.frame(crowding1))
 })
 
 #demo-crowding must have 5 columns
 test_that("demo-crowding has correct number of columns", {
-  df <- demo_crowding("wa", "hsa", "All Races (includes Hispanic)")
+  df <- demo_crowding(area = "wa",
+                      areatype = "hsa", 
+                      crowding = "household with >1 person per room",
+                      race = "All Races (includes Hispanic)")
   expected_columns <- 5
   expect_equal(ncol(df), expected_columns)
 })

vignettes/demographics-vignette.Rmd

@@ -27,6 +27,8 @@ These functions are: `demo_crowding()`, `demo_education()`, `demo_food()`, `demo
 
 Each of these functions require various parameters that must be specified to pull data. Please refer to function documentation for more details.
 
+### Demo Crowding
+Demo crowding always requires 3 arguments: area, areatype, and race
 
 ```{r}
 # demo_education("wa", "county", "at least high school", "males")