Fix major bug in extra_time with offset

Will do more testing still and push
to CRAN soon

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: sdmTMB
 Title: Spatial and Spatiotemporal SPDE-Based GLMMs with 'TMB'
-Version: 0.4.2.9003
+Version: 0.4.2.9004
 Authors@R: c(
     person(c("Sean", "C."), "Anderson", , "[email protected]",
            role = c("aut", "cre"),

NEWS.md

@@ -1,5 +1,11 @@
 # sdmTMB (development version)
 
+* Fix a bug likely introduced in July 2023 that caused issues when
+  `extra_time` was specified with some configurations of `offset`. This is an
+  important bug and models fit with `extra_time` and offsets between that date
+  and v0.4.2.9003 (February 21 2024) should be checked against a current version
+  of sdmTMB. This likely affected v0.4.0 to v0.4.2 on CRAN.
+
 * Issue error if `time` column has NAs. #298 #299
 
 * Fix bug in `get_cog(..., format = "wide")` where the time column was

R/fit.R

@@ -768,10 +768,10 @@ sdmTMB <- function(
 
   if (!is.null(extra_time)) { # for forecasting or interpolating
     data <- expand_time(df = data, time_slices = extra_time, time_column = time, weights = weights, offset = offset, upr = upr)
-    if (!is.null(offset)) offset <- data[["__sdmTMB_offset__"]] # expanded
-    if (!is.null(weights)) weights <- data[["__weight_sdmTMB__"]] # expanded
-    if (!is.null(upr)) upr <- data[["__dcens_upr__"]] # expanded
-    data[["__dcens_upr__"]] <- NULL
+    offset <- data[["__sdmTMB_offset__"]] # expanded
+    weights <- data[["__weight_sdmTMB__"]] # expanded
+    upr <- data[["__dcens_upr__"]] # expanded
+    # data[["__dcens_upr__"]] <- NULL
     spde$loc_xy <- as.matrix(data[,spde$xy_cols,drop=FALSE])
     spde$A_st <- fmesher::fm_basis(spde$mesh, loc = spde$loc_xy)
     spde$sdm_spatial_id <- seq(1, nrow(data)) # FIXME

R/utils.R

@@ -229,13 +229,13 @@ parse_threshold_formula <- function(formula, thresh_type_short = "lin_thresh",
 }
 
 expand_time <- function(df, time_slices, time_column, weights, offset, upr) {
-  if (!is.null(weights)) df[["__weight_sdmTMB__"]] <- weights
-  if (!is.null(offset)) df[["__sdmTMB_offset__"]] <- offset
-  if (!is.null(upr)) df[["__dcens_upr__"]] <- upr
+  df[["__weight_sdmTMB__"]] <- ifelse(!is.null(weights), weights, 1)
+  df[["__sdmTMB_offset__"]] <- ifelse(!is.null(offset), offset, 0)
+  df[["__dcens_upr__"]] <- ifelse(!is.null(upr), upr, NA_real_)
   fake_df <- df[1L, , drop = FALSE]
-  if (!is.null(weights)) fake_df[["__weight_sdmTMB__"]] <- 0
-  if (!is.null(offset))fake_df[["__sdmTMB_offset__"]] <- 0
-  if (!is.null(upr)) fake_df[["__dcens_upr__"]] <- NA_real_
+  fake_df[["__weight_sdmTMB__"]] <- 0
+  fake_df[["__sdmTMB_offset__"]] <- 0
+  fake_df[["__dcens_upr__"]] <- NA_real_
   missing_years <- time_slices[!time_slices %in% df[[time_column]]]
   fake_df <- do.call("rbind", replicate(length(missing_years), fake_df, simplify = FALSE))
   fake_df[[time_column]] <- missing_years

tests/testthat/test-5-residuals.R

@@ -341,9 +341,9 @@ test_that("predict_mle_mcmc() works with extra_time #297", {
   skip_if_not_installed("rstan")
   skip_on_ci()
   fit <- sdmTMB(
-    density ~ 0 + as.factor(year),
+    density ~ 1,
     time = "year",
-    spatiotemporal = "off",
+    spatiotemporal = "rw",
     spatial = "on",
     mesh = pcod_mesh_2011,
     data = pcod_2011,

tests/testthat/test-offset.R

@@ -94,7 +94,7 @@ test_that("Offset works with extra_time", {
   )
   expect_true(inherits(fit, "sdmTMB"))
   b <- tidy(fit, "ran_pars")
-  expect_equal(round(b$estimate[b$term == "rho"], 2), 0.91)
+  expect_equal(round(b$estimate[b$term == "rho"], 2), 0.88)
 })
 
 test_that("Offset prediction matches glm()", {