From 18286d008f7489154520c6821650f51dde7eb5f1 Mon Sep 17 00:00:00 2001 From: Will Curran-Groome Date: Mon, 20 Jul 2026 15:17:01 -0400 Subject: [PATCH 1/2] minor sheldus vignette revision --- vignettes/get_sheldus.Rmd | 20 -------------------- vignettes/get_sheldus.Rmd.orig | 4 ---- 2 files changed, 24 deletions(-) diff --git a/vignettes/get_sheldus.Rmd b/vignettes/get_sheldus.Rmd index fd284c5..fc44a19 100644 --- a/vignettes/get_sheldus.Rmd +++ b/vignettes/get_sheldus.Rmd @@ -42,26 +42,6 @@ sheldus <- get_sheldus() Each row represents a unique combination of county, year, month, and hazard type. Only county-month-hazard combinations with recorded events are included. - -``` r -glimpse(sheldus) -#> Rows: 1,000,189 -#> Columns: 13 -#> $ unique_id "199da95a-821f-4f2f-974a-85bb0c4e8a0f", "a9af66c4-1ea9-4c43-9a7e-85211bf280db", "b6e481a5-998b-46a3-a393-0064de9e87b4", "e40fd03d-cabf-4e41-9… -#> $ GEOID "01001", "01001", "01001", "01001", "01001", "01001", "01001", "01001", "01001", "01001", "01001", "01001", "01001", "01001", "01001", "01001… -#> $ state_name "Alabama", "Alabama", "Alabama", "Alabama", "Alabama", "Alabama", "Alabama", "Alabama", "Alabama", "Alabama", "Alabama", "Alabama", "Alabama"… -#> $ county_name "Autauga", "Autauga", "Autauga", "Autauga", "Autauga", "Autauga", "Autauga", "Autauga", "Autauga", "Autauga", "Autauga", "Autauga", "Autauga"… -#> $ year 1961, 1961, 1961, 1962, 1962, 1962, 1962, 1962, 1963, 1963, 1963, 1964, 1964, 1965, 1966, 1967, 1968, 1968, 1968, 1969, 1969, 1969, 1969, 196… -#> $ month 1, 2, 12, 1, 4, 4, 4, 12, 1, 4, 12, 4, 4, 7, 1, 3, 3, 8, 8, 3, 3, 6, 6, 6, 4, 4, 4, 5, 1, 3, 3, 4, 4, 4, 5, 5, 5, 6, 3, 3, 2, 4, 5, 11, 1, 2,… -#> $ hazard "Winter Weather", "Severe Storm/Thunder Storm", "Severe Storm/Thunder Storm", "Winter Weather", "Hail", "Severe Storm/Thunder Storm", "Wind",… -#> $ damage_property 21498.713, 75141.081, 83907.468, 74394.646, 2479.825, 2479.825, 2479.825, 74394.646, 73422.069, 491928.296, 73422.167, 292024.963, 6389.224, … -#> $ damage_crop 7514.11815, 75141.08081, 8390.71660, 74394.64644, 2479.82487, 2479.82487, 2479.82487, 74394.64644, 73422.06910, 0.00000, 7342.22659, 34952.83… -#> $ fatalities 0.00, 0.00, 0.00, 0.06, 0.00, 0.00, 0.00, 0.04, 0.00, 0.00, 0.00, 0.00, 0.00, 1.00, 0.15, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.0… -#> $ injuries 0.00000, 0.00000, 0.00000, 0.00000, 0.00333, 0.00333, 0.00333, 0.00000, 0.00000, 0.00000, 0.00000, 0.04000, 0.04000, 0.00000, 0.07000, 0.0000… -#> $ records 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, … -#> $ allocation_factor NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N… -``` - Key variables include: - `unique_id`: Unique identifier for each observation diff --git a/vignettes/get_sheldus.Rmd.orig b/vignettes/get_sheldus.Rmd.orig index d3a6340..abdba5f 100644 --- a/vignettes/get_sheldus.Rmd.orig +++ b/vignettes/get_sheldus.Rmd.orig @@ -55,10 +55,6 @@ sheldus <- get_sheldus() Each row represents a unique combination of county, year, month, and hazard type. Only county-month-hazard combinations with recorded events are included. -```{r structure} -glimpse(sheldus) -``` - Key variables include: - `unique_id`: Unique identifier for each observation From 02fb6c04f223dc261d6b392362261f1964ea3435 Mon Sep 17 00:00:00 2001 From: Will Curran-Groome Date: Wed, 22 Jul 2026 13:29:04 -0400 Subject: [PATCH 2/2] minor updates --- .Rbuildignore | 1 + R/get_business_patterns.R | 37 +++++- R/get_lodes.R | 87 ++++++++++---- R/get_national_risk_index.R | 2 +- man/climateapi-package.Rd | 1 - man/get_business_patterns.Rd | 11 +- man/get_lodes.Rd | 12 +- renv.lock | 4 +- tests/testthat/helper-cache.R | 18 +++ tests/testthat/test-get_business_patterns.R | 6 +- tests/testthat/test-get_lodes.R | 8 +- tests/testthat/test-get_wildfire_burn_zones.R | 111 ++++++++---------- 12 files changed, 198 insertions(+), 100 deletions(-) create mode 100644 tests/testthat/helper-cache.R diff --git a/.Rbuildignore b/.Rbuildignore index 680a09c..481c3ac 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -11,6 +11,7 @@ ^pkgdown$ ^\.github$ ^temporary-scripts$ +^data$ \.Rmd\.orig$ ^vignettes/precompile\.R$ ^reviews$ diff --git a/R/get_business_patterns.R b/R/get_business_patterns.R index 8514d96..0aed3f4 100644 --- a/R/get_business_patterns.R +++ b/R/get_business_patterns.R @@ -98,6 +98,13 @@ get_cbp_naics_metadata = function(year) { #' @param naics_codes A vector of NAICS codes to query. If NULL, the function will #' query all available codes with the specified number of digits. If not NULL, #' this argument overrides the `naics_code_digits` argument. +#' @param cache_directory Optional path to a directory used as a read-through cache +#' for the raw (pre-cleaning) CBP pull. If supplied, a cache file is named from +#' every parameter that determines its content (`geo`, `year`, and whichever of +#' `naics_code_digits`/`naics_codes` was used to select codes), so a later call +#' for a different year or code selection always misses the cache and re-queries +#' the API, rather than silently returning stale data. If `NULL` (the default), +#' data are queried fresh and not written to disk. #' #' @details #' County Business Patterns (CBP) is an annual series that provides subnational @@ -172,7 +179,9 @@ get_cbp_naics_metadata = function(year) { #' naics_codes = c(221111, 221112)) #' } -get_business_patterns = function(year = 2023, geo = "county", naics_code_digits = 2, naics_codes = NULL) { +get_business_patterns = function( + year = 2023, geo = "county", naics_code_digits = 2, naics_codes = NULL, + cache_directory = NULL) { if (year < 2008) { stop("Year must be 2008 or later. Earlier years use different data structures not currently supported.") } if (year > 2023) { stop("Most recent year for data is 2023.") } if (! geo %in% c("county", "zipcode")) { stop("`geo` must be one of 'county' or 'zipcode'.") } @@ -269,7 +278,31 @@ get_business_patterns = function(year = 2023, geo = "county", naics_code_digits error = function(e2) tibble::tibble()) }) } else { tibble::tibble() } }) } - cbp = purrr::map_dfr(naics_codes_to_query, fetch_cbp_data) %>% + ## caches the raw Census API pull -- before the renaming/mutating/recoding below -- + ## so that if the cleaning logic changes later, previously-cached raw data can still + ## be reprocessed with the updated logic instead of needing to be re-queried + cbp_cache_path = if (is.null(cache_directory)) { + NULL + } else { + naics_key = if (!is.null(naics_codes)) { + stringr::str_c("codes-", stringr::str_c(sort(unique(as.character(naics_codes))), collapse = "-")) + } else { + stringr::str_c("digits-", naics_code_digits) } + file.path(cache_directory, stringr::str_c( + "business_patterns_raw_", geo, "_", year, "_", naics_key, ".parquet")) } + + if (!is.null(cbp_cache_path) && file.exists(cbp_cache_path)) { + message("Reading cached raw CBP data: ", basename(cbp_cache_path)) + cbp_raw = arrow::read_parquet(cbp_cache_path) + } else { + cbp_raw = purrr::map_dfr(naics_codes_to_query, fetch_cbp_data) + if (!is.null(cbp_cache_path)) { + if (!dir.exists(cache_directory)) { dir.create(cache_directory, recursive = TRUE) } + arrow::write_parquet(cbp_raw, cbp_cache_path) + message("Cached raw CBP data: ", basename(cbp_cache_path)) } + } + + cbp = cbp_raw %>% # Rename the NAICS label column to a standard name dplyr::rename_with(~ "NAICS_LABEL", dplyr::matches("NAICS[0-9]+_(LABEL|TTL)")) %>% dplyr::mutate( diff --git a/R/get_lodes.R b/R/get_lodes.R index 01cec91..c055fb0 100644 --- a/R/get_lodes.R +++ b/R/get_lodes.R @@ -107,6 +107,14 @@ rename_lodes_variables = function(.df) { #' @param state_part One of c("main", "aux"). Default is "main", which includes #' only workers who reside inside the state where they work. "aux" returns #' only workers who work in the specified state but live outside of that state. +#' @param cache_directory Optional path to a directory used as a read-through cache +#' for the raw (pre-cleaning) LODES pull. If supplied, a cache file is named from +#' every parameter that determines its content (`lodes_type`, `jobs_type`, +#' `geography`, `state_part`, `states`, and the exact years requested), so a later +#' call with different `states`/`years` -- e.g. once a new LODES vintage year +#' becomes available -- always misses the cache and re-downloads, rather than +#' silently returning stale data. If `NULL` (the default), data are downloaded +#' fresh and not written to disk. #' #' @details #' The Longitudinal Employer-Household Dynamics (LEHD) data at the U.S. Census Bureau @@ -163,7 +171,8 @@ get_lodes = function( states, years, geography = "tract", - state_part = "main") { + state_part = "main", + cache_directory = NULL) { if (geography == "bg") { geography = "block group"} @@ -278,21 +287,58 @@ Returning for only those states that are available for all specified years.\n") jobs_type_all = "JT01" jobs_type_federal = "JT05" } - ## supress messages/warnings else this is noisy - suppressWarnings({suppressMessages({ - lodes_all_jobs = lehdr::grab_lodes( + ## builds a cache filename that fully encodes every parameter influencing the raw + ## pull's content (including the exact years requested for *this* segment, since + ## the federal-jobs pull below requests a different, narrower years vector than the + ## all-jobs pull) -- so a later request for different states/years (e.g. once a new + ## LODES vintage year becomes available) always misses the cache rather than + ## silently returning stale data + lodes_cache_path = function(years_requested, segment_label) { + if (is.null(cache_directory)) { return(NULL) } + geography_slug = stringr::str_replace_all(geography, " ", "-") + file.path(cache_directory, stringr::str_c( + stringr::str_c( + "lodes_raw", lodes_type, jobs_type, geography_slug, state_part, segment_label, + stringr::str_c("states-", stringr::str_c(sort(states), collapse = "-")), + stringr::str_c("years-", stringr::str_c(sort(years_requested), collapse = "-")), + sep = "_"), + ".parquet")) } + + ## caches the raw lehdr::grab_lodes() pull -- before the GEOID renaming/column + ## dropping below, let alone the pivot/relabel steps further down -- so that if the + ## cleaning logic changes later, previously-cached raw data can still be reprocessed + ## with the updated logic instead of needing to be re-downloaded + fetch_lodes_raw = function(years_requested, job_type_code, segment_label) { + cache_path = lodes_cache_path(years_requested, segment_label) + + if (!is.null(cache_path) && file.exists(cache_path)) { + message("Reading cached raw LODES data: ", basename(cache_path)) + return(arrow::read_parquet(cache_path)) + } + + raw = suppressWarnings({suppressMessages({ + lehdr::grab_lodes( state = states, - year = years, - job_type = jobs_type_all, ## all primary jobs, i.e., the highest-paying job per worker + year = years_requested, + job_type = job_type_code, agg_geo = geography, segment = "S000", ## total number of jobs for workers lodes_type = lodes_type, version = "LODES8", - state_part = state_part) %>% ## include out-of-state workers who work in the state of interest - dplyr::rename_with( - .cols = dplyr::everything(), - .fn = ~ stringr::str_replace_all(.x, geoid_rename)) %>% - dplyr::select(-dplyr::matches("create")) })}) + state_part = state_part) })}) ## include out-of-state workers who work in the state of interest + + if (!is.null(cache_path)) { + if (!dir.exists(cache_directory)) { dir.create(cache_directory, recursive = TRUE) } + arrow::write_parquet(raw, cache_path) + message("Cached raw LODES data: ", basename(cache_path)) } + + raw } + + lodes_all_jobs = fetch_lodes_raw(years, jobs_type_all, "alljobs") %>% + dplyr::rename_with( + .cols = dplyr::everything(), + .fn = ~ stringr::str_replace_all(.x, geoid_rename)) %>% + dplyr::select(-dplyr::matches("create")) if (years %>% min < 2010 & years %>% max > 2010) { warning( @@ -320,20 +366,11 @@ as NA.\n") } } else { - suppressWarnings({suppressMessages({ - lodes_federal_jobs = lehdr::grab_lodes( - state = states, - year = years[years > 2009], - job_type = jobs_type_federal, ## federal jobs - agg_geo = geography, - segment = "S000", - lodes_type = lodes_type, - version = "LODES8", - state_part = state_part) %>% - dplyr::rename_with( - .cols = dplyr::everything(), - .fn = ~ stringr::str_replace_all(.x, geoid_rename)) %>% - dplyr::select(-dplyr::matches("create")) })}) + lodes_federal_jobs = fetch_lodes_raw(years[years > 2009], jobs_type_federal, "federaljobs") %>% + dplyr::rename_with( + .cols = dplyr::everything(), + .fn = ~ stringr::str_replace_all(.x, geoid_rename)) %>% + dplyr::select(-dplyr::matches("create")) if (lodes_type == "od") { join_by = c("year", "w_GEOID", "h_GEOID") } if (lodes_type == "rac") { join_by = c("year", "h_GEOID") } diff --git a/R/get_national_risk_index.R b/R/get_national_risk_index.R index 16be673..7b36617 100644 --- a/R/get_national_risk_index.R +++ b/R/get_national_risk_index.R @@ -200,7 +200,7 @@ get_national_risk_index = function( value_building = buildvalue, value_agriculture = agrivalue, area_sq_mi = area) |> - dplyr::select(-c(nri_id, stateabbrv, statefips, countytype, countyfips, stcofips, tract, tractfips)) |> + dplyr::select(-dplyr::any_of(c("nri_id", "stateabbrv", "statefips", "countytype", "countyfips", "stcofips", "tract", "tractfips"))) |> dplyr::rename_with( .cols = dplyr::everything(), .fn = ~ stringr::str_replace_all(.x, c( diff --git a/man/climateapi-package.Rd b/man/climateapi-package.Rd index f5b4464..9962c11 100644 --- a/man/climateapi-package.Rd +++ b/man/climateapi-package.Rd @@ -20,7 +20,6 @@ Useful links: Authors: \itemize{ - \item Will Curran-Groome \email{wcurrangroome@urban.org} (\href{https://orcid.org/0000-0001-6432-7561}{ORCID}) \item Kameron Lloyd } diff --git a/man/get_business_patterns.Rd b/man/get_business_patterns.Rd index 5c7d40e..a0fa1fc 100644 --- a/man/get_business_patterns.Rd +++ b/man/get_business_patterns.Rd @@ -8,7 +8,8 @@ get_business_patterns( year = 2023, geo = "county", naics_code_digits = 2, - naics_codes = NULL + naics_codes = NULL, + cache_directory = NULL ) } \arguments{ @@ -31,6 +32,14 @@ argument as NULL and supply the desired codes as the argument to \code{naics_cod \item{naics_codes}{A vector of NAICS codes to query. If NULL, the function will query all available codes with the specified number of digits. If not NULL, this argument overrides the \code{naics_code_digits} argument.} + +\item{cache_directory}{Optional path to a directory used as a read-through cache +for the raw (pre-cleaning) CBP pull. If supplied, a cache file is named from +every parameter that determines its content (\code{geo}, \code{year}, and whichever of +\code{naics_code_digits}/\code{naics_codes} was used to select codes), so a later call +for a different year or code selection always misses the cache and re-queries +the API, rather than silently returning stale data. If \code{NULL} (the default), +data are queried fresh and not written to disk.} } \value{ A tibble with data on employees, employers, and aggregate annual payrolls by diff --git a/man/get_lodes.Rd b/man/get_lodes.Rd index 222d8c9..a25066d 100644 --- a/man/get_lodes.Rd +++ b/man/get_lodes.Rd @@ -10,7 +10,8 @@ get_lodes( states, years, geography = "tract", - state_part = "main" + state_part = "main", + cache_directory = NULL ) } \arguments{ @@ -34,6 +35,15 @@ Default is "tract".} \item{state_part}{One of c("main", "aux"). Default is "main", which includes only workers who reside inside the state where they work. "aux" returns only workers who work in the specified state but live outside of that state.} + +\item{cache_directory}{Optional path to a directory used as a read-through cache +for the raw (pre-cleaning) LODES pull. If supplied, a cache file is named from +every parameter that determines its content (\code{lodes_type}, \code{jobs_type}, +\code{geography}, \code{state_part}, \code{states}, and the exact years requested), so a later +call with different \code{states}/\code{years} -- e.g. once a new LODES vintage year +becomes available -- always misses the cache and re-downloads, rather than +silently returning stale data. If \code{NULL} (the default), data are downloaded +fresh and not written to disk.} } \value{ A tibble with one record per geography per year per job type. Attributes diff --git a/renv.lock b/renv.lock index f645eae..dba135d 100644 --- a/renv.lock +++ b/renv.lock @@ -5853,12 +5853,12 @@ "Author": "Will Curran-Groome [aut, cre]", "Maintainer": "Will Curran-Groome ", "RemoteType": "github", + "Remotes": "UI-Research/crosswalk, UrbanInstitute/urbnthemes", "RemoteUsername": "UI-Research", "RemoteRepo": "urbnindicators", "RemoteRef": "main", "RemoteSha": "e47d4b2a749b504e27f80997526bdbe3e0c7aef9", - "RemoteHost": "api.github.com", - "Remotes": "UI-Research/crosswalk, UrbanInstitute/urbnthemes" + "RemoteHost": "api.github.com" }, "urbnthemes": { "Package": "urbnthemes", diff --git a/tests/testthat/helper-cache.R b/tests/testthat/helper-cache.R new file mode 100644 index 0000000..eacb10d --- /dev/null +++ b/tests/testthat/helper-cache.R @@ -0,0 +1,18 @@ +# Absolute path to a local raw-data cache used by get_lodes()/get_business_patterns() +# tests, so re-running devtools::check() doesn't re-download the same data every time. +# +# Returns NULL (no caching -- tests hit the live API directly, same as before this +# helper existed) unless CLIMATEAPI_TEST_CACHE_DIR is set to an absolute path (e.g. in +# .Renviron). A relative path would not work here: devtools::check() builds and checks +# the package from a temporary directory disconnected from this source tree, so tests +# running under check() can't find a repo-relative "../../data" -- only an absolute +# path set outside that sandbox (via an environment variable) survives the trip. +get_test_cache_directory <- function() { + cache_directory <- Sys.getenv("CLIMATEAPI_TEST_CACHE_DIR", unset = NA) + + if (is.na(cache_directory) || !nzchar(cache_directory)) { + return(NULL) + } + + cache_directory +} diff --git a/tests/testthat/test-get_business_patterns.R b/tests/testthat/test-get_business_patterns.R index 55d01f4..520b7a5 100644 --- a/tests/testthat/test-get_business_patterns.R +++ b/tests/testthat/test-get_business_patterns.R @@ -12,11 +12,13 @@ testthat::test_that("year errors clearly when year is outside accceptable range" testthat::test_that("geo errors clearly when geo is not 'county' or 'zipcode'; does not error when in 'county' or 'zipcode' ", { testthat::expect_error({get_business_patterns(geo = "tract", naics_code_digits = 3)}) - testthat::expect_no_error({get_business_patterns(geo = "county", naics_code_digits = 2)}) + testthat::expect_no_error({get_business_patterns( + geo = "county", naics_code_digits = 2, cache_directory = get_test_cache_directory())}) }) testthat::test_that("employees has no negative values", { - test <- get_business_patterns(geo = "zipcode", naics_code_digits = 2) + test <- get_business_patterns( + geo = "zipcode", naics_code_digits = 2, cache_directory = get_test_cache_directory()) # Ensure the column exists testthat::expect_true( diff --git a/tests/testthat/test-get_lodes.R b/tests/testthat/test-get_lodes.R index cf9ef6a..f7c26b9 100644 --- a/tests/testthat/test-get_lodes.R +++ b/tests/testthat/test-get_lodes.R @@ -7,13 +7,13 @@ testthat::test_that("states clearly errors when invalid state abbreviation is su testthat::test_that("warning generated when missing state and year combination is supplied", { testthat::expect_warning( - {get_lodes(lodes_type = "od", years = 2022, states = c("AK", "MN"))}, + {get_lodes(lodes_type = "od", years = 2022, states = c("AK", "MN"), cache_directory = get_test_cache_directory())}, "state-year combinations") ## pre-2015 years also trigger the federal-jobs reporting warning; capture both ## so neither escapes the expectation testthat::expect_warning( testthat::expect_warning( - {get_lodes(lodes_type = "wac", years = 2009, states = c("DC", "MN"))}, + {get_lodes(lodes_type = "wac", years = 2009, states = c("DC", "MN"), cache_directory = get_test_cache_directory())}, "state-year combinations"), "federal jobs") }) @@ -26,7 +26,9 @@ testthat::test_that("error generated when invalid lodes_type is supplied", { testthat::test_that("variables have no negative values", { ## states = "all" includes state-years missing from LODES (e.g., AK/MI in 2022), ## which triggers an expected availability warning - test <- suppressWarnings(get_lodes(lodes_type = "wac", years = 2022, states = "all")) + test <- suppressWarnings(get_lodes( + lodes_type = "wac", years = 2022, states = "all", + cache_directory = get_test_cache_directory())) # Select numeric columns num_df <- dplyr::select(test, where(is.numeric)) diff --git a/tests/testthat/test-get_wildfire_burn_zones.R b/tests/testthat/test-get_wildfire_burn_zones.R index 179276a..c748536 100644 --- a/tests/testthat/test-get_wildfire_burn_zones.R +++ b/tests/testthat/test-get_wildfire_burn_zones.R @@ -1,3 +1,27 @@ +# Tests for get_wildfire_burn_zones.R +# +# Data is loaded once at the top of the test file to avoid repeated I/O. +# The error-path test and the message test call the function directly, since +# they need to exercise the error/messaging behavior itself. + +wfbz_data_path <- file.path( + get_box_path(), "hazards", "other-sources", "wildfire-burn-zones", + "wfbz_disasters_2000-2025.geojson") + +skip_if_no_wfbz_data <- function() { + skip_if_not(file.exists(wfbz_data_path), message = "Wildfire burn zones data file not available") +} + +wfbz_test_data <- NULL + +local({ + if (file.exists(wfbz_data_path)) { + wfbz_test_data <<- tryCatch( + suppressMessages(get_wildfire_burn_zones()), + error = function(e) NULL) + } +}) + test_that("get_wildfire_burn_zones errors when file path does not exist", { expect_error( get_wildfire_burn_zones(file_path = "/nonexistent/path/to/file.geojson"), @@ -6,14 +30,10 @@ test_that("get_wildfire_burn_zones errors when file path does not exist", { }) test_that("get_wildfire_burn_zones returns expected structure", { - skip_if_not( - file.exists(file.path( - get_box_path(), "hazards", "other-sources", "wildfire-burn-zones", - "wfbz_disasters_2000-2025.geojson")), - message = "Wildfire burn zones data file not available" - ) + skip_if_no_wfbz_data() + skip_if(is.null(wfbz_test_data), "Wildfire burn zones test data not loaded") - result <- suppressMessages(get_wildfire_burn_zones()) + result <- wfbz_test_data expect_s3_class(result, "sf") @@ -31,41 +51,29 @@ test_that("get_wildfire_burn_zones returns expected structure", { }) test_that("get_wildfire_burn_zones has correct CRS", { - skip_if_not( - file.exists(file.path( - get_box_path(), "hazards", "other-sources", "wildfire-burn-zones", - "wfbz_disasters_2000-2025.geojson")), - message = "Wildfire burn zones data file not available" - ) + skip_if_no_wfbz_data() + skip_if(is.null(wfbz_test_data), "Wildfire burn zones test data not loaded") - result <- suppressMessages(get_wildfire_burn_zones()) + result <- wfbz_test_data expect_equal(sf::st_crs(result)$epsg, 5070) }) test_that("get_wildfire_burn_zones has one county per row", { - skip_if_not( - file.exists(file.path( - get_box_path(), "hazards", "other-sources", "wildfire-burn-zones", - "wfbz_disasters_2000-2025.geojson")), - message = "Wildfire burn zones data file not available" - ) + skip_if_no_wfbz_data() + skip_if(is.null(wfbz_test_data), "Wildfire burn zones test data not loaded") - result <- suppressMessages(get_wildfire_burn_zones()) + result <- wfbz_test_data expect_false(any(stringr::str_detect(result$county_fips, "\\|"), na.rm = TRUE)) expect_false(any(stringr::str_detect(result$county_name, "\\|"), na.rm = TRUE)) }) test_that("get_wildfire_burn_zones wildfire-level columns repeat identically across a multi-county wildfire's rows", { - skip_if_not( - file.exists(file.path( - get_box_path(), "hazards", "other-sources", "wildfire-burn-zones", - "wfbz_disasters_2000-2025.geojson")), - message = "Wildfire burn zones data file not available" - ) + skip_if_no_wfbz_data() + skip_if(is.null(wfbz_test_data), "Wildfire burn zones test data not loaded") - result <- suppressMessages(get_wildfire_burn_zones()) + result <- wfbz_test_data multi_county_ids <- result$wildfire_id[duplicated(result$wildfire_id)] |> unique() # this test is only meaningful if the live data actually contains multi-county wildfires @@ -102,14 +110,10 @@ test_that("get_wildfire_burn_zones wildfire-level columns repeat identically acr }) test_that("get_wildfire_burn_zones has valid FIPS codes", { - skip_if_not( - file.exists(file.path( - get_box_path(), "hazards", "other-sources", "wildfire-burn-zones", - "wfbz_disasters_2000-2025.geojson")), - message = "Wildfire burn zones data file not available" - ) + skip_if_no_wfbz_data() + skip_if(is.null(wfbz_test_data), "Wildfire burn zones test data not loaded") - result <- suppressMessages(get_wildfire_burn_zones()) + result <- wfbz_test_data non_na_state_fips <- result$state_fips[!is.na(result$state_fips)] non_na_county_fips <- result$county_fips[!is.na(result$county_fips)] @@ -120,14 +124,10 @@ test_that("get_wildfire_burn_zones has valid FIPS codes", { }) test_that("get_wildfire_burn_zones county names use Census's canonical casing", { - skip_if_not( - file.exists(file.path( - get_box_path(), "hazards", "other-sources", "wildfire-burn-zones", - "wfbz_disasters_2000-2025.geojson")), - message = "Wildfire burn zones data file not available" - ) + skip_if_no_wfbz_data() + skip_if(is.null(wfbz_test_data), "Wildfire burn zones test data not loaded") - result <- suppressMessages(get_wildfire_burn_zones()) + result <- wfbz_test_data non_na_names <- result$county_name[!is.na(result$county_name)] # county_name is joined from tidycensus::fips_codes (Census's own canonical casing) by @@ -139,12 +139,7 @@ test_that("get_wildfire_burn_zones county names use Census's canonical casing", }) test_that("get_wildfire_burn_zones emits expected message", { - skip_if_not( - file.exists(file.path( - get_box_path(), "hazards", "other-sources", "wildfire-burn-zones", - "wfbz_disasters_2000-2025.geojson")), - message = "Wildfire burn zones data file not available" - ) + skip_if_no_wfbz_data() expect_message( get_wildfire_burn_zones(), @@ -158,28 +153,20 @@ test_that("get_wildfire_burn_zones emits expected message", { }) test_that("get_wildfire_burn_zones year column is integer", { - skip_if_not( - file.exists(file.path( - get_box_path(), "hazards", "other-sources", "wildfire-burn-zones", - "wfbz_disasters_2000-2025.geojson")), - message = "Wildfire burn zones data file not available" - ) + skip_if_no_wfbz_data() + skip_if(is.null(wfbz_test_data), "Wildfire burn zones test data not loaded") - result <- suppressMessages(get_wildfire_burn_zones()) + result <- wfbz_test_data expect_type(result$year, "integer") expect_true(all(result$year >= 2000 & result$year <= 2025, na.rm = TRUE)) }) test_that("get_wildfire_burn_zones date columns are Date class", { - skip_if_not( - file.exists(file.path( - get_box_path(), "hazards", "other-sources", "wildfire-burn-zones", - "wfbz_disasters_2000-2025.geojson")), - message = "Wildfire burn zones data file not available" - ) + skip_if_no_wfbz_data() + skip_if(is.null(wfbz_test_data), "Wildfire burn zones test data not loaded") - result <- suppressMessages(get_wildfire_burn_zones()) + result <- wfbz_test_data expect_s3_class(result$date_start, "Date") expect_s3_class(result$date_containment, "Date")