diff --git a/NEWS.md b/NEWS.md index 85efce2..02233d4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # fireSense_ignitionPredict (development version) +- Fix: the objective of the fitted models is read with `xgboost::xgb.config()` (falling back to `attr(model, "params")`), not `model$params`, which is `NULL` for xgboost >= 3 boosters, so every prediction run stopped at the ignition step. `xgboost (>= 3.0.0)` is now in `reqdPkgs`. - Breaking: the module now only predicts; it draws nothing and no longer makes `ignitionsAndEscapes`. `fireSense_burn` draws the ignitions and escapes from the new `fireSense_IgAndEscapeDistribution` and `fireSense_IgAndEscapeProbRas`, and places them (`placeIgnitions()`, `coarseToFineMap()` and `fineCoarseTable()` moved there). `flammableRTM` is no longer an input. - `fireSense_IgAndEscapeProbRas` layer `escapeProb` is the expected escapes per pixel and year for every pixel (it was NA where no ignition was drawn), no longer clamped to [0, 1]; `ignitionProb` is the expected ignitions. - New output `fireSense_IgAndEscapeDistribution`, `list(ignition, escape)`, the objective read from the fitted models; stops if it cannot be read or folds or ELFs disagree. diff --git a/fireSense_ignitionPredict.R b/fireSense_ignitionPredict.R index 9eec316..f043479 100644 --- a/fireSense_ignitionPredict.R +++ b/fireSense_ignitionPredict.R @@ -17,7 +17,7 @@ defineModule(sim, list( citation = list("citation.bib"), documentation = list("README.txt", "fireSense_ignitionPredict.Rmd"), reqdPkgs = list( - "data.table", "magrittr", "terra", + "data.table", "magrittr", "terra", "xgboost (>= 3.0.0)", "PredictiveEcology/SpaDES.core@development (>= 3.0.4)", "PredictiveEcology/reproducible@development", "PredictiveEcology/fireSenseUtils@development (>=0.1.0)" @@ -259,6 +259,8 @@ foldMeanPrediction <- function(fit, newdata) { rowMeans(do.call(cbind, preds)) } +isOneString <- function(x) is.character(x) && length(x) == 1L && !is.na(x) + #' The objective the fitted models were fitted with #' #' `fireSense_burn` draws from the predicted means with the distribution this implies, so every fold of @@ -272,10 +274,12 @@ fitObjective <- function(fits, process) { what <- c(ign = "ignition", esc = "escape")[[process]] perELF <- lapply(fits, function(f) { obj <- vapply(foldModels(f[[process]]), function(model) { - o <- tryCatch(model$params$objective, error = function(e) NULL) - if (!is.character(o) || length(o) != 1L || is.na(o)) + o <- tryCatch(xgboost::xgb.config(model)$learner$objective$name, error = function(e) NULL) + if (!isOneString(o)) o <- tryCatch(attr(model, "params")$objective, error = function(e) NULL) + if (!isOneString(o)) stop("fireSense_ignitionPredict: cannot read the objective of a fitted ", what, - " model (`model$params$objective`); fireSense_burn needs it to draw from the predictions") + " model (tried `xgboost::xgb.config(model)$learner$objective$name` and `attr(model, \"params\")$objective`);", + " fireSense_burn needs it to draw from the predictions") o }, "") if (length(unique(obj)) > 1L) diff --git a/tests/testthat/setup-toyIgnition.R b/tests/testthat/setup-toyIgnition.R index a49eaa8..3ed7f4b 100644 --- a/tests/testthat/setup-toyIgnition.R +++ b/tests/testthat/setup-toyIgnition.R @@ -5,8 +5,8 @@ ## data.table, so `dt[i, j]` there is NOT data.table-aware: tables are handled with base ## subsetting and data.table::set() only. ## -## The fitted models are stand-ins of class "toyFold". xgboost is not among the module's -## `reqdPkgs`, so CI does not have it; and a stand-in lets a test see exactly what the +## The fitted models are stand-ins of class "toyFold" (test-xgboost-objective.R uses real boosters). +## A stand-in lets a test see exactly what the ## module hands to predict(). Each "model" is a function of `newdata`; every call is ## logged in `toyLog`. @@ -26,9 +26,9 @@ predict.toyFold <- function(object, newdata, ...) { } registerS3method("predict", "toyFold", predict.toyFold) -## `objective` is what an xgboost model keeps in `$params$objective`; both fitted processes are Poisson counts +## `objective` is what a reloaded xgboost model keeps in `attr(, "params")$objective`; both fitted processes are Poisson counts toyFold <- function(fun, label, objective = "count:poisson") - structure(list(fun = fun, label = label, params = list(objective = objective)), class = "toyFold") + structure(list(fun = fun, label = label), params = list(objective = objective), class = "toyFold") ## calls logged for one model label, in call order toyCalls <- function(label) { diff --git a/tests/testthat/test-multiELF.R b/tests/testthat/test-multiELF.R index 7fd36ed..f88ce1f 100644 --- a/tests/testthat/test-multiELF.R +++ b/tests/testthat/test-multiELF.R @@ -43,10 +43,10 @@ test_that("with several fits, a missing ELF raster or mismatched lists stop with test_that("ELFs fitted with different objectives stop, naming the ELFs and objectives", { o <- multiInputs() - o$fireSense_IgnitionFittedList$B$modelList$model$Fold1$params$objective <- "reg:tweedie" + attr(o$fireSense_IgnitionFittedList$B$modelList$model$Fold1, "params")$objective <- "reg:tweedie" expect_error(toyIgRun(o), "ELFs' ignition models have different objectives: A \\(count:poisson\\), B \\(reg:tweedie\\)") o <- multiInputs() - o$fireSense_EscapeFittedList$A$modelList$model$Fold1$params$objective <- "reg:squarederror" + attr(o$fireSense_EscapeFittedList$A$modelList$model$Fold1, "params")$objective <- "reg:squarederror" expect_error(toyIgRun(o), "ELFs' escape models have different objectives: A \\(reg:squarederror\\), B \\(count:poisson\\)") }) diff --git a/tests/testthat/test-run-values.R b/tests/testthat/test-run-values.R index 8a40922..56eb3df 100644 --- a/tests/testthat/test-run-values.R +++ b/tests/testthat/test-run-values.R @@ -56,23 +56,23 @@ test_that("the distribution is read from the fitted models' objective", { expect_identical(sim$fireSense_IgAndEscapeDistribution, list(ignition = "count:poisson", escape = "count:poisson")) ins <- twoFolds() - ins$fireSense_EscapeFitted$modelList$model$Fold1$params$objective <- "reg:tweedie" + attr(ins$fireSense_EscapeFitted$modelList$model$Fold1, "params")$objective <- "reg:tweedie" expect_identical(toyIgRun(ins)$fireSense_IgAndEscapeDistribution, list(ignition = "count:poisson", escape = "reg:tweedie")) }) test_that("an unreadable objective stops", { ins <- twoFolds() - ins$fireSense_IgnitionFitted$modelList$model$Fold1$params <- NULL + attr(ins$fireSense_IgnitionFitted$modelList$model$Fold1, "params") <- NULL expect_error(toyIgRun(ins), "cannot read the objective of a fitted ignition model") ins <- twoFolds() - ins$fireSense_EscapeFitted$modelList$model$Fold1$params$objective <- NULL + attr(ins$fireSense_EscapeFitted$modelList$model$Fold1, "params")$objective <- NULL expect_error(toyIgRun(ins), "cannot read the objective of a fitted escape model") }) test_that("folds with different objectives stop", { ins <- toyIgInputs(list(byPixel(c(0, 2, 3, 0)), byPixel(c(0, 4, 3, 0))), list(constant(1))) - ins$fireSense_IgnitionFitted$modelList$model$Fold2$params$objective <- "reg:tweedie" + attr(ins$fireSense_IgnitionFitted$modelList$model$Fold2, "params")$objective <- "reg:tweedie" expect_error(toyIgRun(ins), "folds of the ignition model.*different objectives: count:poisson, reg:tweedie") }) diff --git a/tests/testthat/test-xgboost-objective.R b/tests/testthat/test-xgboost-objective.R new file mode 100644 index 0000000..30debe8 --- /dev/null +++ b/tests/testthat/test-xgboost-objective.R @@ -0,0 +1,29 @@ +## Real xgboost boosters, as the ledger stores them: saved and read back, which makes them +## external pointers with no `$params` (xgboost >= 3). +realBooster <- function(objective = "count:poisson", seed = 1) { + set.seed(seed) + x <- matrix(rnorm(200), ncol = 2, dimnames = list(NULL, c("MDC", "youngAge"))) + y <- rpois(100, exp(0.3 * x[, 1])) + b <- xgboost::xgboost(x, y, objective = objective, nrounds = 3, nthreads = 1, + max_depth = 2) + f <- tempfile(fileext = ".rds") + on.exit(unlink(f)) + saveRDS(b, f) + readRDS(f) +} + +ledgerFit <- function(b1, b2) + list(elf = "A", ign = list(modelList = list(model = list(Fold1 = b1, Fold2 = b2), + scaleData = toyScaleData()))) + +test_that("the objective of saved and reloaded xgboost models is read", { + skip_if_not_installed("xgboost") + fits <- list(ledgerFit(realBooster(), realBooster(seed = 2))) + expect_identical(fitObjective(fits, "ign"), "count:poisson") +}) + +test_that("xgboost folds with different objectives stop", { + skip_if_not_installed("xgboost") + fits <- list(ledgerFit(realBooster(), realBooster("reg:squarederror"))) + expect_error(fitObjective(fits, "ign"), "different objectives: count:poisson, reg:squarederror") +})