Remove dead code, document functions, correct Rmd

fireSense_SpreadPredict.Rmd

@@ -45,13 +45,17 @@ download.file(url = "https://img.shields.io/badge/Made%20with-Markdown-1f425f.pn
 
 ### Module summary
 
-Predicts a surface (raster) of fire spread probabilities using a model previously fit with `fireSense_SpreadFit`.
-fireSense [@Marchal:2017a; @Marchal:2017b; @Marchal:2019] <!-- TODO -->
+Each year, predicts a raster of fire spread probabilities from the parameters fitted by *fireSense_SpreadFit*, for the spread component of fireSense [@Marchal:2017a; @Marchal:2017b; @Marchal:2019].
+
+1. The covariates in `fireSense_SpreadCovariates` are rescaled to [0, 1] using `covMinMax_spread`, the range of the fitting data.
+2. For each parameter set (row) in `studyAreaWithSpreadParams$params[[1]]`, the spread probability is a 2- or 3-parameter logistic of the linear combination of the covariates, with lower asymptote `lowerSpreadProb`.
+3. `fireSense_SpreadPredicted` is the mean over parameter sets, on the `flammableRTM` grid.
 
 ### Module inputs and parameters
 
-Describe input data required by the module and how to obtain it (e.g., directly from online sources or supplied by other modules)
-If `sourceURL` is specified, `downloadData("fireSense_SpreadPredict", "..")` may be sufficient.
+Two objects from *fireSense_SpreadFit* are read from the `simList` though they are not declared as inputs: `studyAreaWithSpreadParams` (the fitted parameters) and `fireSense_spreadFormula` (every term must be a column of `fireSense_SpreadCovariates`).
+The module stops if `studyAreaWithSpreadParams` has no parameters.
+`maxFireSpread` must have the same value in every module that defines it.
 
 Table \@ref(tab:moduleInputs-fireSense-SpreadPredict) shows the full list of module inputs.
 
@@ -72,17 +76,12 @@ knitr::kable(df_params, caption = "List of (ref:fireSense-SpreadPredict) paramet
 ```
 
 ### Events
-<!-- TODO -->
-- Module initiation;
-- Make predictions.
-
-### Plotting
-
-Write what is plotted. <!-- TODO -->
 
-### Saving
+- `init`: checks `maxFireSpread` against the other modules; schedules `run` at `.runInitialTime`, and `save` at `.saveInitialTime` if that is not `NA`.
+- `run`: makes the prediction described above; repeats every `.runInterval`.
+- `save`: does nothing, and says so in a message.
 
-There is currently nothing saved, but this may change in the future. <!-- TODO -->
+The module does not plot anything.
 
 ### Module outputs
 
@@ -96,7 +95,8 @@ knitr::kable(df_outputs, caption = "List of (ref:fireSense-SpreadPredict) output
 
 ### Links to other modules
 
-Predictions made with this module can be used with the fire spread component of landscape fire models (e.g., `fireSense`). <!-- TODO -->
+Runs after *fireSense_dataPrepPredict* (covariates) and *fireSense_SpreadFit* (parameters). `fireSense_SpreadPredicted` is used by *fireSense* to spread fires.
+It is normally run as part of the [fireSense](https://github.com/PredictiveEcology/fireSense) module group.
 
 ### Getting help
 

tests/testthat/setup-toySpread.R

@@ -0,0 +1,78 @@
+## This is a setup file, not a helper: helpers are sourced by pkgload::load_all() into an
+## environment that cannot see `moduleName` and `testPaths` from setup.R.
+##
+## Tests run inside the namespace of the package rendition, which does not import
+## data.table, so `dt[i, j]` there is NOT data.table-aware. Tables are therefore edited
+## with data.table::set() and base subsetting only.
+##
+## Toy inputs for the `run` event, small enough that every predicted value can be worked
+## out by hand.
+##
+## flammableRTM is 3 x 3. Cell 5 is non-flammable (0) and cell 9 is NA; neither has a row in
+## the covariate table, as in fireSense_dataPrepPredict. Rows are deliberately NOT in
+## pixelID order.
+##
+## The ranges in `covMinMax_spread` are those of the (imaginary) FITTING data and are wider
+## than the ranges of the prediction covariates: MDC is 50..150 here but 0..200 in the fit.
+toyCovariates <- function() {
+  data.table::data.table(
+    pixelID  = c(7L,  1L, 3L,  2L,  8L,  4L,  6L),
+    MDC      = c(150, 0,  100, 50,  100, 200, 100),
+    youngAge = c(0,   0,  0,   1,   1,   0,   0),
+    fuelA    = c(0,   0,  4,   0,   8,   8,   2)
+  )
+}
+
+toyParams <- function(...) {
+  ## one row per retained DEoptim solution: logistic parameters first, then one
+  ## coefficient per covariate
+  data.frame(maxAsymptote = 0.25, hillSlope1 = 2, inflectionPoint1 = 1,
+             MDC = 1.5, youngAge = -0.5, fuelA = 1, ...)
+}
+
+toyInputs <- function(covs = toyCovariates(), params = toyParams(),
+                      formula = "~ MDC + youngAge + fuelA - 1") {
+  flammableRTM <- terra::rast(nrows = 3, ncols = 3, xmin = 0, xmax = 3, ymin = 0, ymax = 3,
+                              vals = c(1, 1, 1, 1, 0, 1, 1, 1, NA))
+  sa <- data.frame(ID = 1L)
+  sa$params <- list(params)
+  list(flammableRTM = flammableRTM,
+       fireSense_SpreadCovariates = covs,
+       covMinMax_spread = data.table::data.table(MDC = c(0, 200), youngAge = c(0, 1),
+                                                 fuelA = c(0, 8)),
+       fireSense_spreadFormula = formula,
+       studyAreaWithSpreadParams = sa)
+}
+
+toySim <- function(objects = toyInputs(), params = list(), times = list(start = 1, end = 1)) {
+  SpaDES.core::simInit(
+    times = c(times, timeunit = "year"),
+    modules = moduleName,
+    params = stats::setNames(list(params), moduleName),
+    objects = objects,
+    paths = testPaths
+  )
+}
+
+toyRun <- function(...) SpaDES.core::spades(toySim(...), debug = FALSE)
+
+## predicted values, as a plain vector indexed by cell number
+predVals <- function(sim) terra::values(sim$fireSense_SpreadPredicted, mat = FALSE)
+
+## The 3-parameter logistic written out longhand, for the hand calculations below:
+## lower + (upper - lower) / (1 + exp(-slope * x)) ^ shape
+handLogistic3 <- function(x, upper = 0.25, slope = 2, shape = 1, lower = 0.13) {
+  lower + (upper - lower) / (1 + exp(-slope * x))^shape
+}
+
+## set one covariate value for one pixel
+setCov <- function(covs, pixel, col, value) {
+  data.table::set(covs, which(covs$pixelID == pixel), col, value)
+  covs
+}
+
+## rows of completed()/events() for this module and one event type, as a data.frame
+evOf <- function(dt, type) {
+  df <- as.data.frame(dt)
+  df[df$moduleName == "fireSense_SpreadPredict" & df$eventType == type, , drop = FALSE]
+}

tests/testthat/test-events.R

@@ -0,0 +1,69 @@
+## Which events are scheduled, and when.
+
+test_that("run repeats every .runInterval from .runInitialTime, at priority 5.12", {
+  sim <- toyRun(times = list(start = 1, end = 3))
+  done <- evOf(SpaDES.core::completed(sim), "run")
+  expect_equal(done$eventTime, c(1, 2, 3))
+  expect_equal(unique(done$eventPriority), 5.12)
+  ## the next one is queued for year 4
+  nxt <- evOf(SpaDES.core::events(sim), "run")
+  expect_equal(nxt$eventTime, 4)
+  expect_equal(nxt$eventPriority, 5.12)
+  expect_equal(evOf(SpaDES.core::completed(sim), "init")$eventTime, 1)
+})
+
+test_that(".runInitialTime delays the first run; .runInterval sets the step", {
+  sim <- toyRun(params = list(.runInitialTime = 2, .runInterval = 2),
+                times = list(start = 1, end = 5))
+  expect_equal(evOf(SpaDES.core::completed(sim), "run")$eventTime, c(2, 4))
+  expect_equal(evOf(SpaDES.core::events(sim), "run")$eventTime, 6)
+})
+
+test_that(".runInterval = NA predicts once", {
+  sim <- toyRun(params = list(.runInterval = NA_real_), times = list(start = 1, end = 3))
+  expect_equal(evOf(SpaDES.core::completed(sim), "run")$eventTime, 1)
+  expect_identical(nrow(evOf(SpaDES.core::events(sim), "run")), 0L)
+  ## and the one prediction is there
+  expect_equal(predVals(sim)[1], 0.19, tolerance = 1e-7)
+})
+
+test_that("no save event is scheduled when .saveInitialTime is NA (the default)", {
+  sim <- toyRun(times = list(start = 1, end = 2))
+  expect_identical(nrow(evOf(SpaDES.core::completed(sim), "save")), 0L)
+  expect_identical(nrow(evOf(SpaDES.core::events(sim), "save")), 0L)
+})
+
+test_that("the save event says it does nothing, and leaves sim as it was", {
+  ref <- toyRun(times = list(start = 1, end = 2))
+  expect_message(
+    sim <- toyRun(params = list(.saveInitialTime = 1), times = list(start = 1, end = 2)),
+    "the save event does nothing", fixed = TRUE
+  )
+  expect_equal(evOf(SpaDES.core::completed(sim), "save")$eventTime, 1)
+  ## same objects, same prediction, same queue: it is not rescheduled either
+  expect_identical(sort(ls(sim)), sort(ls(ref)))
+  expect_identical(predVals(sim), predVals(ref))
+  expect_identical(as.data.frame(SpaDES.core::events(sim)), as.data.frame(SpaDES.core::events(ref)))
+})
+
+test_that("nothing is predicted before the first run event", {
+  sim <- toyRun(params = list(.runInitialTime = 5), times = list(start = 1, end = 2))
+  expect_null(sim$fireSense_SpreadPredicted)
+  expect_equal(evOf(SpaDES.core::events(sim), "run")$eventTime, 5)
+})
+
+test_that("the prediction follows the covariates from year to year", {
+  sim <- toySim(times = list(start = 1, end = 1))
+  sim <- SpaDES.core::spades(sim, debug = FALSE)
+  expect_equal(predVals(sim)[4], 0.2491969, tolerance = 1e-6)
+  ## next year's covariates: cell 4 becomes young, with no fuel and MDC 0 -> x = -0.5
+  covs <- toyCovariates()
+  for (cn in c("MDC", "fuelA")) setCov(covs, 4L, cn, 0)
+  setCov(covs, 4L, "youngAge", 1)
+  sim$fireSense_SpreadCovariates <- covs
+  SpaDES.core::end(sim) <- 2
+  sim <- SpaDES.core::spades(sim, debug = FALSE)
+  ## 0.13 + 0.12 / (1 + exp(1)) = 0.13 + 0.12 * 0.2689414 = 0.1622730
+  expect_equal(predVals(sim)[4], 0.1622730, tolerance = 1e-6)
+  expect_equal(predVals(sim)[1], 0.19, tolerance = 1e-7)
+})

tests/testthat/test-failures.R

@@ -0,0 +1,35 @@
+## Failure paths of the run event, with the message each one gives.
+
+test_that("a formula term that is not a covariate column stops, naming the term", {
+  ins <- toyInputs(formula = "~ MDC + youngAge + fuelA + fuelZ - 1")
+  expect_error(toyRun(ins), "'fuelZ' not found in data objects")
+})
+
+test_that("several missing terms are counted in the message", {
+  ins <- toyInputs(formula = "~ MDC + fuelY + fuelZ + fuelW - 1")
+  expect_error(toyRun(ins), "'fuelY' \\(and 2 others\\) not found in data objects")
+  ins <- toyInputs(formula = "~ MDC + fuelY + fuelZ - 1")
+  expect_error(toyRun(ins), "'fuelY' \\(and 1 other\\) not found in data objects")
+})
+
+test_that("a response on the left of the formula is ignored", {
+  ins <- toyInputs(formula = "fires ~ MDC + youngAge + fuelA - 1")
+  expect_equal(predVals(toyRun(ins))[1], 0.19, tolerance = 1e-7)
+})
+
+test_that("no fitted parameters stops with an explanation that names the run", {
+  ins <- toyInputs()
+  ins$studyAreaWithSpreadParams <- NULL
+  expect_error(toyRun(ins), "holds no fitted spread parameters for this run \\(unknown\\)")
+
+  ins <- toyInputs()
+  ins$studyAreaWithSpreadParams$params <- list(toyParams()[0, ])
+  ins$.runName <- "toyRunName"
+  expect_error(toyRun(ins), "holds no fitted spread parameters for this run \\(toyRunName\\)")
+})
+
+test_that("a missing spread formula stops", {
+  ins <- toyInputs()
+  ins$fireSense_spreadFormula <- NULL
+  expect_error(toyRun(ins), "argument is not a valid model")
+})

tests/testthat/test-metadata.R

@@ -19,7 +19,6 @@ test_that("inputs are the expected names and classes", {
     inputs[order(names(inputs))],
     c(covMinMax_spread           = "data.table",
       fireSense_SpreadCovariates = "data.table",
-      fireSense_SpreadFitted     = "fireSense_SpreadFit",
       flammableRTM               = "SpatRaster")
   )
 })
@@ -33,12 +32,31 @@ test_that("outputs are the expected names and classes", {
   )
 })
 
-test_that("parameters are the expected names", {
+## deparsed defaults, so that a changed default fails as loudly as a renamed parameter
+paramTable <- function(md) {
+  p <- md$parameters
+  out <- data.frame(
+    class = as.character(unlist(p$paramClass)),
+    default = vapply(p$default, function(d) paste(deparse(as.vector(d)), collapse = ""), ""),
+    row.names = p$paramName
+  )
+  out[order(rownames(out), method = "radix"), ] # C order, whatever the locale
+}
+
+test_that("parameters have the expected names, classes and defaults", {
   md <- SpaDES.core::moduleMetadata(module = moduleName, path = modulePath)
-  expect_identical(
-    sort(md$parameters$paramName),
-    sort(c(".runInitialTime", ".runInterval", ".saveInitialTime", ".saveInterval",
-           ".useCache", "coefToUse", "lowerSpreadProb", "maxFireSpread",
-           "mutuallyExclusiveCols"))
+  expected <- data.frame(
+    class   = c("numeric", "numeric", "numeric", "logical", "numeric", "numeric"),
+    ## .runInitialTime defaults to start(sim), which is 0 when only metadata is parsed
+    default = c("0", "1", "NA", "FALSE", "0.13", "0.28"),
+    row.names = c(".runInitialTime", ".runInterval", ".saveInitialTime", ".useCache",
+                  "lowerSpreadProb", "maxFireSpread")
   )
+  expect_identical(paramTable(md), expected)
+})
+
+test_that("fireSenseUtils is a declared dependency, so CI installs it", {
+  md <- SpaDES.core::moduleMetadata(module = moduleName, path = modulePath)
+  expect_true(any(grepl("^PredictiveEcology/fireSenseUtils@development", unlist(md$reqdPkgs))))
+  expect_identical(md$timeunit, "year")
 })