From d1742e5aa03c069010efe183023a4ac80e423ba5 Mon Sep 17 00:00:00 2001 From: Sean Anderson Date: Tue, 5 Dec 2023 12:50:03 -0800 Subject: [PATCH] Enable newdata = NULL for SVCs #279 --- R/predict.R | 16 ++++------------ tests/testthat/test-3-spatial-varying.R | 8 ++++++++ 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/R/predict.R b/R/predict.R index be2d9bd88..319e5e440 100644 --- a/R/predict.R +++ b/R/predict.R @@ -312,7 +312,7 @@ predict.sdmTMB <- function(object, newdata = NULL, # places where we force newdata: nd_arg_was_null <- FALSE if (is.null(newdata)) { - if (is_delta(object) || nsim > 0 || type == "response" || !is.null(mcmc_samples) || se_fit || !is.null(re_form) || !is.null(re_form_iid) || !is.null(offset)) { + if (is_delta(object) || nsim > 0 || type == "response" || !is.null(mcmc_samples) || se_fit || !is.null(re_form) || !is.null(re_form_iid) || !is.null(offset) || isTRUE(object$family$delta)) { newdata <- object$data if (!is.null(object$extra_time)) { # issue #273 newdata <- newdata[!newdata[[object$time]] %in% object$extra_time,] @@ -819,10 +819,6 @@ predict.sdmTMB <- function(object, newdata = NULL, "supply `newdata`. In the meantime you could supply your original data frame ", "to the `newdata` argument.")) } - if (isTRUE(object$family$delta)) { - cli_abort(c("Delta model prediction not implemented for `newdata = NULL` yet.", - "Please provide your data to `newdata` and include the `offset` vector if needed.")) - } nd <- object$data lp <- object$tmb_obj$env$last.par.best # object$tmb_obj$fn(lp) # call once to update internal structures? @@ -833,14 +829,10 @@ predict.sdmTMB <- function(object, newdata = NULL, # IID and RW effects are baked into fixed effects for `newdata` in above code: nd$est_non_rf <- r$eta_fixed_i[,1] + r$eta_rw_i[,1] + r$eta_iid_re_i[,1] # DELTA FIXME nd$est_rf <- r$omega_s_A[,1] + r$epsilon_st_A_vec[,1] # DELTA FIXME - if (!is.null(object$spatial_varying_formula)) - cli_abort(c("Prediction with `newdata = NULL` is not supported with spatially varying coefficients yet.", - "Please provide your data to `newdata`.")) - # + r$zeta_s_A nd$omega_s <- r$omega_s_A[,1]# DELTA FIXME - # for (z in seq_len(dim(r$zeta_s_A)[2])) { # SVC: - # nd[[paste0("zeta_s_", object$spatial_varying[z])]] <- r$zeta_s_A[,z,1] - # } + for (z in seq_len(dim(r$zeta_s_A)[2])) { # SVC: # DELTA FIXME + nd[[paste0("zeta_s_", object$spatial_varying[z])]] <- r$zeta_s_A[,z,1] + } nd$epsilon_st <- r$epsilon_st_A_vec[,1]# DELTA FIXME nd <- nd[!nd[[object$time]] %in% object$extra_time, , drop = FALSE] # issue 270 obj <- object diff --git a/tests/testthat/test-3-spatial-varying.R b/tests/testthat/test-3-spatial-varying.R index ff25a26d0..bb2a88123 100644 --- a/tests/testthat/test-3-spatial-varying.R +++ b/tests/testthat/test-3-spatial-varying.R @@ -12,6 +12,13 @@ test_that("SVC are estimated correctly for binomial and delta models", { mesh = mesh10, family = binomial() ) + + p <- predict(m1) + pnd <- predict(m1, newdata = d) + expect_identical(names(p), names(pnd)) + expect_equal(p$est, pnd$est) + expect_equal(p$zeta_s_year_scaled, pnd$zeta_s_year_scaled) + # m1.1 <- sdmTMB( # data = d, # formula = present ~ 1 + year_scaled, @@ -144,3 +151,4 @@ test_that("SVC throws a warning if character class #269", { ) }, regexp = "character") }) +