diff options
author | Ken Kellner <ken@kenkellner.com> | 2023-03-07 17:19:01 -0500 |
---|---|---|
committer | Ken Kellner <ken@kenkellner.com> | 2023-03-07 17:19:05 -0500 |
commit | 171605ab21dc511de8b53438b1ee6ff6a2336d12 (patch) | |
tree | 68e2ddc9b4f474f725e7e10f8ff2d550d3993aca | |
parent | b484aedaaf1873569559df931ec58426be7e768e (diff) |
Error trap lists provided without names to obsCovs and attempts to use variables in formulas that are not in covariates. Fixes #246
-rw-r--r-- | R/getDesign.R | 10 | ||||
-rw-r--r-- | R/unmarkedFrame.R | 5 | ||||
-rw-r--r-- | tests/testthat/test_occu.R | 6 | ||||
-rw-r--r-- | tests/testthat/test_unmarkedFrame.R | 41 |
4 files changed, 60 insertions, 2 deletions
diff --git a/R/getDesign.R b/R/getDesign.R index 79f20e6..8597b2d 100644 --- a/R/getDesign.R +++ b/R/getDesign.R @@ -23,6 +23,11 @@ setMethod("getDesign", "unmarkedFrame", } else { siteCovs <- siteCovs(umf) } + miss_vars <-all.vars(stateformula)[!all.vars(stateformula) %in% names(siteCovs)] + if(length(miss_vars) > 0){ + stop(paste("Variable(s)", paste(miss_vars, collapse=", "), + "not found in siteCovs"), call.=FALSE) + } X.mf <- model.frame(stateformula, siteCovs, na.action = NULL) X <- model.matrix(stateformula, X.mf) X.offset <- as.vector(model.offset(X.mf)) @@ -49,6 +54,11 @@ setMethod("getDesign", "unmarkedFrame", obsCovs <- cbind(obsCovs, obsNum = as.factor(rep(1:R, M))) } + miss_vars <-all.vars(detformula)[!all.vars(detformula) %in% names(obsCovs)] + if(length(miss_vars) > 0){ + stop(paste("Variable(s)", paste(miss_vars, collapse=", "), + "not found in obsCovs"), call.=FALSE) + } V.mf <- model.frame(detformula, obsCovs, na.action = NULL) V <- model.matrix(detformula, V.mf) V.offset <- as.vector(model.offset(V.mf)) diff --git a/R/unmarkedFrame.R b/R/unmarkedFrame.R index b6a9273..3b8895f 100644 --- a/R/unmarkedFrame.R +++ b/R/unmarkedFrame.R @@ -161,7 +161,10 @@ setClass("unmarkedFrameDSO", #Convert covs provided as list of matrices/dfs to data frame covsToDF <- function(covs, name, obsNum, numSites){ if(!inherits(covs, "list")) return(covs) - + + if(is.null(names(covs)) | any(is.na(names(covs))) | any(names(covs)=="")){ + stop("All elements of list provided to ", name, " argument must be named", call.=FALSE) + } lapply(covs, function(x){ if(!inherits(x, c("matrix", "data.frame"))) stop(paste("At least one element of", name, "is not a matrix or data frame.")) diff --git a/tests/testthat/test_occu.R b/tests/testthat/test_occu.R index 7ea3afe..fdcede8 100644 --- a/tests/testthat/test_occu.R +++ b/tests/testthat/test_occu.R @@ -126,7 +126,11 @@ test_that("occu can fit models with covariates",{ stMat <- fm@estimates@estimates$state@covMat expect_equivalent(detMat, matrix(rep(NA,9),nrow=3)) expect_equivalent(stMat, matrix(rep(NA,4),nrow=2)) - + + # Trap attempts to use a variable in formula that isn't in covariates + fake <- rnorm(3) + expect_error(fm <- occu(~ o1 + o2 ~ fake, data = umf)) + expect_error(fm <- occu(~ o1 + fake ~ o1, data = umf)) }) test_that("occu handles NAs",{ diff --git a/tests/testthat/test_unmarkedFrame.R b/tests/testthat/test_unmarkedFrame.R index b5c6044..c3194fe 100644 --- a/tests/testthat/test_unmarkedFrame.R +++ b/tests/testthat/test_unmarkedFrame.R @@ -214,4 +214,45 @@ test_that("yearlySiteCovs processing works",{ expect_equivalent(dim(as_df2),c(50,25)) }) +test_that("lists provided to obsCovs or yearlySiteCovs must be named", { + y <- matrix(1:27, 3) + sc <- data.frame(x1 = 1:3) + ysc <- list(x2 = matrix(1:9, 3)) + oc <- list(x3 = matrix(1:27, 3)) + + umf1 <- unmarkedMultFrame( + y = y, + siteCovs = sc, + yearlySiteCovs = ysc, + obsCovs = oc, + numPrimary = 3) + expect_is(umf1, "unmarkedMultFrame") + + oc <- list(matrix(1:27, 3)) + umf1 <- expect_error(unmarkedMultFrame( + y = y, + siteCovs = sc, + yearlySiteCovs = ysc, + obsCovs = oc, + numPrimary = 3)) + + oc <- list(x3 = matrix(1:27, 3)) + ysc <- list(matrix(1:9, 3)) + umf1 <- expect_error(unmarkedMultFrame( + y = y, + siteCovs = sc, + yearlySiteCovs = ysc, + obsCovs = oc, + numPrimary = 3)) + + ysc <- list(x2 = matrix(1:9, 3)) + oc <- list(x3 = matrix(1:27, 3), matrix(1:27, 3)) + + umf1 <- expect_error(unmarkedMultFrame( + y = y, + siteCovs = sc, + yearlySiteCovs = ysc, + obsCovs = oc, + numPrimary = 3)) +}) |