From 2a41c50fcec998d1fa87e609af43af5dbb673321 Mon Sep 17 00:00:00 2001 From: realbp Date: Wed, 14 Feb 2024 09:39:47 -0800 Subject: [PATCH 1/2] completed more risk tests --- NAMESPACE | 2 +- R/handle-vaccine.R | 2 +- R/risk-vaccines.R | 16 ++--- R/risk-womens-health.R | 4 +- man/risk_vaccine.Rd | 28 --------- man/risk_vaccines.Rd | 26 ++++++++ man/risk_whealth.Rd | 2 +- tests/testthat/test-risk-vaccines.R | 37 +++++++++++- tests/testthat/test-risk-womens-health.R | 76 ++++++++++++------------ 9 files changed, 109 insertions(+), 84 deletions(-) delete mode 100644 man/risk_vaccine.Rd create mode 100644 man/risk_vaccines.Rd diff --git a/NAMESPACE b/NAMESPACE index b6a7aa0..964b4ae 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -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) diff --git a/R/handle-vaccine.R b/R/handle-vaccine.R index 79fc08a..46c4b24 100644 --- a/R/handle-vaccine.R +++ b/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] diff --git a/R/risk-vaccines.R b/R/risk-vaccines.R index 640cd89..cc71b51 100644 --- a/R/risk-vaccines.R +++ b/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")) diff --git a/R/risk-womens-health.R b/R/risk-womens-health.R index 7f1a4ca..ceede7b 100644 --- a/R/risk-womens-health.R +++ b/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 { diff --git a/man/risk_vaccine.Rd b/man/risk_vaccine.Rd deleted file mode 100644 index 13c8f68..0000000 --- a/man/risk_vaccine.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/risk-vaccines.R -\name{risk_vaccine} -\alias{risk_vaccine} -\title{Access to Vaccines Data} -\usage{ -risk_vaccine(vaccine, sex) -} -\arguments{ -\item{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+"} - -\item{sex}{Either "both sexes", "males", "females"} -} -\value{ -A data frame with the following columns "State", "FIPS", "Percent", "Lower 95\% CI", "Upper 95\% CI", "Number of Respondents" -} -\description{ -This function returns a data frame from Vaccines in State Cancer Profiles -} -\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") -} -} diff --git a/man/risk_vaccines.Rd b/man/risk_vaccines.Rd new file mode 100644 index 0000000..762d628 --- /dev/null +++ b/man/risk_vaccines.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/risk-vaccines.R +\name{risk_vaccines} +\alias{risk_vaccines} +\title{Access to Vaccines Data} +\usage{ +risk_vaccines(vaccine, sex) +} +\arguments{ +\item{vaccine}{Either "percent with up to date hpv vaccination coverage, ages 13-15", +"percent with up to date hpv vaccination coverage, ages 13-17"} + +\item{sex}{Either "both sexes", "males", "females"} +} +\value{ +A data frame with the following columns "State", "FIPS", "Percent", "Lower 95\% CI", "Upper 95\% CI", "Number of Respondents" +} +\description{ +This function returns a data frame from Vaccines in State Cancer Profiles +} +\examples{ +\dontrun{ +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") +} +} diff --git a/man/risk_whealth.Rd b/man/risk_whealth.Rd index 3f4f110..356ce75 100644 --- a/man/risk_whealth.Rd +++ b/man/risk_whealth.Rd @@ -8,7 +8,7 @@ risk_whealth(whealth, race, datatype = "direct estimates", area = NULL) } \arguments{ \item{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"} \item{race}{One of the following values: "all races (includes hispanic)", "white (non-hispanic)", "black (non-hispanic)", "amer. indian / ak native (non-hispanic)", diff --git a/tests/testthat/test-risk-vaccines.R b/tests/testthat/test-risk-vaccines.R index 8849056..1c8d4bd 100644 --- a/tests/testthat/test-risk-vaccines.R +++ b/tests/testthat/test-risk-vaccines.R @@ -1,3 +1,36 @@ -test_that("multiplication works", { - expect_equal(2 * 2, 4) +#' Test risk-vaccines +#' +#' This testthat file test the risk-vaccines function +#' +# tests class and typeof output +test_that("Output data type is correct", { + output <- risk_vaccines("percent with up to date hpv vaccination coverage, ages 13-15", + "both sexes") + + expect_true(inherits(output, "data.frame")) }) + +#Ensures that variables are present and working on SCP +vaccine_options <- c("percent with up to date hpv vaccination coverage, ages 13-15", + "percent with up to date hpv vaccination coverage, ages 13-17") + +for (option in vaccine_options) { + test_that("risk_womens_health returns non-empty data frame", { + result <- risk_vaccines(option, "both sexes") + expect_true(is.data.frame(result)) + }) +} + +#risk-vaccines must have 5 columns +test_that("risk-vaccines has correct number of columns", { + df <- risk_vaccines("percent with up to date hpv vaccination coverage, ages 13-15", + "both sexes") + expected_columns <- 6 + expect_equal(ncol(df), expected_columns) + +}) + +#parameter +test_that("risk-vaccines has correct parameters", { + expect_error(risk_vaccines()) +}) \ No newline at end of file diff --git a/tests/testthat/test-risk-womens-health.R b/tests/testthat/test-risk-womens-health.R index ed0cfaa..d158f1b 100644 --- a/tests/testthat/test-risk-womens-health.R +++ b/tests/testthat/test-risk-womens-health.R @@ -2,41 +2,41 @@ #' #' This testthat file test the risk-womens health function #' -#tests class and typeof output -# test_that("Output data type is correct", { -# output <- risk_womens_health("bmi is healthy, ages 20+", -# "all races (includes hispanic)", "both sexes") -# -# expect_true(inherits(output, "data.frame")) -# }) -# -# #Ensures that variables are present and working on SCP -# womens_health_options <- c("bmi is healthy, ages 20+", "bmi is obese, ages 20+", -# "bmi is obese, high school survey", "bmi is overweight, high school survey", -# "consumed 1 or more fruits per day", "consumed 1 or more vegetables per day", -# "no leisure time physical activity") -# -# for (option in womens_health_options) { -# test_that("risk_womens_health returns non-empty data frame", { -# result <- risk_womens_health(option, "all races (includes hispanic)", "both sexes") -# expect_true(is.data.frame(result)) -# }) -# } -# -# #risk-womens health must have 5 columns -# test_that("risk-womens health has correct number of columns", { -# df1 <- risk_womens_health("bmi is healthy, ages 20+", -# "all races (includes hispanic)", "both sexes") -# df2 <- risk_womens_health("bmi is obese, high school survey", -# "all races (includes hispanic)", "males") -# expected_columns1 <- 6 -# expected_columns2 <- 5 -# expect_equal(ncol(df1), expected_columns1) -# expect_equal(ncol(df2), expected_columns2) -# -# }) -# -# #parameter -# test_that("risk-womens health has correct parameters", { -# expect_error(risk_womens_health()) -# }) \ No newline at end of file +# tests class and typeof output +test_that("Output data type is correct", { + output <- risk_whealth("mammogram in past 2 years, ages 50-74", + "all races (includes hispanic)", "direct estimates") + + expect_true(inherits(output, "data.frame")) +}) + +#Ensures that variables are present and working on SCP +womens_health_options <- c("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") + +for (option in womens_health_options) { + test_that("risk_womens_health returns non-empty data frame", { + result <- risk_whealth(option, "all races (includes hispanic)", "direct estimates") + expect_true(is.data.frame(result)) + }) +} + +#risk-womens health must have 5 columns +test_that("risk-womens health has correct number of columns", { + df1 <- risk_whealth("mammogram in past 2 years, ages 50-74", + "all races (includes hispanic)", "direct estimates") + df2 <- risk_whealth("mammogram in past 2 years, ages 50-74", + "all races (includes hispanic)", "county level modeled estimates", "wa") + + expected_columns1 <- 6 + expected_columns2 <- 5 + expect_equal(ncol(df1), expected_columns1) + expect_equal(ncol(df2), expected_columns2) + +}) + +#parameter +test_that("risk-womens health has correct parameters", { + expect_error(risk_whealth()) +}) \ No newline at end of file From e53b9ffc9fcdfba1f44f1522495f860bf08b6037 Mon Sep 17 00:00:00 2001 From: realbp Date: Wed, 14 Feb 2024 10:57:42 -0800 Subject: [PATCH 2/2] completed risk smoking test --- R/risk-smoking.R | 5 +- tests/testthat/test-risk-smoking.R | 137 ++++++++++++++++++++++++++++- 2 files changed, 138 insertions(+), 4 deletions(-) diff --git a/R/risk-smoking.R b/R/risk-smoking.R index b078540..a727a42 100644 --- a/R/risk-smoking.R +++ b/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 %>% diff --git a/tests/testthat/test-risk-smoking.R b/tests/testthat/test-risk-smoking.R index 8849056..ceca39e 100644 --- a/tests/testthat/test-risk-smoking.R +++ b/tests/testthat/test-risk-smoking.R @@ -1,3 +1,136 @@ -test_that("multiplication works", { - expect_equal(2 * 2, 4) +#' Test risk-smoking +#' +#' This testthat file test the risk-smoking function +#' +#tests class and typeof output +test_that("Output data type is correct", { + output <- risk_smoking("smoking laws (any)") + + expect_true(inherits(output, "data.frame")) }) + +#Ensures that variables are present and working on SCP + +#group1 +smoking_group1_options <- c("smoking laws (any)", + "smoking laws (bars)", + "smoking laws (restaurants)", + "smoking laws (workplace)", + "smoking laws (workplace; restaurant; & bar)") + +for (option in smoking_group1_options) { + test_that("smoking group1 returns non-empty data frame", { + result <- risk_smoking(option) + expect_true(is.data.frame(result)) + }) +} + +#group2 +smoking_group2_options <- c("smokers (stopped for 1 day or longer)", + "smoking not allowed at work (all people)", + "smoking not allowed in home (all people)") + +for (option in smoking_group2_options) { + test_that("smoking group2 returns non-empty data frame", { + result <- risk_smoking(option, sex="both sexes", datatype="direct estimates") + expect_true(is.data.frame(result)) + }) +} + +#group3 +smoking_group3_options <- c("smoking not allowed at work (current smokers)", + "smoking not allowed at work (former/never smokers)", + "smoking not allowed in home (current smokers)", + "smoking not allowed in home (former/never smokers)") + +for (option in smoking_group3_options) { + test_that("smoking group3 returns non-empty data frame", { + result <- risk_smoking(option, sex="both sexes", datatype="direct estimates") + expect_true(is.data.frame(result)) + }) +} + +#group4 +smoking_group4_options <- c("former smoker; ages 18+", + "former smoker, quit 1 year+; ages 18+") + +for (option in smoking_group4_options) { + test_that("smoking group4 returns non-empty data frame", { + result <- risk_smoking(option, sex="both sexes", + datatype="county level modeled estimates", area="ca") + expect_true(is.data.frame(result)) + }) +} + +#group5 +smoking_group5_options <- c("smokers (ever); ages 18+", + "e-cigarette use; ages 18+") + +for (option in smoking_group5_options) { + test_that("smoking group5 returns non-empty data frame", { + result <- risk_smoking(option, race="hispanic (any race)", + sex="both sexes", datatype="direct estimates") + expect_true(is.data.frame(result)) + }) +} + +#group6 +test_that("smoking group6 returns non-empty data frame", { + result <- risk_smoking("smokers (current); ages 18+", race="hispanic (any race)", + sex="both sexes", datatype="direct estimates") + expect_true(is.data.frame(result)) +}) + + +#risk-smoking must have 5 columns +test_that("risk-smoking has correct number of columns", { + df1 <- risk_smoking("smoking laws (any)") + df2 <- risk_smoking("smokers (stopped for 1 day or longer)", sex="both sexes", + datatype="county level modeled estimates", area="wa") + df3 <- risk_smoking("smoking not allowed at work (current smokers)", sex="both sexes", + datatype="direct estimates") + expected_columns1 <- 3 + expected_columns2 <- 5 + expected_columns3 <- 6 + expect_equal(ncol(df1), expected_columns1) + expect_equal(ncol(df2), expected_columns2) + expect_equal(ncol(df3), expected_columns3) +}) + +#test error handling +test_that("risk-smoking handles invalid smoking parameters", { + expect_error( + risk_smoking("smoking laws (any)", sex="both sexes"), + "For this smoking type, Race, Sex, Datatype, and Area must ALL be NULL" + ) + expect_error( + risk_smoking("smokers (stopped for 1 day or longer)", sex="both sexes", + datatype="county level modeled estimates"), + "For county level modeled estimates on this smoking type, area must NOT be null" + ) + expect_error( + risk_smoking("smoking not allowed at work (current smokers)", + race="all races (includes hispanic)", sex="both sexes", + datatype="direct estimates"), + "For all sexes in this smoking type, race and area should be NULL" + ) + expect_error( + risk_smoking("former smoker; ages 18+", sex="both sexes", + datatype="county level modeled estimates"), + "For this smoking type, Sex, Datatype, and Area must not be NULL AND Race must be NULL" + ) + expect_error( + risk_smoking("smokers (ever); ages 18+", race="hispanic (any race)", sex="both sexes"), + "For this smoking type, Race, Sex, and Datatype must not be NULL AND Datatype and Area must be NULL" + ) + expect_error( + risk_smoking("smokers (current); ages 18+", race="all races (includes hispanic)", + sex="both sexes", area="wa"), + "For all races for this smoking type, Datatype must not be NULL" + ) +}) + +#parameter +test_that("risk-smoking has correct parameters", { + expect_error(risk_smoking()) +}) \ No newline at end of file