Build app support files — zone gpkgs, layers registry, metrics raster

Published

2026-07-14 10:48:56

Reproducibly generate the per-version files the Shiny apps (scores, species) load at startup — which the v8 scoring pipeline doesn’t otherwise emit:

1 Design

Figure 1: Per-version Shiny app-support files: zone gpkgs, layer registry, and the cell-metrics raster

2 Setup

Code
librarian::shelf(DBI, dplyr, duckdb, fs, glue, here, jsonlite, logger, readr, sf, terra, quiet = T)
source(here("libs/paths.R"))
dir_v    <- glue("{dir_derived}/{ver}"); dir_create(dir_v)
manifest <- here("data/manifests/build_app_support.json"); dir_create(path_dir(manifest))
stopifnot(all(file_exists(c(sdm_db, cellid_tif))))

3 Zone polygons → version dir

Code
er_src <- glue("{dir_derived}/{ver_prev}/ply_ecoregions_2025.gpkg")
pa_src <- glue("{dir_derived}/{ver_prev}/ply_programareas_2026_{ver_prev}.gpkg")
stopifnot(all(file_exists(c(er_src, pa_src))))
file_copy(er_src, glue("{dir_v}/ply_ecoregions_2025.gpkg"),          overwrite = TRUE)
file_copy(pa_src, glue("{dir_v}/ply_programareas_2026_{ver}.gpkg"),  overwrite = TRUE)
log_info("copied ecoregion + programarea gpkgs to {dir_v}")

4 Layer registry (layers_{ver}.csv)

Code
lyrs <- read_csv(glue("{dir_derived}/{ver_prev}/layers_{ver_prev}.csv"), show_col_types = FALSE) |>
  mutate(
    lyr   = gsub("_other", "_primary_producer", lyr),          # extrisk_other_* -> extrisk_primary_producer_*
    layer = gsub("^other:", "primary producer:", layer))       # relabel
write_csv(lyrs, glue("{dir_v}/layers_{ver}.csv"))
log_info("layers_{ver}.csv: {nrow(lyrs)} layers")

5 Subregion → programarea map (subregion_programareas.csv)

The subregion → programarea map (USA/AK/GA/PA regional groupings) is version-agnostic — copy {ver_prev}‘s. score_zones builds the matching subregion zones (PA unions) so the apps’ “Study area” filter works.

Code
sr_src <- glue("{dir_derived}/{ver_prev}/subregion_programareas.csv")
if (file_exists(sr_src)) {
  file_copy(sr_src, glue("{dir_v}/subregion_programareas.csv"), overwrite = TRUE)
} else {  # fallback: whole-study-area USA -> all PRAs
  con  <- dbConnect(duckdb(sdm_db, read_only = TRUE))
  pras <- dbGetQuery(con, "SELECT DISTINCT val FROM zone WHERE fld='programarea_key' ORDER BY val")$val
  dbDisconnect(con, shutdown = TRUE)
  write_csv(tibble::tibble(subregion_key = "USA", programarea_key = pras), glue("{dir_v}/subregion_programareas.csv"))
}
log_info("subregion_programareas.csv written")

6 Metrics raster (r_metrics_{ver}.tif)

Code
con    <- dbConnect(duckdb(sdm_db, read_only = TRUE))
r_cell <- rast(cellid_tif)                                       # pixel value = cell_id
# crop to the programarea polygons' extent (US study area) so it isn't a full global grid
pa      <- st_read(glue("{dir_v}/ply_programareas_2026_{ver}.gpkg"), quiet = TRUE)
r_cell  <- crop(r_cell, ext(project(vect(pa), r_cell)))
cidx    <- values(r_cell, mat = FALSE)                          # cell_id per pixel (NA on land)
maxid   <- max(cidx, na.rm = TRUE)
mk_lut  <- function(cell_id, v) { lut <- rep(NA_real_, maxid); lut[cell_id] <- v; lut }

# one band per app layer, plus the raw composite key already in lyrs$lyr
lst <- list()
for (k in unique(lyrs$lyr)) {
  d <- dbGetQuery(con, glue("SELECT cm.cell_id, cm.val FROM cell_metric cm
    JOIN metric m USING(metric_seq) WHERE m.metric_key = '{k}'"))
  if (!nrow(d)) { log_warn("no cells for layer {k}"); next }
  r <- setValues(rast(r_cell), mk_lut(d$cell_id, d$val)[cidx]); names(r) <- k
  lst[[k]] <- r
}
# categorical zone keys from zone_cell
for (zf in c("ecoregion_key", "programarea_key")) {
  d    <- dbGetQuery(con, glue("SELECT zc.cell_id, z.val AS key FROM zone_cell zc
    JOIN zone z USING(zone_seq) WHERE z.fld = '{zf}'"))
  lvls <- sort(unique(d$key)); d$id <- match(d$key, lvls)
  r    <- setValues(rast(r_cell), mk_lut(d$cell_id, d$id)[cidx]); names(r) <- zf
  levels(r) <- data.frame(id = seq_along(lvls), key = lvls)
  lst[[zf]] <- r
}
r_metrics <- rast(lst)
if ("primprod" %in% names(r_metrics))
  r_metrics[["primprod_log"]] <- log(r_metrics[["primprod"]])
writeRaster(r_metrics, glue("{dir_v}/r_metrics_{ver}.tif"), overwrite = TRUE,
            gdal = c("COMPRESS=ZSTD", "TILED=YES"))
n_lyr <- nlyr(r_metrics)
dbDisconnect(con, shutdown = TRUE)
log_info("r_metrics_{ver}.tif: {n_lyr} bands")

7 Outputs + manifest

Code
# content fingerprint of the notebook's authoritative output (the metrics raster):
# reduce its non-NA cell values order-independently via DuckDB — deterministic, so no
# wall-clock and no machine paths leak into the tracked manifest.
con <- dbConnect(duckdb())
duckdb::duckdb_register(con, "r_metrics_df", as.data.frame(r_metrics, cells = TRUE, na.rm = TRUE))
h   <- msens::hash_query(con, "r_metrics_df")
dbDisconnect(con, shutdown = TRUE)

smry <- tibble::tibble(output = c("layers", "r_metrics_bands"), n = c(nrow(lyrs), n_lyr))
msens::report_table(smry, caption = "app-support outputs")
app-support outputs
output n
layers 17
r_metrics_bands 20
Code
msens::write_manifest(
  manifest, target = "build_app_support", content_hash = h,
  stats = list(ver = ver, layers = nrow(lyrs), r_metrics_bands = n_lyr),
  force = msens::force_target("build_app_support"))