Merge branch 'main' into IDS_hazard

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: unmarked
-Version: 1.4.3.9006
-Date: 2024-12-01
+Version: 1.4.3.9007
+Date: 2025-01-09
 Type: Package
 Title: Models for Data from Unmarked Animals
 Authors@R: c(

R/getP.R

@@ -110,20 +110,12 @@ setMethod("getP_internal", "unmarkedFitOccuMulti", function(object){
   ylist <- object@data@ylist
   S <- length(ylist)
   N <- nrow(ylist[[1]])
-  maxOrder <- object@call$maxOrder
-  if(is.null(maxOrder)) maxOrder <- length(object@data@ylist)
-  dm <- getDesign(object@data,object@detformulas,object@stateformulas, maxOrder=maxOrder)
+  J <- ncol(ylist[[1]])
   pred <- predict(object,'det', level=NULL)
-  dets <- do.call(cbind,lapply(pred,`[`,,1))
-  #ugly mess
+  stopifnot(nrow(pred) == N*J)
   out <- list()
   for (i in 1:S){
-    pmat <- array(NA,dim(ylist[[1]]))
-    for (j in 1:N){
-      ps <- dets[dm$yStart[j]:dm$yStop[j],i]
-      not_na <- !is.na(ylist[[i]][j,])
-      pmat[j,not_na] <- ps
-    }
+    pmat <- matrix(pred[[i]]$Predicted, nrow=N, ncol=J, byrow=TRUE)
     out[[i]] <- pmat
   }
   names(out) <- names(ylist)

R/power.R

@@ -69,7 +69,7 @@ powerAnalysis_internal <- function(object, model, data_sims,
     parallel::clusterEvalQ(cl, library(unmarked))
   }
 
-  sum_dfs <- pbapply::pblapply(data_sims, function(x){
+  sum_dfs <- lapply2(data_sims, function(x){
               fit <- fun(..., data = x)
           }, cl=cl)
   sum_dfs <- lapply(sum_dfs, get_summary_df, effects=effects, nulls=nulls)

tests/testthat/test_occuMS.R

@@ -163,7 +163,7 @@ test_that("occuMS can fit the multinomial model",{
 
   #Check bootstrapped error for predict
   expect_equivalent(as.numeric(pr[[1]][1,]),
-                     c(0.2292279,0.11235796,0.08024297,0.45486279), tol=1e-4)
+                     c(0.2292279,0.11235796,0.08024297,0.45486279), tol=0.1)
 
   #det
   nul <- capture.output(pr <- predict(fit_C, "det"))
@@ -173,7 +173,7 @@ test_that("occuMS can fit the multinomial model",{
   expect_equal(names(pr),c('p[11]','p[12]','p[22]'))
 
   expect_equivalent(as.numeric(pr[[1]][1,]),
-                     c(0.285455,0.07441389,0.18922129,0.48677813), tol=1e-4)
+                     c(0.285455,0.07441389,0.18922129,0.48677813), tol=0.1)
 
   #with new data (some missing)
   newdata <- data.frame(oc1=rnorm(5),oc2=rnorm(5))
@@ -182,7 +182,7 @@ test_that("occuMS can fit the multinomial model",{
   expect_true(is.na(pr[[1]][1,1]))
   expect_equivalent(nrow(pr[[1]]), nrow(newdata))
   expect_equivalent(as.numeric(pr[[1]][2,]),
-                     c(0.343157,0.07801936,0.20967511,0.49916983),tol=1e-4)
+                     c(0.343157,0.07801936,0.20967511,0.49916983),tol=0.1)
 
   newdata <- data.frame(sc1=rnorm(5),sc2=rnorm(5))
   newdata[1,1] <- NA

tests/testthat/test_occuMulti.R

@@ -174,24 +174,41 @@ test_that("occuMulti can handle NAs",{
 
   yna <- y
   yna[[1]][1,1] <- NA
+  det_covs_na <- det_covs
+  det_covs_na$det_cov1[1] <- NA
+  det_covs_na$det_cov2[8] <- NA
+
   expect_warning(umf <- unmarkedFrameOccuMulti(y = yna, siteCovs = occ_covs, obsCovs = det_covs))
 
   #Check correct answer given when missing detection
   expect_warning(fm <- occuMulti(detformulas, stateformulas, data = umf, se=FALSE))
   expect_equivalent(coef(fm)[c(1,7)], c(6.63207,0.35323), tol= 1e-4)
 
   fit <- fitted(fm)
-  expect_true(is.na(fit[[1]][1,1]))
+  expect_true(!is.na(fit[[1]][1,1]))
 
   res <- residuals(fm)
   expect_true(is.na(res[[1]][1,1]))
 
   gp <- getP(fm)
   expect_equal(dim(gp[[1]]), dim(fm@data@ylist[[1]]))
-  expect_true(is.na(gp[[1]][1,1]))
+  expect_true(!is.na(gp[[1]][1,1]))
 
   r <- ranef(fm)
 
+  # When a detection cov is also missing
+  expect_warning(umf <- unmarkedFrameOccuMulti(y = yna, siteCovs = occ_covs, obsCovs = det_covs_na))
+  expect_warning(fm <- occuMulti(detformulas, stateformulas, data = umf, se=FALSE))
+  fit <- fitted(fm)
+  expect_true(is.na(fit[[1]][1,1]))
+  expect_true(is.na(fit[[2]][4,2]))
+  expect_equal(sum(!is.na(fit[[1]])), 9)
+
+  gp <- getP(fm)
+  expect_equal(dim(gp[[1]]), dim(fm@data@ylist[[1]]))
+  expect_true(is.na(gp[[1]][1,1]))
+  expect_true(is.na(gp[[2]][4,2]))
+
   #Check error thrown when all detections are missing
   yna[[1]][1,] <- NA
   expect_warning(umf <- unmarkedFrameOccuMulti(y = yna, siteCovs = occ_covs, obsCovs = det_covs))

tests/testthat/test_powerAnalysis.R

@@ -69,6 +69,8 @@ test_that("custom datasets can be passed to powerAnalysis",{
 test_that("powerAnalysis can be run in parallel",{
   skip_on_cran()
   skip_on_ci()
+  #skip_if(!requireNamespace("pbapply", quietly=TRUE), 
+  #        "pbapply package unavailable")
 
   set.seed(123)
   ef <- list(state=c(0, -0.4), det=0)