Keep the whole spread-fit ledger out of the data-prep cache key

NEWS.md

@@ -1,5 +1,7 @@
 # fireSense_dataPrepFit (development version)
 
+- Fixed: `.inputObjects` (1-2 h of data preparation per ELF) was redone whenever the SpreadFit ledger changed, e.g. when any ELF's fit landed, because `spreadFitPreRun` was declared as an input and `fireSense_ELFs` puts the whole ledger in the simList before `.inputObjects` runs. It is now an output only. `.inputObjects` never reads it; `Init()` always assigns it (this study area's rows from `CacheGeo`, or `NULL`), and `dataPrepBuild`, `prepIgnitionFitData`, `prepEscapeFitData` and `prepSpreadFitData` key on it through `.useCacheArgs`, so a new fit of this study area still re-runs them and a cached event cannot restore an old row. Results are unchanged; the `.inputObjects` key changes once.
+
 - The strictly-before rule (a fire year uses the latest data year before it) is `fireSenseUtils::dataYearBefore()` and `dataYearElement(before = TRUE)`, shared with the spread objective, which read the tables by "not after" and failed in its first DEoptim generation for fire years equal to a data year; this module's own `vegetationYear()` is gone. Results are unchanged. Floor `fireSenseUtils` raised to 0.2.3.9100 (Depends-on: PredictiveEcology/fireSenseUtils#159).
 - The `fireYears` default is plain `fireSenseUtils::defaultFireYears()`, which now starts in 1986 (before, this module dropped its first year with `[-1L]`). Floor `fireSenseUtils` raised to 0.2.3.9099, the first version whose `defaultFireYears()` starts in 1986 (PredictiveEcology/fireSenseUtils#158). The default fire years do not change; `fireSense_ELFs` shares them.
 

fireSense_dataPrepFit.R

@@ -154,20 +154,26 @@ defineModule(sim, list(
                       fireSenseUtils::assessFuelClasses, fireSenseUtils::dataYearElement,
                       fireSenseUtils::dataYearFor, fireSenseUtils::fuelClassPrep,
                       fireSenseUtils::lccFlammableShare, fireSenseUtils::makeLandcoverDT,
-                      fireSenseUtils::makeTSD))),
+                      fireSenseUtils::makeTSD, spreadFitPreRun = sim$spreadFitPreRun))),
+                         prepIgnitionFitData = list(.cacheExtra = quote(list(spreadFitPreRun = sim$spreadFitPreRun))),
+                         prepEscapeFitData = list(.cacheExtra = quote(list(spreadFitPreRun = sim$spreadFitPreRun))),
                          prepSpreadFitData = list(.cacheExtra = quote(c(list(
                       fireSenseUtils::bufferToArea, fireSenseUtils::chooseDomSecFuelClasses,
                       fireSenseUtils::climateRasterToDataTable, fireSenseUtils::dataYearElement,
                       fireSenseUtils::dataYearFor, fireSenseUtils::emptySpreadCovariates,
                       fireSenseUtils::escapedFires, fireSenseUtils::fireSenseCovariatesCreate, fireSenseUtils::firePixelsByYear,
                       fireSenseUtils::harmonizeFireData, fireSenseUtils::lccFlammableShare,
                       fireSenseUtils::makeMutuallyExclusive, fireSenseUtils::rasterFireBufferDT,
-                      fireSenseUtils::rasterFireSpreadPoints, fireSenseUtils::youngAgeAtYear),
+                      fireSenseUtils::rasterFireSpreadPoints, fireSenseUtils::youngAgeAtYear,
+                      spreadFitPreRun = sim$spreadFitPreRun),
                       fireSenseUtils::harmonizeFireDataDeps())))),
                     NA, NA,
                     paste("Extra `reproducible::Cache()` arguments, by event. A cached event's digest covers",
                           "this module's code but not the package functions it calls, so `dataPrepBuild` and",
-                          "`prepSpreadFitData` pass those in `.cacheExtra`: a changed function then re-runs the event."))
+                          "`prepSpreadFitData` pass those in `.cacheExtra`: a changed function then re-runs the event.",
+                          "Every cached event after `init` also keys on `sim$spreadFitPreRun`, evaluated when the event runs:",
+                          "`Init()` has by then assigned it (this study area's ledger rows, or `NULL`), so a new fit of",
+                          "this study area re-runs the events, while rows of other study areas do not."))
   ),
   inputObjects = bindrows(
     expectsInput("climateVariables", "list", sourceURL = NA,
@@ -241,11 +247,6 @@ defineModule(sim, list(
     expectsInput("spreadFirePolys", "list", sourceURL = NA,
                   "Not needed from the user: `firePolys` in the CRS of `rasterToMatch`, declared as an input",
                   " because a later event modifies it."),
-    expectsInput("spreadFitPreRun", "data.frame", sourceURL = NA,
-                 paste("Ledger rows of previous SpreadFit results, as the output of that name; `Init()` reads them",
-                       "(supplied by `fireSense_ELFs`). Declared as an input so the rows are in the cache keys of",
-                       "this module's cached events: otherwise a cache entry saved before an ELF was refitted",
-                       "restores its old row over the one `Init()` just read.")),
     expectsInput("studyArea", "SpatVector", sourceURL = NA,
                  "Study area for all data. Should be buffered to limit edge effects on fire spread."),
     expectsInput("studyArea_biomassParam", "SpatVector", sourceURL = NA,
@@ -258,7 +259,11 @@ defineModule(sim, list(
     createsOutput("spreadFitPreRun", "data.frame",
                   desc = paste("Ledger rows of previous SpreadFit results that overlap `studyArea`, from `CacheGeo`:",
                                "a geometry column (convert with `sf::st_as_sf`), plus `polygonID` and the columns in",
-                               "`spreadFitAdditionalColNames`. `NULL` if there is no previous fit.")),
+                               "`spreadFitAdditionalColNames`. `NULL` if there is no previous fit. `Init()` always assigns it",
+                               "(`fireSense_ELFs` may have put the whole ledger there before). It is not an input: as one,",
+                               "it would be in the `.inputObjects` cache key and any ELF's new fit would redo the data",
+                               "preparation. The cached events after `init` key on it through `.useCacheArgs`, so a",
+                               "cached event cannot restore an old row over the one `Init()` just read.")),
     createsOutput("studyAreaWithSpreadParams", "sf",
                   desc = "Same as `spreadFitPreRun`; not created if there is no previous fit."),
     createsOutput("sppColorVect", "character",

tests/testthat/test-ledgerNotInInputObjectsKey.R

@@ -0,0 +1,80 @@
+## `spreadFitPreRun` was an expectsInput, so SpaDES.core put it in the `.inputObjects` cache key
+## (simInit(), suppliedElsewhere()) whenever fireSense_ELFs had put the whole ledger in the sim: any
+## ELF's new fit redid this ELF's data preparation. Init() always assigns it (this study area's
+## rows from CacheGeo, or NULL for a held-out fold) before any cached event runs, so it is an output only
+## and the cached events after init key on it through `.useCacheArgs`.
+
+moduleParams <- function() {
+  def <- Filter(function(x) is.call(x) && identical(x[[1]], as.name("defineModule")),
+                parse(testthat::test_path("..", "..", "fireSense_dataPrepFit.R"), keep.source = FALSE))
+  eval(as.list(def[[1]][[3]])[["parameters"]], envir = asNamespace("SpaDES.core"))
+}
+fnDefs <- function() {
+  files <- c(testthat::test_path("..", "..", "fireSense_dataPrepFit.R"),
+             list.files(testthat::test_path("..", "..", "R"), "\\.R$", full.names = TRUE))
+  defs <- Filter(function(d) is.call(d) && as.character(d[[1]]) %in% c("<-", "=") && is.name(d[[2]]) &&
+                   is.call(d[[3]]) && identical(d[[3]][[1]], as.name("function")),
+                 unlist(lapply(files, function(f) as.list(parse(f, keep.source = FALSE))), recursive = FALSE))
+  stats::setNames(lapply(defs, function(d) d[[3]]), vapply(defs, function(d) as.character(d[[2]]), ""))
+}
+cacheExtras <- function() {
+  p <- moduleParams()
+  p$default[[match(".useCacheArgs", p$paramName)]]
+}
+
+test_that("spreadFitPreRun is created by the module but not expected as an input", {
+  md <- SpaDES.core::moduleMetadata(module = moduleName, path = modulePath)
+  expect_false("spreadFitPreRun" %in% md$inputObjects$objectName)
+  expect_true("spreadFitPreRun" %in% md$outputObjects$objectName)
+})
+
+test_that(".inputObjects does not read spreadFitPreRun", {
+  f <- fnDefs()
+  expect_false("spreadFitPreRun" %in% all.names(f[[".inputObjects"]]))
+})
+
+test_that("Init() assigns spreadFitPreRun unconditionally, before the cached events", {
+  txt <- deparse(fnDefs()[["Init"]])
+  expect_true(any(grepl("^\\s*sim\\$spreadFitPreRun <- if \\(isTRUE\\(is.na\\(heldOutFold\\)\\)\\)", txt)))
+})
+
+test_that("every cached event after init keys on the ledger Init read, and only on it", {
+  args <- cacheExtras()
+  events <- c("dataPrepBuild", "prepIgnitionFitData", "prepEscapeFitData", "prepSpreadFitData")
+  expect_true(all(events %in% names(args)))
+  ## the same Init result gives the same key; this ELF's own new row gives another; NULL (held-out fold) another again
+  keyOf <- function(extra, ledger) {
+    sim <- new.env()
+    sim$spreadFitPreRun <- ledger
+    digest::digest(eval(extra, list2env(list(sim = sim), parent = asNamespace("fireSenseUtils"))))
+  }
+  own <- data.frame(polygonID = "5.1.1", objFunVal = 1)
+  ownNew <- data.frame(polygonID = "5.1.1", objFunVal = 2)
+  for (ev in events) {
+    extra <- args[[ev]]$.cacheExtra
+    expect_true(is.call(extra), info = ev)
+    expect_identical(keyOf(extra, own), keyOf(extra, own), info = ev)
+    expect_false(identical(keyOf(extra, own), keyOf(extra, ownNew)), info = ev)
+    expect_false(identical(keyOf(extra, own), keyOf(extra, NULL)), info = ev)
+  }
+})
+
+test_that("a ledger differing only in another ELF's rows gives the same Init result, hence the same key", {
+  skip_if_not_installed("withr")
+  d <- withr::local_tempdir()
+  sq <- function(x0) sf::st_sfc(sf::st_polygon(list(rbind(c(x0, 0), c(x0 + 1e4, 0), c(x0 + 1e4, 1e4),
+                                                          c(x0, 1e4), c(x0, 0)))), crs = 3978)
+  mk <- function(otherValue) {
+    df <- data.frame(polygonID = c("4.1", "4.3"), objFunVal = c(otherValue, 2),
+                     crs = I(rep(sf::st_crs(3978)$wkt, 2)))
+    df$geometry <- c(sq(2e4), sq(4e4))
+    df
+  }
+  value <- 1
+  testthat::local_mocked_bindings(latestSpreadFits = function(...) mk(value), .package = "fireSenseUtils")
+  domain <- sf::st_as_sf(sq(4e4))                            # 4.3
+  first <- suppressMessages(readSpreadFitLedger("latest", "folder", domain, d))
+  value <- 99                                                # ELF 4.1 refitted
+  second <- suppressMessages(readSpreadFitLedger("latest", "folder", domain, d))
+  expect_identical(digest::digest(first), digest::digest(second))
+})

tests/testthat/test-metadata.R

@@ -38,9 +38,7 @@ test_that("inputs are the expected names and classes", {
       spreadFirePoints            = "list",
       spreadFirePolys             = "list",
       spreadFitAdditionalColNames = "character",
-      ## Init reads the ledger rows into it; as an input it is in the cached events' keys, so a cache
-      ## entry saved before the ELF was refitted cannot restore the old row over the new one.
-      spreadFitPreRun             = "data.frame",
+      ## spreadFitPreRun is an output only: as an input it would be in the .inputObjects cache key
       standAgeMaps                = "list",
       studyArea                   = "SpatVector",
       studyArea_biomassParam      = "SpatVector")