From 4ccc45d5075a91d13bddd990ce187860675a5163 Mon Sep 17 00:00:00 2001
From: realbp <realbp@uw.edu>
Date: Fri, 1 Mar 2024 13:13:17 -0800
Subject: [PATCH] created handle and test non english/ edited demo vignette

---
 R/demo-insurance.R                            |  8 +-
 R/demo-non-english-language.R                 | 16 ++--
 R/demo-population.R                           |  6 +-
 R/handle-non-english.R                        | 31 +++++++
 R/handle-race.R                               |  2 +-
 man/demo_insurance.Rd                         |  8 +-
 man/demo_language.Rd                          | 15 ++--
 man/demo_population.Rd                        |  6 +-
 .../testthat/test-demo-non-english-language.R |  6 +-
 tests/testthat/test-handle-crowding.R         | 13 +++
 tests/testthat/test-handle-non-english.R      | 13 +++
 tests/testthat/test-handle-race.R             |  4 +-
 vignettes/demographics-vignette.Rmd           | 86 ++++++++++++++++++-
 13 files changed, 181 insertions(+), 33 deletions(-)
 create mode 100644 R/handle-non-english.R
 create mode 100644 tests/testthat/test-handle-crowding.R
 create mode 100644 tests/testthat/test-handle-non-english.R

diff --git a/R/demo-insurance.R b/R/demo-insurance.R
index d9dff34..b19dac5 100644
--- a/R/demo-insurance.R
+++ b/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",
diff --git a/R/demo-non-english-language.R b/R/demo-non-english-language.R
index e754f86..8b968fe 100644
--- a/R/demo-non-english-language.R
+++ b/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",
diff --git a/R/demo-population.R b/R/demo-population.R
index 3a38ddd..3fbfc5a 100644
--- a/R/demo-population.R
+++ b/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",
diff --git a/R/handle-non-english.R b/R/handle-non-english.R
new file mode 100644
index 0000000..c73ec5f
--- /dev/null
+++ b/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))
+}
\ No newline at end of file
diff --git a/R/handle-race.R b/R/handle-race.R
index e11a27d..79db7eb 100644
--- a/R/handle-race.R
+++ b/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"
     
   )
   
diff --git a/man/demo_insurance.Rd b/man/demo_insurance.Rd
index c8019ed..496fa57 100644
--- a/man/demo_insurance.Rd
+++ b/man/demo_insurance.Rd
@@ -24,8 +24,8 @@ demo_insurance(area, areatype, insurance, sex, age, race = NULL)
 \item{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"}
 
-\item{race}{Either "all races (includes hispanic)", "white non hispanic", "black non hispanic", "american indian / alaska native non-hispanic",
-"asian non-hispanic", "hispanic (any race)"}
+\item{race}{Either "all races (includes hispanic)", "white (non-hispanic)", "black (non-hispanic)", "american indian / alaska native non-hispanic",
+"asian (non-hispanic)", "hispanic (any race)"}
 }
 \value{
 A data frame with the following columns: Area Type, Area Code, "Percent", "People", "Rank"
@@ -39,8 +39,8 @@ demo_insurance(area = "usa",
                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",
diff --git a/man/demo_language.Rd b/man/demo_language.Rd
index cfefbf8..11ded96 100644
--- a/man/demo_language.Rd
+++ b/man/demo_language.Rd
@@ -4,12 +4,14 @@
 \alias{demo_language}
 \title{Access to Non-English Language}
 \usage{
-demo_language(area, areatype)
+demo_language(area, areatype, language)
 }
 \arguments{
 \item{area}{A state/territory abbreviation or USA.}
 
 \item{areatype}{Either "county", "hsa" (Health service area), or "state"}
+
+\item{language}{"language isolation"}
 }
 \value{
 A data frame with the following columns: Area Type, Area Code, "Percent", "Households", "Rank"
@@ -18,12 +20,15 @@ A data frame with the following columns: Area Type, Area Code, "Percent", "House
 This function returns a data frame from Crowding in State Cancer Profiles
 }
 \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")
+              areatype = "state",
+              language = "language isolation")
 }
diff --git a/man/demo_population.Rd b/man/demo_population.Rd
index 2c3fc53..e6072d4 100644
--- a/man/demo_population.Rd
+++ b/man/demo_population.Rd
@@ -18,7 +18,7 @@ demo_population(area, areatype, population, race = NULL, sex = NULL)
 \item{race}{One of the following values: "american indian/alaska native", "asian/pacific islander",
 "black", "hispanic", "white (includes hispanic)", "white non-hispanic", "hispanic (any race)"}
 
-\item{sex}{Either "both sexes", "male", "female"}
+\item{sex}{Either "both sexes", "males", "females"}
 }
 \value{
 A data frame with the following columns: Area Type, Area Code, "Percent", "Households", "Rank"
@@ -30,8 +30,8 @@ This function returns a data frame from population in State Cancer Profiles
 \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",
diff --git a/tests/testthat/test-demo-non-english-language.R b/tests/testthat/test-demo-non-english-language.R
index 39becd2..9baba63 100644
--- a/tests/testthat/test-demo-non-english-language.R
+++ b/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)
 })
diff --git a/tests/testthat/test-handle-crowding.R b/tests/testthat/test-handle-crowding.R
new file mode 100644
index 0000000..3c9b313
--- /dev/null
+++ b/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"))
+})
\ No newline at end of file
diff --git a/tests/testthat/test-handle-non-english.R b/tests/testthat/test-handle-non-english.R
new file mode 100644
index 0000000..4df9580
--- /dev/null
+++ b/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"))
+})
\ No newline at end of file
diff --git a/tests/testthat/test-handle-race.R b/tests/testthat/test-handle-race.R
index 1687321..403bc44 100644
--- a/tests/testthat/test-handle-race.R
+++ b/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)
 })
diff --git a/vignettes/demographics-vignette.Rmd b/vignettes/demographics-vignette.Rmd
index da30455..ff56684 100644
--- a/vignettes/demographics-vignette.Rmd
+++ b/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)
\ No newline at end of file