# 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)
# })
# }
# }
#
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.