Change approach to reloaded models

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: sdmTMB
 Title: Spatial and Spatiotemporal SPDE-Based GLMMs with 'TMB'
-Version: 0.5.0.9005
+Version: 0.5.0.9006
 Authors@R: c(
     person(c("Sean", "C."), "Anderson", , "sean@seananderson.ca",
            role = c("aut", "cre"),

NEWS.md

@@ -1,5 +1,11 @@
 # sdmTMB (development version)
 
+* Add warning if it's detected that there were problems reloading (e.g., with
+  `readRDS()`) a fitted model. Simultaneously revert the approach to 
+  how reloaded models are reattached. Check that random effects haven't been
+  reverted to zero if you `readRDS()` a fitted model. E.g. 
+  `get_pars(fit)$omega_s` if you have spatial random fields enabled.
+
 * Move `log_ratio_mix` parameter to 2nd phase with starting value of -1 instead
   of 0 to improve convergence.
 

R/fit.R

@@ -1503,6 +1503,8 @@ sdmTMB <- function(
   out <- c(out_structure, list(
     model      = tmb_opt,
     sd_report  = sd_report,
+    parlist = tmb_obj$env$parList(par = tmb_obj$env$last.par.best),
+    last.par.best = tmb_obj$env$last.par.best,
     gradients  = conv$final_grads,
     bad_eig    = conv$bad_eig,
     pos_def_hessian = sd_report$pdHess))

R/predict.R

@@ -297,6 +297,8 @@ predict.sdmTMB <- function(object, newdata = NULL,
     sims <- nsim
   }
 
+  reinitialize(object)
+
   assert_that(model[[1]] %in% c(NA, 1, 2),
     msg = "`model` argument not valid; should be one of NA, 1, 2")
   if (missing(model)) {

R/utils.R

@@ -657,6 +657,30 @@ update_version <- function(object) {
   object
 }
 
+reload_model <- function(object) {
+  if ("parlist" %in% names(object)) {
+    # tinyVAST does this to be extra sure... I've found one case where it was needed
+    obj <- TMB::MakeADFun(
+      data = object$tmb_data,
+      parameters = object$parlist, #!! important part
+      map = object$tmb_map,
+      random = object$tmb_random,
+      DLL = "sdmTMB",
+      profile = object$control$profile
+    )
+    obj$env$beSilent()
+    nll_new <- obj$fn(object$model$par) #!! important: need to eval once (restores last.par.best etc.)
+    if (abs(nll_new - object$model$objective) > 0.01) {
+      cli_abort(c("Model fit is not identical to recorded value:", "
+        something is not working as expected"))
+    }
+    object$tmb_obj <- obj
+    object
+  } else {
+    cli_abort("`reload_model()` only works with models fit with sdmTMB 0.5.0.9006 and higher.")
+  }
+}
+
 reinitialize <- function(x) {
   # replacement for TMB:::isNullPointer; modified from glmmTMB source
   # https://github.com/glmmTMB/glmmTMB/issues/651#issuecomment-912920255
@@ -667,7 +691,16 @@ reinitialize <- function(x) {
     identical(x, new("externalptr"))
   }
   if (is_null_pointer(x)) {
-    x$tmb_obj$retape()
+    x$tmb_obj$env$beSilent()
+    x$tmb_obj$fn(x$model$par)
+    # x$tmb_obj$retape()
+    if ("parlist" %in% names(x) && "last.par.best" %in% names(x)) {
+      if (!identical(x$tmb_obj$env$last.par.best, x$last.par.best)) {
+        cli_warn(c("Detected a potential issue reloading a saved sdmTMB model.",
+          "Please run `fit <- sdmTMB:::reload_model(fit)`,",
+          "where `fit` is your fitted model."))
+      }
+    }
   }
 }