Add fake mesh if no random fields #59

pbs-assess · Mar 23, 2022 · 379681d · 379681d
1 parent 4041bea
commit 379681d
Show file tree

Hide file tree

Showing 5 changed files with 25 additions and 6 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: sdmTMB
 Title: Spatiotemporal Species Distribution GLMMs with 'TMB'
-Version: 0.0.21.9007
+Version: 0.0.21.9008
 Authors@R:
     c(person(given = c("Sean", "C."),
              family = "Anderson",

diff --git a/NEWS.md b/NEWS.md
@@ -4,6 +4,8 @@
 
 # sdmTMB 0.0.21.9000
 
+* Add fake mesh if random fields are all off. #59
+
 * Make `predict(..., newdata = NULL)` also use `last.par.best` instead of
   `last.par` to match `newdata = df`.
 

diff --git a/R/fit.R b/R/fit.R
@@ -439,15 +439,20 @@ sdmTMB <- function(
       include_spatial <- FALSE
     }
   }
+  if (!include_spatial && spatiotemporal == "off" || !include_spatial && spatial_only) {
+    # message("Both spatial and spatiotemporal fields are set to 'off'.")
+    control$map_rf <- TRUE
+  }
+  if ((spatial == "off" || isFALSE(spatial)) && spatiotemporal == "off" && missing(mesh)) {
+    # message("Constructing fake mesh object.")
+    data$sdmTMB_X_ <- data$sdmTMB_Y_ <- stats::runif(nrow(data))
+    mesh <- make_mesh(data, c("sdmTMB_X_", "sdmTMB_Y_"), cutoff = 1)
+  }
   if (is_present(spde)) {
     deprecate_warn("0.0.20", "sdmTMB(spde)", "sdmTMB(mesh)")
   } else {
     spde <- mesh
   }
-  if (!include_spatial && spatiotemporal == "off" || !include_spatial && spatial_only) {
-    message("Both spatial and spatiotemporal fields are set to 'off'.")
-    control$map_rf <- TRUE
-  }
   epsilon_model <- NULL
   epsilon_predictor <- NULL
   if (!is.null(experimental)) {
@@ -563,7 +568,6 @@ sdmTMB <- function(
         "Please remove these or turn your time column into an integer.", call. = FALSE)
     }
   }
-
   assert_that(identical(nrow(spde$loc_xy), nrow(data)),
     msg = "Number of x-y coordinates in `mesh` does not match `nrow(data)`.")
 
@@ -1010,6 +1014,7 @@ sdmTMB <- function(
   }
 
   data$sdm_x <- data$sdm_y <- data$sdm_orig_id <- data$sdm_spatial_id <- NULL
+  data$sdmTMB_X_ <- data$sdmTMB_Y_ <- NULL
 
   tmb_obj <- TMB::MakeADFun(
     data = tmb_data, parameters = tmb_params, map = tmb_map,

diff --git a/R/methods.R b/R/methods.R
@@ -25,6 +25,9 @@ print.sdmTMB <- function(x, ...) {
   } else {
     title <- paste0("Spatiotemporal model fit by ", fit_by, " ['sdmTMB']\n")
   }
+  if (x$control$map_rf) {
+    title <- paste0("Model fit by ", fit_by, " ['sdmTMB']\n")
+  }
   formula <- paste0("Formula: ", deparse(x$call$formula), "\n")
   if (deparse(x$call$time) != "NULL") {
     time <- paste0("Time column: ", deparse(x$call$time), "\n")
@@ -190,6 +193,9 @@ print.sdmTMB <- function(x, ...) {
     paste0("Matern range (spatial): ", range[1], "\n",
       "Matern range (spatiotemporal): ", range[2], "\n")
   }
+  if (x$control$map_rf) {
+    range_text <- NULL
+  }
 
   cat("\n",
     phi,

diff --git a/tests/testthat/test-1-fit-basic.R b/tests/testthat/test-1-fit-basic.R
@@ -100,6 +100,12 @@ test_that("sdmTMB model fit with a covariate beta", {
   # mismatch:
   nd$time <- as.factor(nd$time)
   expect_error(predict(m, newdata = nd), regexp = "class")
+
+  # no fields; fake mesh:
+  m <- sdmTMB(data = s, formula = observed ~ 0 + cov1, time = "time",
+    spatial = "off", spatiotemporal = "off")
+  m <- sdmTMB(data = s, formula = observed ~ 0 + cov1, time = "time",
+    spatial = FALSE, spatiotemporal = "off")
 })
 
 test_that("Anisotropy fits and plots", {