diff options
| author | Ken Kellner <ken@kenkellner.com> | 2022-12-29 20:06:50 -0500 |
|---|---|---|
| committer | Ken Kellner <ken@kenkellner.com> | 2022-12-29 20:06:50 -0500 |
| commit | cf49f46e899c3147b2de98b3d729b203b0a5f172 (patch) | |
| tree | 313b00f13b9a2119032edd0dc700ff787357fc50 | |
| parent | 13a58b6b6df28e22adcde5974c072c7c7d2dd234 (diff) | |
Add na.rm option to fitstats example function, fixes #244
| -rw-r--r-- | DESCRIPTION | 2 | ||||
| -rw-r--r-- | man/parboot.Rd | 12 | ||||
| -rw-r--r-- | tests/testthat/test_parboot.R | 22 |
3 files changed, 29 insertions, 7 deletions
diff --git a/DESCRIPTION b/DESCRIPTION index fa00190..5454b14 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: unmarked -Version: 1.2.5.9009 +Version: 1.2.5.9010 Date: 2022-12-29 Type: Package Title: Models for Data from Unmarked Animals diff --git a/man/parboot.Rd b/man/parboot.Rd index 2d95b33..6b6493f 100644 --- a/man/parboot.Rd +++ b/man/parboot.Rd @@ -54,16 +54,16 @@ ltUMF <- with(linetran, { (fm <- distsamp(~area ~habitat, ltUMF)) # Function returning three fit-statistics. -fitstats <- function(fm) { +fitstats <- function(fm, na.rm=TRUE) { observed <- getY(fm@data) expected <- fitted(fm) resids <- residuals(fm) - sse <- sum(resids^2) - chisq <- sum((observed - expected)^2 / expected) - freeTuke <- sum((sqrt(observed) - sqrt(expected))^2) + sse <- sum(resids^2, na.rm=na.rm) + chisq <- sum((observed - expected)^2 / expected, na.rm=na.rm) + freeTuke <- sum((sqrt(observed) - sqrt(expected))^2, na.rm=na.rm) out <- c(SSE=sse, Chisq=chisq, freemanTukey=freeTuke) return(out) - } +} (pb <- parboot(fm, fitstats, nsim=25, report=1)) plot(pb, main="") @@ -84,4 +84,4 @@ colSums(confint(ranef(fm, K=50))) -}
\ No newline at end of file +} diff --git a/tests/testthat/test_parboot.R b/tests/testthat/test_parboot.R index af62658..ca7e5e5 100644 --- a/tests/testthat/test_parboot.R +++ b/tests/testthat/test_parboot.R @@ -18,6 +18,17 @@ fitstats <- function(fm) { return(out) } +fitstats2 <- function(fm, na.rm=TRUE) { + observed <- getY(fm@data) + expected <- fitted(fm) + resids <- residuals(fm) + sse <- sum(resids^2, na.rm=na.rm) + chisq <- sum((observed - expected)^2 / expected, na.rm=na.rm) + freeTuke <- sum((sqrt(observed) - sqrt(expected))^2, na.rm=na.rm) + out <- c(SSE=sse, Chisq=chisq, freemanTukey=freeTuke) + return(out) +} + test_that("parboot works", { pb <- parboot(fm, fitstats, nsim=3) expect_equal(dim(pb@t.star), c(3,3)) @@ -78,3 +89,14 @@ test_that("parboot handles statistic functions with additional arguments", { expect_equal(colnames(pb@t.star), c("res", "y")) expect_true(all(pb@t.star[,"y"]==0.1)) }) + +# To show the fitstats function in parboot example works when there are NAs +test_that("fitstats2 function handles NAs", { + umf2 <- umf + umf2@y[1,1] <- NA + fm2 <- occu(~ o1 + o2 ~ x, data = umf2) + expect_error(expect_warning(show(parboot(fm2, nsim=3, statistic=fitstats2, na.rm=FALSE)))) + pb <- parboot(fm2, nsim=3, statistic=fitstats2, na.rm=TRUE) + expect_is(pb, "parboot") + expect_equal(nrow(pb@t.star), 3) +}) |