tests/testthat/test-tinyVAST.R

# if (FALSE) {
# if (requireNamespace("tinyVAST", quietly = TRUE)) {
#   library("tinyVAST", warn.conflicts = FALSE)
#   TOL <- 1e-5
#
#   get_sdmTMB_pars <- function(x) {
#     c(
#       as.list(x$sd_report, "Estimate"),
#       as.list(x$sd_report, "Estimate", report = TRUE)
#     )
#   }
#
#   test_that("tinyVAST/sdmTMB Tweedie spatiotemporal IID models and index area integration match", {
#     skip_on_cran()
#     mesh <- make_mesh(pcod, c("X", "Y"), cutoff = 18)
#     system.time({
#       fit_sd <- sdmTMB(
#         density ~ 0 + as.factor(year),
#         data = pcod,
#         mesh = mesh,
#         family = tweedie(),
#         time = "year",
#         control = sdmTMBcontrol(multiphase = FALSE)
#       )
#     })
#     ps <- get_sdmTMB_pars(fit_sd)
#
#     system.time({
#       fit_tv <- tinyVAST(
#         density ~ 0 + factor(year),
#         dsem = "",
#         sem = "",
#         data = pcod,
#         family = tweedie(),
#         time_column = "year",
#         space_columns = c("X", "Y"),
#         spatial_graph = mesh$mesh,
#         control = tinyVASTcontrol(newton_loops = 1)
#       )
#     })
#     pt <- as.list(fit_tv$sdrep, "Estimate")
#
#     expect_equal(pt$alpha_j, ps$b_j, tolerance = TOL)
#     expect_equal(pt$log_sigma[2], ps$thetaf, tolerance = TOL)
#     expect_equal(pt$log_sigma[1], ps$ln_phi, tolerance = TOL)
#     expect_equal(pt$beta_z, ps$sigma_E[1, 1], tolerance = TOL)
#     expect_equal(pt$theta_z, ps$sigma_O[1, 1], tolerance = TOL)
#     expect_equal(pt$log_kappa, ps$ln_kappa[1, 1], tolerance = TOL)
#
#     g <- replicate_df(qcs_grid, "year", unique(pcod$year))
#     p <- predict(fit_sd, newdata = g, return_tmb_object = TRUE)
#
#     system.time({
#       is <- get_index(p, bias_correct = TRUE)
#     })
#
#     # system.time({
#     # is2 <- lapply(unique(g$year), \(x) {
#     #   pp <- predict(fit_sd, newdata = subset(g, year == x), return_tmb_object = TRUE)
#     #   get_index(pp, bias_correct = TRUE)
#     # })
#     # is2 <- do.call(rbind, is2)
#     # })
#
#     system.time({
#       g$var <- "response"
#       it <- lapply(unique(g$year), \(x)
#       integrate_output(fit_tv, newdata = subset(g, year == x), apply.epsilon = TRUE))
#       it <- do.call(rbind, it) |> as.data.frame()
#     })
#
#     expect_equal(it$`Est. (bias.correct)`, is$est, tolerance = TOL)
#   })
#
#   fit_sd <- sdmTMB(
#     density ~ 0 + as.factor(year),
#     data = pcod,
#     family = delta_lognormal(type = "poisson-link"),
#     spatial = "off",
#     spatiotemporal = "off"
#   )
#   ps <- get_pars(fit_sd)
#
#   suppressWarnings({
#     fit_tv <- tinyVAST(
#       density ~ 0 + factor(year),
#       delta_options = list(delta_formula = ~ 0 + factor(year)),
#       data = pcod,
#       family = delta_lognormal(type = "poisson-link"),
#       control = tinyVASTcontrol(newton_loops = 1)
#     )
#   })
#   pt <- as.list(fit_tv$sdrep, "Estimate")
#
#   compare_models_delta <- function(mtv, msd) {
#     ps <- get_pars(msd)
#     pt <- as.list(mtv$sdrep, "Estimate")
#     expect_equal(logLik(msd), logLik(mtv), ignore_attr = TRUE)
#     expect_equal(pt$alpha_j, ps$b_j, tolerance = TOL)
#     expect_equal(pt$alpha2_j, ps$b_j2, tolerance = TOL)
#   }
#
#   test_that("tinyVAST/sdmTMB delta_lognormal(type = 'poisson-link') models match", {
#     skip_on_cran()
#     compare_models_delta(fit_tv, fit_sd)
#     expect_equal(pt$log_sigma, ps$ln_phi[2], tolerance = TOL)
#   })
#
#   test_that("tinyVAST/sdmTMB delta_gamma() models match", {
#     skip_on_cran()
#     fit_sd <- update(fit_sd, family = delta_gamma())
#     fit_tv <- update(fit_tv, family = delta_gamma())
#     compare_models_delta(fit_tv, fit_sd)
#     ps <- get_pars(fit_sd)
#     pt <- as.list(fit_tv$sdrep, "Estimate")
#     expect_equal(1 / (exp(pt$log_sigma))^2, exp(ps$ln_phi[2]), tolerance = TOL)
#   })
#
#   test_that("tinyVAST/sdmTMB delta_gamma(type = 'poisson-link')) models match", {
#     skip_on_cran()
#     fit_sd <- update(fit_sd, family = delta_gamma(type = "poisson-link"))
#     fit_tv <- update(fit_tv, family = delta_gamma(type = "poisson-link"))
#     compare_models_delta(fit_tv, fit_sd)
#     ps <- get_pars(fit_sd)
#     pt <- as.list(fit_tv$sdrep, "Estimate")
#     expect_equal(1 / (exp(pt$log_sigma))^2, exp(ps$ln_phi[2]), tolerance = TOL)
#   })
# }
# }
#
seananderson/sdmTMB documentation built on June 10, 2025, 3:49 a.m.