diff --git a/NEWS.md b/NEWS.md index 8c1a926..c65a845 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,11 @@ # fireSense_dataPrepFit (development version) +- `prepare_SpreadFit()` built the spread formula's RHS as `climate + youngAgeTxt + vegCols`, but `vegCols` + (derived from `fireSenseVegData`) already includes a `youngAge` column whenever + `fireSenseUtils::fireSenseCovariatesCreate()` finds young forest or non-forest pixels. The formula then + listed `youngAge` twice; `terms()` silently drops the duplicate, leaving one fewer distinct term than the + covariates actually used downstream. `youngAgeTxt` and the spread climate variable are now excluded from + `vegCols` before building the RHS. Version 1.2.0.9013. - `prepare_SpreadFitFire_Vector()` filtered `spreadFirePolys` by pixel size only, while `spreadFirePoints` was filtered with `escapedFires()` (pixel size and `escapeSizeHa`, PR #44). A fire between one pixel and `escapeSizeHa` then survived in the polygons but not the points, and `fireSenseUtils::harmonizeFireData()` diff --git a/fireSense_dataPrepFit.R b/fireSense_dataPrepFit.R index b7b9edf..8ec0283 100644 --- a/fireSense_dataPrepFit.R +++ b/fireSense_dataPrepFit.R @@ -8,7 +8,7 @@ defineModule(sim, list( person(c("Alex", "M"), "Chubaty", role = "ctb", email = "achubaty@for-cast.ca") ), childModules = character(0), - version = list(fireSense_dataPrepFit = "1.2.0.9012"), + version = list(fireSense_dataPrepFit = "1.2.0.9013"), timeframe = as.POSIXlt(c(NA, NA)), timeunit = "year", citation = list("citation.bib"), @@ -771,8 +771,13 @@ prepare_SpreadFit <- function(sim) { round(sim$spreadClimateSelection$auc, 2), collapse = ", ")) } + ## vegCols can already contain "youngAge" (added by fireSenseUtils::fireSenseCovariatesCreate() + ## when there are young non-forest/forest pixels) and, in principle, the spread climate variable + ## name; both are also added explicitly below, so they must be excluded here or the formula lists + ## them twice and terms() silently drops the duplicate, leaving one fewer term than parameters. + vegColsForRHS <- setdiff(vegCols, c(youngAgeTxt, sim$climateVariablesForFire$spread)) RHS <- paste(paste0(sim$climateVariablesForFire$spread, collapse = " + "), youngAgeTxt, - paste0(vegCols, collapse = " + "), sep = " + ") + paste0(vegColsForRHS, collapse = " + "), sep = " + ") ## this is a funny way to get years but avoids years with 0 fires allYears <- unname(unlist(mod$allYears)) diff --git a/tests/testthat/test-spreadFormulaYoungAgeOnce.R b/tests/testthat/test-spreadFormulaYoungAgeOnce.R new file mode 100644 index 0000000..b831f02 --- /dev/null +++ b/tests/testthat/test-spreadFormulaYoungAgeOnce.R @@ -0,0 +1,39 @@ +## fireSense_dataPrepFit.R ~774 (prepare_SpreadFit()): the spread formula's RHS was built as +## `climate + youngAgeTxt + vegCols`, but vegCols already includes a "youngAge" column whenever +## fireSenseUtils::fireSenseCovariatesCreate() finds young forest/non-forest pixels (real cache +## entries for ELFs 14.3 and 14.4, 2026-09-27). R's terms() silently drops the duplicate, so the +## resulting formula has one fewer distinct term than the raw covariate list that downstream code +## (the fitted parameter bounds) is built from. + +test_that("the spread formula lists a veg-table youngAge column once, not twice", { + body <- body(prepare_SpreadFit) + stmts <- as.list(body)[-1] + txt <- vapply(stmts, function(s) paste(deparse(s), collapse = " "), character(1)) + + ## pull just the statements that build vegCols and the formula's RHS out of prepare_SpreadFit, + ## in their original order, and eval them against a small fabricated fireSenseVegData -- the + ## rest of that function (fire buffering, climate rasters, ...) is irrelevant to this defect + patterns <- c("^nonVegColnames <-", "^vegCols <- setdiff", "^dropCols <-", + "^if \\(length\\(dropCols\\)", "^vegColsForRHS <-", "^RHS <-", + "^if \\(is\\.null\\(sim\\$fireSense_spreadFormula\\)\\)") + idx <- sort(unique(unlist(lapply(patterns, grep, x = txt)))) + expect_true(length(idx) >= 5) # sanity: these statements are still present in prepare_SpreadFit + + env <- new.env(parent = environment(prepare_SpreadFit)) + env$sim <- new.env() + env$sim$climateVariablesForFire <- list(spread = "CMD") + env$sim$fireSense_spreadFormula <- NULL + ## the shape fireSenseVegData has after joinFireBuffersToVeg() and setnames(..., "buffer", + ## "burned"): a youngAge column that is not all-zero, as in ELFs 14.3/14.4 + env$fireSenseVegData <- data.table::data.table( + pixelID = 1:10, ids = 1L, burned = rep(0:1, 5), year = 2010L, + fuelA = c(rep(0, 5), rep(1, 5)), youngAge = c(rep(1, 3), rep(0, 7)) + ) + + for (i in idx) eval(stmts[[i]], env) + + rhsTerms <- trimws(strsplit(env$RHS, "\\+")[[1]]) + expect_identical(anyDuplicated(rhsTerms), 0L) + expect_identical(length(rhsTerms), length(env$vegCols) + 1L) # +1 for the climate variable + expect_identical(env$sim$fireSense_spreadFormula, "~ 0 + CMD + youngAge + fuelA") +})