Informative error when all parboot samples fail, fixes #270

2 files changed, 18 insertions, 0 deletions

diff --git a/R/boot.R b/R/boot.R
index 3da4fd0..67f9a42 100644
--- a/R/boot.R
+++ b/R/boot.R
@@ -84,6 +84,9 @@ setMethod("parboot", "unmarkedFit",  function(object, statistic=SSE, nsim=10,
   if(length(t0) == 1) t.star <- matrix(t.star, ncol=1)
 
   failed <- apply(t.star, 1, function(x) any(is.na(x)))
+  if(all(failed)){
+    stop("Model fitting failed in all sims.", call.=FALSE)
+  }
   if(sum(failed) > 0){
     warning(paste0("Model fitting failed in ",sum(failed), " sims."), call.=FALSE)
     t.star <- t.star[!failed,,drop=FALSE]
diff --git a/tests/testthat/test_parboot.R b/tests/testthat/test_parboot.R
index 33a620b..175d0c3 100644
--- a/tests/testthat/test_parboot.R
+++ b/tests/testthat/test_parboot.R
@@ -68,6 +68,21 @@ test_that("parboot handles failing model fits", {
   set.seed(123)
   expect_warning(pb <- parboot(fm, nsim=20, statistic=fail_func))
   expect_equal(nrow(pb@t.star), 13)
+
+  # Error message when all parboot samples are bad
+
+  # force error only when running function on new simulated datasets,
+  # but not for original dataset
+  fail_func <- function(x){
+    if(round(x@AIC, 5) == 23.29768){
+      return(0)
+    } else {
+      stop("fail")
+    }
+  }
+
+  set.seed(123)
+  expect_error(pb2 <- parboot(fm, nsim=20, statistic=fail_func))
 })
 
 test_that("parboot handles failing model fits in parallel", {