diff options
| author | Ken Kellner <ken@kenkellner.com> | 2024-01-04 21:53:24 -0500 |
|---|---|---|
| committer | Ken Kellner <ken@kenkellner.com> | 2024-01-04 22:32:17 -0500 |
| commit | 9ff89b580cd765c3c6cddfac9b3431a2128f4316 (patch) | |
| tree | f8f32d46aec7df6ae04dfe66abf1bf34864ff7f7 | |
| parent | f3c4de5b6475641efbc4e97295c4218d193d9e04 (diff) | |
Fix NA handling bug in TMB occu engine
| -rw-r--r-- | DESCRIPTION | 4 | ||||
| -rw-r--r-- | src/TMB/tmb_occu.hpp | 5 | ||||
| -rw-r--r-- | tests/testthat/test_occu.R | 27 |
3 files changed, 33 insertions, 3 deletions
diff --git a/DESCRIPTION b/DESCRIPTION index 2a2cb8e..e155530 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: unmarked -Version: 1.3.2.9005 -Date: 2023-12-10 +Version: 1.3.2.9006 +Date: 2023-01-04 Type: Package Title: Models for Data from Unmarked Animals Authors@R: c( diff --git a/src/TMB/tmb_occu.hpp b/src/TMB/tmb_occu.hpp index 0fef715..c282542 100644 --- a/src/TMB/tmb_occu.hpp +++ b/src/TMB/tmb_occu.hpp @@ -56,7 +56,10 @@ Type tmb_occu(objective_function<Type>* obj) { int pind = i * J; Type cp = 1.0; for (int j=0; j<J; j++){ - if(R_IsNA(asDouble(y(i,j)))) continue; + if(R_IsNA(asDouble(y(i,j)))){ + pind += 1; + continue; + } cp *= pow(p(pind), y(i,j)) * pow(1-p(pind), 1-y(i,j)); pind += 1; } diff --git a/tests/testthat/test_occu.R b/tests/testthat/test_occu.R index 8bb603e..2538e68 100644 --- a/tests/testthat/test_occu.R +++ b/tests/testthat/test_occu.R @@ -414,3 +414,30 @@ test_that("occu can handle random effects",{ test <- modSel(fl) # shouldn't warn #options(warn=0) }) + +test_that("TMB engine gives correct det estimates when there are lots of NAs", { + + skip_on_cran() + set.seed(123) + M <- 200 + J <- 10 + psi <- 0.5 + + z <- rbinom(M, 1, psi) + + x <- matrix(rnorm(M*J), M, J) + + p <- plogis(0 + 0.3*x) + + y <- matrix(NA, M, J) + for (i in 1:M){ + y[i,] <- rbinom(J, 1, p[i,]) * z[i] + } + y[sample(1:(M*J), (M*J/2), replace=FALSE)] <- NA + + umf <- unmarkedFrameOccu(y=y, obsCovs=list(x=x)) + + fit <- occu(~x~1, umf) + fitT <- occu(~x~1, umf, engine="TMB") + expect_equal(coef(fit), coef(fitT), tol=1e-5) +}) |