Skip to content

Commit

Permalink
timeline example vignette (#52)
Browse files Browse the repository at this point in the history
  • Loading branch information
cole-brokamp committed Feb 28, 2024
1 parent 7279ef8 commit b21db43
Show file tree
Hide file tree
Showing 5 changed files with 78 additions and 2 deletions.
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -2,3 +2,4 @@
docs
/rf_pm.rds
/training_data.rds
inst/doc
3 changes: 3 additions & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,9 @@ Imports:
withr
RoxygenNote: 7.2.3
Suggests:
knitr,
rmarkdown,
testthat (>= 3.0.0)
Config/testthat/edition: 3
Config/testthat/parallel: true
VignetteBuilder: knitr
4 changes: 2 additions & 2 deletions R/hms_smoke.R
Original file line number Diff line number Diff line change
Expand Up @@ -25,14 +25,14 @@ get_hms_smoke_data <- function(x, dates, quiet = TRUE) {
date_smoke_geoms <- purrr::map(dates, \(.) d_smoke[as.character(.)])
withr::with_options(list(sf_use_s2 = FALSE), {
out <-
mappp::mappp(seq_along(x), \(i) {
purrr::map(seq_along(x), \(i) {
purrr::map(date_smoke_geoms[[i]], \(.) sf::st_join(sf::st_as_sf(s2::s2_cell_to_lnglat(x[[i]])), .)) |>
suppressMessages() |>
purrr::map("Density") |>
purrr::map(\(.) as.numeric(factor(., levels = c("Light", "Medium", "Heavy")))) |>
purrr::map_dbl(sum, na.rm = TRUE) |>
as.numeric()
}, parallel = TRUE)
}, .progress = ifelse(quiet, FALSE, "extracting smoke data"))
})
return(out)
}
Expand Down
2 changes: 2 additions & 0 deletions vignettes/.gitignore
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
*.html
*.R
70 changes: 70 additions & 0 deletions vignettes/timeline-example.Rmd
Original file line number Diff line number Diff line change
@@ -0,0 +1,70 @@
---
title: "timeline-example"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{timeline-example}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---

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

```{r setup}
library(appc)
library(dplyr, warn.conflicts = FALSE)
```

This example details how to use the appc package to add air pollution exposure estimates for exact locations and time periods defined by geocoded coordinates and a "key" date. For this example workflow, we will simulate 20 random locations in Wayne County, Michigan and dates of birth between 2019 and 2022, but in actuality this can be any set of geocoded `lat` and `lon` columns with corresponding dates.

```{r}
#| warnings: false
#| messages: false
d <-
tigris::counties("MI", year = 2021, progress_bar = FALSE) |>
suppressWarnings() |>
filter(GEOID == 26163) |>
sf::st_sample(20) |>
sf::st_coordinates() |>
tibble::as_tibble() |>
rename(lat = Y, lon = X) |>
mutate(dob = sample(seq(as.Date("2019-01-01"), as.Date("2022-12-31"), by = 1), size = 20))
d
```

For this example, we want to estimate the average fine particulate matter from 90 days prior to birth until 1 year after birth. We define these dates and create a list-col of dates for each location in our example data:

```{r}
d <- d |>
mutate(
start_date = dob - 90,
end_date = dob + 325.25
) |>
rowwise() |>
mutate(dates = list(seq(start_date, end_date, by = 1))) |>
ungroup()
```

Next, we will use the `lon` and `lat` columns to create the s2 geohash:

```{r}
d <- d |> dplyr::mutate(s2 = s2::as_s2_cell(s2::s2_geog_point(lon, lat)))
```

Directly use the `s2` and `dates` columns to call the `predict_pm25()` function:

```{r}
d <- d |> dplyr::mutate(pm25 = predict_pm25(s2, dates, quiet = TRUE))
```

With daily exposures, we could average fine particulate matter throughout the study period:

```{r}
d |>
mutate(mean_pm25 = purrr::map_dbl(pm25, \(.) mean(.$pm25)))
```

0 comments on commit b21db43

Please sign in to comment.