From 461dc297754343ce0f4dd202294b2c63256313a8 Mon Sep 17 00:00:00 2001 From: realbp Date: Mon, 11 Mar 2024 13:23:41 -0700 Subject: [PATCH 1/2] fixed order of parameters --- R/cancerprof-package.R | 6 ++++++ R/demo-crowding.R | 9 +++------ R/demo-insurance.R | 3 +-- R/demo-workforce.R | 2 +- man/cancerprof-package.Rd | 15 +++++++++++++++ man/demo_crowding.Rd | 8 +------- 6 files changed, 27 insertions(+), 16 deletions(-) create mode 100644 R/cancerprof-package.R create mode 100644 man/cancerprof-package.Rd diff --git a/R/cancerprof-package.R b/R/cancerprof-package.R new file mode 100644 index 0000000..a65cf64 --- /dev/null +++ b/R/cancerprof-package.R @@ -0,0 +1,6 @@ +#' @keywords internal +"_PACKAGE" + +## usethis namespace: start +## usethis namespace: end +NULL diff --git a/R/demo-crowding.R b/R/demo-crowding.R index 165f274..bff77a1 100644 --- a/R/demo-crowding.R +++ b/R/demo-crowding.R @@ -52,17 +52,14 @@ #' race = "black" #' ) #' } -#' -demo_crowding <- function(area, areatype, - crowding = "household with >1 person per room", - race) { - areatype <- tolower(areatype) +demo_crowding <- function(area, areatype, crowding, race) { + req <- create_request("demographics") resp <- req %>% req_url_query( stateFIPS = fips_scp(area), - areatype = areatype, + areatype = tolower(areatype), topic = "crowd", demo = handle_crowding(crowding), race = handle_race(race), diff --git a/R/demo-insurance.R b/R/demo-insurance.R index f1d43a7..27f271c 100644 --- a/R/demo-insurance.R +++ b/R/demo-insurance.R @@ -89,10 +89,9 @@ demo_insurance <- function(area, areatype, insurance, sex, age, race = NULL) { "asian non-hispanic", "hispanic (any race)" ) - req <- create_request("demographics") - if ((sex == "males" || sex == "females") & (age == "under 19 years" || age == "21 to 64 years")) { + if ((sex == "males" || sex == "females") && (age == "under 19 years" || age == "21 to 64 years")) { cli_abort("For males and females, age CANNOT be under 19 years OR 21 to 64 years") } else if (areatype == "state" && is.null(race)) { cli_abort("For areatype State, Race must not be null") diff --git a/R/demo-workforce.R b/R/demo-workforce.R index 0a276e8..91e270a 100644 --- a/R/demo-workforce.R +++ b/R/demo-workforce.R @@ -63,7 +63,7 @@ demo_workforce <- function(area, areatype, workforce, race, sex) { req_url_query( stateFIPS = fips_scp(area), areatype = tolower(areatype), - topic = "crowd", + topic = "work", demo = handle_workforce(workforce), race = handle_race(race), sex = handle_sex(sex), diff --git a/man/cancerprof-package.Rd b/man/cancerprof-package.Rd new file mode 100644 index 0000000..12d3505 --- /dev/null +++ b/man/cancerprof-package.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cancerprof-package.R +\docType{package} +\name{cancerprof-package} +\alias{cancerprof} +\alias{cancerprof-package} +\title{cancerprof: Open Cancer Informatics} +\description{ +What the package does (one paragraph). +} +\author{ +\strong{Maintainer}: Brian Park \email{joon.brianpark@gmail.com} (\href{https://orcid.org/YOUR-ORCID-ID}{ORCID}) + +} +\keyword{internal} diff --git a/man/demo_crowding.Rd b/man/demo_crowding.Rd index 60d92e5..8dd6577 100644 --- a/man/demo_crowding.Rd +++ b/man/demo_crowding.Rd @@ -4,12 +4,7 @@ \alias{demo_crowding} \title{Access to Crowding Data} \usage{ -demo_crowding( - area, - areatype, - crowding = "household with >1 person per room", - race -) +demo_crowding(area, areatype, crowding, race) } \arguments{ \item{area}{A state/territory abbreviation or USA.} @@ -66,5 +61,4 @@ demo_crowding( race = "black" ) } - } From 70266f6c05864f1c75b06e29d0811f2c74d416c5 Mon Sep 17 00:00:00 2001 From: realbp Date: Mon, 11 Mar 2024 16:00:56 -0700 Subject: [PATCH 2/2] merged process functions --- NAMESPACE | 3 -- R/demo-crowding.R | 9 ++-- R/demo-education.R | 2 +- R/demo-food-access.R | 2 +- R/demo-income.R | 2 +- R/demo-insurance.R | 2 +- R/demo-mobility.R | 2 +- R/demo-non-english-language.R | 2 +- R/demo-population.R | 2 +- R/demo-poverty.R | 2 +- R/demo-svi.R | 2 +- R/demo-workforce.R | 2 +- R/incidence-cancer.R | 2 +- R/mortality-cancer.R | 2 +- R/process-incidence.R | 69 ------------------------ R/process-mortality.R | 69 ------------------------ R/process-screening.R | 51 ------------------ R/{process-response.R => process_resp.R} | 43 ++++++++++----- R/risk-alcohol.R | 2 +- R/risk-colorectal-screening.R | 2 +- R/risk-diet-exercise.R | 2 +- R/risk-smoking.R | 2 +- R/risk-vaccines.R | 2 +- R/risk-womens-health.R | 30 ++++------- 24 files changed, 62 insertions(+), 246 deletions(-) delete mode 100644 R/process-incidence.R delete mode 100644 R/process-mortality.R delete mode 100644 R/process-screening.R rename R/{process-response.R => process_resp.R} (58%) diff --git a/NAMESPACE b/NAMESPACE index a13ac55..9f79ed3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,17 +27,14 @@ importFrom(dplyr,filter) importFrom(dplyr,mutate) importFrom(dplyr,mutate_all) importFrom(dplyr,na_if) -importFrom(dplyr,rename) importFrom(httr2,req_perform) importFrom(httr2,req_url_query) importFrom(httr2,request) importFrom(httr2,resp_body_string) importFrom(magrittr,"%>%") -importFrom(rlang,":=") 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) diff --git a/R/demo-crowding.R b/R/demo-crowding.R index bff77a1..addd6e1 100644 --- a/R/demo-crowding.R +++ b/R/demo-crowding.R @@ -70,7 +70,7 @@ demo_crowding <- function(area, areatype, crowding, race) { ) %>% req_perform() - resp <- process_response(resp) + resp <- process_resp(resp, "demographics") areatype_map <- c( "county" = "County", "hsa" = "Health_Service_Area", @@ -83,8 +83,11 @@ demo_crowding <- function(area, areatype, crowding, race) { resp %>% setNames(c( - areatype_title, areacode_title, "Percent", - "Households", "Rank" + areatype_title, + areacode_title, + "Percent", + "Households", + "Rank" )) %>% mutate(across(c("Percent", "Households"), \(x) as.numeric(x))) } diff --git a/R/demo-education.R b/R/demo-education.R index f66d58f..9cd9705 100644 --- a/R/demo-education.R +++ b/R/demo-education.R @@ -93,7 +93,7 @@ demo_education <- function(area, areatype, education, sex = NULL, race = NULL) { resp <- resp %>% req_perform() - resp <- process_response(resp) + resp <- process_resp(resp, "demographics") areatype_map <- c( "county" = "County", diff --git a/R/demo-food-access.R b/R/demo-food-access.R index 4edf4e9..c79d62e 100644 --- a/R/demo-food-access.R +++ b/R/demo-food-access.R @@ -75,7 +75,7 @@ demo_food <- function(area, areatype, food, race = NULL) { resp <- req_draft %>% req_perform() - resp <- process_response(resp) %>% + resp <- process_resp(resp, "demographics") %>% mutate(Value..Percent. = as.integer(Value..Percent.)) areatype_map <- c("county" = "County", "state" = "State") diff --git a/R/demo-income.R b/R/demo-income.R index 17e1611..9a71b0c 100644 --- a/R/demo-income.R +++ b/R/demo-income.R @@ -65,7 +65,7 @@ demo_income <- function(area, areatype, income, race) { ) %>% req_perform() - resp <- process_response(resp) %>% + resp <- process_resp(resp, "demographics") %>% mutate(Value..Dollars. = as.integer(Value..Dollars.)) areatype_map <- c("county" = "County", "state" = "State") diff --git a/R/demo-insurance.R b/R/demo-insurance.R index 27f271c..e530300 100644 --- a/R/demo-insurance.R +++ b/R/demo-insurance.R @@ -126,7 +126,7 @@ demo_insurance <- function(area, areatype, insurance, sex, age, race = NULL) { resp <- resp %>% req_perform() - resp <- process_response(resp) + resp <- process_resp(resp, "demographics") areatype_map <- c( "county" = "County", diff --git a/R/demo-mobility.R b/R/demo-mobility.R index 5d0eb9b..58b0255 100644 --- a/R/demo-mobility.R +++ b/R/demo-mobility.R @@ -60,7 +60,7 @@ demo_mobility <- function(area, areatype, mobility) { ) %>% req_perform() - resp <- process_response(resp) + resp <- process_resp(resp, "demographics") areatype_map <- c( "county" = "County", diff --git a/R/demo-non-english-language.R b/R/demo-non-english-language.R index 713b75c..6e24e12 100644 --- a/R/demo-non-english-language.R +++ b/R/demo-non-english-language.R @@ -54,7 +54,7 @@ demo_language <- function(area, areatype, language) { req_perform() - resp <- process_response(resp) + resp <- process_resp(resp, "demographics") areatype_map <- c( "county" = "County", diff --git a/R/demo-population.R b/R/demo-population.R index 64e3c8a..8f3a457 100644 --- a/R/demo-population.R +++ b/R/demo-population.R @@ -115,7 +115,7 @@ demo_population <- function(area, areatype, population, race = NULL, sex = NULL) resp <- resp %>% req_perform() - resp <- process_response(resp) + resp <- process_resp(resp, "demographics") areatype_map <- c( "county" = "County", diff --git a/R/demo-poverty.R b/R/demo-poverty.R index bc47db3..ba37e67 100644 --- a/R/demo-poverty.R +++ b/R/demo-poverty.R @@ -95,7 +95,7 @@ demo_poverty <- function(area, areatype, poverty, race = NULL, sex = NULL) { resp <- resp %>% req_perform() - resp <- process_response(resp) + resp <- process_resp(resp, "demographics") areatype_map <- c( "county" = "County", diff --git a/R/demo-svi.R b/R/demo-svi.R index 4c422a8..184496e 100644 --- a/R/demo-svi.R +++ b/R/demo-svi.R @@ -52,7 +52,7 @@ demo_svi <- function(area, svi) { req_perform() - resp <- process_response(resp) + resp <- process_resp(resp, "demographics") resp %>% setNames(c("County", "FIPS", "Score")) diff --git a/R/demo-workforce.R b/R/demo-workforce.R index 91e270a..70fe13b 100644 --- a/R/demo-workforce.R +++ b/R/demo-workforce.R @@ -74,7 +74,7 @@ demo_workforce <- function(area, areatype, workforce, race, sex) { ) %>% req_perform() - resp <- process_response(resp) + resp <- process_resp(resp, "demographics") areatype_map <- c( "county" = "County", diff --git a/R/incidence-cancer.R b/R/incidence-cancer.R index cdc9de8..ab477cc 100644 --- a/R/incidence-cancer.R +++ b/R/incidence-cancer.R @@ -168,7 +168,7 @@ incidence_cancer <- function(area, areatype, cancer, race, sex, age, stage, year resp <- resp %>% req_perform() - resp <- process_incidence(resp) + resp <- process_resp(resp, "incidence") areatype_map <- c( diff --git a/R/mortality-cancer.R b/R/mortality-cancer.R index 392de0b..84f5e58 100644 --- a/R/mortality-cancer.R +++ b/R/mortality-cancer.R @@ -147,7 +147,7 @@ mortality_cancer <- function(area, areatype, cancer, race, sex, age, year) { resp <- resp %>% req_perform() - resp <- process_mortality(resp) + resp <- process_resp(resp, "mortality") areatype_map <- c( "county" = "County", diff --git a/R/process-incidence.R b/R/process-incidence.R deleted file mode 100644 index 2c7a2b9..0000000 --- a/R/process-incidence.R +++ /dev/null @@ -1,69 +0,0 @@ -#' Process Cancer Incidence Response Data -#' -#' This function processes the Cancer Incidence response data -#' from State Cancer Profiles -#' -#' @param resp A response object -#' -#' @importFrom httr2 resp_body_string -#' @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 -#' -#' @noRd -#' -#' @examples -#' \dontrun{ -#' process_incidence(resp) -#' } -process_incidence <- function(resp) { - nenv <- new.env() - data("state", envir = nenv) - state_name <- nenv$state.name - - resp_lines <- resp %>% - resp_body_string() %>% - strsplit("\\n") %>% - unlist() - - index_first_line_break <- which(resp_lines == "")[4] - index_second_line_break <- which(resp_lines == "")[5] - - resp <- resp_lines[ - (index_first_line_break + 1): - (index_second_line_break - 1) - ] %>% - paste(collapse = "\n") %>% - ( - \(x) { - read.csv(textConnection(x), - header = TRUE, - colClasses = "character" - ) - } - )() - - column <- c( - "County", - "Health.Service.Area", - "State" - )[c( - "County", - "Health.Service.Area", - "State" - ) %in% colnames(resp)] - - resp <- resp %>% - filter(!!sym(column) != "US (SEER+NPCR)(1)") %>% - mutate(!!sym(column) := str_replace_all(!!sym(column), "\\(\\d+\\)", "")) - - - if (column %in% c("Health.Service.Area", "County")) { - resp <- resp %>% - filter(!(!!sym(column) %in% state_name)) - } - resp -} diff --git a/R/process-mortality.R b/R/process-mortality.R deleted file mode 100644 index d55140a..0000000 --- a/R/process-mortality.R +++ /dev/null @@ -1,69 +0,0 @@ -#' Process Cancer Mortality Response Data -#' -#' This function processes the Cancer Mortality response data -#' from State Cancer Profiles -#' -#' @param resp A response object -#' -#' @importFrom httr2 resp_body_string -#' @importFrom dplyr mutate_all na_if filter -#' @importFrom rlang sym -#' @importFrom utils read.csv data -#' -#' @returns A processed response data frame -#' -#' @noRd -#' -#' @examples -#' \dontrun{ -#' process_mortality(resp) -#' } -process_mortality <- function(resp) { - nenv <- new.env() - data("state", envir = nenv) - state_name <- nenv$state.name - - resp_lines <- resp %>% - resp_body_string() %>% - strsplit("\\n") %>% - unlist() - - index_first_line_break <- which(resp_lines == "")[4] - index_second_line_break <- which(resp_lines == "")[5] - - resp <- resp_lines[ - (index_first_line_break + 1): - (index_second_line_break - 1) - ] %>% - paste(collapse = "\n") %>% - ( - \(x) { - read.csv(textConnection(x), - header = TRUE, - colClasses = "character" - ) - } - )() - - column <- c( - "County", - "Health.Service.Area", - "State" - )[c( - "County", - "Health.Service.Area", - "State" - ) %in% colnames(resp)] - - resp <- resp %>% - filter(!!sym(column) != "United States") - - if (column %in% c("Health.Service.Area", "County")) { - resp <- resp %>% - filter(!(!!sym(column) %in% state_name)) - } - - resp %>% - mutate_all(\(x) na_if(x, "N/A")) %>% - mutate_all(\(x) na_if(x, "data not available")) -} diff --git a/R/process-screening.R b/R/process-screening.R deleted file mode 100644 index 3d5911b..0000000 --- a/R/process-screening.R +++ /dev/null @@ -1,51 +0,0 @@ -#' Process Response Data -#' -#' This function processes the response data from State Cancer Profiles -#' -#' @param resp A response object -#' -#' @importFrom httr2 resp_body_string -#' @importFrom dplyr mutate_all na_if filter -#' @importFrom rlang sym -#' @importFrom utils read.csv data -#' -#' @returns A processed response data frame -#' -#' @noRd -#' -#' @examples -#' \dontrun{ -#' process_screening(resp) -#' } -process_screening <- function(resp) { - resp_lines <- resp %>% - resp_body_string() %>% - strsplit("\\n") %>% - unlist() - - index_first_line_break <- which(resp_lines == "")[3] - index_second_line_break <- which(resp_lines == "")[4] - - resp <- resp_lines[ - (index_first_line_break + 1): - (index_second_line_break - 1) - ] %>% - paste(collapse = "\n") %>% - ( - \(x) { - read.csv(textConnection(x), - header = TRUE, - colClasses = "character" - ) - } - )() - - column <- c("County", "State")[c("County", "State") %in% colnames(resp)] - - resp <- resp %>% - filter(!!sym(column) != "United States") - - resp %>% - mutate_all(\(x) na_if(x, "N/A")) %>% - mutate_all(\(x) na_if(x, "data not available")) -} diff --git a/R/process-response.R b/R/process_resp.R similarity index 58% rename from R/process-response.R rename to R/process_resp.R index e0d8a18..f18ff59 100644 --- a/R/process-response.R +++ b/R/process_resp.R @@ -3,7 +3,12 @@ #' This function processes the response data from State Cancer Profiles #' #' @param resp A response object -#' +#' @param topic One of the following values: +#' - "demographics" +#' - "risks" +#' - "incidence" +#' - "mortality" +#' #' @importFrom httr2 resp_body_string #' @importFrom dplyr mutate_all na_if filter #' @importFrom rlang sym @@ -15,21 +20,32 @@ #' #' @examples #' \dontrun{ -#' process_response(resp) +#' process_resp(resp, demographics) #' } -process_response <- function(resp) { +process_resp <- function(resp, topic) { + nenv <- new.env() data("state", envir = nenv) state_name <- nenv$state.name - + resp_lines <- resp %>% resp_body_string() %>% strsplit("\\n") %>% unlist() - - index_first_line_break <- which(resp_lines == "")[1] - index_second_line_break <- which(resp_lines == "")[2] - + + if (topic == "demographics") { + index_first_line_break <- which(resp_lines == "")[1] + index_second_line_break <- which(resp_lines == "")[2] + } else if (topic == "risks") { + index_first_line_break <- which(resp_lines == "")[3] + index_second_line_break <- which(resp_lines == "")[4] + } else if (topic == "incidence" || topic == "mortality") { + index_first_line_break <- which(resp_lines == "")[4] + index_second_line_break <- which(resp_lines == "")[5] + } else { + cli_abort("Incorrect topic argument, please ensure that correct.") + } + resp <- resp_lines[ (index_first_line_break + 1): (index_second_line_break - 1) @@ -38,12 +54,12 @@ process_response <- function(resp) { ( \(x) { read.csv(textConnection(x), - header = TRUE, - colClasses = "character" + header = TRUE, + colClasses = "character" ) } )() - + column <- c( "Health.Service.Area", "County", @@ -53,10 +69,10 @@ process_response <- function(resp) { "County", "State" ) %in% colnames(resp)] - + resp <- resp %>% filter(!!sym(column) != "United States") - + if (column %in% c("Health.Service.Area", "County")) { resp <- resp %>% filter(!(!!sym(column) %in% state_name)) @@ -64,4 +80,5 @@ process_response <- function(resp) { resp %>% mutate_all(\(x) na_if(x, "N/A")) %>% mutate_all(\(x) na_if(x, "data not available")) + } diff --git a/R/risk-alcohol.R b/R/risk-alcohol.R index ca07c08..cf755be 100644 --- a/R/risk-alcohol.R +++ b/R/risk-alcohol.R @@ -51,7 +51,7 @@ risk_alcohol <- function(alcohol, race, sex) { ) %>% req_perform() - resp <- process_screening(resp) + resp <- process_resp(resp, "risks") resp %>% setNames(c( diff --git a/R/risk-colorectal-screening.R b/R/risk-colorectal-screening.R index d455600..7300e14 100644 --- a/R/risk-colorectal-screening.R +++ b/R/risk-colorectal-screening.R @@ -93,7 +93,7 @@ risk_colorectal_screening <- function(screening, race = NULL, sex = NULL, area = resp <- resp %>% req_perform() - resp <- process_screening(resp) + resp <- process_resp(resp, "risks") if (screening %in% screening_type_1) { resp %>% diff --git a/R/risk-diet-exercise.R b/R/risk-diet-exercise.R index 05146f7..7faa056 100644 --- a/R/risk-diet-exercise.R +++ b/R/risk-diet-exercise.R @@ -58,7 +58,7 @@ risk_diet_exercise <- function(diet_exercise, race, sex) { ) %>% req_perform() - resp <- process_screening(resp) + resp <- process_resp(resp, "risks") diet_exercise_type1 <- c( "bmi is overweight, high school survey", diff --git a/R/risk-smoking.R b/R/risk-smoking.R index c62334f..7e16bb3 100644 --- a/R/risk-smoking.R +++ b/R/risk-smoking.R @@ -202,7 +202,7 @@ risk_smoking <- function(smoking, race = NULL, sex = NULL, datatype = NULL, area resp <- resp %>% req_perform() - resp <- process_screening(resp) + resp <- process_resp(resp, "risks") if (smoking %in% smoking_group1) { diff --git a/R/risk-vaccines.R b/R/risk-vaccines.R index e380d6c..79ecdfd 100644 --- a/R/risk-vaccines.R +++ b/R/risk-vaccines.R @@ -46,7 +46,7 @@ risk_vaccines <- function(vaccine, sex) { resp <- resp %>% req_perform() - resp <- process_screening(resp) + resp <- process_resp(resp, "risks") vaccine_type1 <- c( diff --git a/R/risk-womens-health.R b/R/risk-womens-health.R index 61c2293..850ae8d 100644 --- a/R/risk-womens-health.R +++ b/R/risk-womens-health.R @@ -88,29 +88,17 @@ risk_women_health <- function(women_health, race, datatype = "direct estimates", resp <- resp %>% req_perform() - resp <- process_screening(resp) + resp <- process_resp(resp, "risks") if (datatype == "county level modeled estimates") { - if (women_health == "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 { - resp %>% - setNames(c( - "County", - "FIPS", - "Percent", - "Lower_95%_CI", - "Upper_95%_CI" - )) - } + resp %>% + setNames(c( + "State", + "FIPS", + "Percent", + "Lower_95%_CI", + "Upper_95%_CI" + )) } else { resp %>% setNames(c(