From aa6b7d1ab8408d6d37c13aec8dc05167936f9318 Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Wed, 21 Aug 2024 13:04:13 -0400 Subject: [PATCH] Consolidate summary methods for unmarkedFit --- DESCRIPTION | 4 +- R/IDS.R | 2 +- R/unmarkedFit.R | 73 +++++++++++++++++++++-------------- man/unmarkedFit-class.Rd | 2 - tests/testthat/test_fitList.R | 14 ++++--- tests/testthat/test_occu.R | 9 +++++ 6 files changed, 64 insertions(+), 40 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d4eefb92..68a49aac 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: unmarked -Version: 1.4.1.9014 -Date: 2024-08-20 +Version: 1.4.1.9015 +Date: 2024-08-21 Type: Package Title: Models for Data from Unmarked Animals Authors@R: c( diff --git a/R/IDS.R b/R/IDS.R index 09b6fb72..a8c69e6b 100644 --- a/R/IDS.R +++ b/R/IDS.R @@ -299,7 +299,7 @@ IDS <- function(lambdaformula = ~1, } -setMethod("summary", "unmarkedFitIDS", function(object) +setMethod("summary_internal", "unmarkedFitIDS", function(object) { cat("\nCall:\n") print(object@call) diff --git a/R/unmarkedFit.R b/R/unmarkedFit.R index ad93f95d..2476d6f4 100644 --- a/R/unmarkedFit.R +++ b/R/unmarkedFit.R @@ -164,46 +164,61 @@ setClass("unmarkedFitGPC", setMethod("show", "unmarkedFit", function(object) { - cat("\nCall:\n") - print(object@call) - cat("\n") - show(object@estimates) - cat("AIC:", object@AIC,"\n") - if(!identical(object@opt$convergence, 0L)) - warning("Model did not converge. Try providing starting values or increasing maxit control argment.") + summary(object) }) +setMethod("summary", "unmarkedFit", function(object) +{ + summary_internal(object) +}) -setMethod("summary", "unmarkedFit", function(object) +setGeneric("summary_internal", function(object) standardGeneric("summary_internal")) + +setMethod("summary_internal", "unmarkedFit", function(object) { - cat("\nCall:\n") - print(object@call) - cat("\n") - summaryOut <- summary(object@estimates) - cat("AIC:", object@AIC,"\n") - cat("Number of sites:", sampleSize(object)) - if(length(object@sitesRemoved) > 0) - cat("\nID of sites removed due to NA:", object@sitesRemoved) - cat("\noptim convergence code:", object@opt$convergence) - cat("\noptim iterations:", object@opt$counts[1], "\n") - if(!identical(object@opt$convergence, 0L)) - warning("Model did not converge. Try providing starting values or increasing maxit control argment.") - cat("Bootstrap iterations:", length(object@bootstrapSamples), "\n\n") - invisible(summaryOut) + cat("\nCall:\n") + print(object@call) + cat("\n") + summaryOut <- summary(object@estimates) + cat("AIC:", object@AIC,"\n") + cat("Number of sites:", sampleSize(object)) + if(length(object@sitesRemoved) > 0){ + cat("\nID of sites removed due to NA:", object@sitesRemoved) + } + if(!identical(object@opt$convergence, 0L)){ + warning("Model did not converge. Try providing starting values or increasing maxit control argment.", call.=FALSE) + } + + # Check for potentially bad estimates + if(!is.null(object@opt$hessian)){ + se <- SE(object) + has_na <- any(is.na(se)) | any(is.nan(se)) + big_se <- any(abs(se) >= 5) + if(has_na | big_se){ + warning("Large or missing SE values. Be very cautious using these results.", call.=FALSE) + } + } + + nboot <- length(object@bootstrapSamples) + if(nboot > 0){ + cat("\nBootstrap iterations:", nboot) + } + cat("\n\n") + invisible(summaryOut) }) -setMethod("summary", "unmarkedFitDS", function(object) +setMethod("summary_internal", "unmarkedFitDS", function(object) { - out <- callNextMethod() - cat("Survey design: ", object@data@survey, "-transect", sep="") - cat("\nDetection function:", object@keyfun) - cat("\nUnitsIn:", object@data@unitsIn) - cat("\nUnitsOut:", object@unitsOut, "\n\n") - invisible(out) + out <- callNextMethod() + cat("Survey design: ", object@data@survey, "-transect", sep="") + cat("\nDetection function:", object@keyfun) + cat("\nUnitsIn:", object@data@unitsIn) + cat("\nUnitsOut:", object@unitsOut, "\n\n") + invisible(out) }) diff --git a/man/unmarkedFit-class.Rd b/man/unmarkedFit-class.Rd index 74134649..6e783908 100644 --- a/man/unmarkedFit-class.Rd +++ b/man/unmarkedFit-class.Rd @@ -16,8 +16,6 @@ \alias{update,unmarkedFit-method} \alias{plot,profile,missing-method} \alias{summary,unmarkedFit-method} -\alias{summary,unmarkedFitDS-method} -\alias{summary,unmarkedFitIDS-method} \alias{smoothed} \alias{smoothed,unmarkedFitColExt-method} \alias{projected} diff --git a/tests/testthat/test_fitList.R b/tests/testthat/test_fitList.R index ca913b32..220b5330 100644 --- a/tests/testthat/test_fitList.R +++ b/tests/testthat/test_fitList.R @@ -14,8 +14,8 @@ test_that("fitList operations work",{ fl <- fitList(fm=fm, fm2=fm2) expect_is(fl, "unmarkedFitList") - out <- capture.output(summary(fl)) - expect_equal(out[c(2,23)], rep("Call:", 2)) + out <- capture.output(expect_warning(summary(fl))) + expect_equal(out[c(2,20)], rep("Call:", 2)) cf <- coef(fl) expect_equal(dim(cf), c(2,5)) @@ -33,10 +33,12 @@ test_that("fitList operations work",{ # Raster predict r <- data.frame(x=rep(1:10, 10), y=rep(1:10, each=10), z=rnorm(100)) - r <- raster::rasterFromXYZ(r) - names(r) <- "x" - pr <- predict(fl, type="state", newdata=r) - expect_is(pr, "RasterStack") + if(requireNamespace("raster")){ + r <- raster::rasterFromXYZ(r) + names(r) <- "x" + pr <- predict(fl, type="state", newdata=r) + expect_is(pr, "RasterStack") + } mt <- modSel(fl) out <- capture.output(mt) diff --git a/tests/testthat/test_occu.R b/tests/testthat/test_occu.R index 94b6ea1e..10866140 100644 --- a/tests/testthat/test_occu.R +++ b/tests/testthat/test_occu.R @@ -29,6 +29,15 @@ test_that("occu can fit simple models",{ umf <- unmarkedFrameOccu(y = y) fm <- occu(~ 1 ~ 1, data = umf) + # Expect warning about big SEs + nul <- capture.output(expect_warning(summary(fm))) + + # Check warning about NaN/NA SEs + fm2 <- fm + fm2@estimates@estimates$state@covMat[1,1] <- NaN + fm2@estimates@estimates$det@covMat[1,1] <- 1 + nul <- capture.output(expect_warning(summary(fm2))) + occ <- fm['state'] det <- fm['det']