Simplify model inspection and retain selectable OSA diagnostics

.Rbuildignore

@@ -10,4 +10,5 @@
 ^_pkgdown\.yml$
 ^docs$
 ^AGENTS\.md$
+^vignettes/articles$
 ^\.git$

DESCRIPTION

@@ -29,16 +29,16 @@ Imports:
     cli,
     htmltools,
     htmlwidgets,
+    knitr,
+    rmarkdown,
+    flexdashboard,
     plotly
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 LazyData: true
 Suggests: 
     pkgload,
-    knitr,
-    rmarkdown,
     jsonlite,
-    flexdashboard,
     testthat (>= 3.0.0),
     withr
 Config/testthat/edition: 3

NAMESPACE

@@ -14,6 +14,7 @@ S3method(update,tam_fit)
 S3method(update,tam_ref)
 S3method(vis_tam,default)
 S3method(vis_tam,tam_retro)
+export(add_osa_residuals)
 export(add_plot_buttons)
 export(ar1)
 export(as_tam_data)
@@ -37,6 +38,12 @@ export(fit_retro)
 export(fit_tam)
 export(for_fleet)
 export(for_survey)
+export(get_f)
+export(get_fbar)
+export(get_m)
+export(get_mbar)
+export(get_recruitment)
+export(get_ssb)
 export(iid)
 export(logistic)
 export(make_par)
@@ -47,6 +54,7 @@ export(plot_age_year)
 export(plot_bubbles)
 export(plot_heatmap)
 export(plot_matrix)
+export(plot_model)
 export(plot_obs_pred)
 export(plot_par)
 export(plot_process_deviations)
@@ -84,10 +92,12 @@ importFrom(Matrix,expand)
 importFrom(Matrix,solve)
 importFrom(cli,cli_abort)
 importFrom(cli,cli_warn)
+importFrom(flexdashboard,flex_dashboard)
 importFrom(furrr,furrr_options)
 importFrom(furrr,future_map)
 importFrom(future,multisession)
 importFrom(future,plan)
+importFrom(knitr,knit_expand)
 importFrom(progressr,progressor)
 importFrom(progressr,with_progress)
 importFrom(stats,aggregate)

NEWS.md

@@ -1,5 +1,32 @@
 # tinyAM 0.1.1.9001
 
+* Add `plot_model()` and a Model structure dashboard page showing biological
+  connections, process switches, formulas, initialization and input predictors.
+  Compare stored specifications with an independent model selector; link
+  components to maintained equations without calculating or changing fits.
+
+* Add Auto / Standardized / OSA controls to public residual plots and dashboards.
+  Auto selects retained OSAs separately for each model and panel, preserving
+  partial gaps and models without OSA calculations. Labels identify the method;
+  changing plot controls never calculates residuals.
+
+* Select any supported OSA algorithm through `method` and retain diagnostics
+  with `add_osa_residuals()`, without refitting. Explicit computation requests
+  refresh catch and survey residuals together; cached extraction stays cheap.
+  Retain method/settings/coverage metadata through tidying and model comparisons.
+
+* Add `get_ssb()`, `get_recruitment()`, `get_fbar()`, `get_mbar()`, `get_f()`
+  and `get_m()` for common population tables, retaining uncertainty, units,
+  projections and comparison labels without calculating diagnostics.
+
+* Print a concise input-validation summary with `check_tam_data()`; internal
+  preparation remains quiet. Install dashboard R dependencies automatically and
+  check for Pandoc before rendering.
+
+* Preserve smooth warm-start functions across equivalent mgcv basis signs and
+  rotations, while rejecting changes to predictor grids or Gaussian penalties.
+  This fixes platform-dependent retrospective warm-start checks.
+
 * Read assessment examples from pinned external SAIO snapshots. Separate
   curated and preliminary translations, dashboards, caches and comparison outputs.
 

R/data.R

@@ -181,7 +181,7 @@
 #' check_tam_data(data)
 #' @export
 as_tam_data <- function(data) {
-  check_tam_data(data)
+  check_tam_data(data, quiet = TRUE)
   class(data) <- unique(c("tam_data", class(data)))
   data
 }
@@ -292,20 +292,26 @@ print.tam_data <- function(x, n = 5, ...) {
 #'   requires nonempty labels on every row. Units never change input values.
 #'   See [as_tam_data()] for units of derived quantities.
 #'
-#' On failure the function aborts with a `cli` error. On success, it returns
-#' `TRUE` (invisibly).
+#' On failure the function aborts with a `cli` error. On success, it prints a
+#' concise summary and returns `TRUE` invisibly. Use `quiet = TRUE` to suppress
+#' the success summary; validation errors are always reported.
 #'
 #' @param data A named list expected to contain data.frames `catch`, `index`,
 #'   `weight`, and `maturity` with the columns described above.
+#' @param quiet Logical. Suppress the success summary? Defaults to `FALSE`.
 #'
 #' @return `TRUE` (invisibly) if validation passes; otherwise aborts.
 #' @examples
 #' data(cod_obs)
-#' check_obs(cod_obs) # returns TRUE (invisibly) if valid
+#' check_tam_data(cod_obs)
+#' check_tam_data(cod_obs, quiet = TRUE)
 #'
 #' @importFrom cli cli_abort cli_warn
 #' @export
-check_tam_data <- function(data) {
+check_tam_data <- function(data, quiet = FALSE) {
+  if (!is.logical(quiet) || length(quiet) != 1L || is.na(quiet)) {
+    cli::cli_abort("{.arg quiet} must be TRUE or FALSE.")
+  }
   obs <- data
   if (!is.list(obs)) {
     cli::cli_abort(c(
@@ -478,6 +484,14 @@ check_tam_data <- function(data) {
   }
 
   .data_units(obs)
+  if (!quiet) {
+    n_fleets <- if ("fleet" %in% names(obs$catch)) length(unique(obs$catch$fleet)) else 1L
+    n_surveys <- length(unique(obs$index$survey))
+    cli::cli_inform(c(
+      "v" = "Input data passed validation.",
+      "i" = "Years {years[1]}-{years[length(years)]}; ages {ages[1]}-{ages[length(ages)]}; fleets: {n_fleets}; surveys: {n_surveys}."
+    ))
+  }
   invisible(TRUE)
 }
 
@@ -513,10 +527,11 @@ check_tam_data <- function(data) {
 #'
 #' A convenience wrapper for [check_tam_data()].
 #' @param obs A named list of tinyAM input tables.
+#' @inheritParams check_tam_data
 #' @inherit check_tam_data details
 #' @return `TRUE` (invisibly) if validation passes; otherwise aborts.
 #' @examples
 #' check_tam_data(cod_obs)
 #' @export
-check_obs <- function(obs) check_tam_data(obs)
+check_obs <- function(obs, quiet = FALSE) check_tam_data(obs, quiet = quiet)
 

R/fit.R

@@ -105,11 +105,14 @@
         start$log_f <- start$log_f[, groups[keep], drop = FALSE]
       }
     }
+    smooth_start <- .smooth_warm_starts(start, source$dat, dat)
+    start <- smooth_start$parameters
     for (component in c("N", "F", "M", "rec", "q")) {
       name <- switch(component, N = "mu_n", F = "log_mu_f", M = "mu_m", rec = "rec_beta",
         q=if (dat$index_settings$q_link == "logit") "logit_q" else "log_q")
       if (is.null(start[[name]])) next
       old <- if (component == "rec") source$dat$rec$matrix else source$dat[[paste0(component, "_modmat")]]
+      if (component %in% c("F", "q")) old <- smooth_start$designs[[component]]
       new <- if (component == "rec") dat$rec$matrix else dat[[paste0(component, "_modmat")]]
       if (!is.matrix(new)) next
       if (component %in% c("F","q")) {
@@ -138,15 +141,6 @@
         cli::cli_inform("{label} mean starts were omitted because the formula basis changed.")
       }
     }
-    for (component in c("q","F")) {
-      field <- if (component == "q") "q_terms" else "F_terms"
-      for (term in Filter(function(x)x$type == "smooth",dat[[field]])) {
-        previous <- source$dat[[field]][[term$id]]
-        if (is.null(previous) || !.smooth_basis_compatible(previous,term)) {
-          start[c(term$parameter,term$sd_parameter)] <- NULL
-        }
-      }
-    }
   }
   if (!is.list(start) || (length(start) && (is.null(names(start)) ||
     anyNA(names(start)) || any(!nzchar(names(start))) || anyDuplicated(names(start))))) {
@@ -222,9 +216,9 @@
 #' @param interval Level in `(0, 1)` to use to generate confidence intervals,
 #'   where applicable; default `0.95.`
 #' @param silent Logical; if `TRUE`, disables tracing information.
-#' @param add_osa_res Logical; add one-step-ahead residuals? Hard wired to
-#'   apply the `"oneStepGaussianOffMode"` method. See [RTMB::oneStepPredict()]
-#'   for details.
+#' @param add_osa_res Logical; add one-step-ahead residuals using
+#'   `"oneStepGaussianOffMode"`? To select another method after fitting and
+#'   retain its results, use [add_osa_residuals()].
 #' @param start_par Optional fitted `tam_fit` or list of starting parameter values, matching the
 #'   structure returned by [make_par()]. Useful for warm starts or retrospective
 #'   runs where parameter estimates from a previous fit are reused to improve

R/getters.R

@@ -0,0 +1,104 @@
+#' Extract common population estimates
+#'
+#' Return a ready-to-plot table of spawning biomass, recruitment or mortality,
+#' without navigating the nested tidy output. These functions select the same
+#' estimates, uncertainty and units used in [tidy_tam()] and the dashboard.
+#'
+#' @param ... One or more fitted `tam_fit` models or `tam_ref` reporting
+#'   references, or one named list of these objects.
+#' @param model_list A named list of models, instead of `...`.
+#' @param interval Confidence level in `(0, 1)`, default `0.95`. Fitted summaries
+#'   are rebuilt when their cached interval differs. Reference uncertainty is
+#'   retained as supplied, because it cannot be recalculated from a reporting
+#'   reference.
+#' @details
+#' `get_ssb()` and `get_recruitment()` return annual estimates. `get_fbar()`
+#' and `get_mbar()` return the model's abundance-weighted means over the ages
+#' chosen by `F_settings$mean_ages` and `M_settings$mean_ages`, respectively.
+#' `get_f()` and `get_m()` return year-by-age surfaces; F is total fishing
+#' mortality, summed over fleets. They do not return process deviations.
+#'
+#' A single fit returns its table without a model column. Multiple fits and
+#' named-list inputs add `model`, using the supplied names. Missing reference
+#' quantities are omitted rather than reconstructed. Explicit reference
+#' `comparison_scales` follow [tidy_tam()]'s conversion rules; otherwise known
+#' incompatible units must be converted before combining models.
+#'
+#' These are lightweight selectors. They never refit models or calculate
+#' observation OSA residuals or joint-sample process diagnostics. Supplied
+#' objects are not modified.
+#'
+#' @return A data frame retaining available keys, `est`, confidence limits,
+#'   `se`, `se_scale`, `unit` and `is_proj`. Available metadata, such as SSB
+#'   timing, is retained. Annual summaries have `year`; surfaces also have `age`.
+#' @examples
+#' \dontrun{
+#' get_ssb(fit)
+#' get_recruitment(fit, interval = 0.8)
+#' get_fbar(Base = fit, Alternative = other_fit)
+#' get_f(model_list = list(Base = fit, Alternative = other_fit))
+#' }
+#' @seealso [tidy_pop()], [tidy_tam()], [plot_trend()], [plot_matrix()]
+#' @name get_population
+NULL
+
+#' @rdname get_population
+#' @export
+get_ssb <- function(..., model_list = NULL, interval = 0.95) {
+  .get_population_quantity("ssb", list(...), as.list(substitute(list(...)))[-1L],
+    model_list, interval)
+}
+
+#' @rdname get_population
+#' @export
+get_recruitment <- function(..., model_list = NULL, interval = 0.95) {
+  .get_population_quantity("recruitment", list(...), as.list(substitute(list(...)))[-1L],
+    model_list, interval)
+}
+
+#' @rdname get_population
+#' @export
+get_fbar <- function(..., model_list = NULL, interval = 0.95) {
+  .get_population_quantity("F_bar", list(...), as.list(substitute(list(...)))[-1L],
+    model_list, interval)
+}
+
+#' @rdname get_population
+#' @export
+get_mbar <- function(..., model_list = NULL, interval = 0.95) {
+  .get_population_quantity("M_bar", list(...), as.list(substitute(list(...)))[-1L],
+    model_list, interval)
+}
+
+#' @rdname get_population
+#' @export
+get_f <- function(..., model_list = NULL, interval = 0.95) {
+  .get_population_quantity("F", list(...), as.list(substitute(list(...)))[-1L],
+    model_list, interval)
+}
+
+#' @rdname get_population
+#' @export
+get_m <- function(..., model_list = NULL, interval = 0.95) {
+  .get_population_quantity("M", list(...), as.list(substitute(list(...)))[-1L],
+    model_list, interval)
+}
+
+.get_population_quantity <- function(quantity, dots, expressions, model_list, interval) {
+  if (!is.numeric(interval) || length(interval) != 1L || !is.finite(interval) ||
+      interval <= 0 || interval >= 1) {
+    cli::cli_abort("{.arg interval} must be one number strictly between zero and one.")
+  }
+  info <- .dots_or_list(dots, expressions, model_list, "model_list")
+  named_list <- length(dots) == 1L && is.list(dots[[1L]]) &&
+    !.is_reporting_fit(dots[[1L]])
+  add_label <- !info$using_dots || named_list || length(info$fits) > 1L
+  populations <- .population_tables(info$fits, interval)
+  selected <- lapply(populations, function(x) x[intersect(names(x), quantity)])
+  tab <- stack_nested(selected, label = if (add_label) "model" else NULL)[[quantity]]
+  if (!is.data.frame(tab)) {
+    cli::cli_abort("The requested quantity {.val {quantity}} is unavailable in the supplied models.")
+  }
+  .unit_label(tab, "")
+  tab
+}