diff options
author | Ken Kellner <ken@kenkellner.com> | 2023-03-07 10:29:50 -0500 |
---|---|---|
committer | Ken Kellner <ken@kenkellner.com> | 2023-03-07 10:29:50 -0500 |
commit | 304318512db5c6ad256324f2e506d4c90adba77e (patch) | |
tree | be6907e2ad3702db5ac173de76ffc8177a730216 | |
parent | 40a45fbe202625c93dd1be893891ecd1d8f3bbd3 (diff) |
Get original covariate data in a more reliable way
-rw-r--r-- | R/plotEffects.R | 36 | ||||
-rw-r--r-- | tests/testthat/test_occuTTD.R | 2 |
2 files changed, 20 insertions, 18 deletions
diff --git a/R/plotEffects.R b/R/plotEffects.R index f5be1d8..c77f5aa 100644 --- a/R/plotEffects.R +++ b/R/plotEffects.R @@ -1,16 +1,16 @@ -type_to_covs <- function(umf, type){ - if(type %in% c("state","psi","lam","lambda","sigma","dist")){ - return(methods::slot(umf, "siteCovs")) - } else if(type %in% c("det","rem","fp","b")){ - return(methods::slot(umf, "obsCovs")) - } else if(type %in% c("phi","transition","col","ext","gamma","omega","iota")){ - return(methods::slot(umf, "yearlySiteCovs")) - } - return(NULL) -} - -get_base_newdata <- function(umf, type){ - covs <- type_to_covs(umf, type) +#type_to_covs <- function(umf, type){ +# if(type %in% c("state","psi","lam","lambda","sigma","dist")){ +# return(methods::slot(umf, "siteCovs")) +# } else if(type %in% c("det","rem","fp","b")){ +# return(methods::slot(umf, "obsCovs")) +# } else if(type %in% c("phi","transition","col","ext","gamma","omega","iota")){ +# return(methods::slot(umf, "yearlySiteCovs")) +# } +# return(NULL) +#} + +get_base_newdata <- function(object, type){ + covs <- get_orig_data(object, type) out <- lapply(covs, function(x){ if(is.numeric(x)){ return(median(x, na.rm=TRUE)) @@ -23,8 +23,8 @@ get_base_newdata <- function(umf, type){ as.data.frame(out) } -get_cov_seq <- function(covariate, umf, type){ - cov_values <- type_to_covs(umf, type)[[covariate]] +get_cov_seq <- function(covariate, object, type){ + cov_values <- get_orig_data(object, type)[[covariate]] if(is.numeric(cov_values)){ rng <- range(cov_values, na.rm=TRUE) return(seq(rng[1], rng[2], length.out=100)) @@ -40,12 +40,12 @@ setGeneric("plotEffectsData", function(object, ...) standardGeneric("plotEffects setMethod("plotEffectsData", "unmarkedFit", function(object, type, covariate, level=0.95, ...){ - umf <- umf_to_factor(object@data) - nd <- get_base_newdata(umf, type) + #umf <- umf_to_factor(object@data) + nd <- get_base_newdata(object, type) if(! covariate %in% names(nd)){ stop("Covariate not in this submodel", call.=FALSE) } - values <- get_cov_seq(covariate, umf, type) + values <- get_cov_seq(covariate, object, type) nd <- nd[rep(1, length(values)),,drop=FALSE] nd[[covariate]] <- values diff --git a/tests/testthat/test_occuTTD.R b/tests/testthat/test_occuTTD.R index 0af27a8..0fb7d81 100644 --- a/tests/testthat/test_occuTTD.R +++ b/tests/testthat/test_occuTTD.R @@ -385,6 +385,8 @@ test_that("occuTTD can fit a dynamic model",{ pdf(NULL) plotEffects(fit, 'psi', 'elev') plotEffects(fit, 'col', 'forest') + plotEffects(fit, 'det', 'wind') + plotEffects(fit, 'det', 'obs') dev.off() #Check ranef |