Skip to content

Commit

Permalink
Merge pull request #49 from getwilds/vignette
Browse files Browse the repository at this point in the history
Vignette
  • Loading branch information
realbp authored Mar 4, 2024
2 parents c67783b + ab2e900 commit f403a3a
Show file tree
Hide file tree
Showing 8 changed files with 200 additions and 10 deletions.
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)
```








0 comments on commit f403a3a

Please sign in to comment.