From b7b11ab6c7ae7702e51df1b1695cb077d2f1eb45 Mon Sep 17 00:00:00 2001
From: Sean Anderson <sean@seananderson.ca>
Date: Tue, 26 Mar 2024 14:44:39 -0700
Subject: [PATCH] Better re-initialization of saved fits

---
 R/index.R     |  2 ++
 R/print.R     |  6 +-----
 R/residuals.R |  2 ++
 R/tidy.R      |  2 ++
 R/tmb-sim.R   |  3 +++
 R/utils.R     | 14 ++++++++++++++
 6 files changed, 24 insertions(+), 5 deletions(-)

diff --git a/R/index.R b/R/index.R
index a2075b0c3..d67d79d78 100644
--- a/R/index.R
+++ b/R/index.R
@@ -105,6 +105,8 @@ get_cog <- function(obj, bias_correct = FALSE, level = 0.95, format = c("long",
 get_generic <- function(obj, value_name, bias_correct = FALSE, level = 0.95,
   trans = I, area = 1, silent = TRUE, ...) {
 
+  reinitialize(obj$fit_obj)
+
   if ((!isTRUE(obj$do_index) && value_name[1] == "link_total") || value_name[1] == "cog_x") {
     if (is.null(obj[["obj"]])) {
       cli_abort(paste0("`obj` needs to be created with ",
diff --git a/R/print.R b/R/print.R
index e9a15d89a..c3c3a0af3 100644
--- a/R/print.R
+++ b/R/print.R
@@ -374,13 +374,9 @@ print_footer <- function(x) {
 #' @export
 #' @import methods
 print.sdmTMB <- function(x, ...) {
-
-  # or x$tmb_obj$retape()!?
-  sink(tempfile())
-  # tmp <- x$tmb_obj$fn(x$tmb_obj$par) # FIXME needed?
+  reinitialize(x)
   lp <- x$tmb_obj$env$last.par.best
   r <- x$tmb_obj$report(lp)
-  sink()
 
   delta <- isTRUE(x$family$delta)
   print_header(x)
diff --git a/R/residuals.R b/R/residuals.R
index a0edbe019..61424679c 100644
--- a/R/residuals.R
+++ b/R/residuals.R
@@ -316,6 +316,8 @@ residuals.sdmTMB <- function(object,
   if ("visreg_model" %in% names(object)) {
     model <- object$visreg_model
   }
+  # need to re-attach environment if in fresh session
+  reinitialize(object)
 
   # retrieve function that called this:
   sys_calls <- unlist(lapply(sys.calls(), deparse))
diff --git a/R/tidy.R b/R/tidy.R
index e3986bf1c..e1dff0112 100644
--- a/R/tidy.R
+++ b/R/tidy.R
@@ -60,6 +60,8 @@ tidy.sdmTMB <- function(x, effects = c("fixed", "ran_pars", "ran_vals"), model =
   crit <- stats::qnorm(1 - (1 - conf.level) / 2)
   if (exponentiate) trans <- exp else trans <- I
 
+  reinitialize(x)
+
   delta <- isTRUE(x$family$delta)
   assert_that(is.numeric(model))
   assert_that(length(model) == 1L)
diff --git a/R/tmb-sim.R b/R/tmb-sim.R
index 890677a5d..5ec8ccb95 100644
--- a/R/tmb-sim.R
+++ b/R/tmb-sim.R
@@ -360,6 +360,9 @@ simulate.sdmTMB <- function(object, nsim = 1L, seed = sample.int(1e6, 1L),
   type <- match.arg(type)
   assert_that(as.integer(model[[1]]) %in% c(NA_integer_, 1L, 2L))
 
+  # need to re-attach environment if in fresh session
+  reinitialize(object)
+
   # re_form stuff
   conditional_re <- !(!is.null(re_form) && ((re_form == ~0) || identical(re_form, NA)))
   tmb_dat <- object$tmb_data
diff --git a/R/utils.R b/R/utils.R
index 8776321ca..ea12a7062 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -644,3 +644,17 @@ update_version <- function(object) {
   }
   object
 }
+
+reinitialize <- function(x) {
+  # replacement for TMB:::isNullPointer; modified from glmmTMB source
+  # https://github.com/glmmTMB/glmmTMB/issues/651#issuecomment-912920255
+  # https://github.com/glmmTMB/glmmTMB/issues/651#issuecomment-914542795
+  is_null_pointer <- function(x) {
+    x <- x$tmb_obj$env$ADFun$ptr
+    attributes(x) <- NULL
+    identical(x, new("externalptr"))
+  }
+  if (is_null_pointer(x)) {
+    x$tmb_obj$retape()
+  }
+}