tests/testthat/test-check_AnalysisOptions.R

In dsims: Distance Sampling Simulations

library(dsims)
library(testthat)

context("Analysis Option Checks")

test_that("Can create objects or return correct error / warning messages", {

  #Set up simulation
  outer = matrix(c(0,0,0,500,2000,500,2000,0,0,0),ncol=2, byrow=TRUE)
  hole1 = matrix(c(500,300,500,350,1500,350,1500,300,500,300),ncol=2, byrow=TRUE)
  pol1 = list(outer, hole1)
  mp = list(pol1)
  mp1 = sf::st_multipolygon(mp)

  region <- make.region(region.name = "main",
                        shape = mp1)

  density <- make.density(region = region, x.space = 20, constant = 10)
  density <- add.hotspot(density, c(500,250), 200, 200)

  covariate.list <- list()
  covariate.list$size <- list(distribution = "poisson", lambda = 25)
  covariate.list$sex <- data.frame(level = c("male", "female"), prob = c(0.5,0.5))
  pop.descrp <- make.population.description(region = region,
                                            density = density,
                                            covariates = covariate.list,
                                            N = 250)
  cov.params <- list(size = log(1.1),
                     sex = data.frame(level = c("male", "female"),
                                      param = c(log(1), log(1.75))))

  detect <- make.detectability(key.function = "hn",
                               scale.param = 5,
                               truncation = 75,
                               cov.param = cov.params)

  design <- make.design(region = region,
                        transect.type = "line",
                        design = "systematic",
                        samplers = 20,
                        truncation = 75)

  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Test anaysis options

  analyses <- make.ds.analysis(dfmodel = list(~1, ~size, ~size+sex),
                               key = c("hn","hn","hn"),
                               truncation = 75)

  sim <- make.simulation(reps = 10,
                         design = design,
                         population.description = pop.descrp,
                         detectability = detect,
                         ds.analysis = analyses)

  survey <- run.survey(sim)
  
  pop <- survey@population
  pop.data <- pop@population
  
  # Check the scale parameter is calculated correctly
  indiv.size <- pop.data[1,"size"]
  indiv.sex <- ifelse(pop.data[1,"sex"] == "male", 0, 1)
  
  scale.param <- pop@detectability@scale.param
  size.param <- pop@detectability@cov.param$size
  sex.param <- pop@detectability@cov.param$sex[2,2]
  
  expect_equal(pop.data[1,"scale.param"],
               exp(log(scale.param)+indiv.size*size.param+indiv.sex*sex.param))

  # Basic multi-model selection test
  sel.model <- analyse.data(analyses, survey@dist.data, warnings = list())
  expect_equal(length(sel.model$model$ddf$fitted), nrow(survey@dist.data[!is.na(survey@dist.data$object),]))

  # Test optim method

  # Test different er.var estimator
  analyses <- make.ds.analysis(dfmodel = list(~1),
                               key = c("hn"),
                               er.var = "R2",
                               truncation = 75)
  fit.R2 <- analyse.data(analyses, survey@dist.data)
  analyses <- make.ds.analysis(dfmodel = list(~1),
                               key = c("hn"),
                               er.var = "S2",
                               truncation = 75)
  fit.S2 <- analyse.data(analyses, survey@dist.data)
  
  expect_true(fit.R2$dht$individuals$N$se > fit.S2$dht$individuals$N$se)
  
  # Test default truncation distance (should be 50)
  
  analyses <- make.ds.analysis()
  expect_equal(analyses@truncation, list(50))


})

test_that("Grouping strata", {
  
  outer <- matrix(c(0,0,15,0,15,10,0,10,0,0),ncol=2, byrow=TRUE)
  hole1 <- matrix(c(2,2,2,3,3,3,3,2,2,2),ncol=2, byrow=TRUE)
  hole2 <- matrix(c(5,5,5,6,7,6,8,5.5,7,5,5,5),ncol=2, byrow=TRUE)
  pol1 <- sf::st_polygon(list(outer, hole1*1.5, hole2))
  pol2 <- sf::st_polygon(list(outer + 15, hole2*1.5 + 12))
  pol3 <- sf::st_polygon(list(outer + 30, hole2*2.5 + 20))
  sfc <- sf::st_sfc(pol1,pol2,pol3)
  strata.names <- c("SW", "central", "NE")
  mp1 <- sf::st_sf(strata = strata.names, geom = sfc)
  
  region <- make.region(region.name = "study.area", 
                        strata.name = strata.names, 
                        shape = mp1)
  
  density <- make.density(region,
                          x.space = 0.5,
                          constant = rep(1,3))
  
  design <- make.design(region,
                        design = "systematic",
                        samplers = 30,
                        truncation = 0.5)
  
  pop.descript <- make.population.description(region,
                                              density,
                                              N = c(200,200,200))
  
  detect <- make.detectability(scale.param = 0.25,
                               truncation = 0.5)
  
  grp.strat <- data.frame(design.id = c("SW", "central", "NE"),
                          analysis.id = rep("global",3))
  
  analyses <- make.ds.analysis(dfmodel = list(~1),
                               key = "hn",
                               truncation = 0.5,
                               group.strata = grp.strat)
  
  sim <- make.simulation(reps = 3,
                         design = design,
                         population.description = pop.descript,
                         detectability = detect,
                         ds.analysis = analyses)
  
  test <- run.simulation(sim)
  tmp <- summary(test, description.summary = FALSE)
  
  expect_null(tmp@expected.size$Truth)
  true.individsN <- 600
  expect_equal(tmp@individuals$N$Truth, true.individsN)
  
  
  # Test when cluster size is in the simulation
  covs <- list()
  covs$size <- list(list(distribution = "poisson", lambda = 25))
  
  pop.descript <- make.population.description(region,
                                              density,
                                              covariates = covs,
                                              N = c(200,200,200))
  
  sim <- make.simulation(reps = 3,
                         design = design,
                         population.description = pop.descript,
                         detectability = detect,
                         ds.analysis = analyses)
  
  test <- run.simulation(sim)
  tmp <- summary(test, description.summary = FALSE)
  
  true.es <-25
  true.clusterN <-  600
  expect_equal(tmp@expected.size$Truth, true.es)
  expect_equal(tmp@clusters$N$Truth,true.clusterN)
  expect_equal(tmp@individuals$N$Truth, true.es*true.clusterN)
  
  # Test when only some are grouped
  grp.strat <- data.frame(design.id = c("SW", "central", "NE"),
                          analysis.id = c(rep("S_Central",2), "NE"))
  
  analyses <- make.ds.analysis(dfmodel = list(~1),
                               key = "hn",
                               truncation = 0.5,
                               group.strata = grp.strat)
  
  sim <- make.simulation(reps = 3,
                         design = design,
                         population.description = pop.descript,
                         detectability = detect,
                         ds.analysis = analyses)
  
  test <- run.simulation(sim)
  tmp <- summary(test, description.summary = FALSE)
  
  true.es <- c(25,25,25)
  true.clusterN <-  c(200,400,600)
  expect_equal(tmp@expected.size$Truth, true.es)
  expect_equal(tmp@clusters$N$Truth,true.clusterN)
  expect_equal(tmp@individuals$N$Truth, true.es*true.clusterN)
  
  
  # Modify cluster size values to check 
  
  covs <- list()
  covs$size <- list(list(distribution = "poisson", lambda = 25),
                    list(distribution = "poisson", lambda = 50),
                    list(distribution = "poisson", lambda = 100))
  
  pop.descript <- make.population.description(region,
                                              density,
                                              covariates = covs,
                                              N = c(200,300,500))
  
  grp.strat <- data.frame(design.id = c("SW", "central", "NE"),
                          analysis.id = c(rep("S_Central",2), "NE"))
  
  analyses <- make.ds.analysis(dfmodel = list(~1),
                               key = "hn",
                               truncation = 0.5,
                               group.strata = grp.strat)
  
  
  sim <- make.simulation(reps = 3,
                         design = design,
                         population.description = pop.descript,
                         detectability = detect,
                         ds.analysis = analyses)
  
  test <- run.simulation(sim)
  tmp <- summary(test, description.summary = FALSE)
  
  true.es <- c(100, 25*0.4 + 0.6*50, 25*0.2 + 0.3*50 + 0.5*100)
  true.clusterN <-  c(500,500,1000)
  expect_equal(tmp@expected.size$Truth, true.es)
  expect_equal(tmp@clusters$N$Truth,true.clusterN)
  expect_equal(tmp@individuals$N$Truth, true.es*true.clusterN)
})