Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Vignette #49

Merged
merged 2 commits into from
Mar 4, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 5 additions & 0 deletions R/demo-crowding.R
Original file line number Diff line number Diff line change
Expand Up @@ -68,3 +68,8 @@ demo_crowding <- function(area, areatype, crowding, race) {
resp %>%
setNames(c(areatype_title, areacode_title, "Percent", "Households", "Rank"))
}

area = "wa"
areatype = "county"
race = "all races (includes hispanic)"
crowding = "household with >1 person per room"
8 changes: 6 additions & 2 deletions R/demo-workforce.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
#'
#' @param area A state/territory abbreviation or USA.
#' @param areatype Either "county", "hsa" (Health service area), or "state"
#' @param workforce "unemployed"
#' @param race One of the following values: "All Races (includes Hispanic)", "white (includes hispanic)" = "01",
#' "white non-hispanic","black","amer. indian/alaskan native (includes hispanic)",
#' "asian or pacific islander (includes hispanic)","hispanic (any race)
Expand All @@ -20,20 +21,23 @@
#' \dontrun{
#' demo_workforce(area = "WA",
#' areatype = "county",
#' workforce = "unemployed",
#' race = "all races (includes hispanic)",
#' sex = "both sexes")
#'
#' demo_workforce(area = "usa",
#' areatype = "state",
#' workforce = "unemployed",
#' race = "all races (includes hispanic)",
#' sex = "females")
#'
#' demo_workforce(area = "pr",
#' areatype = "hsa",
#' workforce = "unemployed",
#' race = "all races (includes hispanic)",
#' sex = "both sexes")
#' }
demo_workforce <- function(area, areatype, race, sex) {
demo_workforce <- function(area, areatype, workforce, race, sex) {

req <- create_request("demographics")

Expand All @@ -42,7 +46,7 @@ demo_workforce <- function(area, areatype, race, sex) {
stateFIPS=fips_scp(area),
areatype=tolower(areatype),
topic="crowd",
demo="00012",
demo=handle_workforce(workforce),
race=handle_race(race),
sex=handle_sex(sex),
type="manyareacensus",
Expand Down
31 changes: 31 additions & 0 deletions R/handle-workforce.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,31 @@
#' Handles workforce Values to Code
#'
#' This function returns a matching code value for workforce for the api to use to get data from State Cancer Profiles
#'
#' @param workforce "unemployed"
#'
#' @importFrom rlang is_na
#'
#' @returns A string for its respective workforce Value
#'
#' @noRd
#'
#' @examples
#' \dontrun{
#' handle_workforce("unemployed")
#' }
handle_workforce <- function(workforce) {
workforce <- tolower(workforce)

workforce_mapping <- c(
"unemployed" = "00012"
)

workforce_code <- workforce_mapping[workforce]

if (is_na(workforce_code)) {
stop("Invalid workforce input, please check the documentation for valid inputs")
}

return(as.character(workforce_code))
}
7 changes: 6 additions & 1 deletion man/demo_workforce.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

9 changes: 6 additions & 3 deletions tests/testthat/test-demo-workforce.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,20 +4,23 @@
#'
#tests class and typeof output
test_that("Output data type is correct", {
output <- demo_workforce("wa", "county", "all races (includes hispanic)", "both sexes")
output <- demo_workforce("wa", "county", "unemployed",
"all races (includes hispanic)", "both sexes")

expect_true(inherits(output, "data.frame"))
})

#Ensures that variables are present and working on SCP
test_that("demo-workforce returns non-empty data frame", {
workforce1 <- demo_workforce("wa", "county", "all races (includes hispanic)", "both sexes")
workforce1 <- demo_workforce("wa", "county", "unemployed",
"all races (includes hispanic)", "both sexes")
expect_true(is.data.frame(workforce1))
})

#demo-workforce must have 5 columns
test_that("demo-workforce has correct number of columns", {
df <- demo_workforce("wa", "county", "all races (includes hispanic)", "both sexes")
df <- demo_workforce("wa", "county", "unemployed",
"all races (includes hispanic)", "both sexes")
expected_columns <- 5
expect_equal(ncol(df), expected_columns)
})
Expand Down
13 changes: 13 additions & 0 deletions tests/testthat/test-handle-workforce.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
#' Test Handle workforce
#'
#' This testthat file tests the handle-workforce function
test_that("handle workforce correctly maps workforce", {
result <- sapply(c("unemployed"), handle_workforce)
expected <- c(`unemployed` = "00012")

expect_equal(result, expected)
})

test_that("handle workforce expects errors for incorrect arguments", {
expect_error(handle_workforce("carrot"))
})
82 changes: 79 additions & 3 deletions vignettes/demographics-vignette.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -31,11 +31,11 @@ Each of these functions require various parameters that must be specified to pul
Demo crowding **Always** requires 4 arguments: area, areatype, crowding, and race

```{r crowding}
results <- demo_crowding(area = "WA",
crowding <- demo_crowding(area = "WA",
areatype = "county",
crowding = "household with >1 person per room",
race = "All Races (includes Hispanic)")
head(results, n=3)
head(crowding, n=3)
```

### Demo Education
Expand Down Expand Up @@ -201,4 +201,80 @@ population3 <- demo_population(area = "usa",
race = "all races (includes hispanic)",
sex = "both sexes")

head(population3, n=3)
head(population3, n=3)
```

### Demo Poverty
Demo poverty has 5 arguments: area, areatype, poverty, race, sex. The function defaults to "all ages"

The "persistent poverty" and "persons <150% of poverty" poverty argument will default to "all races", "both sexes", "all ages".

The "families below poverty" poverty argument will require a race argument and default to "both sexes" and "all ages".

The "persons below poverty" poverty argument will require a race argument and a sex argument, and default to "all ages".

```{r poverty}
#Persistent poverty
poverty1 <- demo_poverty(area = "WA",
areatype = "county",
poverty = "persistent poverty")

head(poverty1, n=3)

#Families below poverty
poverty2 <- demo_poverty(area = "usa",
areatype = "state",
poverty = "families below poverty",
race = "black")

head(poverty2, n=3)

#Persons below poverty
poverty3 <- demo_poverty(area = "usa",
areatype = "state",
poverty = "persons below poverty",
race = "black",
sex = "males")

head(poverty3, n=3)
```

### Demo Social Vulnerability Index (SVI)
Demo svi **Always** requires 2 arguments: area, svi. The function defaults to "all races", "both sexes", "all ages."

*Please note that the areatype argument is not available for this function because areatype is limited to "county"*

```{r svi}
svi1 <- demo_svi(area = "WA",
svi = "overall")

head(svi1, n=3)


svi2 <- demo_svi(area = "usa",
svi = "socioeconomic status")

head(svi2, n=3)
```

### Workforce
Demo svi **Always** requires 5 arguments: area, areatype, workforce, race, sex. The function defaults to "ages 16+"

```{r workforce}
workforce1 <- demo_workforce(area = "WA",
areatype = "county",
workforce = "unemployed",
race = "all races (includes hispanic)",
sex = "both sexes")

head(workforce1, n=3)


workforce2 <- demo_workforce(area = "usa",
areatype = "state",
workforce = "unemployed",
race = "all races (includes hispanic)",
sex = "females")

head(workforce2, n=3)
```
55 changes: 54 additions & 1 deletion vignettes/risks-vignette.Rmd
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
---
title: "risks-vignette"
title: "Screening and Risk Factors"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{risks-vignette}
Expand All @@ -14,6 +14,59 @@ knitr::opts_chunk$set(
)
```

```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
```

## Load the package
```{r setup}
library(cancerprof)
```

## Retrieving Data

The Screening and Risk Factors category of cancerprof contains 6 unique functions to pull data from the demographics page of [State Cancer Profile](https://statecancerprofiles.cancer.gov/demographics/index.php).

These functions are: `risk_alcohol()`, `risk_colorectal_screening()`, `risk_diet_exercise()`, `risk_smoking()`, `risk_vaccines()`, `risk_womens_health()`

Each of these functions require various parameters that must be specified to pull data. Please refer to function documentation for more details.

### Risk Alcohol
Risk Alcohol requires 3 arguments: alcohol, race, sex

```{r alcohol}
alcohol1 <- risk_alcohol(alcohol = paste("binge drinking (4+ drinks on one occasion for women,",
"5+ drinks for one occasion for men), ages 21+"),
race = "all races (includes hispanic)",
sex = "both sexes")
head(alcohol1, n=3)
```

### Risk Colorectal Screening
Risk Colorectal Screening has 4 arguments: screening, race, sex, area

"home blood stool test in the past year, ages 45-75" and "received at least one recommended crc test, ages 45-75" for the screening arguments requires a race argument and a sex argument and defaults to "direct estimates", "US by state".

"ever had fobt, ages 50-75", "guidance sufficient crc, ages 50-75", "had colonoscopy in past 10 years, ages 50-75" for the screening arguments defaults to "all races", "both sexes", and "county level modeled estimates"

```{r colorectal screening}
screening1 <- risk_colorectal_screening(screening = "home blood stool test in the past year, ages 45-75",
race = "all races (includes hispanic)",
sex = "both sexes")
head(screening1, n=3)

screening2 <- risk_colorectal_screening(screening = "ever had fobt, ages 50-75",
area="usa")
head(screening2, n=3)
```