Extension chain

DESCRIPTION

@@ -19,7 +19,7 @@ Authors@R: c(person("Gustav", "Delius", email="gustav.delius@york.ac.uk",
                     comment = c(ORCID = "0000-0002-8478-3430")),
              person("Richard", "Southwell", email="richard.southwell@york.ac.uk",
                     role=c("ctb", "cph")))
-Version: 2.5.4.9124
+Version: 2.5.4.9125
 License: GPL-3
 Imports:
     assertthat,
@@ -36,7 +36,8 @@ Imports:
     Rcpp,
     reshape2,
     rlang,
-    lifecycle
+    lifecycle,
+    pak
 LinkingTo: Rcpp
 Depends:
     R (>= 3.5)
@@ -56,6 +57,7 @@ Collate:
     'helpers.R'
     'MizerParams-class.R'
     'MizerSim-class.R'
+    'registerExtensions.R'
     'ArraySpeciesBySize-class.R'
     'ArraySpeciesByTime-class.R'
     'background.R'

NAMESPACE

@@ -134,12 +134,27 @@ S3method(print,summary.ArraySpeciesBySize)
 S3method(print,summary.ArraySpeciesByTime)
 S3method(project,MizerParams)
 S3method(project,MizerSim)
+S3method(projectDiffusion,MizerParams)
+S3method(projectEGrowth,MizerParams)
+S3method(projectERepro,MizerParams)
+S3method(projectEReproAndGrowth,MizerParams)
+S3method(projectEncounter,MizerParams)
+S3method(projectFMort,MizerParams)
+S3method(projectFeedingLevel,MizerParams)
+S3method(projectMort,MizerParams)
+S3method(projectPredMort,MizerParams)
+S3method(projectPredRate,MizerParams)
+S3method(projectRDD,MizerParams)
+S3method(projectRDI,MizerParams)
+S3method(projectRates,MizerParams)
+S3method(projectResourceMort,MizerParams)
 S3method(projectToSteady,MizerParams)
 S3method(project_simple,MizerParams)
 S3method(removeSpecies,MizerParams)
 S3method(renameGear,MizerParams)
 S3method(renameSpecies,MizerParams)
 S3method(saveParams,MizerParams)
+S3method(saveSim,MizerSim)
 S3method(scaleModel,MizerParams)
 S3method(scaleRates,MizerParams)
 S3method(selectivity,MizerParams)
@@ -217,6 +232,8 @@ export(calibrateBiomass)
 export(calibrateNumber)
 export(calibrateYield)
 export(catchability)
+export(clearExtensionChain)
+export(coerceToExtensionClass)
 export(compareParams)
 export(completeSpeciesParams)
 export(constantEggRDI)
@@ -283,6 +300,7 @@ export(getRDD)
 export(getRDI)
 export(getRateFunction)
 export(getRates)
+export(getRegisteredExtensions)
 export(getReproductionLevel)
 export(getReproductionProportion)
 export(getRequiredRDD)
@@ -377,10 +395,27 @@ export(plotlyYieldObservedVsModel)
 export(power_law_pred_kernel)
 export(pred_kernel)
 export(project)
+export(projectDiffusion)
+export(projectEGrowth)
+export(projectERepro)
+export(projectEReproAndGrowth)
+export(projectEncounter)
+export(projectFMort)
+export(projectFeedingLevel)
+export(projectMort)
+export(projectPredMort)
+export(projectPredRate)
+export(projectRDD)
+export(projectRDI)
+export(projectRates)
+export(projectResourceMort)
 export(projectToSteady)
 export(project_n)
 export(project_simple)
 export(readParams)
+export(readSim)
+export(registerExtension)
+export(registerExtensions)
 export(removeBackgroundSpecies)
 export(removeComponent)
 export(removeSpecies)
@@ -396,6 +431,7 @@ export(resource_params)
 export(resource_rate)
 export(resource_semichemostat)
 export(saveParams)
+export(saveSim)
 export(scaleModel)
 export(scaleRates)
 export(search_vol)
@@ -464,6 +500,7 @@ importFrom(stats,lm)
 importFrom(stats,mvfft)
 importFrom(stats,pnorm)
 importFrom(stats,runif)
+importFrom(stats,setNames)
 importFrom(utils,data)
 importFrom(utils,globalVariables)
 importFrom(utils,modifyList)

NEWS.md

@@ -1,4 +1,49 @@
-# Development version 2.5.4.9102
+# Development version (will become mizer 3.0.0)
+
+- `setRateFunction()` now works correctly even when an extension package is
+  loaded and S3 dispatch is active. Previously, custom rate functions registered
+  via `setRateFunction()` were silently ignored whenever `usesExtensionDispatch()`
+  returned `TRUE`. The fix resolves which functions to call once before the
+  time-step loop (in `projectRateFunctions()`), so there is no per-step overhead.
+
+- `setResource()` now allows `resource_level = 1`. When balancing would
+  otherwise divide by zero because the resource capacity equals the current
+  resource abundance at positive consumption, the capacity is increased
+  slightly with a warning instead of failing early.
+
+- Bug fix: `getFMort()` on a `MizerSim` object was silently dropping the
+  component names from `n_other` when passing it to the rate function and its
+  dependencies (`getEGrowth()`, `getPredMort()`). This caused failures whenever
+  the rate functions accessed `n_other` by component name (e.g.
+  `n_other[["resource"]]`). The internal implementation has also been
+  refactored to use the same `plyr::aaply` pattern as `getFeedingLevel()` and
+  `getPredMort()`, keeping the three methods consistent.
+
+- Added first-stage infrastructure for composable extension chains:
+  `registerExtensions()`, `getRegisteredExtensions()`, and
+  `coerceToExtensionClass()`. Extension classes are marker classes for S3
+  dispatch, with `MizerSim` deriving its extension chain from
+  `sim@params@extensions`.
+
+- `saveParams()` now serialises extension objects as plain `MizerParams`
+  objects while preserving their extension chain, and `readParams()` restores
+  the appropriate extension class. New `saveSim()` and `readSim()` helpers
+  provide the same lifecycle for `MizerSim` objects.
+
+- Added `projectRates()` and `projectEncounter()` as the first S3 hooks in the
+  extension-chain rate pipeline. Extension-aware projections dispatch through
+  `projectRates()`, while models without extensions keep using the pre-resolved
+  `mizerRates()` pipeline directly.
+
+- Added S3 projection hooks for the remaining standard mizer rate functions.
+  Extension-aware projections now call `projectFeedingLevel()`,
+  `projectEReproAndGrowth()`, `projectERepro()`, `projectEGrowth()`,
+  `projectDiffusion()`, `projectPredRate()`, `projectPredMort()`,
+  `projectFMort()`, `projectMort()`, `projectRDI()` and
+  `projectRDD()` and `projectResourceMort()` directly.
+
+- Extensions that do not provide a marker class now remain metadata-only and do
+  not trigger the S3 projection-rate dispatch path.
 
 - New `scaleRates(params, factor)` function that rescales all rates in a model
   by a given factor. This is equivalent to a time rescaling: it speeds up or
@@ -27,7 +72,7 @@
   applies them via `setColours()` and `setLinetypes()` so added components can
   be styled directly in plots.
 
-- New "Extending mizer" vignette (`vignette("extensions")`) documents when
+- New "Extending mizer" vignette (`vignette("extending-mizer")`) documents when
   to use `setRateFunction()`, `setComponent()`, and `customFunction()`,
   summarises the required signatures and return shapes for custom rate
   functions, and gives worked examples for both a custom encounter function
@@ -161,6 +206,8 @@
 
 - `getMeanMaxWeight()` now correctly applies the species selector to the
   denominator.
+- `upgradeParams()` now preserves `MizerParams` subclasses and their extra
+  slots when upgrading older objects.
 - `plotDataFrame()` now correctly applies custom log-scale x breaks.
 - `get_size_range_array()` no longer gives an error when no size brackets are
   selected.

R/MizerParams-class.R

@@ -278,10 +278,12 @@ validMizerParams <- function(object) {
 #' @slot metadata A list with metadata information. See [setMetadata()].
 #' @slot mizer_version The package version of mizer (as returned by
 #'   `packageVersion("mizer")`) that created or upgraded the model.
-#' @slot extensions A named vector of strings where each name is the name of
-#'    and extension package needed to run the model and each value is a string
-#'    giving the information that the remotes package needs to install the
-#'    correct version of the extension package, see https://remotes.r-lib.org/.
+#' @slot extensions A named vector of strings describing the extension chain
+#'   needed to run the model. The names are extension identifiers and S4 marker
+#'   class names. The order is the S3 dispatch order, from outermost to
+#'   innermost extension. The values are version strings, installation
+#'   specifications, or `NA_character_`. Extension subclasses are marker
+#'   classes only and must not add slots.
 #' @slot time_created A POSIXct date-time object with the creation time.
 #' @slot time_modified A POSIXct date-time object with the last modified time.
 #' @slot w The size grid for the fish part of the spectrum. An increasing
@@ -975,6 +977,7 @@ validParams.MizerParams <- function(params, info_level = 3) {
     if (!all(is.finite(params@intake_max) | is.infinite(params@intake_max))) {
         stop("intake_max must contain finite or infinite numeric values only")
     }
+    params <- coerceToExtensionClass(params)
     validObject(params)
     params
 }

R/MizerSim-class.R

@@ -151,6 +151,9 @@ valid_MizerSim <- function(object) {
 #' with [validSim()].
 #'
 #' @slot params An object of type \linkS4class{MizerParams}.
+#'   If this params object uses extensions, the `MizerSim` object uses the same
+#'   extension chain via `params@extensions`; `MizerSim` has no separate
+#'   extension slot.
 #' @slot n Three-dimensional array (time x species x size) that stores the
 #'   projected community number densities.
 #' @slot n_pp An array (time x size) that stores the projected resource number
@@ -238,7 +241,7 @@ MizerSim <- function(params, t_dimnames = NA, t_max = 100, t_save = 1) {
                n_pp = array_n_pp,
                n_other = list_n_other,
                effort = array_effort)
-    return(sim)
+    coerceToExtensionClass(sim)
 }
 
 #' Validate MizerSim object and upgrade if necessary
@@ -300,6 +303,7 @@ validSim.MizerSim <- function(sim) {
         }
         sim <- truncateSim(sim, end_time = max_t)
     }
+    sim <- coerceToExtensionClass(sim)
     validObject(sim)
     sim
 }

R/customFunction.R

@@ -35,6 +35,8 @@
 #' @param name Name of mizer function to replace
 #' @param fun The custom function to use as replacement
 #' @return No return value, called for side effects
+#' @seealso "Extending mizer":
+#'   \code{vignette("extending-mizer", package = "mizer")}
 #' @export
 #' @examples
 #' \dontrun{

R/diffusion.R

@@ -36,14 +36,27 @@ getDiffusion.MizerParams <- function(params, n = initialN(params),
                                      t = 0,
                                      ...) {
     params <- validParams(params)
-    f <- get(params@rates_funcs$Diffusion)
-    d <- f(params, n = n, n_pp = n_pp, n_other = n_other, t = t,
-           feeding_level = getFeedingLevel(params, n = n, n_pp = n_pp,
-                                           n_other = n_other, t = t), ...)
+    feeding_level <- getFeedingLevel(params, n = n, n_pp = n_pp,
+                                     n_other = n_other, t = t)
+    if (usesExtensionDispatch(params)) {
+        d <- projectDiffusion(params, n = n, n_pp = n_pp, n_other = n_other,
+                              t = t, feeding_level = feeding_level, ...)
+    } else {
+        f <- get(params@rates_funcs$Diffusion)
+        d <- f(params, n = n, n_pp = n_pp, n_other = n_other, t = t,
+               feeding_level = feeding_level, ...)
+    }
     ArraySpeciesBySize(d, value_name = "Diffusion rate",
                        units = "g^2/year", params = params)
 }
 
+#' @name mizerDiffusion
+#' @rdname mizerDiffusion
+#' @export
+projectDiffusion <- function(params, n, n_pp, n_other, t = 0,
+                             feeding_level, ...) {
+    UseMethod("projectDiffusion")
+}
 
 #' Calculate diffusion rate
 #'
@@ -69,8 +82,10 @@ getDiffusion.MizerParams <- function(params, n = initialN(params),
 #' @param ... Unused
 #'
 #' @return A two dimensional array (species x size) holding the diffusion rate.
+#' @rdname mizerDiffusion
 #' @export
-mizerDiffusion <- function(params, n, n_pp, n_other, t, feeding_level, ...) {
+projectDiffusion.MizerParams <- function(params, n, n_pp, n_other, t = 0,
+                                         feeding_level, ...) {
 
     if (missing(feeding_level)) {
         feeding_level <- getFeedingLevel(params, n = n, n_pp = n_pp,
@@ -115,6 +130,10 @@ mizerDiffusion <- function(params, n, n_pp, n_other, t, feeding_level, ...) {
     return(D)
 }
 
+#' @rdname mizerDiffusion
+#' @export
+mizerDiffusion <- projectDiffusion.MizerParams
+
 
 #' Get or set the use_predation_diffusion flag
 #'