diff options
| author | Ken Kellner <ken@kenkellner.com> | 2022-09-19 20:50:33 -0400 |
|---|---|---|
| committer | Ken Kellner <ken@kenkellner.com> | 2022-09-19 20:50:33 -0400 |
| commit | 4cef59d0d272e08bc779a4fffcacf77902c0d2bb (patch) | |
| tree | f270de0436af960502cefa4dd832a6e906a913c8 | |
| parent | 9ca97d799307ea72e84a5ead55cf7a459590802b (diff) | |
Fix bug when there were both missing values and random effects
| -rw-r--r-- | DESCRIPTION | 2 | ||||
| -rw-r--r-- | R/loglik.R | 2 | ||||
| -rw-r--r-- | tests/testthat/test_occu.R | 17 |
3 files changed, 17 insertions, 4 deletions
diff --git a/DESCRIPTION b/DESCRIPTION index 104660e..03dd646 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ubms Version: 1.1.9005 -Date: 2022-04-12 +Date: 2022-09-19 Title: Bayesian Models for Data from Unmarked Animals using 'Stan' Authors@R: person("Ken", "Kellner", email="contact@kenkellner.com", role=c("cre","aut")) @@ -7,7 +7,7 @@ calculate_par <- function(object, inps, submodel, permute=FALSE){ beta <- extract_posterior(object, paste0("beta_", submodel)) lp <- X %*% t(beta) if(inps$stan_data[[paste0("has_random_",submodel)]]){ - Z <- Z_matrix(inps$submodels[submodel]) + Z <- Z_matrix(inps$submodels[submodel], na.rm=TRUE) b <- extract_posterior(object, paste0("b_", submodel)) lp <- lp + Z %*% t(b) } diff --git a/tests/testthat/test_occu.R b/tests/testthat/test_occu.R index 8a45953..87577ac 100644 --- a/tests/testthat/test_occu.R +++ b/tests/testthat/test_occu.R @@ -71,8 +71,21 @@ test_that("stan_occu handles NA values",{ test_that("extract_log_lik method works",{ ll <- extract_log_lik(fit) expect_is(ll, "matrix") - expect_equal(dim(ll), c(100/2 * 2, numSites(fit@data))) - expect_between(sum(ll), -3500, -3200) + expect_equal(dim(ll), c(100/2 * 2, numSites(fit@data))) + expect_between(sum(ll), -3500, -3200) +}) + +test_that("extract_log_lik works when there are missing values and random effects",{ + skip_on_cran() + skip_on_ci() + umf3 <- umf2 + umf3@siteCovs$group <- sample(letters[1:5], nrow(umf2@siteCovs), replace=TRUE) + fit_na <- suppressWarnings(stan_occu(~x2+(1|group)~1, umf3[1:10,], chains=2, + iter=50, refresh=0)) + expect_is(fit_na, "ubmsFitOccu") + ll <- extract_log_lik(fit_na) + expect_is(ll, "matrix") + expect_equal(dim(ll), c(50,9)) }) test_that("ubmsFitOccu gof method works",{ |