tests/testthat/test_vargam.R

In dsm: Density Surface Modelling of Distance Sampling Data

cv.tol<-1e-5
N.tol<-1e-4

## NB the 444km^2 for the prediction grid is INCORRECT but
## serves us fine for the purpose of these tests.
context("GAM variance")
library(Distance)


# load the Gulf of Mexico dolphin data
data(mexdolphins)

# fit a detection function and look at the summary
hn.model <- suppressMessages(ds(distdata,
                                max(distdata$distance),
                                adjustment = NULL))

# fit a simple smooth of x and y
mod1 <- dsm(abundance.est~s(x,y), hn.model, segdata, obsdata)


# run the moving block bootstrap for 2 rounds
# set.seed(1123)
# mod1.var <- dsm.var.prop(mod1, preddata, off.set=preddata$area)
# 
# test_that("mexdolphins - results for s(x,y)",{
#   # CV
#   expect_equal(summary(mod1.var)$cv,
#                0.1742568601, tol=cv.tol)
#   # var
#   expect_equal(mod1.var$pred.var,
#                15336119.57, tol=N.tol)
#   # test that the CIs are right
#   expect_output(print(summary(mod1.var)),
#                 "2.5%     Mean    97.5% \\n16012.09 22473.35 31541.89")
# })
# 
# test_that("different CIs work",{
#   expect_output(print(summary(mod1.var, alpha=0.1)),
#                 "5%     Mean      95% \\n16908.97 22473.35 29868.86")
#   expect_output(print(summary(mod1.var, alpha=0.02)),
#                 "1%     Mean      99% \\n15028.91 22473.35 33605.33")
# 
# })

## With no detection function
test_that("mexdolphins - works for strip transects",{

  dum <- dummy_ddf(obsdata$object, obsdata$size, 8000)
  mod1_nodf <- dsm(abundance.est~s(x,y), dum, segdata, obsdata)
  set.seed(1123)
  mod1.var <- dsm_var_gam(mod1_nodf, preddata, off.set=preddata$area)

  expect_equal(summary(mod1.var)$cv,
               0.1639757, tol=cv.tol)

  # throw an error if you want detection function uncertainty with no
  # detection function
  expect_error(dsm_var_prop(mod1_nodf, preddata, off.set=preddata$area),
               "Variance propagation can only be used with count as the response.")

})

test_that("varprop doesn't work for estimated abundance", {

  mod1_Nhat <- dsm(abundance.est~s(x,y), hn.model, segdata, obsdata)
  expect_error(dsm_var_prop(mod1_Nhat, preddata, off.set=preddata$area),
               "Variance propagation can only be used with count as the response.")
})


## test that disaggregated estimation does the right thing

# test_that("mexdolphins - results for s(x,y)",{
#   set.seed(1123)
#   preddata$off.set <- preddata$area
# 
#   # estimate using the "quick" routine
#   mod1.varp <- dsm_varprop(mod1, preddata)
# 
#   # do it the "long way" for D7 compatibility
#   set.seed(1123)
#   lpreddata <- split(preddata, 1:nrow(preddata))
#   mod1.var <- dsm.var.prop(mod1, lpreddata, off.set=preddata$area)
# 
# 
#   # ses
#   expect_equal(sqrt(mod1.var$pred.var)/unlist(mod1.var$pred),
#                as.vector(unname(mod1.varp$ses/mod1.varp$pred[,1])), tol=cv.tol,
#                check.attributes=FALSE)
# #  # var
# #  expect_equal(mod1.var$pred.var,
# #               23747034.5355, tol=N.tol)
# #  # test that the CIs are right
# #  expect_output(print(summary(mod1.var)),
# #                "2.5%     Mean    97.5% \\n14764.25 22473.39 34207.84")
# })