diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..91114bf --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,2 @@ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5de40de --- /dev/null +++ b/.gitignore @@ -0,0 +1,14 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata + +# R check artifacts +*.Rcheck/ + +# Generated analysis outputs — large binaries, not source +analysis/generated_data/ +analysis/worldpop/ + +# SLURM logs +logs/ diff --git a/CLAUDE.md b/CLAUDE.md new file mode 100644 index 0000000..ca2f365 --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1,141 @@ +# CLAUDE.md + +This file provides guidance to Claude Code (claude.ai/code) when working with code in this repository. + +## Package Overview + +**OutbreakExtractR** is an R package for epidemiological cholera outbreak surveillance. It extracts and identifies cholera outbreaks from surveillance data (sourced from a PostgreSQL/Global Cholera Taxonomy Database) using a configurable operational outbreak definition. + +## Development Commands + +```r +# Regenerate documentation (run before installing after any @param/@export changes) +devtools::document() + +# Install from source +install.packages('.', repo=NULL, type="source") + +# Run all tests +devtools::test() + +# Run a single test file +testthat::test_file("tests/testthat/test-clean_psql_data.R") + +# Load package interactively without reinstalling +devtools::load_all() + +# Check the full package (CRAN-style) +devtools::check() +``` + +NAMESPACE is auto-generated by roxygen2 — never edit it by hand. + +## Architecture + +The pipeline has five sequential layers: + +### 1. Ingestion & Cleaning (`R/clean_*.R`, `R/observation_filter.R`) +- `clean_psql_data()` — entry point for raw PostgreSQL CSV exports; standardizes types, identifies spatial/temporal scales, flags primary records +- `clean_location_names()` — normalizes `::`-delimited location hierarchy strings (`country::admin1::admin2::admin3::admin4`) +- `observation_filter()` — subsets by date range, WHO region, scale, and minimum case count + +### 2. Normalization (`R/observation_aggregator.R`, `R/fill_*.R`, `R/set_uniform_*.R`) +- Aggregates daily data to weekly; aligns week-start days; fills phantom zero-case weeks (±8 weeks padding) and missing location-periods from linked records +- Time periods are always represented as `TL` (start) / `TR` (end) date pairs + +### 3. Threshold Calculation (`R/get_outbreak_threshold.R`, `R/get_pop.R`, `R/calculate_population_density.R`) +- Supports four threshold modes: `fixed`, `mean_weekly_incidence`, `outbreak_dependent`, `time_restricted` +- Population data comes from bundled `WPP2022.rda` / `WPP2024.rda` (WorldPop) and `endemic_locs_gte50nz_3ydata.rda` + +### 4. Outbreak Detection (`R/identify_*.R`) +`identify_outbreaks()` is the main orchestrator. It calls: +- `identify_epidemic_start()` — two modes: `"consecutive"` (N weeks above threshold) or `"dual_window"` (sliding window + cumulative case trigger); key params: `min_weeks_above`, `window_weeks`, `cumulative_case_threshold_ratio` +- `identify_epidemic_tail()` — marks outbreak end after `tail_period` (default 6) consecutive weeks below threshold +- `identify_consecutive_outbreak_data()` / `identify_epidemic_period()` — group and extract bounded outbreak windows +- `identify_washout_period()` — labels inter-epidemic gaps + +### 5. Alert Generation & Post-Processing (`R/trigger_alert*.R`, `R/format_alerts.R`, `R/label_*.R`) +`trigger_alert()` fires 17 alert types across three families: +- **Trend**: single/double/triple week exceeding 4-week rolling mean +- **Case count**: 2/5/10/25/50/100/250 cases in 3 consecutive weeks +- **Cumulative**: 5/10/25/50/100/500/1000 cumulative cases in 3 weeks + +Functions suffixed `_obs` operate on observatory (observed) data; others operate on modeled/threshold data. + +## Key Conventions + +- **Location strings** use `::` as hierarchy delimiter (e.g., `"Chad::Borkou"`). Helper `custom_paste()` handles safe concatenation. +- **Spatial scales**: `country`, `admin1`–`admin4` (and `admin4+`) +- **Temporal scales**: `daily`, `multiday`, `weekly`, `multiweek`, `monthly`, `multimonth`, `yearly`, `multiyear` +- **WHO regions**: `AFR`, `EMR`, `AMR`, `SEAR`, `EUR`, `WPR` +- Code uses R 4.1+ lambda syntax (`\(x)`) throughout; pipe is `%>%` (magrittr) +- Rolling windows via `slider`; RLE-based grouping via `zoo`; per-location processing via `purrr::map` + +## Testing + +Test files live in `tests/testthat/` with CSV fixtures (`outbreak_testing_data.csv`, `clean_outbreak_testing_data.csv`). Tests use **testthat edition 3**. Coverage focuses on filtering boundaries, type coercion, NA handling, aggregation correctness, and de-duplication logic. + +--- + +## HPC / SLURM Analysis Layer (`analysis/`) + +A config-driven pipeline that parallelizes over **countries × time windows** on Yggdrasil (University of Geneva HPC). Built on the same pattern as `mpox-uvira-sprint`. + +### Quick start + +```bash +# 1. Generate YAML configs +Rscript analysis/00_make_configs.R + +# 2. Set API credentials (these propagate to SLURM tasks via --export=ALL) +export CHOLERA_API_USERNAME= +export CHOLERA_API_KEY= + +# 3. Submit Batch 1 (data pull), chain Batch 2 (outbreak detection) after it +BATCH1=$(sbatch --parsable analysis/bash/submit_01_pull_data.sh) +sbatch --dependency=afterok:$BATCH1 analysis/bash/submit_02_detection.sh + +# 4. After all jobs finish, aggregate results locally +Rscript analysis/03_aggregate_results.R +``` + +### Architecture + +**Two SLURM batches:** +- **Batch 1** (`submit_01_pull_data.sh`): array over `analysis/configs/pull_set/` — one task per country × time window. Pulls via `taxdat::pull_taxonomy_data(source="api")`, runs the full normalization pipeline, writes: + - `stage1_geo_{run_id}.parquet` — GeoParquet with geometry (via `sfarrow`) + - `stage1_flat_{run_id}.parquet` — flat Parquet without geometry (input to Batch 2) +- **Batch 2** (`submit_02_detection.sh`): array over `analysis/configs/detection_set/` — one task per country. Globs all Stage 1 flat files for that country, runs `identify_outbreaks()` + `trigger_alert()` per time window, writes `stage2_{region}_{iso3}.parquet`. + +### Config system + +- `analysis/config_defaults.yml` — full parameter schema with defaults +- `analysis/00_make_configs.R` — editable country list and time windows; generates `pull_set/` and `detection_set/` configs +- `analysis/utils.R` — shared helpers: `write_configs()`, `make_options_from_config()`, `make_taxdat_location()`, filename functions + +**taxdat location format:** `"CT-World::{WHO_REGION}::{ISO3}"` (e.g. `"CT-World::AFR::COD"`). +**Credentials:** always via env vars `CHOLERA_API_USERNAME` / `CHOLERA_API_KEY` — never in config files. + +### Local dry-run workflow + +```bash +# Generate a 1-country test config +# (already created by 00_make_configs.R as configs/test_pull/ and test_detection/) + +# Test Batch 1 +Rscript analysis/01_pull_data.R -c analysis/configs/test_pull/test_pull_1.yml + +# Test Batch 2 +Rscript analysis/02_run_outbreak_detection.R -c analysis/configs/test_detection/test_detection_1.yml + +# SLURM dry run (no submission) +SLURM_ARRAY_TASK_ID=0 bash analysis/bash/submit_01_pull_data.sh +``` + +### SLURM array bounds + +After running `00_make_configs.R`, it prints the exact `--array` bounds to set in the submission scripts. **Edit the `#SBATCH --array=` lines** in `submit_01_pull_data.sh` and `submit_02_detection.sh` before submitting. + +### GeoParquet + +`get_shp()` now accepts an `output_parquet` parameter — when provided, it saves the returned sf object as GeoParquet via `sfarrow::st_write_parquet()`. All `analysis/` layer outputs use `.parquet` format (`sfarrow` for spatial, `arrow` for tabular). diff --git a/DESCRIPTION b/DESCRIPTION index e77848f..ba05f20 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,10 +7,40 @@ Description: This package License: GLP-2 Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.2 -Suggests: - testthat (>= 3.0.0) +Imports: + DBI, + RPostgres, + glue, + sf, + dplyr, + purrr, + tidyr, + stringr, + tibble, + lubridate, + zoo, + tidyselect, + rlang, + magrittr, + slider, + curl, + raster, + exactextractr +Suggests: + testthat (>= 3.0.0), + sfarrow, + arrow, + yaml, + optparse, + furrr, + future, + here, + taxdat, + rgeoboundaries, + digest, + withr Config/testthat/edition: 3 -Depends: +Depends: R (>= 2.10) LazyData: true +Config/roxygen2/version: 8.1.0 diff --git a/NAMESPACE b/NAMESPACE index 724425e..bd2c1f4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,8 +9,11 @@ export(add_outcome_bin) export(add_pop3_adm_columns) export(add_pop3_adm_columns_outbreak) export(add_pop6_adm_columns) +export(add_population) export(add_unique_alert_ids) export(average_duplicate_observations) +export(band_adj_factor) +export(build_composite_locations) export(calculate_cases) export(calculate_population_density) export(clean_location_names) @@ -19,13 +22,17 @@ export(create_alert_groups) export(create_alert_groups2) export(custom_paste) export(define_postprocessed_alerts) +export(detect_duplicate_geometries) +export(estimate_pop_for_geometries) export(extract_agroup_case_outcomes) export(extract_agroup_pers_outcomes) export(extract_alert_outcomes) export(extract_binary_case_outcomes) export(fill_missing_lps) export(fill_phantom_zeroes) +export(filter_ms_data) export(format_alerts) +export(get_country_boundary) export(get_epiweek) export(get_ghs_pop) export(get_outbreak_threshold) @@ -46,11 +53,14 @@ export(label_dimensions) export(observation_aggregator) export(observation_filter) export(remove_consecutive_alerts) +export(resolve_composite_children) export(set_uniform_wday_start) export(trigger_alert) export(trigger_alert_caseratio) export(trigger_alert_cases) export(trigger_alert_rate) export(trigger_alert_trends) +export(validate_population) +export(verify_outbreak_definitions) import(magrittr) importFrom(magrittr,"%>%") diff --git a/OutbreakExtractR.Rproj b/OutbreakExtractR.Rproj new file mode 100644 index 0000000..ff46899 --- /dev/null +++ b/OutbreakExtractR.Rproj @@ -0,0 +1,20 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +AutoAppendNewline: Yes + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source +PackageRoxygenize: rd,collate,namespace diff --git a/R/add_population.R b/R/add_population.R new file mode 100644 index 0000000..fd6bc5e --- /dev/null +++ b/R/add_population.R @@ -0,0 +1,517 @@ +#' @export +#' @title add_population +#' @name add_population +#' @description Attach WorldPop population estimates to a normalized weekly +#' data frame. Intended as a Stage 1 pipeline step immediately after +#' fill_missing_lps(), and before writing to parquet. +#' +#' A single population value is computed per unique location_period_id (not +#' per week), which is correct: get_outbreak_threshold() and +#' identify_epidemic_start() both use pop as a static denominator for +#' incidence calculations. +#' +#' Population is estimated by: +#' 1. Looking up each location_period_id geometry in raw_sf (already in +#' memory — no extra DB call). +#' 2. Clamping the representative year (median TL) to 2015-2030 (WorldPop +#' constrained raster range). +#' 3. For each unique year: loading the raster ONCE, computing the UN +#' adjustment factor with one exact_extract call on the country boundary, +#' then extracting ALL LP populations with a single vectorized +#' exact_extract call. The raster is released immediately after. +#' +#' This avoids the 2N-loads-per-year penalty that results from calling +#' get_pop() per LP (each call loads the raster twice: once for the LP +#' geometry and once inside estimate_adj_factors() for the country boundary). +#' +#' @param normalized_data data.frame: weekly normalized data from the Stage 1 +#' pipeline (output of fill_missing_lps()). Must contain columns +#' location_period_id and TL. +#' @param raw_sf sf object: geometry-bearing data returned by +#' taxdat::pull_taxonomy_data() (before geometry is dropped). Must contain +#' a location_period_id, locationPeriod_id, or lctn_pr column and an sf +#' geometry column. +#' @param country_iso3 character: ISO3 country code (e.g. "COD"). Used to +#' download the correct WorldPop raster and to fetch the country boundary +#' for the UN population adjustment factor. +#' @param raster_dir character: directory for caching WorldPop raster files. +#' Defaults to "worldpop". Created if it does not exist. +#' @param boundary_cache_dir character or NULL: directory for caching national +#' boundaries used by the UN adjustment. Passed to +#' \code{get_country_boundary()}. +#' +#' @return normalized_data with a numeric \code{pop} column added, plus +#' provenance columns: \code{pop_source}, \code{pop_geom_dup_n}, +#' \code{pop_geom_dup_class}, \code{pop_year_obs}, \code{pop_year_raster}, +#' \code{pop_natl_ref}, \code{adj_factor} and \code{adj_factor_flag}. +#' Rows whose location_period_id has no matching geometry in raw_sf receive +#' \code{pop = NA} (never 0 — see the note on zero denominators below). +#' +#' \code{pop} is \code{NA}, never 0, whenever a population cannot be +#' established. \code{get_outbreak_threshold()} routes \code{is.na(pop)} to +#' the "low" surveillance class, but \code{pop == 0} yields +#' \code{sCh / pop == Inf}, which classifies as "high" — so a zero denominator +#' silently flips the outbreak-detection threshold rather than merely +#' producing a bad rate. +add_population <- function(normalized_data, raw_sf, country_iso3, + raster_dir = "worldpop", + boundary_cache_dir = "country_boundaries") { + + country_iso3 <- toupper(country_iso3) + + # --------------------------------------------------------------------------- + # 1. Build named geometry lookup: LP ID (character) -> sfg object + # --------------------------------------------------------------------------- + # taxdat::rename_database_fields(source="api") uses "locationPeriod_id" (camelCase); + # taxdat::rename_database_fields(source="psql") / after clean_psql_data() uses + # "location_period_id" (snake_case); get_shp() uses "lctn_pr". Accept all three. + geom_id_col <- if ("location_period_id" %in% names(raw_sf)) { + "location_period_id" + } else if ("locationPeriod_id" %in% names(raw_sf)) { + "locationPeriod_id" + } else if ("lctn_pr" %in% names(raw_sf)) { + "lctn_pr" + } else { + stop("raw_sf must have a 'location_period_id', 'locationPeriod_id', or 'lctn_pr' column.") + } + + lp_geoms <- raw_sf %>% + dplyr::rename(lp_id = !!geom_id_col) %>% + dplyr::group_by(lp_id) %>% + dplyr::slice(1) %>% + dplyr::ungroup() %>% + sf::st_make_valid() + + # Named list: character(LP ID) -> sfg geometry + geom_lookup <- setNames( + as.list(sf::st_geometry(lp_geoms)), + as.character(lp_geoms$lp_id) + ) + source_crs <- sf::st_crs(raw_sf) + + # --------------------------------------------------------------------------- + # 2. Representative year per LP (clamped to WorldPop range 2015-2030) + # --------------------------------------------------------------------------- + # pop_year_obs keeps the *unclamped* median observation year; pop_year_raster + # is the year actually rastered. Downstream can rescale a static population to + # an arbitrary year with pop * WPP(iso3, t) / pop_natl_ref, which needs both. + lp_years <- normalized_data %>% + dplyr::filter(!is.na(location_period_id)) %>% + dplyr::group_by(location_period_id) %>% + dplyr::summarise( + pop_year_obs = as.integer(stats::median(lubridate::year(TL))), + .groups = "drop" + ) %>% + dplyr::mutate(year = pmax(2015L, pmin(2030L, pop_year_obs))) + + # All location_period_ids are NA (absent from API response or filtered out). + # purrr::list_rbind() on an empty map returns a 0-column tibble, which breaks + # the left_join below. Return early with pop = NA for all rows. + if (nrow(lp_years) == 0) { + message("add_population(): no valid location_period_ids — pop set to NA for all rows.") + return(attach_empty_pop_provenance(normalized_data)) + } + + # --------------------------------------------------------------------------- + # 3. Country boundary for the UN adjustment factor (fetched once) + # --------------------------------------------------------------------------- + # Resolved by get_country_boundary(): disk cache -> gb_adm0() -> NULL. + # + # There is deliberately NO union-of-LP-geometries fallback. That union covers + # only the surveilled sub-areas, so extracting the raster on it understates + # country_raw and inflates adj_factor = tot_UN / country_raw, scaling every + # population in the country upward. When the boundary cannot be resolved we + # skip the adjustment (adj_factor = 1.0), leaving populations unadjusted + # rather than wrong. + iso3_for_boundary <- regmatches(country_iso3, regexpr("[A-Z]{3}", country_iso3)) + country_shp <- get_country_boundary(iso3_for_boundary, + cache_dir = boundary_cache_dir) + if (is.null(country_shp)) { + message("add_population(): no national boundary for ", iso3_for_boundary, + " — UN adjustment skipped (adj_factor = 1.0).") + } + + # --------------------------------------------------------------------------- + # 4. WPP2024 national totals (loaded once, used for adj factor in every year) + # --------------------------------------------------------------------------- + data("WPP2024", package = "OutbreakExtractR", envir = environment()) + + # --------------------------------------------------------------------------- + # 5. One raster load per year; two exact_extract calls per year + # + # Avoids the 2N raster-load penalty of calling get_pop() per LP, where + # each call loads the raster in get_pop() AND again inside + # estimate_adj_factors(). Here we load once and inline the adj-factor + # calculation against the same in-memory raster object. + # --------------------------------------------------------------------------- + message("add_population(): ", nrow(lp_years), " LP(s) across ", + dplyr::n_distinct(lp_years$year), " year(s) in ", country_iso3) + + lp_pop <- lp_years %>% + dplyr::group_by(year) %>% + dplyr::group_split() %>% + purrr::map(\(year_group) { + + yr <- year_group$year[1] + lp_ids <- year_group$location_period_id + message(" Year ", yr, ": ", length(lp_ids), " LP(s)") + + # -- a. Download / cache raster (no-op if already on disk) -------------- + raster_path <- tryCatch( + download_worldpop_constrained(iso3_for_boundary, yr, dest_dir = raster_dir), + error = function(e) { + message(" Raster download failed: ", conditionMessage(e)) + NULL + } + ) + + tot_UN <- WPP2024$PopTotal[ + WPP2024$Time == yr & WPP2024$ISO3_code == iso3_for_boundary + ] * 1e3 + pop_natl_ref <- if (length(tot_UN) == 1L) tot_UN else NA_real_ + + if (is.null(raster_path)) { + message(" Skipping year ", yr, " — all LPs set to NA.") + return(dplyr::tibble(location_period_id = lp_ids, pop = NA_real_, + pop_source = "none", adj_factor = NA_real_, + adj_factor_flag = NA_character_, + pop_natl_ref = pop_natl_ref)) + } + + # Load raster ONCE for this year + pop_raster <- raster::raster(raster_path) + + # -- b. Adj factor: one exact_extract call on the country boundary ------ + # Inlined from estimate_adj_factors() to reuse the already-loaded + # raster instead of having that function load it a second time. + country_raw <- if (is.null(country_shp)) { + 0 + } else { + tryCatch( + sum( + exactextractr::exact_extract( + pop_raster, sf::st_geometry(country_shp), "sum" + ), + na.rm = TRUE + ), + error = function(e) { + message(" adj factor extraction failed: ", conditionMessage(e), + " — using 1.0 (population will be unadjusted).") + 0 + } + ) + } + + adj_banded <- if (length(tot_UN) == 1L && country_raw > 0) { + band_adj_factor(tot_UN / country_raw) + } else { + message(" Could not compute adj factor for year ", yr, + " — using 1.0 (population will be unadjusted).") + list(value = 1.0, flag = "unadjusted") + } + adj_factor <- adj_banded$value + adj_factor_flag <- adj_banded$flag + + # -- c. Identify which LPs have geometry in this batch ------------------ + geoms <- lapply(as.character(lp_ids), \(id) geom_lookup[[id]]) + missing <- vapply(geoms, is.null, logical(1L)) + + if (any(missing)) { + message(" No geometry for LP(s): ", + paste(lp_ids[missing], collapse = ", "), " — pop = NA.") + } + + pop_values <- rep(NA_real_, length(lp_ids)) + pop_source <- rep("none", length(lp_ids)) + valid_idx <- which(!missing) + + if (length(valid_idx) > 0L) { + # -- d. Single vectorized exact_extract call for all LPs this year ---- + # exactextractr processes multiple geometries in one C++ pass, + # reading each raster tile at most once. + valid_sfc <- do.call(sf::st_sfc, geoms[valid_idx]) + sf::st_crs(valid_sfc) <- if (!is.na(source_crs)) source_crs else 4326 + valid_sfc <- sf::st_transform(valid_sfc, 4326) + + # exact_extract requires 2-D polygon geometries. + # st_dimension() returns: NA for empty, 0 for point, 1 for line, 2 for polygon. + # A single pass covers both the "GEOMETRYCOLLECTION EMPTY" case (NA) and + # the centroid-only "POINT" case (0) that would otherwise cause + # exactextractr's internal if(!all(st_dimension(y)==2)) to throw + # "missing value where TRUE/FALSE needed". + dims <- sf::st_dimension(valid_sfc) + bad_geom <- is.na(dims) | dims != 2L + if (any(bad_geom)) { + message(" Unusable geometry (empty/non-polygon) for LP(s): ", + paste(lp_ids[valid_idx[bad_geom]], collapse = ", "), + " — pop = NA.") + valid_idx <- valid_idx[!bad_geom] + valid_sfc <- valid_sfc[!bad_geom] + } + + # Normalize to a uniform geometry type. + # exactextractr::exact_extract() errors with "Mixed-type geometries not + # supported" when valid_sfc contains a mix of POLYGON and MULTIPOLYGON. + # After the bad_geom filter all remaining features have dimension == 2 + # (polygon-type), so casting to MULTIPOLYGON is always safe. + if (length(valid_sfc) > 0L) { + geom_types <- unique(as.character(sf::st_geometry_type(valid_sfc))) + if (length(geom_types) > 1L || identical(geom_types, "POLYGON")) { + valid_sfc <- sf::st_cast(valid_sfc, "MULTIPOLYGON", warn = FALSE) + } + } + + if (length(valid_idx) > 0L) { + raw_pops <- exactextractr::exact_extract( + pop_raster, valid_sfc, "sum" + ) + extracted <- as.numeric(raw_pops) * adj_factor + + # A raster sum of exactly 0 is not a population — it means the + # constrained raster has no built-up cells under this footprint. Emit + # NA so that get_outbreak_threshold() routes the LP to the "low" + # surveillance class instead of computing sCh/0 == Inf and + # classifying it as "high". + zero_pop <- !is.na(extracted) & extracted <= 0 + if (any(zero_pop)) { + message(" WorldPop returned 0 for LP(s): ", + paste(lp_ids[valid_idx[zero_pop]], collapse = ", "), + " — pop = NA (a zero denominator would flip the ", + "detection threshold).") + extracted[zero_pop] <- NA_real_ + } + + pop_values[valid_idx] <- extracted + pop_source[valid_idx] <- ifelse(is.na(extracted), "none", + "worldpop_constrained") + } + } + + # -- e. Release raster from memory before moving to the next year ------- + rm(pop_raster) + gc(verbose = FALSE) + + dplyr::tibble(location_period_id = lp_ids, pop = pop_values, + pop_source = pop_source, adj_factor = adj_factor, + adj_factor_flag = adj_factor_flag, + pop_natl_ref = pop_natl_ref) + }) %>% + purrr::list_rbind() + + # --------------------------------------------------------------------------- + # 6. Duplicate-geometry detection + # + # Several LPs can carry byte-identical geometry, in which case they are all + # assigned the same population. This originates in the Taxonomy source + # (distinct location_period_ids, distinct shape ids, identical shape + # content), not in the join here, so the response is to mark rather than + # to recompute. See detect_duplicate_geometries() for the class meanings. + # --------------------------------------------------------------------------- + lp_locations <- NULL + if ("location" %in% names(normalized_data)) { + loc_map <- normalized_data %>% + dplyr::filter(!is.na(location_period_id)) %>% + dplyr::group_by(location_period_id) %>% + dplyr::summarise(location = dplyr::first(location), .groups = "drop") + lp_locations <- loc_map$location[match(lp_geoms$lp_id, + loc_map$location_period_id)] + } + + dup_info <- detect_duplicate_geometries( + lp_ids = lp_geoms$lp_id, + geoms = sf::st_geometry(lp_geoms), + lp_locations = lp_locations + ) + + n_dup <- sum(dup_info$pop_geom_dup_n > 1L) + if (n_dup > 0L) { + cls <- table(dup_info$pop_geom_dup_class[dup_info$pop_geom_dup_n > 1L]) + message("add_population(): ", n_dup, " LP(s) share geometry with another LP (", + paste(names(cls), cls, sep = "=", collapse = ", "), ").") + } + + # --------------------------------------------------------------------------- + # 7. Join pop and provenance back onto the normalized data + # --------------------------------------------------------------------------- + prov_cols <- c("pop", "pop_source", "pop_geom_dup_n", "pop_geom_dup_class", + "pop_year_obs", "pop_year_raster", "pop_natl_ref", + "adj_factor", "adj_factor_flag") + normalized_data <- dplyr::select(normalized_data, -dplyr::any_of(prov_cols)) + + lp_pop <- lp_pop %>% + dplyr::left_join( + lp_years %>% + dplyr::select(location_period_id, pop_year_obs, + pop_year_raster = year), + by = "location_period_id" + ) %>% + dplyr::left_join( + dup_info %>% + dplyr::mutate(location_period_id = as(location_period_id, + class(lp_pop$location_period_id))), + by = "location_period_id" + ) %>% + dplyr::mutate( + pop_geom_dup_n = dplyr::coalesce(pop_geom_dup_n, 1L), + pop_geom_dup_class = dplyr::coalesce(pop_geom_dup_class, "unique") + ) + + normalized_data <- dplyr::left_join(normalized_data, lp_pop, + by = "location_period_id") + + n_with <- sum(!is.na(normalized_data$pop)) + message(sprintf("add_population(): %d / %d rows have a population estimate.", + n_with, nrow(normalized_data))) + + normalized_data +} + +#' @title attach_empty_pop_provenance +#' @name attach_empty_pop_provenance +#' @description Attach the population provenance schema with empty values, so +#' that early-return paths in \code{add_population()} produce the same columns +#' as the full path. Consumers can then rely on the schema unconditionally. +#' @param d data.frame to attach columns to. +#' @return \code{d} with the provenance columns added. +#' @keywords internal +attach_empty_pop_provenance <- function(d) { + d$pop <- NA_real_ + d$pop_source <- "none" + d$pop_geom_dup_n <- 1L + d$pop_geom_dup_class <- "unique" + d$pop_year_obs <- NA_integer_ + d$pop_year_raster <- NA_integer_ + d$pop_natl_ref <- NA_real_ + d$adj_factor <- NA_real_ + d$adj_factor_flag <- NA_character_ + d +} + +#' @export +#' @title estimate_pop_for_geometries +#' @name estimate_pop_for_geometries +#' @description Estimate a UN-adjusted WorldPop population for each polygon in an +#' sf object by extracting the constrained WorldPop raster directly on the +#' geometry. Intended for composite locations, whose denominator should be the +#' population of the actual (child-union) sub-area rather than the sum of +#' child populations or the parent-admin polygon. Mirrors the WorldPop machinery +#' in \code{add_population()} (one raster load per year, one adjustment-factor +#' \code{exact_extract} on the country boundary, one vectorized +#' \code{exact_extract} for all geometries in that year) and reuses the same +#' geometry sanitation (\code{st_make_valid}, drop empty/non-polygon, cast to +#' MULTIPOLYGON) so mixed-type / POINT / empty geometries do not crash the +#' extraction. +#' @param geom_sf sf: polygons to estimate population for. One value is returned +#' per row, in input order. +#' @param country_iso3 character: ISO3 country code (e.g. "BDI"); a sub-national +#' suffix is tolerated (the leading 3-letter code is extracted). +#' @param year integer: representative year(s), length 1 (recycled) or +#' \code{nrow(geom_sf)}. Clamped to the WorldPop constrained range 2015-2030. +#' @param raster_dir character: directory for caching WorldPop rasters. +#' @param boundary_cache_dir character or NULL: directory for caching national +#' boundaries, passed to \code{get_country_boundary()}. +#' @return numeric vector of length \code{nrow(geom_sf)} with the UN-adjusted +#' population per geometry (NA where the raster is unavailable, the geometry +#' is unusable, or the raster sum is zero — zero is never returned as a +#' population). +estimate_pop_for_geometries <- function(geom_sf, country_iso3, year, + raster_dir = "worldpop", + boundary_cache_dir = "country_boundaries") { + + n <- nrow(geom_sf) + if (n == 0L) return(numeric(0L)) + + country_iso3 <- toupper(country_iso3) + iso3_for_boundary <- regmatches(country_iso3, regexpr("[A-Z]{3}", country_iso3)) + + # Representative year per geometry, clamped to the WorldPop range. + if (length(year) == 1L) year <- rep(year, n) + if (length(year) != n) { + stop("estimate_pop_for_geometries(): 'year' must have length 1 or nrow(geom_sf).") + } + year <- pmax(2015L, pmin(2030L, as.integer(year))) + + # Work in EPSG:4326 (WorldPop CRS); keep an explicit row index for reassembly. + geoms_sfc <- sf::st_geometry(sf::st_make_valid(geom_sf)) + if (is.na(sf::st_crs(geoms_sfc))) sf::st_crs(geoms_sfc) <- 4326 + geoms_sfc <- sf::st_transform(geoms_sfc, 4326) + + # Country boundary for the UN adjustment factor (fetched once). + # As in add_population(): no union-of-input-geometries fallback — that + # understates the national raster total and inflates the adjustment factor. + # NULL means "skip the adjustment", not "approximate it". + country_shp <- get_country_boundary(iso3_for_boundary, + cache_dir = boundary_cache_dir) + + data("WPP2024", package = "OutbreakExtractR", envir = environment()) + + pop_out <- rep(NA_real_, n) + + for (yr in sort(unique(year))) { + idx <- which(year == yr) + + raster_path <- tryCatch( + download_worldpop_constrained(iso3_for_boundary, yr, dest_dir = raster_dir), + error = function(e) { + message(" estimate_pop_for_geometries(): raster download failed for ", + yr, ": ", conditionMessage(e)) + NULL + } + ) + if (is.null(raster_path)) next + + pop_raster <- raster::raster(raster_path) + + # Adjustment factor: one exact_extract on the country boundary. + country_raw <- if (is.null(country_shp)) { + 0 + } else { + tryCatch( + sum(exactextractr::exact_extract(pop_raster, sf::st_geometry(country_shp), "sum"), + na.rm = TRUE), + error = function(e) 0 + ) + } + tot_UN <- WPP2024$PopTotal[ + WPP2024$Time == yr & WPP2024$ISO3_code == iso3_for_boundary + ] * 1e3 + adj_factor <- if (length(tot_UN) == 1L && country_raw > 0) { + band_adj_factor(tot_UN / country_raw)$value + } else { + 1.0 + } + + # Sanitize this year's geometries (same guards as add_population()). + this_sfc <- geoms_sfc[idx] + dims <- sf::st_dimension(this_sfc) + good <- !is.na(dims) & dims == 2L + if (!any(good)) { + rm(pop_raster); gc(verbose = FALSE); next + } + keep_idx <- idx[good] + this_sfc <- this_sfc[good] + + geom_types <- unique(as.character(sf::st_geometry_type(this_sfc))) + if (length(geom_types) > 1L || identical(geom_types, "POLYGON")) { + this_sfc <- sf::st_cast(this_sfc, "MULTIPOLYGON", warn = FALSE) + } + + raw_pops <- tryCatch( + exactextractr::exact_extract(pop_raster, this_sfc, "sum"), + error = function(e) { + message(" estimate_pop_for_geometries(): extraction failed for year ", + yr, ": ", conditionMessage(e)) + rep(NA_real_, length(this_sfc)) + } + ) + extracted <- as.numeric(raw_pops) * adj_factor + # Zero is not a population — see add_population(). NA keeps the LP in the + # "low" surveillance class instead of producing sCh/0 == Inf. + extracted[!is.na(extracted) & extracted <= 0] <- NA_real_ + pop_out[keep_idx] <- extracted + + rm(pop_raster); gc(verbose = FALSE) + } + + pop_out +} diff --git a/R/build_composite_locations.R b/R/build_composite_locations.R new file mode 100644 index 0000000..f6d145a --- /dev/null +++ b/R/build_composite_locations.R @@ -0,0 +1,553 @@ +# Composite-location handling for Stage 2 outbreak detection. +# +# A "composite location" is an observation whose location name joins several +# admin units with "|" (e.g. "AFR::BDI::Cankuzo::Cankuzo|Cendajuru|Kigamba") +# and which the taxonomy API returns with location_period_id = NA and no +# geometry. Such rows survive Stage 1 but are silently dropped during Stage 2: +# add_population() skips NA location_period_id, so pop = NA, so +# get_outbreak_threshold() forces risk = "low" and identify_outbreaks() never +# flags an epidemic start. +# +# build_composite_locations() reproduces the handling previously done in +# GenevaIDD/global-cholera-surveillance-timeseries Step2_Extract_outbreak.R: +# de-composite the joined name into its child admin units, look up each child's +# location_period_id and population from the atomic rows already present in the +# normalized data (matching exactly, then on a name normalized to strip the +# " Sanitary District" suffix the taxonomy appends to health-system units), +# assign the composite a synthetic "composite_loc__" +# id with summed child population, and build the composite geometry as the +# union of its children's geometries. The rewritten rows then flow through +# identify_outbreaks() like any ordinary location. +# +# Population (geometry-derived, matching the colleague's reference): +# When a raster_dir is supplied, the composite's population is estimated +# directly from the constrained WorldPop raster on its (child-union or +# parent-fallback) geometry via estimate_pop_for_geometries(). This is the true +# sub-area denominator the reference script computed with get_pop() on the +# unioned shapefile, and it gives accurate incidence for composites whose +# children resolve to real geometry. The summed-child pop and parent-polygon pop +# are retained only as fallbacks (for composites whose geometry the raster could +# not resolve). Without a raster_dir the older summed-child / parent pop is used. +# +# Fallback (parent-location approximation): +# When composite children are not observed atomically (e.g. BDI sanitary +# districts that only ever appear in aggregate), no matched-child geometry is +# available. In that case the function falls back to the parent admin location +# (the prefix before the first "|" token) for geometry (and, without a +# raster_dir, for pop). This is an approximation: the incidence denominator then +# covers the full parent area rather than just the composite subunits, so +# detection thresholds are correspondingly lower (incidence underestimated). +# With a raster_dir, WorldPop-on-the-parent-geometry is still used, but it +# remains a parent-area (over-estimated) denominator for these composites. + +# Internal: split composite names into one (composite_name, location) row per +# child admin unit. Mirrors Step2_Extract_outbreak.R:105-134 — handles a "|" at +# any admin depth and decodes the "##" deeper-admin separator into "::". +decompose_composite_names <- function(composite_names) { + out <- vector("list", length(composite_names)) + + for (i in seq_along(composite_names)) { + nm <- composite_names[i] + tokens <- strsplit(nm, "::", fixed = TRUE)[[1]] + rows <- list() + + # Reproduce the original per-column loop: every admin token that contains a + # "|" yields a set of children (paths up to and including that token). + for (k in seq_along(tokens)) { + if (!grepl("|", tokens[k], fixed = TRUE)) next + + prefix <- if (k > 1L) paste(tokens[seq_len(k - 1L)], collapse = "::") else "" + pieces <- strsplit(tokens[k], "|", fixed = TRUE)[[1]] + child_locs <- vapply(pieces, function(p) { + full <- if (nzchar(prefix)) paste(prefix, p, sep = "::") else p + gsub("##", "::", full, fixed = TRUE) + }, character(1)) + + rows[[length(rows) + 1L]] <- data.frame( + composite_name = nm, + location = child_locs, + stringsAsFactors = FALSE + ) + } + + if (length(rows) > 0L) out[[i]] <- do.call(rbind, rows) + } + + res <- do.call(rbind, out) + if (is.null(res)) { + return(data.frame(composite_name = character(0L), + location = character(0L), + stringsAsFactors = FALSE)) + } + res +} + +# Internal: resolve each composite-child location to at most one atomic +# location_period_id + pop. It matches on the exact location string first, then +# falls back to a normalized key that strips a trailing " Sanitary District" +# from the terminal admin token. The taxonomy stores many BDI health-system +# units as " Sanitary District" while composite children carry the bare +# admin name, so the exact join alone leaves most children unmatched even though +# the like-named district LP (and its geometry) is present in the country pull. +# Each child is resolved to a SINGLE LP (deterministic: prefer non-NA pop, then +# lowest location_period_id) so that downstream population sums over distinct +# child LPs never double-count multiple location periods of the same place. +match_children_to_lps <- function(child_tbl, loc_lookup) { + strip_sd <- function(x) sub(" Sanitary District$", "", x) + + atomic <- loc_lookup %>% + dplyr::mutate(.key_norm = strip_sd(location)) %>% + dplyr::arrange(is.na(pop), location_period_id) + + exact <- atomic %>% + dplyr::distinct(location, .keep_all = TRUE) %>% + dplyr::select(location, + lp_exact = location_period_id, + pop_exact = pop) + + norm <- atomic %>% + dplyr::distinct(.key_norm, .keep_all = TRUE) %>% + dplyr::select(.key_norm, + lp_norm = location_period_id, + pop_norm = pop) + + child_tbl %>% + dplyr::mutate(.key_norm = strip_sd(location)) %>% + dplyr::left_join(exact, by = "location") %>% + dplyr::left_join(norm, by = ".key_norm") %>% + dplyr::mutate( + location_period_id = dplyr::coalesce(lp_exact, lp_norm), + pop = dplyr::if_else(!is.na(lp_exact), pop_exact, pop_norm) + ) %>% + dplyr::select(composite_name, location, location_period_id, pop) +} + +# Internal: return the parent location string (all tokens before the first +# pipe-containing token). Returns NA_character_ when the pipe is in the first +# or second token (country level — no meaningful parent available). +get_composite_parent <- function(composite_name) { + tokens <- strsplit(composite_name, "::", fixed = TRUE)[[1]] + first_pipe <- which(vapply(tokens, function(t) grepl("|", t, fixed = TRUE), + logical(1L)))[1L] + if (is.na(first_pipe) || first_pipe <= 2L) return(NA_character_) + paste(tokens[seq_len(first_pipe - 1L)], collapse = "::") +} + +#' @export +#' @title build_composite_locations +#' @name build_composite_locations +#' @description Resolve composite locations (NA location_period_id, "|"-joined +#' names) into synthetic "composite_loc__" pseudo location periods so +#' that Stage 2 outbreak detection can run on them. Geometry is the union of a +#' composite's children's geometries from raw_sf (parent-location fallback when +#' children are not individually observed). Population: when \code{raster_dir} +#' is supplied, it is estimated directly from WorldPop on that composite +#' geometry (the true sub-area denominator); otherwise it is the sum of the +#' children's WorldPop populations (attached by add_population()), with a +#' parent-location pop fallback. +#' @param normalized data.frame: the normalized weekly data AFTER +#' add_population(), so atomic location_period_ids carry a pop column. +#' @param raw_sf sf: geometry-bearing data from the Stage 1 geo files, keyed by +#' location_period_id. +#' @param iso3 character: ISO3 country code, used to namespace composite ids and +#' to gate the known-LP corrections for SSD/SOM. +#' @param raster_dir character or NULL: when supplied, each composite's +#' population is estimated directly from the constrained WorldPop raster on the +#' composite geometry via \code{estimate_pop_for_geometries()}. +#' @param allow_parent_pop_fallback logical: when TRUE, a composite whose +#' population cannot be established from its own children may inherit its +#' parent location's population. Defaults to FALSE. +#' +#' The parent of a composite is a strictly larger area, so inheriting its +#' population overstates the denominator by however much of the parent the +#' composite does not cover — the same pathology as the parent-inherited +#' geometry duplicates that \code{detect_duplicate_geometries()} flags. The +#' honest default is to leave such a composite with \code{pop = NA}, which +#' routes it to the "low" surveillance class, rather than to silently +#' substitute a value that is wrong in a known direction. +#' +#' @section Population precedence: +#' Sources are tried in this order, and the first that yields a usable +#' (positive, non-NA) value wins: +#' \enumerate{ +#' \item \code{composite_union} — WorldPop extracted on the union of the +#' composite's *children's* geometries. This is the true sub-area +#' denominator. +#' \item \code{child_sum} — the sum of the children's own populations. +#' \item \code{parent_fallback} — the parent location's population, only +#' when \code{allow_parent_pop_fallback = TRUE}. +#' } +#' +#' Ordering matters: the raster extraction is only treated as +#' \code{composite_union} when the geometry it ran on was a genuine child +#' union. When the composite fell back to its *parent's* polygon (step 6b), +#' extracting WorldPop on it returns the parent population, so that result is +#' classified as \code{parent_fallback} and is subject to the same gate. +#' Previously this path could install the parent population while presenting +#' it as a geometry-derived sub-area figure. +#' +#' @return list(data = normalized with composites resolved, +#' geometry = sf(lctn_pr, area_per_1km2, geometry) for composites, +#' or NULL when there are none). +build_composite_locations <- function(normalized, raw_sf, iso3, + raster_dir = NULL, + allow_parent_pop_fallback = FALSE) { + + iso3 <- toupper(regmatches(iso3, regexpr("[A-Z]{3}", iso3))) + + normalized <- normalized %>% + dplyr::mutate(location_period_id = as.character(location_period_id)) + + # 1. Identify composite rows ----------------------------------------------- + is_composite <- is.na(normalized$location_period_id) & + stringr::str_detect(normalized$location, "\\|") + + if (!any(is_composite)) { + return(list(data = apply_known_lp_fixes(normalized, iso3), geometry = NULL)) + } + + composite_names <- unique(normalized$location[is_composite]) + message("build_composite_locations(): ", length(composite_names), + " composite location(s) in ", iso3) + + # 2. De-composite names into child location strings ------------------------ + child_tbl <- decompose_composite_names(composite_names) + + # 3. Map child location -> location_period_id + pop (from atomic rows) ------ + loc_lookup <- normalized %>% + dplyr::filter(!is.na(location_period_id)) %>% + dplyr::distinct(location, location_period_id, pop) + + # Extend loc_lookup with dot-stripped country keys: "AFR::BDI.Burundi" is + # stored in normalized but the parent prefix derived from composite names is + # "AFR::BDI". Adding the stripped variant allows parent lookups to match. + loc_lookup_extended <- dplyr::bind_rows( + loc_lookup, + loc_lookup %>% + dplyr::mutate(location = sub("\\.[^:]+$", "", location)) %>% + dplyr::anti_join(loc_lookup, by = "location") + ) + + cp <- match_children_to_lps(child_tbl, loc_lookup) + + n_missing <- sum(is.na(cp$location_period_id)) + if (n_missing > 0L) { + miss <- unique(cp$location[is.na(cp$location_period_id)]) + message(" ", n_missing, " child location(s) had no atomic match: ", + paste(utils::head(miss, 5L), collapse = "; "), + if (length(miss) > 5L) " ..." else "") + } + + # 4. Assign composite ids --------------------------------------------------- + comp_ids <- data.frame( + composite_name = composite_names, + composite_id = paste0("composite_loc_", iso3, "_", seq_along(composite_names)), + stringsAsFactors = FALSE + ) + + # 5. Candidate population: sum of distinct matched child-LP populations ----- + # Held as a *candidate* only; precedence is resolved in step 6d once the + # geometry-derived value is known. + # + # sum(na.rm = TRUE) over a group whose children all have pop = NA returns + # 0, and a composite with no matched children at all is absent entirely. + # Both must surface as NA, never 0: get_outbreak_threshold() routes + # is.na(pop) to the "low" surveillance class, but pop == 0 gives + # sCh / pop == Inf, which classifies as "high". A zero denominator would + # therefore flip the detection threshold rather than merely be missing. + comp_pop_raw <- cp %>% + dplyr::filter(!is.na(location_period_id)) %>% + dplyr::distinct(composite_name, location_period_id, pop) %>% + dplyr::group_by(composite_name) %>% + dplyr::summarise( + child_sum_pop = if (all(is.na(pop))) NA_real_ else sum(pop, na.rm = TRUE), + .groups = "drop" + ) + + comp_pop <- comp_ids %>% + dplyr::select(composite_name, composite_id) %>% + dplyr::left_join(comp_pop_raw, by = "composite_name") %>% + dplyr::mutate( + child_sum_pop = dplyr::if_else(!is.na(child_sum_pop) & child_sum_pop <= 0, + NA_real_, child_sum_pop) + ) + + # 6. Composite geometry: union of matched child geometries (sf left table) -- + geom_lookup <- raw_sf %>% + dplyr::mutate(location_period_id = as.character(location_period_id)) %>% + dplyr::filter(!is.na(location_period_id)) %>% + dplyr::group_by(location_period_id) %>% + dplyr::slice(1L) %>% + dplyr::ungroup() %>% + sf::st_make_valid() + + child_lp_map <- cp %>% + dplyr::filter(!is.na(location_period_id)) %>% + dplyr::mutate(location_period_id = as.character(location_period_id)) %>% + dplyr::distinct(composite_name, location_period_id) %>% + dplyr::left_join(comp_ids, by = "composite_name") + + # geom_lookup is sf (left table) → result is sf with geometry + composite_geom <- geom_lookup %>% + dplyr::inner_join(child_lp_map, by = "location_period_id") %>% + dplyr::filter(!sf::st_is_empty(geometry)) %>% + dplyr::group_by(composite_id) %>% + dplyr::summarise(geometry = sf::st_union(geometry), .groups = "drop") %>% + dplyr::mutate( + lctn_pr = composite_id, + area_per_1km2 = as.numeric(sf::st_area( + sf::st_transform(geometry, "+proj=moll") + )) / 1e6 + ) %>% + dplyr::select(lctn_pr, area_per_1km2) + + # 6b. Parent-location geometry fallback for composites still without geom --- + parent_geom_ids <- character(0) + composites_with_geom <- composite_geom$lctn_pr # character(0) when 0 rows + needs_parent_geom <- comp_ids$composite_id[ + !comp_ids$composite_id %in% composites_with_geom + ] + + if (length(needs_parent_geom) > 0L) { + names_needing <- comp_ids$composite_name[ + comp_ids$composite_id %in% needs_parent_geom + ] + parent_lp_df <- data.frame( + composite_id = needs_parent_geom, + parent_location = vapply(names_needing, get_composite_parent, + character(1L)), + stringsAsFactors = FALSE + ) %>% + dplyr::filter(!is.na(parent_location)) %>% + dplyr::left_join( + dplyr::select(loc_lookup_extended, + parent_location = location, + location_period_id = location_period_id), + by = "parent_location" + ) %>% + dplyr::filter(!is.na(location_period_id)) %>% + dplyr::mutate(location_period_id = as.character(location_period_id)) %>% + dplyr::distinct(composite_id, location_period_id) + + if (nrow(parent_lp_df) > 0L) { + # geom_lookup is sf (left table) → inner_join keeps sf semantics + parent_geom <- geom_lookup %>% + dplyr::inner_join(parent_lp_df, by = "location_period_id") %>% + dplyr::filter(!sf::st_is_empty(geometry)) %>% + dplyr::mutate( + lctn_pr = composite_id, + area_per_1km2 = as.numeric(sf::st_area( + sf::st_transform(geometry, "+proj=moll") + )) / 1e6 + ) %>% + dplyr::select(lctn_pr, area_per_1km2) + + if (nrow(parent_geom) > 0L) { + message(" ", nrow(parent_geom), + " composite(s) using parent geometry as fallback.") + composite_geom <- rbind(composite_geom, parent_geom) + # Record which composites are standing on their parent's polygon. A + # raster extraction over such a geometry returns the PARENT's + # population, not the composite's, so it must not be presented as a + # geometry-derived sub-area denominator (step 6c/6d). + parent_geom_ids <- unique(parent_geom$lctn_pr) + } + } + } + + if (nrow(composite_geom) > 0L) { + sf::st_crs(composite_geom) <- sf::st_crs(raw_sf) + } else { + composite_geom <- NULL + } + + # 6c. Geometry-derived population (primary source when raster_dir given) ---- + # Estimate each composite's population directly from WorldPop on its + # (child-union or parent-fallback) geometry. This is the true sub-area + # denominator; it overrides the summed-child / parent-polygon pop from step 5 + # wherever the raster extraction resolves. Composites whose geometry could not + # be resolved keep the step-5 fallback pop. + if (!is.null(raster_dir) && !is.null(composite_geom) && + nrow(composite_geom) > 0L) { + + # Representative year per composite = median year(TL) over its rows. + comp_year <- normalized %>% + dplyr::filter(location %in% comp_ids$composite_name) %>% + dplyr::left_join(comp_ids, by = c("location" = "composite_name")) %>% + dplyr::group_by(composite_id) %>% + dplyr::summarise( + year = as.integer(stats::median(lubridate::year(TL))), + .groups = "drop" + ) + + geom_years <- data.frame(lctn_pr = composite_geom$lctn_pr, + stringsAsFactors = FALSE) %>% + dplyr::left_join(comp_year, by = c("lctn_pr" = "composite_id")) + geom_years$year[is.na(geom_years$year)] <- + as.integer(stats::median(geom_years$year, na.rm = TRUE)) + + geom_pop_vals <- tryCatch( + estimate_pop_for_geometries( + geom_sf = composite_geom, + country_iso3 = iso3, + year = geom_years$year, + raster_dir = raster_dir + ), + error = function(e) { + message(" build_composite_locations(): geometry-derived pop failed (", + conditionMessage(e), ") — keeping summed-child/parent pop.") + rep(NA_real_, nrow(composite_geom)) + } + ) + + geom_pop_df <- comp_ids %>% + dplyr::left_join( + data.frame(composite_id = composite_geom$lctn_pr, + geom_pop = as.numeric(geom_pop_vals), + stringsAsFactors = FALSE), + by = "composite_id" + ) %>% + dplyr::select(composite_name, geom_pop) + + # Split the raster result by what polygon it actually ran on. Only a child + # union is a genuine sub-area denominator; a parent polygon yields the + # parent's population and is gated with the other parent fallbacks. + comp_pop <- comp_pop %>% + dplyr::left_join(geom_pop_df, by = "composite_name") %>% + dplyr::mutate( + geom_pop = dplyr::if_else(!is.na(geom_pop) & geom_pop <= 0, + NA_real_, geom_pop), + union_pop = dplyr::if_else(composite_id %in% parent_geom_ids, + NA_real_, geom_pop), + parent_geom_pop = dplyr::if_else(composite_id %in% parent_geom_ids, + geom_pop, NA_real_) + ) %>% + dplyr::select(-geom_pop) + + n_union <- sum(!is.na(comp_pop$union_pop)) + if (n_union > 0L) + message(" ", n_union, + " composite(s) using WorldPop-on-child-union as population ", + "(true sub-area denominator).") + n_pgeom <- sum(!is.na(comp_pop$parent_geom_pop)) + if (n_pgeom > 0L) + message(" ", n_pgeom, + " composite(s) had only parent geometry — the raster value is a ", + "parent population, not a sub-area one.") + } else { + comp_pop$union_pop <- NA_real_ + comp_pop$parent_geom_pop <- NA_real_ + } + + # 6d. Parent-location population candidate -------------------------------- + parent_pop_lookup <- data.frame( + composite_name = comp_pop$composite_name, + parent_location = vapply(comp_pop$composite_name, get_composite_parent, + character(1L)), + stringsAsFactors = FALSE + ) %>% + dplyr::left_join( + dplyr::select(loc_lookup_extended, + parent_location = location, + parent_pop = pop), + by = "parent_location" + ) %>% + dplyr::distinct(composite_name, .keep_all = TRUE) %>% + dplyr::select(composite_name, parent_pop) + + comp_pop <- comp_pop %>% + dplyr::left_join(parent_pop_lookup, by = "composite_name") %>% + dplyr::mutate( + parent_pop = dplyr::coalesce(parent_pop, parent_geom_pop), + parent_pop = dplyr::if_else(!is.na(parent_pop) & parent_pop <= 0, + NA_real_, parent_pop) + ) + + # 6e. Resolve precedence: child union > child sum > parent (gated) --------- + comp_pop <- comp_pop %>% + dplyr::mutate( + composite_pop = dplyr::case_when( + !is.na(union_pop) ~ union_pop, + !is.na(child_sum_pop) ~ child_sum_pop, + allow_parent_pop_fallback & !is.na(parent_pop) ~ parent_pop, + TRUE ~ NA_real_ + ), + composite_pop_source = dplyr::case_when( + !is.na(union_pop) ~ "composite_union", + !is.na(child_sum_pop) ~ "child_sum", + allow_parent_pop_fallback & !is.na(parent_pop) ~ "parent_fallback", + TRUE ~ "none" + ) + ) + + n_blocked <- sum(comp_pop$composite_pop_source == "none" & + !is.na(comp_pop$parent_pop)) + if (n_blocked > 0L) { + message(" ", n_blocked, " composite(s) could have inherited a parent ", + "population but allow_parent_pop_fallback = FALSE — pop left NA ", + "(they will fall into the 'low' surveillance class).") + } + n_none <- sum(comp_pop$composite_pop_source == "none") + if (n_none > 0L) { + message(" ", n_none, " composite(s) have no population from any source.") + } + + comp_pop <- dplyr::select(comp_pop, -union_pop, -parent_geom_pop, + -parent_pop, -child_sum_pop) + + # 7. Rewrite composite rows in the normalized data ------------------------- + data_out <- normalized %>% + dplyr::left_join(comp_ids, by = c("location" = "composite_name")) %>% + dplyr::left_join( + dplyr::select(comp_pop, composite_name, composite_pop, + composite_pop_source), + by = c("location" = "composite_name") + ) %>% + dplyr::mutate( + location_period_id = dplyr::coalesce(composite_id, location_period_id), + pop = dplyr::if_else(!is.na(composite_id), composite_pop, pop), + # 8. Tag spatial_scale for composite rows. + spatial_scale = dplyr::if_else( + !is.na(composite_id), + paste(as.character(spatial_scale), "composite"), + as.character(spatial_scale) + ) + ) + + # Composite rows carry their own population provenance; atomic rows keep the + # pop_source that add_population() assigned. + if ("pop_source" %in% names(data_out)) { + data_out <- data_out %>% + dplyr::mutate( + pop_source = dplyr::if_else(!is.na(composite_id), + composite_pop_source, pop_source) + ) + } else { + data_out <- data_out %>% + dplyr::mutate(pop_source = dplyr::if_else(!is.na(composite_id), + composite_pop_source, + NA_character_)) + } + + data_out <- dplyr::select(data_out, -composite_id, -composite_pop, + -composite_pop_source) + + # 9. Known atomic-LP corrections (SSD/SOM only) ---------------------------- + data_out <- apply_known_lp_fixes(data_out, iso3) + + list(data = data_out, geometry = composite_geom) +} + +# Internal: hardcoded location_period_id corrections carried over from +# Step2_Extract_outbreak.R:199-211. These are atomic-LP fixes (not composite +# logic) and only affect SSD/SOM, so they are a no-op elsewhere. +apply_known_lp_fixes <- function(df, iso3) { + if (!iso3 %in% c("SSD", "SOM")) return(df) + df %>% + dplyr::mutate(location_period_id = dplyr::case_when( + location == "AFR::SSD::Unity::Rubkona" ~ "5624", + location == "AFR::SSD::Upper Nile::Renk" ~ "7859", + location == "EMR::SOM::Hiiraan" ~ "9373", + TRUE ~ location_period_id + )) +} diff --git a/R/clean_psql_data.R b/R/clean_psql_data.R index 81c8930..d1ef8eb 100644 --- a/R/clean_psql_data.R +++ b/R/clean_psql_data.R @@ -6,8 +6,39 @@ clean_psql_data <- function( original_data,... ){ - - library(tidyverse) + + + # --------------------------------------------------------------------------- + # Normalize taxdat API column names to OutbreakExtractR conventions. + # taxdat::rename_database_fields(source = "api") produces different column + # names than a direct psql export. This block maps either naming convention + # to the names expected by the rest of this function, making it compatible + # with both data sources. + # + # API names -> OutbreakExtractR names + # is_primary -> primary + # locationPeriod_id -> location_period_id + # OC_UID -> observation_collection_id + # location_name -> location + # attributes.fields.suspected_cases -> sCh + # attributes.fields.confirmed_cases -> cCh + # attributes.fields.deaths -> deaths + # --------------------------------------------------------------------------- + col_map <- c( + primary = "is_primary", + location_period_id = "locationPeriod_id", + observation_collection_id = "OC_UID", + location = "location_name", + sCh = "attributes.fields.suspected_cases", + cCh = "attributes.fields.confirmed_cases", + deaths = "attributes.fields.deaths" + ) + for (new_name in names(col_map)) { + old_name <- col_map[[new_name]] + if (old_name %in% names(original_data) && !new_name %in% names(original_data)) { + original_data <- dplyr::rename(original_data, !!new_name := !!old_name) + } + } # clean the location names (keep updated) # clean and add descriptive columns @@ -19,10 +50,18 @@ clean_psql_data <- function( TL = lubridate::ymd(TL), TR = lubridate::ymd(TR), primary = dplyr::case_when( - primary == "f" ~ FALSE, + is.logical(primary) ~ as.logical(primary), # API source: already TRUE/FALSE + primary == "f" ~ FALSE, # psql source: "f"/"t" strings primary == "t" ~ TRUE) ) %>% - dplyr::filter(primary) %>% ## always only keep primary data + ## Keep primary data, but retain composite locations ("|"-joined names) that + ## only ever appear as non-primary; otherwise they are silently dropped here, + ## before Stage 2 (e.g. SEN "AFR::SEN::Saint-Louis::Dagana::Mbane|Ross-Bethio", + ## which is primary = FALSE for every row). A composite that also has a + ## primary version still keeps only its primary rows (no double-counting). + dplyr::group_by(location) %>% + dplyr::filter(primary | (stringr::str_detect(location, "\\|") & !any(primary %in% TRUE))) %>% + dplyr::ungroup() %>% dplyr::mutate( date_range = TR-TL+1, temporal_scale = dplyr::case_when( diff --git a/R/detect_duplicate_geometries.R b/R/detect_duplicate_geometries.R new file mode 100644 index 0000000..9a6e7c7 --- /dev/null +++ b/R/detect_duplicate_geometries.R @@ -0,0 +1,114 @@ +#' @export +#' @title detect_duplicate_geometries +#' @name detect_duplicate_geometries +#' @description Identify location periods that share an identical polygon, and +#' classify why. +#' +#' The Cholera Taxonomy database stores a separate shape record per location +#' period, but the *content* of those records is sometimes duplicated: several +#' distinct location_period_ids, each with its own distinct shape id, resolve +#' to byte-identical geometry. \code{add_population()} then extracts the same +#' raster footprint for each of them and assigns them all the same population. +#' This is a defect in the source data, not in the join — every LP receives +#' the geometry the database associates with it. +#' +#' Not every duplicate is harmful, so the cluster is classified: +#' +#' \describe{ +#' \item{\code{unique}}{No other LP in the country shares this geometry.} +#' \item{\code{alias}}{All members sit at the same hierarchy depth and share +#' a base name once an ISO-style code prefix is stripped (e.g. +#' \code{GN-B::Fria} and \code{GN-B::GN-FR.Fria}). These are duplicate +#' records for one real place; the geometry is *correct*. They still +#' double-count if a consumer sums population across LPs.} +#' \item{\code{parent_inherited}}{Members span more than one hierarchy +#' depth, i.e. children carry their parent's polygon (e.g. the Conakry +#' region polygon on six Conakry sub-districts). Severe: each child is +#' assigned the whole parent population.} +#' \item{\code{cross_unit}}{Members sit at the same depth but have different +#' base names, i.e. genuinely distinct units share one polygon (e.g. +#' \code{Lagos::Shomolu} and \code{Nasarawa::Awe}). Severe: at least one +#' unit has an entirely wrong denominator.} +#' \item{\code{unknown}}{Duplicated, but no location names were supplied so +#' the cluster could not be classified.} +#' } +#' +#' @param lp_ids vector: location period identifiers, one per geometry. +#' @param geoms sfc or sf: geometries aligned with \code{lp_ids}. +#' @param lp_locations character or NULL: \code{::}-delimited location name per +#' LP, aligned with \code{lp_ids}. When NULL, duplicated clusters are class +#' \code{"unknown"}. +#' @return a tibble with columns \code{location_period_id}, +#' \code{pop_geom_dup_n} (size of the identical-geometry cluster; 1 means +#' unique) and \code{pop_geom_dup_class}. +detect_duplicate_geometries <- function(lp_ids, geoms, lp_locations = NULL) { + + n <- length(lp_ids) + if (n == 0L) { + return(dplyr::tibble(location_period_id = lp_ids, + pop_geom_dup_n = integer(0), + pop_geom_dup_class = character(0))) + } + + geoms_sfc <- if (inherits(geoms, "sf")) sf::st_geometry(geoms) else geoms + + # Geometry identity key. Empty geometries are never treated as duplicates of + # one another: they carry no footprint, so sharing "emptiness" says nothing. + wkt <- vapply(geoms_sfc, function(g) { + if (is.null(g)) return(NA_character_) + txt <- tryCatch(sf::st_as_text(g), error = function(e) NA_character_) + txt + }, character(1L)) + + empty <- is.na(wkt) | vapply(geoms_sfc, function(g) { + if (is.null(g)) return(TRUE) + isTRUE(tryCatch(sf::st_is_empty(sf::st_sfc(g)), error = function(e) TRUE)) + }, logical(1L)) + + if (requireNamespace("digest", quietly = TRUE)) { + key <- vapply(seq_len(n), function(i) { + if (empty[i]) NA_character_ else digest::digest(wkt[i]) + }, character(1L)) + } else { + key <- ifelse(empty, NA_character_, wkt) + } + + # Cluster size: NA keys (empty geometry) are always singletons. + dup_n <- rep(1L, n) + keyed <- which(!is.na(key)) + if (length(keyed) > 0L) { + tab <- table(key[keyed]) + dup_n[keyed] <- as.integer(tab[key[keyed]]) + } + + dup_class <- rep("unique", n) + + if (is.null(lp_locations)) { + dup_class[dup_n > 1L] <- "unknown" + } else { + depth <- lengths(strsplit(as.character(lp_locations), "::", fixed = TRUE)) + leaf <- vapply(strsplit(as.character(lp_locations), "::", fixed = TRUE), + function(p) if (length(p) == 0L) NA_character_ else p[length(p)], + character(1L)) + # "GN-FR.Fria" and "Fria" name the same unit under two conventions. + base <- tolower(trimws(sub("^[A-Za-z]{2}-[A-Za-z0-9]+\\.", "", leaf))) + + for (k in unique(key[keyed])) { + idx <- which(key == k & !is.na(key)) + if (length(idx) < 2L) next + dup_class[idx] <- if (dplyr::n_distinct(depth[idx]) > 1L) { + "parent_inherited" + } else if (dplyr::n_distinct(base[idx]) == 1L) { + "alias" + } else { + "cross_unit" + } + } + } + + dplyr::tibble( + location_period_id = lp_ids, + pop_geom_dup_n = dup_n, + pop_geom_dup_class = dup_class + ) +} diff --git a/R/fill_missing_lps.R b/R/fill_missing_lps.R index b19cca9..1633eaa 100644 --- a/R/fill_missing_lps.R +++ b/R/fill_missing_lps.R @@ -5,9 +5,9 @@ #' @param original_data dataframe with location, epiweek, TL, TR, sCh, cCh, deaths fill_missing_lps <- function(original_data){ - possible_to_fill_locs <- original_data %>% - dplyr::filter(is.na(location_period_id)) %>% - arrange(location, TR) + possible_to_fill_locs <- original_data %>% + dplyr::filter(is.na(location_period_id)) %>% + dplyr::arrange(location, TR) dictionary <- original_data %>% dplyr::select(location, location_period_id, TR) %>% @@ -18,30 +18,30 @@ fill_missing_lps <- function(original_data){ if(nrow(dictionary)>0){ message(paste("Some observations in these locations had missing LPs. They will be filled in with LPs from other observations in the same location:", paste(unique(possible_to_fill_locs$location), collapse = ", "))) - rc <- original_data %>% - arrange(location, TR) %>% - group_by(location) %>% - mutate( + rc <- original_data %>% + dplyr::arrange(location, TR) %>% + dplyr::group_by(location) %>% + dplyr::mutate( # Locate the closest previous and next non-NA location_period_id previous_id = zoo::na.locf(location_period_id, na.rm = FALSE), # Closest previous non-NA value next_id = zoo::na.locf(location_period_id, fromLast = TRUE, na.rm = FALSE), # Closest next non-NA value - + # Apply the logic to fill NA location_period_id based on closest previous and next values location_period_id = ifelse( is.na(location_period_id), - case_when( + dplyr::case_when( # If both previous and next location_period_id are the same, use that value previous_id == next_id ~ previous_id, - + # If previous and next are different, choose the one with the later TR !is.na(next_id) & (is.na(previous_id) | TR[match(next_id, location_period_id)] > TR[match(previous_id, location_period_id)]) ~ next_id, - + TRUE ~ previous_id ), location_period_id ) ) %>% - ungroup() %>% + dplyr::ungroup() %>% dplyr::select(-previous_id, -next_id) # Remove helper columns } else{ message("0 empty location periods were successfully filled in.") diff --git a/R/fill_phantom_zeroes.R b/R/fill_phantom_zeroes.R index dac237b..31d3632 100644 --- a/R/fill_phantom_zeroes.R +++ b/R/fill_phantom_zeroes.R @@ -5,14 +5,16 @@ #' @description Fill in weekly zeroes for sCh if no reporting between min(TL)- 8 weeks and max(TL)+ 8 weeks for that location #' @param original_data dataframe with location, epiweek, TL, TR, sCh, cCh, deaths fill_phantom_zeroes <- function(original_data){ - - if(length(unique(original_data$start_weekday))!=1){ - error("All observations should have the same start_weekday. Please run set_uniform_wday_start on this dataset.") + + if (nrow(original_data) == 0) return(original_data) + + if(length(unique(na.omit(original_data$start_weekday))) > 1){ + stop("All observations should have the same start_weekday. Please run set_uniform_wday_start on this dataset.") } else if(nrow(dplyr::distinct(original_data, location, TL) %>% dplyr::group_by(location, TL) %>% dplyr::add_count() %>% dplyr::filter(n>1)) > 1){ - error("There are overlapping weekly observations. Please run_average_duplicate_observations on this dataset.") + stop("There are overlapping weekly observations. Please run_average_duplicate_observations on this dataset.") } tmp_function <- function(df_original, loc){ diff --git a/R/get_country_boundary.R b/R/get_country_boundary.R new file mode 100644 index 0000000..ce46098 --- /dev/null +++ b/R/get_country_boundary.R @@ -0,0 +1,120 @@ +#' @export +#' @title get_country_boundary +#' @name get_country_boundary +#' @description Resolve a national boundary polygon for the UN population +#' adjustment factor, deterministically and without ever falling back to the +#' union of location-period geometries. +#' +#' The resolution ladder is: on-disk cache -> \code{rgeoboundaries::gb_adm0()} +#' -> \code{NULL}. There is deliberately no fourth step. A union of the +#' observed LP geometries is *not* a country boundary — it covers only the +#' surveilled sub-areas, so the raster total extracted on it is too small and +#' the resulting adjustment factor (\code{tot_UN / country_raw}) is inflated, +#' scaling every population in the country upward. Callers must treat +#' \code{NULL} as "skip the adjustment" (\code{adj_factor = 1.0}), which +#' leaves populations unadjusted rather than wrong. +#' +#' \code{rgeoboundaries} is an optional dependency (Suggests). It is checked +#' with \code{requireNamespace()} before use so that a missing package +#' produces a legible message instead of being swallowed by a +#' \code{tryCatch()} that cannot distinguish it from a network failure. +#' +#' @param country_iso3 character: ISO3 code, optionally with a sub-national +#' suffix (e.g. "TZA::Mainland"); the leading 3-letter code is extracted. +#' @param cache_dir character or NULL: directory for caching boundary GeoJSON. +#' When NULL, no cache is read or written. +#' @return an sf object with a single boundary geometry in EPSG:4326, or +#' \code{NULL} if the boundary could not be resolved. +get_country_boundary <- function(country_iso3, cache_dir = "country_boundaries") { + + iso3 <- regmatches(toupper(country_iso3), + regexpr("[A-Z]{3}", toupper(country_iso3))) + if (length(iso3) != 1L || is.na(iso3)) { + message("get_country_boundary(): could not extract an ISO3 code from '", + country_iso3, "' — returning NULL.") + return(NULL) + } + + # -- 1. Disk cache --------------------------------------------------------- + cache_file <- NULL + if (!is.null(cache_dir)) { + cache_file <- file.path(cache_dir, paste0(iso3, "_adm0.geojson")) + if (file.exists(cache_file)) { + cached <- tryCatch( + sf::st_transform(sf::st_read(cache_file, quiet = TRUE), 4326), + error = function(e) { + message("get_country_boundary(): cached boundary for ", iso3, + " unreadable (", conditionMessage(e), ") — refetching.") + NULL + } + ) + if (!is.null(cached) && nrow(cached) > 0L) return(cached) + } + } + + # -- 2. rgeoboundaries ----------------------------------------------------- + if (!requireNamespace("rgeoboundaries", quietly = TRUE)) { + message("get_country_boundary(): package 'rgeoboundaries' is not installed, ", + "so the boundary for ", iso3, " cannot be fetched. ", + "The UN adjustment will be skipped (adj_factor = 1.0). ", + "Install it to enable the adjustment.") + return(NULL) + } + + shp <- tryCatch( + sf::st_transform(rgeoboundaries::gb_adm0(country = iso3), 4326), + error = function(e) { + message("get_country_boundary(): gb_adm0() failed for ", iso3, ": ", + conditionMessage(e), + " — the UN adjustment will be skipped (adj_factor = 1.0).") + NULL + } + ) + if (is.null(shp) || nrow(shp) == 0L) return(NULL) + + # -- 3. Populate the cache ------------------------------------------------- + if (!is.null(cache_file)) { + tryCatch({ + dir.create(dirname(cache_file), recursive = TRUE, showWarnings = FALSE) + sf::st_write(shp, cache_file, quiet = TRUE, delete_dsn = TRUE) + }, error = function(e) { + message("get_country_boundary(): could not cache boundary for ", iso3, + ": ", conditionMessage(e)) + }) + } + + shp +} + + +#' @export +#' @title band_adj_factor +#' @name band_adj_factor +#' @description Apply the accept / flag / clamp banding to a UN population +#' adjustment factor. +#' +#' The observed corpus-wide range is 1.005-1.034, so any value far outside +#' 1.0 indicates that the raster total was extracted on the wrong polygon +#' rather than that the country genuinely disagrees with WPP. Rather than +#' propagate such a factor, extreme values are clamped to 1.0 (leaving the +#' population unadjusted) and flagged. +#' +#' @param adj_factor numeric: the raw \code{tot_UN / country_raw} ratio. +#' @return a list with \code{value} (the factor to use) and \code{flag}, one of +#' "ok", "wide", or "clamped". +band_adj_factor <- function(adj_factor) { + if (!is.finite(adj_factor) || adj_factor <= 0) { + return(list(value = 1.0, flag = "clamped")) + } + if (adj_factor >= 0.67 && adj_factor <= 1.5) { + return(list(value = adj_factor, flag = "ok")) + } + if (adj_factor >= 0.5 && adj_factor <= 2.0) { + message(" adj_factor ", signif(adj_factor, 4), + " is outside the expected band [0.67, 1.5] — accepted but flagged.") + return(list(value = adj_factor, flag = "wide")) + } + message(" adj_factor ", signif(adj_factor, 4), + " is outside [0.5, 2.0] — clamped to 1.0 (population left unadjusted).") + list(value = 1.0, flag = "clamped") +} diff --git a/R/get_outbreak_threshold.R b/R/get_outbreak_threshold.R index 4c123a7..9049894 100644 --- a/R/get_outbreak_threshold.R +++ b/R/get_outbreak_threshold.R @@ -63,10 +63,17 @@ get_outbreak_threshold <- function ( } - surveillance_data_threshold <- surveillance_data_threshold %>% - ungroup() %>% + surveillance_data_threshold <- surveillance_data_threshold %>% + ungroup() %>% mutate( - risk = ifelse(sCh/pop >= threshold & sCh>0, "high","low") + # When pop or threshold is NA (population lookup failed for this + # location), incidence cannot be computed — treat as "low" risk rather + # than propagating NA, which crashes downstream if() conditions. + risk = dplyr::case_when( + is.na(pop) | is.na(threshold) ~ "low", + sCh / pop >= threshold & sCh > 0 ~ "high", + TRUE ~ "low" + ) ) return(surveillance_data_threshold) diff --git a/R/get_pop.R b/R/get_pop.R index ae17a4b..c884a27 100644 --- a/R/get_pop.R +++ b/R/get_pop.R @@ -1,29 +1,70 @@ # Helper function -#' Download country-specific constrained world pop 100*100m raster (2015-2030) from the worldpop data repo: -#' @param country country iso code -#' @param year the year of the population raster -#' @param dest_dir folder name where the downloaded population raster will be saved -download_worldpop_constrained <- function(country, year, dest_dir = "worldpop") { - if (!dir.exists(dest_dir)) dir.create(dest_dir) - - out_file <- file.path( - dest_dir, - paste0(tolower(country), "_pop_", year, "_CN_100m_R2025A_v1.tif") - ) - - if (file.exists(out_file)) return(out_file) - - url <- paste0( - "https://data.worldpop.org/GIS/Population/Global_2015_2030/", - "R2025A/", year, "/", country, - "/v1/100m/constrained/", - tolower(country), "_pop_", year, "_CN_100m_R2025A_v1.tif" - ) - - message("Downloading WorldPop constrained raster: ", url) - curl::curl_download(url, out_file) - - return(out_file) +#' Download country-specific constrained WorldPop 100m raster (2015-2030). +#' +#' Tries releases in order (newest first): R2025A → R2024B. After each +#' download, reads one cell to verify the file is intact. Both releases use +#' standard LZW+PREDICTOR=2 compression readable by any GDAL version; the +#' fallback exists to handle interrupted or corrupted downloads (a partial +#' LZW stream produces "code not yet in table" / TIFFReadEncodedTile errors +#' indistinguishable from a codec problem). If R2025A is corrupt, its cached +#' file is deleted and R2024B is fetched fresh. +#' +#' @param country Country ISO3 code (upper-case). +#' @param year Population year (integer, 2015-2030). +#' @param dest_dir Directory for cached raster files. Created if absent. +#' @param releases Character vector of WorldPop release tags to try, in order. +download_worldpop_constrained <- function(country, year, dest_dir = "worldpop", + releases = c("R2025A", "R2024B")) { + if (!dir.exists(dest_dir)) dir.create(dest_dir, recursive = TRUE) + + for (release in releases) { + out_file <- file.path( + dest_dir, + paste0(tolower(country), "_pop_", year, "_CN_100m_", release, "_v1.tif") + ) + + if (!file.exists(out_file)) { + url <- paste0( + "https://data.worldpop.org/GIS/Population/Global_2015_2030/", + release, "/", year, "/", country, + "/v1/100m/constrained/", + tolower(country), "_pop_", year, "_CN_100m_", release, "_v1.tif" + ) + message("Downloading WorldPop (", release, "): ", url) + dl_ok <- tryCatch({ + curl::curl_download(url, out_file) + TRUE + }, error = function(e) { + message(" Download failed: ", conditionMessage(e)) + file.remove(out_file) # no-op (returns FALSE) if partial write did not occur + FALSE + }) + if (!dl_ok) next + } else { + message("Using cached WorldPop raster (", release, "): ", basename(out_file)) + } + + # Verify the raster is actually intact after download. + # Both releases use LZW+PREDICTOR=2 (universally supported), but a + # partial/interrupted download produces a truncated LZW stream that + # causes "code not yet in table" / TIFFReadEncodedTile failures at read + # time. Reading one block is the earliest point these errors surface. + readable <- tryCatch({ + r <- raster::raster(out_file) + suppressWarnings(raster::getValuesBlock(r, 1L, 1L, 1L, 1L)) + TRUE + }, error = function(e) { + message(" Raster unreadable (corrupted download?): ", + conditionMessage(e), + "\n Removing cached file and trying next release.") + file.remove(out_file) + FALSE + }) + if (readable) return(out_file) + } + + stop("All WorldPop releases failed for ", country, " year ", year, + ". Tried: ", paste(releases, collapse = ", ")) } #' Estimate Adjustment Factors for Population Data (for years >=2021, use the adjustment factors at 2020 instead) diff --git a/R/get_shp.R b/R/get_shp.R index 9fd1a7f..43d3be9 100644 --- a/R/get_shp.R +++ b/R/get_shp.R @@ -1,19 +1,40 @@ #' @export #' @title get_shp #' @name get_shp -#' @description this function is to extract shapefiles from -get_shp <- function (location_period_id,username=username,password=password,host="db.cholera-taxonomy.middle-distance.com",port=5432,dbname='CholeraTaxonomy_production'){ - conn=DBI::dbConnect( +#' @description this function is to extract shapefiles from the Cholera Taxonomy +#' database. Optionally saves the result as a GeoParquet file. +#' @param location_period_id numeric: the location period ID to retrieve +#' @param username character: PostgreSQL username +#' @param password character: PostgreSQL password +#' @param host character: database host +#' @param port integer: database port +#' @param dbname character: database name +#' @param output_parquet character: optional file path to save result as +#' GeoParquet (requires sfarrow package). If NULL, no file is written. +#' @return sf object with the shapefile geometry +get_shp <- function(location_period_id, username, password, + host = "db.cholera-taxonomy.middle-distance.com", + port = 5432, dbname = "CholeraTaxonomy_production", + output_parquet = NULL) { + conn <- DBI::dbConnect( RPostgres::Postgres(), - user= username, + user = username, password = password, host = host, - port = 5432, + port = port, dbname = dbname ) - qsql_code=paste0("select geojson from geojsons where location_period_id = ",location_period_id,';') - sql_query=DBI::dbSendQuery(conn,glue::glue_sql(.con=conn, qsql_code)) - shp=sf::st_read(DBI::dbFetch(sql_query)) + on.exit(DBI::dbDisconnect(conn)) + + qsql_code <- paste0("select geojson from geojsons where location_period_id = ", + location_period_id, ";") + sql_query <- DBI::dbSendQuery(conn, glue::glue_sql(.con = conn, qsql_code)) + shp <- sf::st_read(DBI::dbFetch(sql_query)) shp$lctn_pr <- location_period_id + + if (!is.null(output_parquet)) { + dir.create(dirname(output_parquet), recursive = TRUE, showWarnings = FALSE) + sfarrow::st_write_parquet(shp, output_parquet) + } return(shp) } diff --git a/R/identify_epidemic_start.R b/R/identify_epidemic_start.R index 7008d12..9822b76 100644 --- a/R/identify_epidemic_start.R +++ b/R/identify_epidemic_start.R @@ -40,7 +40,7 @@ identify_epidemic_start <- function( } } else { for (idx in 1:(nrow(outbreak_data_with_epistart)-min_weeks_above+1)) { - if(all(outbreak_data_with_epistart$risk[idx:(idx+min_weeks_above-1)] == "high")){ + if(isTRUE(all(outbreak_data_with_epistart$risk[idx:(idx+min_weeks_above-1)] == "high"))){ outbreak_data_with_epistart$epidemic_start[idx] = TRUE } } diff --git a/R/identify_epidemic_tail.R b/R/identify_epidemic_tail.R index a130a3a..7e3da0d 100644 --- a/R/identify_epidemic_tail.R +++ b/R/identify_epidemic_tail.R @@ -16,7 +16,7 @@ identify_epidemic_tail <- function ( tail_position <- rle(tail_vector) - if(any(tail_position$lengths[tail_position$values==1] >= tail_period)){ + if(isTRUE(any(tail_position$lengths[tail_position$values==1] >= tail_period))){ tail_position_table <- data.frame( values = tail_position$values, lengths = tail_position$lengths, diff --git a/R/identify_outbreaks.R b/R/identify_outbreaks.R index 41ec621..dac0c7d 100644 --- a/R/identify_outbreaks.R +++ b/R/identify_outbreaks.R @@ -1,5 +1,20 @@ # Function to identify outbreaks +# Internal helper (not exported): zero out outbreak_number for any outbreak whose +# total cases (summed over the full numbered outbreak window) fall below +# min_total_cases. +filter_small_outbreaks <- function(df, min_total_cases) { + small <- df %>% + dplyr::filter(outbreak_number > 0) %>% + dplyr::group_by(outbreak_number) %>% + dplyr::summarise(total = sum(sCh, na.rm = TRUE), .groups = "drop") %>% + dplyr::filter(total < min_total_cases) %>% + dplyr::pull(outbreak_number) + if (length(small) > 0) + df$outbreak_number[df$outbreak_number %in% small] <- 0 + df +} + #' @title identify_outbreaks #' @param threahold_type: character: 1. fixed threshold: a fixed value as outbreak threshold. 2. mean weekly incidence: use the mean weekly incidence as the outbreak threshold. 3. outbreak_dependent threshold: use the mean weekly cholera incidence for the first three weeks as the threshold for that outbreak @@ -8,6 +23,9 @@ #' @param zero_case_assumption: logic: whether to assume weeks without reports have zero case #' @param customized_TL: customize the lower bound of time for outbreak estimation #' @param customized_TR: customize the upper bound of time for outbreak estimation +#' @param cumulative_min_cases: numeric: minimum cumulative cases. Used by the dual_window cumulative trigger and, when \code{filter_outbreaks_by_size = TRUE}, as the minimum total-case threshold for the post-detection size filter. +#' @param filter_outbreaks_by_size: logical: when TRUE, drop detected outbreaks whose total cases (summed over the full outbreak window) fall below \code{cumulative_min_cases}. Default FALSE (no filtering, backward compatible). +#' @param keep_nonoutbreak_locations: logical: when TRUE, locations that never trigger an epidemic start are returned as their full time series labelled \code{outbreak_number = 0} and \code{`Time Period` = "non-outbreak period"}, instead of an empty data.frame. Use this to retain every location in the output rather than silently dropping those without a detected outbreak. Default FALSE (backward compatible). #' @export #' @return list of dataframes @@ -17,7 +35,7 @@ identify_outbreaks <- function( zero_case_assumption = T, customized_TL = NULL, customized_TR = NULL, - outbreak_start_definition = c("consecutive","dual_window"), + outbreak_start_definition = c("consecutive","dual_window"), min_weeks_above = 2, require_increasing_trend = FALSE, window_weeks = window_weeks, @@ -27,16 +45,18 @@ identify_outbreaks <- function( use_cumulative_trigger=use_cumulative_trigger, cumulative_min_cases=cumulative_min_cases, nonzero_windows = nonzero_windows, - tail_period =6 + tail_period =6, + filter_outbreaks_by_size = FALSE, + keep_nonoutbreak_locations = FALSE ){ - + # Identify cholera outbreak thresholds original_data_threshold <- OutbreakExtractR::get_outbreak_threshold( threshold_type = threshold_type, surveillance_data = original_data, zero_case_assumption = zero_case_assumption, - customized_TL, - customized_TR) + customized_TL = customized_TL, + customized_TR = customized_TR) # Create an empty list to store outbreaks outbreak_list <- vector(mode = 'list', length = length(unique(original_data_threshold$location))) @@ -75,8 +95,8 @@ identify_outbreaks <- function( data_between_epidemic_start = preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[idx]:epidemic_start_row_idx[idx+1],] if(any(data_between_epidemic_start$epidemic_tail) & nrow(data_between_epidemic_start)>=tail_period+2){ outbreak_end = min(as.numeric(data_between_epidemic_start[data_between_epidemic_start$epidemic_tail,]$row_idx)) - preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[idx]:as.numeric(as.numeric(outbreak_end)+2-1),]$outbreak_number = - min(outbreak_number_idx,preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[idx]:as.numeric(as.numeric(outbreak_end)+2-1),]$outbreak_number[preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[idx]:as.numeric(as.numeric(outbreak_end)+2-1),]$outbreak_number>0]) + preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[idx]:as.numeric(as.numeric(outbreak_end)+tail_period-1),]$outbreak_number = + min(outbreak_number_idx,preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[idx]:as.numeric(as.numeric(outbreak_end)+tail_period-1),]$outbreak_number[preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[idx]:as.numeric(as.numeric(outbreak_end)+tail_period-1),]$outbreak_number>0]) outbreak_number_idx = outbreak_number_idx +1 } else { preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[idx]:epidemic_start_row_idx[idx+1],]$outbreak_number = @@ -91,28 +111,55 @@ identify_outbreaks <- function( if(last_epidemic_start$outbreak_number>0){ final_outbreak_number = last_epidemic_start$outbreak_number after_last_epidemi_start = preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[length(epidemic_start_row_idx)]:nrow(preoutbreak_by_location_start_end_washout),] - last_outbreak_end_idx = min(as.numeric(after_last_epidemi_start[after_last_epidemi_start$epidemic_tail,]$row_idx)) - preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[length(epidemic_start_row_idx)]:(last_outbreak_end_idx+2-1),]$outbreak_number = last_epidemic_start$outbreak_number + # Guard: if no epidemic_tail exists after the last start (outbreak extends + # to the end of the window), fall back to the last row index. + if(any(after_last_epidemi_start$epidemic_tail)){ + last_outbreak_end_idx = min(as.numeric(after_last_epidemi_start[after_last_epidemi_start$epidemic_tail,]$row_idx)) + } else { + last_outbreak_end_idx = nrow(preoutbreak_by_location_start_end_washout) + } + end_idx = min(as.numeric(last_outbreak_end_idx) + tail_period - 1, + nrow(preoutbreak_by_location_start_end_washout)) + preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[length(epidemic_start_row_idx)]:end_idx,]$outbreak_number = last_epidemic_start$outbreak_number } else { #there's only one outbreak start (one potential outbreak) data_between_epidemic_start = preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[length(epidemic_start_row_idx)]:nrow(preoutbreak_by_location_start_end_washout),] if(any(data_between_epidemic_start$epidemic_tail)){ outbreak_end = min(as.numeric(data_between_epidemic_start[data_between_epidemic_start$epidemic_tail,]$row_idx)) - preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[length(epidemic_start_row_idx)]:as.numeric(as.numeric(outbreak_end)+2-1),]$outbreak_number = - min(outbreak_number_idx,preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[length(epidemic_start_row_idx)]:as.numeric(as.numeric(outbreak_end)+2-1),]$outbreak_number[preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[length(epidemic_start_row_idx)]:as.numeric(as.numeric(outbreak_end)+2-1),]$outbreak_number>0]) + preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[length(epidemic_start_row_idx)]:as.numeric(as.numeric(outbreak_end)+tail_period-1),]$outbreak_number = + min(outbreak_number_idx,preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[length(epidemic_start_row_idx)]:as.numeric(as.numeric(outbreak_end)+tail_period-1),]$outbreak_number[preoutbreak_by_location_start_end_washout[epidemic_start_row_idx[length(epidemic_start_row_idx)]:as.numeric(as.numeric(outbreak_end)+tail_period-1),]$outbreak_number>0]) outbreak_number_idx = outbreak_number_idx +1 } } - preoutbreak_by_location_start_end_washout <- preoutbreak_by_location_start_end_washout %>% + # Post-detection size filter: drop outbreaks whose total cases (summed over + # the full outbreak window) fall below cumulative_min_cases. Applied before + # the Time Period labelling so dropped outbreaks become "non-outbreak period". + if (isTRUE(filter_outbreaks_by_size) && !is.null(cumulative_min_cases)) { + preoutbreak_by_location_start_end_washout <- + filter_small_outbreaks(preoutbreak_by_location_start_end_washout, + cumulative_min_cases) + } + + preoutbreak_by_location_start_end_washout <- preoutbreak_by_location_start_end_washout %>% mutate(`Time Period` = ifelse( outbreak_number>0, "outbreak period", "non-outbreak period" - )) %>% + )) %>% mutate( `Time Period` = factor(`Time Period`,levels =c("outbreak period",'non-outbreak period')) ) + } else if (isTRUE(keep_nonoutbreak_locations) && + nrow(preoutbreak_by_location_start_end_washout) > 0) { + # No epidemic start for this location. Rather than dropping it, keep the + # full series labelled as a non-outbreak period so downstream consumers + # retain every location. Columns match the if-branch above. + preoutbreak_by_location_start_end_washout$outbreak_number <- 0 + preoutbreak_by_location_start_end_washout$`Time Period` <- factor( + "non-outbreak period", + levels = c("outbreak period", "non-outbreak period") + ) } else{ preoutbreak_by_location_start_end_washout <-data.frame() } diff --git a/R/resolve_composite_children.R b/R/resolve_composite_children.R new file mode 100644 index 0000000..66e62eb --- /dev/null +++ b/R/resolve_composite_children.R @@ -0,0 +1,187 @@ +# Directed per-child location-period + geometry retrieval for composite +# locations. +# +# A "composite location" is a surveillance observation whose location name joins +# several admin units with "|" (e.g. "AFR::SEN::Saint-Louis::Dagana::Mbane|Ross-Bethio"). +# The Cholera Taxonomy `by_location` API returns such observations with +# location_period_id = NA and no geometry, so their constituent children carry no +# shape in the country-wide pull. build_composite_locations() therefore cannot +# always reconstruct a composite from atomic rows already present in the country +# pull (the children may never be observed atomically, or only under a different +# vocabulary such as " Sanitary District"). +# +# resolve_composite_children() makes a *directed* per-child API call: for every +# unique child location string it queries the API for that child alone and keeps +# the child's own location_period_id + polygon geometry when the API returns one. +# The resulting child LP/geometry can then be fed to build_composite_locations() +# (via raw_sf / a child-LP lookup) so previously-unresolved composites recover a +# real child-union geometry. +# +# The default time window is deliberately WIDE (2000-01-01 -> 2024-12-31): +# composites and their children frequently sit in early years (e.g. SEN's only +# composite is ~2002-2010), so a narrow detection window would miss them. The API +# requires a date range, so an unbounded pull is not possible. +# +# The pull function is injected (pull_fn) so the function is unit-testable without +# any network access, and each child pull is wrapped in tryCatch() so a single +# failing / empty child never aborts the whole batch. Optionally, a cache_dir +# memoizes each child's raw pull to a window-independent key so repeated runs +# (and overlapping detection windows) do not re-hit the API. + +# Internal: an empty child-LP sf with the canonical schema. +empty_child_lp_sf <- function() { + sf::st_sf( + location = character(0L), + location_period_id = character(0L), + geometry = sf::st_sfc(crs = 4326L) + ) +} + +# Internal: sanitize a location string into a filesystem-safe cache key. +child_cache_key <- function(child_location) { + key <- gsub("[^A-Za-z0-9]+", "_", child_location) + key <- gsub("^_+|_+$", "", key) + paste0("raw_api_cache_child_", key, ".rds") +} + +# Internal: resolve a single child location to its (location, LP, geometry) rows. +# Returns an sf with the canonical schema (possibly 0 rows). Never throws. +resolve_one_child <- function(child_location, time_left, time_right, + api_user, api_key, pull_fn, cache_dir, + location_prefix) { + raw <- NULL + + cache_file <- if (!is.null(cache_dir)) { + file.path(cache_dir, child_cache_key(child_location)) + } else { + NULL + } + + if (!is.null(cache_file) && file.exists(cache_file)) { + raw <- tryCatch(readRDS(cache_file), error = function(e) NULL) + } + + if (is.null(raw)) { + raw <- tryCatch( + pull_fn( + username = api_user, + api_key = api_key, + locations = paste0(location_prefix, child_location), + time_left = time_left, + time_right = time_right + ), + error = function(e) { + message(" resolve_composite_children(): child pull failed for ", + child_location, " -- ", conditionMessage(e)) + NULL + } + ) + if (!is.null(raw) && !is.null(cache_file)) { + tryCatch(saveRDS(raw, cache_file), error = function(e) NULL) + } + } + + if (is.null(raw) || !inherits(raw, "sf") || nrow(raw) == 0L) { + return(empty_child_lp_sf()) + } + + # Locate the LP-id column (API naming) robustly. + lp_col <- intersect( + c("attributes.location_period_id", "location_period_id"), + names(raw) + )[1] + if (is.na(lp_col)) return(empty_child_lp_sf()) + + raw$.lp <- as.character(raw[[lp_col]]) + + # Keep only rows with a real LP and a real (dimension-2) polygon. + dims <- suppressWarnings(sf::st_dimension(sf::st_geometry(raw))) + keep <- !is.na(raw$.lp) & !is.na(dims) & dims == 2L + raw <- raw[keep, , drop = FALSE] + if (nrow(raw) == 0L) return(empty_child_lp_sf()) + + # One row per distinct LP (deterministic: lowest id first). + raw <- raw[order(raw$.lp), , drop = FALSE] + raw <- raw[!duplicated(raw$.lp), , drop = FALSE] + + sf::st_sf( + location = rep(child_location, nrow(raw)), + location_period_id = raw$.lp, + geometry = sf::st_geometry(raw) + ) +} + +#' @export +#' @title resolve_composite_children +#' @name resolve_composite_children +#' @description Make a directed per-child Cholera Taxonomy API call for every +#' constituent child of a set of composite ("|"-joined) location names, and +#' return each child's own location_period_id and polygon geometry. Intended +#' for the Batch 1 pull step: the resulting child LP/geometry lets Stage 2 +#' \code{build_composite_locations()} reconstruct composites whose children are +#' not observed atomically in the country-wide pull. +#' @param composite_names character: composite location names (containing "|"). +#' Names are de-composited with \code{decompose_composite_names()} to obtain the +#' unique child location strings that are queried. +#' @param time_left,time_right Date: the (wide) pull window. Defaults to +#' 2000-01-01 .. 2024-12-31 because composites and their children often sit in +#' early years; the API requires a bounded range. +#' @param api_user,api_key character: API credentials. Default to the +#' \code{CHOLERA_API_USERNAME} / \code{CHOLERA_API_KEY} environment variables. +#' @param pull_fn function: the API pull function, injected for testability. +#' Must accept \code{username, api_key, locations, time_left, time_right} and +#' return an sf. Defaults to \code{taxdat::read_taxonomy_data_api}. +#' @param cache_dir character or NULL: if given, each child's raw pull is +#' memoized to a window-independent key in this directory (deduplicating across +#' overlapping windows and avoiding repeat API calls). +#' @param location_prefix character: prepended to each child location for the +#' API query (default "CT-World::"). +#' @return an sf keyed by location_period_id with columns +#' \code{location} (the queried child string), \code{location_period_id}, and +#' \code{geometry}. Returns a 0-row sf (canonical schema) when nothing resolves. +resolve_composite_children <- function(composite_names, + time_left = as.Date("2000-01-01"), + time_right = as.Date("2024-12-31"), + api_user = Sys.getenv("CHOLERA_API_USERNAME"), + api_key = Sys.getenv("CHOLERA_API_KEY"), + pull_fn = taxdat::read_taxonomy_data_api, + cache_dir = NULL, + location_prefix = "CT-World::") { + + composite_names <- unique(composite_names[!is.na(composite_names) & + grepl("\\|", composite_names)]) + if (length(composite_names) == 0L) return(empty_child_lp_sf()) + + children <- unique(decompose_composite_names(composite_names)$location) + children <- children[!is.na(children) & nzchar(children)] + if (length(children) == 0L) return(empty_child_lp_sf()) + + if (!is.null(cache_dir) && !dir.exists(cache_dir)) { + dir.create(cache_dir, recursive = TRUE, showWarnings = FALSE) + } + + resolved <- lapply(children, function(ch) { + tryCatch( + resolve_one_child( + child_location = ch, + time_left = time_left, + time_right = time_right, + api_user = api_user, + api_key = api_key, + pull_fn = pull_fn, + cache_dir = cache_dir, + location_prefix = location_prefix + ), + error = function(e) { + message(" resolve_composite_children(): failed to resolve ", ch, + " -- ", conditionMessage(e)) + empty_child_lp_sf() + } + ) + }) + + resolved <- Filter(function(x) !is.null(x) && nrow(x) > 0L, resolved) + if (length(resolved) == 0L) return(empty_child_lp_sf()) + + do.call(rbind, resolved) +} diff --git a/R/validate_population.R b/R/validate_population.R new file mode 100644 index 0000000..e687875 --- /dev/null +++ b/R/validate_population.R @@ -0,0 +1,198 @@ +#' @export +#' @title validate_population +#' @name validate_population +#' @description Run the population quality gates over one country's +#' location-period populations and return a tidy per-gate report. +#' +#' The gates encode failure modes that were verified against the extraction +#' corpus rather than inferred from reading code, so their thresholds are +#' calibrated to observed behaviour. Gate 3's band, for instance, is loose +#' because the observed adjustment factors span only 1.005-1.034 — anything +#' far outside that indicates the raster total was extracted on the wrong +#' polygon, not a genuine disagreement with WPP. +#' +#' Default \code{on_fail = "warn"}. Gate 4 currently fails corpus-wide (many +#' location periods legitimately share geometry with an alias record), so +#' aborting by default would make a full re-extraction impossible. Use +#' \code{on_fail = "abort"} only for gates you have already driven to zero. +#' +#' @param lp_pop data.frame: one row per location period, with at least +#' \code{location_period_id} and \code{pop}. Optional columns +#' \code{location}, \code{pop_source}, \code{pop_geom_dup_n}, +#' \code{pop_geom_dup_class} and \code{adj_factor} enable additional gates. +#' @param iso3 character: ISO3 country code, recorded in the report. +#' @param on_fail character: "warn" (default) or "abort". +#' @param wpp_total numeric or NULL: the WPP2024 national total to compare +#' against. When NULL it is looked up from the bundled WPP2024 table using +#' the median \code{pop_year_raster} in \code{lp_pop}. +#' @return a tibble with one row per gate: \code{iso3}, \code{gate}, +#' \code{description}, \code{n_violations}, \code{n_checked}, \code{passed}, +#' and \code{detail} (a compact listing of offending location periods). +validate_population <- function(lp_pop, iso3, on_fail = c("warn", "abort"), + wpp_total = NULL) { + + on_fail <- match.arg(on_fail) + iso3 <- toupper(iso3) + + if (!"location_period_id" %in% names(lp_pop) || !"pop" %in% names(lp_pop)) { + stop("validate_population(): lp_pop must have location_period_id and pop columns.") + } + + # One row per location period. Population is a static per-LP attribute, so a + # weekly frame would otherwise inflate every violation count by the number of + # weeks observed. + lp <- lp_pop %>% + dplyr::filter(!is.na(location_period_id)) %>% + dplyr::group_by(location_period_id) %>% + dplyr::slice(1L) %>% + dplyr::ungroup() + + has <- function(col) col %in% names(lp) + report <- list() + + add_gate <- function(gate, description, violations, n_checked, + record_only = FALSE) { + ids <- as.character(violations) + report[[length(report) + 1L]] <<- dplyr::tibble( + iso3 = iso3, + # Character throughout: gates 5a/5b/7/8 are not integers, and a mixed + # integer/character column cannot be bound into one report. + gate = as.character(gate), + description = description, + n_violations = length(ids), + n_checked = n_checked, + passed = record_only | length(ids) == 0L, + record_only = record_only, + detail = if (length(ids) == 0L) NA_character_ else + paste(utils::head(ids, 20L), collapse = ", ") + ) + } + + # -- Gate 1: pop is finite and non-NA -------------------------------------- + # NA is the correct representation of "unknown"; this gate simply counts how + # much of the country lacks a denominator. + g1 <- lp$location_period_id[is.na(lp$pop) | !is.finite(lp$pop)] + add_gate(1L, "pop is present and finite", g1, nrow(lp)) + + # -- Gate 2: pop is never zero --------------------------------------------- + # A zero denominator is worse than a missing one: get_outbreak_threshold() + # sends is.na(pop) to the "low" surveillance class, but pop == 0 yields + # sCh/pop == Inf, which classifies as "high". Zero silently flips the + # detection threshold, so it must never be emitted. + g2 <- lp$location_period_id[!is.na(lp$pop) & lp$pop <= 0] + add_gate(2L, "pop is never zero or negative (zero flips the detection threshold)", + g2, nrow(lp)) + + # -- Gate 3: adjustment factor within a plausible band --------------------- + if (has("adj_factor")) { + g3 <- lp$location_period_id[!is.na(lp$adj_factor) & + (lp$adj_factor < 0.8 | lp$adj_factor > 1.5)] + add_gate(3L, "adj_factor within [0.8, 1.5] (observed corpus range 1.005-1.034)", + g3, sum(!is.na(lp$adj_factor))) + } + + # -- Gate 4: no two LPs share an identical geometry ------------------------ + # Broad net. Includes benign alias records, so this is expected to be + # non-zero; gates 5a/5b isolate the harmful subsets. + if (has("pop_geom_dup_n")) { + g4 <- lp$location_period_id[!is.na(lp$pop_geom_dup_n) & lp$pop_geom_dup_n > 1L] + add_gate(4L, "no two location periods share an identical geometry", + g4, nrow(lp)) + } + + # -- Gates 5a / 5b: the harmful duplicate classes -------------------------- + # Splitting these matters. A single "duplicate pop spanning >1 admin depth" + # gate catches only parent inheritance and misses same-depth cross-unit + # collisions entirely — and in the audited corpus the cross-unit class was + # the larger of the two. + if (has("pop_geom_dup_class")) { + g5a <- lp$location_period_id[lp$pop_geom_dup_class %in% "parent_inherited"] + add_gate("5a", "no child location period carries its parent's geometry", + g5a, nrow(lp)) + + g5b <- lp$location_period_id[lp$pop_geom_dup_class %in% "cross_unit"] + add_gate("5b", "no two distinct units at the same depth share one geometry", + g5b, nrow(lp)) + } + + # -- Gate 6: no LP exceeds the national total ------------------------------ + # Compare each LP's pop against ITS OWN pop_natl_ref (the year-specific WPP + # total for the year that LP's population was actually assigned), not a + # single corpus-wide scalar. A country's true national total grows across a + # multi-year extraction window (e.g. 2010-2024), so comparing every LP to + # one fixed reference year produces false positives on any LP assigned a + # later year, purely from population growth, not a defect. Caught on BDI's + # country-level LP: pop=12,404,228 (year 2020) was flagged against the + # corpus-wide median reference (11,506,762, pulled down by earlier-year + # LPs), while its own year's true national total was 12,617,036 -- pop was + # correctly below its own reference; there was no real violation. + # When the caller supplies `wpp_total` explicitly, honor it as a single + # fixed comparison value instead (their deliberate choice, applied to every + # LP uniformly). + if (!is.null(wpp_total) && is.finite(wpp_total) && wpp_total > 0) { + ref6 <- rep(wpp_total, nrow(lp)) + ref6_desc <- format(round(wpp_total), big.mark = ",") + } else if (has("pop_natl_ref")) { + ref6 <- lp$pop_natl_ref + ref6_desc <- "each LP's own year-specific national total" + } else { + ref6 <- NULL + } + + if (!is.null(ref6)) { + checked6 <- !is.na(lp$pop) & !is.na(ref6) & is.finite(ref6) & ref6 > 0 + g6 <- lp$location_period_id[checked6 & lp$pop > ref6] + add_gate(6L, sprintf("no location period exceeds the national total (%s)", ref6_desc), + g6, sum(checked6)) + } + + # -- Gate 7: country total within 30% of WPP (record only) ----------------- + # Record-only: the frame covers surveilled areas, not the whole country, so a + # shortfall is expected and is not by itself evidence of a defect. This is a + # corpus-wide aggregate check, so (unlike gate 6) a single reference value is + # the right comparison basis -- median pop_natl_ref across the LPs actually + # summed, or the caller-supplied wpp_total. + natl <- wpp_total + if (is.null(natl) && has("pop_natl_ref")) { + natl <- suppressWarnings(stats::median(lp$pop_natl_ref, na.rm = TRUE)) + } + if (!is.null(natl) && is.finite(natl) && natl > 0) { + observed <- sum(lp$pop, na.rm = TRUE) + ratio <- observed / natl + report[[length(report) + 1L]] <- dplyr::tibble( + iso3 = iso3, gate = "7", + description = "country sum vs WPP2024 national total", + n_violations = as.integer(!is.na(ratio) && (ratio < 0.7 || ratio > 1.3)), + n_checked = nrow(lp), passed = TRUE, record_only = TRUE, + detail = sprintf("sum=%s national=%s ratio=%.3f", + format(round(observed), big.mark = ","), + format(round(natl), big.mark = ","), ratio) + ) + } + + # -- Gate 8: pop_source composition (record only) -------------------------- + if (has("pop_source")) { + tab <- table(lp$pop_source, useNA = "ifany") + report[[length(report) + 1L]] <- dplyr::tibble( + iso3 = iso3, gate = "8", description = "population source composition", + n_violations = sum(lp$pop_source %in% "parent_fallback"), + n_checked = nrow(lp), passed = TRUE, record_only = TRUE, + detail = paste(names(tab), as.integer(tab), sep = "=", collapse = ", ") + ) + } + + out <- dplyr::bind_rows(report) + + failed <- out[!out$passed & !out$record_only, , drop = FALSE] + if (nrow(failed) > 0L) { + msg <- paste0( + "validate_population(): ", nrow(failed), " gate(s) failed for ", iso3, ":\n", + paste0(" gate ", failed$gate, ": ", failed$description, + " — ", failed$n_violations, "/", failed$n_checked, + " violation(s) [", failed$detail, "]", collapse = "\n") + ) + if (identical(on_fail, "abort")) stop(msg) else warning(msg, call. = FALSE) + } + + out +} diff --git a/R/verify_outbreak_definitions.R b/R/verify_outbreak_definitions.R new file mode 100644 index 0000000..ab3da30 --- /dev/null +++ b/R/verify_outbreak_definitions.R @@ -0,0 +1,549 @@ +#' @title verify_outbreak_definitions +#' @description Post-hoc verification that the output of +#' \code{\link{identify_outbreaks}()} is internally consistent with the +#' outbreak-definition parameters used to produce it. +#' +#' @details +#' The function accepts the list returned by \code{identify_outbreaks()} (or a +#' pre-bound dataframe) and runs the following checks, returning one tidy row +#' per check per location (or per outbreak, for outbreak-level checks): +#' +#' \strong{Location-level checks} +#' \describe{ +#' \item{\code{risk_classification_consistency}}{Every row: \code{risk == +#' "high"} iff \code{sCh > 0} and \code{sCh / pop >= threshold}.} +#' \item{\code{no_zero_case_epidemic_start}}{All \code{epidemic_start = TRUE} +#' rows have \code{sCh > 0}.} +#' \item{\code{epidemic_start_in_outbreak_period}}{Every epidemic start is +#' assigned a positive \code{outbreak_number}.} +#' \item{\code{consecutive_start_validity}}{(\code{consecutive} mode) Each +#' epidemic start begins a run of at least \code{min_weeks_above} +#' consecutive \code{"high"}-risk weeks.} +#' \item{\code{dual_window_start_validity}}{(\code{dual_window} mode) Each +#' epidemic start satisfies the sliding-window trigger, the cumulative +#' trigger, or both.} +#' \item{\code{epidemic_tail_validity}}{For every row where +#' \code{epidemic_tail = TRUE}, the subsequent \code{tail_period} +#' consecutive rows (including the flagged row itself) are all +#' \code{risk == "low"} and \code{epidemic_start == FALSE}.} +#' \item{\code{inter_outbreak_gap_weeks}}{The gap in weeks between +#' consecutive outbreak periods is at least \code{tail_period}. +#' One row per consecutive pair (\code{outbreak_number} column stores +#' \code{"k-k+1"}).} +#' } +#' +#' \strong{Outbreak-level checks (one row per location × outbreak_number)} +#' \describe{ +#' \item{\code{min_high_risk_weeks_per_outbreak}}{Each outbreak period +#' contains at least \code{min_weeks_above} high-risk weeks.} +#' \item{\code{cumulative_cases_at_start}}{The sum of \code{sCh} over the +#' first \code{cumulative_windows} weeks of the outbreak meets +#' \code{cumulative_min_cases}. Skipped when \code{cumulative_min_cases} +#' is \code{NULL}.} +#' \item{\code{outbreak_weekly_continuity}}{All consecutive week-start dates +#' within the outbreak are exactly 7 days apart (no internal gaps).} +#' \item{\code{tail_period_after_outbreak}}{After the last row of the +#' outbreak period, the immediately following non-outbreak weeks are all +#' low-risk. SKIP is returned when no data follows the outbreak.} +#' \item{\code{outbreak_summary}}{Informational (\code{status = "INFO"}): +#' total cases, duration in weeks, and peak weekly cases.} +#' } +#' +#' @param outbreak_list Named list of dataframes returned by +#' \code{\link{identify_outbreaks}()}, or a single dataframe produced by +#' \code{purrr::list_rbind(outbreak_list)}. +#' @param outbreak_start_definition \code{"consecutive"} (default) or +#' \code{"dual_window"}. +#' @param min_weeks_above Integer. Minimum consecutive / sliding-window +#' high-risk weeks required to trigger an epidemic start (default 2). +#' @param tail_period Integer. Consecutive below-threshold weeks required to +#' close an outbreak (default 6). +#' @param cumulative_min_cases Numeric or \code{NULL}. When non-NULL, each +#' outbreak's first \code{cumulative_windows} weeks must sum to at least this +#' many cases. Applies in any \code{outbreak_start_definition} mode. +#' @param cumulative_windows Integer. Width of the cumulative case window used +#' in \code{dual_window} mode and in the \code{cumulative_cases_at_start} +#' check (default 3). +#' @param window_weeks Integer. Width of the sliding high-risk-week window +#' (\code{dual_window} mode, default 3). +#' @param cumulative_case_threshold_ratio Numeric. Multiplier on +#' \code{threshold * pop} for the cumulative case trigger (default 1.5). +#' @param use_cumulative_trigger Logical. Whether the cumulative trigger is +#' active in \code{dual_window} mode (default \code{TRUE}). +#' @param cumulative_trigger_type Character. One of +#' \code{"cumulative_case_threshold"}, +#' \code{"cumulative_case_threshold_and_min_cases"}, or +#' \code{"cumulative_case_threshold_and_nonzero_weeks"}. +#' @param nonzero_windows Integer or \code{NULL}. Minimum non-zero-case weeks +#' in the cumulative window (used with +#' \code{"cumulative_case_threshold_and_nonzero_weeks"}). +#' +#' @return A \code{tibble} with columns: +#' \describe{ +#' \item{\code{location}}{Location string.} +#' \item{\code{outbreak_number}}{Outbreak identifier. \code{NA} for +#' location-level checks; a string like \code{"1-2"} for inter-outbreak +#' gap checks; a positive integer (as character) for outbreak-level +#' checks.} +#' \item{\code{check}}{Name of the verification check.} +#' \item{\code{status}}{\code{"PASS"}, \code{"FAIL"}, \code{"SKIP"}, or +#' \code{"INFO"}.} +#' \item{\code{value}}{Measured quantity for the check (e.g. number of +#' violations, total cases, gap in weeks).} +#' \item{\code{detail}}{Human-readable description of the result, including +#' specifics for failures.} +#' } +#' +#' @examples +#' \dontrun{ +#' # Run outbreak detection +#' outbreak_list <- identify_outbreaks( +#' threshold_type = "mean weekly incidence rate", +#' original_data = my_data, +#' outbreak_start_definition = "consecutive", +#' min_weeks_above = 2, +#' tail_period = 6 +#' ) +#' +#' # Verify the definitions were applied consistently +#' results <- verify_outbreak_definitions( +#' outbreak_list = outbreak_list, +#' outbreak_start_definition = "consecutive", +#' min_weeks_above = 2, +#' tail_period = 6, +#' cumulative_min_cases = 50 +#' ) +#' +#' # Inspect failures +#' results[results$status == "FAIL", ] +#' } +#' @export +verify_outbreak_definitions <- function( + outbreak_list, + outbreak_start_definition = c("consecutive", "dual_window"), + min_weeks_above = 2L, + tail_period = 6L, + cumulative_min_cases = NULL, + cumulative_windows = 3L, + window_weeks = 3L, + cumulative_case_threshold_ratio = 1.5, + use_cumulative_trigger = TRUE, + cumulative_trigger_type = c( + "cumulative_case_threshold", + "cumulative_case_threshold_and_min_cases", + "cumulative_case_threshold_and_nonzero_weeks" + ), + nonzero_windows = NULL +) { + outbreak_start_definition <- match.arg(outbreak_start_definition) + cumulative_trigger_type <- match.arg(cumulative_trigger_type) + min_weeks_above <- as.integer(min_weeks_above) + tail_period <- as.integer(tail_period) + cumulative_windows <- as.integer(cumulative_windows) + window_weeks <- as.integer(window_weeks) + + # --------------------------------------------------------------------------- + # Normalise input: accept list-of-dataframes or single bound dataframe + # --------------------------------------------------------------------------- + if (is.data.frame(outbreak_list)) { + df_all <- outbreak_list + } else { + df_all <- purrr::list_rbind( + purrr::keep(outbreak_list, \(x) is.data.frame(x) && nrow(x) > 0) + ) + } + + if (nrow(df_all) == 0) { + message("verify_outbreak_definitions: no data to verify — returning empty result.") + return(tibble::tibble( + location = character(), + outbreak_number = character(), + check = character(), + status = character(), + value = numeric(), + detail = character() + )) + } + + df_all <- df_all %>% + dplyr::mutate(TL = as.Date(TL), TR = as.Date(TR)) + + # --------------------------------------------------------------------------- + # Helper: build one result row + # --------------------------------------------------------------------------- + make_row <- function(location, + outbreak_number = NA_character_, + check, + status, + value = NA_real_, + detail = "") { + tibble::tibble( + location = as.character(location), + outbreak_number = as.character(outbreak_number), + check = as.character(check), + status = as.character(status), + value = as.numeric(value), + detail = as.character(detail) + ) + } + + # Pre-allocate result list (grows as needed) + results <- vector("list", 2000L) + ri <- 0L + push <- function(row) { ri <<- ri + 1L; results[[ri]] <<- row } + + # =========================================================================== + # Loop over locations + # =========================================================================== + for (loc in unique(df_all$location)) { + + d <- df_all %>% + dplyr::filter(location == loc) %>% + dplyr::arrange(TL) + + has_cols <- function(...) all(c(...) %in% names(d)) + + # ------------------------------------------------------------------------- + # CHECK 1 — risk_classification_consistency + # risk == "high" iff (sCh > 0) AND (sCh / pop >= threshold) + # ------------------------------------------------------------------------- + if (has_cols("sCh", "pop", "threshold", "risk")) { + computable <- !is.na(d$pop) & !is.na(d$threshold) & d$pop > 0 + d_c <- d[computable, ] + if (nrow(d_c) > 0) { + expected_risk <- dplyr::if_else( + d_c$sCh > 0 & (d_c$sCh / d_c$pop) >= d_c$threshold, + "high", "low" + ) + n_bad <- sum(d_c$risk != expected_risk, na.rm = TRUE) + push(make_row(loc, NA_character_, "risk_classification_consistency", + if (n_bad == 0) "PASS" else "FAIL", + n_bad, + if (n_bad == 0) + paste0("All ", nrow(d_c), " row(s) have risk labels consistent with ", + "sCh/pop >= threshold & sCh > 0.") + else + paste0(n_bad, " of ", nrow(d_c), + " row(s) have a risk label inconsistent with sCh/pop vs threshold. ", + "Check for population or threshold anomalies."))) + } + } + + # ------------------------------------------------------------------------- + # CHECK 2 — no_zero_case_epidemic_start + # All epidemic_start == TRUE rows must have sCh > 0 + # ------------------------------------------------------------------------- + if (has_cols("epidemic_start", "sCh")) { + starts <- d[d$epidemic_start %in% TRUE, ] + if (nrow(starts) > 0) { + n_zero <- sum(is.na(starts$sCh) | starts$sCh == 0) + push(make_row(loc, NA_character_, "no_zero_case_epidemic_start", + if (n_zero == 0) "PASS" else "FAIL", + n_zero, + if (n_zero == 0) + paste0("All ", nrow(starts), " epidemic start(s) have sCh > 0.") + else + paste0(n_zero, " of ", nrow(starts), + " epidemic start(s) have zero or missing case count (sCh == 0 or NA). ", + "Dates: ", + paste(head(as.character(starts$TL[is.na(starts$sCh) | starts$sCh == 0]), 5), + collapse = ", "), + if (n_zero > 5) " ..." else ""))) + } + } + + # ------------------------------------------------------------------------- + # CHECK 3 — epidemic_start_in_outbreak_period + # All epidemic_start == TRUE rows must have outbreak_number > 0 + # ------------------------------------------------------------------------- + if (has_cols("epidemic_start", "outbreak_number")) { + starts <- d[d$epidemic_start %in% TRUE, ] + if (nrow(starts) > 0) { + n_out <- sum(is.na(starts$outbreak_number) | starts$outbreak_number == 0) + push(make_row(loc, NA_character_, "epidemic_start_in_outbreak_period", + if (n_out == 0) "PASS" else "FAIL", + n_out, + if (n_out == 0) + "All epidemic starts are within a labeled outbreak period (outbreak_number > 0)." + else + paste0(n_out, " epidemic start(s) are not assigned to any outbreak period. ", + "Dates: ", + paste(head(as.character(starts$TL[is.na(starts$outbreak_number) | + starts$outbreak_number == 0]), 5), + collapse = ", "), + if (n_out > 5) " ..." else ""))) + } + } + + # ------------------------------------------------------------------------- + # CHECK 4 — consecutive_start_validity (consecutive mode only) + # Each epidemic_start begins a run of >= min_weeks_above "high"-risk weeks. + # ------------------------------------------------------------------------- + if (outbreak_start_definition == "consecutive" && + has_cols("epidemic_start", "risk")) { + start_idx <- which(d$epidemic_start %in% TRUE) + n_fail <- 0L + fail_tl <- character() + for (i in start_idx) { + run_end <- min(i + min_weeks_above - 1L, nrow(d)) + run_len <- run_end - i + 1L + if (run_len < min_weeks_above || !all(d$risk[i:run_end] == "high")) { + n_fail <- n_fail + 1L + fail_tl <- c(fail_tl, as.character(d$TL[i])) + } + } + push(make_row(loc, NA_character_, "consecutive_start_validity", + if (n_fail == 0) "PASS" else "FAIL", + n_fail, + if (n_fail == 0) + paste0("All ", length(start_idx), " epidemic start(s) are followed by >= ", + min_weeks_above, " consecutive high-risk weeks.") + else + paste0(n_fail, " epidemic start(s) are NOT followed by ", min_weeks_above, + " consecutive high-risk weeks. ", + "First offending TL: ", + paste(head(fail_tl, 5), collapse = ", "), + if (n_fail > 5) " ..." else ""))) + } + + # ------------------------------------------------------------------------- + # CHECK 5 — dual_window_start_validity (dual_window mode only) + # Each epidemic_start satisfies the sliding-window trigger (>= min_weeks_above + # high-risk weeks in the forward window_weeks window) OR the cumulative + # trigger (cumulative sCh over cumulative_windows weeks meets the threshold). + # ------------------------------------------------------------------------- + if (outbreak_start_definition == "dual_window" && + has_cols("epidemic_start", "risk", "sCh", "pop", "threshold")) { + start_idx <- which(d$epidemic_start %in% TRUE) + n_fail <- 0L + fail_tl <- character() + for (i in start_idx) { + # --- Sliding-window trigger --- + w_end <- min(i + window_weeks - 1L, nrow(d)) + n_high_win <- sum(d$risk[i:w_end] == "high", na.rm = TRUE) + sliding_ok <- n_high_win >= min_weeks_above + + # --- Cumulative trigger --- + c_end <- min(i + cumulative_windows - 1L, nrow(d)) + cum_cases <- sum(d$sCh[i:c_end], na.rm = TRUE) + cum_thresh <- if (!is.na(d$threshold[i]) && !is.na(d$pop[i]) && d$pop[i] > 0) + d$threshold[i] * d$pop[i] * cumulative_case_threshold_ratio + else + Inf + thresh_met <- is.finite(cum_thresh) && cum_cases >= cum_thresh + + cum_ok <- if (!use_cumulative_trigger) { + FALSE + } else if (cumulative_trigger_type == "cumulative_case_threshold") { + thresh_met + } else if (cumulative_trigger_type == "cumulative_case_threshold_and_min_cases") { + thresh_met && !is.null(cumulative_min_cases) && cum_cases >= cumulative_min_cases + } else if (cumulative_trigger_type == "cumulative_case_threshold_and_nonzero_weeks") { + n_nz <- sum(d$sCh[i:c_end] > 0, na.rm = TRUE) + thresh_met && !is.null(nonzero_windows) && n_nz >= nonzero_windows + } else { + FALSE + } + + if (!sliding_ok && !cum_ok) { + n_fail <- n_fail + 1L + fail_tl <- c(fail_tl, as.character(d$TL[i])) + } + } + push(make_row(loc, NA_character_, "dual_window_start_validity", + if (n_fail == 0) "PASS" else "FAIL", + n_fail, + if (n_fail == 0) + paste0("All ", length(start_idx), + " epidemic start(s) satisfy at least one dual-window trigger ", + "(sliding window or cumulative).") + else + paste0(n_fail, " epidemic start(s) satisfy neither the sliding-window trigger ", + "(>= ", min_weeks_above, " high-risk weeks in ", window_weeks, " weeks) ", + "nor the cumulative trigger. ", + "First offending TL: ", + paste(head(fail_tl, 5), collapse = ", "), + if (n_fail > 5) " ..." else ""))) + } + + # ------------------------------------------------------------------------- + # CHECK 6 — epidemic_tail_validity + # For every epidemic_tail == TRUE row at position i, + # rows i through i + tail_period - 1 must all be risk == "low" and + # epidemic_start == FALSE. This verifies the tail flag semantics. + # ------------------------------------------------------------------------- + if (has_cols("epidemic_tail", "risk", "epidemic_start")) { + tail_idx <- which(d$epidemic_tail %in% TRUE) + if (length(tail_idx) > 0) { + n_fail <- 0L + fail_tl <- character() + for (i in tail_idx) { + run_end <- min(i + tail_period - 1L, nrow(d)) + run_rows <- d[i:run_end, ] + if (!all(run_rows$risk == "low") || any(run_rows$epidemic_start %in% TRUE)) { + n_fail <- n_fail + 1L + fail_tl <- c(fail_tl, as.character(d$TL[i])) + } + } + push(make_row(loc, NA_character_, "epidemic_tail_validity", + if (n_fail == 0) "PASS" else "FAIL", + n_fail, + if (n_fail == 0) + paste0("All ", length(tail_idx), " epidemic_tail flag(s) correctly mark ", + "the start of a ", tail_period, "-week low-risk run.") + else + paste0(n_fail, " epidemic_tail row(s) are NOT followed by ", + tail_period, " consecutive low-risk non-epidemic-start weeks. ", + "First offending TL: ", + paste(head(fail_tl, 5), collapse = ", "), + if (n_fail > 5) " ..." else ""))) + } + } + + # ========================================================================= + # OUTBREAK-LEVEL CHECKS + # ========================================================================= + if ("outbreak_number" %in% names(d)) { + ob_ids <- sort(unique( + d$outbreak_number[!is.na(d$outbreak_number) & d$outbreak_number > 0] + )) + + for (ob_id in ob_ids) { + ob <- d[!is.na(d$outbreak_number) & d$outbreak_number == ob_id, ] %>% + dplyr::arrange(TL) + + # ---------------------------------------------------------------------- + # CHECK 7 — min_high_risk_weeks_per_outbreak + # Each outbreak must contain at least min_weeks_above high-risk weeks. + # ---------------------------------------------------------------------- + if ("risk" %in% names(ob)) { + n_high <- sum(ob$risk == "high", na.rm = TRUE) + push(make_row(loc, ob_id, "min_high_risk_weeks_per_outbreak", + if (n_high >= min_weeks_above) "PASS" else "FAIL", + n_high, + paste0("Outbreak ", ob_id, ": ", n_high, " high-risk week(s) in ", + nrow(ob), " total week(s) ", + "(minimum required: ", min_weeks_above, ")."))) + } + + # ---------------------------------------------------------------------- + # CHECK 8 — cumulative_cases_at_start + # Sum of sCh over the first cumulative_windows weeks >= cumulative_min_cases. + # Skipped when cumulative_min_cases is NULL. + # ---------------------------------------------------------------------- + if (!is.null(cumulative_min_cases) && "sCh" %in% names(ob)) { + n_win <- min(cumulative_windows, nrow(ob)) + cum_sum <- sum(ob$sCh[seq_len(n_win)], na.rm = TRUE) + push(make_row(loc, ob_id, "cumulative_cases_at_start", + if (cum_sum >= cumulative_min_cases) "PASS" else "FAIL", + cum_sum, + paste0("Outbreak ", ob_id, ": first ", n_win, " week(s) sum to ", + round(cum_sum, 1), " cases ", + "(minimum required: ", cumulative_min_cases, ")."))) + } + + # ---------------------------------------------------------------------- + # CHECK 9 — outbreak_weekly_continuity + # Consecutive TL values within an outbreak must be exactly 7 days apart. + # ---------------------------------------------------------------------- + if (nrow(ob) > 1) { + gaps <- as.integer(diff(ob$TL)) + n_gap_v <- sum(gaps != 7L) + push(make_row(loc, ob_id, "outbreak_weekly_continuity", + if (n_gap_v == 0) "PASS" else "FAIL", + n_gap_v, + if (n_gap_v == 0) + paste0("Outbreak ", ob_id, ": all ", nrow(ob), + " weeks are consecutive (7-day spacing).") + else + paste0("Outbreak ", ob_id, ": ", n_gap_v, + " non-7-day gap(s) within the outbreak period. ", + "Min gap: ", min(gaps), " days, max gap: ", max(gaps), " days."))) + } + + # ---------------------------------------------------------------------- + # CHECK 10 — tail_period_after_outbreak + # Immediately after each outbreak period, the following non-outbreak + # weeks should be low-risk (forming the washout / tail period). + # The minimum number of such weeks depends on how the tail is split + # between the outbreak period and the non-outbreak period; this check + # simply verifies that the immediately-following weeks are not high-risk. + # Returns SKIP when no data follows the outbreak. + # ---------------------------------------------------------------------- + if ("risk" %in% names(d)) { + ob_end_tl <- max(ob$TL) + after <- d[d$TL > ob_end_tl, ] %>% dplyr::arrange(TL) + + if (nrow(after) == 0) { + push(make_row(loc, ob_id, "tail_period_after_outbreak", + "SKIP", NA_real_, + paste0("Outbreak ", ob_id, + ": no observations after this outbreak period — ", + "tail structure cannot be verified."))) + } else { + # Count how many consecutive non-outbreak low-risk weeks follow + non_ob <- (is.na(after$outbreak_number) | after$outbreak_number == 0) + low <- after$risk == "low" + non_ob_low <- non_ob & low + + rle_res <- rle(non_ob_low) + n_leading_low <- if (rle_res$values[1]) rle_res$lengths[1] else 0L + + # The algorithm places ~2 tail rows inside the outbreak period; + # expect at least tail_period - 2 consecutive non-outbreak low-risk + # weeks immediately after. + min_expected <- max(0L, tail_period - 2L) + push(make_row(loc, ob_id, "tail_period_after_outbreak", + if (n_leading_low >= min_expected) "PASS" else "FAIL", + n_leading_low, + paste0("Outbreak ", ob_id, ": ", + n_leading_low, " consecutive non-outbreak low-risk week(s) ", + "immediately follow (expected >= ", min_expected, + " given tail_period = ", tail_period, ")."))) + } + } + + # ---------------------------------------------------------------------- + # CHECK 11 — outbreak_summary (INFO) + # Informational summary: total cases, duration, peak weekly cases. + # ---------------------------------------------------------------------- + if ("sCh" %in% names(ob)) { + total_c <- sum(ob$sCh, na.rm = TRUE) + peak_c <- max(ob$sCh, na.rm = TRUE) + push(make_row(loc, ob_id, "outbreak_summary", + "INFO", total_c, + paste0("Outbreak ", ob_id, ": ", nrow(ob), " week(s), ", + round(total_c, 1), " total suspected cases, ", + round(peak_c, 1), " peak weekly cases."))) + } + } # end outbreak-level loop + + # ----------------------------------------------------------------------- + # CHECK 12 — inter_outbreak_gap_weeks + # The gap in time between consecutive outbreaks must be >= tail_period + # weeks (otherwise the algorithm would have merged them). + # One result row per consecutive outbreak pair. + # ----------------------------------------------------------------------- + if (length(ob_ids) > 1) { + for (k in seq_len(length(ob_ids) - 1L)) { + ob_a <- d[!is.na(d$outbreak_number) & d$outbreak_number == ob_ids[k], ] + ob_b <- d[!is.na(d$outbreak_number) & d$outbreak_number == ob_ids[k + 1L], ] + end_a <- max(ob_a$TR) + start_b <- min(ob_b$TL) + gap_w <- as.numeric(start_b - end_a) / 7 + pair_id <- paste0(ob_ids[k], "-", ob_ids[k + 1L]) + push(make_row(loc, pair_id, "inter_outbreak_gap_weeks", + if (gap_w >= tail_period) "PASS" else "FAIL", + gap_w, + paste0("Outbreaks ", ob_ids[k], " \u2192 ", ob_ids[k + 1L], ": ", + "gap = ", round(gap_w, 1), " week(s) ", + "(minimum required: ", tail_period, ")."))) + } + } + + } # end "outbreak_number" block + } # end location loop + + # Combine and return + dplyr::bind_rows(results[seq_len(ri)]) +} diff --git a/analysis/00_make_configs.R b/analysis/00_make_configs.R new file mode 100644 index 0000000..bdb0c15 --- /dev/null +++ b/analysis/00_make_configs.R @@ -0,0 +1,164 @@ +# 00_make_configs.R +# Generates YAML config files for the two SLURM batches: +# pull_set — one config per country × time_window (Batch 1) +# detection_set — one config per country (Batch 2) +# +# After running, the script prints the --array bounds to use in the SLURM +# submission scripts (submit_01_pull_data.sh, submit_02_detection.sh). +# +# Usage: Rscript analysis/00_make_configs.R + +library(here) +library(tibble) +library(tidyr) + +source(here("analysis/utils.R")) + +# --------------------------------------------------------------------------- +# 1. Define the country × WHO region grid +# --------------------------------------------------------------------------- +# Add or remove rows to control which countries are analysed. +# country_iso3 must match the ISO3 code used by the Cholera Taxonomy API. + +countries <- tibble::tribble( + ~who_region, ~country_iso3, + "AFR", "AGO", + "AFR", "BDI", + "AFR", "BEN", + "AFR", "BFA", + "AFR", "BWA", + "AFR", "CAF", + "AFR", "CIV", + "AFR", "CMR", + "AFR", "COD", + "AFR", "COG", + "EMR", "DJI", + "AFR", "ERI", + "AFR", "ETH", + "AFR", "GAB", + "AFR", "GHA", + "AFR", "GIN", + "AFR", "GMB", + "AFR", "GNB", + "AFR", "GNQ", + "AFR", "KEN", + "AFR", "LBR", + "AFR", "LSO", + "AFR", "MDG", + "AFR", "MLI", + "AFR", "MOZ", + "AFR", "MRT", + "AFR", "MWI", + "AFR", "NAM", + "AFR", "NER", + "AFR", "NGA", + "AFR", "RWA", + "EMR", "SDN", + "AFR", "SEN", + "AFR", "SLE", + "EMR", "SOM", + "AFR", "SSD", + "AFR", "SWZ", + "AFR", "TCD", + "AFR", "TGO", + "AFR", "TZA::Mainland", + "AFR", "UGA", + "EMR", "YEM", + "AFR", "ZAF", + "AFR", "ZMB", + "AFR", "ZWE", + "AFR", "TZA::Zanzibar", + "AFR", "COM", + "EUR", "MYT", + "AMR", "HTI", + "EMR", "LBN", + "SEAR", "BGD", + "EMR", "AFG", + "EMR", "PAK", + "SEAR", "IND", + "SEAR", "MMR", + "SEAR", "NPL", + "EMR", "SYR", + "EMR", "IRQ", + "WPR", "PHL", + "AMR", "DOM", + "SEAR", "THA", + "WPR", "CHN", + "WPR", "KHM", + "WPR", "MYS", + "EMR", "IRN", + "WPR", "PNG", + "EMR", "SAU", + "EMR", "ARE" +) + +# --------------------------------------------------------------------------- +# 2. Define time windows +# --------------------------------------------------------------------------- +# Each row is one pull window. Each window is a given month to make data download manageable. + +# time_windows <- tibble::tribble( +# ~time_lower_bound, ~time_upper_bound, +# "2010-01-01", "2015-12-31", +# "2013-01-01", "2018-12-31", +# "2016-01-01", "2021-12-31", +# "2018-01-01", "2023-12-31" +# ) + +tstart <- as.Date("2010-01-01") +tend <- as.Date("2024-12-31") +tseq <- seq.Date(tstart, tend, by = "4 months") + +time_windows <- tibble( + time_lower_bound = tseq + 1, + time_upper_bound = c(tseq[-1], tend) +) + + +# --------------------------------------------------------------------------- +# 3. (Optional) outbreak-detection parameter variants +# --------------------------------------------------------------------------- +# Uncomment to generate separate jobs per outbreak_start_definition variant. +# param_variants <- tibble::tribble( +# ~threshold_type, ~outbreak_start_definition, +# "mean weekly incidence rate", "consecutive", +# "mean weekly incidence rate", "dual_window" +# ) + +# --------------------------------------------------------------------------- +# 4. Generate config sets +# --------------------------------------------------------------------------- + +# pull_set: country × time_window (for Batch 1 data pull) +pull_specs <- tidyr::crossing(countries, time_windows) %>% + dplyr::arrange(time_lower_bound) %>% + dplyr::mutate(time_lower_bound = as.character(time_lower_bound), + time_upper_bound = as.character(time_upper_bound)) + +# pull_specs <- tidyr::crossing(countries, time_windows, param_variants) +write_configs(pull_specs, "pull_set") + +# detection_set: country only (for Batch 2 outbreak detection) +# Each Batch 2 task globs all Stage 1 parquet files for that country. +write_configs(countries, "detection_set") + +# --------------------------------------------------------------------------- +# 5. Print SLURM array bounds +# --------------------------------------------------------------------------- +cat("\n=== SLURM array bounds ===\n") +cat("submit_01_pull_data.sh → --array=0-", nrow(pull_specs) - 1, "%25\n", sep = "") +cat("submit_02_detection.sh → --array=0-", nrow(countries) - 1, "%10\n", sep = "") +cat("\n") +cat("Total Batch 1 jobs:", nrow(pull_specs), "\n") +cat("Total Batch 2 jobs:", nrow(countries), "\n") + +# --------------------------------------------------------------------------- +# 6. Minimal test config (1 country, 1 window — for local dry runs) +# --------------------------------------------------------------------------- +test_specs <- tibble::tribble( + ~who_region, ~country_iso3, ~time_lower_bound, ~time_upper_bound, + "AFR", "ETH", "2020-01-01", "2020-03-01" +) +write_configs(test_specs, "test_pull") +write_configs(dplyr::select(test_specs, who_region, country_iso3), "test_detection") +cat("\nTest configs written to analysis/configs/test_pull/ and test_detection/\n") diff --git a/analysis/01_pull_data.R b/analysis/01_pull_data.R new file mode 100644 index 0000000..5fe7c53 --- /dev/null +++ b/analysis/01_pull_data.R @@ -0,0 +1,366 @@ +# 01_pull_data.R — Batch 1: pull + normalize data for one country × time window +# +# Reads a YAML config, calls the Cholera Taxonomy API via taxdat, runs the +# full OutbreakExtractR normalization pipeline, and writes two GeoParquet files: +# stage1_geo_{run_id}.{geojson,parquet} — sf object (retains geometry, for spatial use) +# stage1_flat_{run_id}.{rds,parquet} — cleaned observations, geometry dropped (input to Batch 2) +# +# Skips gracefully if outputs already exist (re-run with --redo TRUE to force). +# +# Usage: +# Rscript analysis/01_pull_data.R -c analysis/configs/pull_set/pull_set_1.yml +# Rscript analysis/01_pull_data.R -c analysis/configs/pull_set/pull_set_1.yml --redo TRUE +# +# Required environment variables: +# CHOLERA_API_USERNAME — Cholera Taxonomy API username +# CHOLERA_API_KEY — Cholera Taxonomy API key + +library(here) +library(optparse) +library(dplyr) +library(sf) +sf_use_s2(FALSE) +source(here("analysis/utils.R")) + +# --------------------------------------------------------------------------- +# CLI / config parsing +# --------------------------------------------------------------------------- + +option_list <- list( + make_option(c("-c", "--config"), + default = NULL, type = "character", + help = "Path to YAML config file (required)"), + make_option(c("--redo"), + default = FALSE, type = "logical", + help = "Force re-pull even if output already exists [default: FALSE]") +) + +opt <- make_options_from_config(option_list, enforce_options = "redo") +print_options(opt) + +# --------------------------------------------------------------------------- +# Skip if already done +# --------------------------------------------------------------------------- + +out_geo <- make_stage1_geo_filename(opt) +out_flat <- make_stage1_flat_filename(opt) +out_api_cache <- file.path( + here(opt$output_dir), + paste0("raw_api_cache_", make_run_id(opt), ".rds") +) +dir.create(dirname(out_flat), recursive = TRUE, showWarnings = FALSE) + +if (file.exists(out_flat) && !isTRUE(opt$redo)) { + message("Stage 1 output already exists, skipping: ", out_flat) + quit(status = 0) +} + +# --------------------------------------------------------------------------- +# Credentials — only required when no API cache exists +# --------------------------------------------------------------------------- + +api_user <- Sys.getenv("CHOLERA_API_USERNAME", unset = NA_character_) +api_key <- Sys.getenv("CHOLERA_API_KEY", unset = NA_character_) + +if (!file.exists(out_api_cache) && (is.na(api_user) || is.na(api_key))) { + stop("CHOLERA_API_USERNAME and CHOLERA_API_KEY environment variables must be set.") +} + +# --------------------------------------------------------------------------- +# Stage 1a: pull raw data from Cholera Taxonomy API +# --------------------------------------------------------------------------- + +# Patch taxdat::flatten_json_result to handle list columns that contain nested +# data frames or raw vectors — these cause jsonlite::flatten() to throw +# "list columns are only allowed with raw vector contents". The fix drops any +# such column before flattening; they carry no information used downstream. +utils::assignInNamespace( + "flatten_json_result", + function(json_results) { + if (!is.data.frame(json_results)) json_results <- as.data.frame(json_results) + + # jsonlite::flatten() fails when nested data frames contain raw-vector + # list columns ("list columns are only allowed with raw vector contents"). + # Fix: walk every list-of-data-frame column recursively and strip only the + # raw-vector leaf columns — do NOT remove the parent data frame columns, + # because jsonlite::flatten() needs them to produce the attributes.* names. + clean_df <- function(df) { + for (col in names(df)) { + v <- df[[col]] + if (is.data.frame(v)) { + # Nested data frame column: recurse directly — do NOT lapply over it, + # which would iterate columns (not rows) and produce wrong-length output. + df[[col]] <- clean_df(v) + } else if (is.list(v)) { + # Pure list column: remove if any element is a raw vector + if (any(vapply(v, is.raw, logical(1L)))) { + message(" [flatten_json_result patch] removing raw-vector column: ", col) + df[[col]] <- NULL + } + } + } + df + } + + json_results <- clean_df(json_results) + json_results <- jsonlite::flatten(json_results) + + for (colname in names(json_results)) { + if (mode(json_results[[colname]]) == "list") { + if (max(sapply(json_results[[colname]], length)) == 1) { + json_results[[colname]] <- sapply(json_results[[colname]], function(x) { + ifelse(length(x) == 1, x, NA) + }) + } + } + } + json_results + }, + ns = "taxdat" +) + +# Patch taxdat::read_taxonomy_data_api to guard against shape IDs that are +# absent from the API response's `included` list. match() returns NA/NULL when +# the shape isn't found, and the subsequent [[NA]] index crashes with +# "attempt to select less than one element in get1index" before the existing +# is.null(unformatted_geojson) guard can fire. The fix skips to the empty- +# point fallback whenever this_shape_index is missing, mirroring what the +# original null-check was already trying to do. +utils::assignInNamespace( + "read_taxonomy_data_api", + function(username, api_key, locations = NULL, time_left = NULL, + time_right = NULL, uids = NULL, + website = "https://cholera-taxonomy.middle-distance.com/") { + api_type <- "" + if (is.null(uids)) { + api_type <- "by_location" + if (length(locations == 1)) { + locations <- c(locations, locations) + } + if (any(!grepl("::", locations))) { + stop("Trying to pull data for a continent is not allowed") + } + if ((sum(stringr::str_count(string = unique(locations), pattern = "::") == 1) > 2)) { + stop("Trying to pull data for more than 2 countries at a time is not allowed") + } + https_post_argument_list <- list( + email = username, api_key = api_key, + locations = gsub("::", " ", locations), + time_left = time_left, time_right = time_right + ) + } else if (is.null(locations) && is.null(time_left) && is.null(time_right)) { + api_type <- "by_observation_collections" + https_post_argument_list <- list( + email = username, api_key = api_key, + observation_collection_ids = uids + ) + } else { + stop("Not supported") + } + website <- paste0(website, "/api/v1/observations/", api_type) + json <- jsonlite::toJSON(https_post_argument_list, auto_unbox = T) + message("Fetching results from JSON API") + results <- httr::POST(website, + httr::add_headers(`Content-Type` = "application/json"), + body = json, encode = "form") + code <- httr::status_code(results) + if (code != 200) stop(paste("Error: Status Code", code)) + + original_results_data <- httr::content(results) + jsondata <- rjson::toJSON(original_results_data) + if (!jsonlite::validate(jsondata)) stop("Could not validate json response") + results_data <- jsonlite::fromJSON(jsondata) + + if ((!("observations" %in% names(results_data))) | + (!("data" %in% names(results_data[["observations"]]))) | + (length(results_data[["observations"]]) > 1)) { + stop("Could not parse results properly. Contact package maintainer") + } + results_data[["observations"]] <- taxdat:::flatten_json_result(results_data[["observations"]][["data"]]) + + observation_collections_present <- FALSE + if (("observation_collections" %in% names(results_data)) && + ("data" %in% names(results_data[["observation_collections"]])) && + (length(results_data[["observation_collections"]]) == 1)) { + results_data[["observation_collections"]] <- taxdat:::flatten_json_result( + results_data[["observation_collections"]][["data"]] + ) + observation_collections_present <- TRUE + } + + if (!length(unique(results_data$observations$id)) == nrow(results_data$observations)) { + stop("Could not parse results properly. Contact package maintainer") + } + + tmp_results <- original_results_data[["location_periods"]][["data"]] + all_shape_ids <- sapply(original_results_data$location_periods$included, function(x) x$id) + all_locations <- list() + + if (length(tmp_results) > 0) { + for (idx in 1:length(tmp_results)) { + message(paste(idx, "/", length(tmp_results))) + shape_id <- tmp_results[[idx]][["relationships"]][["shape"]][["data"]][["id"]] + this_shape_index <- match(shape_id, all_shape_ids) + # PATCH: guard — match() returns NA/NULL when shape_id is absent from + # `included`; [[NA]] crashes before the is.null check below can fire. + if (is.null(this_shape_index) || length(this_shape_index) == 0 || is.na(this_shape_index)) { + message(" [read_taxonomy_data_api patch] shape ID not found in included, skipping geometry: ", shape_id) + all_locations[[idx]] <- sf::st_sf(geometry = sf::st_sfc(sf::st_point())) + next + } + unformatted_geojson <- original_results_data[["location_periods"]][["included"]][[this_shape_index]][["attributes"]][["simple_shape"]] + if (is.null(unformatted_geojson)) { + all_locations[[idx]] <- sf::st_sf(geometry = sf::st_sfc(sf::st_point())) + next + } + sf_geojson <- geojsonsf::geojson_sf(unformatted_geojson) + all_locations[[idx]] <- sf_geojson + } + } + + locations_sf <- taxdat::reduce_sf_vector(all_locations) + results_data$location_periods$data$geojson <- NULL + results_data$location_periods$data$attributes$geojson <- NULL + results_data$location_periods <- taxdat:::flatten_json_result(results_data$location_periods$data) + if (nrow(results_data$location_periods) > 0) { + results_data$location_periods$sf_id <- seq_len(nrow(results_data$location_periods)) + } + + results_data$observations$attributes.location_period_id <- as( + results_data$observations$attributes.location_period_id, + class(results_data$location_periods$id) + ) + all_results <- results_data$observations + if (observation_collections_present && + (nrow(all_results) > 0) && + (nrow(results_data$observation_collections) > 0)) { + all_results <- dplyr::left_join( + results_data$observations, results_data$observation_collections, + by = c(relationships.observation_collection.data.id = "id") + ) + } + if ((nrow(all_results) > 0) && (nrow(results_data$location_periods) > 0)) { + all_results <- dplyr::left_join( + all_results, results_data$location_periods, + by = c(attributes.location_period_id = "id") + ) + } + + geoinput <- sf::st_sf(geometry = sf::st_sfc(sf::st_point(1 * c(NA, NA))))$geometry + if (nrow(all_results) == 0) geoinput <- geoinput[0] + all_results$geojson <- geoinput + all_results$geojson[!is.na(all_results$sf_id)] <- + locations_sf$geometry[all_results[!is.na(all_results$sf_id), ][["sf_id"]]] + + return(sf::st_sf(all_results, sf_column_name = "geojson")) + }, + ns = "taxdat" +) + +location_str <- make_taxdat_location(opt$who_region, opt$country_iso3) + +# Pull raw data from API — use cache if available to skip the network call on +# debug reruns. Delete raw_api_cache_*.rds manually (or with --redo-api) to +# force a fresh pull. +if (file.exists(out_api_cache)) { + message("Loading cached API response: ", basename(out_api_cache)) + raw_api <- readRDS(out_api_cache) +} else { + message("Pulling data: ", location_str, + " [", opt$time_lower_bound, " → ", opt$time_upper_bound, "]") + raw_api <- taxdat::read_taxonomy_data_api( + username = api_user, + api_key = api_key, + locations = location_str, + time_left = as.Date(opt$time_lower_bound), + time_right = as.Date(opt$time_upper_bound) + ) + saveRDS(raw_api, out_api_cache) + message("Cached API response: ", basename(out_api_cache)) +} + +# Guard: empty API response means no observations for this location/window. +# Must happen before select/rename — an empty sf has only a geometry column, +# which would cause rename(TL = attributes.time_left) to crash. +if (is.null(raw_api) || nrow(raw_api) == 0) { + warning("API returned no data for: ", location_str, + " [", opt$time_lower_bound, " → ", opt$time_upper_bound, "]") + write_tabular(data.frame(), out_flat, opt$use_geoparquet) + quit(status = 0) +} + +# Select and rename API columns to OutbreakExtractR conventions. +# rename_database_fields() maps attributes.id → locationPeriod_id, but the +# correct LP identifier in the API response is attributes.location_period_id. +# Using direct column selection based on actual API response structure. +# Selecting only needed columns also drops list columns with raw-vector elements +# that would cause sf::st_write to fail. +raw_sf <- raw_api %>% + dplyr::select( + dplyr::any_of(c( + "relationships.observation_collection.data.id", + "attributes.time_left", + "attributes.time_right", + "attributes.fields.suspected_cases", + "attributes.fields.confirmed_cases", + "attributes.fields.deaths", + "attributes.location_period_id", + "attributes.primary", + "attributes.location_name" + )) + ) %>% + dplyr::rename( + TL = attributes.time_left, + TR = attributes.time_right, + primary = attributes.primary, + location = attributes.location_name + ) + +# Optional columns: rename if present, else add as NA. +# Mirrors the confirmed_cases guard below — some API responses omit these fields. +optional_col_map <- list( + observation_collection_id = "relationships.observation_collection.data.id", + sCh = "attributes.fields.suspected_cases", + cCh = "attributes.fields.confirmed_cases", + deaths = "attributes.fields.deaths", + location_period_id = "attributes.location_period_id" +) +for (new_name in names(optional_col_map)) { + old_name <- optional_col_map[[new_name]] + if (old_name %in% names(raw_sf)) { + raw_sf <- dplyr::rename(raw_sf, !!new_name := !!old_name) + } else { + raw_sf[[new_name]] <- NA + } +} + +message("Pulled ", nrow(raw_sf), " raw observations.") + +# Save raw sf with geometry as GeoParquet (useful for spatial visualisation) +write_spatial(raw_sf, out_geo, opt$use_geoparquet) +message("Saved raw geo file: ", basename(out_geo)) + +# --------------------------------------------------------------------------- +# Stage 1b: clean raw observations and save per-window flat file +# +# Filtering, aggregation, normalization, and population attachment all happen +# in Batch 2 (02_run_outbreak_detection.R) once the full per-country series +# has been assembled from all windows, matching the reference pipeline. +# --------------------------------------------------------------------------- + +# Drop geometry — OutbreakExtractR functions operate on flat dataframes +raw_df <- sf::st_drop_geometry(raw_sf) + +# Clean: standardize types, identify spatial/temporal scale, clean location names +clean_data <- OutbreakExtractR::clean_psql_data(raw_df) + +# --------------------------------------------------------------------------- +# Save cleaned flat file for Batch 2 +# --------------------------------------------------------------------------- + +write_tabular(clean_data, out_flat, opt$use_geoparquet) + +message("Stage 1 complete.") +message(" Rows: ", nrow(clean_data)) +message(" Locations: ", length(unique(clean_data$location))) +message(" Saved: ", basename(out_flat)) diff --git a/analysis/02_run_outbreak_detection.R b/analysis/02_run_outbreak_detection.R new file mode 100644 index 0000000..7fbaf3e --- /dev/null +++ b/analysis/02_run_outbreak_detection.R @@ -0,0 +1,414 @@ +# 02_run_outbreak_detection.R — Batch 2: outbreak detection for one country +# +# Reads a per-country YAML config (detection_set), concatenates all Stage 1 +# flat files for that country (one per 4-month pull window), and runs the +# full reference processing pipeline + identify_outbreaks() + trigger_alert() +# once over the entire per-country time series. +# +# Processing pipeline matches Step2_Extract_outbreak.R from +# GenevaIDD/global-cholera-surveillance-timeseries: +# filter (daily → aggregate; weekly) → fill_missing_lps ×3 → +# average_duplicate_observations → set_uniform_wday_start → +# filter(n_obs > 1) → fill_phantom_zeroes → add_population → +# identify_outbreaks (threshold over full series, no customized_TL/TR) +# +# Outputs one file per country: +# stage2_{who_region}_{country_iso3}.{rds,parquet} +# +# SLURM parallelism happens at the country level (one job per country). +# +# Usage: +# Rscript analysis/02_run_outbreak_detection.R \ +# -c analysis/configs/detection_set/detection_set_1.yml + +library(here) +library(optparse) +library(dplyr) +library(purrr) +library(lubridate) +library(stringr) +library(sf) +sf_use_s2(FALSE) + +source(here("analysis/utils.R")) + +# --------------------------------------------------------------------------- +# CLI / config parsing +# --------------------------------------------------------------------------- + +option_list <- list( + make_option(c("-c", "--config"), + default = NULL, type = "character", + help = "Path to YAML config file (required)"), + make_option(c("--redo"), + default = FALSE, type = "logical", + help = "Force re-run even if output already exists [default: FALSE]") +) + +opt <- make_options_from_config(option_list, enforce_options = "redo") +print_options(opt) + +# --------------------------------------------------------------------------- +# Discover Stage 1 flat parquet files for this country +# --------------------------------------------------------------------------- + +stage1_dir <- here("analysis/generated_data") +stage1_ext <- if (isTRUE(opt$use_geoparquet)) "\\.parquet" else "\\.rds" +pattern <- paste0("^stage1_flat_", opt$who_region, "_", opt$country_iso3, "_.*", stage1_ext, "$") +stage1_files <- list.files(stage1_dir, pattern = pattern, full.names = TRUE) + +if (length(stage1_files) == 0) { + stop("No Stage 1 flat parquet files found for ", + opt$who_region, "::", opt$country_iso3, + " in: ", stage1_dir, + "\nRun Batch 1 (01_pull_data.R) first.") +} + +message("Found ", length(stage1_files), " Stage 1 file(s) for ", + opt$who_region, "::", opt$country_iso3) + +# --------------------------------------------------------------------------- +# Skip if already done +# --------------------------------------------------------------------------- + +out_file <- make_stage2_filename(opt$who_region, opt$country_iso3, opt$use_geoparquet) + +if (file.exists(out_file) && !isTRUE(opt$redo)) { + message("Stage 2 output already exists, skipping: ", out_file) + quit(status = 0) +} + +# --------------------------------------------------------------------------- +# Concatenate all per-window cleaned observations for this country +# --------------------------------------------------------------------------- + +clean_list <- lapply(stage1_files, function(f) { + tryCatch({ + df <- read_tabular(f, opt$use_geoparquet) + if (nrow(df) == 0) return(NULL) + df + }, error = function(e) { + warning("Failed to read Stage 1 flat file: ", basename(f), " — ", conditionMessage(e)) + NULL + }) +}) + +clean_all <- purrr::list_rbind(purrr::keep(clean_list, \(x) !is.null(x))) + +if (nrow(clean_all) == 0) { + warning("No Stage 1 observations for: ", opt$who_region, "::", opt$country_iso3) + write_tabular(data.frame(), out_file, opt$use_geoparquet) + quit(status = 0) +} + +message("Loaded ", nrow(clean_all), " cleaned observations across ", + length(stage1_files), " window(s).") + +# --------------------------------------------------------------------------- +# Load per-window geo files → raw_sf for population attachment +# --------------------------------------------------------------------------- + +geo_ext <- if (isTRUE(opt$use_geoparquet)) "\\.parquet" else "\\.geojson" +# Use opt$country_iso3 directly (with :: as-is) to match actual filenames. +# gsub("::", "_", ...) was a bug: geo files retain :: in their names just like +# stage1 flat files, so the underscore-substituted pattern never matched. +geo_pattern <- paste0("^stage1_geo_", opt$who_region, "_", + opt$country_iso3, "_.*", geo_ext, "$") +geo_files <- list.files(stage1_dir, pattern = geo_pattern, full.names = TRUE) +# Exclude composite sidecars written by a prior run of this script — they have +# a different schema (only location_period_id + area_per_1km2 + geometry) and +# must not be rbind-ed with the full Stage 1 geo files. +geo_files <- geo_files[!grepl("_composite\\.geojson$|_composite\\.parquet$", + basename(geo_files))] + +if (length(geo_files) == 0) { + warning("No Stage 1 geo files found for population attachment — pop will be NA.") + raw_sf <- NULL +} else { + geo_list <- lapply(geo_files, function(f) { + tryCatch( + if (isTRUE(opt$use_geoparquet)) sfarrow::st_read_parquet(f) + else sf::st_read(f, quiet = TRUE), + error = function(e) { + warning("Failed to read geo file: ", basename(f), " — ", conditionMessage(e)) + NULL + } + ) + }) + raw_sf <- do.call(rbind, Filter(Negate(is.null), geo_list)) + message("Loaded geometry from ", length(geo_files), " geo file(s).") +} + +# --------------------------------------------------------------------------- +# Derive full time range from window filenames +# --------------------------------------------------------------------------- + +tl_strings <- str_extract(basename(stage1_files), "(?<=_TL)\\d{8}") +tr_strings <- str_extract(basename(stage1_files), "(?<=_TR)\\d{8}") +tl_all <- min(lubridate::ymd(tl_strings), na.rm = TRUE) +tr_all <- max(lubridate::ymd(tr_strings), na.rm = TRUE) + +message("Full time range: ", tl_all, " → ", tr_all) + +# --------------------------------------------------------------------------- +# Reference processing pipeline (matches Step2_Extract_outbreak.R:26-67) +# --------------------------------------------------------------------------- + +# Daily branch: filter then aggregate to weekly +daily_data <- OutbreakExtractR::observation_filter( + outbreak_data = clean_all, + time_lower_bound_filter = tl_all, + time_upper_bound_filter = tr_all, + temporal_scale_filter = "daily", + who_regions = opt$who_region, + spatial_scale_filter = opt$spatial_scale_filter, + remove_na_sCh = opt$remove_na_sCh, + remove_na_cCh = opt$remove_na_cCh, + remove_na_locationperiod = opt$remove_na_locationperiod, + minimum_daily_cases = opt$minimum_daily_cases +) +if (nrow(daily_data) > 0) { + daily_data <- OutbreakExtractR::observation_aggregator(daily_data) +} + +# Weekly branch: filter then coerce id columns to character (avoids bind_rows type conflicts) +weekly_data <- OutbreakExtractR::observation_filter( + outbreak_data = clean_all, + time_lower_bound_filter = tl_all, + time_upper_bound_filter = tr_all, + temporal_scale_filter = "weekly", + who_regions = opt$who_region, + spatial_scale_filter = opt$spatial_scale_filter, + remove_na_sCh = opt$remove_na_sCh, + remove_na_cCh = opt$remove_na_cCh, + remove_na_locationperiod = opt$remove_na_locationperiod, + minimum_daily_cases = opt$minimum_daily_cases +) %>% + dplyr::mutate( + observation_collection_id = as.character(observation_collection_id), + dplyr::across(dplyr::any_of("original_location_name"), as.character) + ) + +combined_filtered <- dplyr::bind_rows(weekly_data, daily_data) + +if (nrow(combined_filtered) == 0) { + warning("No observations after filtering for: ", opt$who_region, "::", opt$country_iso3) + write_tabular(data.frame(), out_file, opt$use_geoparquet) + quit(status = 0) +} + +# Normalization: fill_missing_lps (×3), dedup, wday alignment, singleton drop, phantom zeros +normalized <- combined_filtered %>% + OutbreakExtractR::fill_missing_lps() %>% + OutbreakExtractR::average_duplicate_observations() %>% + OutbreakExtractR::fill_missing_lps() %>% + OutbreakExtractR::set_uniform_wday_start() %>% + dplyr::group_by(location) %>% + dplyr::add_count(name = "n_obs") %>% + dplyr::ungroup() %>% + dplyr::filter(n_obs > 1) %>% + dplyr::select(-n_obs) %>% + OutbreakExtractR::fill_phantom_zeroes() %>% + OutbreakExtractR::fill_missing_lps() + +message("Normalized: ", nrow(normalized), " rows, ", + length(unique(normalized$location)), " location(s).") + +if (nrow(normalized) == 0) { + warning("No data after normalization for: ", opt$who_region, "::", opt$country_iso3) + write_tabular(data.frame(), out_file, opt$use_geoparquet) + quit(status = 0) +} + +# Population attachment (WorldPop, keyed by location_period_id + geometry from geo files) +if (!is.null(raw_sf)) { + normalized <- OutbreakExtractR::add_population( + normalized_data = normalized, + raw_sf = raw_sf, + country_iso3 = opt$country_iso3, + raster_dir = here::here(opt$raster_dir) + ) +} else { + normalized$pop <- NA_real_ + message("Skipping add_population() — no geo files found; pop set to NA.") +} + +# --------------------------------------------------------------------------- +# Resolve composite locations (NA location_period_id, "|"-joined names) into +# composite_loc__* pseudo-LPs with unioned child geometry and a +# WorldPop-on-geometry population (raster_dir passed below), so they survive +# detection (otherwise NA pop drops them). +# --------------------------------------------------------------------------- + +composite_geom <- NULL +if (!is.null(raw_sf)) { + comp <- tryCatch( + OutbreakExtractR::build_composite_locations( + normalized = normalized, + raw_sf = raw_sf, + iso3 = opt$country_iso3, + raster_dir = here::here(opt$raster_dir) + ), + error = function(e) { + warning("build_composite_locations() failed for ", + opt$who_region, "::", opt$country_iso3, ": ", conditionMessage(e)) + NULL + } + ) + if (!is.null(comp)) { + normalized <- comp$data + composite_geom <- comp$geometry + } +} + +# --------------------------------------------------------------------------- +# Population QC gates +# +# Runs AFTER the composite block so that composite pseudo-LPs are covered too. +# on_fail = "warn": gate 4 currently fails corpus-wide (alias records sharing a +# geometry), so aborting here would prevent any full re-extraction from +# completing. The per-country CSV is aggregated by 03_aggregate_results.R into +# one reviewable corpus-wide artefact. +# --------------------------------------------------------------------------- +pop_qa <- tryCatch( + OutbreakExtractR::validate_population( + lp_pop = normalized, + iso3 = opt$country_iso3, + on_fail = "warn" + ), + error = function(e) { + warning("validate_population() failed for ", opt$who_region, "::", + opt$country_iso3, ": ", conditionMessage(e)) + NULL + } +) + +if (!is.null(pop_qa)) { + qa_file <- file.path( + dirname(out_file), + sprintf("stage2_popqa_%s_%s.csv", opt$who_region, opt$country_iso3) + ) + utils::write.csv(pop_qa, qa_file, row.names = FALSE) + message("Population QC written: ", basename(qa_file)) +} + +# --------------------------------------------------------------------------- +# Outbreak detection over full per-country series (no customized_TL/TR) +# Threshold = mean weekly incidence over the entire time series, matching reference +# --------------------------------------------------------------------------- + +outbreak_list <- tryCatch( + OutbreakExtractR::identify_outbreaks( + threshold_type = opt$threshold_type, + original_data = normalized, + zero_case_assumption = opt$zero_case_assumption, + outbreak_start_definition = opt$outbreak_start_definition, + min_weeks_above = opt$min_weeks_above, + require_increasing_trend = opt$require_increasing_trend, + window_weeks = opt$window_weeks, + cumulative_windows = opt$cumulative_windows, + cumulative_case_threshold_ratio = opt$cumulative_case_threshold_ratio, + cumulative_trigger_type = opt$cumulative_trigger_type, + use_cumulative_trigger = opt$use_cumulative_trigger, + cumulative_min_cases = opt$cumulative_min_cases, + nonzero_windows = opt$nonzero_windows, + tail_period = opt$tail_period, + filter_outbreaks_by_size = isTRUE(opt$filter_outbreaks_by_size), + keep_nonoutbreak_locations = isTRUE(opt$keep_nonoutbreak_locations) + ), + error = function(e) { + warning("identify_outbreaks() failed for ", + opt$who_region, "::", opt$country_iso3, ": ", conditionMessage(e)) + NULL + } +) + +if (is.null(outbreak_list)) { + write_tabular(data.frame(), out_file, opt$use_geoparquet) + quit(status = 0) +} + +outbreaks_df <- purrr::list_rbind( + purrr::keep(outbreak_list, \(x) is.data.frame(x) && nrow(x) > 0) +) + +if (nrow(outbreaks_df) == 0) { + message("No outbreaks detected for: ", opt$who_region, "::", opt$country_iso3) + write_tabular(data.frame(), out_file, opt$use_geoparquet) + quit(status = 0) +} + +# --------------------------------------------------------------------------- +# Alerts +# --------------------------------------------------------------------------- + +alerts_df <- tryCatch( + OutbreakExtractR::trigger_alert(original_data = normalized), + error = function(e) { + warning("trigger_alert() failed: ", conditionMessage(e)) + NULL + } +) + +if (!is.null(alerts_df) && nrow(alerts_df) > 0) { + alert_cols <- names(alerts_df)[str_detect(names(alerts_df), "^alert")] + join_keys <- intersect(c("location", "TL", "TR"), names(alerts_df)) + if (length(join_keys) > 0 && length(alert_cols) > 0) { + outbreaks_df <- dplyr::left_join( + outbreaks_df, + dplyr::select(alerts_df, dplyr::all_of(c(join_keys, alert_cols))), + by = join_keys + ) + } +} + +# --------------------------------------------------------------------------- +# Add metadata and save +# --------------------------------------------------------------------------- + +outbreaks_df <- dplyr::mutate( + outbreaks_df, + who_region = opt$who_region, + country_iso3 = opt$country_iso3, + time_lower_bound = as.character(tl_all), + time_upper_bound = as.character(tr_all) +) + +n_outbreak_rows <- sum(outbreaks_df$outbreak_number > 0, na.rm = TRUE) + +write_tabular(outbreaks_df, out_file, opt$use_geoparquet) + +# --------------------------------------------------------------------------- +# Composite geometry sidecar +# +# The converter (00_ingest_outbreakextractr.R) builds outbreak_shapefiles.rds +# by globbing stage1_geo_(AFR|EMR)_*.geojson and computing area itself. Composite +# pseudo-LPs have no geometry in the per-window geo files, so emit a sidecar that +# matches that glob, keyed by location_period_id = composite_loc__*. +# --------------------------------------------------------------------------- + +if (!is.null(composite_geom) && nrow(composite_geom) > 0) { + composite_geo_file <- file.path( + stage1_dir, + paste0("stage1_geo_", opt$who_region, "_", opt$country_iso3, "_composite.geojson") + ) + tryCatch({ + sf::st_write( + composite_geom %>% dplyr::rename(location_period_id = lctn_pr), + composite_geo_file, + delete_dsn = TRUE, + quiet = TRUE + ) + message(" Composite geometries: ", nrow(composite_geom), + " → ", basename(composite_geo_file)) + }, error = function(e) { + warning("Failed to write composite geometry sidecar: ", conditionMessage(e)) + }) +} + +message("\nStage 2 complete.") +message(" Country: ", opt$who_region, "::", opt$country_iso3) +message(" Full time range: ", tl_all, " → ", tr_all) +message(" Total rows: ", nrow(outbreaks_df)) +message(" Outbreak-period rows: ", n_outbreak_rows) +message(" Saved: ", basename(out_file)) diff --git a/analysis/03_aggregate_results.R b/analysis/03_aggregate_results.R new file mode 100644 index 0000000..4f77d7a --- /dev/null +++ b/analysis/03_aggregate_results.R @@ -0,0 +1,154 @@ +# 03_aggregate_results.R — Post-processing: aggregate all Stage 2 outputs +# +# Run locally (not on SLURM) after all Batch 2 jobs complete. +# Loads every stage2_{who_region}_{country_iso3}.{rds,parquet} file in generated_data/, +# binds rows, and saves a combined CSV (plus Parquet when --format geoparquet). +# +# Uses furrr::future_map for parallel file loading across workers. +# +# Usage: +# Rscript analysis/03_aggregate_results.R +# Rscript analysis/03_aggregate_results.R --workers 4 --set_name cholera_v2 +# Rscript analysis/03_aggregate_results.R --format geoparquet + +library(here) +library(optparse) +library(purrr) +library(furrr) +library(future) +library(dplyr) +library(stringr) + +# --------------------------------------------------------------------------- +# CLI args +# --------------------------------------------------------------------------- + +option_list <- list( + make_option(c("-w", "--workers"), + default = 8L, type = "integer", + help = "Number of parallel workers for loading files [default: 8]"), + make_option(c("-s", "--set_name"), + default = "cholera", type = "character", + help = "Label for the combined output filename [default: cholera]"), + make_option(c("-o", "--out_dir"), + default = here("analysis/generated_data"), type = "character", + help = "Directory containing stage2_* files"), + make_option(c("-f", "--format"), + default = "geojson", type = "character", + help = "File format: 'geojson' (default, RDS tabular) or 'geoparquet' [default: geojson]") +) + +opt <- parse_args(OptionParser(option_list = option_list)) + +if (!opt$format %in% c("geojson", "geoparquet")) { + stop("--format must be 'geojson' or 'geoparquet', got: ", opt$format) +} +use_geoparquet <- opt$format == "geoparquet" + +cat("Workers:", opt$workers, "\n") +cat("Set name:", opt$set_name, "\n") +cat("Output dir:", opt$out_dir, "\n") +cat("Format:", opt$format, "\n\n") + +# --------------------------------------------------------------------------- +# Discover Stage 2 parquet files +# --------------------------------------------------------------------------- + +stage2_ext <- if (use_geoparquet) "\\.parquet" else "\\.rds" +stage2_files <- list.files(opt$out_dir, + pattern = paste0("^stage2_.*", stage2_ext, "$"), + full.names = TRUE) + +if (length(stage2_files) == 0) { + stop("No stage2_* ", opt$format, " files found in: ", opt$out_dir, + "\nRun Batch 2 (02_run_outbreak_detection.R) first.") +} + +cat("Found", length(stage2_files), "Stage 2 file(s):\n") +cat(paste0(" ", basename(stage2_files), collapse = "\n"), "\n\n") + +# --------------------------------------------------------------------------- +# Load in parallel +# --------------------------------------------------------------------------- + +plan(multisession, workers = opt$workers) + +results_list <- future_map(stage2_files, function(f) { + tryCatch({ + df <- if (use_geoparquet) arrow::read_parquet(f) else readRDS(f) + if (nrow(df) == 0) return(NULL) + df + }, error = function(e) { + warning("Failed to read: ", basename(f), " — ", conditionMessage(e)) + NULL + }) +}, .options = furrr_options(seed = TRUE)) + +plan(sequential) + +# --------------------------------------------------------------------------- +# Combine +# --------------------------------------------------------------------------- + +combined <- purrr::list_rbind(purrr::keep(results_list, \(x) !is.null(x))) + +# --------------------------------------------------------------------------- +# Aggregate the per-country population QC into one corpus-wide report +# --------------------------------------------------------------------------- + +qa_files <- list.files(dirname(stage2_files[1]), pattern = "^stage2_popqa_.*\\.csv$", + full.names = TRUE) + +if (length(qa_files) > 0) { + pop_qa <- purrr::list_rbind(purrr::map(qa_files, \(f) tryCatch( + read.csv(f, stringsAsFactors = FALSE), + error = function(e) { + warning("Failed to read QC file: ", basename(f), " — ", conditionMessage(e)) + NULL + } + ))) + + if (nrow(pop_qa) > 0) { + qa_out <- file.path(opt$out_dir, + paste0("population_qc_", opt$set_name, ".csv")) + write.csv(pop_qa, qa_out, row.names = FALSE) + message("Saved population QC: ", qa_out) + + cat("\nPopulation QC summary (gates across ", + length(unique(pop_qa$iso3)), " countries):\n", sep = "") + qa_summary <- pop_qa %>% + dplyr::group_by(gate, description) %>% + dplyr::summarise( + countries_failing = sum(!passed & !record_only), + total_violations = sum(n_violations, na.rm = TRUE), + .groups = "drop" + ) %>% + dplyr::arrange(gate) + print(as.data.frame(qa_summary), row.names = FALSE) + cat("\n") + } +} + +cat("Combined result:\n") +cat(" Total rows: ", nrow(combined), "\n") +cat(" Countries: ", length(unique(combined$country_iso3)), "\n") +cat(" WHO regions: ", length(unique(combined$who_region)), "\n") +cat(" Time windows: ", + length(unique(paste0(combined$time_lower_bound, "_", combined$time_upper_bound))), "\n\n") + +# --------------------------------------------------------------------------- +# Save combined outputs +# --------------------------------------------------------------------------- + +out_csv <- file.path(opt$out_dir, + paste0("combined_outbreaks_", opt$set_name, ".csv")) + +if (use_geoparquet) { + out_parquet <- file.path(opt$out_dir, + paste0("combined_outbreaks_", opt$set_name, ".parquet")) + arrow::write_parquet(combined, out_parquet) + message("Saved parquet: ", out_parquet) +} + +write.csv(combined, out_csv, row.names = FALSE) +message("Saved CSV: ", out_csv) diff --git a/analysis/bash/install_r_packages.sh b/analysis/bash/install_r_packages.sh new file mode 100755 index 0000000..4bf9ac3 --- /dev/null +++ b/analysis/bash/install_r_packages.sh @@ -0,0 +1,98 @@ +#!/bin/bash +# install_r_packages.sh — install all R packages required by the OutbreakExtractR pipeline +# +# Run ONCE from a LOGIN NODE (not a compute node — internet access needed for GitHub): +# +# cd /path/to/OutbreakExtractR +# bash analysis/bash/install_r_packages.sh +# +# What this installs: +# - All DESCRIPTION Imports + analysis-layer Suggests (from CRAN) +# - taxdat (from GitHub: HopkinsIDD/cholera-mapping-pipeline, branch dev) +# - OutbreakExtractR itself (from the current directory) +# +# !! This takes a while to complete + + +set -euo pipefail + + +# --------------------------------------------------------------------------- +# Modules — toolchain +# --------------------------------------------------------------------------- +module purge +module load GCCcore/12.3.0 GCC/12.3.0 libdeflate/1.18 Abseil/20230125.3 OpenMPI/4.1.5 R/4.3.2 GDAL/3.7.1 PostgreSQL/16.1 + +echo "R: $(Rscript --version 2>&1)" +echo "Library: $(Rscript -e 'cat(.libPaths()[1])' 2>/dev/null)" +echo "" + +# --------------------------------------------------------------------------- +# Run R install script +# Must be executed from the OutbreakExtractR project root. +# --------------------------------------------------------------------------- +REPO_ROOT="$(pwd)" + +Rscript - "$REPO_ROOT" <<'REOF' + +repo_root <- commandArgs(trailingOnly = TRUE)[1] +repo <- "https://cloud.r-project.org" + +# ---- CRAN packages --------------------------------------------------------- +pkgs <- c( + # OutbreakExtractR Imports (DESCRIPTION) + "DBI", "RPostgres", "glue", "sf", + "dplyr", "purrr", "tidyr", "stringr", "tibble", + "lubridate", "zoo", "tidyselect", "rlang", "magrittr", + "slider", "curl", "raster", "exactextractr", + + # population estimation (add_population / get_pop) + "rgeoboundaries", + + # analysis/ layer: configs, CLI, parquet I/O, parallelism + "yaml", "optparse", "here", + "arrow", "sfarrow", + "furrr", "future", + + # taxdat Depends + runtime deps used in pull_data_helpers.R + # (ISOcodes, igraph, geodata are in DESCRIPTION Depends; + # geojsonsf, rjson, httr, jsonlite are called directly in pull_data_helpers.R) + "ISOcodes", "igraph", "geodata", + "geojsonsf", "rjson", "httr", "jsonlite", + "readr", "reshape2", + + # dev / testing + "testthat", "remotes", "geojsonsf" +) + +missing_pkgs <- pkgs[!pkgs %in% rownames(installed.packages())] + +if (length(missing_pkgs) > 0) { + message("Installing ", length(missing_pkgs), " CRAN package(s): ", + paste(missing_pkgs, collapse = ", ")) + install.packages(missing_pkgs, repos = repo) +} else { + message("All CRAN packages already installed.") +} + +# ---- taxdat (private GitHub package) --------------------------------------- +if (!"taxdat" %in% rownames(installed.packages())) { +# NOTE: Needed to rebuild the documentation rm -rf man/ NAMESPACE && Rscript -e "devtools::document()" + message("Installing taxdat from GitHub (HopkinsIDD/cholera-mapping-pipeline, branch dev) ...") + remotes::install_version("Matrix", version = "1.6-5", repos = "https://cran.r-project.org") + remotes::install_github("HopkinsIDD/cholera-mapping-pipeline", + subdir = "packages/taxdat", + ref = "dev", + upgrade = "never") +} else { + message("taxdat already installed.") +} + +# ---- OutbreakExtractR from source ------------------------------------------ +message("Installing OutbreakExtractR from source: ", repo_root) +install.packages(repo_root, repos = NULL, type = "source") + +message("\n===== Installation complete =====") +message("Packages installed in: ", .libPaths()[1]) + +REOF diff --git a/analysis/bash/submit_01_pull_data.sh b/analysis/bash/submit_01_pull_data.sh new file mode 100755 index 0000000..34c1241 --- /dev/null +++ b/analysis/bash/submit_01_pull_data.sh @@ -0,0 +1,95 @@ +#!/bin/bash +# submit_01_pull_data.sh — Batch 1: pull + normalize data (country × time window) +# +# Each array task processes one YAML config from analysis/configs/pull_set/. +# One config = one country × one time window. +# +# Prerequisites: +# 1. Generate configs: +# Rscript analysis/00_make_configs.R +# 2. Set credentials (export persists to child SLURM jobs via --export=ALL): +# export CHOLERA_API_USERNAME= +# export CHOLERA_API_KEY= +# 3. Create log directory: +# mkdir -p logs +# +# Submission: +# BATCH1=$(sbatch --parsable analysis/bash/submit_01_pull_data.sh) +# echo "Batch 1 job ID: $BATCH1" +# +# Then chain Batch 2: +# sbatch --dependency=afterok:$BATCH1 analysis/bash/submit_02_detection.sh +# +# To re-run specific failed tasks (e.g. tasks 3 and 7): +# sbatch --array=3,7 analysis/bash/submit_01_pull_data.sh + +#SBATCH --job-name=cholera_pull +#SBATCH --output=logs/%x_%A_%a.log +#SBATCH --error=logs/%x_%A_%a.log +#SBATCH --mem=8G +#SBATCH --cpus-per-task=1 +#SBATCH --time=02:00:00 +#SBATCH --export=ALL +# Yggdrasil partition — verify available partitions with: sinfo -s +# Common options: shared-cpu, cpu, bigmem +#SBATCH --partition=shared-cpu +# EDIT: set upper bound to (N pull_set configs - 1) +# The exact value is printed by 00_make_configs.R +#SBATCH --array=0-3059%25 + +module load GCCcore/12.3.0 GCC/12.3.0 libdeflate/1.18 Abseil/20230125.3 OpenMPI/4.1.5 R/4.3.2 GDAL/3.7.1 PostgreSQL/16.1 + + +# Set taxonomy credentials +source analysis/bash/set_taxonomy_api_key.sh + +echo "===== Batch 1 start: $(date) =====" +echo "SLURM_JOB_ID: $SLURM_JOB_ID" +echo "SLURM_ARRAY_TASK_ID: $SLURM_ARRAY_TASK_ID" +echo "Hostname: $(hostname)" + +# --- R executable --- +# Yggdrasil uses Lmod; check available versions with: module spider R +if command -v module &>/dev/null; then + module load R 2>/dev/null || true +fi +RSCRIPT=$(command -v Rscript) +echo "Rscript: $RSCRIPT" +$RSCRIPT --version + +# --- Validate credentials --- +if [ -z "$CHOLERA_API_USERNAME" ] || [ -z "$CHOLERA_API_KEY" ]; then + echo "ERROR: CHOLERA_API_USERNAME and CHOLERA_API_KEY must be set." + echo "Run: export CHOLERA_API_USERNAME= CHOLERA_API_KEY=" + exit 1 +fi + +# --- Config selection --- +CONFIGDIR=analysis/configs/pull_set + +if [ ! -d "$CONFIGDIR" ]; then + echo "ERROR: Config directory not found: $CONFIGDIR" + echo "Run: Rscript analysis/00_make_configs.R" + exit 1 +fi + +# sort -V ensures natural (numeric) ordering: pull_set_1, pull_set_2, ..., pull_set_10 +CONFIGNAMES=($(ls "$CONFIGDIR" | sort -V)) +N_CONFIGS=${#CONFIGNAMES[@]} +echo "Config set: $CONFIGDIR ($N_CONFIGS configs)" + +if [ "$SLURM_ARRAY_TASK_ID" -ge "$N_CONFIGS" ]; then + echo "Task ID $SLURM_ARRAY_TASK_ID >= N_CONFIGS $N_CONFIGS — nothing to do." + exit 0 +fi + +THISCONFIG="$CONFIGDIR/${CONFIGNAMES[$SLURM_ARRAY_TASK_ID]}" +echo "Config: $THISCONFIG" + +# --- Run Stage 1 --- +$RSCRIPT analysis/01_pull_data.R -c "$THISCONFIG" --redo FALSE || { + echo "ERROR: 01_pull_data.R failed for $THISCONFIG" + exit 1 +} + +echo "===== Batch 1 end: $(date) =====" diff --git a/analysis/bash/submit_02_detection.sh b/analysis/bash/submit_02_detection.sh new file mode 100755 index 0000000..4322bf3 --- /dev/null +++ b/analysis/bash/submit_02_detection.sh @@ -0,0 +1,72 @@ +#!/bin/bash +# submit_02_detection.sh — Batch 2: outbreak detection (per country) +# +# Each array task processes one YAML config from analysis/configs/detection_set/. +# One config = one country; the script globs all Stage 1 flat parquet files for +# that country and runs identify_outbreaks() + trigger_alert() per time window. +# +# Typically submitted with a dependency on Batch 1: +# BATCH1=$(sbatch --parsable analysis/bash/submit_01_pull_data.sh) +# sbatch --dependency=afterok:$BATCH1 analysis/bash/submit_02_detection.sh +# +# Can also be submitted independently (if Stage 1 outputs already exist). + +#SBATCH --job-name=cholera_detect +#SBATCH --output=logs/%x_%A_%a.log +#SBATCH --error=logs/%x_%A_%a.log +#SBATCH --mem=10G +#SBATCH --cpus-per-task=1 +#SBATCH --time=01:00:00 +#SBATCH --export=ALL +#SBATCH --partition=shared-cpu +# EDIT: set upper bound to (N detection_set configs - 1) +# The exact value is printed by 00_make_configs.R +#SBATCH --array=0-67%10 + +module load GCCcore/12.3.0 GCC/12.3.0 libdeflate/1.18 Abseil/20230125.3 OpenMPI/4.1.5 R/4.3.2 GDAL/3.7.1 PostgreSQL/16.1 + + +# Set taxonomy credentials +source analysis/bash/set_taxonomy_api_key.sh + + +echo "===== Batch 2 start: $(date) =====" +echo "SLURM_JOB_ID: $SLURM_JOB_ID" +echo "SLURM_ARRAY_TASK_ID: $SLURM_ARRAY_TASK_ID" +echo "Hostname: $(hostname)" + +# --- R executable --- +if command -v module &>/dev/null; then + module load R 2>/dev/null || true +fi +RSCRIPT=$(command -v Rscript) +echo "Rscript: $RSCRIPT" + +# --- Config selection --- +CONFIGDIR=analysis/configs/detection_set + +if [ ! -d "$CONFIGDIR" ]; then + echo "ERROR: Config directory not found: $CONFIGDIR" + echo "Run: Rscript analysis/00_make_configs.R" + exit 1 +fi + +CONFIGNAMES=($(ls "$CONFIGDIR" | sort -V)) +N_CONFIGS=${#CONFIGNAMES[@]} +echo "Config set: $CONFIGDIR ($N_CONFIGS configs)" + +if [ "$SLURM_ARRAY_TASK_ID" -ge "$N_CONFIGS" ]; then + echo "Task ID $SLURM_ARRAY_TASK_ID >= N_CONFIGS $N_CONFIGS — nothing to do." + exit 0 +fi + +THISCONFIG="$CONFIGDIR/${CONFIGNAMES[$SLURM_ARRAY_TASK_ID]}" +echo "Config: $THISCONFIG" + +# --- Run Stage 2 --- +$RSCRIPT analysis/02_run_outbreak_detection.R -c "$THISCONFIG" --redo TRUE || { + echo "ERROR: 02_run_outbreak_detection.R failed for $THISCONFIG" + exit 1 +} + +echo "===== Batch 2 end: $(date) =====" diff --git a/analysis/config_defaults.yml b/analysis/config_defaults.yml new file mode 100644 index 0000000..ead69ef --- /dev/null +++ b/analysis/config_defaults.yml @@ -0,0 +1,87 @@ +# config_defaults.yml +# Default parameters for OutbreakExtractR HPC pipeline. +# These values are loaded first; 00_make_configs.R overwrites only the fields +# that vary across the country × time_window grid. +# +# CREDENTIALS: never stored here. Set as environment variables before running: +# export CHOLERA_API_USERNAME= +# export CHOLERA_API_KEY= + +# --- API endpoint --- +api_website: "https://cholera-taxonomy.middle-distance.com" + +# --- Geography (overridden per job) --- +# who_region: WHO region prefix used in taxdat location strings +# country_iso3: ISO3 country code (e.g. COD, NGA, ETH) +# taxdat location format built as: "CT-World::{who_region}::{country_iso3}" +who_region: "AFR" +country_iso3: "COD" + +# Which spatial scales to retain after pulling +spatial_scale_filter: + - "country" + - "admin1" + - "admin2" + - "admin3" + +# --- Time window (overridden per job in pull_set configs) --- +time_lower_bound: "2010-01-01" +time_upper_bound: "2015-12-31" + +# --- observation_filter() params --- +temporal_scale_filter: + - "daily" + - "weekly" +remove_na_sCh: true +remove_na_cCh: false +remove_na_locationperiod: false +minimum_daily_cases: 0 + +# --- identify_outbreaks() params --- +# threshold_type options: +# "fixed threshold" +# "mean weekly incidence rate" +# "outbreak_dependent threshold" +# "time_restricted threshold" +threshold_type: "mean weekly incidence rate" +fixed_outbreak_threshold: ~ # only used when threshold_type == "fixed threshold" +zero_case_assumption: true +# outbreak_start_definition options: "consecutive" or "dual_window" +outbreak_start_definition: "consecutive" +min_weeks_above: 2 +require_increasing_trend: false +tail_period: 6 +# When true, retain every location's full time series (outbreak_number = 0, +# Time Period = "non-outbreak period") instead of dropping locations with no +# detected outbreak. +keep_nonoutbreak_locations: true + +# --- dual_window params (ignored when outbreak_start_definition == "consecutive") --- +window_weeks: 3 +use_cumulative_trigger: true +# cumulative_trigger_type options: +# "cumulative_case_threshold" +# "cumulative_case_threshold_and_min_cases" +# "cumulative_case_threshold_and_nonzero_weeks" +cumulative_trigger_type: "cumulative_case_threshold_and_min_cases" +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +# When true, drop detected outbreaks whose total cases < cumulative_min_cases +filter_outbreaks_by_size: true + +# --- Population estimation --- +# Directory to cache WorldPop constrained rasters (100m, 2015-2030, per country/year). +# Downloaded automatically by add_population() on first use; reused on subsequent runs. +# Relative paths are resolved from the project root (here::here()). +raster_dir: "analysis/worldpop" + +# --- Job metadata --- +set_name: "default" +output_dir: "analysis/generated_data" + +# --- Output format --- +# Set to true to write spatial files as GeoParquet (requires sfarrow) and +# tabular files as Parquet (requires arrow). Default false uses GeoJSON + RDS. +use_geoparquet: false diff --git a/analysis/configs/detection_set/detection_set_1.yml b/analysis/configs/detection_set/detection_set_1.yml new file mode 100644 index 0000000..fecce2e --- /dev/null +++ b/analysis/configs/detection_set/detection_set_1.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: AGO +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_10.yml b/analysis/configs/detection_set/detection_set_10.yml new file mode 100644 index 0000000..3cdb1a7 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_10.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: COG +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_11.yml b/analysis/configs/detection_set/detection_set_11.yml new file mode 100644 index 0000000..7d8584a --- /dev/null +++ b/analysis/configs/detection_set/detection_set_11.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: EMR +country_iso3: DJI +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_12.yml b/analysis/configs/detection_set/detection_set_12.yml new file mode 100644 index 0000000..6e5db58 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_12.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: ERI +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_13.yml b/analysis/configs/detection_set/detection_set_13.yml new file mode 100644 index 0000000..64824ff --- /dev/null +++ b/analysis/configs/detection_set/detection_set_13.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: ETH +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_14.yml b/analysis/configs/detection_set/detection_set_14.yml new file mode 100644 index 0000000..75a9d20 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_14.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: GAB +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_15.yml b/analysis/configs/detection_set/detection_set_15.yml new file mode 100644 index 0000000..315bff0 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_15.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: GHA +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_16.yml b/analysis/configs/detection_set/detection_set_16.yml new file mode 100644 index 0000000..ffbcb7c --- /dev/null +++ b/analysis/configs/detection_set/detection_set_16.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: GIN +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_17.yml b/analysis/configs/detection_set/detection_set_17.yml new file mode 100644 index 0000000..44637a3 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_17.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: GMB +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_18.yml b/analysis/configs/detection_set/detection_set_18.yml new file mode 100644 index 0000000..9534f67 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_18.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: GNB +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_19.yml b/analysis/configs/detection_set/detection_set_19.yml new file mode 100644 index 0000000..bedaf39 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_19.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: GNQ +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_2.yml b/analysis/configs/detection_set/detection_set_2.yml new file mode 100644 index 0000000..90a4617 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_2.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: BDI +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_20.yml b/analysis/configs/detection_set/detection_set_20.yml new file mode 100644 index 0000000..87de834 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_20.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: KEN +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_21.yml b/analysis/configs/detection_set/detection_set_21.yml new file mode 100644 index 0000000..dc38112 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_21.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: LBR +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_22.yml b/analysis/configs/detection_set/detection_set_22.yml new file mode 100644 index 0000000..f8b51a9 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_22.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: LSO +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_23.yml b/analysis/configs/detection_set/detection_set_23.yml new file mode 100644 index 0000000..3f1722a --- /dev/null +++ b/analysis/configs/detection_set/detection_set_23.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: MDG +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_24.yml b/analysis/configs/detection_set/detection_set_24.yml new file mode 100644 index 0000000..bb947a4 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_24.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: MLI +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_25.yml b/analysis/configs/detection_set/detection_set_25.yml new file mode 100644 index 0000000..57fbade --- /dev/null +++ b/analysis/configs/detection_set/detection_set_25.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: MOZ +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_26.yml b/analysis/configs/detection_set/detection_set_26.yml new file mode 100644 index 0000000..5e514eb --- /dev/null +++ b/analysis/configs/detection_set/detection_set_26.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: MRT +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_27.yml b/analysis/configs/detection_set/detection_set_27.yml new file mode 100644 index 0000000..e93d008 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_27.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: MWI +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_28.yml b/analysis/configs/detection_set/detection_set_28.yml new file mode 100644 index 0000000..8921e30 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_28.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: NAM +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_29.yml b/analysis/configs/detection_set/detection_set_29.yml new file mode 100644 index 0000000..609c221 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_29.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: NER +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_3.yml b/analysis/configs/detection_set/detection_set_3.yml new file mode 100644 index 0000000..5ef0cca --- /dev/null +++ b/analysis/configs/detection_set/detection_set_3.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: BEN +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_30.yml b/analysis/configs/detection_set/detection_set_30.yml new file mode 100644 index 0000000..ab30ae8 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_30.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: NGA +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_31.yml b/analysis/configs/detection_set/detection_set_31.yml new file mode 100644 index 0000000..62a622b --- /dev/null +++ b/analysis/configs/detection_set/detection_set_31.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: RWA +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_32.yml b/analysis/configs/detection_set/detection_set_32.yml new file mode 100644 index 0000000..8e6e995 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_32.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: EMR +country_iso3: SDN +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_33.yml b/analysis/configs/detection_set/detection_set_33.yml new file mode 100644 index 0000000..1fb6917 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_33.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: SEN +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_34.yml b/analysis/configs/detection_set/detection_set_34.yml new file mode 100644 index 0000000..c1a128b --- /dev/null +++ b/analysis/configs/detection_set/detection_set_34.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: SLE +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_35.yml b/analysis/configs/detection_set/detection_set_35.yml new file mode 100644 index 0000000..83981d3 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_35.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: EMR +country_iso3: SOM +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_36.yml b/analysis/configs/detection_set/detection_set_36.yml new file mode 100644 index 0000000..fec21b2 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_36.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: SSD +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_37.yml b/analysis/configs/detection_set/detection_set_37.yml new file mode 100644 index 0000000..83e5ebb --- /dev/null +++ b/analysis/configs/detection_set/detection_set_37.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: SWZ +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_38.yml b/analysis/configs/detection_set/detection_set_38.yml new file mode 100644 index 0000000..e19598a --- /dev/null +++ b/analysis/configs/detection_set/detection_set_38.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: TCD +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_39.yml b/analysis/configs/detection_set/detection_set_39.yml new file mode 100644 index 0000000..cc39fa9 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_39.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: TGO +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_4.yml b/analysis/configs/detection_set/detection_set_4.yml new file mode 100644 index 0000000..69cda22 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_4.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: BFA +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_40.yml b/analysis/configs/detection_set/detection_set_40.yml new file mode 100644 index 0000000..ffa1e58 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_40.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: TZA::Mainland +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2024-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_41.yml b/analysis/configs/detection_set/detection_set_41.yml new file mode 100644 index 0000000..017573a --- /dev/null +++ b/analysis/configs/detection_set/detection_set_41.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: UGA +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_42.yml b/analysis/configs/detection_set/detection_set_42.yml new file mode 100644 index 0000000..120e5cd --- /dev/null +++ b/analysis/configs/detection_set/detection_set_42.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: EMR +country_iso3: YEM +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_43.yml b/analysis/configs/detection_set/detection_set_43.yml new file mode 100644 index 0000000..25947ae --- /dev/null +++ b/analysis/configs/detection_set/detection_set_43.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: ZAF +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_44.yml b/analysis/configs/detection_set/detection_set_44.yml new file mode 100644 index 0000000..77dfffb --- /dev/null +++ b/analysis/configs/detection_set/detection_set_44.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: ZMB +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_45.yml b/analysis/configs/detection_set/detection_set_45.yml new file mode 100644 index 0000000..8daf50e --- /dev/null +++ b/analysis/configs/detection_set/detection_set_45.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: ZWE +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_46.yml b/analysis/configs/detection_set/detection_set_46.yml new file mode 100644 index 0000000..f862ad8 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_46.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: TZA::Zanzibar +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2024-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_47.yml b/analysis/configs/detection_set/detection_set_47.yml new file mode 100644 index 0000000..3860437 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_47.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: COM +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_48.yml b/analysis/configs/detection_set/detection_set_48.yml new file mode 100644 index 0000000..1858565 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_48.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: EUR +country_iso3: MYT +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_49.yml b/analysis/configs/detection_set/detection_set_49.yml new file mode 100644 index 0000000..f9819fa --- /dev/null +++ b/analysis/configs/detection_set/detection_set_49.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AMR +country_iso3: HTI +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_5.yml b/analysis/configs/detection_set/detection_set_5.yml new file mode 100644 index 0000000..287bb85 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_5.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: BWA +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_50.yml b/analysis/configs/detection_set/detection_set_50.yml new file mode 100644 index 0000000..da488a5 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_50.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: EMR +country_iso3: LBN +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_51.yml b/analysis/configs/detection_set/detection_set_51.yml new file mode 100644 index 0000000..c6ee77a --- /dev/null +++ b/analysis/configs/detection_set/detection_set_51.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: SEAR +country_iso3: BGD +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_52.yml b/analysis/configs/detection_set/detection_set_52.yml new file mode 100644 index 0000000..f613c85 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_52.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: EMR +country_iso3: AFG +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_53.yml b/analysis/configs/detection_set/detection_set_53.yml new file mode 100644 index 0000000..bd61e99 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_53.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: EMR +country_iso3: PAK +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_54.yml b/analysis/configs/detection_set/detection_set_54.yml new file mode 100644 index 0000000..a0bb593 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_54.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: SEAR +country_iso3: IND +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_55.yml b/analysis/configs/detection_set/detection_set_55.yml new file mode 100644 index 0000000..4c026be --- /dev/null +++ b/analysis/configs/detection_set/detection_set_55.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: SEAR +country_iso3: MMR +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_56.yml b/analysis/configs/detection_set/detection_set_56.yml new file mode 100644 index 0000000..85e22d5 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_56.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: SEAR +country_iso3: NPL +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_57.yml b/analysis/configs/detection_set/detection_set_57.yml new file mode 100644 index 0000000..797361c --- /dev/null +++ b/analysis/configs/detection_set/detection_set_57.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: EMR +country_iso3: SYR +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_58.yml b/analysis/configs/detection_set/detection_set_58.yml new file mode 100644 index 0000000..6c6b21a --- /dev/null +++ b/analysis/configs/detection_set/detection_set_58.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: EMR +country_iso3: IRQ +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_59.yml b/analysis/configs/detection_set/detection_set_59.yml new file mode 100644 index 0000000..7b78286 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_59.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: WPR +country_iso3: PHL +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_6.yml b/analysis/configs/detection_set/detection_set_6.yml new file mode 100644 index 0000000..13a4870 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_6.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: CAF +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_60.yml b/analysis/configs/detection_set/detection_set_60.yml new file mode 100644 index 0000000..94df559 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_60.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AMR +country_iso3: DOM +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_61.yml b/analysis/configs/detection_set/detection_set_61.yml new file mode 100644 index 0000000..55bbb6d --- /dev/null +++ b/analysis/configs/detection_set/detection_set_61.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: SEAR +country_iso3: THA +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_62.yml b/analysis/configs/detection_set/detection_set_62.yml new file mode 100644 index 0000000..f0b3a1d --- /dev/null +++ b/analysis/configs/detection_set/detection_set_62.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: WPR +country_iso3: CHN +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_63.yml b/analysis/configs/detection_set/detection_set_63.yml new file mode 100644 index 0000000..9f7fa30 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_63.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: WPR +country_iso3: KHM +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_64.yml b/analysis/configs/detection_set/detection_set_64.yml new file mode 100644 index 0000000..929f0b9 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_64.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: WPR +country_iso3: MYS +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_65.yml b/analysis/configs/detection_set/detection_set_65.yml new file mode 100644 index 0000000..8163c8d --- /dev/null +++ b/analysis/configs/detection_set/detection_set_65.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: EMR +country_iso3: IRN +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_66.yml b/analysis/configs/detection_set/detection_set_66.yml new file mode 100644 index 0000000..63a9320 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_66.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: WPR +country_iso3: PNG +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_67.yml b/analysis/configs/detection_set/detection_set_67.yml new file mode 100644 index 0000000..c76ea01 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_67.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: EMR +country_iso3: SAU +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_68.yml b/analysis/configs/detection_set/detection_set_68.yml new file mode 100644 index 0000000..238e65c --- /dev/null +++ b/analysis/configs/detection_set/detection_set_68.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: EMR +country_iso3: ARE +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_7.yml b/analysis/configs/detection_set/detection_set_7.yml new file mode 100644 index 0000000..d308225 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_7.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: CIV +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_8.yml b/analysis/configs/detection_set/detection_set_8.yml new file mode 100644 index 0000000..5a81955 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_8.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: CMR +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/configs/detection_set/detection_set_9.yml b/analysis/configs/detection_set/detection_set_9.yml new file mode 100644 index 0000000..4944f78 --- /dev/null +++ b/analysis/configs/detection_set/detection_set_9.yml @@ -0,0 +1,36 @@ +api_website: https://cholera-taxonomy.middle-distance.com +who_region: AFR +country_iso3: COD +spatial_scale_filter: +- country +- admin1 +- admin2 +- admin3 +time_lower_bound: '2010-01-01' +time_upper_bound: '2015-12-31' +temporal_scale_filter: +- daily +- weekly +remove_na_sCh: yes +remove_na_cCh: no +remove_na_locationperiod: no +minimum_daily_cases: 0 +threshold_type: mean weekly incidence rate +fixed_outbreak_threshold: ~ +zero_case_assumption: yes +outbreak_start_definition: consecutive +min_weeks_above: 2 +require_increasing_trend: no +tail_period: 6 +window_weeks: 3 +use_cumulative_trigger: yes +cumulative_trigger_type: cumulative_case_threshold_and_min_cases +cumulative_windows: 3 +cumulative_case_threshold_ratio: 1.5 +cumulative_min_cases: 50 +nonzero_windows: ~ +filter_outbreaks_by_size: yes +raster_dir: analysis/worldpop +set_name: default +output_dir: analysis/generated_data +use_geoparquet: no diff --git a/analysis/data_issue_composite_geometry_2026-07-17.md b/analysis/data_issue_composite_geometry_2026-07-17.md new file mode 100644 index 0000000..357ca17 --- /dev/null +++ b/analysis/data_issue_composite_geometry_2026-07-17.md @@ -0,0 +1,114 @@ +# Composite Location Geometry — Investigation State (2026-07-17) + +Fleeting note. Originally paused after Step 0 of plan `resilient-nibbling-noodle` +(fix composite population via WorldPop lookup + keep non-outbreak locations). + +> **Status update (2026-08-06).** Step A and the `identify_outbreaks()` half of +> Step B have since landed; the findings below are still accurate but the +> "Remaining plan steps" section at the bottom was stale and has been corrected. +> See that section for what is actually left. + +## Problem recap + +Colleague's May-2025 pre-outbreak extraction vs June-2026 refactor: missing rows, all +**composite locations** (`|`-joined names). Countries MRT/MDG/SEN vanish entirely. + +Root cause (from prior session): composite `pop = 0` → NaN threshold → risk "low" → +no epidemic start → `identify_outbreaks()` returns empty frame → Stage 2 drops it. + +## Step 0 finding — composites have NO API geometry (triple-confirmed) + +Confirmed via (a) cached `raw_api_cache_AFR_BDI_*.rds`, (b) low-level live POST, +(c) the actual patched `taxdat::read_taxonomy_data_api` production path. + +Live BDI pull, window 2014-01-02 → 2014-05-01: +- 2192 obs = 656 composite + 1536 atomic. +- **All 656 composites: `location_period_id = NULL`, empty POINT geometry.** +- Atomic: 1328 POLYGON + 32 MULTIPOLYGON + 176 empty POINT. + +Why (raw JSON, pre-processing): +- Composite obs carry a real `attributes.location_id` (e.g. 29697) but + `attributes.location_period_id = NULL`. Geometry (shape) hangs off a *location_period*, + not a location_id → no shape returned. +- **The client code does NOT drop geometry** — the source response already lacks the link; + `read_taxonomy_data_api`'s left-join on the missing id faithfully yields empty geometry. + +Raw `location_periods` block has **no hidden geometry**: 43 LPs, 43 shapes, +all referenced by atomic obs, **0 orphan LPs, 0 orphan shapes**. + +No API route resolves a shape from a `location_id` (probed +`locations/{id}`, `locations/{id}/location_periods`, `location_periods?location_id=`, +`shapes?location_id=`, `location_periods/by_location` → all 404/500). + +Only remaining way to know if the DB itself stores a composite shape: **direct-SQL path** +(`taxdat::build_geoms_query` / `get_unique_db_shps` / `read_taxonomy_locationperiods_sql`). +Not yet attempted (needs DB creds). + +## Why reconstruction is hard — vocabulary mismatch + +BDI pull = 91 unique locations (50 atomic + 41 composite). Atomic and composite units live in +**different admin vocabularies**: +- Atomic = health-system **"Sanitary Districts"** (admin3) under **province-name** admin2, + e.g. `AFR::BDI::Ruyigi::Butezi Sanitary District`. +- Composite children = **communes**; many composites use **ISO province codes** at admin2, + e.g. `AFR::BDI::BI-CA::(Cankuzo|Cendajuru|Kigamba)`. + +So `build_composite_locations()` exact-match child lookup mostly fails +(36/47 composites → no child matched; only 5 all-children, 6 partial). Root names DO overlap +(Butezi, Bubanza, Cankuzo…) but exact equality breaks on: +1. `" Sanitary District"` suffix, and +2. `BI-XX` code vs province name at admin2. +Even normalized, communes ≠ sanitary districts (different partitions of a province) — not a +full 1:1. + +## Current pipeline behaviour (existing `stage1_geo_AFR_BDI_composite.geojson`) + +Only 6 composites currently get any geometry, all via **parent-polygon fallback** (areas come +in identical pairs = shared parent province). The rest get summed-child / parent-pop / 0. + +## Open decision (RESOLVED) + +WorldPop-on-geometry gives a **true sub-area denominator only for ~1/4 of BDI composites**; +the rest fall back to the parent area. Options that were on the table: +- (a) Direct-SQL DB check on composite `location_id`s for a server-side shape. +- (b) Proceed with child-union / parent-fallback reconstruction as planned. +- (c) Improve child-name matching first (strip "Sanitary District", map `BI-XX` → + province name) to recover more real child-unions. + +**Chosen: (c) then (b).** `match_children_to_lps()` now strips the +" Sanitary District" suffix and resolves each child to a single LP, and +`build_composite_locations()` reconstructs geometry from the recovered children +with a parent-polygon fallback. + +The premise of the "pop > 0 → fixes the drop bug" argument has since been +**retracted**. Substituting the parent-area population to avoid `pop = 0` trades +one defect for another: the parent is a strictly larger area, so the denominator +is wrong in a known direction. The population fix (2026-08-06) makes NA — not a +parent approximation and not 0 — the honest value, gated behind +`allow_parent_pop_fallback` (default FALSE). Note that `pop = 0` was never merely +"missing": `get_outbreak_threshold()` sends `is.na(pop)` to the "low" surveillance +class, but `pop == 0` gives `sCh/pop == Inf`, which classifies as "high" — a zero +denominator *flips* the threshold. + +## Remaining plan steps + +Done: +- ~~Step A~~ — `raster_dir` param, `estimate_pop_for_geometries()`, geometry-derived + pop as the primary source, header comment corrected. Wired in + `analysis/02_run_outbreak_detection.R:250`. +- ~~`keep_nonoutbreak_locations` param + non-empty else branch~~ — + `R/identify_outbreaks.R:50,153`. +- ~~Docs~~ — `roxygen2::roxygenise()` run 2026-08-06. + +Still open: +- Wire `keep_nonoutbreak_locations = TRUE` into + `analysis/02_run_outbreak_detection.R` (the parameter exists and defaults to + FALSE for backward compatibility, but the analysis layer does not yet pass it, + so Stage 2 still drops locations with no detected outbreak). +- Add a testthat case for `keep_nonoutbreak_locations` in + `tests/testthat/test-identify_outbreaks.R` — there is none. +- Stage 2 dry-run on BDI. + +Test scripts: `/tmp/api_composite_test.R`, `/tmp/api_taxdat_test.R`, +`/tmp/raw_composite_dump.R`, `/tmp/probe_raw_shapes.R`, `/tmp/list_bdi_locations.R` +(raw response cached at `/tmp/bdi_live_raw.rds`). diff --git a/analysis/generated_data/.gitkeep b/analysis/generated_data/.gitkeep new file mode 100644 index 0000000..e69de29 diff --git a/analysis/parse_detect_logs.R b/analysis/parse_detect_logs.R new file mode 100644 index 0000000..ceb429d --- /dev/null +++ b/analysis/parse_detect_logs.R @@ -0,0 +1,362 @@ +#!/usr/bin/env Rscript +# parse_detect_logs.R +# Parses all Stage 2 (detection) SLURM logs, classifies outcomes, and writes +# summary CSVs. +# +# Supports two log formats: +# OLD (batch ≤ 44825740): per-window Processing: lines with Rows: summaries +# NEW (batch ≥ 44869016): single-pass pipeline with Loaded N observations … +# +# Usage: +# Rscript analysis/parse_detect_logs.R [--log-dir analysis/logs] \ +# [--out analysis/detect_log_summary.csv] \ +# [--latest-only] + +suppressPackageStartupMessages({ + library(dplyr) + library(readr) + library(stringr) + library(purrr) + library(tidyr) +}) + +# ── CLI args ────────────────────────────────────────────────────────────────── +args <- commandArgs(trailingOnly = TRUE) + +get_arg <- function(flag, default) { + idx <- which(args == flag) + if (length(idx) && length(args) >= idx + 1) args[[idx + 1]] else default +} + +log_dir <- get_arg("--log-dir", "analysis/logs") +out_csv <- get_arg("--out", "analysis/detect_log_summary.csv") +latest_only <- any(args == "--latest-only") + +# ── Fatal-error classification (new format) ─────────────────────────────────── +# Applied to the tail of logs whose outcome is "error". +fatal_error_classes <- list( + exactextractr_error = "exactextractr|CPP_stats", + purrr_map_error = "Error in `purrr::map", + r_error_generic = "^Error in |^Error:" +) + +classify_fatal_error <- function(tail_lines) { + combined <- paste(tail_lines, collapse = "\n") + for (cls in names(fatal_error_classes)) { + if (grepl(fatal_error_classes[[cls]], combined, perl = TRUE)) return(cls) + } + "unknown_error" +} + +# ── Per-window warning classification (old format) ──────────────────────────── +window_error_classes <- list( + missing_value_logical = "missing value where TRUE/FALSE needed", + too_long_vector = "result would be too long a vector", + subscript_out_of_range = "subscript out of bounds|attempt to select less than one", + no_non_missing_min = "no non-missing arguments to min", + trigger_alert_failed = "trigger_alert\\(\\) failed", + identify_failed_other = "identify_outbreaks\\(\\) failed" +) + +classify_window_error <- function(msg) { + for (cls in names(window_error_classes)) { + if (grepl(window_error_classes[[cls]], msg, perl = TRUE)) return(cls) + } + "unknown_window_error" +} + +# ── Per-log parser ───────────────────────────────────────────────────────────── +parse_log <- function(path) { + + lines <- tryCatch(readLines(path, warn = FALSE), error = function(e) character(0)) + + empty_row <- tibble( + log_file = basename(path), + slurm_job_id = NA_character_, + array_task_id = NA_integer_, + config = NA_character_, + who_region = NA_character_, + country_iso3 = NA_character_, + outcome = "unreadable", + error_class = NA_character_, + # --- new-format fields --- + n_obs_loaded = NA_integer_, + total_rows = NA_integer_, + outbreak_rows = NA_integer_, + no_results_reason = NA_character_, + # --- old-format per-window fields (NA for new-format logs) --- + n_stage1_files = NA_integer_, + n_windows_empty = NA_integer_, + n_windows_no_ob = NA_integer_, + n_windows_ran = NA_integer_, + n_windows_failed = NA_integer_, + window_error_types = NA_character_, + failed_run_ids = NA_character_ + ) + + if (length(lines) == 0) return(empty_row) + + # ── Helper ─────────────────────────────────────────────────────────────────── + grab <- function(pattern) { + m <- str_match(lines, pattern) + hit <- m[!is.na(m[, 2]), 2, drop = TRUE] + if (length(hit)) hit[[1]] else NA_character_ + } + + # ── Header fields ──────────────────────────────────────────────────────────── + slurm_job_id <- str_match(basename(path), "^cholera_detect_(\\d+)_")[, 2] + array_task_id <- as.integer(grab("SLURM_ARRAY_TASK_ID:\\s*(\\d+)")) + config <- grab("^Config:\\s*(.+)") + who_region <- grab("\\$\\s*who_region\\s*:\\s*chr\\s*\"([^\"]+)\"") + country_iso3 <- grab("\\$\\s*country_iso3\\s*:\\s*chr\\s*\"([^\"]+)\"") + + # ── Detect log format ──────────────────────────────────────────────────────── + # New format loads sf (→ "Linking to GEOS" appears even for early-exit logs). + # Old format never loads sf. + new_format <- any(grepl("Linking to GEOS", lines, fixed = TRUE)) || + any(grepl("Loaded \\d+ cleaned observations", lines)) + + # ── New-format fields ──────────────────────────────────────────────────────── + n_obs_loaded <- as.integer(grab("Loaded (\\d+) cleaned observations")) + + total_rows <- { + m <- str_match(lines, "Total rows:\\s*(\\d+)") + hit <- m[!is.na(m[, 2]), 2] + if (length(hit)) as.integer(hit[[1]]) else NA_integer_ + } + outbreak_rows <- { + m <- str_match(lines, "Outbreak-period rows:\\s*(\\d+)") + hit <- m[!is.na(m[, 2]), 2] + if (length(hit)) as.integer(hit[[1]]) else NA_integer_ + } + + # ── Old-format per-window fields ───────────────────────────────────────────── + n_stage1_files <- as.integer(grab("Found (\\d+) Stage 1 file")) + n_windows_empty <- if (!new_format) sum(grepl("Empty Stage 1 file", lines, fixed = TRUE)) else NA_integer_ + n_windows_no_ob <- if (!new_format) sum(grepl("No outbreaks detected", lines, fixed = TRUE)) else NA_integer_ + n_windows_ran <- if (!new_format) sum(grepl("Rows:\\s*\\d+\\s*\\|\\s*Outbreak-period rows", lines)) else NA_integer_ + + warn_lines <- lines[grepl("(identify_outbreaks|trigger_alert)\\(\\) failed for", lines)] + n_windows_failed <- if (!new_format) length(warn_lines) else NA_integer_ + + window_error_types <- if (!new_format && length(warn_lines) > 0) { + warn_lines |> map_chr(classify_window_error) |> unique() |> sort() |> paste(collapse = ";") + } else { + NA_character_ + } + + failed_run_ids <- if (!new_format && length(warn_lines) > 0) { + m <- str_match(warn_lines, + "(?:identify_outbreaks|trigger_alert)\\(\\) failed for ([^:]+):") + m[!is.na(m[, 2]), 2] |> paste(collapse = ";") + } else { + NA_character_ + } + + # ── Outcome sentinels ───────────────────────────────────────────────────────── + halted <- any(grepl("Execution halted", lines, fixed = TRUE)) + error_line <- any(grepl("^ERROR:", lines)) + skipped <- any(grepl("Stage 2 output already exists", lines, fixed = TRUE)) + stage2_ok <- any(grepl("Stage 2 complete.", lines, fixed = TRUE)) + batch_end <- any(grepl("Batch 2 end:", lines, fixed = TRUE)) + completed <- stage2_ok || batch_end + + # "no results" covers both old and new warning messages + no_results <- any(grepl("No outbreak results to save", lines, fixed = TRUE)) || + any(grepl("No outbreaks detected for:", lines, fixed = TRUE)) || + any(grepl("No Stage 1 observations for:", lines, fixed = TRUE)) || + any(grepl("No observations after filtering for:", lines, fixed = TRUE)) || + any(grepl("No data after normalization for:", lines, fixed = TRUE)) + + # Extract the specific reason (first match wins; ordered most-specific first) + no_results_reason <- NA_character_ + if (no_results) { + for (pat in c( + "No Stage 1 observations for:", + "No observations after filtering for:", + "No data after normalization for:", + "No outbreaks detected for:", + "No outbreak results to save" + )) { + hit <- lines[grepl(pat, lines, fixed = TRUE)] + if (length(hit)) { no_results_reason <- str_trim(hit[[1]]); break } + } + } + + # ── Outcome ─────────────────────────────────────────────────────────────────── + n_failed <- if (!is.na(n_windows_failed)) n_windows_failed else 0L + + outcome <- case_when( + halted | error_line ~ "error", + skipped & !completed ~ "skipped", + completed & no_results & n_failed > 0 ~ "success_no_results_with_warnings", + completed & no_results ~ "success_no_results", + completed & n_failed > 0 ~ "success_with_warnings", + completed ~ "success", + TRUE ~ "incomplete" + ) + + # ── Fatal-error classification ──────────────────────────────────────────────── + error_class <- if (outcome == "error") { + classify_fatal_error(tail(lines, 80)) + } else { + NA_character_ + } + + tibble( + log_file = basename(path), + slurm_job_id = slurm_job_id, + array_task_id = array_task_id, + config = config, + who_region = who_region, + country_iso3 = country_iso3, + outcome = outcome, + error_class = error_class, + n_obs_loaded = n_obs_loaded, + total_rows = total_rows, + outbreak_rows = outbreak_rows, + no_results_reason = no_results_reason, + n_stage1_files = n_stage1_files, + n_windows_empty = n_windows_empty, + n_windows_no_ob = n_windows_no_ob, + n_windows_ran = n_windows_ran, + n_windows_failed = n_windows_failed, + window_error_types = window_error_types, + failed_run_ids = failed_run_ids + ) +} + +# ── Main ─────────────────────────────────────────────────────────────────────── +log_files <- list.files(log_dir, + pattern = "^cholera_detect.*\\.log$", + full.names = TRUE) + +if (length(log_files) == 0) stop("No detection .log files found in: ", log_dir) + +if (latest_only) { + batch_ids <- str_match(basename(log_files), "^cholera_detect_(\\d+)_")[, 2] + latest_id <- max(batch_ids, na.rm = TRUE) + log_files <- log_files[!is.na(batch_ids) & batch_ids == latest_id] + message(sprintf("--latest-only: restricting to batch %s (%d files)", + latest_id, length(log_files))) +} + +message(sprintf("Parsing %d detection log files from '%s' ...", + length(log_files), log_dir)) + +results <- map(log_files, parse_log, .progress = TRUE) |> list_rbind() + +# ── Console summary ──────────────────────────────────────────────────────────── +batches <- sort(unique(results$slurm_job_id)) +cat(sprintf("\n%d batch(es) found: %s\n", length(batches), paste(batches, collapse = ", "))) + +print_batch_summary <- function(df, label) { + cat(sprintf("\n========== %s ==========\n", label)) + + cat("--- Outcome ---\n") + df |> + count(outcome, sort = TRUE) |> + mutate(pct = sprintf("%.1f%%", 100 * n / sum(n))) |> + print(n = Inf) + + # Error details + err_df <- df |> filter(outcome == "error") + if (nrow(err_df) > 0) { + cat(sprintf("--- Error class (%d job(s)) ---\n", nrow(err_df))) + err_df |> + count(error_class, sort = TRUE) |> + mutate(pct = sprintf("%.1f%%", 100 * n / sum(n))) |> + print(n = Inf) + cat("--- Errored jobs ---\n") + err_df |> + select(log_file, array_task_id, who_region, country_iso3, error_class) |> + print(n = Inf) + } + + # No-results breakdown + nr_df <- df |> filter(str_starts(outcome, "success_no_results")) + if (nrow(nr_df) > 0) { + cat(sprintf("--- No-results reasons (%d country/ies) ---\n", nrow(nr_df))) + nr_df |> + # trim to just the prefix before ":" to group by type + mutate(reason_type = str_extract(no_results_reason, + "^No [^:]+")) |> + count(reason_type, sort = TRUE) |> + print(n = Inf) + } + + # Row counts (new format) + new_fmt <- df |> filter(!is.na(n_obs_loaded)) + if (nrow(new_fmt) > 0) { + cat("--- Output rows (new-format jobs) ---\n") + new_fmt |> + summarise( + countries_ok = sum(outcome == "success"), + total_obs_loaded = sum(n_obs_loaded, na.rm = TRUE), + total_output_rows = sum(total_rows, na.rm = TRUE), + total_outbreak_rows = sum(outbreak_rows, na.rm = TRUE) + ) |> print() + } + + # Window counts (old format) + old_fmt <- df |> filter(!is.na(n_windows_ran)) + if (nrow(old_fmt) > 0) { + cat("--- Window counts (old-format jobs) ---\n") + old_fmt |> + summarise( + countries_run = sum(outcome %in% c("success", "success_with_warnings", + "success_no_results", + "success_no_results_with_warnings")), + total_stage1_files = sum(n_stage1_files, na.rm = TRUE), + windows_empty = sum(n_windows_empty, na.rm = TRUE), + windows_no_ob = sum(n_windows_no_ob, na.rm = TRUE), + windows_ran = sum(n_windows_ran, na.rm = TRUE), + windows_failed = sum(n_windows_failed, na.rm = TRUE), + total_output_rows = sum(total_rows, na.rm = TRUE) + ) |> print() + + failed_df <- old_fmt |> filter(!is.na(n_windows_failed) & n_windows_failed > 0) + if (nrow(failed_df) > 0) { + cat(sprintf("--- Per-window error types (%d countries affected) ---\n", + nrow(failed_df))) + failed_df |> + mutate(error_type = str_split(window_error_types, ";")) |> + unnest(error_type) |> + count(error_type, sort = TRUE) |> + mutate(pct = sprintf("%.1f%%", 100 * n / sum(n))) |> + print(n = Inf) + + cat("--- Countries with per-window failures ---\n") + failed_df |> + select(who_region, country_iso3, n_windows_failed, window_error_types, + n_windows_ran, total_rows) |> + arrange(desc(n_windows_failed)) |> + print(n = 40) + } + } + + incomplete <- df |> filter(outcome == "incomplete") + if (nrow(incomplete) > 0) { + cat(sprintf("--- Incomplete jobs (%d) ---\n", nrow(incomplete))) + incomplete |> + select(log_file, array_task_id, who_region, country_iso3) |> + print(n = Inf) + } +} + +# Per-batch summaries +for (b in batches) { + print_batch_summary(results |> filter(slurm_job_id == b), + paste("Batch", b)) +} + +# Combined summary across all batches (latest per country if duplicated) +cat("\n========== Combined (latest batch per country) ==========\n") +latest <- results |> + arrange(desc(slurm_job_id)) |> + distinct(who_region, country_iso3, .keep_all = TRUE) +print_batch_summary(latest, "Latest run per country") + +# ── Write CSV ───────────────────────────────────────────────────────────────── +write_csv(results, out_csv) +message(sprintf("\nSummary written to: %s", out_csv)) diff --git a/analysis/pull_set_errors_2026-06-09.md b/analysis/pull_set_errors_2026-06-09.md new file mode 100644 index 0000000..6d7921c --- /dev/null +++ b/analysis/pull_set_errors_2026-06-09.md @@ -0,0 +1,79 @@ +# Pull Set Error Analysis — 2026-06-09 + +Job array: `44806696` (315 tasks, `analysis/configs/pull_set/`) + +## Summary + +| Outcome | Count | % | +|---|---|---| +| Success | 149 | 47.3% | +| Failed | 166 | 52.7% | + +--- + +## Error Groups + +### 1. Missing column in `dplyr::rename()` — 103 jobs (62% of failures) + +`analysis/01_pull_data.R` lines 165–174: the `rename()` call is unconditional — `any_of()` guards the preceding `select()` but not the rename. Columns absent from the API response cause the job to fail. + +**Fix**: apply the cCh guard pattern (rename if present, else `mutate(col = NA)`) to all optional columns. + +| Missing column | Count | +|---|---| +| `relationships.observation_collection.data.id` | 90 | +| `attributes.fields.deaths` | 7 | +| `attributes.location_period_id` | 5 | +| `attributes.fields.suspected_cases` | 1 | + +Affected job IDs: 1, 4, 5, 6, 8, 9, 11, 12, 15, 16, 18, 19, 22, 25, 30, 32, 33, 40, 43, 44, 46, 47, 50, 51, 54, 57, 58, 60, 61, 64, 65, 67, 68, 71, 72, 74, 75, 78, 79, 82, 83, 85, 86, 88, 89, 90, 92, 93, 95, 96, 97, 99, 100, 102, 103, 104, 106, 109, 110, 114, 116, 117, 121, 123, 124, 131, 137, 180, 187, 194, 205, 207, 213, 214, 215, 220, 221, 222, 228, 229, 232, 233, 235, 236, 242, 243, 249, 250, 257, 263, 264, 266, 271, 273, 278, 280, 282, 284, 285, 286, 289, 292, 312 + +--- + +### 2. Inconsistent `start_weekday` — 27 jobs (16% of failures) + +`Error: All observations should have the same start_weekday. Please run set_uniform_wday_start on this dataset.` + +`set_uniform_wday_start()` is called in `01_pull_data.R` but the error fires downstream, suggesting some code path bypasses or re-introduces mixed weekdays after normalization. + +Affected: 2, 13, 20, 81, 128, 135, 142, 144, 149, 151, 252, 287, 291, 293, 294, 298, 299, 300, 301, 303, 305, 306, 307, 308, 310, 313, 314 + +--- + +### 3. `purrr::map()` — missing value where TRUE/FALSE needed — 22 jobs (13% of failures) + +Occurs in `add_population()` during `exactextractr::exact_extract()` on invalid or degenerate geometries. Likely a NULL/empty geometry row slipping through before the spatial join. + +Affected: 0, 7, 14, 21, 35, 42, 49, 56, 63, 70, 77, 84, 91, 132, 139, 146, 153, 165, 168, 175, 189, 203 + +--- + +### 4. SSL/network timeout — 9 jobs (5% of failures) + +`Error in curl::curl_fetch_memory(): Timeout was reached: [cholera-taxonomy.middle-distance.com] SSL connection timeout` + +Transient. Safe to requeue. + +Affected: 26, 27, 28, 29, 31, 36, 37, 38, 39 + +--- + +### 5. `dplyr::left_join()` — missing `location_period_id` — 3 jobs (2% of failures) + +`"Join columns in y must be present in the data. Problem with location_period_id."` + +Downstream join fails when `location_period_id` is NA throughout (from Error 1 unfixed, or when the column is absent). Investigate after Error 1 fix. + +Affected: 41, 277, 296 + +--- + +### 6. `[readValues] cannot read values` — 2 jobs (1% of failures) + +Two distinct root causes, both handled in `R/get_pop.R` / `R/add_population.R`. + +**Job 24 (NGA):** Corrupted WorldPop download. Both R2024B and R2025A use identical LZW+PREDICTOR=2 compression (standard, readable by all GDAL versions). The "Using code not yet in table" / `TIFFReadEncodedTile` errors are produced by a truncated LZW stream — i.e., a partial download of the 150 MB NGA raster. Fix: `download_worldpop_constrained()` now reads one tile after download to verify the file is intact; if corrupt, it deletes the cached file and retries with the next release (R2024B). On a clean re-run the R2025A download will succeed and no fallback is needed. + +**Job 53 (ZMB):** Single-observation LP had a POINT geometry (centroid coordinates only). `exactextractr::exact_extract()` only supports polygon geometries (`st_dimension == 2`). Fix: non-polygon geometries are now filtered out alongside empty geometries in `add_population()`, with pop set to NA. + +Affected: 24, 53 diff --git a/analysis/scratch_api_vs_stage1.R b/analysis/scratch_api_vs_stage1.R new file mode 100644 index 0000000..c09e7ea --- /dev/null +++ b/analysis/scratch_api_vs_stage1.R @@ -0,0 +1,225 @@ +# scratch_api_vs_stage1.R — Compare raw API cache to Stage 1 flat output +# +# For every country × time window that has a raw_api_cache_*.rds file, this +# script counts rows at each filtering stage and compares to the corresponding +# stage1_flat_*.rds to identify where data is being lost (or is genuinely absent). +# +# Filtering stages tracked (in pipeline order): +# 1. n_api_raw — total rows returned by the API (before any processing) +# 2. n_api_primary — rows where attributes.primary == TRUE +# 3. n_stage1_all — all rows in Stage 1 flat (including phantom zeroes) +# 4. n_stage1_obs — non-phantom rows in Stage 1 flat (real observations) +# 5. n_stage1_sCh — non-phantom rows with sCh > 0 +# +# Between stage 2 and 3 the pipeline also applies observation_filter() (temporal +# scale, spatial scale, NA-sCh removal, minimum daily cases) and aggregation, +# so n_stage1_obs ≤ n_api_primary is expected. The script flags windows where +# n_api_primary > 0 but n_stage1_obs == 0 as "potential data loss" for review. +# +# Output: +# analysis/generated_data/api_vs_stage1.csv — full row-by-row table +# console summary table — printed at end + +library(here) +library(dplyr) +library(purrr) +library(tidyr) +library(stringr) +library(lubridate) + +stage1_dir <- here("analysis/generated_data") + +# --------------------------------------------------------------------------- +# 1. Discover raw API cache files and parse metadata +# --------------------------------------------------------------------------- + +cache_files <- list.files(stage1_dir, + pattern = "^raw_api_cache_.*\\.rds$", + full.names = TRUE) + +m <- str_match(basename(cache_files), + "^raw_api_cache_([A-Z]+)_([^_]+)_TL(\\d{8})_TR(\\d{8})") + +cache_meta <- tibble( + cache_path = cache_files, + run_id = str_remove(basename(cache_files), "^raw_api_cache_") |> + str_remove("\\.rds$"), + who_region = m[, 2], + iso3 = m[, 3], + tl_str = m[, 4], + tr_str = m[, 5] +) |> + filter(!is.na(who_region), !is.na(iso3)) |> + mutate( + TL = ymd(tl_str), + TR = ymd(tr_str), + flat_path = file.path(stage1_dir, + paste0("stage1_flat_", run_id, ".rds")) + ) + +message("Found ", nrow(cache_meta), " API cache files across ", + n_distinct(cache_meta$iso3), " countries") +message(" Stage 1 flat file present: ", + sum(file.exists(cache_meta$flat_path)), " / ", nrow(cache_meta)) + +# --------------------------------------------------------------------------- +# 2. Per-window comparison function +# --------------------------------------------------------------------------- + +compare_window <- function(cache_path, flat_path) { + + # --- Raw API cache --- + api <- tryCatch(readRDS(cache_path), error = function(e) NULL) + + if (is.null(api) || nrow(api) == 0) { + return(tibble( + n_api_raw = 0L, + n_api_primary = 0L, + flat_exists = file.exists(flat_path), + n_stage1_all = NA_integer_, + n_stage1_obs = NA_integer_, + n_stage1_sCh = NA_integer_ + )) + } + + n_api_raw <- nrow(api) + + # "primary" lives as attributes.primary in raw API sf objects + primary_col <- intersect(c("primary", "attributes.primary"), names(api)) + if (length(primary_col) == 0) { + # Fallback: assume all primary if column absent + n_api_primary <- n_api_raw + } else { + n_api_primary <- sum(api[[primary_col[1]]] == TRUE, na.rm = TRUE) + } + + # --- Stage 1 flat file --- + if (!file.exists(flat_path)) { + return(tibble( + n_api_raw = n_api_raw, + n_api_primary = n_api_primary, + flat_exists = FALSE, + n_stage1_all = NA_integer_, + n_stage1_obs = NA_integer_, + n_stage1_sCh = NA_integer_ + )) + } + + flat <- tryCatch(readRDS(flat_path), error = function(e) NULL) + + if (is.null(flat) || nrow(flat) == 0) { + return(tibble( + n_api_raw = n_api_raw, + n_api_primary = n_api_primary, + flat_exists = TRUE, + n_stage1_all = 0L, + n_stage1_obs = 0L, + n_stage1_sCh = 0L + )) + } + + obs <- filter(flat, !phantom) + tibble( + n_api_raw = n_api_raw, + n_api_primary = n_api_primary, + flat_exists = TRUE, + n_stage1_all = nrow(flat), + n_stage1_obs = nrow(obs), + n_stage1_sCh = sum(obs$sCh > 0, na.rm = TRUE) + ) +} + +# --------------------------------------------------------------------------- +# 3. Run comparison (with progress bar) +# --------------------------------------------------------------------------- + +message("Comparing API cache vs Stage 1 flat files …") + +results <- map2( + cache_meta$cache_path, + cache_meta$flat_path, + compare_window, + .progress = TRUE +) + +comparison <- bind_cols(cache_meta, list_rbind(results)) |> + mutate( + # Classify each window + status = case_when( + n_api_raw == 0 ~ "api_empty", + n_api_primary == 0 ~ "api_nonprimary_only", + !flat_exists ~ "stage1_missing", + n_stage1_obs == 0 & n_api_primary > 0 ~ "data_lost", + n_stage1_sCh == 0 & n_stage1_obs > 0 ~ "zero_sCh", + TRUE ~ "ok" + ), + # Retention rate: what fraction of primary API rows appear as Stage 1 obs + # (can be > 1 after zero-filling / aggregation, but usually ≤ 1) + retention = if_else(n_api_primary > 0, + n_stage1_obs / n_api_primary, + NA_real_) + ) + +# --------------------------------------------------------------------------- +# 4. Save full table +# --------------------------------------------------------------------------- + +out_csv <- here("analysis/generated_data/api_vs_stage1.csv") +readr::write_csv(comparison |> select(-cache_path, -flat_path), out_csv) +message("Saved: ", basename(out_csv)) + +# --------------------------------------------------------------------------- +# 5. Console summary +# --------------------------------------------------------------------------- + +cat("\n=== API cache vs Stage 1 — window status counts ===\n") +comparison |> + count(status, sort = TRUE) |> + print() + +cat("\n=== 'data_lost' windows: primary API rows > 0 but Stage 1 obs == 0 ===\n") +lost <- comparison |> + filter(status == "data_lost") |> + select(who_region, iso3, TL, TR, n_api_raw, n_api_primary, + n_stage1_all, n_stage1_obs) + +if (nrow(lost) == 0) { + cat("None — no data loss detected.\n") +} else { + cat(nrow(lost), "windows affected across", + n_distinct(lost$iso3), "countries\n\n") + print(lost, n = 50) +} + +cat("\n=== 'stage1_missing' windows: cache exists but no Stage 1 file ===\n") +missing_s1 <- comparison |> + filter(status == "stage1_missing") |> + select(who_region, iso3, TL, TR, n_api_raw, n_api_primary) + +if (nrow(missing_s1) == 0) { + cat("None.\n") +} else { + cat(nrow(missing_s1), "windows missing Stage 1 output\n\n") + missing_s1 |> + count(who_region, iso3, name = "n_missing") |> + arrange(desc(n_missing)) |> + print(n = 30) +} + +cat("\n=== Countries with ≥1 'data_lost' window ===\n") +comparison |> + filter(status == "data_lost") |> + count(who_region, iso3, name = "n_lost_windows") |> + arrange(desc(n_lost_windows)) |> + print(n = 30) + +cat("\n=== Retention rate summary (n_stage1_obs / n_api_primary) ===\n") +comparison |> + filter(status == "ok") |> + summarise( + median_retention = median(retention, na.rm = TRUE), + p05_retention = quantile(retention, 0.05, na.rm = TRUE), + p95_retention = quantile(retention, 0.95, na.rm = TRUE), + n_windows = n() + ) |> + print() diff --git a/analysis/scratch_coverage.R b/analysis/scratch_coverage.R new file mode 100644 index 0000000..4452257 --- /dev/null +++ b/analysis/scratch_coverage.R @@ -0,0 +1,267 @@ +# scratch_coverage.R — Data coverage across countries from Stage 1 flat files +# +# Reads every stage1_flat_*.rds, summarises per (country, time-window): +# - whether the file is empty +# - number of non-phantom observed rows +# - total suspected cases (sCh) +# - number of unique sub-national locations (admin1+) +# +# Produces three figures saved to analysis/generated_data/: +# 1. Presence/absence heatmap (coverage_presence.png) +# 2. Observed-row-count heatmap (coverage_obs_rows.png) +# 3. Suspected-case-count heatmap (coverage_sCh.png) + +library(here) +library(dplyr) +library(purrr) +library(tidyr) +library(stringr) +library(lubridate) +library(ggplot2) +library(forcats) + +# --------------------------------------------------------------------------- +# 1. Collect all Stage 1 flat files and parse metadata from filenames +# --------------------------------------------------------------------------- + +stage1_dir <- here("analysis/generated_data") + +files_raw <- list.files(stage1_dir, + pattern = "^stage1_flat_.*\\.rds$", + full.names = TRUE) + +# Use str_match so variable-length region codes (AFR/AMR/EMR/SEAR/WPR/EUR) +# are captured correctly — lookbehind can't handle variable width in R. +m <- str_match(basename(files_raw), + "^stage1_flat_([A-Z]+)_([^_]+)_TL(\\d{8})_TR(\\d{8})") + +files <- tibble( + path = files_raw, + fname = basename(files_raw), + who_region = m[, 2], + iso3_raw = m[, 3], + tl_str = m[, 4], + tr_str = m[, 5] +) |> + mutate( + TL = lubridate::ymd(tl_str), + TR = lubridate::ymd(tr_str), + window_mid = TL + as.numeric(TR - TL) / 2, + window_yr = year(TL) + ) |> + filter(!is.na(TL), !is.na(TR), !is.na(who_region), !is.na(iso3_raw)) + +message("Found ", nrow(files), " Stage 1 files across ", + n_distinct(files$iso3_raw), " country/sub-country units") + +# --------------------------------------------------------------------------- +# 2. Read each file and summarise +# --------------------------------------------------------------------------- + +message("Reading files … (this takes ~30-60 s)") + +summarise_file <- function(path) { + d <- tryCatch(readRDS(path), error = function(e) NULL) + if (is.null(d) || nrow(d) == 0) { + return(tibble(n_rows = 0L, n_obs = 0L, total_sCh = 0, n_locations = 0L, + empty = TRUE)) + } + obs <- filter(d, !phantom) + tibble( + n_rows = nrow(d), + n_obs = nrow(obs), + total_sCh = sum(obs$sCh, na.rm = TRUE), + n_locations = n_distinct(obs$location[obs$spatial_scale != "country"], + na.rm = TRUE), + empty = FALSE + ) +} + +summaries <- map(files$path, summarise_file, .progress = TRUE) + +coverage <- bind_cols(files, list_rbind(summaries)) |> + mutate( + status = case_when( + empty | n_obs == 0 ~ "no data", # empty file OR phantom rows only + total_sCh == 0 ~ "zero cases", # real obs but all sCh = 0 + TRUE ~ "has data" # real obs with sCh > 0 + ), + status = factor(status, levels = c("has data", "zero cases", "no data")) + ) + +# --------------------------------------------------------------------------- +# 3. Shared plot helpers +# --------------------------------------------------------------------------- + +# WHO-region colour palette (for y-axis strip / row label colouring) +region_pal <- c(AFR = "#E05C2F", AMR = "#2E86AB", EMR = "#A23B72", + SEAR = "#F18F01", WPR = "#C73E1D", EUR = "#3B1F2B") + +# Order countries: by WHO region, then alphabetically within region +country_order <- coverage |> + distinct(iso3_raw, who_region) |> + arrange(who_region, iso3_raw) |> + pull(iso3_raw) + +coverage <- coverage |> + mutate(iso3_f = factor(iso3_raw, levels = rev(country_order))) # rev so top = first + +# X-axis: use TL directly; tile width = actual window duration in days. +# This avoids the visual gap that arises from using floor_date(mid, "quarter"), +# which maps the 3 windows to Q1/Q3/Q4 (skipping Q2) and leaves a 3-month +# blank strip mid-year because geom_tile's default width = min spacing (92 d). +coverage <- coverage |> + mutate( + win_days = as.numeric(TR - TL) # tile width in days + ) + +# X-axis breaks: Jan 1 of each year +year_breaks <- tibble( + break_dt = seq( + floor_date(min(coverage$TL), "year"), + floor_date(max(coverage$TL), "year"), + by = "1 year" + ) +) |> mutate(label = year(break_dt)) + +base_theme <- theme_minimal(base_size = 10) + + theme( + axis.text.x = element_text(angle = 45, hjust = 1, size = 7), + axis.text.y = element_text(size = 7), + panel.grid = element_blank(), + legend.position = "bottom", + plot.title = element_text(face = "bold"), + strip.text = element_text(face = "bold", size = 8) + ) + +# Y-axis coloured by WHO region +region_colour_scale <- function(df) { + cols <- region_pal[df |> distinct(iso3_raw, who_region) |> + arrange(factor(iso3_raw, levels = rev(country_order))) |> + pull(who_region)] + scale_y_discrete(labels = setNames( + str_replace(rev(country_order), "\n", "::"), + rev(country_order) + )) +} + +# --------------------------------------------------------------------------- +# 4. Figure 1 — Presence / absence heatmap +# --------------------------------------------------------------------------- + +fig1_pal <- c( + "has data" = "#2C7BB6", # blue — real sCh data + "zero cases" = "#FDB462", # amber — obs present, sCh all zero + "no data" = "#DDDDDD" # light grey — no real observations +) + +p1 <- ggplot(coverage, + aes(x = TL + win_days / 2, y = iso3_f, fill = status, + width = win_days)) + + geom_tile(colour = "white", linewidth = 0.15) + + scale_fill_manual(values = fig1_pal, name = "Stage 1 status", + drop = FALSE) + + scale_x_date( + breaks = year_breaks$break_dt, + labels = year_breaks$label, + expand = expansion(add = 0) + ) + + facet_grid(who_region ~ ., scales = "free_y", space = "free_y") + + labs( + title = "Stage 1 data coverage — presence / absence", + x = NULL, y = NULL + ) + + base_theme + +out1 <- here("analysis/generated_data/coverage_presence.png") +ggsave(out1, p1, width = 14, height = 10, dpi = 150) +message("Saved: ", basename(out1)) + +# --------------------------------------------------------------------------- +# 5. Figure 2 — Observed-row heatmap (log10 scale) +# --------------------------------------------------------------------------- + +p2 <- coverage |> + mutate(n_obs_plot = if_else(n_obs == 0, NA_integer_, n_obs)) |> + ggplot(aes(x = TL + win_days / 2, y = iso3_f, fill = n_obs_plot, + width = win_days)) + + geom_tile(colour = "white", linewidth = 0.15) + + scale_fill_viridis_c( + name = "Observed rows\n(log10 + 1)", + trans = "log1p", + option = "plasma", + na.value = "#BBBBBB", + labels = scales::label_comma() + ) + + scale_x_date( + breaks = year_breaks$break_dt, + labels = year_breaks$label, + expand = expansion(add = 0) + ) + + facet_grid(who_region ~ ., scales = "free_y", space = "free_y") + + labs( + title = "Stage 1 data coverage — observed (non-phantom) rows per window", + x = NULL, y = NULL + ) + + base_theme + +out2 <- here("analysis/generated_data/coverage_obs_rows.png") +ggsave(out2, p2, width = 14, height = 10, dpi = 150) +message("Saved: ", basename(out2)) + +# --------------------------------------------------------------------------- +# 6. Figure 3 — Suspected-case heatmap (log10 scale) +# --------------------------------------------------------------------------- + +p3 <- coverage |> + mutate(sCh_plot = if_else(total_sCh == 0, NA_real_, total_sCh)) |> + ggplot(aes(x = TL + win_days / 2, y = iso3_f, fill = sCh_plot, + width = win_days)) + + geom_tile(colour = "white", linewidth = 0.15) + + scale_fill_viridis_c( + name = "Suspected cases\n(log10 + 1)", + trans = "log1p", + option = "inferno", + na.value = "#BBBBBB", + labels = scales::label_comma() + ) + + scale_x_date( + breaks = year_breaks$break_dt, + labels = year_breaks$label, + expand = expansion(add = 0) + ) + + facet_grid(who_region ~ ., scales = "free_y", space = "free_y") + + labs( + title = "Stage 1 data coverage — total suspected cases (sCh) per window", + x = NULL, y = NULL + ) + + base_theme + +out3 <- here("analysis/generated_data/coverage_sCh.png") +ggsave(out3, p3, width = 14, height = 10, dpi = 150) +message("Saved: ", basename(out3)) + +# --------------------------------------------------------------------------- +# 7. Quick console summary +# --------------------------------------------------------------------------- + +cat("\n=== Coverage summary ===\n") +coverage |> + count(who_region, status) |> + tidyr::pivot_wider(names_from = status, values_from = n, values_fill = 0L) |> + print() + +cat("\nCountries with ≥1 window of real data:\n") +coverage |> + filter(status == "has data") |> + distinct(who_region, iso3_raw) |> + count(who_region) |> + print() + +cat("\nCountries with NO real data in any window:\n") +no_data <- coverage |> + group_by(iso3_raw) |> + summarise(any_data = any(status == "has data")) |> + filter(!any_data) |> + pull(iso3_raw) +print(no_data) diff --git a/analysis/scratch_stage2_summary.R b/analysis/scratch_stage2_summary.R new file mode 100644 index 0000000..f32d0f8 --- /dev/null +++ b/analysis/scratch_stage2_summary.R @@ -0,0 +1,305 @@ +# scratch_stage2_summary.R +# Scratchpad: coverage and descriptive statistics of Stage 2 outbreak outputs +# +# Run from project root: +# Rscript analysis/scratch_stage2_summary.R + +library(here) +library(dplyr) +library(tidyr) +library(ggplot2) +library(patchwork) +library(scales) +library(lubridate) +library(forcats) +library(stringr) + +# ── 0. Load & combine ───────────────────────────────────────────────────────── + +stage2_files <- list.files( + here("analysis/generated_data"), + pattern = "^stage2_.*\\.rds$", + full.names = TRUE +) + +message("Loading ", length(stage2_files), " stage2 files …") + +combined <- lapply(stage2_files, function(f) { + tryCatch({ + df <- readRDS(f) + if (nrow(df) == 0) return(NULL) + df + }, error = function(e) { + warning("Failed: ", basename(f), " — ", conditionMessage(e)); NULL + }) +}) |> bind_rows() + +message("Combined: ", nrow(combined), " rows, ", n_distinct(combined$country_iso3), " countries") + +# ── 1. Derived fields ───────────────────────────────────────────────────────── + +scale_levels <- c("country", "admin1", "admin2", "admin3", "admin4 or lower") +existing_scale <- intersect(scale_levels, unique(as.character(combined$spatial_scale))) + +combined <- combined |> + mutate( + year = year(TL), + in_outbreak = outbreak_number > 0, + spatial_scale = fct_relevel(as.character(spatial_scale), existing_scale) + ) + +real <- combined |> filter(!phantom) + +# Full observation span per country (min TL → max TR across all time windows) +# Gap weeks fall inside this span; they contribute 0 to all numerators. +country_span <- combined |> + group_by(who_region, country_iso3) |> + summarise( + span_start = min(TL, na.rm = TRUE), + span_end = max(TR, na.rm = TRUE), + span_weeks = as.numeric(difftime(max(TR, na.rm = TRUE), + min(TL, na.rm = TRUE), units = "weeks")), + .groups = "drop" + ) + +# ── 2. Panel A — Outbreak burden by country ─────────────────────────────────── +# Denominator = full span_weeks (gaps count as 0 outbreak-weeks). + +# Use country-scale rows only so that outbreak_weeks counts unique *calendar* +# weeks, not location-weeks across all admin levels. Mixing all-scale +# location-week counts with a calendar-week denominator (span_weeks) inflates +# pct_outbreak by 10-28× for countries with dense sub-national data (COD → +# 2800%, IRQ → 1949%, etc.). +country_summary <- real |> + filter(spatial_scale == "country") |> + group_by(who_region, country_iso3) |> + summarise( + outbreak_weeks = n_distinct(TL[in_outbreak]), # unique calendar weeks in outbreak + n_outbreaks = max(outbreak_number, na.rm = TRUE), + total_sCh = sum(sCh, na.rm = TRUE), + .groups = "drop" + ) |> + left_join(country_span, by = c("who_region", "country_iso3")) |> + mutate( + pct_outbreak = outbreak_weeks / span_weeks, + who_region = factor(who_region, levels = c("AFR", "EMR", "SEAR", "AMR", "EUR", "WPR")) + ) + +region_order <- country_summary |> + group_by(who_region) |> + summarise(med = median(pct_outbreak, na.rm = TRUE)) |> + arrange(desc(med)) |> + pull(who_region) + +pa <- country_summary |> + mutate(who_region = fct_relevel(who_region, as.character(region_order))) |> + ggplot(aes(x = fct_reorder(country_iso3, pct_outbreak), y = pct_outbreak, + colour = who_region)) + + geom_segment(aes(xend = country_iso3, y = 0, yend = pct_outbreak), + linewidth = 0.5, alpha = 0.6) + + geom_point(size = 2) + + scale_y_continuous(labels = percent_format(accuracy = 1), limits = c(0, NA)) + + scale_colour_brewer(palette = "Dark2", name = "WHO region") + + coord_flip() + + facet_wrap(~who_region, scales = "free_y", ncol = 3) + + labs( + title = "A Outbreak burden by country", + subtitle = "Outbreak-weeks ÷ full observation span (data gaps treated as 0)", + x = NULL, y = "% of span-weeks in outbreak" + ) + + theme_minimal(base_size = 9) + + theme( + legend.position = "none", + panel.grid.major.y = element_blank(), + strip.text = element_text(face = "bold"), + axis.text.y = element_text(size = 6.5) + ) + +# ── 3. Panel B — Temporal heatmap with explicit data gaps ───────────────────── +# Three visual states: +# grey = no data at all (gap) +# light yellow = data present but no outbreak detected +# yellow→red = outbreak detected (intensity = log1p outbreak-weeks) + +year_range <- range(combined$year, na.rm = TRUE) +all_years <- seq(year_range[1], year_range[2]) + +# Use ALL spatial scales (non-phantom) so that countries whose early years +# only have admin2/admin3 data (e.g. COD 2010-2013) are not falsely shown as +# gaps. outbreak_weeks = distinct calendar weeks where ANY location was in +# outbreak — n_distinct(TL) avoids double-counting a week covered by multiple +# admin levels. +country_yr <- combined |> + filter(!phantom) |> + group_by(who_region, country_iso3, year) |> + summarise( + has_data = TRUE, + outbreak_weeks = n_distinct(TL[in_outbreak]), + .groups = "drop" + ) + +ctry_order <- country_span |> + arrange(who_region, country_iso3) |> + pull(country_iso3) + +year_grid <- expand_grid( + country_iso3 = unique(combined$country_iso3), + year = all_years +) |> + left_join(distinct(combined, who_region, country_iso3), by = "country_iso3") |> + left_join(country_yr, by = c("who_region", "country_iso3", "year")) |> + mutate( + # NA → gap (no rows for this country-year at country scale) + # 0 → covered, no outbreak + # >0 → covered, with outbreaks + fill_val = if_else(is.na(has_data), NA_real_, as.numeric(outbreak_weeks)) + ) + +pb <- year_grid |> + mutate(country_iso3 = factor(country_iso3, levels = ctry_order)) |> + ggplot(aes(x = year, y = country_iso3, fill = log1p(fill_val))) + + geom_tile(colour = "white", linewidth = 0.15) + + scale_fill_gradient( + low = "#ffffcc", + high = "#b10026", + na.value = "grey72", + name = "log1p(outbreak-weeks)" + ) + + scale_x_continuous(breaks = seq(2010, 2024, 2)) + + facet_grid(who_region ~ ., scales = "free_y", space = "free_y") + + labs( + title = "B Outbreak activity over time", + subtitle = "Yellow = data, no outbreak | Red = outbreak | Grey = data gap", + x = "Year", y = NULL + ) + + theme_minimal(base_size = 9) + + theme( + axis.text.y = element_text(size = 6), + legend.position = "bottom", + legend.key.width = unit(1.2, "cm"), + strip.text.y = element_text(face = "bold", angle = 0) + ) + +# ── 4. Panel C — Outbreak prevalence by spatial scale ──────────────────────── +# Denominator = ALL rows (phantom + non-phantom) per WHO region × scale. +# Phantom rows are the zero-case weeks already filled in; this makes +# "no-data weeks within a window" zero-numerator but positive-denominator. + +scale_colors <- c( + "country" = "#4e79a7", + "admin1" = "#59a14f", + "admin2" = "#f28e2b", + "admin3" = "#e15759", + "admin4 or lower" = "#b07aa1" +) + +scale_summary <- combined |> + group_by(who_region, spatial_scale) |> + summarise( + total_loc_weeks = n(), + outbreak_loc_weeks = sum(in_outbreak, na.rm = TRUE), + pct_outbreak = outbreak_loc_weeks / total_loc_weeks, + .groups = "drop" + ) + +pc <- scale_summary |> + mutate(who_region = fct_relevel(who_region, as.character(region_order))) |> + ggplot(aes(x = who_region, y = pct_outbreak, fill = spatial_scale)) + + geom_col(position = "dodge", width = 0.75) + + scale_fill_manual(values = scale_colors, name = "Spatial scale") + + scale_y_continuous(labels = percent_format(accuracy = 1)) + + labs( + title = "C Outbreak prevalence by spatial scale", + subtitle = "% of all covered location-weeks (incl. phantom zero-weeks) in outbreak", + x = "WHO region", y = "% of location-weeks in outbreak" + ) + + theme_minimal(base_size = 9) + + theme(legend.position = "right") + +# ── 5. Panel D — Outbreak sCh per span-week ─────────────────────────────────── +# Normalise outbreak-period sCh by the full observation span (gaps = 0 sCh). +# Countries with more data gaps will appear lower, as intended. + +cases_country <- real |> + filter(in_outbreak) |> + group_by(who_region, country_iso3) |> + summarise(total_ob_sCh = sum(sCh, na.rm = TRUE), .groups = "drop") |> + right_join(country_span, by = c("who_region", "country_iso3")) |> + mutate( + total_ob_sCh = coalesce(total_ob_sCh, 0), + ob_sCh_per_span_wk = total_ob_sCh / span_weeks + ) |> + filter(ob_sCh_per_span_wk > 0) + +pd <- cases_country |> + mutate(who_region = fct_relevel(who_region, as.character(region_order))) |> + ggplot(aes(x = who_region, y = ob_sCh_per_span_wk, colour = who_region)) + + geom_jitter(width = 0.2, height = 0, alpha = 0.7, size = 2) + + geom_boxplot(alpha = 0, outlier.shape = NA, linewidth = 0.6) + + scale_y_log10(labels = label_number(scale_cut = cut_short_scale())) + + scale_colour_brewer(palette = "Dark2") + + labs( + title = "D Outbreak sCh per span-week", + subtitle = "Total outbreak-period sCh ÷ full observation span (gaps = 0); log scale", + x = "WHO region", y = "sCh / span-week (log)" + ) + + theme_minimal(base_size = 9) + + theme(legend.position = "none") + +# ── 6. Compose & save ───────────────────────────────────────────────────────── + +layout <- " +AABB +AABB +AABB +CCDD +" + +fig <- pa + pb + pc + pd + + plot_layout(design = layout) + + plot_annotation( + title = "Stage 2 outputs — coverage and outbreak descriptive statistics", + subtitle = paste0( + n_distinct(combined$country_iso3), " countries · ", + n_distinct(combined$who_region), " WHO regions · ", + min(year(combined$TL), na.rm = TRUE), "–", max(year(combined$TR), na.rm = TRUE) + ), + theme = theme( + plot.title = element_text(size = 13, face = "bold"), + plot.subtitle = element_text(size = 9, colour = "grey40") + ) + ) + +out_path <- here("analysis/generated_data/stage2_summary_fig.pdf") +ggsave(out_path, fig, width = 16, height = 14, units = "in", device = cairo_pdf) +message("Saved: ", out_path) + +# ── 7. Quick console summary ────────────────────────────────────────────────── + +cat("\n── Stage 2 summary ──────────────────────────────────────────────────────\n") +cat("Files loaded: ", length(stage2_files), "\n") +cat("Total rows: ", format(nrow(combined), big.mark = ","), "\n") +cat("Non-phantom rows: ", format(nrow(real), big.mark = ","), "\n") +cat("Countries: ", n_distinct(combined$country_iso3), "\n") +cat("WHO regions: ", paste(sort(unique(combined$who_region)), collapse = ", "), "\n") +cat("Date range: ", + as.character(min(combined$TL, na.rm = TRUE)), "to", + as.character(max(combined$TR, na.rm = TRUE)), "\n") +cat("Outbreak-period rows: ", format(sum(real$in_outbreak, na.rm = TRUE), big.mark = ","), "\n") +cat("Total sCh (all): ", format(sum(combined$sCh, na.rm = TRUE), big.mark = ","), "\n") +cat("Total sCh (outbreaks):", + format(sum(real$sCh[real$in_outbreak], na.rm = TRUE), big.mark = ","), "\n") +cat("─────────────────────────────────────────────────────────────────────────\n") + +print( + country_summary |> + group_by(who_region) |> + summarise( + n_countries = n(), + with_outbreaks = sum(n_outbreaks > 0), + med_pct_ob = median(pct_outbreak, na.rm = TRUE), + total_sCh = sum(total_sCh), + .groups = "drop" + ) |> + arrange(desc(total_sCh)) +) diff --git a/analysis/utils.R b/analysis/utils.R new file mode 100644 index 0000000..70b4379 --- /dev/null +++ b/analysis/utils.R @@ -0,0 +1,132 @@ +# utils.R — shared helpers for the OutbreakExtractR analysis pipeline +# Sourced by 00_make_configs.R, 01_pull_data.R, 02_run_outbreak_detection.R, +# and 03_aggregate_results.R. + +library(yaml) +library(here) +library(stringr) +library(purrr) +library(optparse) + +# --------------------------------------------------------------------------- +# Config I/O +# --------------------------------------------------------------------------- + +get_default_config <- function() { + yaml::read_yaml(here("analysis/config_defaults.yml")) +} + +get_config_dir <- function() { + here("analysis/configs") +} + +#' Write one YAML config file per row of config_specs. +#' Loads config_defaults.yml, then overwrites each field present in config_specs. +write_configs <- function(config_specs, set_name) { + out_dir <- file.path(get_config_dir(), set_name) + dir.create(out_dir, recursive = TRUE, showWarnings = FALSE) + walk(seq_len(nrow(config_specs)), function(x) { + cfg <- get_default_config() + for (nm in names(as.list(config_specs[x, ]))) { + cfg[[nm]] <- config_specs[[nm]][x] + } + yaml::write_yaml(cfg, file.path(out_dir, paste0(set_name, "_", x, ".yml"))) + }) + message("Wrote ", nrow(config_specs), " configs to: ", out_dir) +} + +#' Parse arguments from a YAML config file (-c flag) or direct CLI flags. +#' enforce_options: character vector of option names that should always come +#' from the CLI (overriding the config), useful for --redo. +make_options_from_config <- function(option_list, enforce_options = NULL) { + opt_ <- parse_args(OptionParser(option_list = option_list)) + opt <- if (!is.null(opt_$config)) yaml::read_yaml(opt_$config) else opt_ + if (!is.null(enforce_options)) { + for (i in enforce_options) opt[[i]] <- opt_[[i]] + } + opt +} + +# --------------------------------------------------------------------------- +# taxdat location string helper +# --------------------------------------------------------------------------- + +#' Build the location string expected by taxdat::pull_taxonomy_data(). +#' Format: "CT-World::{who_region}::{country_iso3}" +make_taxdat_location <- function(who_region, country_iso3) { + paste("CT-World", who_region, country_iso3, sep = "::") +} + +# --------------------------------------------------------------------------- +# Filename helpers — encode key params in output names for reproducibility +# --------------------------------------------------------------------------- + +#' Canonical run identifier string shared by Stage 1 and Stage 2 filenames. +make_run_id <- function(opt) { + str_glue( + "{opt$who_region}_{opt$country_iso3}", + "_TL{str_remove_all(opt$time_lower_bound, '-')}", + "_TR{str_remove_all(opt$time_upper_bound, '-')}", + "_thresh-{str_replace_all(opt$threshold_type, ' ', '_')}", + "_start-{opt$outbreak_start_definition}" + ) +} + +#' Stage 1 geo file — raw sf object pulled from API (retains geometry). +#' Extension is .parquet (GeoParquet) when use_geoparquet is TRUE, else .geojson. +make_stage1_geo_filename <- function(opt) { + ext <- if (isTRUE(opt$use_geoparquet)) ".parquet" else ".geojson" + file.path(here(opt$output_dir), paste0("stage1_geo_", make_run_id(opt), ext)) +} + +#' Stage 1 flat file — normalized tabular data (geometry dropped). +#' Extension is .parquet when use_geoparquet is TRUE, else .rds. +#' This is the input to Stage 2 outbreak detection. +make_stage1_flat_filename <- function(opt) { + ext <- if (isTRUE(opt$use_geoparquet)) ".parquet" else ".rds" + file.path(here(opt$output_dir), paste0("stage1_flat_", make_run_id(opt), ext)) +} + +#' Stage 2 file — outbreak detection results for one country (all windows). +#' Extension is .parquet when use_geoparquet is TRUE, else .rds. +make_stage2_filename <- function(who_region, country_iso3, use_geoparquet = FALSE) { + ext <- if (isTRUE(use_geoparquet)) ".parquet" else ".rds" + file.path( + here("analysis/generated_data"), + paste0("stage2_", who_region, "_", country_iso3, ext) + ) +} + +# --------------------------------------------------------------------------- +# Format-aware I/O helpers +# --------------------------------------------------------------------------- + +#' Write a flat data frame to .rds (default) or .parquet (use_geoparquet = TRUE). +write_tabular <- function(df, path, use_geoparquet = FALSE) { + if (isTRUE(use_geoparquet)) arrow::write_parquet(df, path) + else saveRDS(df, path) +} + +#' Read a flat data frame from .rds (default) or .parquet (use_geoparquet = TRUE). +read_tabular <- function(path, use_geoparquet = FALSE) { + if (isTRUE(use_geoparquet)) arrow::read_parquet(path) + else readRDS(path) +} + +#' Write a spatial sf object to .geojson (default) or .parquet (use_geoparquet = TRUE). +#' delete_dsn = TRUE is required: sf::st_write refuses to overwrite by default. +write_spatial <- function(sf_obj, path, use_geoparquet = FALSE) { + if (isTRUE(use_geoparquet)) sfarrow::st_write_parquet(sf_obj, path) + else sf::st_write(sf_obj, path, driver = "GeoJSON", delete_dsn = TRUE, quiet = TRUE) +} + +# --------------------------------------------------------------------------- +# Logging helper +# --------------------------------------------------------------------------- + +print_options <- function(opt) { + cat("---------- Run config ----------\n") + str(opt) + cat("--------------------------------\n") +} + diff --git a/logs/.gitkeep b/logs/.gitkeep new file mode 100644 index 0000000..e69de29 diff --git a/man/add_alert_columns.Rd b/man/add_alert_columns.Rd index 5ba1689..e5b4848 100644 --- a/man/add_alert_columns.Rd +++ b/man/add_alert_columns.Rd @@ -6,11 +6,6 @@ \usage{ add_alert_columns(basedf, alertdf) } -\arguments{ -\item{basedf}{} - -\item{alertdf}{} -} \value{ dataframe } diff --git a/man/add_alert_columns_outbreak.Rd b/man/add_alert_columns_outbreak.Rd index 64f5e16..3d3028c 100644 --- a/man/add_alert_columns_outbreak.Rd +++ b/man/add_alert_columns_outbreak.Rd @@ -6,11 +6,6 @@ \usage{ add_alert_columns_outbreak(basedf, alertdf) } -\arguments{ -\item{basedf}{} - -\item{alertdf}{} -} \value{ dataframe } diff --git a/man/add_alert_stringency.Rd b/man/add_alert_stringency.Rd index 6e53afd..d5422b8 100644 --- a/man/add_alert_stringency.Rd +++ b/man/add_alert_stringency.Rd @@ -6,9 +6,6 @@ \usage{ add_alert_stringency(basedf) } -\arguments{ -\item{basedf}{} -} \value{ dataframe } diff --git a/man/add_country_column.Rd b/man/add_country_column.Rd index 9aec5d5..2d5a0c1 100644 --- a/man/add_country_column.Rd +++ b/man/add_country_column.Rd @@ -6,9 +6,6 @@ \usage{ add_country_column(basedf) } -\arguments{ -\item{basedf}{} -} \value{ dataframe } diff --git a/man/add_outcome_bin.Rd b/man/add_outcome_bin.Rd index 9738650..552c5af 100644 --- a/man/add_outcome_bin.Rd +++ b/man/add_outcome_bin.Rd @@ -6,11 +6,6 @@ \usage{ add_outcome_bin(basedf, bins) } -\arguments{ -\item{basedf}{} - -\item{bins}{} -} \value{ dataframe } diff --git a/man/add_population.Rd b/man/add_population.Rd new file mode 100644 index 0000000..7576666 --- /dev/null +++ b/man/add_population.Rd @@ -0,0 +1,74 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/add_population.R +\name{add_population} +\alias{add_population} +\title{add_population} +\usage{ +add_population( + normalized_data, + raw_sf, + country_iso3, + raster_dir = "worldpop", + boundary_cache_dir = "country_boundaries" +) +} +\arguments{ +\item{normalized_data}{data.frame: weekly normalized data from the Stage 1 +pipeline (output of fill_missing_lps()). Must contain columns +location_period_id and TL.} + +\item{raw_sf}{sf object: geometry-bearing data returned by +taxdat::pull_taxonomy_data() (before geometry is dropped). Must contain +a location_period_id, locationPeriod_id, or lctn_pr column and an sf +geometry column.} + +\item{country_iso3}{character: ISO3 country code (e.g. "COD"). Used to +download the correct WorldPop raster and to fetch the country boundary +for the UN population adjustment factor.} + +\item{raster_dir}{character: directory for caching WorldPop raster files. +Defaults to "worldpop". Created if it does not exist.} + +\item{boundary_cache_dir}{character or NULL: directory for caching national +boundaries used by the UN adjustment. Passed to +\code{get_country_boundary()}.} +} +\value{ +normalized_data with a numeric \code{pop} column added, plus +provenance columns: \code{pop_source}, \code{pop_geom_dup_n}, +\code{pop_geom_dup_class}, \code{pop_year_obs}, \code{pop_year_raster}, +\code{pop_natl_ref}, \code{adj_factor} and \code{adj_factor_flag}. +Rows whose location_period_id has no matching geometry in raw_sf receive +\code{pop = NA} (never 0 — see the note on zero denominators below). + +\code{pop} is \code{NA}, never 0, whenever a population cannot be +established. \code{get_outbreak_threshold()} routes \code{is.na(pop)} to +the "low" surveillance class, but \code{pop == 0} yields +\code{sCh / pop == Inf}, which classifies as "high" — so a zero denominator +silently flips the outbreak-detection threshold rather than merely +producing a bad rate. +} +\description{ +Attach WorldPop population estimates to a normalized weekly +data frame. Intended as a Stage 1 pipeline step immediately after +fill_missing_lps(), and before writing to parquet. + +A single population value is computed per unique location_period_id (not +per week), which is correct: get_outbreak_threshold() and +identify_epidemic_start() both use pop as a static denominator for +incidence calculations. + +Population is estimated by: +1. Looking up each location_period_id geometry in raw_sf (already in +memory — no extra DB call). +2. Clamping the representative year (median TL) to 2015-2030 (WorldPop +constrained raster range). +3. For each unique year: loading the raster ONCE, computing the UN +adjustment factor with one exact_extract call on the country boundary, +then extracting ALL LP populations with a single vectorized +exact_extract call. The raster is released immediately after. + +This avoids the 2N-loads-per-year penalty that results from calling +get_pop() per LP (each call loads the raster twice: once for the LP +geometry and once inside estimate_adj_factors() for the country boundary). +} diff --git a/man/attach_empty_pop_provenance.Rd b/man/attach_empty_pop_provenance.Rd new file mode 100644 index 0000000..ed475e1 --- /dev/null +++ b/man/attach_empty_pop_provenance.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/add_population.R +\name{attach_empty_pop_provenance} +\alias{attach_empty_pop_provenance} +\title{attach_empty_pop_provenance} +\usage{ +attach_empty_pop_provenance(d) +} +\arguments{ +\item{d}{data.frame to attach columns to.} +} +\value{ +\code{d} with the provenance columns added. +} +\description{ +Attach the population provenance schema with empty values, so +that early-return paths in \code{add_population()} produce the same columns +as the full path. Consumers can then rely on the schema unconditionally. +} +\keyword{internal} diff --git a/man/band_adj_factor.Rd b/man/band_adj_factor.Rd new file mode 100644 index 0000000..3707ca3 --- /dev/null +++ b/man/band_adj_factor.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_country_boundary.R +\name{band_adj_factor} +\alias{band_adj_factor} +\title{band_adj_factor} +\usage{ +band_adj_factor(adj_factor) +} +\arguments{ +\item{adj_factor}{numeric: the raw \code{tot_UN / country_raw} ratio.} +} +\value{ +a list with \code{value} (the factor to use) and \code{flag}, one of +"ok", "wide", or "clamped". +} +\description{ +Apply the accept / flag / clamp banding to a UN population +adjustment factor. + +The observed corpus-wide range is 1.005-1.034, so any value far outside +1.0 indicates that the raster total was extracted on the wrong polygon +rather than that the country genuinely disagrees with WPP. Rather than +propagate such a factor, extreme values are clamped to 1.0 (leaving the +population unadjusted) and flagged. +} diff --git a/man/build_composite_locations.Rd b/man/build_composite_locations.Rd new file mode 100644 index 0000000..04647cc --- /dev/null +++ b/man/build_composite_locations.Rd @@ -0,0 +1,78 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/build_composite_locations.R +\name{build_composite_locations} +\alias{build_composite_locations} +\title{build_composite_locations} +\usage{ +build_composite_locations( + normalized, + raw_sf, + iso3, + raster_dir = NULL, + allow_parent_pop_fallback = FALSE +) +} +\arguments{ +\item{normalized}{data.frame: the normalized weekly data AFTER +add_population(), so atomic location_period_ids carry a pop column.} + +\item{raw_sf}{sf: geometry-bearing data from the Stage 1 geo files, keyed by +location_period_id.} + +\item{iso3}{character: ISO3 country code, used to namespace composite ids and +to gate the known-LP corrections for SSD/SOM.} + +\item{raster_dir}{character or NULL: when supplied, each composite's +population is estimated directly from the constrained WorldPop raster on the +composite geometry via \code{estimate_pop_for_geometries()}.} + +\item{allow_parent_pop_fallback}{logical: when TRUE, a composite whose +population cannot be established from its own children may inherit its +parent location's population. Defaults to FALSE. + +The parent of a composite is a strictly larger area, so inheriting its +population overstates the denominator by however much of the parent the +composite does not cover — the same pathology as the parent-inherited +geometry duplicates that \code{detect_duplicate_geometries()} flags. The +honest default is to leave such a composite with \code{pop = NA}, which +routes it to the "low" surveillance class, rather than to silently +substitute a value that is wrong in a known direction.} +} +\value{ +list(data = normalized with composites resolved, +geometry = sf(lctn_pr, area_per_1km2, geometry) for composites, +or NULL when there are none). +} +\description{ +Resolve composite locations (NA location_period_id, "|"-joined +names) into synthetic "composite_loc_\if{html}{\out{}}_\if{html}{\out{}}" pseudo location periods so +that Stage 2 outbreak detection can run on them. Geometry is the union of a +composite's children's geometries from raw_sf (parent-location fallback when +children are not individually observed). Population: when \code{raster_dir} +is supplied, it is estimated directly from WorldPop on that composite +geometry (the true sub-area denominator); otherwise it is the sum of the +children's WorldPop populations (attached by add_population()), with a +parent-location pop fallback. +} +\section{Population precedence}{ + +Sources are tried in this order, and the first that yields a usable +(positive, non-NA) value wins: +\enumerate{ +\item \code{composite_union} — WorldPop extracted on the union of the +composite's \emph{children's} geometries. This is the true sub-area +denominator. +\item \code{child_sum} — the sum of the children's own populations. +\item \code{parent_fallback} — the parent location's population, only +when \code{allow_parent_pop_fallback = TRUE}. +} + +Ordering matters: the raster extraction is only treated as +\code{composite_union} when the geometry it ran on was a genuine child +union. When the composite fell back to its \emph{parent's} polygon (step 6b), +extracting WorldPop on it returns the parent population, so that result is +classified as \code{parent_fallback} and is subject to the same gate. +Previously this path could install the parent population while presenting +it as a geometry-derived sub-area figure. +} + diff --git a/man/detect_duplicate_geometries.Rd b/man/detect_duplicate_geometries.Rd new file mode 100644 index 0000000..f0f1f80 --- /dev/null +++ b/man/detect_duplicate_geometries.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/detect_duplicate_geometries.R +\name{detect_duplicate_geometries} +\alias{detect_duplicate_geometries} +\title{detect_duplicate_geometries} +\usage{ +detect_duplicate_geometries(lp_ids, geoms, lp_locations = NULL) +} +\arguments{ +\item{lp_ids}{vector: location period identifiers, one per geometry.} + +\item{geoms}{sfc or sf: geometries aligned with \code{lp_ids}.} + +\item{lp_locations}{character or NULL: \code{::}-delimited location name per +LP, aligned with \code{lp_ids}. When NULL, duplicated clusters are class +\code{"unknown"}.} +} +\value{ +a tibble with columns \code{location_period_id}, +\code{pop_geom_dup_n} (size of the identical-geometry cluster; 1 means +unique) and \code{pop_geom_dup_class}. +} +\description{ +Identify location periods that share an identical polygon, and +classify why. + +The Cholera Taxonomy database stores a separate shape record per location +period, but the \emph{content} of those records is sometimes duplicated: several +distinct location_period_ids, each with its own distinct shape id, resolve +to byte-identical geometry. \code{add_population()} then extracts the same +raster footprint for each of them and assigns them all the same population. +This is a defect in the source data, not in the join — every LP receives +the geometry the database associates with it. + +Not every duplicate is harmful, so the cluster is classified: + +\describe{ +\item{\code{unique}}{No other LP in the country shares this geometry.} +\item{\code{alias}}{All members sit at the same hierarchy depth and share +a base name once an ISO-style code prefix is stripped (e.g. +\code{GN-B::Fria} and \code{GN-B::GN-FR.Fria}). These are duplicate +records for one real place; the geometry is \emph{correct}. They still +double-count if a consumer sums population across LPs.} +\item{\code{parent_inherited}}{Members span more than one hierarchy +depth, i.e. children carry their parent's polygon (e.g. the Conakry +region polygon on six Conakry sub-districts). Severe: each child is +assigned the whole parent population.} +\item{\code{cross_unit}}{Members sit at the same depth but have different +base names, i.e. genuinely distinct units share one polygon (e.g. +\code{Lagos::Shomolu} and \code{Nasarawa::Awe}). Severe: at least one +unit has an entirely wrong denominator.} +\item{\code{unknown}}{Duplicated, but no location names were supplied so +the cluster could not be classified.} +} +} diff --git a/man/download_worldpop_constrained.Rd b/man/download_worldpop_constrained.Rd new file mode 100644 index 0000000..13b8cc9 --- /dev/null +++ b/man/download_worldpop_constrained.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pop.R +\name{download_worldpop_constrained} +\alias{download_worldpop_constrained} +\title{Download country-specific constrained WorldPop 100m raster (2015-2030).} +\usage{ +download_worldpop_constrained( + country, + year, + dest_dir = "worldpop", + releases = c("R2025A", "R2024B") +) +} +\arguments{ +\item{country}{Country ISO3 code (upper-case).} + +\item{year}{Population year (integer, 2015-2030).} + +\item{dest_dir}{Directory for cached raster files. Created if absent.} + +\item{releases}{Character vector of WorldPop release tags to try, in order.} +} +\description{ +Tries releases in order (newest first): R2025A → R2024B. After each +download, reads one cell to verify the file is intact. Both releases use +standard LZW+PREDICTOR=2 compression readable by any GDAL version; the +fallback exists to handle interrupted or corrupted downloads (a partial +LZW stream produces "code not yet in table" / TIFFReadEncodedTile errors +indistinguishable from a codec problem). If R2025A is corrupt, its cached +file is deleted and R2024B is fetched fresh. +} diff --git a/man/estimate_pop_for_geometries.Rd b/man/estimate_pop_for_geometries.Rd new file mode 100644 index 0000000..5189baa --- /dev/null +++ b/man/estimate_pop_for_geometries.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/add_population.R +\name{estimate_pop_for_geometries} +\alias{estimate_pop_for_geometries} +\title{estimate_pop_for_geometries} +\usage{ +estimate_pop_for_geometries( + geom_sf, + country_iso3, + year, + raster_dir = "worldpop", + boundary_cache_dir = "country_boundaries" +) +} +\arguments{ +\item{geom_sf}{sf: polygons to estimate population for. One value is returned +per row, in input order.} + +\item{country_iso3}{character: ISO3 country code (e.g. "BDI"); a sub-national +suffix is tolerated (the leading 3-letter code is extracted).} + +\item{year}{integer: representative year(s), length 1 (recycled) or +\code{nrow(geom_sf)}. Clamped to the WorldPop constrained range 2015-2030.} + +\item{raster_dir}{character: directory for caching WorldPop rasters.} + +\item{boundary_cache_dir}{character or NULL: directory for caching national +boundaries, passed to \code{get_country_boundary()}.} +} +\value{ +numeric vector of length \code{nrow(geom_sf)} with the UN-adjusted +population per geometry (NA where the raster is unavailable, the geometry +is unusable, or the raster sum is zero — zero is never returned as a +population). +} +\description{ +Estimate a UN-adjusted WorldPop population for each polygon in an +sf object by extracting the constrained WorldPop raster directly on the +geometry. Intended for composite locations, whose denominator should be the +population of the actual (child-union) sub-area rather than the sum of +child populations or the parent-admin polygon. Mirrors the WorldPop machinery +in \code{add_population()} (one raster load per year, one adjustment-factor +\code{exact_extract} on the country boundary, one vectorized +\code{exact_extract} for all geometries in that year) and reuses the same +geometry sanitation (\code{st_make_valid}, drop empty/non-polygon, cast to +MULTIPOLYGON) so mixed-type / POINT / empty geometries do not crash the +extraction. +} diff --git a/man/filter_ms_data.Rd b/man/filter_ms_data.Rd new file mode 100644 index 0000000..bb9a3dd --- /dev/null +++ b/man/filter_ms_data.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/filter_ms_data.R +\name{filter_ms_data} +\alias{filter_ms_data} +\title{filter_ms_data} +\usage{ +filter_ms_data( + df, + which_setting = c("epidemic", "endemic", "all"), + incl_trend_alerts = TRUE +) +} +\arguments{ +\item{df}{A dataframe containing alert data. Must include columns: +\itemize{ +\item \code{location}: character, name of the location +\item \code{spatial_scale}: character, e.g., "country", "admin1", etc... +\item \code{alert_type}: character, e.g., "trend" or other alert types +}} + +\item{which_setting}{Character. One of \code{"endemic"}, \code{"epidemic"}, or \code{"all"}. +Controls which subset of locations to keep. Default is \code{"epidemic"}.} + +\item{incl_trend_alerts}{Logical. If \code{TRUE}, trend-based alerts are included; +if \code{FALSE}, they are removed. Default is \code{TRUE}.} +} +\value{ +A filtered dataframe with subnational locations and the requested subset of endemic/epidemic/all. +} +\description{ +Filters a dataframe of outbreak alerts by spatial scale, endemic status, and trend-based alerts. +This function removes country-level locations, optionally removes trend-based alerts, +and allows keeping only endemic, epidemic, or all locations. Endemic locations are determined +based on the package dataset \code{endemic_locs_gte50nz_3ydata}. +} diff --git a/man/format_alerts.Rd b/man/format_alerts.Rd index 2aa01dc..5281e04 100644 --- a/man/format_alerts.Rd +++ b/man/format_alerts.Rd @@ -6,9 +6,6 @@ \usage{ format_alerts(alerts_df) } -\arguments{ -\item{alerts_df}{} -} \value{ a 'long' version of the alerts dataframe with columns for the alert_id, location, TL, spatial scale, country, alert number (numeric), and alert type } diff --git a/man/get_country_boundary.Rd b/man/get_country_boundary.Rd new file mode 100644 index 0000000..a55d6c8 --- /dev/null +++ b/man/get_country_boundary.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_country_boundary.R +\name{get_country_boundary} +\alias{get_country_boundary} +\title{get_country_boundary} +\usage{ +get_country_boundary(country_iso3, cache_dir = "country_boundaries") +} +\arguments{ +\item{country_iso3}{character: ISO3 code, optionally with a sub-national +suffix (e.g. "TZA::Mainland"); the leading 3-letter code is extracted.} + +\item{cache_dir}{character or NULL: directory for caching boundary GeoJSON. +When NULL, no cache is read or written.} +} +\value{ +an sf object with a single boundary geometry in EPSG:4326, or +\code{NULL} if the boundary could not be resolved. +} +\description{ +Resolve a national boundary polygon for the UN population +adjustment factor, deterministically and without ever falling back to the +union of location-period geometries. + +The resolution ladder is: on-disk cache -> \code{rgeoboundaries::gb_adm0()} +-> \code{NULL}. There is deliberately no fourth step. A union of the +observed LP geometries is \emph{not} a country boundary — it covers only the +surveilled sub-areas, so the raster total extracted on it is too small and +the resulting adjustment factor (\code{tot_UN / country_raw}) is inflated, +scaling every population in the country upward. Callers must treat +\code{NULL} as "skip the adjustment" (\code{adj_factor = 1.0}), which +leaves populations unadjusted rather than wrong. + +\code{rgeoboundaries} is an optional dependency (Suggests). It is checked +with \code{requireNamespace()} before use so that a missing package +produces a legible message instead of being swallowed by a +\code{tryCatch()} that cannot distinguish it from a network failure. +} diff --git a/man/get_pop.Rd b/man/get_pop.Rd index 9845035..161a02e 100644 --- a/man/get_pop.Rd +++ b/man/get_pop.Rd @@ -32,3 +32,6 @@ numeric \description{ this function is used to get population data for each location period } +\details{ +Estimate population function - updated in May 2026: use the updated population raster between 2015-2030 +} diff --git a/man/get_shp.Rd b/man/get_shp.Rd index 3b3870b..7c1c1df 100644 --- a/man/get_shp.Rd +++ b/man/get_shp.Rd @@ -6,13 +6,34 @@ \usage{ get_shp( location_period_id, - username = username, - password = password, + username, + password, host = "db.cholera-taxonomy.middle-distance.com", port = 5432, - dbname = "CholeraTaxonomy_production" + dbname = "CholeraTaxonomy_production", + output_parquet = NULL ) } +\arguments{ +\item{location_period_id}{numeric: the location period ID to retrieve} + +\item{username}{character: PostgreSQL username} + +\item{password}{character: PostgreSQL password} + +\item{host}{character: database host} + +\item{port}{integer: database port} + +\item{dbname}{character: database name} + +\item{output_parquet}{character: optional file path to save result as +GeoParquet (requires sfarrow package). If NULL, no file is written.} +} +\value{ +sf object with the shapefile geometry +} \description{ -this function is to extract shapefiles from +this function is to extract shapefiles from the Cholera Taxonomy +database. Optionally saves the result as a GeoParquet file. } diff --git a/man/identify_epidemic_start.Rd b/man/identify_epidemic_start.Rd index 0d4d9fc..7d00373 100644 --- a/man/identify_epidemic_start.Rd +++ b/man/identify_epidemic_start.Rd @@ -6,7 +6,18 @@ \usage{ identify_epidemic_start( outbreak_data = outbreak_data, - minimum_consecutive_reports = 3 + outbreak_start_definition = c("consecutive", "dual_window"), + min_weeks_above = 2, + require_increasing_trend = FALSE, + window_weeks = 3, + use_cumulative_trigger = TRUE, + cumulative_trigger_type = c("cumulative_case_threshold", + "cumulative_case_threshold_and_min_cases", + "cumulative_case_threshold_and_nonzero_weeks"), + cumulative_windows = 3, + cumulative_case_threshold_ratio = 1.5, + cumulative_min_cases = NULL, + nonzero_windows = NULL ) } \description{ diff --git a/man/identify_outbreaks.Rd b/man/identify_outbreaks.Rd index 0cd7790..68832d4 100644 --- a/man/identify_outbreaks.Rd +++ b/man/identify_outbreaks.Rd @@ -9,7 +9,20 @@ identify_outbreaks( original_data, zero_case_assumption = T, customized_TL = NULL, - customized_TR = NULL + customized_TR = NULL, + outbreak_start_definition = c("consecutive", "dual_window"), + min_weeks_above = 2, + require_increasing_trend = FALSE, + window_weeks = window_weeks, + cumulative_windows = cumulative_windows, + cumulative_case_threshold_ratio = cumulative_case_threshold_ratio, + cumulative_trigger_type = cumulative_trigger_type, + use_cumulative_trigger = use_cumulative_trigger, + cumulative_min_cases = cumulative_min_cases, + nonzero_windows = nonzero_windows, + tail_period = 6, + filter_outbreaks_by_size = FALSE, + keep_nonoutbreak_locations = FALSE ) } \arguments{ @@ -24,6 +37,12 @@ identify_outbreaks( \item{customized_TL:}{customize the lower bound of time for outbreak estimation} \item{customized_TR:}{customize the upper bound of time for outbreak estimation} + +\item{cumulative_min_cases:}{numeric: minimum cumulative cases. Used by the dual_window cumulative trigger and, when \code{filter_outbreaks_by_size = TRUE}, as the minimum total-case threshold for the post-detection size filter.} + +\item{filter_outbreaks_by_size:}{logical: when TRUE, drop detected outbreaks whose total cases (summed over the full outbreak window) fall below \code{cumulative_min_cases}. Default FALSE (no filtering, backward compatible).} + +\item{keep_nonoutbreak_locations:}{logical: when TRUE, locations that never trigger an epidemic start are returned as their full time series labelled \code{outbreak_number = 0} and \code{`Time Period` = "non-outbreak period"}, instead of an empty data.frame. Use this to retain every location in the output rather than silently dropping those without a detected outbreak. Default FALSE (backward compatible).} } \value{ list of dataframes diff --git a/man/resolve_composite_children.Rd b/man/resolve_composite_children.Rd new file mode 100644 index 0000000..bb58945 --- /dev/null +++ b/man/resolve_composite_children.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/resolve_composite_children.R +\name{resolve_composite_children} +\alias{resolve_composite_children} +\title{resolve_composite_children} +\usage{ +resolve_composite_children( + composite_names, + time_left = as.Date("2000-01-01"), + time_right = as.Date("2024-12-31"), + api_user = Sys.getenv("CHOLERA_API_USERNAME"), + api_key = Sys.getenv("CHOLERA_API_KEY"), + pull_fn = taxdat::read_taxonomy_data_api, + cache_dir = NULL, + location_prefix = "CT-World::" +) +} +\arguments{ +\item{composite_names}{character: composite location names (containing "|"). +Names are de-composited with \code{decompose_composite_names()} to obtain the +unique child location strings that are queried.} + +\item{time_left, time_right}{Date: the (wide) pull window. Defaults to +2000-01-01 .. 2024-12-31 because composites and their children often sit in +early years; the API requires a bounded range.} + +\item{api_user, api_key}{character: API credentials. Default to the +\code{CHOLERA_API_USERNAME} / \code{CHOLERA_API_KEY} environment variables.} + +\item{pull_fn}{function: the API pull function, injected for testability. +Must accept \code{username, api_key, locations, time_left, time_right} and +return an sf. Defaults to \code{taxdat::read_taxonomy_data_api}.} + +\item{cache_dir}{character or NULL: if given, each child's raw pull is +memoized to a window-independent key in this directory (deduplicating across +overlapping windows and avoiding repeat API calls).} + +\item{location_prefix}{character: prepended to each child location for the +API query (default "CT-World::").} +} +\value{ +an sf keyed by location_period_id with columns +\code{location} (the queried child string), \code{location_period_id}, and +\code{geometry}. Returns a 0-row sf (canonical schema) when nothing resolves. +} +\description{ +Make a directed per-child Cholera Taxonomy API call for every +constituent child of a set of composite ("|"-joined) location names, and +return each child's own location_period_id and polygon geometry. Intended +for the Batch 1 pull step: the resulting child LP/geometry lets Stage 2 +\code{build_composite_locations()} reconstruct composites whose children are +not observed atomically in the country-wide pull. +} diff --git a/man/validate_population.Rd b/man/validate_population.Rd new file mode 100644 index 0000000..690b0c3 --- /dev/null +++ b/man/validate_population.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/validate_population.R +\name{validate_population} +\alias{validate_population} +\title{validate_population} +\usage{ +validate_population( + lp_pop, + iso3, + on_fail = c("warn", "abort"), + wpp_total = NULL +) +} +\arguments{ +\item{lp_pop}{data.frame: one row per location period, with at least +\code{location_period_id} and \code{pop}. Optional columns +\code{location}, \code{pop_source}, \code{pop_geom_dup_n}, +\code{pop_geom_dup_class} and \code{adj_factor} enable additional gates.} + +\item{iso3}{character: ISO3 country code, recorded in the report.} + +\item{on_fail}{character: "warn" (default) or "abort".} + +\item{wpp_total}{numeric or NULL: the WPP2024 national total to compare +against. When NULL it is looked up from the bundled WPP2024 table using +the median \code{pop_year_raster} in \code{lp_pop}.} +} +\value{ +a tibble with one row per gate: \code{iso3}, \code{gate}, +\code{description}, \code{n_violations}, \code{n_checked}, \code{passed}, +and \code{detail} (a compact listing of offending location periods). +} +\description{ +Run the population quality gates over one country's +location-period populations and return a tidy per-gate report. + +The gates encode failure modes that were verified against the extraction +corpus rather than inferred from reading code, so their thresholds are +calibrated to observed behaviour. Gate 3's band, for instance, is loose +because the observed adjustment factors span only 1.005-1.034 — anything +far outside that indicates the raster total was extracted on the wrong +polygon, not a genuine disagreement with WPP. + +Default \code{on_fail = "warn"}. Gate 4 currently fails corpus-wide (many +location periods legitimately share geometry with an alias record), so +aborting by default would make a full re-extraction impossible. Use +\code{on_fail = "abort"} only for gates you have already driven to zero. +} diff --git a/man/verify_outbreak_definitions.Rd b/man/verify_outbreak_definitions.Rd new file mode 100644 index 0000000..6f2dc2c --- /dev/null +++ b/man/verify_outbreak_definitions.Rd @@ -0,0 +1,154 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/verify_outbreak_definitions.R +\name{verify_outbreak_definitions} +\alias{verify_outbreak_definitions} +\title{verify_outbreak_definitions} +\usage{ +verify_outbreak_definitions( + outbreak_list, + outbreak_start_definition = c("consecutive", "dual_window"), + min_weeks_above = 2L, + tail_period = 6L, + cumulative_min_cases = NULL, + cumulative_windows = 3L, + window_weeks = 3L, + cumulative_case_threshold_ratio = 1.5, + use_cumulative_trigger = TRUE, + cumulative_trigger_type = c("cumulative_case_threshold", + "cumulative_case_threshold_and_min_cases", + "cumulative_case_threshold_and_nonzero_weeks"), + nonzero_windows = NULL +) +} +\arguments{ +\item{outbreak_list}{Named list of dataframes returned by +\code{\link{identify_outbreaks}()}, or a single dataframe produced by +\code{purrr::list_rbind(outbreak_list)}.} + +\item{outbreak_start_definition}{\code{"consecutive"} (default) or +\code{"dual_window"}.} + +\item{min_weeks_above}{Integer. Minimum consecutive / sliding-window +high-risk weeks required to trigger an epidemic start (default 2).} + +\item{tail_period}{Integer. Consecutive below-threshold weeks required to +close an outbreak (default 6).} + +\item{cumulative_min_cases}{Numeric or \code{NULL}. When non-NULL, each +outbreak's first \code{cumulative_windows} weeks must sum to at least this +many cases. Applies in any \code{outbreak_start_definition} mode.} + +\item{cumulative_windows}{Integer. Width of the cumulative case window used +in \code{dual_window} mode and in the \code{cumulative_cases_at_start} +check (default 3).} + +\item{window_weeks}{Integer. Width of the sliding high-risk-week window +(\code{dual_window} mode, default 3).} + +\item{cumulative_case_threshold_ratio}{Numeric. Multiplier on +\code{threshold * pop} for the cumulative case trigger (default 1.5).} + +\item{use_cumulative_trigger}{Logical. Whether the cumulative trigger is +active in \code{dual_window} mode (default \code{TRUE}).} + +\item{cumulative_trigger_type}{Character. One of +\code{"cumulative_case_threshold"}, +\code{"cumulative_case_threshold_and_min_cases"}, or +\code{"cumulative_case_threshold_and_nonzero_weeks"}.} + +\item{nonzero_windows}{Integer or \code{NULL}. Minimum non-zero-case weeks +in the cumulative window (used with +\code{"cumulative_case_threshold_and_nonzero_weeks"}).} +} +\value{ +A \code{tibble} with columns: +\describe{ +\item{\code{location}}{Location string.} +\item{\code{outbreak_number}}{Outbreak identifier. \code{NA} for +location-level checks; a string like \code{"1-2"} for inter-outbreak +gap checks; a positive integer (as character) for outbreak-level +checks.} +\item{\code{check}}{Name of the verification check.} +\item{\code{status}}{\code{"PASS"}, \code{"FAIL"}, \code{"SKIP"}, or +\code{"INFO"}.} +\item{\code{value}}{Measured quantity for the check (e.g. number of +violations, total cases, gap in weeks).} +\item{\code{detail}}{Human-readable description of the result, including +specifics for failures.} +} +} +\description{ +Post-hoc verification that the output of +\code{\link{identify_outbreaks}()} is internally consistent with the +outbreak-definition parameters used to produce it. +} +\details{ +The function accepts the list returned by \code{identify_outbreaks()} (or a +pre-bound dataframe) and runs the following checks, returning one tidy row +per check per location (or per outbreak, for outbreak-level checks): + +\strong{Location-level checks} +\describe{ +\item{\code{risk_classification_consistency}}{Every row: \code{risk == + "high"} iff \code{sCh > 0} and \code{sCh / pop >= threshold}.} +\item{\code{no_zero_case_epidemic_start}}{All \code{epidemic_start = TRUE} +rows have \code{sCh > 0}.} +\item{\code{epidemic_start_in_outbreak_period}}{Every epidemic start is +assigned a positive \code{outbreak_number}.} +\item{\code{consecutive_start_validity}}{(\code{consecutive} mode) Each +epidemic start begins a run of at least \code{min_weeks_above} +consecutive \code{"high"}-risk weeks.} +\item{\code{dual_window_start_validity}}{(\code{dual_window} mode) Each +epidemic start satisfies the sliding-window trigger, the cumulative +trigger, or both.} +\item{\code{epidemic_tail_validity}}{For every row where +\code{epidemic_tail = TRUE}, the subsequent \code{tail_period} +consecutive rows (including the flagged row itself) are all +\code{risk == "low"} and \code{epidemic_start == FALSE}.} +\item{\code{inter_outbreak_gap_weeks}}{The gap in weeks between +consecutive outbreak periods is at least \code{tail_period}. +One row per consecutive pair (\code{outbreak_number} column stores +\code{"k-k+1"}).} +} + +\strong{Outbreak-level checks (one row per location × outbreak_number)} +\describe{ +\item{\code{min_high_risk_weeks_per_outbreak}}{Each outbreak period +contains at least \code{min_weeks_above} high-risk weeks.} +\item{\code{cumulative_cases_at_start}}{The sum of \code{sCh} over the +first \code{cumulative_windows} weeks of the outbreak meets +\code{cumulative_min_cases}. Skipped when \code{cumulative_min_cases} +is \code{NULL}.} +\item{\code{outbreak_weekly_continuity}}{All consecutive week-start dates +within the outbreak are exactly 7 days apart (no internal gaps).} +\item{\code{tail_period_after_outbreak}}{After the last row of the +outbreak period, the immediately following non-outbreak weeks are all +low-risk. SKIP is returned when no data follows the outbreak.} +\item{\code{outbreak_summary}}{Informational (\code{status = "INFO"}): +total cases, duration in weeks, and peak weekly cases.} +} +} +\examples{ +\dontrun{ +# Run outbreak detection +outbreak_list <- identify_outbreaks( + threshold_type = "mean weekly incidence rate", + original_data = my_data, + outbreak_start_definition = "consecutive", + min_weeks_above = 2, + tail_period = 6 +) + +# Verify the definitions were applied consistently +results <- verify_outbreak_definitions( + outbreak_list = outbreak_list, + outbreak_start_definition = "consecutive", + min_weeks_above = 2, + tail_period = 6, + cumulative_min_cases = 50 +) + +# Inspect failures +results[results$status == "FAIL", ] +} +} diff --git a/shiny/app.R b/shiny/app.R new file mode 100644 index 0000000..4c0a49a --- /dev/null +++ b/shiny/app.R @@ -0,0 +1,858 @@ +# shiny/app.R ───────────────────────────────────────────────────────────────── +# Cholera Outbreak Explorer +# +# Launch from project root: +# shiny::runApp("shiny") +# +# Requires (install once): +# install.packages(c("leaflet", "plotly", "bsicons", "leaflet.extras")) +# ───────────────────────────────────────────────────────────────────────────── + +# ── 0. Check hard dependencies ──────────────────────────────────────────────── +needed <- c("leaflet", "plotly", "bslib", "bsicons") +missing <- needed[!sapply(needed, requireNamespace, quietly = TRUE)] +if (length(missing) > 0) + stop(paste0("Missing packages — run:\n install.packages(c(", + paste0('"', missing, '"', collapse = ", "), "))"), + call. = FALSE) + +# ── 1. Libraries ────────────────────────────────────────────────────────────── +suppressPackageStartupMessages({ + library(shiny) + library(bslib) + library(bsicons) + library(leaflet) + library(leaflet.extras) + library(plotly) + library(DT) + library(dplyr) + library(tidyr) + library(ggplot2) + library(scales) + library(stringr) + library(lubridate) + library(forcats) + library(rnaturalearth) + library(sf) +}) + +# ── 2. Load & pre-process data (runs once at startup) ───────────────────────── +message("[ 1/4 ] Loading combined_outbreaks_cholera.rds ...") + +# Paths are relative to the app directory so the app works both locally +# (Shiny sets wd to the app dir) and on shinyapps.io. +new_raw <- readRDS("data/combined_outbreaks_cholera.rds") %>% + mutate( + TL = as.Date(TL), + TR = as.Date(TR), + year = year(TL), + # Normalise country name + country_name = case_when( + str_detect(country, "\\.") ~ str_replace(country, "^[A-Z0-9:]+\\.", ""), + country_iso3 == "TZA::Mainland" ~ "Tanzania (Mainland)", + country_iso3 == "TZA::Zanzibar" ~ "Tanzania (Zanzibar)", + TRUE ~ country + ), + # Merge TZA sub-territories for join compatibility + country_iso3_cmp = ifelse(str_detect(country_iso3, "TZA"), "TZA", country_iso3) + ) + +# Scale normalisation (mirrors notebook) +normalise_scale <- function(x) { + case_when( + x == "country" ~ "Country", + str_detect(x, "^admin1") ~ "Admin 1", + str_detect(x, "^admin2") ~ "Admin 2", + str_detect(x, "^admin3") ~ "Admin 3", + TRUE ~ NA_character_ + ) +} + +message("[ 2/4 ] Deriving outbreak summaries ...") +new_ob_admin <- new_raw %>% + filter(outbreak_number > 0) %>% + mutate(scale = normalise_scale(spatial_scale)) %>% + # TZA special case: Mainland / Zanzibar are ADM0 analogues (union territories), + # not true provinces. Shift every TZA scale down by one level so that: + # admin1 (Mainland / Zanzibar) → "Country" + # admin2 (regions, e.g. Arusha) → "Admin 1" + # admin3 (districts) → "Admin 2" + mutate(scale = case_when( + str_detect(country_iso3, "^TZA::") & scale == "Admin 1" ~ "Country", + str_detect(country_iso3, "^TZA::") & scale == "Admin 2" ~ "Admin 1", + str_detect(country_iso3, "^TZA::") & scale == "Admin 3" ~ "Admin 2", + TRUE ~ scale + )) %>% + filter(!is.na(scale)) %>% + group_by(location, scale, country_iso3, who_region, + time_lower_bound, time_upper_bound, outbreak_number) %>% + summarise( + ob_start = min(TL), + ob_end = max(TR), + total_cases = sum(sCh, na.rm = TRUE), + total_deaths = sum(deaths, na.rm = TRUE), + n_weeks = n(), + pop = first(pop), + peak_cases = max(sCh, na.rm = TRUE), + .groups = "drop" + ) %>% + mutate( + year = year(ob_start), + cfr_pct = ifelse(total_cases > 0 & !is.na(total_deaths) & total_deaths > 0, + total_deaths / total_cases * 100, NA_real_), + attack_rate = ifelse(!is.na(pop) & pop > 0, total_cases / pop * 1e3, NA_real_), + country_iso3_cmp = ifelse(str_detect(country_iso3, "TZA"), "TZA", country_iso3), + scale = factor(scale, levels = c("Country", "Admin 1", "Admin 2", "Admin 3")) + ) + +# Country name lookup (one canonical name per ISO3-cmp) +name_lut <- new_raw %>% + mutate(cname = case_when( + str_detect(country_iso3, "TZA") ~ "Tanzania", + str_detect(country, "\\.") ~ str_replace(country, "^[A-Z0-9:]+\\.", ""), + TRUE ~ country + )) %>% + filter(str_detect(cname, "[a-z]")) %>% + distinct(country_iso3_cmp, .keep_all = FALSE) %>% # just the keys + left_join( + new_raw %>% + mutate(cname = case_when( + str_detect(country_iso3, "TZA") ~ "Tanzania", + str_detect(country, "\\.") ~ str_replace(country, "^[A-Z0-9:]+\\.", ""), + TRUE ~ country + )) %>% + filter(str_detect(cname, "[a-z]")) %>% + distinct(country_iso3_cmp, cname), + by = "country_iso3_cmp" + ) %>% + rename(country_name = cname) %>% + group_by(country_iso3_cmp) %>% + slice(1) %>% + ungroup() + +message("[ 3/4 ] Loading spatial data ...") + +# Centroid lookup (built by data_prep.R) +centroids <- tryCatch( + readRDS("data/centroids.rds"), + error = function(e) { + message(" [WARN] centroids.rds not found — run `Rscript shiny/data_prep.R` first. ", + "Admin markers will be unavailable until then.") + tibble(location = character(), lon = numeric(), lat = numeric()) + } +) + +# World polygons (country outlines) +world_sf <- rnaturalearth::ne_countries(scale = "medium", returnclass = "sf") %>% + select(iso_a3, name_long, continent) + +message("[ 4/4 ] Ready.") + +# ── 3. App-wide constants ───────────────────────────────────────────────────── +REGIONS <- sort(unique(new_ob_admin$who_region)) + +REGION_LABELS <- c( + AFR = "African Region (AFR)", + AMR = "Americas (AMR)", + EMR = "Eastern Mediterranean (EMR)", + SEAR = "South-East Asia (SEAR)" +) + +# Matches Set2 palette used throughout the notebook +REGION_COLOURS <- c( + AFR = "#66C2A5", + AMR = "#FC8D62", + EMR = "#8DA0CB", + SEAR = "#E78AC3" +) + +all_countries <- new_ob_admin %>% + distinct(country_iso3_cmp, who_region) %>% + left_join(name_lut, by = "country_iso3_cmp") %>% + mutate(label = coalesce(country_name, country_iso3_cmp)) %>% + arrange(label) + +ALL_YEARS <- range(new_ob_admin$year, na.rm = TRUE) + +SCALE_LEVELS <- c("Country", "Admin 1", "Admin 2", "Admin 3") + +# ── 4. UI ───────────────────────────────────────────────────────────────────── +ui <- page_sidebar( + title = tagList( + bs_icon("virus2", size = "1.1em", class = "me-2"), + "Cholera Outbreak Explorer 2010–2024" + ), + theme = bs_theme( + bootswatch = "flatly", + base_font = font_google("Source Sans Pro") + ), + + # ── Sidebar ───────────────────────────────────────────────────────────────── + sidebar = sidebar( + width = 285, + open = TRUE, + title = "Filters", + + checkboxGroupInput( + "who_region", "WHO Region", + choices = setNames(REGIONS, REGION_LABELS[REGIONS]), + selected = REGIONS + ), + + selectizeInput( + "countries", "Countries", + choices = setNames(all_countries$country_iso3_cmp, all_countries$label), + selected = all_countries$country_iso3_cmp, + multiple = TRUE, + options = list( + plugins = list("remove_button"), + placeholder = "Select countries …", + maxOptions = 200 + ) + ), + + radioButtons( + "admin_level", "Admin level", + choices = SCALE_LEVELS, + selected = "Country" + ), + + sliderInput( + "year_range", "Year range", + min = ALL_YEARS[1], max = ALL_YEARS[2], + value = ALL_YEARS, step = 1, sep = "" + ), + + numericInput( + "min_cases", "Min. cases per outbreak", + value = 0, min = 0, step = 10 + ), + + hr(style = "margin: 8px 0"), + + actionButton( + "reset_filters", "Reset all filters", + icon = icon("rotate-left"), + class = "btn-sm btn-outline-secondary w-100" + ), + + hr(style = "margin: 8px 0"), + p(tags$small(tags$em( + "Click a country / marker on the map to show its weekly time series below." + )), style = "color: #888; font-size: 0.8em;") + ), + + # ── KPI value boxes ────────────────────────────────────────────────────────── + layout_columns( + fill = FALSE, + col_widths = c(3, 3, 3, 3), + + value_box( + title = "Outbreaks", + value = textOutput("kpi_ob", inline = TRUE), + showcase = bs_icon("virus"), + theme = "primary" + ), + value_box( + title = "Total cases", + value = textOutput("kpi_cases", inline = TRUE), + showcase = bs_icon("people-fill"), + theme = "info" + ), + value_box( + title = "Total deaths", + value = textOutput("kpi_deaths", inline = TRUE), + showcase = bs_icon("heartbreak-fill"), + theme = "danger" + ), + value_box( + title = "Locations affected", + value = textOutput("kpi_locs", inline = TRUE), + showcase = bs_icon("geo-alt-fill"), + theme = "success" + ) + ), + + # ── Main tabs ──────────────────────────────────────────────────────────────── + navset_card_underline( + + # ── Tab 1: Map ───────────────────────────────────────────────────────────── + nav_panel( + title = tagList(bs_icon("map"), " Map"), + leafletOutput("map", height = "460px"), + hr(style = "margin: 5px 0"), + div( + style = "color: #555; font-size: 0.85em; margin-bottom: 3px;", + textOutput("ts_header", inline = TRUE) + ), + plotlyOutput("ts_plot", height = "195px") + ), + + # ── Tab 2: Statistics ────────────────────────────────────────────────────── + nav_panel( + title = tagList(bs_icon("table"), " Statistics"), + layout_columns( + col_widths = c(7, 5), + card( + card_header("Outbreak characteristics by country"), + full_screen = TRUE, + DTOutput("stats_table") + ), + card( + card_header("Top 15 locations by total cases"), + plotOutput("top_locs_plot", height = "420px") + ) + ) + ), + + # ── Tab 3: Heatmap ───────────────────────────────────────────────────────── + nav_panel( + title = tagList(bs_icon("grid-3x3-gap-fill"), " Heatmap"), + layout_columns( + col_widths = c(2, 10), + card( + card_header("Options"), + radioButtons( + "heatmap_metric", "Metric", + choices = c("Outbreaks (n)" = "n_outbreaks", + "Total cases" = "total_cases"), + selected = "n_outbreaks" + ), + hr(style = "margin: 6px 0"), + p(tags$small("Rows sorted by total at the selected admin level."), + style = "color:#888; font-size:0.8em;") + ), + card( + card_header(textOutput("heatmap_title", inline = TRUE)), + full_screen = TRUE, + plotlyOutput("heatmap", height = "530px") + ) + ) + ) + ) +) + +# ── 5. Server ───────────────────────────────────────────────────────────────── +server <- function(input, output, session) { + + # ── Country choices follow WHO region selection ──────────────────────────── + observeEvent(input$who_region, { + sub <- all_countries %>% filter(who_region %in% input$who_region) + keep <- intersect(input$countries, sub$country_iso3_cmp) + if (length(keep) == 0) keep <- sub$country_iso3_cmp + updateSelectizeInput( + session, "countries", + choices = setNames(sub$country_iso3_cmp, sub$label), + selected = keep + ) + }, ignoreInit = TRUE) + + observeEvent(input$reset_filters, { + updateCheckboxGroupInput(session, "who_region", selected = REGIONS) + updateSelectizeInput( + session, "countries", + choices = setNames(all_countries$country_iso3_cmp, all_countries$label), + selected = all_countries$country_iso3_cmp + ) + updateRadioButtons(session, "admin_level", selected = "Country") + updateSliderInput(session, "year_range", value = ALL_YEARS) + updateNumericInput(session, "min_cases", value = 0) + selected_loc(NULL) + }) + + # ── Core reactive: filtered outbreak data ────────────────────────────────── + filtered_ob <- reactive({ + req(length(input$who_region) > 0, length(input$countries) > 0) + new_ob_admin %>% + filter( + who_region %in% input$who_region, + country_iso3_cmp %in% input$countries, + as.character(scale) == input$admin_level, + year >= input$year_range[1], + year <= input$year_range[2], + total_cases >= input$min_cases + ) + }) + + # ── KPIs ────────────────────────────────────────────────────────────────── + output$kpi_ob <- renderText(format(nrow(filtered_ob()), big.mark = ",")) + output$kpi_cases <- renderText(format(sum(filtered_ob()$total_cases, na.rm = TRUE), big.mark = ",")) + output$kpi_deaths <- renderText(format(sum(filtered_ob()$total_deaths, na.rm = TRUE), big.mark = ",")) + output$kpi_locs <- renderText(format(n_distinct(filtered_ob()$location), big.mark = ",")) + + # ── Map ─────────────────────────────────────────────────────────────────── + selected_loc <- reactiveVal(NULL) # iso_a3 (country) or location string (admin) + + # Per-location aggregation for the map + map_sum <- reactive({ + filtered_ob() %>% + group_by(location, country_iso3_cmp, who_region) %>% + summarise( + n_outbreaks = n(), + total_cases = sum(total_cases, na.rm = TRUE), + total_deaths = sum(total_deaths, na.rm = TRUE), + cfr_pct = ifelse(sum(total_cases, na.rm = TRUE) > 0, + sum(total_deaths, na.rm = TRUE) / + sum(total_cases, na.rm = TRUE) * 100, NA_real_), + med_attack = median(attack_rate, na.rm = TRUE), + .groups = "drop" + ) %>% + left_join(name_lut, by = "country_iso3_cmp") + }) + + # Initialise the leaflet widget once + output$map <- renderLeaflet({ + leaflet(options = leafletOptions(minZoom = 2)) %>% + addProviderTiles(providers$CartoDB.Positron, + options = tileOptions(maxZoom = 12)) %>% + setView(lng = 18, lat = 3, zoom = 3) + }) + + # Update map layers when filters / admin level change + observe({ + ms <- map_sum() + level <- input$admin_level + proxy <- leafletProxy("map") %>% + clearShapes() %>% clearMarkers() %>% clearControls() + + if (nrow(ms) == 0) return() + + if (level == "Country") { + # ── Choropleth ───────────────────────────────────────────────────────── + map_sf <- world_sf %>% + left_join( + ms %>% group_by(country_iso3_cmp) %>% + summarise( + n_outbreaks = sum(n_outbreaks, na.rm = TRUE), + total_cases = sum(total_cases, na.rm = TRUE), + total_deaths = sum(total_deaths, na.rm = TRUE), + cfr_pct = ifelse(sum(total_cases, na.rm = TRUE) > 0, + sum(total_deaths, na.rm = TRUE) / + sum(total_cases, na.rm = TRUE) * 100, + NA_real_), + who_region = first(who_region), + country_name = first(country_name), + .groups = "drop" + ), + by = c("iso_a3" = "country_iso3_cmp") + ) + + has_data <- !is.na(map_sf$n_outbreaks) + pal_choro <- colorNumeric("viridis", domain = ms$n_outbreaks, na.color = "#e4e4e4") + + proxy %>% + addPolygons( + data = map_sf[!has_data, ], + fillColor = "#e8e8e8", fillOpacity = 0.4, + color = "#cccccc", weight = 0.5, options = pathOptions(interactive = FALSE) + ) %>% + addPolygons( + data = map_sf[has_data, ], + fillColor = ~pal_choro(n_outbreaks), + fillOpacity = 0.78, + color = "white", weight = 0.8, + highlightOptions = highlightOptions( + weight = 2.5, color = "#444", fillOpacity = 0.95, bringToFront = TRUE + ), + popup = ~paste0( + "", name_long, "
", + "", who_region, "
", + "Outbreaks: ", n_outbreaks, "
", + "Cases: ", format(total_cases, big.mark = ","), "
", + "Deaths: ", ifelse(total_deaths > 0, + format(total_deaths, big.mark = ","), "—"), "
", + "CFR: ", ifelse(is.na(cfr_pct) | cfr_pct == 0, "—", + sprintf("%.1f%%", cfr_pct)), "" + ), + layerId = ~iso_a3 + ) %>% + addLegend( + pal = pal_choro, + values = ms$n_outbreaks, + title = "Outbreaks (n)", + position = "bottomright", + opacity = 0.9 + ) + + } else { + # ── Admin circle markers ──────────────────────────────────────────────── + ms_pts <- ms %>% + inner_join(centroids, by = "location") %>% + filter(is.finite(lon), is.finite(lat)) + + # Grey base outlines + proxy %>% + addPolygons( + data = world_sf, + fillColor = "#f4f4f4", fillOpacity = 0.5, + color = "#bbbbbb", weight = 0.5, + options = pathOptions(interactive = FALSE) + ) + + if (nrow(ms_pts) == 0) { + showNotification( + tagList(icon("triangle-exclamation"), + " No centroid data — run: Rscript shiny/data_prep.R"), + type = "warning", duration = 8 + ) + return() + } + + pal_region <- colorFactor( + palette = unname(REGION_COLOURS), + domain = names(REGION_COLOURS) + ) + + proxy %>% + addCircleMarkers( + data = ms_pts, + lng = ~lon, lat = ~lat, + radius = ~pmax(4, pmin(24, 4 + sqrt(total_cases / 400))), + fillColor = ~pal_region(who_region), + fillOpacity = 0.75, + color = "white", weight = 1, + popup = ~paste0( + "", location, "
", + "", who_region, " | ", level, "
", + "Outbreaks: ", n_outbreaks, "
", + "Cases: ", format(total_cases, big.mark = ","), "
", + "Deaths: ", ifelse(is.na(total_deaths) | total_deaths == 0, + "—", format(total_deaths, big.mark = ",")), "
", + "CFR: ", ifelse(is.na(cfr_pct), "—", + sprintf("%.1f%%", cfr_pct)), "
", + "Attack rate: ", ifelse(is.na(med_attack), "—", + sprintf("%.2f /1,000", med_attack)), "" + ), + layerId = ~location + ) %>% + addLegend( + colors = unname(REGION_COLOURS[names(REGION_COLOURS) %in% + unique(ms_pts$who_region)]), + labels = unname(REGION_LABELS[names(REGION_COLOURS) %in% + unique(ms_pts$who_region)]), + title = "WHO Region", + position = "bottomright", + opacity = 0.9 + ) + } + }) + + # Capture map click → update selected location + observeEvent(input$map_shape_click, selected_loc(input$map_shape_click$id)) + observeEvent(input$map_marker_click, selected_loc(input$map_marker_click$id)) + + # ── Weekly time series ────────────────────────────────────────────────────── + output$ts_header <- renderText({ + loc <- selected_loc() + if (is.null(loc)) return("Weekly time series — click a location on the map") + lbl <- if (input$admin_level == "Country") { + nm <- name_lut$country_name[name_lut$country_iso3_cmp == loc] + if (length(nm)) nm[1] else loc + } else loc + paste0("Weekly time series — ", lbl) + }) + + ts_raw <- reactive({ + loc <- selected_loc() + if (is.null(loc)) return(NULL) + + if (input$admin_level == "Country") { + # TZA has no "country" spatial_scale rows; its ADM0-equivalent data is at + # "admin1" (Mainland + Zanzibar). For all other countries use "country". + ts_scale <- if (loc == "TZA") "admin1" else "country" + new_raw %>% + filter(spatial_scale == ts_scale, + country_iso3_cmp == loc, + year >= input$year_range[1], + year <= input$year_range[2]) %>% + group_by(TL) %>% + summarise(sCh = sum(sCh, na.rm = TRUE), + deaths = sum(deaths, na.rm = TRUE), + outbreak_flag = as.integer(any(outbreak_number > 0)), + .groups = "drop") + } else { + # Aggregate to one row per TL (a location can have multiple rows from + # overlapping analysis runs; sum cases and flag as outbreak if any run + # detects one for that week). + new_raw %>% + filter(location == loc, + year >= input$year_range[1], + year <= input$year_range[2]) %>% + group_by(TL) %>% + summarise(sCh = sum(sCh, na.rm = TRUE), + deaths = sum(deaths, na.rm = TRUE), + outbreak_flag = as.integer(any(outbreak_number > 0)), + .groups = "drop") + } + }) + + output$ts_plot <- renderPlotly({ + # Empty-state placeholder (native plotly avoids the ggplotly date-axis issue) + empty_pl <- function(txt) { + plot_ly(type = "scatter", mode = "text") %>% + add_text(x = 0.5, y = 0.5, text = txt, + textfont = list(size = 11, color = "#888")) %>% + layout( + xaxis = list(visible = FALSE, range = c(0, 1)), + yaxis = list(visible = FALSE, range = c(0, 1)), + margin = list(t = 5, b = 5) + ) + } + + ts <- ts_raw() + if (is.null(ts) || nrow(ts) == 0) + return(empty_pl("Click a location on the map to see its weekly time series")) + + ts <- ts %>% arrange(TL) %>% + mutate(grp = cumsum(c(1, diff(outbreak_flag) != 0))) + + # xmax + 7 so a single-week outbreak has visible (non-zero) width + bands <- ts %>% + filter(outbreak_flag == 1) %>% + group_by(grp) %>% + summarise(xmin = min(TL), xmax = max(TL) + 7L, .groups = "drop") + + # ── Native plot_ly (not ggplotly) so the x-axis is type "date" and shapes + # with ISO date strings land at the correct positions. ggplotly() converts + # date axes to type "linear" (numeric days since epoch), making date-string + # shape coordinates silently collapse to x = 0. + shapes <- lapply(seq_len(nrow(bands)), function(i) { + list( + type = "rect", + fillcolor = "rgba(252,141,98,0.22)", + line = list(width = 0), + xref = "x", yref = "paper", + x0 = format(bands$xmin[i], "%Y-%m-%d"), + x1 = format(bands$xmax[i], "%Y-%m-%d"), + y0 = 0, y1 = 1, + layer = "below" + ) + }) + + plot_ly( + ts, + x = ~TL, + y = ~sCh, + type = "scatter", + mode = "lines+markers", + line = list(color = "#2c7bb6", width = 1.5), + marker = list(color = "#2c7bb6", size = 3), + text = ~paste0("", format(TL, "%b %d %Y"), "
", + scales::comma(sCh), " cases"), + hovertemplate = "%{text}", + showlegend = FALSE + ) %>% + layout( + xaxis = list( + title = "", + type = "date", + range = c("2010-01-01", "2024-12-31"), + tickformat = "%Y", + dtick = "M12" + ), + yaxis = list( + title = "Cases / week", + tickformat = "," + ), + shapes = shapes, + margin = list(t = 10, b = 40, l = 60, r = 20), + annotations = if (nrow(bands) > 0) list(list( + text = "Shaded = outbreak periods", + xref = "paper", yref = "paper", + x = 1, y = 1.02, xanchor = "right", yanchor = "bottom", + showarrow = FALSE, + font = list(size = 9, color = "#888") + )) else list() + ) + }) + + # ── Statistics table ──────────────────────────────────────────────────────── + table_df <- reactive({ + filtered_ob() %>% + left_join(name_lut, by = "country_iso3_cmp") %>% + mutate(country_label = coalesce(country_name, country_iso3_cmp)) %>% + group_by(scale, country_label, who_region) %>% + summarise( + n_locations = n_distinct(location), + n_outbreaks = n(), + total_cases = sum(total_cases, na.rm = TRUE), + total_deaths = sum(total_deaths, na.rm = TRUE), + cfr_pct = ifelse(sum(total_cases, na.rm = TRUE) > 0, + sum(total_deaths, na.rm = TRUE) / + sum(total_cases, na.rm = TRUE) * 100, NA_real_), + med_dur = median(n_weeks, na.rm = TRUE), + q1_dur = quantile(n_weeks, 0.25, na.rm = TRUE), + q3_dur = quantile(n_weeks, 0.75, na.rm = TRUE), + med_cases_ob = median(total_cases, na.rm = TRUE), + q1_cases_ob = quantile(total_cases, 0.25, na.rm = TRUE), + q3_cases_ob = quantile(total_cases, 0.75, na.rm = TRUE), + med_ar = median(attack_rate, na.rm = TRUE), + .groups = "drop" + ) %>% + mutate( + dur_iqr = sprintf("%.0f (%.0f–%.0f)", med_dur, q1_dur, q3_dur), + ob_iqr = sprintf("%s (%s–%s)", + format(round(med_cases_ob), big.mark = ","), + format(round(q1_cases_ob), big.mark = ","), + format(round(q3_cases_ob), big.mark = ",")), + cfr_str = ifelse(!is.na(cfr_pct) & cfr_pct > 0, + sprintf("%.1f", cfr_pct), "—"), + ar_str = ifelse(!is.na(med_ar), sprintf("%.2f", med_ar), "—"), + cases_f = format(total_cases, big.mark = ","), + deaths_f = ifelse(total_deaths > 0, + format(total_deaths, big.mark = ","), "—") + ) %>% + arrange(scale, desc(n_outbreaks)) %>% + select(scale, country_label, who_region, n_locations, n_outbreaks, + cases_f, deaths_f, cfr_str, dur_iqr, ob_iqr, ar_str) + }) + + output$stats_table <- renderDT({ + df <- table_df() + datatable( + df, + colnames = c( + "Level", "Country", "WHO Region", "Locations", + "Outbreaks", "Total cases", "Total deaths", "CFR (%)", + "Duration wk (IQR)", "Cases/outbreak (IQR)", "Attack rate /1k (med)" + ), + rownames = FALSE, + extensions = c("Buttons", "Scroller"), + options = list( + dom = "Bfrtip", + buttons = list(list(extend = "csv", filename = "cholera_outbreaks", + text = "⬇ Download CSV")), + scrollX = TRUE, + deferRender = TRUE, + scrollY = "420px", + scroller = TRUE, + pageLength = 50 + ) + ) %>% + formatStyle( + "n_outbreaks", + background = styleColorBar(c(0, max(df$n_outbreaks)), "#a8c7e8"), + backgroundSize = "90% 70%", + backgroundRepeat = "no-repeat", + backgroundPosition = "center" + ) + }) + + # ── Top locations bar chart ───────────────────────────────────────────────── + output$top_locs_plot <- renderPlot({ + top15 <- filtered_ob() %>% + group_by(location, who_region) %>% + summarise(total_cases = sum(total_cases, na.rm = TRUE), .groups = "drop") %>% + slice_max(total_cases, n = 15, with_ties = FALSE) %>% + mutate( + loc_short = str_trunc(location, 32), + loc_short = fct_reorder(loc_short, total_cases) + ) + + if (nrow(top15) == 0) { + return(ggplot() + annotate("text", x=0.5, y=0.5, label="No data", colour="grey60") + + theme_void()) + } + + ggplot(top15, aes(x = total_cases, y = loc_short, fill = who_region)) + + geom_col(alpha = 0.85, width = 0.7) + + geom_text(aes(label = format(total_cases, big.mark = ",")), + hjust = -0.1, size = 2.6, colour = "#333") + + scale_fill_manual(values = REGION_COLOURS, labels = REGION_LABELS, name = NULL) + + scale_x_continuous(labels = comma_format(), + expand = expansion(mult = c(0, 0.18))) + + labs(x = "Total cases", y = NULL) + + theme_bw(base_size = 10) + + theme(legend.position = "bottom", + legend.text = element_text(size = 7), + axis.text.y = element_text(size = 8), + panel.grid.major.y = element_blank()) + }) + + # ── Heatmap ────────────────────────────────────────────────────────────────── + output$heatmap_title <- renderText({ + m <- switch(input$heatmap_metric, + "n_outbreaks" = "Outbreak count", + "total_cases" = "Total cases") + paste0(m, " by country × year — ", input$admin_level, " level") + }) + + heatmap_df <- reactive({ + metric <- input$heatmap_metric + yr <- input$year_range + + base <- filtered_ob() %>% + left_join(name_lut, by = "country_iso3_cmp") %>% + mutate(country_label = coalesce(country_name, country_iso3_cmp)) %>% + group_by(country_label, year) %>% + summarise( + n_outbreaks = n(), + total_cases = sum(total_cases, na.rm = TRUE), + .groups = "drop" + ) + + # Full year × country grid so absent years appear as NA (grey) + full_grid <- expand.grid( + country_label = unique(base$country_label), + year = seq(yr[1], yr[2]), + stringsAsFactors = FALSE + ) + left_join(full_grid, base, by = c("country_label", "year")) + }) + + output$heatmap <- renderPlotly({ + hd <- heatmap_df() + metric <- input$heatmap_metric + mlabel <- switch(metric, n_outbreaks = "Outbreaks (n)", total_cases = "Total cases") + + if (nrow(hd) == 0) + return(plotly_empty(type = "scatter") %>% layout(title = "No data for current filters")) + + # Sort countries: most active at the top of the plot (highest y-axis value) + country_order <- hd %>% + group_by(country_label) %>% + summarise(total = sum(.data[[metric]], na.rm = TRUE), .groups = "drop") %>% + arrange(total) %>% # ascending → top of y-axis is the largest + pull(country_label) + + hd <- hd %>% + mutate( + country_label = factor(country_label, levels = country_order), + val_disp = ifelse(is.na(.data[[metric]]), "—", + format(.data[[metric]], big.mark = ",")), + tooltip = paste0("", country_label, " (", year, ")
", + mlabel, ": ", val_disp) + ) + + p <- ggplot(hd, aes(x = year, y = country_label, + fill = .data[[metric]], text = tooltip)) + + geom_tile(colour = "white", linewidth = 0.25) + + scale_fill_viridis_c( + option = "viridis", + na.value = "#f0f0f0", + name = mlabel, + labels = comma_format() + ) + + scale_x_continuous( + breaks = seq(input$year_range[1], input$year_range[2], + by = max(1L, as.integer((diff(input$year_range) + 1L) / 8L))) + ) + + labs(x = "Year", y = NULL) + + theme_bw(base_size = 10) + + theme( + axis.text.x = element_text(angle = 45, hjust = 1), + axis.text.y = element_text(size = 8), + panel.grid = element_blank(), + legend.title = element_text(size = 9) + ) + + ggplotly(p, tooltip = "text") %>% + layout( + margin = list(l = 130, b = 60, t = 10, r = 20), + yaxis = list(tickfont = list(size = 9)) + ) + }) +} + +# ── 6. Run ──────────────────────────────────────────────────────────────────── +shinyApp(ui, server) diff --git a/shiny/data_prep.R b/shiny/data_prep.R new file mode 100644 index 0000000..02b8166 --- /dev/null +++ b/shiny/data_prep.R @@ -0,0 +1,153 @@ +#!/usr/bin/env Rscript +# shiny/data_prep.R ───────────────────────────────────────────────────────── +# Run ONCE from the project root to build the centroid lookup used by the app. +# +# Rscript shiny/data_prep.R +# +# Output: shiny/data/centroids.rds +# A data frame: location (chr) | lon (dbl) | lat (dbl) +# One row per unique location string found across all stage1_geo GeoJSONs. +# ───────────────────────────────────────────────────────────────────────────── + +suppressPackageStartupMessages({ + library(sf) + library(dplyr) + library(stringr) + library(here) +}) + +cat("=== Cholera Outbreak Explorer — centroid build ===\n") +t0 <- proc.time() + +geojson_dir <- here("analysis/generated_data") +geojson_files <- list.files(geojson_dir, + pattern = "^stage1_geo_.*\\.geojson$", + full.names = TRUE) +cat(sprintf("Found %d GeoJSON files in %s\n", length(geojson_files), geojson_dir)) + +if (length(geojson_files) == 0) { + stop("No stage1_geo_*.geojson files found. Run 01_pull_data.R first.") +} + +# ── One representative file per country prefix ──────────────────────────────── +# Naming: stage1_geo_{REGION}_{ISO3}_TL{date}_TR{date}_thresh-*.geojson +# Extract everything up to the first "_TL" as the "country key". +country_key <- str_extract(basename(geojson_files), "^stage1_geo_.+?(?=_TL\\d)") +country_key[is.na(country_key)] <- basename(geojson_files)[is.na(country_key)] + +# Pick the largest file per key — larger files tend to have more admin levels +files_df <- tibble(path = geojson_files, key = country_key, + size = file.size(geojson_files)) + +# For each country-key, pick the largest file in each 4-year time window. +# This ensures that administrative boundary changes over time are captured +# (e.g. DRC reorganised from 11 → 26 provinces in 2015; older files carry the +# old names, 2017-2018 files carry the new names, recent files may only have +# admin3 data). Within-window deduplication, then global dedup, collapses +# overlapping centroids without double-counting. +rep_files_by_key <- files_df %>% + filter(!is.na(key)) %>% + mutate( + tl_year = as.integer(str_extract(basename(path), "(?<=_TL)[0-9]{4}")), + window = (tl_year %/% 4L) * 4L # 2010, 2014, 2018, 2022, … + ) %>% + group_by(key, window) %>% + slice_max(size, n = 1, with_ties = FALSE) %>% + ungroup() %>% + arrange(key, desc(size)) %>% + group_by(key) %>% + summarise(candidates = list(path), .groups = "drop") %>% + { setNames(.$candidates, .$key) } + +rep_files <- sapply(rep_files_by_key, `[[`, 1) # still used for progress counter + +cat(sprintf("Reading %d representative files (one per country, with fallback on error)...\n", length(rep_files))) + +# ── Extract (location, centroid) from each file ─────────────────────────────── +read_centroids <- function(path) { + tryCatch({ + obj <- suppressWarnings(sf::st_read(path, quiet = TRUE)) + if (!inherits(obj, "sf") || nrow(obj) == 0) return(NULL) + if (!"location" %in% names(obj)) return(NULL) + + # Deduplicate on location BEFORE centroid computation. + # Large files (e.g. COD 380 MB / 306K rows) have many time-repeated geometries + # for the same location; deduplication makes st_centroid tractable. + obj <- obj[!duplicated(obj$location), ] + + # Repair any invalid geometries (e.g. duplicate vertices, self-intersections) + # before computing centroids. + obj <- suppressWarnings(sf::st_make_valid(obj)) + + suppressWarnings(cents <- sf::st_centroid(obj)) + coords <- sf::st_coordinates(cents) + + tibble( + location = as.character(obj$location), + lon = coords[, "X"], + lat = coords[, "Y"] + ) + }, error = function(e) { + message(sprintf(" [WARN] %s: %s", basename(path), conditionMessage(e))) + NULL + }) +} + +# Process one file per 4-year window per country; merge results. +# All windows are attempted; failures are skipped without aborting the country. +keys <- names(rep_files_by_key) +results <- vector("list", length(keys)) +for (i in seq_along(keys)) { + if (i %% 10 == 0 || i == length(keys)) + cat(sprintf(" [%d/%d] %s (%d window files)\n", + i, length(keys), keys[i], length(rep_files_by_key[[keys[i]]]))) + per_country <- lapply(rep_files_by_key[[keys[i]]], function(cand) { + res <- read_centroids(cand) + if (is.null(res) || nrow(res) == 0) { + message(sprintf(" [skip] %s", basename(cand))) + return(NULL) + } + res + }) + combined <- bind_rows(per_country) + results[[i]] <- if (nrow(combined) > 0) combined else NULL +} + +centroids <- bind_rows(results) %>% + filter(!is.na(lon), !is.na(lat), is.finite(lon), is.finite(lat)) %>% + distinct(location, .keep_all = TRUE) + +cat(sprintf("\nUnique locations with centroids (from GeoJSONs): %d\n", nrow(centroids))) + +# ── Back-propagate parent centroids ────────────────────────────────────────── +# Some location strings used in the outbreak CSV are *aggregate* nodes that +# have no direct geometry in the GeoJSONs (e.g. "AFR::TZA::Mainland"). +# We approximate their centroid as the mean of their children's centroids, +# repeating up the hierarchy until no new parents can be inferred. +add_parent_centroids <- function(df) { + repeat { + existing <- df$location + parents <- df %>% + mutate(parent = str_replace(location, "::[^:]+$", "")) %>% + filter(parent != location, !parent %in% existing) %>% + group_by(parent) %>% + summarise(lon = mean(lon, na.rm = TRUE), + lat = mean(lat, na.rm = TRUE), + .groups = "drop") %>% + rename(location = parent) + + if (nrow(parents) == 0) break + df <- bind_rows(df, parents) + } + df +} + +centroids <- add_parent_centroids(centroids) +cat(sprintf("Unique locations after parent back-propagation: %d\n", nrow(centroids))) + +# ── Save ────────────────────────────────────────────────────────────────────── +out_path <- here("shiny/data/centroids.rds") +saveRDS(centroids, out_path) + +elapsed <- (proc.time() - t0)[["elapsed"]] +cat(sprintf("Saved to %s (%.0f s)\n", out_path, elapsed)) diff --git a/tests/testthat/test-add_population.R b/tests/testthat/test-add_population.R new file mode 100644 index 0000000..fe36e68 --- /dev/null +++ b/tests/testthat/test-add_population.R @@ -0,0 +1,213 @@ +# Offline WorldPop stand-in: a 0.01-degree raster over lon [0,3] x lat [0,1]. +# Each cell carries `value`, so a 1x1-degree square extracts to 10,000 * value. +# download_worldpop_constrained() is mocked to hand this file back, which keeps +# the real raster::raster() and exactextractr::exact_extract() code paths under +# test without any network access. +local_worldpop_stub <- function(value = 1, env = parent.frame()) { + r <- raster::raster(xmn = 0, xmx = 3, ymn = 0, ymx = 1, res = 0.01, + crs = "+proj=longlat +datum=WGS84") + raster::values(r) <- value + path <- withr::local_tempfile(fileext = ".tif", .local_envir = env) + raster::writeRaster(r, path, overwrite = TRUE) + testthat::local_mocked_bindings( + download_worldpop_constrained = function(...) path, + .env = env + ) + path +} + +sq <- function(x0) { + sf::st_polygon(list(rbind(c(x0, 0), c(x0 + 1, 0), c(x0 + 1, 1), + c(x0, 1), c(x0, 0)))) +} + +two_lp_fixture <- function(locations = c("AFR::ZZZ::A", "AFR::ZZZ::B"), + geoms = sf::st_sfc(sq(0), sq(1), crs = 4326), + year = 2018L) { + raw_sf <- sf::st_sf(location_period_id = c("100", "200"), geometry = geoms) + normalized <- data.frame( + location = rep(locations, each = 3L), + location_period_id = rep(c("100", "200"), each = 3L), + TL = as.Date(paste0(year, c("-01-01", "-02-01", "-03-01"))), + stringsAsFactors = FALSE + ) + list(raw_sf = raw_sf, normalized = normalized) +} + +testthat::test_that("add_population extracts pop and attaches the full provenance schema", { + testthat::skip_if_not_installed("sf") + local_worldpop_stub(value = 1) + + fx <- two_lp_fixture() + res <- suppressMessages( + add_population(fx$normalized, fx$raw_sf, "ZZZ", + boundary_cache_dir = withr::local_tempdir())) + + testthat::expect_true(all(c("pop", "pop_source", "pop_geom_dup_n", + "pop_geom_dup_class", "pop_year_obs", + "pop_year_raster", "pop_natl_ref", "adj_factor", + "adj_factor_flag") %in% names(res))) + testthat::expect_equal(nrow(res), nrow(fx$normalized)) + testthat::expect_equal(unique(res$pop), 10000, tolerance = 1e-6) + testthat::expect_equal(unique(res$pop_source), "worldpop_constrained") + testthat::expect_equal(unique(res$pop_geom_dup_n), 1L) + testthat::expect_equal(unique(res$pop_geom_dup_class), "unique") +}) + +testthat::test_that("a missing rgeoboundaries leaves pop unadjusted rather than union-scaled", { + testthat::skip_if_not_installed("sf") + testthat::skip_if(requireNamespace("rgeoboundaries", quietly = TRUE), + "rgeoboundaries is installed; the no-boundary path is untestable here") + local_worldpop_stub(value = 1) + + # COD is present in WPP2024, so tot_UN resolves and the *only* thing standing + # between the code and an adjustment factor is the national boundary. + fx <- two_lp_fixture() + res <- suppressMessages( + add_population(fx$normalized, fx$raw_sf, "COD", + boundary_cache_dir = withr::local_tempdir())) + + # No boundary -> adj_factor 1.0 and flagged "unadjusted". The old LP-union + # fallback would have understated country_raw and scaled every pop upward. + testthat::expect_true(all(res$pop_natl_ref > 0)) + testthat::expect_equal(unique(res$adj_factor), 1.0) + testthat::expect_equal(unique(res$adj_factor_flag), "unadjusted") + testthat::expect_equal(unique(res$pop), 10000, tolerance = 1e-6) +}) + +testthat::test_that("add_population records the observed year and the clamped raster year", { + testthat::skip_if_not_installed("sf") + local_worldpop_stub(value = 1) + + fx <- two_lp_fixture(year = 2010L) # before the WorldPop constrained range + res <- suppressMessages( + add_population(fx$normalized, fx$raw_sf, "ZZZ", + boundary_cache_dir = withr::local_tempdir())) + + testthat::expect_equal(unique(res$pop_year_obs), 2010L) + testthat::expect_equal(unique(res$pop_year_raster), 2015L) + testthat::expect_true(all(res$pop_year_obs != res$pop_year_raster)) +}) + +testthat::test_that("add_population flags LPs that share an identical geometry", { + testthat::skip_if_not_installed("sf") + local_worldpop_stub(value = 1) + + # Two LPs at different hierarchy depths carrying the same polygon: the child + # is assigned the whole parent population. + fx <- two_lp_fixture( + locations = c("AFR::ZZZ::Conakry", "AFR::ZZZ::Conakry::Dixinn"), + geoms = sf::st_sfc(sq(0), sq(0), crs = 4326) + ) + res <- suppressMessages( + add_population(fx$normalized, fx$raw_sf, "ZZZ", + boundary_cache_dir = withr::local_tempdir())) + + testthat::expect_equal(unique(res$pop_geom_dup_n), 2L) + testthat::expect_equal(unique(res$pop_geom_dup_class), "parent_inherited") +}) + +testthat::test_that("add_population emits NA, never 0, when WorldPop has no cells", { + testthat::skip_if_not_installed("sf") + local_worldpop_stub(value = 0) + + fx <- two_lp_fixture() + res <- suppressMessages( + add_population(fx$normalized, fx$raw_sf, "ZZZ", + boundary_cache_dir = withr::local_tempdir())) + + # pop == 0 gives sCh/pop == Inf, which get_outbreak_threshold() classifies as + # "high" — a zero denominator flips the threshold instead of being missing. + testthat::expect_true(all(is.na(res$pop))) + testthat::expect_equal(unique(res$pop_source), "none") +}) + +testthat::test_that("add_population sets pop = NA for LPs with no geometry", { + testthat::skip_if_not_installed("sf") + local_worldpop_stub(value = 1) + + fx <- two_lp_fixture() + fx$normalized$location_period_id[fx$normalized$location_period_id == "200"] <- "999" + + res <- suppressMessages( + add_population(fx$normalized, fx$raw_sf, "ZZZ", + boundary_cache_dir = withr::local_tempdir())) + + testthat::expect_true(all(is.na(res$pop[res$location_period_id == "999"]))) + testthat::expect_equal(unique(res$pop_source[res$location_period_id == "999"]), + "none") + testthat::expect_false(any(is.na(res$pop[res$location_period_id == "100"]))) +}) + +testthat::test_that("a failed raster download yields NA pop with the schema intact", { + testthat::skip_if_not_installed("sf") + testthat::local_mocked_bindings( + download_worldpop_constrained = function(...) stop("no network") + ) + + fx <- two_lp_fixture() + res <- suppressMessages( + add_population(fx$normalized, fx$raw_sf, "ZZZ", + boundary_cache_dir = withr::local_tempdir())) + + testthat::expect_true(all(is.na(res$pop))) + testthat::expect_equal(unique(res$pop_source), "none") + testthat::expect_equal(unique(res$pop_year_obs), 2018L) + testthat::expect_equal(unique(res$pop_geom_dup_class), "unique") +}) + +testthat::test_that("add_population returns the provenance schema when no LP id is usable", { + testthat::skip_if_not_installed("sf") + + fx <- two_lp_fixture() + fx$normalized$location_period_id <- NA_character_ + + testthat::expect_message( + res <- add_population(fx$normalized, fx$raw_sf, "ZZZ", + boundary_cache_dir = withr::local_tempdir()), + "no valid location_period_ids") + + testthat::expect_equal(nrow(res), nrow(fx$normalized)) + testthat::expect_true(all(is.na(res$pop))) + testthat::expect_equal(unique(res$pop_source), "none") + testthat::expect_equal(unique(res$pop_geom_dup_n), 1L) + testthat::expect_true(all(is.na(res$pop_year_obs))) +}) + +testthat::test_that("add_population accepts the camelCase and lctn_pr geometry keys", { + testthat::skip_if_not_installed("sf") + local_worldpop_stub(value = 1) + + fx <- two_lp_fixture() + for (key in c("locationPeriod_id", "lctn_pr")) { + raw <- fx$raw_sf + names(raw)[names(raw) == "location_period_id"] <- key + res <- suppressMessages( + add_population(fx$normalized, raw, "ZZZ", + boundary_cache_dir = withr::local_tempdir())) + testthat::expect_equal(unique(res$pop), 10000, tolerance = 1e-6) + } + + raw <- fx$raw_sf + names(raw)[names(raw) == "location_period_id"] <- "nonsense" + testthat::expect_error(add_population(fx$normalized, raw, "ZZZ"), + "location_period_id") +}) + +testthat::test_that("add_population overwrites stale provenance columns instead of suffixing them", { + testthat::skip_if_not_installed("sf") + local_worldpop_stub(value = 1) + + fx <- two_lp_fixture() + fx$normalized$pop <- 42 + fx$normalized$pop_source <- "stale" + fx$normalized$adj_factor <- 99 + + res <- suppressMessages( + add_population(fx$normalized, fx$raw_sf, "ZZZ", + boundary_cache_dir = withr::local_tempdir())) + + testthat::expect_false(any(grepl("\\.x$|\\.y$", names(res)))) + testthat::expect_equal(unique(res$pop), 10000, tolerance = 1e-6) + testthat::expect_equal(unique(res$pop_source), "worldpop_constrained") +}) diff --git a/tests/testthat/test-build_composite_locations.R b/tests/testthat/test-build_composite_locations.R new file mode 100644 index 0000000..6ee2c6c --- /dev/null +++ b/tests/testthat/test-build_composite_locations.R @@ -0,0 +1,343 @@ +testthat::test_that("match_children_to_lps strips ' Sanitary District' and keeps one LP per child", { + child_tbl <- data.frame( + composite_name = "AFR::BDI::Cankuzo::Cankuzo|Murore", + location = c("AFR::BDI::Cankuzo::Cankuzo", "AFR::BDI::Cankuzo::Murore"), + stringsAsFactors = FALSE + ) + loc_lookup <- data.frame( + location = c("AFR::BDI::Cankuzo::Cankuzo Sanitary District", + "AFR::BDI::Cankuzo::Murore Sanitary District"), + location_period_id = c("15468", "15469"), + pop = c(100, 200), + stringsAsFactors = FALSE + ) + res <- OutbreakExtractR:::match_children_to_lps(child_tbl, loc_lookup) + + testthat::expect_equal(nrow(res), 2L) + testthat::expect_equal( + res$location_period_id[res$location == "AFR::BDI::Cankuzo::Cankuzo"], "15468") + testthat::expect_equal( + res$location_period_id[res$location == "AFR::BDI::Cankuzo::Murore"], "15469") + testthat::expect_equal( + res$pop[res$location == "AFR::BDI::Cankuzo::Cankuzo"], 100) +}) + +testthat::test_that("match_children_to_lps prefers an exact match over the normalized fallback", { + child_tbl <- data.frame(composite_name = "c", location = "AFR::X::Foo", + stringsAsFactors = FALSE) + loc_lookup <- data.frame( + location = c("AFR::X::Foo", "AFR::X::Foo Sanitary District"), + location_period_id = c("1", "2"), + pop = c(9, 9), + stringsAsFactors = FALSE + ) + res <- OutbreakExtractR:::match_children_to_lps(child_tbl, loc_lookup) + testthat::expect_equal(res$location_period_id, "1") +}) + +testthat::test_that("match_children_to_lps resolves one child to a single LP (prefer non-NA pop, lowest id)", { + child_tbl <- data.frame(composite_name = "c", location = "AFR::X::Bar", + stringsAsFactors = FALSE) + loc_lookup <- data.frame( + location = rep("AFR::X::Bar Sanitary District", 3L), + location_period_id = c("30", "20", "25"), + pop = c(NA, 5, 5), + stringsAsFactors = FALSE + ) + res <- OutbreakExtractR:::match_children_to_lps(child_tbl, loc_lookup) + testthat::expect_equal(nrow(res), 1L) + testthat::expect_equal(res$location_period_id, "20") +}) + +testthat::test_that("match_children_to_lps returns NA LP for unmatched children", { + child_tbl <- data.frame(composite_name = "c", location = "AFR::X::Ghost", + stringsAsFactors = FALSE) + loc_lookup <- data.frame(location = "AFR::X::Other", location_period_id = "1", + pop = 1, stringsAsFactors = FALSE) + res <- OutbreakExtractR:::match_children_to_lps(child_tbl, loc_lookup) + testthat::expect_true(is.na(res$location_period_id)) +}) + +testthat::test_that("build_composite_locations recovers child geometry + pop via suffix normalization", { + testthat::skip_if_not_installed("sf") + + p1 <- sf::st_polygon(list(rbind(c(0, 0), c(1, 0), c(1, 1), c(0, 1), c(0, 0)))) + p2 <- sf::st_polygon(list(rbind(c(1, 0), c(2, 0), c(2, 1), c(1, 1), c(1, 0)))) + raw_sf <- sf::st_sf( + location_period_id = c("100", "200"), + geometry = sf::st_sfc(p1, p2), + crs = 4326 + ) + + normalized <- data.frame( + location = c("AFR::ZZZ::Prov::Alpha Sanitary District", + "AFR::ZZZ::Prov::Beta Sanitary District", + "AFR::ZZZ::Prov::Alpha|Beta"), + location_period_id = c("100", "200", NA), + pop = c(1000, 2000, NA), + spatial_scale = c("admin2", "admin2", "admin2"), + stringsAsFactors = FALSE + ) + + res <- build_composite_locations(normalized, raw_sf, "ZZZ") + + comp_row <- res$data[grepl("composite_loc_ZZZ", res$data$location_period_id), ] + testthat::expect_equal(nrow(comp_row), 1L) + testthat::expect_equal(comp_row$pop, 3000) # summed child pops, no double count + + testthat::expect_false(is.null(res$geometry)) + testthat::expect_equal(nrow(res$geometry), 1L) # union of the two child squares +}) + +testthat::test_that("build_composite_locations uses WorldPop-on-geometry pop when raster_dir given", { + testthat::skip_if_not_installed("sf") + + p1 <- sf::st_polygon(list(rbind(c(0, 0), c(1, 0), c(1, 1), c(0, 1), c(0, 0)))) + p2 <- sf::st_polygon(list(rbind(c(1, 0), c(2, 0), c(2, 1), c(1, 1), c(1, 0)))) + raw_sf <- sf::st_sf( + location_period_id = c("100", "200"), + geometry = sf::st_sfc(p1, p2), + crs = 4326 + ) + + normalized <- data.frame( + location = c("AFR::ZZZ::Prov::Alpha Sanitary District", + "AFR::ZZZ::Prov::Beta Sanitary District", + "AFR::ZZZ::Prov::Alpha|Beta"), + location_period_id = c("100", "200", NA), + pop = c(1000, 2000, NA), + spatial_scale = c("admin2", "admin2", "admin2"), + TL = as.Date(c("2018-01-01", "2018-01-01", "2018-01-01")), + stringsAsFactors = FALSE + ) + + # Offline: mock the raster extraction to return a fixed sub-area denominator. + testthat::local_mocked_bindings( + estimate_pop_for_geometries = function(geom_sf, country_iso3, year, + raster_dir = "worldpop") { + rep(5555, nrow(geom_sf)) + } + ) + + res <- build_composite_locations(normalized, raw_sf, "ZZZ", + raster_dir = "ignored") + + comp_row <- res$data[grepl("composite_loc_ZZZ", res$data$location_period_id), ] + testthat::expect_equal(nrow(comp_row), 1L) + # Geometry-derived pop (5555) overrides the summed-child pop (3000). + testthat::expect_equal(comp_row$pop, 5555) +}) + +testthat::test_that("build_composite_locations keeps summed-child pop when geometry pop is NA/0", { + testthat::skip_if_not_installed("sf") + + p1 <- sf::st_polygon(list(rbind(c(0, 0), c(1, 0), c(1, 1), c(0, 1), c(0, 0)))) + p2 <- sf::st_polygon(list(rbind(c(1, 0), c(2, 0), c(2, 1), c(1, 1), c(1, 0)))) + raw_sf <- sf::st_sf( + location_period_id = c("100", "200"), + geometry = sf::st_sfc(p1, p2), + crs = 4326 + ) + normalized <- data.frame( + location = c("AFR::ZZZ::Prov::Alpha Sanitary District", + "AFR::ZZZ::Prov::Beta Sanitary District", + "AFR::ZZZ::Prov::Alpha|Beta"), + location_period_id = c("100", "200", NA), + pop = c(1000, 2000, NA), + spatial_scale = c("admin2", "admin2", "admin2"), + TL = as.Date(c("2018-01-01", "2018-01-01", "2018-01-01")), + stringsAsFactors = FALSE + ) + + testthat::local_mocked_bindings( + estimate_pop_for_geometries = function(geom_sf, country_iso3, year, + raster_dir = "worldpop") { + rep(NA_real_, nrow(geom_sf)) + } + ) + + res <- build_composite_locations(normalized, raw_sf, "ZZZ", + raster_dir = "ignored") + comp_row <- res$data[grepl("composite_loc_ZZZ", res$data$location_period_id), ] + testthat::expect_equal(comp_row$pop, 3000) # falls back to summed child pop +}) + +# --------------------------------------------------------------------------- +# Population precedence and the parent fallback gate +# --------------------------------------------------------------------------- + +# A composite whose children are never observed atomically: only the parent +# admin unit ("Prov") carries an LP, a geometry and a population. +orphan_composite_fixture <- function() { + parent_poly <- sf::st_polygon( + list(rbind(c(0, 0), c(2, 0), c(2, 1), c(0, 1), c(0, 0)))) + raw_sf <- sf::st_sf( + location_period_id = "900", + geometry = sf::st_sfc(parent_poly), + crs = 4326 + ) + normalized <- data.frame( + location = c("AFR::ZZZ::Prov", "AFR::ZZZ::Prov::Alpha|Beta"), + location_period_id = c("900", NA), + pop = c(7000, NA), + spatial_scale = c("admin1", "admin2"), + TL = as.Date(c("2018-01-01", "2018-01-01")), + pop_source = c("worldpop_constrained", NA), + stringsAsFactors = FALSE + ) + list(raw_sf = raw_sf, normalized = normalized) +} + +testthat::test_that("a composite with no child pop is left NA by default, not given its parent's", { + testthat::skip_if_not_installed("sf") + fx <- orphan_composite_fixture() + + res <- suppressMessages( + build_composite_locations(fx$normalized, fx$raw_sf, "ZZZ")) + + comp <- res$data[grepl("composite_loc_ZZZ", res$data$location_period_id), ] + testthat::expect_equal(nrow(comp), 1L) + # The parent is a strictly larger area, so inheriting 7000 would overstate the + # denominator by however much of Prov the composite does not cover. NA routes + # the composite to the "low" surveillance class instead. + testthat::expect_true(is.na(comp$pop)) + testthat::expect_equal(comp$pop_source, "none") +}) + +testthat::test_that("allow_parent_pop_fallback = TRUE opts into the parent population", { + testthat::skip_if_not_installed("sf") + fx <- orphan_composite_fixture() + + res <- suppressMessages( + build_composite_locations(fx$normalized, fx$raw_sf, "ZZZ", + allow_parent_pop_fallback = TRUE)) + + comp <- res$data[grepl("composite_loc_ZZZ", res$data$location_period_id), ] + testthat::expect_equal(comp$pop, 7000) + testthat::expect_equal(comp$pop_source, "parent_fallback") +}) + +testthat::test_that("WorldPop run on a parent polygon is classified parent_fallback, not composite_union", { + testthat::skip_if_not_installed("sf") + fx <- orphan_composite_fixture() + + # The composite has no child geometry, so step 6b puts it on the PARENT + # polygon. Extracting the raster there returns the parent's population — it + # must not be presented as a geometry-derived sub-area denominator. + testthat::local_mocked_bindings( + estimate_pop_for_geometries = function(geom_sf, country_iso3, year, ...) { + rep(5555, nrow(geom_sf)) + } + ) + + gated <- suppressMessages( + build_composite_locations(fx$normalized, fx$raw_sf, "ZZZ", + raster_dir = "ignored")) + comp <- gated$data[grepl("composite_loc_ZZZ", gated$data$location_period_id), ] + testthat::expect_true(is.na(comp$pop)) + testthat::expect_equal(comp$pop_source, "none") + + opted_in <- suppressMessages( + build_composite_locations(fx$normalized, fx$raw_sf, "ZZZ", + raster_dir = "ignored", + allow_parent_pop_fallback = TRUE)) + comp2 <- opted_in$data[grepl("composite_loc_ZZZ", opted_in$data$location_period_id), ] + testthat::expect_equal(comp2$pop_source, "parent_fallback") + # The atomic parent pop (7000) is preferred over the raster-on-parent value. + testthat::expect_equal(comp2$pop, 7000) +}) + +testthat::test_that("build_composite_locations never manufactures a zero denominator", { + testthat::skip_if_not_installed("sf") + + p1 <- sf::st_polygon(list(rbind(c(0, 0), c(1, 0), c(1, 1), c(0, 1), c(0, 0)))) + p2 <- sf::st_polygon(list(rbind(c(1, 0), c(2, 0), c(2, 1), c(1, 1), c(1, 0)))) + raw_sf <- sf::st_sf( + location_period_id = c("100", "200"), + geometry = sf::st_sfc(p1, p2), + crs = 4326 + ) + # Both children have pop = NA. sum(na.rm = TRUE) over them returns 0, which + # would give sCh/0 == Inf and flip the composite into the "high" class. + normalized <- data.frame( + location = c("AFR::ZZZ::Prov::Alpha", "AFR::ZZZ::Prov::Beta", + "AFR::ZZZ::Prov::Alpha|Beta"), + location_period_id = c("100", "200", NA), + pop = c(NA_real_, NA_real_, NA_real_), + spatial_scale = rep("admin2", 3L), + TL = as.Date(rep("2018-01-01", 3L)), + stringsAsFactors = FALSE + ) + + res <- suppressMessages(build_composite_locations(normalized, raw_sf, "ZZZ")) + comp <- res$data[grepl("composite_loc_ZZZ", res$data$location_period_id), ] + + testthat::expect_true(is.na(comp$pop)) + testthat::expect_false(isTRUE(comp$pop == 0)) + testthat::expect_equal(comp$pop_source, "none") +}) + +testthat::test_that("composite pop_source is recorded and atomic rows keep theirs", { + testthat::skip_if_not_installed("sf") + + p1 <- sf::st_polygon(list(rbind(c(0, 0), c(1, 0), c(1, 1), c(0, 1), c(0, 0)))) + p2 <- sf::st_polygon(list(rbind(c(1, 0), c(2, 0), c(2, 1), c(1, 1), c(1, 0)))) + raw_sf <- sf::st_sf( + location_period_id = c("100", "200"), + geometry = sf::st_sfc(p1, p2), + crs = 4326 + ) + normalized <- data.frame( + location = c("AFR::ZZZ::Prov::Alpha", "AFR::ZZZ::Prov::Beta", + "AFR::ZZZ::Prov::Alpha|Beta"), + location_period_id = c("100", "200", NA), + pop = c(1000, 2000, NA), + pop_source = c("worldpop_constrained", "worldpop_constrained", NA), + spatial_scale = rep("admin2", 3L), + TL = as.Date(rep("2018-01-01", 3L)), + stringsAsFactors = FALSE + ) + + res <- suppressMessages(build_composite_locations(normalized, raw_sf, "ZZZ")) + + comp <- res$data[grepl("composite_loc_ZZZ", res$data$location_period_id), ] + atomic <- res$data[res$data$location_period_id == "100", ] + + testthat::expect_equal(comp$pop_source, "child_sum") + testthat::expect_equal(comp$pop, 3000) + testthat::expect_equal(atomic$pop_source, "worldpop_constrained") +}) + +testthat::test_that("geometry-derived pop on a genuine child union is classified composite_union", { + testthat::skip_if_not_installed("sf") + + p1 <- sf::st_polygon(list(rbind(c(0, 0), c(1, 0), c(1, 1), c(0, 1), c(0, 0)))) + p2 <- sf::st_polygon(list(rbind(c(1, 0), c(2, 0), c(2, 1), c(1, 1), c(1, 0)))) + raw_sf <- sf::st_sf( + location_period_id = c("100", "200"), + geometry = sf::st_sfc(p1, p2), + crs = 4326 + ) + normalized <- data.frame( + location = c("AFR::ZZZ::Prov::Alpha", "AFR::ZZZ::Prov::Beta", + "AFR::ZZZ::Prov::Alpha|Beta"), + location_period_id = c("100", "200", NA), + pop = c(1000, 2000, NA), + spatial_scale = rep("admin2", 3L), + TL = as.Date(rep("2018-01-01", 3L)), + stringsAsFactors = FALSE + ) + + testthat::local_mocked_bindings( + estimate_pop_for_geometries = function(geom_sf, country_iso3, year, ...) { + rep(5555, nrow(geom_sf)) + } + ) + + res <- suppressMessages( + build_composite_locations(normalized, raw_sf, "ZZZ", raster_dir = "ignored")) + comp <- res$data[grepl("composite_loc_ZZZ", res$data$location_period_id), ] + + testthat::expect_equal(comp$pop, 5555) + testthat::expect_equal(comp$pop_source, "composite_union") +}) diff --git a/tests/testthat/test-clean_psql_data.R b/tests/testthat/test-clean_psql_data.R index e282ff1..5d50b10 100644 --- a/tests/testthat/test-clean_psql_data.R +++ b/tests/testthat/test-clean_psql_data.R @@ -20,3 +20,55 @@ test_that("clean_psql_data works", { testthat::expect_true(all(unique(clean_outbreak_ts$spatial_scale) %in% c("country", "admin1", "admin2", "admin3", "admin4 or lower"))) testthat::expect_true(all(!is.na(clean_outbreak_ts$spatial_scale))) }) + +# Composite locations ("|"-joined names) that only ever appear as non-primary +# must be retained; non-composite non-primary rows are still dropped. +test_that("clean_psql_data retains non-primary composite locations", { + df <- data.frame( + TL = c("2018-01-01", "2018-01-08", "2018-01-01", "2018-01-01"), + TR = c("2018-01-07", "2018-01-14", "2018-01-07", "2018-01-07"), + sCh = c(5, 3, 10, 7), + cCh = c(NA, NA, NA, NA), + deaths = c(0, 0, 0, 0), + location_period_id = c(NA, NA, 100, 101), + primary = c("f", "f", "f", "t"), + phantom = c(FALSE, FALSE, FALSE, FALSE), + location = c( + "AFR::SEN::Saint-Louis::Dagana::Mbane|Ross-Bethio", # composite, non-primary -> keep + "AFR::SEN::Saint-Louis::Dagana::Mbane|Ross-Bethio", # composite, non-primary -> keep + "AFR::SEN::Saint-Louis::Podor", # atomic, non-primary -> drop + "AFR::SEN::Saint-Louis::Dagana" # atomic, primary -> keep + ), + observation_collection_id = c("a", "b", "c", "d"), + stringsAsFactors = FALSE + ) + cleaned <- clean_psql_data(original_data = df) + testthat::expect_equal(sum(cleaned$composite_loc), 2) + testthat::expect_true(all(grepl("\\|", cleaned$location[cleaned$composite_loc]))) + testthat::expect_false(any(cleaned$location == "AFR::SEN::Saint-Louis::Podor")) + testthat::expect_true(any(cleaned$location == "AFR::SEN::Saint-Louis::Dagana")) +}) + +# A composite that also appears as primary keeps ONLY its primary rows +# (no double-counting of the non-primary duplicate). +test_that("clean_psql_data does not duplicate composites that have a primary version", { + df <- data.frame( + TL = c("2018-01-01", "2018-01-01"), + TR = c("2018-01-07", "2018-01-07"), + sCh = c(5, 5), + cCh = c(NA, NA), + deaths = c(0, 0), + location_period_id = c(NA, 200), + primary = c("f", "t"), + phantom = c(FALSE, FALSE), + location = c( + "AFR::BDI::Cankuzo::Cankuzo|Cendajuru", + "AFR::BDI::Cankuzo::Cankuzo|Cendajuru" + ), + observation_collection_id = c("a", "b"), + stringsAsFactors = FALSE + ) + cleaned <- clean_psql_data(original_data = df) + testthat::expect_equal(nrow(cleaned), 1) + testthat::expect_true(all(cleaned$composite_loc)) +}) diff --git a/tests/testthat/test-detect_duplicate_geometries.R b/tests/testthat/test-detect_duplicate_geometries.R new file mode 100644 index 0000000..b47c461 --- /dev/null +++ b/tests/testthat/test-detect_duplicate_geometries.R @@ -0,0 +1,99 @@ +sq <- function(x0, y0, w = 1) { + sf::st_polygon(list(rbind(c(x0, y0), c(x0 + w, y0), c(x0 + w, y0 + w), + c(x0, y0 + w), c(x0, y0)))) +} + +testthat::test_that("distinct geometries are all class 'unique' with dup_n 1", { + testthat::skip_if_not_installed("sf") + + res <- detect_duplicate_geometries( + lp_ids = c("1", "2", "3"), + geoms = sf::st_sfc(sq(0, 0), sq(2, 0), sq(4, 0), crs = 4326), + lp_locations = c("AFR::ZZZ::A", "AFR::ZZZ::B", "AFR::ZZZ::C") + ) + + testthat::expect_equal(res$location_period_id, c("1", "2", "3")) + testthat::expect_equal(res$pop_geom_dup_n, rep(1L, 3L)) + testthat::expect_equal(unique(res$pop_geom_dup_class), "unique") +}) + +testthat::test_that("duplicates spanning >1 admin depth are 'parent_inherited'", { + testthat::skip_if_not_installed("sf") + + res <- detect_duplicate_geometries( + lp_ids = c("parent", "child_a", "child_b"), + geoms = sf::st_sfc(sq(0, 0), sq(0, 0), sq(0, 0), crs = 4326), + lp_locations = c("AFR::GIN::Conakry", + "AFR::GIN::Conakry::Dixinn", + "AFR::GIN::Conakry::Matam") + ) + + testthat::expect_equal(res$pop_geom_dup_n, rep(3L, 3L)) + testthat::expect_equal(unique(res$pop_geom_dup_class), "parent_inherited") +}) + +testthat::test_that("same-depth same-base-name duplicates are 'alias', not 'cross_unit'", { + testthat::skip_if_not_installed("sf") + + # "GN-FR.Fria" and "Fria" name one real place under two conventions. + res <- detect_duplicate_geometries( + lp_ids = c("10", "11"), + geoms = sf::st_sfc(sq(0, 0), sq(0, 0), crs = 4326), + lp_locations = c("AFR::GIN::GN-B::Fria", "AFR::GIN::GN-B::GN-FR.Fria") + ) + + testthat::expect_equal(unique(res$pop_geom_dup_class), "alias") + testthat::expect_equal(res$pop_geom_dup_n, c(2L, 2L)) +}) + +testthat::test_that("same-depth different-name duplicates are 'cross_unit'", { + testthat::skip_if_not_installed("sf") + + res <- detect_duplicate_geometries( + lp_ids = c("20", "21"), + geoms = sf::st_sfc(sq(0, 0), sq(0, 0), crs = 4326), + lp_locations = c("AFR::NGA::Lagos::Shomolu", "AFR::NGA::Nasarawa::Awe") + ) + + testthat::expect_equal(unique(res$pop_geom_dup_class), "cross_unit") +}) + +testthat::test_that("duplicates are 'unknown' when no location names are supplied", { + testthat::skip_if_not_installed("sf") + + res <- detect_duplicate_geometries( + lp_ids = c("1", "2", "3"), + geoms = sf::st_sfc(sq(0, 0), sq(0, 0), sq(5, 5), crs = 4326) + ) + + testthat::expect_equal(res$pop_geom_dup_n, c(2L, 2L, 1L)) + testthat::expect_equal(res$pop_geom_dup_class, c("unknown", "unknown", "unique")) +}) + +testthat::test_that("empty geometries are never duplicates of one another", { + testthat::skip_if_not_installed("sf") + + # Sharing "no footprint" says nothing about sharing a denominator. + res <- detect_duplicate_geometries( + lp_ids = c("e1", "e2", "real"), + geoms = sf::st_sfc(sf::st_polygon(), sf::st_polygon(), sq(0, 0), crs = 4326), + lp_locations = c("AFR::ZZZ::A", "AFR::ZZZ::B", "AFR::ZZZ::C") + ) + + testthat::expect_equal(res$pop_geom_dup_n, rep(1L, 3L)) + testthat::expect_equal(unique(res$pop_geom_dup_class), "unique") +}) + +testthat::test_that("detect_duplicate_geometries accepts an sf object and zero rows", { + testthat::skip_if_not_installed("sf") + + x <- sf::st_sf(location_period_id = c("1", "2"), + geometry = sf::st_sfc(sq(0, 0), sq(0, 0), crs = 4326)) + res <- detect_duplicate_geometries(x$location_period_id, x) + testthat::expect_equal(res$pop_geom_dup_n, c(2L, 2L)) + + empty <- detect_duplicate_geometries(character(0), sf::st_sfc(crs = 4326)) + testthat::expect_equal(nrow(empty), 0L) + testthat::expect_named(empty, c("location_period_id", "pop_geom_dup_n", + "pop_geom_dup_class")) +}) diff --git a/tests/testthat/test-get_country_boundary.R b/tests/testthat/test-get_country_boundary.R new file mode 100644 index 0000000..c11a025 --- /dev/null +++ b/tests/testthat/test-get_country_boundary.R @@ -0,0 +1,97 @@ +testthat::test_that("get_country_boundary returns NULL rather than a union when nothing resolves", { + testthat::skip_if_not_installed("sf") + + # A union of LP geometries is NOT a country boundary: it covers only the + # surveilled sub-areas, so country_raw is understated and adj_factor inflated. + # The contract is that an unresolvable boundary yields NULL ("skip the + # adjustment"), never an approximation. + empty_cache <- withr::local_tempdir() + + testthat::expect_message(res <- get_country_boundary("ZZZ", cache_dir = empty_cache)) + testthat::expect_null(res) +}) + +testthat::test_that("get_country_boundary returns NULL for an unparseable code", { + testthat::expect_message(res <- get_country_boundary("12", cache_dir = NULL), + "could not extract an ISO3 code") + testthat::expect_null(res) +}) + +testthat::test_that("get_country_boundary reads the on-disk cache without fetching", { + testthat::skip_if_not_installed("sf") + + cache <- withr::local_tempdir() + poly <- sf::st_sf( + id = 1L, + geometry = sf::st_sfc( + sf::st_polygon(list(rbind(c(0, 0), c(1, 0), c(1, 1), c(0, 1), c(0, 0)))), + crs = 4326 + ) + ) + sf::st_write(poly, file.path(cache, "ZZZ_adm0.geojson"), quiet = TRUE) + + res <- get_country_boundary("ZZZ", cache_dir = cache) + + testthat::expect_s3_class(res, "sf") + testthat::expect_equal(nrow(res), 1L) + testthat::expect_equal(sf::st_crs(res)$epsg, 4326L) +}) + +testthat::test_that("get_country_boundary tolerates a sub-national suffix", { + testthat::skip_if_not_installed("sf") + + cache <- withr::local_tempdir() + poly <- sf::st_sf( + id = 1L, + geometry = sf::st_sfc( + sf::st_polygon(list(rbind(c(0, 0), c(1, 0), c(1, 1), c(0, 1), c(0, 0)))), + crs = 4326 + ) + ) + sf::st_write(poly, file.path(cache, "TZA_adm0.geojson"), quiet = TRUE) + + res <- get_country_boundary("TZA::Mainland", cache_dir = cache) + testthat::expect_s3_class(res, "sf") +}) + +testthat::test_that("get_country_boundary refetches when the cache file is corrupt", { + testthat::skip_if_not_installed("sf") + + cache <- withr::local_tempdir() + writeLines("not geojson", file.path(cache, "ZZZ_adm0.geojson")) + + testthat::expect_message(res <- get_country_boundary("ZZZ", cache_dir = cache)) + testthat::expect_null(res) # no rgeoboundaries fallback available offline +}) + +testthat::test_that("band_adj_factor accepts the plausible band untouched", { + testthat::expect_equal(band_adj_factor(1.02), list(value = 1.02, flag = "ok")) + testthat::expect_equal(band_adj_factor(0.67)$flag, "ok") + testthat::expect_equal(band_adj_factor(1.5)$flag, "ok") +}) + +testthat::test_that("band_adj_factor accepts-and-flags the wide band", { + testthat::expect_message(wide <- band_adj_factor(1.8), "accepted but flagged") + testthat::expect_equal(wide$value, 1.8) + testthat::expect_equal(wide$flag, "wide") + + testthat::expect_message(low <- band_adj_factor(0.55)) + testthat::expect_equal(low$flag, "wide") +}) + +testthat::test_that("band_adj_factor clamps implausible factors to 1.0", { + # An extreme factor means the raster total was extracted on the wrong polygon, + # not that the country disagrees with WPP. Leave the population unadjusted. + testthat::expect_message(big <- band_adj_factor(12), "clamped to 1.0") + testthat::expect_equal(big$value, 1.0) + testthat::expect_equal(big$flag, "clamped") + + testthat::expect_message(small <- band_adj_factor(0.1)) + testthat::expect_equal(small$value, 1.0) +}) + +testthat::test_that("band_adj_factor clamps non-finite and non-positive factors", { + for (bad in list(NA_real_, NaN, Inf, 0, -1)) { + testthat::expect_equal(band_adj_factor(bad), list(value = 1.0, flag = "clamped")) + } +}) diff --git a/tests/testthat/test-identify_outbreaks.R b/tests/testthat/test-identify_outbreaks.R new file mode 100644 index 0000000..0a301c3 --- /dev/null +++ b/tests/testthat/test-identify_outbreaks.R @@ -0,0 +1,152 @@ +# Tests for the post-detection outbreak size filter (filter_small_outbreaks), +# the internal helper used by identify_outbreaks() when +# filter_outbreaks_by_size = TRUE. + +make_outbreak_df <- function() { + # Two numbered outbreaks plus surrounding non-outbreak (0) weeks. + # outbreak 1: 40 + 50 + 30 = 120 cases (large) + # outbreak 2: 5 + 4 + 3 = 12 cases (small) + data.frame( + location = "TestCountry", + outbreak_number = c(0, 1, 1, 1, 0, 0, 2, 2, 2, 0), + sCh = c(0, 40, 50, 30, 0, 0, 5, 4, 3, 0), + stringsAsFactors = FALSE + ) +} + +test_that("filter_small_outbreaks drops only outbreaks below the threshold", { + df <- make_outbreak_df() + out <- filter_small_outbreaks(df, min_total_cases = 50) + + # Outbreak 1 (120 cases) retained, outbreak 2 (12 cases) zeroed. + expect_equal(out$outbreak_number, c(0, 1, 1, 1, 0, 0, 0, 0, 0, 0)) + # sCh column is untouched. + expect_equal(out$sCh, df$sCh) +}) + +test_that("filter_small_outbreaks keeps all outbreaks when threshold is below both", { + df <- make_outbreak_df() + out <- filter_small_outbreaks(df, min_total_cases = 10) + expect_equal(out$outbreak_number, df$outbreak_number) +}) + +test_that("filter_small_outbreaks drops all outbreaks when threshold exceeds both", { + df <- make_outbreak_df() + out <- filter_small_outbreaks(df, min_total_cases = 1000) + expect_true(all(out$outbreak_number == 0)) +}) + +test_that("filter_small_outbreaks returns all-zero input unchanged", { + df <- data.frame( + location = "TestCountry", + outbreak_number = c(0, 0, 0), + sCh = c(0, 2, 1), + stringsAsFactors = FALSE + ) + out <- filter_small_outbreaks(df, min_total_cases = 50) + expect_equal(out$outbreak_number, df$outbreak_number) +}) + +test_that("filter_small_outbreaks handles NA cases via na.rm", { + df <- data.frame( + location = "TestCountry", + outbreak_number = c(1, 1, 1, 2, 2), + sCh = c(60, NA, 70, 1, NA), # ob1 = 130 (keep), ob2 = 1 (drop) + stringsAsFactors = FALSE + ) + out <- filter_small_outbreaks(df, min_total_cases = 50) + expect_equal(out$outbreak_number, c(1, 1, 1, 0, 0)) +}) + +# --------------------------------------------------------------------------- +# identify_outbreaks(): keep_nonoutbreak_locations +# --------------------------------------------------------------------------- + +# A location with zero cases every week never reaches risk == "high" (which +# requires sCh > 0), so it never gets an epidemic_start. This exercises the +# "no epidemic start found for this location" branch directly. +make_no_outbreak_data <- function(location = "QuietCountry", n_weeks = 10, pop = 1000) { + tl <- as.Date("2014-01-06") + 7L * seq(0L, n_weeks - 1L) + data.frame( + location = location, + TL = tl, + TR = tl + 6L, + sCh = rep(0, n_weeks), + pop = pop, + stringsAsFactors = FALSE + ) +} + +test_that("keep_nonoutbreak_locations = FALSE (default) drops locations with no epidemic start", { + df <- make_no_outbreak_data() + out <- identify_outbreaks( + threshold_type = "mean weekly incidence rate", + original_data = df, + zero_case_assumption = TRUE, + outbreak_start_definition = "consecutive", + min_weeks_above = 2, + window_weeks = 3, + cumulative_windows = 3, + cumulative_case_threshold_ratio = 1.5, + cumulative_trigger_type = "cumulative_case_threshold", + use_cumulative_trigger = FALSE, + cumulative_min_cases = NULL, + nonzero_windows = NULL, + tail_period = 6 + ) + expect_equal(nrow(out[["QuietCountry"]]), 0L) +}) + +test_that("keep_nonoutbreak_locations = TRUE retains the full series as a non-outbreak period", { + df <- make_no_outbreak_data() + out <- identify_outbreaks( + threshold_type = "mean weekly incidence rate", + original_data = df, + zero_case_assumption = TRUE, + outbreak_start_definition = "consecutive", + min_weeks_above = 2, + window_weeks = 3, + cumulative_windows = 3, + cumulative_case_threshold_ratio = 1.5, + cumulative_trigger_type = "cumulative_case_threshold", + use_cumulative_trigger = FALSE, + cumulative_min_cases = NULL, + nonzero_windows = NULL, + tail_period = 6, + keep_nonoutbreak_locations = TRUE + ) + loc_out <- out[["QuietCountry"]] + expect_equal(nrow(loc_out), nrow(df)) + expect_true(all(loc_out$outbreak_number == 0)) + expect_true(all(as.character(loc_out$`Time Period`) == "non-outbreak period")) +}) + +test_that("keep_nonoutbreak_locations = TRUE does not affect a location that does have an outbreak", { + outbreak_df <- data.frame( + location = "OutbreakCountry", + TL = as.Date("2014-01-06") + 7L * seq(0L, 9L), + TR = as.Date("2014-01-06") + 7L * seq(0L, 9L) + 6L, + sCh = c(50, 60, 55, 40, 30, 20, 5, 3, 2, 1), + pop = 1000, + stringsAsFactors = FALSE + ) + args <- list( + threshold_type = "mean weekly incidence rate", + original_data = outbreak_df, + zero_case_assumption = TRUE, + outbreak_start_definition = "consecutive", + min_weeks_above = 2, + window_weeks = 3, + cumulative_windows = 3, + cumulative_case_threshold_ratio = 1.5, + cumulative_trigger_type = "cumulative_case_threshold", + use_cumulative_trigger = FALSE, + cumulative_min_cases = NULL, + nonzero_windows = NULL, + tail_period = 6 + ) + out_default <- do.call(identify_outbreaks, args) + out_keep <- do.call(identify_outbreaks, c(args, list(keep_nonoutbreak_locations = TRUE))) + expect_equal(out_default[["OutbreakCountry"]], out_keep[["OutbreakCountry"]]) + expect_true(any(out_keep[["OutbreakCountry"]]$outbreak_number > 0)) +}) diff --git a/tests/testthat/test-resolve_composite_children.R b/tests/testthat/test-resolve_composite_children.R new file mode 100644 index 0000000..12948bf --- /dev/null +++ b/tests/testthat/test-resolve_composite_children.R @@ -0,0 +1,94 @@ +# Unit tests for resolve_composite_children(). All network access is replaced by +# an injected pull_fn, so these run offline and deterministically. + +# Build a fake API sf response for a single child location. `geom` is one of +# "polygon", "point", or "empty"; `lp` is the location_period_id (or NA). +fake_api_row <- function(lp, geom = "polygon", loc_name = "child") { + g <- switch( + geom, + polygon = sf::st_polygon(list(rbind(c(0, 0), c(1, 0), c(1, 1), c(0, 1), c(0, 0)))), + point = sf::st_point(c(0, 0)), + empty = sf::st_point() + ) + sf::st_sf( + attributes.location_name = loc_name, + attributes.location_period_id = lp, + geometry = sf::st_sfc(g, crs = 4326L) + ) +} + +test_that("resolve_composite_children returns child LP + polygon geometry", { + empty_resp <- sf::st_sf(attributes.location_name = character(0), + attributes.location_period_id = character(0), + geometry = sf::st_sfc(crs = 4326L)) + # pull_fn keyed on the requested location string. + pull_fn <- function(username, api_key, locations, time_left, time_right) { + if (grepl("Mbane", locations)) { + return(fake_api_row("111", "polygon", "AFR::SEN::Saint-Louis::Dagana::Mbane")) + } + if (grepl("Ross-Bethio", locations)) { + return(fake_api_row("222", "polygon", "AFR::SEN::Saint-Louis::Dagana::Ross-Bethio")) + } + empty_resp + } + + res <- resolve_composite_children( + composite_names = "AFR::SEN::Saint-Louis::Dagana::Mbane|Ross-Bethio", + pull_fn = pull_fn, api_user = "x", api_key = "y" + ) + testthat::expect_s3_class(res, "sf") + testthat::expect_equal(nrow(res), 2L) + testthat::expect_setequal(res$location_period_id, c("111", "222")) + testthat::expect_true(all(sf::st_dimension(sf::st_geometry(res)) == 2L)) +}) + +test_that("resolve_composite_children drops NA-LP and non-polygon rows", { + pull_fn <- function(username, api_key, locations, time_left, time_right) { + if (grepl("::a$", locations)) return(fake_api_row(NA, "polygon")) # no LP -> drop + if (grepl("::b$", locations)) return(fake_api_row("9", "point")) # point -> drop + sf::st_sf(attributes.location_name = character(0), + attributes.location_period_id = character(0), + geometry = sf::st_sfc(crs = 4326L)) + } + res <- resolve_composite_children("AFR::X::Y::a|b", pull_fn = pull_fn, + api_user = "x", api_key = "y") + testthat::expect_s3_class(res, "sf") + testthat::expect_equal(nrow(res), 0L) +}) + +test_that("resolve_composite_children returns 0-row sf when no composites", { + never_called <- function(...) stop("pull_fn should not be called") + res <- resolve_composite_children(c("AFR::X::atomic", NA_character_), + pull_fn = never_called) + testthat::expect_s3_class(res, "sf") + testthat::expect_equal(nrow(res), 0L) +}) + +test_that("resolve_composite_children survives a failing child pull", { + pull_fn <- function(username, api_key, locations, time_left, time_right) { + if (grepl("::good$", locations)) return(fake_api_row("42", "polygon")) + stop("API 500") + } + res <- resolve_composite_children("AFR::X::Y::good|bad", pull_fn = pull_fn, + api_user = "x", api_key = "y") + testthat::expect_equal(nrow(res), 1L) + testthat::expect_equal(res$location_period_id, "42") +}) + +test_that("resolve_composite_children caches raw pulls per child", { + tmp <- tempfile("childcache"); dir.create(tmp) + calls <- 0L + pull_fn <- function(username, api_key, locations, time_left, time_right) { + calls <<- calls + 1L + fake_api_row("7", "polygon") + } + comp <- "AFR::X::Y::solo|other" + r1 <- resolve_composite_children(comp, pull_fn = pull_fn, cache_dir = tmp, + api_user = "x", api_key = "y") + calls_after_first <- calls + r2 <- resolve_composite_children(comp, pull_fn = pull_fn, cache_dir = tmp, + api_user = "x", api_key = "y") + testthat::expect_equal(calls, calls_after_first) # no new API calls + testthat::expect_equal(nrow(r1), nrow(r2)) + testthat::expect_gt(length(list.files(tmp, pattern = "^raw_api_cache_child_")), 0L) +}) diff --git a/tests/testthat/test-validate_population.R b/tests/testthat/test-validate_population.R new file mode 100644 index 0000000..5cd62e6 --- /dev/null +++ b/tests/testthat/test-validate_population.R @@ -0,0 +1,180 @@ +gate_row <- function(qc, g) qc[as.character(qc$gate) == as.character(g), , drop = FALSE] + +clean_lp <- function() { + data.frame( + location_period_id = as.character(1:4), + location = c("AFR::ZZZ::A", "AFR::ZZZ::B", "AFR::ZZZ::C", "AFR::ZZZ::D"), + pop = c(1000, 2000, 3000, 4000), + pop_source = rep("worldpop_constrained", 4L), + pop_geom_dup_n = rep(1L, 4L), + pop_geom_dup_class = rep("unique", 4L), + adj_factor = rep(1.02, 4L), + pop_natl_ref = rep(10000, 4L), + stringsAsFactors = FALSE + ) +} + +testthat::test_that("validate_population passes every enforced gate on clean input", { + testthat::expect_silent(qc <- validate_population(clean_lp(), "ZZZ")) + + enforced <- qc[!qc$record_only, , drop = FALSE] + testthat::expect_true(all(enforced$passed)) + testthat::expect_true(all(is.na(enforced$detail))) + # Gates 1, 2, 3, 4, 5a, 5b, 6 are enforced; 7 and 8 are record-only. + testthat::expect_setequal(as.character(enforced$gate), + c("1", "2", "3", "4", "5a", "5b", "6")) +}) + +testthat::test_that("validate_population requires location_period_id and pop", { + testthat::expect_error( + validate_population(data.frame(location_period_id = "1"), "ZZZ"), + "location_period_id and pop" + ) +}) + +testthat::test_that("gate 1 fires on missing or non-finite pop", { + lp <- clean_lp() + lp$pop[2] <- NA_real_ + lp$pop[3] <- Inf + testthat::expect_warning(qc <- validate_population(lp, "ZZZ"), "gate 1") + + g <- gate_row(qc, 1L) + testthat::expect_false(g$passed) + testthat::expect_equal(g$n_violations, 2L) + testthat::expect_equal(g$n_checked, 4L) +}) + +testthat::test_that("gate 2 fires on a zero denominator", { + lp <- clean_lp() + lp$pop[1] <- 0 + testthat::expect_warning(qc <- validate_population(lp, "ZZZ"), "gate 2") + + testthat::expect_equal(gate_row(qc, 2L)$n_violations, 1L) + testthat::expect_equal(gate_row(qc, 2L)$detail, "1") + # A zero is present, not missing, so gate 1 is unaffected. + testthat::expect_true(gate_row(qc, 1L)$passed) +}) + +testthat::test_that("gate 3 fires outside [0.8, 1.5] and is skipped without adj_factor", { + lp <- clean_lp() + lp$adj_factor[4] <- 3.2 + testthat::expect_warning(qc <- validate_population(lp, "ZZZ"), "gate 3") + testthat::expect_equal(gate_row(qc, 3L)$n_violations, 1L) + + lp2 <- clean_lp() + lp2$adj_factor <- NULL + qc2 <- validate_population(lp2, "ZZZ") + testthat::expect_equal(nrow(gate_row(qc2, 3L)), 0L) +}) + +testthat::test_that("gates 4, 5a and 5b split the duplicate-geometry classes", { + lp <- clean_lp() + lp$pop_geom_dup_n <- c(2L, 2L, 3L, 1L) + lp$pop_geom_dup_class <- c("alias", "alias", "parent_inherited", "unique") + testthat::expect_warning(qc <- validate_population(lp, "ZZZ")) + + testthat::expect_equal(gate_row(qc, 4L)$n_violations, 3L) # broad net + testthat::expect_equal(gate_row(qc, "5a")$n_violations, 1L) # parent inheritance + testthat::expect_equal(gate_row(qc, "5b")$n_violations, 0L) # no cross-unit here + testthat::expect_true(gate_row(qc, "5b")$passed) +}) + +testthat::test_that("gate 5b catches same-depth cross-unit collisions that 5a misses", { + lp <- clean_lp() + lp$pop_geom_dup_n <- c(2L, 2L, 1L, 1L) + lp$pop_geom_dup_class <- c("cross_unit", "cross_unit", "unique", "unique") + testthat::expect_warning(qc <- validate_population(lp, "ZZZ"), "gate 5b") + + testthat::expect_equal(gate_row(qc, "5a")$n_violations, 0L) + testthat::expect_equal(gate_row(qc, "5b")$n_violations, 2L) +}) + +testthat::test_that("gate 6 fires when an LP exceeds the national total", { + lp <- clean_lp() + lp$pop[4] <- 50000 + testthat::expect_warning(qc <- validate_population(lp, "ZZZ", wpp_total = 10000), + "gate 6") + testthat::expect_equal(gate_row(qc, 6L)$n_violations, 1L) + testthat::expect_match(gate_row(qc, 6L)$description, "10,000") +}) + +testthat::test_that("gate 6 falls back to the median pop_natl_ref when wpp_total is NULL", { + lp <- clean_lp() + lp$pop[4] <- 50000 + testthat::expect_warning(qc <- validate_population(lp, "ZZZ"), "gate 6") + testthat::expect_equal(gate_row(qc, 6L)$n_violations, 1L) +}) + +testthat::test_that("gate 6 compares each LP to its own pop_natl_ref, not a corpus-wide median", { + # Regression test for the BDI smoke-test finding: a country's national + # total grows over a multi-year extraction window, so an LP assigned a + # later year (higher pop_natl_ref) must not be flagged against an earlier + # year's median just because other LPs in the same country were assigned + # earlier years. Three LPs simulate three assignment years with growing + # national totals; the fourth LP's pop is deliberately just below its OWN + # year's reference but above the median of the other three -- the old + # median-based gate 6 would have false-positived on it. + lp <- clean_lp() + lp$pop_natl_ref <- c(10000, 11000, 12000, 12600) + lp$pop <- c(1000, 2000, 3000, 12400) # LP 4: below its own ref (12600)... + # ...but above median(pop_natl_ref) = 11500, which the old implementation + # used as a single scalar for every row. + testthat::expect_silent(qc <- validate_population(lp, "ZZZ")) + + g6 <- gate_row(qc, 6L) + testthat::expect_true(g6$passed) + testthat::expect_equal(g6$n_violations, 0L) + testthat::expect_match(g6$description, "own year-specific") +}) + +testthat::test_that("gate 6 still fires when an LP exceeds its OWN pop_natl_ref", { + lp <- clean_lp() + lp$pop_natl_ref <- c(10000, 11000, 12000, 12600) + lp$pop <- c(1000, 2000, 3000, 13000) # LP 4: above its own ref (12600) + testthat::expect_warning(qc <- validate_population(lp, "ZZZ"), "gate 6") + + g6 <- gate_row(qc, 6L) + testthat::expect_false(g6$passed) + testthat::expect_equal(g6$n_violations, 1L) + testthat::expect_equal(g6$detail, "4") +}) + +testthat::test_that("gates 7 and 8 are record-only and never fail the run", { + lp <- clean_lp() # sum = 10000 vs national 10000 -> ratio 1.0 + lp$pop <- c(10, 10, 10, 10) + lp$pop_source <- c("worldpop_constrained", "none", "parent_fallback", "child_sum") + + qc <- validate_population(lp, "ZZZ", wpp_total = 1e6) + + g7 <- gate_row(qc, "7") + testthat::expect_true(g7$record_only) + testthat::expect_true(g7$passed) + testthat::expect_equal(g7$n_violations, 1L) # ratio far below 0.7, recorded only + testthat::expect_match(g7$detail, "ratio=") + + g8 <- gate_row(qc, "8") + testthat::expect_true(g8$record_only) + testthat::expect_equal(g8$n_violations, 1L) # one parent_fallback + testthat::expect_match(g8$detail, "worldpop_constrained=1") +}) + +testthat::test_that("validate_population counts each LP once even on a weekly frame", { + lp <- clean_lp() + lp$pop[1] <- 0 + weekly <- lp[rep(seq_len(nrow(lp)), each = 52L), , drop = FALSE] + + testthat::expect_warning(qc <- validate_population(weekly, "ZZZ"), "gate 2") + testthat::expect_equal(gate_row(qc, 2L)$n_checked, 4L) + testthat::expect_equal(gate_row(qc, 2L)$n_violations, 1L) +}) + +testthat::test_that("validate_population aborts instead of warning when asked", { + lp <- clean_lp() + lp$pop[1] <- 0 + testthat::expect_error(validate_population(lp, "ZZZ", on_fail = "abort"), "gate 2") +}) + +testthat::test_that("validate_population records the uppercased iso3", { + qc <- validate_population(clean_lp(), "zzz") + testthat::expect_true(all(qc$iso3 == "ZZZ")) +}) diff --git a/tests/testthat/test-verify_outbreak_definitions.R b/tests/testthat/test-verify_outbreak_definitions.R new file mode 100644 index 0000000..491c52e --- /dev/null +++ b/tests/testthat/test-verify_outbreak_definitions.R @@ -0,0 +1,413 @@ +library(dplyr) +library(lubridate) + +# --------------------------------------------------------------------------- +# Helpers +# --------------------------------------------------------------------------- + +# Build a minimal weekly outbreak dataframe with known structure. +# 14 weeks: weeks 1-8 high-risk, 9-10 low-risk tail (in outbreak), 11-14 washout. +# By default, all definition checks should PASS with: +# outbreak_start_definition = "consecutive", min_weeks_above = 2, tail_period = 6 +make_valid_df <- function( + location = "TestCountry", + pop = 1000, + threshold = 0.005, # risk = "high" when sCh/pop >= threshold (sCh >= 5) + sCh_outbreak = c(10, 15, 12, 20, 18, 14, 8, 6, 3, 2), # weeks 1-10 + sCh_washout = c(1, 0, 2, 1) # weeks 11-14 +) { + n_out <- length(sCh_outbreak) + n_wash <- length(sCh_washout) + n <- n_out + n_wash + tl <- as.Date("2014-01-06") + 7L * seq(0L, n - 1L) + + sCh <- c(sCh_outbreak, sCh_washout) + + tibble::tibble( + location = location, + TL = tl, + TR = tl + 6L, + sCh = sCh, + pop = pop, + threshold = threshold, + risk = ifelse(sCh > 0 & sCh / pop >= threshold, "high", "low"), + epidemic_start = c(TRUE, rep(FALSE, n - 1L)), + epidemic_tail = c(rep(FALSE, n_out - 2L), TRUE, FALSE, rep(FALSE, n_wash)), + outbreak_number = c(rep(1L, n_out), rep(0L, n_wash)), + `Time Period` = factor( + ifelse(c(rep(1L, n_out), rep(0L, n_wash)) > 0, + "outbreak period", "non-outbreak period"), + levels = c("outbreak period", "non-outbreak period") + ) + ) +} + +# Shortcut: run verify and filter to one check name +check_status <- function(results, check_name) { + results$status[results$check == check_name] +} + +# --------------------------------------------------------------------------- +# Baseline: all checks pass +# --------------------------------------------------------------------------- + +test_that("all checks pass on a structurally valid dataset (consecutive mode)", { + df <- make_valid_df() + results <- verify_outbreak_definitions( + outbreak_list = df, + outbreak_start_definition = "consecutive", + min_weeks_above = 2L, + tail_period = 6L, + cumulative_min_cases = 10 + ) + + non_info <- results[results$status != "INFO" & results$status != "SKIP", ] + expect_true(all(non_info$status == "PASS"), + info = paste("Unexpected FAIL rows:\n", + paste(non_info[non_info$status == "FAIL", ]$detail, collapse = "\n"))) +}) + +test_that("function accepts a pre-bound dataframe (not a list)", { + df <- make_valid_df() + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_s3_class(results, "tbl_df") + expect_true(nrow(results) > 0) +}) + +test_that("function returns an empty tibble when given no data", { + results <- verify_outbreak_definitions(data.frame()) + expect_s3_class(results, "tbl_df") + expect_equal(nrow(results), 0L) +}) + +test_that("result tibble has expected columns", { + df <- make_valid_df() + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_true(all(c("location", "outbreak_number", "check", "status", "value", "detail") + %in% names(results))) +}) + +# --------------------------------------------------------------------------- +# CHECK 1 — risk_classification_consistency +# --------------------------------------------------------------------------- + +test_that("risk_classification_consistency FAILS when risk label contradicts sCh/pop >= threshold", { + df <- make_valid_df() + df$risk[3] <- "low" # row 3 has sCh=12, sCh/pop=0.012 >= threshold=0.005 → should be "high" + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "risk_classification_consistency"), "FAIL") + expect_equal(results$value[results$check == "risk_classification_consistency"], 1) +}) + +test_that("risk_classification_consistency PASSES when all labels are correct", { + df <- make_valid_df() + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "risk_classification_consistency"), "PASS") +}) + +# --------------------------------------------------------------------------- +# CHECK 2 — no_zero_case_epidemic_start +# --------------------------------------------------------------------------- + +test_that("no_zero_case_epidemic_start FAILS when epidemic start has sCh == 0", { + df <- make_valid_df() + df$sCh[1] <- 0L + df$risk[1] <- "low" # adjust risk to match sCh=0 + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "no_zero_case_epidemic_start"), "FAIL") + expect_equal(results$value[results$check == "no_zero_case_epidemic_start"], 1) +}) + +test_that("no_zero_case_epidemic_start PASSES when epidemic start has sCh > 0", { + df <- make_valid_df() + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "no_zero_case_epidemic_start"), "PASS") +}) + +# --------------------------------------------------------------------------- +# CHECK 3 — epidemic_start_in_outbreak_period +# --------------------------------------------------------------------------- + +test_that("epidemic_start_in_outbreak_period FAILS when start is outside outbreak", { + df <- make_valid_df() + df$outbreak_number[1] <- 0L # epidemic_start=TRUE but outbreak_number=0 + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "epidemic_start_in_outbreak_period"), "FAIL") +}) + +test_that("epidemic_start_in_outbreak_period PASSES when all starts are inside outbreak", { + df <- make_valid_df() + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "epidemic_start_in_outbreak_period"), "PASS") +}) + +# --------------------------------------------------------------------------- +# CHECK 4 — consecutive_start_validity +# --------------------------------------------------------------------------- + +test_that("consecutive_start_validity FAILS when the week after start is low-risk", { + df <- make_valid_df() + # Break week 2 so the start (week 1) is not followed by 2 consecutive high-risk weeks + df$sCh[2] <- 1L + df$risk[2] <- "low" + results <- verify_outbreak_definitions(df, + outbreak_start_definition = "consecutive", + min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "consecutive_start_validity"), "FAIL") +}) + +test_that("consecutive_start_validity PASSES with min_weeks_above consecutive high-risk starts", { + df <- make_valid_df() + results <- verify_outbreak_definitions(df, + outbreak_start_definition = "consecutive", + min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "consecutive_start_validity"), "PASS") +}) + +test_that("consecutive_start_validity PASSES with min_weeks_above = 3", { + df <- make_valid_df() + results <- verify_outbreak_definitions(df, + outbreak_start_definition = "consecutive", + min_weeks_above = 3L, tail_period = 6L) + # Weeks 1-3 are all high-risk + expect_equal(check_status(results, "consecutive_start_validity"), "PASS") +}) + +# --------------------------------------------------------------------------- +# CHECK 5 — dual_window_start_validity (dual_window mode) +# --------------------------------------------------------------------------- + +test_that("dual_window_start_validity PASSES when sliding window trigger is satisfied", { + df <- make_valid_df() + results <- verify_outbreak_definitions(df, + outbreak_start_definition = "dual_window", + min_weeks_above = 2L, + window_weeks = 3L, + use_cumulative_trigger = FALSE, + tail_period = 6L) + # Weeks 1-3: all high → sliding window (3 weeks, min 2 high) satisfied + expect_equal(check_status(results, "dual_window_start_validity"), "PASS") +}) + +test_that("dual_window_start_validity FAILS when neither trigger is satisfied", { + df <- make_valid_df() + # Make all weeks low-risk but keep epidemic_start flag — force a contradiction + df$risk[1:3] <- "low" + df$sCh[1:3] <- 1L + # No cumulative trigger either (sCh too low) + results <- verify_outbreak_definitions(df, + outbreak_start_definition = "dual_window", + min_weeks_above = 2L, + window_weeks = 3L, + use_cumulative_trigger = TRUE, + cumulative_trigger_type = "cumulative_case_threshold", + cumulative_windows = 3L, + cumulative_case_threshold_ratio = 1.5, + tail_period = 6L) + expect_equal(check_status(results, "dual_window_start_validity"), "FAIL") +}) + +test_that("dual_window_start_validity PASSES when only the cumulative trigger is satisfied", { + df <- make_valid_df() + # Make weeks 2-3 low-risk so sliding window fails (only 1 high in 3) + df$risk[2:3] <- "low" + df$sCh[2:3] <- 2L + # But make cumulative cases in weeks 1-3 = 10+2+2 = 14, threshold = 0.005*1000*1.5 = 7.5 → meets it + results <- verify_outbreak_definitions(df, + outbreak_start_definition = "dual_window", + min_weeks_above = 2L, + window_weeks = 3L, + use_cumulative_trigger = TRUE, + cumulative_trigger_type = "cumulative_case_threshold", + cumulative_windows = 3L, + cumulative_case_threshold_ratio = 1.5, + tail_period = 6L) + expect_equal(check_status(results, "dual_window_start_validity"), "PASS") +}) + +# --------------------------------------------------------------------------- +# CHECK 6 — epidemic_tail_validity +# --------------------------------------------------------------------------- + +test_that("epidemic_tail_validity PASSES when tail rows are followed by tail_period low-risk weeks", { + df <- make_valid_df() + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "epidemic_tail_validity"), "PASS") +}) + +test_that("epidemic_tail_validity FAILS when a tail row is followed by a high-risk week", { + df <- make_valid_df() + # epidemic_tail is TRUE at row 9; make row 10 high-risk (violates the 6-week low-risk run) + df$sCh[10] <- 50L + df$risk[10] <- "high" + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "epidemic_tail_validity"), "FAIL") +}) + +# --------------------------------------------------------------------------- +# CHECK 7 — min_high_risk_weeks_per_outbreak +# --------------------------------------------------------------------------- + +test_that("min_high_risk_weeks_per_outbreak FAILS when outbreak has too few high-risk weeks", { + df <- make_valid_df() + # Keep only 1 high-risk week in the outbreak (< min_weeks_above = 2) + df$risk[2:8] <- "low" + df$sCh[2:8] <- 1L + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "min_high_risk_weeks_per_outbreak"), "FAIL") + expect_equal(results$value[results$check == "min_high_risk_weeks_per_outbreak"], 1) +}) + +test_that("min_high_risk_weeks_per_outbreak PASSES when outbreak has enough high-risk weeks", { + df <- make_valid_df() + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "min_high_risk_weeks_per_outbreak"), "PASS") +}) + +# --------------------------------------------------------------------------- +# CHECK 8 — cumulative_cases_at_start +# --------------------------------------------------------------------------- + +test_that("cumulative_cases_at_start PASSES when first cumulative_windows weeks >= cumulative_min_cases", { + df <- make_valid_df() # first 3 weeks: 10+15+12 = 37 >= 30 + results <- verify_outbreak_definitions(df, + min_weeks_above = 2L, + tail_period = 6L, + cumulative_min_cases = 30, + cumulative_windows = 3L) + expect_equal(check_status(results, "cumulative_cases_at_start"), "PASS") + expect_equal(results$value[results$check == "cumulative_cases_at_start"], 37) +}) + +test_that("cumulative_cases_at_start FAILS when first weeks sum below cumulative_min_cases", { + df <- make_valid_df() # first 3 weeks: 10+15+12 = 37 < 50 + results <- verify_outbreak_definitions(df, + min_weeks_above = 2L, + tail_period = 6L, + cumulative_min_cases = 50, + cumulative_windows = 3L) + expect_equal(check_status(results, "cumulative_cases_at_start"), "FAIL") +}) + +test_that("cumulative_cases_at_start is absent from results when cumulative_min_cases is NULL", { + df <- make_valid_df() + results <- verify_outbreak_definitions(df, + min_weeks_above = 2L, + tail_period = 6L, + cumulative_min_cases = NULL) + expect_false("cumulative_cases_at_start" %in% results$check) +}) + +# --------------------------------------------------------------------------- +# CHECK 9 — outbreak_weekly_continuity +# --------------------------------------------------------------------------- + +test_that("outbreak_weekly_continuity PASSES when all within-outbreak weeks are 7 days apart", { + df <- make_valid_df() + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "outbreak_weekly_continuity"), "PASS") +}) + +test_that("outbreak_weekly_continuity FAILS when a gap exists within an outbreak", { + df <- make_valid_df() + # Jump week 5 forward by 14 days instead of 7. + # This creates two violations: gap before row 5 (14 d) and after row 5 (0 d). + df$TL[5] <- df$TL[5] + 7L + df$TR[5] <- df$TR[5] + 7L + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "outbreak_weekly_continuity"), "FAIL") + expect_equal(results$value[results$check == "outbreak_weekly_continuity"], 2) +}) + +# --------------------------------------------------------------------------- +# CHECK 10 — tail_period_after_outbreak +# --------------------------------------------------------------------------- + +test_that("tail_period_after_outbreak PASS when enough low-risk non-outbreak weeks follow", { + df <- make_valid_df() + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "tail_period_after_outbreak"), "PASS") +}) + +test_that("tail_period_after_outbreak is SKIP when no data follows the outbreak", { + df <- make_valid_df() + # Remove washout rows so outbreak is the last observation + df <- df[df$outbreak_number > 0, ] + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "tail_period_after_outbreak"), "SKIP") +}) + +test_that("tail_period_after_outbreak FAILS when week immediately after outbreak is high-risk", { + df <- make_valid_df() + # Make the first non-outbreak week high-risk (week 11 → sCh=50) + df$sCh[11] <- 50L + df$risk[11] <- "high" + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_equal(check_status(results, "tail_period_after_outbreak"), "FAIL") + expect_equal(results$value[results$check == "tail_period_after_outbreak"], 0) +}) + +# --------------------------------------------------------------------------- +# CHECK 12 — inter_outbreak_gap_weeks +# --------------------------------------------------------------------------- + +test_that("inter_outbreak_gap_weeks PASSES when gap between two outbreaks >= tail_period", { + ob1 <- make_valid_df() + # Place ob2 so that TL[1] of ob2 is 8 weeks + 1 day after max(TR) of ob1's outbreak + ob2 <- make_valid_df() + ob1_end_tr <- max(ob1$TR[ob1$outbreak_number > 0]) + shift <- as.integer(ob1_end_tr - min(ob2$TL)) + 7L * 8L + 1L + ob2$TL <- ob2$TL + shift + ob2$TR <- ob2$TR + shift + ob2$outbreak_number[ob2$outbreak_number > 0] <- 2L + + df <- dplyr::bind_rows(ob1, ob2) %>% dplyr::arrange(TL) + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + gap_rows <- results[results$check == "inter_outbreak_gap_weeks", ] + expect_equal(nrow(gap_rows), 1L) + expect_equal(gap_rows$status, "PASS") +}) + +test_that("inter_outbreak_gap_weeks FAILS when gap between outbreaks < tail_period", { + ob1 <- make_valid_df() + # Place ob2 so that TL[1] of ob2 is 2 weeks + 1 day after max(TR) of ob1's outbreak ( 0]) + shift <- as.integer(ob1_end_tr - min(ob2$TL)) + 7L * 2L + 1L + ob2$TL <- ob2$TL + shift + ob2$TR <- ob2$TR + shift + ob2$outbreak_number[ob2$outbreak_number > 0] <- 2L + + df <- dplyr::bind_rows(ob1, ob2) %>% dplyr::arrange(TL) + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + gap_rows <- results[results$check == "inter_outbreak_gap_weeks", ] + expect_equal(nrow(gap_rows), 1L) + expect_equal(gap_rows$status, "FAIL") +}) + +# --------------------------------------------------------------------------- +# CHECK — outbreak_summary (INFO rows) +# --------------------------------------------------------------------------- + +test_that("outbreak_summary INFO row is present and correct for a single outbreak", { + df <- make_valid_df() + results <- verify_outbreak_definitions(df, + min_weeks_above = 2L, tail_period = 6L, cumulative_min_cases = NULL) + info_row <- results[results$check == "outbreak_summary" & results$status == "INFO", ] + expect_equal(nrow(info_row), 1L) + # Total cases in outbreak (weeks 1-10): 10+15+12+20+18+14+8+6+3+2 = 108 + expect_equal(info_row$value, 108) +}) + +# --------------------------------------------------------------------------- +# Multi-location +# --------------------------------------------------------------------------- + +test_that("function handles multiple locations and returns results for each", { + df1 <- make_valid_df(location = "CountryA") + df2 <- make_valid_df(location = "CountryB") + df <- dplyr::bind_rows(df1, df2) + results <- verify_outbreak_definitions(df, min_weeks_above = 2L, tail_period = 6L) + expect_true("CountryA" %in% results$location) + expect_true("CountryB" %in% results$location) +})