## Started 2021-01-30, 2021-05-18, 2021-05-28 library(secr) ## to avoid ASAN/UBSAN errors on CRAN, following advice of Kevin Ushey ## e.g. https://github.com/RcppCore/RcppParallel/issues/169 Sys.setenv(RCPP_PARALLEL_BACKEND = "tinythread") # create small working datasets suppressWarnings(smallCH <- join(subset(ovenCHp, sessions = 1:3, traps = 1:20, dropnullocc = FALSE))) nonspatialCH <- reduce(ovenCH, outputdetector = 'nonspatial', verify = FALSE) msk <- make.mask(traps(smallCH), buffer = 200, nx = 20, type = 'trapbuffer') argssecr <- list(capthist = smallCH, mask = msk, detectfn = 'HHN', start = list(lambda0 = 0.037, sigma = 65.3), details = list(LLonly = TRUE, fastproximity = FALSE)) test_that("correct likelihood (multi-session CL)", { argssecr$CL <- TRUE LL <- do.call(secr.fit, argssecr)[1] expect_equal(LL, -301.1396, tolerance = 1e-4, check.attributes = FALSE) }) test_that("correct likelihood (multi-session CL fastproximity)", { argssecr$CL <- TRUE argssecr$details$fastproximity <- TRUE LL <- do.call(secr.fit, argssecr)[1] expect_equal(LL, -109.61114, tolerance = 1e-4, check.attributes = FALSE) }) test_that("correct likelihood (single session 'single')", { args <- list(capthist = captdata, buffer = 100, detectfn = 'HN', start = list(D = 5.4798, g0 = 0.2732, sigma = 29.3658), details = list(LLonly = TRUE)) # 'multi' likelihood used for single-catch traps expect_warning(LL <- do.call(secr.fit, args)[1]) expect_equal(LL, -759.02575, tolerance = 1e-4, check.attributes = FALSE) }) ############################################################################### ## Check bug fixes 2021 onwards ## make.capthist bug reported by Richard Glennie 2021-01-30 test_that("correct rejection of duplicates at exclusive detectors", { captures <- data.frame(session = c(1, 1, 1), ID = c(1, 11, 1), occasion = c(12, 2, 2), trap = c("A1", "A2", "A2")) traps <- make.grid(detector = "multi") expect_equal(nrow(make.capthist(captures, traps)), 2) }) ############################################################################### ## Multi-polygon bug 2021-05-18 datadir <- system.file("extdata", package = "secr") polyexample1 <- read.traps(file = paste0(datadir, '/polygonexample1.txt'), detector = 'polygon') polygonCH <- sim.capthist(polyexample1, popn = list(D = 1, buffer = 200), detectfn = 'HHN', detectpar = list(lambda0 = 5, sigma = 50), noccasions = 1, seed = 123) test_that("simulated polygon data have correct RPSV", { rpsv <- RPSV(polygonCH, CC = TRUE) expect_equal(rpsv, 45.16401, tolerance = 1e-4, check.attributes = FALSE) }) test_that("correct likelihood (multi-detector polygon data)", { args <- list(capthist = polygonCH, buffer = 200, detectfn = 'HHN', start = list(D=1, lambda0=5, sigma = 50), verify = FALSE, details = list(LLonly = TRUE)) LL <- do.call(secr.fit, args)[1] expect_equal(LL, -2026.92169, tolerance = 1e-4, check.attributes = FALSE) }) ############################################################################### ## join nonspatial bug 2021-05-28 nonspatialCH <- reduce(ovenCH, outputdetector = 'nonspatial', verify = FALSE) test_that("join works on nonspatial data", { sumcapt <- sum(join(nonspatialCH)) expect_equal(sumcapt, 190, tolerance = 1e-4, check.attributes = FALSE) }) ############################################################################### ## pmix bug 2022-01-16 # reported Rebecca Johanna on secrgroup Jan 2022 # after adjusting code in generalsecrloglik.R and fastsecrloglik.R # to match secr 3.2 # extended test 2022-10-25 to fix when one level missing (Mathias Tobler) msk2 <- make.mask(traps(ovenCH[[1]]), buffer = 200, nx = 20, type = 'trapbuffer') args <- list( mask = msk2, detectfn = 'HN', CL = TRUE, start = c(-3.5387, 4.1798, 0.3418, 0.1656), model = sigma~h2, hcov = 'Sex', details = list(LLonly = TRUE)) args$capthist = subset(ovenCH, sessions=1:2) LL1 <- do.call(secr.fit, args)[1] covariates(args$capthist[[2]])$Sex[covariates(args$capthist[[2]])$Sex == 'F'] <- NA LL2 <- do.call(secr.fit, args)[1] args$capthist <-subset(ovenCHp, sessions=1:2) LL3 <- do.call(secr.fit, args)[1] covariates(args$capthist[[2]])$Sex[covariates(args$capthist[[2]])$Sex == 'F'] <- NA LL4 <- do.call(secr.fit, args)[1] test_that("correct likelihood (hcov, pmix with knownclass, multi)", { expect_equal(LL1, -393.62886, tolerance = 1e-4, check.attributes = FALSE) }) test_that("correct likelihood (hcov, pmix with knownclass, fastproximity)", { expect_equal(LL3, -260.04119 , tolerance = 1e-4, check.attributes = FALSE) }) test_that("correct likelihood (hcov, pmix with knownclass, missing one level, multi)", { expect_equal(LL2, -379.08746, tolerance = 1e-4, check.attributes = FALSE) }) test_that("correct likelihood (hcov, pmix with knownclass, missing one level, fastproximity)", { expect_equal(LL4, -245.68867, tolerance = 1e-4, check.attributes = FALSE) }) ############################################################################### ## ignoreusage bug 2022-01-22 test_that("correct likelihood (fastproximity, usage, ignoreusage)", { CH <- ovenCHp[[1]] usage(traps(CH)) <- matrix(1, 44, 9) ## or CH <- secr:::uniformusage(CH) msk <- make.mask(traps(CH), buffer = 200, nx = 20, type = 'trapbuffer') argssecr <- list(capthist = CH, mask = msk, detectfn = 'HHN', start = list(lambda0 = 0.037, sigma = 65.3), CL = TRUE, details = list(LLonly = TRUE, fastproximity = TRUE, ignoreusage = FALSE)) # usage uniform 1.0 LL1 <- do.call(secr.fit, argssecr)[1] # usage alternate nets 1.0, 0.5 usage(traps(argssecr$capthist))[] <- c(1,0.5) LL2 <- do.call(secr.fit, argssecr)[1] # ignore varying usage argssecr$details$ignoreusage <- TRUE LL3 <- do.call(secr.fit, argssecr)[1] expect_equal(LL1, -110.5090678, tolerance = 1e-4, check.attributes = FALSE) expect_equal(LL2, -116.2598708, tolerance = 1e-4, check.attributes = FALSE) # secr 4.5.1 # expect_equal(LL3, -1e+10, tolerance = 1e-4, check.attributes = FALSE) # secr >=4.5.2 expect_equal(LL3, LL1, tolerance = 1e-4, check.attributes = FALSE) }) ###############################################################################