diff options
author | Ken Kellner <ken@kenkellner.com> | 2022-12-29 20:53:44 -0500 |
---|---|---|
committer | Ken Kellner <ken@kenkellner.com> | 2022-12-29 20:53:44 -0500 |
commit | 8bf6bf43ca45808a5839e091534c6b4a4b494741 (patch) | |
tree | c1f0dc90de20b6bd9e6748959f77abb3cb577c07 | |
parent | cf49f46e899c3147b2de98b3d729b203b0a5f172 (diff) |
Handle GMM getP when only 1 site, fixes #243
-rw-r--r-- | R/unmarkedFit.R | 2 | ||||
-rw-r--r-- | tests/testthat/test_gmultmix.R | 17 |
2 files changed, 18 insertions, 1 deletions
diff --git a/R/unmarkedFit.R b/R/unmarkedFit.R index a672c6f..d0fac62 100644 --- a/R/unmarkedFit.R +++ b/R/unmarkedFit.R @@ -2008,7 +2008,7 @@ setMethod("getP", "unmarkedFitGMM", p <- aperm(p, c(1,3,2)) cp <- array(as.numeric(NA), c(M, T, R)) - for(t in 1:T) cp[,t,] <- do.call(piFun, list(p[,t,])) + for(t in 1:T) cp[,t,] <- do.call(piFun, list(matrix(p[,t,], M, J))) cp <- aperm(cp, c(1,3,2)) cp <- matrix(cp, nrow=M, ncol=numY(object@data)) diff --git a/tests/testthat/test_gmultmix.R b/tests/testthat/test_gmultmix.R index ad3ee29..8389b66 100644 --- a/tests/testthat/test_gmultmix.R +++ b/tests/testthat/test_gmultmix.R @@ -270,3 +270,20 @@ test_that("R and C++ engines give identical results",{ }) + +test_that("getP works when there is only 1 site", { + y <- matrix(0:3, 5, 4) + siteCovs <- data.frame(x = c(0,2,3,4,1)) + siteCovs[3,1] <- NA + obsCovs <- data.frame(o1 = 1:20, o2 = exp(-5:4)/20) + yrSiteCovs <- data.frame(yr=factor(rep(1:2, 5))) + + umf <- unmarkedFrameGMM(y = y, siteCovs = siteCovs, obsCovs = obsCovs, + yearlySiteCovs = yrSiteCovs, type="removal", numPrimary=2)[1,] + + fm <- expect_warning(gmultmix(~x, ~yr, ~o1 + o2, data = umf, K=7, engine="C")) + + gp <- getP(fm) + expect_equal(dim(gp), c(1,4)) + +}) |