Merge pull request #48 from getwilds/vignette

created handle and test non english/ edited demo vignette

R/demo-insurance.R

@@ -14,8 +14,8 @@
 #' @param sex Either "both sexes", "male", "female"
 #' @param age Either "under 19 years", "18 to 64 years","21 to 64 years","40 to 64 years","50 to 64 years","under 65 years" for "both sexes"
 #'                  "18 to 64 years","40 to 64 years","50 to 64 years","Under 65 years" for "males" and "females"
-#' @param race Either "all races (includes hispanic)", "white non hispanic", "black non hispanic", "american indian / alaska native non-hispanic",
-#'                    "asian non-hispanic", "hispanic (any race)"
+#' @param race Either "all races (includes hispanic)", "white (non-hispanic)", "black (non-hispanic)", "american indian / alaska native non-hispanic",
+#'                    "asian (non-hispanic)", "hispanic (any race)"
 #'                  
 #' @importFrom httr2 req_url_query req_perform
 #' @importFrom cli cli_abort
@@ -30,8 +30,8 @@
 #'                areatype = "state",
 #'                insurance = "% Insured in demographic group, all income levels", 
 #'                sex = "both sexes",
-#'                age = "under 19 years",
-#'                race = "all races (includes hispanic)")
+#'                age = "18 to 64 years",
+#'                race = "white (non-hispanic)")
 #'                
 #' demo_insurance(area = "wa", 
 #'                areatype = "hsa",

R/demo-non-english-language.R

@@ -4,6 +4,7 @@
 #'
 #' @param area A state/territory abbreviation or USA.
 #' @param areatype Either "county", "hsa" (Health service area), or "state"
+#' @param language "language isolation"
 #' 
 #' @importFrom httr2 req_url_query req_perform
 #' @importFrom stats setNames
@@ -13,15 +14,18 @@
 #' @export
 #' 
 #' @examples 
-#' demo_language(area = "WA", 
-#'               areatype = "county")
+#' demo_language(area = "WA",
+#'               areatype = "county",
+#'               language = "language isolation")
 #'               
 #' demo_language(area = "dc",
-#'               areatype = "hsa")
+#'               areatype = "hsa",
+#'               language = "language isolation")
 #'               
 #' demo_language(area = "usa", 
-#'               areatype = "state")
-demo_language <- function(area, areatype) {
+#'               areatype = "state",
+#'               language = "language isolation")
+demo_language <- function(area, areatype, language) {
 
   req <- create_request("demographics")
 
@@ -30,7 +34,7 @@ demo_language <- function(area, areatype) {
       stateFIPS=fips_scp(area),
       areatype=tolower(areatype),
       topic="lang",
-      demo="00015",
+      demo=handle_non_english(language),
       type="manyareacensus",
       sortVariableName="value",
       sortOrder="default",

R/demo-population.R

@@ -9,7 +9,7 @@
 #'                                                "non-hispanic (origin recode)", "white", "males", "females"
 #' @param race One of the following values: "american indian/alaska native", "asian/pacific islander", 
 #'                                          "black", "hispanic", "white (includes hispanic)", "white non-hispanic", "hispanic (any race)"
-#' @param sex Either "both sexes", "male", "female"
+#' @param sex Either "both sexes", "males", "females"
 #' 
 #' @importFrom httr2 req_url_query req_perform
 #' @importFrom cli cli_abort
@@ -23,8 +23,8 @@
 #' \dontrun{
 #' demo_population(area = "WA",
 #'                 areatype = "county",
-#'                 population = "asian/pacific islander",
-#'                 sex="females")
+#'                 population = "males",
+#'                 race = "all races (includes hispanic)")
 #'                 
 #' demo_population(area = "dc",
 #'                 areatype = "hsa",

R/handle-non-english.R

@@ -0,0 +1,31 @@
+#' Handles Non-English Language Values to Code
+#' 
+#' This function returns a matching code value for Non-English Language for the api to use to get data from State Cancer Profiles
+#'
+#' @param language "language isolation"
+#' 
+#' @importFrom rlang is_na
+#' 
+#' @returns A string for its respective language Value
+#' 
+#' @noRd
+#' 
+#' @examples
+#' \dontrun{
+#' handle_non_english("language isolation")
+#' }
+handle_non_english <- function(language) {
+  language <- tolower(language)
+
+  language_mapping <- c(
+    "language isolation" = "00015"
+  )
+
+  language_code <- language_mapping[language]
+
+  if (is_na(language_code)) {
+    stop("Invalid language input, please check the documentation for valid inputs")
+  }
+
+  return(as.character(language_code))
+}

R/handle-race.R

@@ -40,7 +40,7 @@ handle_race <- function(race) {
     "amer. indian / ak native (non-hispanic)" = "38",
     "american indian / alaska native non-hispanic" = "38",
     "asian / pacific islander (non-hispanic)" = "48",
-    "asian non-hispanic" = "49"
+    "asian (non-hispanic)" = "49"
 
   )
 

tests/testthat/test-demo-non-english-language.R

@@ -4,20 +4,20 @@
 #' 
 #tests class and typeof output
 test_that("Output data type is correct", {
-  output <- demo_language("wa", "county")
+  output <- demo_language("wa", "county", "language isolation")
 
   expect_true(inherits(output, "data.frame"))
 })
 
 #Ensures that variables are present and working on SCP
 test_that("demo-language returns non-empty data frame", {
-  language1 <- demo_language("wa", "county")
+  language1 <- demo_language("wa", "county", "language isolation")
   expect_true(is.data.frame(language1))
 })
 
 #demo-language must have 5 columns
 test_that("demo-language has correct number of columns", {
-  df <- demo_language("wa", "county")
+  df <- demo_language("wa", "county", "language isolation")
   expected_columns <- 5
   expect_equal(ncol(df), expected_columns)
 })

tests/testthat/test-handle-crowding.R

@@ -0,0 +1,13 @@
+#' Test Handle crowding
+#' 
+#' This testthat file tests the handle-crowding function
+test_that("handle crowding correctly maps crowding", {
+  result <- sapply(c("household with >1 person per room"), handle_crowding)
+  expected <- c(`household with >1 person per room` = "00027")
+
+  expect_equal(result, expected)
+})
+
+test_that("handle crowding expects errors for incorrect arguments", {
+  expect_error(handle_crowding("carrot"))
+})

tests/testthat/test-handle-non-english.R

@@ -0,0 +1,13 @@
+#' Test Handle Non-english
+#' 
+#' This testthat file tests the handle_non_english function
+test_that("handle_non_english correctly maps language", {
+  result <- sapply(c("language isolation"), handle_non_english)
+  expected <- c(`language isolation` = "00015")
+
+  expect_equal(result, expected)
+})
+
+test_that("handle_non_english expects errors for incorrect arguments", {
+  expect_error(handle_non_english("carrot"))
+})

tests/testthat/test-handle-race.R

@@ -3,10 +3,10 @@
 #' This testthat file tests the handle-race function
 test_that("handle race correctly maps race", {
   result <- sapply(c("all races (includes hispanic)", "white (non-hispanic)", 
-                     "asian non-hispanic"), handle_race)
+                     "asian (non-hispanic)"), handle_race)
   expected <- c(`all races (includes hispanic)` = "00", 
                 `white (non-hispanic)` = "07", 
-                `asian non-hispanic` = "49")
+                `asian (non-hispanic)` = "49")
 
   expect_equal(result, expected)
 })

vignettes/demographics-vignette.Rmd

@@ -1,5 +1,5 @@
 ---
-title: "demographics-vignette"
+title: "Demographics"
 output: rmarkdown::html_vignette
 vignette: >
   %\VignetteIndexEntry{cancerprof-vignette}
@@ -115,8 +115,90 @@ Demo insurance has 6 arguments: area, areatype, insurance, sex, age, race.
 **Please note that the age arguments for "both sexes" is different than "Males and "Females"**
 Check function documentations for more details
 
-USA State can select Race, otherwise race should always be "all races (includes hispanic)
+Only Areatype "State" can select Race, otherwise race should always be "all races (includes hispanic)
 
 ```{r insurance}
+insurance1 <- demo_insurance(area = "usa",
+                             areatype = "state",
+                             insurance = "% Insured in demographic group, all income levels",
+                             sex = "both sexes",
+                             age = "18 to 64 years",
+                             race = "white (non-hispanic)")
+
+head(insurance1, n=3)
+
+insurance2 <- demo_insurance(area = "wa", 
+                             areatype = "county",
+                             insurance = "% Insured in demographic group, all income levels",
+                             sex = "males",
+                             age = "18 to 64 years")
+
+head(insurance2, n=3)
+```
+
+### Demo Mobility
+Demo mobility **Always** requires 3 arguments: area, areatype, mobility. The function defaults to "all races", "both sexes", "ages 1+"
+
+```{r mobility}
+mobility1 <- demo_mobility(area = "usa",
+                           areatype = "state",
+                           mobility = "moved, same county (in past year)")
+
+head(mobility1, n=3)
+
+
+mobility2 <- demo_mobility(area = "WA",
+                           areatype = "county",
+                           mobility = "moved, different county, same state (in past year)")
+
+head(mobility2, n=3)
+```
+
+### Demo Language
+Demo Language **Always** requires 3 arguments: area, areatype, language. The function defaults to "all races", "both sexes", "ages 14+"
+
+```{r Language}
+non_english1 <- demo_language(area = "wa",
+                              areatype = "county",
+                              language = "language isolation")
+
+head(non_english1, n=3)
 
+
+non_english2 <- demo_language(area = "usa", 
+                              areatype = "state",
+                              language = "language isolation")
+
+head(non_english2, n=3)
 ```
+
+### Demo Population
+Demo Population has 5 arguments: area, areatype, population, race, sex. The population argument is used to input a population variable such as age, race, or sex. Please note that this different from the race and sex arguments and different population variables will default race, sex, and age.
+
+*If you select "foreign born" for population, you must provide another race for the race argument*
+
+```{r population}
+#
+population1 <- demo_population(area = "wa",
+                                areatype = "county",
+                                population = "foreign born",
+                                race = "black",
+                                sex = "females")
+
+head(population1, n=3)
+
+
+population2 <- demo_population(area = "ca",
+                               areatype = "county",
+                               population = "males",
+                               race = "all races (includes hispanic)")
+
+head(population2, n=3)
+
+population3 <- demo_population(area = "usa",
+                               areatype = "state",
+                               population = "age under 18",
+                               race = "all races (includes hispanic)",
+                               sex = "both sexes")
+
+head(population3, n=3)