Merge pull request #32 from getwilds/dev

Dev

DESCRIPTION

@@ -17,7 +17,7 @@ Imports:
     magrittr,
     rlang,
     stringr,
-    testthat,
-    tibble,
     utils
+Suggests: 
+    testthat
 Config/testthat/edition: 3

NAMESPACE

@@ -1,8 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
 export("%>%")
-export(area)
 export(demo_crowding)
+export(demo_education)
 export(demo_food)
 export(demo_income)
 export(demo_insurance)
@@ -18,7 +18,7 @@ export(risk_alcohol)
 export(risk_colorectal_screening)
 export(risk_diet_exercise)
 export(risk_smoking)
-export(risk_vaccine)
+export(risk_vaccines)
 export(risk_whealth)
 importFrom(cdlTools,fips)
 importFrom(cli,cli_abort)
@@ -37,5 +37,6 @@ importFrom(rlang,is_na)
 importFrom(rlang,sym)
 importFrom(stats,setNames)
 importFrom(stringr,str_pad)
+importFrom(stringr,str_replace_all)
 importFrom(utils,data)
 importFrom(utils,read.csv)

R/demo-crowding.R

@@ -50,3 +50,7 @@ demo_crowding <- function(area, areatype, race) {
   resp %>% 
     setNames(c(areatype_title, areacode_title, "Percent", "Households", "Rank"))
 }
+
+area = "pr"
+areatype = "county"
+race = "all races (includes hispanic)"

R/demo-education.R

@@ -25,12 +25,6 @@
 #'                "all races (includes hispanic)")
 #' demo_education("pr", "hsa", "less than 9th grade")
 #' }
-
-area = "wa"
-areatype = "county"
-education = "at least high school"
-sex = "males"
-
 demo_education <- function(area, areatype, education, sex=NULL, race=NULL) {
 
   req <- create_request("demographics")

R/demo-population.R

@@ -39,7 +39,7 @@ demo_population <- function(area, areatype, population, race=NULL, sex=NULL) {
   } else if((population == "males" || population == "females") && (is.null(race) || !is.null(sex))) {
     cli_abort("for males, Race must not be NULL and Sex must be NULL")
   } else if(population == "foreign born" && (is.null(race) || is.null(sex))) {
-    cli_abort("for foreign born, race and sex must not be null")
+    cli_abort("for foreign born, race and sex must not be NULL")
   } else if ((population == "american indian/alaska native" || population == "asian/pacific islander" || population == "black" ||
              population == "hispanic" || population == "non-hispanic (origin recode)" || 
              population == "white") && (is.null(sex) || !is.null(race))) {

R/demo-svi.R

@@ -3,7 +3,7 @@
 #' This function returns a data frame from Social Vulnerability Index (SVI) in State Cancer Profiles
 #'
 #' @param area A state/territory abbreviation or USA.
-#' @param svi Either "Overall, "socioeconomic status", "household characteristics", "racial & ethinic minority status", "housing type & transportation"
+#' @param svi Either "Overall", "socioeconomic status", "household characteristics", "racial & ethinic minority status", "housing type & transportation"
 #' 
 #' @importFrom httr2 req_url_query req_perform
 #' @importFrom stats setNames

R/handle-alcohol.R

@@ -10,7 +10,8 @@
 #' 
 #' @examples
 #' \dontrun{
-#' handle_alcohol("binge drinking (4+ drinks on one occasion for women, 5+ drinks for one occasion for men), ages 21+")
+#' handle_alcohol(paste("binge drinking (4+ drinks on one occasion for women,"
+#'                       "5+ drinks for one occasion for men), ages 21+"))
 #' }
 handle_alcohol <- function(alcohol) {
   alcohol <- tolower(alcohol)

R/handle-screening.R

@@ -20,13 +20,18 @@ handle_screening <- function(screening) {
   screening <- tolower(screening)
 
   screening_mapping <- c(
-    "ever had colorectal endoscopy (sigmoidoscopy or colonoscopy), ages 50+" = "v09",
     "ever had fobt, ages 50-75" = "v304",
-    "fobt (1yr) / flex sig (5yr) / fobt (3yr) / colonoscopy (10yr), ages 50-75" = "v14",
     "guidance sufficient crc, ages 50-75" = "v303",
     "had colonoscopy in past 10 years, ages 50-75" = "v302",
-    "home-based fecal occult blood test (fobt) in past two years" = "v13",
-    "home-based fobt in the past two years or ever had a colorectal endoscopy" = "v59"
+
+    "home blood stool test in the past year, ages 45-75" = "v520",
+    "receieved at least one recommended crc test, ages 45-75" = "v521"
+
+    #removed from scp
+    # "ever had colorectal endoscopy (sigmoidoscopy or colonoscopy), ages 50+" = "v09",
+    # "fobt (1yr) / flex sig (5yr) / fobt (3yr) / colonoscopy (10yr), ages 50-75" = "v14",
+    # "home-based fecal occult blood test (fobt) in past two years" = "v13",
+    # "home-based fobt in the past two years or ever had a colorectal endoscopy" = "v59"
   )
 
   screening_code <- screening_mapping[screening]

R/handle-vaccine.R

@@ -25,7 +25,7 @@ handle_vaccine <- function(vaccine) {
     # "percent who received 3+ doses of hpv vaccine, ages 13-17" = "v71"
 
     "percent with up to date hpv vaccination coverage, ages 13-15" = "v281",
-    "percent with up to date hpv vaccination coverage, ages 13-15" = "v282"
+    "percent with up to date hpv vaccination coverage, ages 13-17" = "v282"
   )
 
   vaccine_code <- vaccine_mapping[vaccine]

R/mortality-cancer.R

@@ -54,7 +54,6 @@ mortality_cancer <- function(area, areatype, cancer, race, sex=NULL, age, year="
     cli_abort("For this cancer type, age cannot be ages <15 or ages <20")
   }
 
-
   req <- create_request("deathrates")
 
   resp <- req %>%
@@ -92,4 +91,3 @@ mortality_cancer <- function(area, areatype, cancer, race, sex=NULL, age, year="
                "CI Rank", "Lower CI Rank", "Upper CI Rank", "Annual Average Count", "Recent Trend", 
                "Recent 5 Year Trend", "Lower 95% CI Trend", "Upper 95% CI Trend"))
 }
-

R/process-incidence.R

@@ -8,6 +8,7 @@
 #' @importFrom dplyr mutate_all na_if filter mutate rename
 #' @importFrom rlang sym :=
 #' @importFrom utils read.csv data
+#' @importFrom stringr str_replace_all
 #' 
 #' @returns A processed response data frame
 #' 
@@ -43,5 +44,6 @@ process_incidence <- function(resp) {
   if(column %in% c("Health.Service.Area", "County")) {
       resp <- resp %>%
         filter(!(!!sym(column) %in% state.name))
-    }
+  }
+  resp
 }

R/process-response.R

@@ -45,4 +45,4 @@ process_response <- function(resp) {
   resp %>%   
     mutate_all(\(x) na_if(x, "N/A")) %>% 
     mutate_all(\(x) na_if(x, "data not available"))
-}
+}

R/process-screening.R

@@ -1,10 +1,3 @@
-library(cdlTools)
-library(cli)
-library(dplyr)
-library(httr2)
-library(magrittr)
-library(rlang)
-library(stringr)
 #' Process Response Data
 #' 
 #' This function processes the response data from State Cancer Profiles

R/risk-alcohol.R

@@ -14,10 +14,9 @@
 #' 
 #' @examples
 #' \dontrun{
-#' risk_alcohol("binge drinking (4+ drinks on one occasion for women, 5+ drinks for one occasion for men), ages 21+", 
-#'              "all races (includes hispanic)", "both sexes")
-#' risk_alcohol("binge drinking (4+ drinks on one occasion for women, 5+ drinks for one occasion for men), ages 21+", 
-#'              "hispanic (any race)", "females")
+#' risk_alcohol(paste("binge drinking (4+ drinks on one occasion for women,", 
+#'                    "5+ drinks for one occasion for men), ages 21+"), 
+#'                    "all races (includes hispanic)", "both sexes")
 #' }
 risk_alcohol <- function(alcohol, race, sex) {
 
@@ -41,3 +40,9 @@ risk_alcohol <- function(alcohol, race, sex) {
   resp %>% 
     setNames(c("State", "FIPS", "Percent", "Lower_95%_CI", "Upper_95%_CI", "Number_of_Respondents"))
 }
+
+
+risk_alcohol(paste("binge drinking (4+ drinks on one occasion for women,", 
+                   "5+ drinks for one occasion for men), ages 21+"), 
+                   "all races (includes hispanic)", "both sexes")
+

R/risk-colorectal-screening.R

@@ -2,11 +2,11 @@
 #' 
 #' This function returns a data frame from Colorectal Screening in State Cancer Profiles
 #'
-#' @param screening One of the following values: "ever had colorectal endoscopy (sigmoidoscopy or colonoscopy), ages 50+", 
-#'                                                "fobt (1yr) / flex sig (5yr) / fobt (3yr) / colonoscopy (10yr), ages 50-75", 
-#'                                                "home-based fecal occult blood test (fobt) in past two years", 
-#'                                                "home-based fobt in the past two years or ever had a colorectal endoscopy", "ever had fobt, ages 50-75", 
-#'                                                "guidance sufficient crc, ages 50-75", "had colonoscopy in past 10 years, ages 50-75"
+#' @param screening One of the following values: "home blood stool test in the past year, ages 45-75",
+#'                                               "receieved at least one recommended crc test, ages 45-75",
+#'                                               "ever had fobt, ages 50-75",
+#'                                               "guidance sufficient crc, ages 50-75",
+#'                                               "had colonoscopy in past 10 years, ages 50-75"
 #' @param race One of the following values: "All Races (includes Hispanic)", "white (includes hispanic)",
 #'              "white non-hispanic","black","amer. indian/alaskan native (includes hispanic)",
 #'              "asian or pacific islander (includes hispanic)","hispanic (any race)
@@ -19,22 +19,17 @@
 #' 
 #' @examples
 #' \dontrun{
-#' risk_colorectal_screening("ever had colorectal endoscopy (sigmoidoscopy or colonoscopy), ages 50+",
+#' risk_colorectal_screening("home blood stool test in the past year, ages 45-75",
 #'                           "all races (includes hispanic)","both sexes")
 #' risk_colorectal_screening("ever had fobt, ages 50-75", area="usa")
 #' risk_colorectal_screening("ever had fobt, ages 50-75", area="wa")
-#' risk_colorectal_screening("fobt (1yr) / flex sig (5yr) / fobt (3yr) / colonoscopy (10yr), ages 50-75", 
-#'                           "all races (includes hispanic)", "males" )
-
 #' }
 risk_colorectal_screening <- function(screening, race=NULL, sex=NULL, area=NULL) {
 
   req <- create_request("risk")
 
-  screening_type_1 = c("ever had colorectal endoscopy (sigmoidoscopy or colonoscopy), ages 50+",
-                       "fobt (1yr) / flex sig (5yr) / fobt (3yr) / colonoscopy (10yr), ages 50-75",
-                       "home-based fecal occult blood test (fobt) in past two years",
-                       "home-based fobt in the past two years or ever had a colorectal endoscopy")
+  screening_type_1 = c("home blood stool test in the past year, ages 45-75",
+                       "receieved at least one recommended crc test, ages 45-75")
 
   screening_type_2 = c("ever had fobt, ages 50-75",
                        "guidance sufficient crc, ages 50-75",
@@ -84,3 +79,7 @@ risk_colorectal_screening <- function(screening, race=NULL, sex=NULL, area=NULL)
       setNames(c("County", "FIPS", "Model_Based_Percent (95%_Confidence_Interval)", "Lower_95%_CI", "Upper_95%_CI"))
   }
 }
+risk_colorectal_screening("ever had fobt, ages 50-75", area="wa")
+
+screening = "ever had fobt, ages 50-75"
+area = "ri"

R/risk-diet-exercise.R

@@ -39,6 +39,14 @@ risk_diet_exercise <- function(diet_exercise, race, sex) {
 
   resp <- process_screening(resp)
 
-  resp %>% 
-    setNames(c("State", "FIPS", "Percent", "Lower_95%_CI", "Upper_95%_CI", "Number_of_Respondents"))
+  diet_exercise_type1 = c("bmi is overweight, high school survey",
+                          "bmi is obese, high school survey")
+
+  if (diet_exercise %in% diet_exercise_type1) {
+    resp %>% 
+      setNames(c("State", "FIPS", "Percent", "Lower_95%_CI", "Upper_95%_CI"))
+  } else {
+    resp %>% 
+      setNames(c("State", "FIPS", "Percent", "Lower_95%_CI", "Upper_95%_CI", "Number_of_Respondents"))
+  }
 }

R/risk-smoking.R

@@ -99,7 +99,7 @@ risk_smoking <- function(smoking, race=NULL, sex=NULL, datatype=NULL, area=NULL)
 
   #smoking group 4
   if (smoking %in% smoking_group4 && ((is.null(sex) || is.null(area) || is.null(datatype)) || !is.null(race))) {
-    cli_abort("For this smoking type, Sex, Datatype, and Area must not be NULL AND Race and Datatype must be NULL")
+    cli_abort("For this smoking type, Sex, Datatype, and Area must not be NULL AND Race must be NULL")
   } else if (smoking %in% smoking_group4 && datatype == "direct estimates") {
     cli_abort("For this smoking type, Datatype must be county level modeled estimates")
   }
@@ -111,6 +111,7 @@ risk_smoking <- function(smoking, race=NULL, sex=NULL, datatype=NULL, area=NULL)
     cli_abort("For this smoking type, Datatype must be direct estimates")
   }
 
+  #smoking group 6
   if (smoking %in% smoking_group6 && (is.null(race) || is.null(sex))) {
     cli_abort("For this smoking group, Race and Sex must not be NULL")
   } else if (smoking %in% smoking_group6 && (!is.null(race) && !is.null(sex)) && race == "all races (includes hispanic)") {
@@ -161,7 +162,7 @@ risk_smoking <- function(smoking, race=NULL, sex=NULL, datatype=NULL, area=NULL)
 
   if (smoking %in% smoking_group1) {
     resp %>% 
-      setNames(c("State", "FIPS", "Percent", "Number_of_Respondents")) 
+      setNames(c("State", "FIPS", "Percent")) 
   } else if ((smoking %in% c(smoking_group2, smoking_group3, smoking_group4, smoking_group5, smoking_group6))
               && (datatype=="direct estimates")) {
     resp %>% 

R/risk-vaccines.R

@@ -2,9 +2,8 @@
 #' 
 #' This function returns a data frame from Vaccines in State Cancer Profiles
 #'
-#' @param vaccine Either "mammogram in past 2 years, ages 50-74", "mammogram in past 2 years, ages 40+", 
-#'                       "pap smear in past 3 years, no hysterectomy, ages 21-65", 
-#'                       "pap smear in past 3 years, no hysterectomy, ages 18+"
+#' @param vaccine Either "percent with up to date hpv vaccination coverage, ages 13-15",
+#'                       "percent with up to date hpv vaccination coverage, ages 13-17"
 #' @param sex Either "both sexes", "males", "females"
 #' 
 #' @returns A data frame with the following columns "State", "FIPS", "Percent", "Lower 95% CI", "Upper 95% CI", "Number of Respondents"
@@ -13,11 +12,10 @@
 #' 
 #' @examples
 #' \dontrun{
-#' risk_vaccine("percent with up to date hpv vaccination coverage, ages 13-15", "both sexes")
-#' risk_vaccine("percent with up to date hpv vaccination coverage, ages 13-15", "both sexes")
-#' risk_vaccine("percent with up to date hpv vaccination coverage, ages 13-15", "females")
+#' risk_vaccines("percent with up to date hpv vaccination coverage, ages 13-15", "both sexes")
+#' risk_vaccines("percent with up to date hpv vaccination coverage, ages 13-17", "females")
 #' }
-risk_vaccine <- function(vaccine, sex) {
+risk_vaccines <- function(vaccine, sex) {
 
   req <- create_request("risk")
 
@@ -42,10 +40,6 @@ risk_vaccine <- function(vaccine, sex) {
                    "percent who received 3+ doses of HPV vaccine, ages 13-15"
                    )
 
-  vaccine_type2 = c("percent who received 2+ doses of HPV vaccine, ages 13-17",
-                   "percent who received 3+ doses of HPV vaccine, ages 13-17"
-  )
-
   if (vaccine %in% vaccine_type1) {
     resp %>% 
       setNames(c("State", "FIPS", "Met_Objective_of_80.0%?", "Percent", "Lower_95%_CI", "Upper_95%_CI", "Number_of_Respondents"))

R/risk-womens-health.R

@@ -3,7 +3,7 @@
 #' This function returns a data frame from Women's Health in State Cancer Profiles
 #'
 #' @param whealth Either "mammogram in past 2 years, ages 50-74", "mammogram in past 2 years, ages 40+", 
-#'                       "pap smear in past 3 years, no hysterectomy, ages 21-65", "pap smear in past 3 years, no hysterectomy, ages 18+"
+#'                       "pap smear in past 3 years, no hysterectomy, ages 21-65"
 #' @param race One of the following values: "all races (includes hispanic)", "white (non-hispanic)", 
 #'                                          "black (non-hispanic)", "amer. indian / ak native (non-hispanic)", 
 #'                                          "asian / pacific islander (non-hispanic)","hispanic (any race)"
@@ -65,7 +65,7 @@ risk_whealth <- function(whealth, race, datatype="direct estimates", area=NULL)
   resp <- process_screening(resp)
 
   if (datatype == "county level modeled estimates") {
-    if(whealth == "pap smear in past 3 years, no hysterectomy, ages 18+") {
+    if(whealth == "pap smear in past 3 years, no hysterectomy, ages 21-65") {
       resp %>% 
         setNames(c("State", "FIPS", "Percent", "Lower_95%_CI", "Upper_95%_CI", "Number_of_Respondents"))
     } else {