From 3532a85473c0302eb5d15ac952f36f9a843aeded Mon Sep 17 00:00:00 2001 From: jsocolar Date: Sun, 24 Nov 2024 16:21:01 -0500 Subject: [PATCH 1/7] progress towards newdata checks --- R/make_flocker_data.R | 50 ++++++++++++++++++++++++++++++++----------- 1 file changed, 38 insertions(+), 12 deletions(-) diff --git a/R/make_flocker_data.R b/R/make_flocker_data.R index 6de56fe..9f819ad 100644 --- a/R/make_flocker_data.R +++ b/R/make_flocker_data.R @@ -43,6 +43,9 @@ #' @param n_aug Number of pseudo-species to augment. Only applicable if #' \code{type = "augmented"}. #' @param quiet Hide progress bars and informational messages? +#' @param newdata_checks If TRUE, turn off checks that must pass in order +#' to use the data for model fitting, but not in other contexts (e.g. making +#' predictions or assessing log-likelihoods over new data). #' @return A flocker_data list that can be passed as data to \code{flock()}. #' @export #' @examples @@ -54,7 +57,7 @@ #' ) make_flocker_data <- function(obs, unit_covs = NULL, event_covs = NULL, type = "single", n_aug = NULL, - quiet = FALSE) { + quiet = FALSE, newdata_checks = FALSE) { assertthat::assert_that( type %in% flocker_data_input_types(), msg = paste0("Invalid type argument. Type given as '", type, "' but must ", @@ -111,15 +114,20 @@ make_flocker_data <- function(obs, unit_covs = NULL, event_covs = NULL, } if (type == "single") { - out <- make_flocker_data_static(obs, unit_covs, event_covs, quiet) + out <- make_flocker_data_static( + obs, unit_covs, event_covs, quiet, newdata_checks + ) out$unit_covs <- names(unit_covs) out$event_covs <- names(event_covs) } else if (type == "multi") { - out <- make_flocker_data_dynamic(obs, unit_covs, event_covs, quiet) + out <- make_flocker_data_dynamic( + obs, unit_covs, event_covs, quiet, newdata_checks + ) out$unit_covs <- names(unit_covs[[1]]) out$event_covs <- names(event_covs) } else if (type == "augmented") { - out <- make_flocker_data_augmented(obs, n_aug, unit_covs, event_covs, quiet) + out <- make_flocker_data_augmented( + obs, n_aug, unit_covs, event_covs, quiet, newdata_checks) out$unit_covs <- names(unit_covs) out$event_covs <- names(event_covs) } @@ -141,6 +149,9 @@ make_flocker_data <- function(obs, unit_covs = NULL, event_covs = NULL, #' @param event_covs A named list of I x J matrices, each one corresponding to a covariate #' that varies across repeated sampling events within closure-units #' @param quiet Hide progress bars and informational messages? +#' @param newdata_checks If TRUE, turn off checks that must pass in order +#' to use the data for model fitting, but not in other contexts (e.g. making +#' predictions or assessing log-likelihoods over new data). #' @return A flocker_data list that can be passed as data to \code{flock()}. #' @export #' @examples @@ -150,7 +161,10 @@ make_flocker_data <- function(obs, unit_covs = NULL, event_covs = NULL, #' sfd$unit_covs, #' sfd$event_covs #' ) -make_flocker_data_static <- function(obs, unit_covs = NULL, event_covs = NULL, quiet = FALSE) { +make_flocker_data_static <- function( + obs, unit_covs = NULL, event_covs = NULL, + quiet = FALSE, newdata_checks = FALSE + ) { assertthat::assert_that( length(dim(obs)) == 2, msg = "in a single-season model, obs must have exactly two dimensions" @@ -158,8 +172,11 @@ make_flocker_data_static <- function(obs, unit_covs = NULL, event_covs = NULL, q n_unit <- nrow(obs) n_rep <- ncol(obs) assertthat::assert_that( - n_rep >= 2, - msg = "obs must contain at least two columns." + newdata_checks | (n_rep >= 2), + msg = paste0( + "obs must contain at least two columns unless being used for newdata ", + "(see newdata_checks argument)." + ) ) unique_y <- unique(obs)[!is.na(unique(obs))] assertthat::assert_that( @@ -288,22 +305,31 @@ make_flocker_data_static <- function(obs, unit_covs = NULL, event_covs = NULL, q #' @param event_covs A named list of I x J x K arrays, each one corresponding to #' a covariate that varies across repeated sampling events within closure-units #' @param quiet Hide progress bars and informational messages? +#' @param newdata_checks If TRUE, turn off checks that must pass in order +#' to use the data for model fitting, but not in other contexts (e.g. making +#' predictions or assessing log-likelihoods over new data). #' @return A flocker_data list that can be passed as data to \code{flock()}. #' @export make_flocker_data_dynamic <- function(obs, unit_covs = NULL, event_covs = NULL, - quiet = FALSE) { + quiet = FALSE, newdata_checks = FALSE) { n_year <- nslice(obs) # nslice checks that obs is a 3-D array n_series <- nrow(obs) n_rep <- ncol(obs) n_total <- n_year*n_series*n_rep assertthat::assert_that( - n_year > 1, msg = "obs must contain at least two slices (seasons/years)" + newdata_checks | (n_year > 1), + msg = paste0( + "obs must contain at least two slices (seasons/years) or you must ", + "format data explicitly as newdata (see newdata_checks argument)." + ) ) assertthat::assert_that( - n_rep > 1, - msg = paste0("obs must contain at least two columns (repeat visits to at ", - "least one unit)" + newdata_checks | (n_rep > 1), + msg = paste0( + "obs must contain at least two columns (repeat visits to at ", + "least one unit), or you mus format data explicitly as newdata (see ", + "newdata_checks argument)." ) ) unique_y <- unique(obs)[!is.na(unique(obs))] From 125e03dfd9f54a7ab19eb2275e47828817a47460 Mon Sep 17 00:00:00 2001 From: jsocolar Date: Sun, 24 Nov 2024 17:33:23 -0500 Subject: [PATCH 2/7] refactoring mfd checks --- R/make_flocker_data.R | 719 +++++++++++++++-------------- man/make_flocker_data.Rd | 7 +- man/make_flocker_data_augmented.Rd | 4 +- man/make_flocker_data_dynamic.Rd | 7 +- man/make_flocker_data_static.Rd | 7 +- man/standard_mfd_checks.Rd | 55 +++ 6 files changed, 460 insertions(+), 339 deletions(-) create mode 100644 man/standard_mfd_checks.Rd diff --git a/R/make_flocker_data.R b/R/make_flocker_data.R index 9f819ad..d8da919 100644 --- a/R/make_flocker_data.R +++ b/R/make_flocker_data.R @@ -58,38 +58,8 @@ make_flocker_data <- function(obs, unit_covs = NULL, event_covs = NULL, type = "single", n_aug = NULL, quiet = FALSE, newdata_checks = FALSE) { - assertthat::assert_that( - type %in% flocker_data_input_types(), - msg = paste0("Invalid type argument. Type given as '", type, "' but must ", - "be one of the following: ", - paste(flocker_data_input_types(), collapse = ", ")) - ) - assertthat::assert_that( - !any(names(unit_covs) %in% names(event_covs)) & - !any(names(unit_covs[[1]]) %in% names(event_covs)), - msg = "overlapping names detected between unit_covs and event_covs" - ) - for (i in seq_along(flocker_reserved())) { - assertthat::assert_that( - !any(grepl(flocker_reserved()[i], names(unit_covs))), - msg = paste0("names of unit_covs include a reserved string matching ", - "the following regular expression: ", - flocker_reserved()[i]) - ) - assertthat::assert_that( - !any(grepl(flocker_reserved()[i], names(unit_covs[[1]]))), - msg = paste0("names of unit_covs include a reserved string matching ", - "the following regular expression: ", - flocker_reserved()[i]) - ) - assertthat::assert_that( - !any(grepl(flocker_reserved()[i], names(event_covs))), - msg = paste0("names of event_covs include a reserved string matching ", - "the following regular expression: ", - flocker_reserved()[i]) - ) - } - + standard_mfd_checks(obs, unit_covs, event_covs, type, quiet, newdata_checks) + if (!quiet) { if (type == "single") { message(paste0("Formatting data for a single-season occupancy model. For ", @@ -108,9 +78,6 @@ make_flocker_data <- function(obs, unit_covs = NULL, event_covs = NULL, "error messages should be interpreted in the context of ", "make_flocker_data_augmented")) } - if (!is.null(n_aug) & (type != "augmented")) { - warning(paste0("n_aug is set but will be ignored for type = '", type, "'.")) - } } if (type == "single") { @@ -165,81 +132,11 @@ make_flocker_data_static <- function( obs, unit_covs = NULL, event_covs = NULL, quiet = FALSE, newdata_checks = FALSE ) { - assertthat::assert_that( - length(dim(obs)) == 2, - msg = "in a single-season model, obs must have exactly two dimensions" - ) + standard_mfd_checks(obs, unit_covs, event_covs, "single", quiet, newdata_checks) + n_unit <- nrow(obs) n_rep <- ncol(obs) - assertthat::assert_that( - newdata_checks | (n_rep >= 2), - msg = paste0( - "obs must contain at least two columns unless being used for newdata ", - "(see newdata_checks argument)." - ) - ) - unique_y <- unique(obs)[!is.na(unique(obs))] - assertthat::assert_that( - all(unique_y %in% c(0, 1)), - msg = "obs may only contain the values 0, 1, or NA" - ) - assertthat::assert_that( - !any(is.na(obs[ , 1])), - msg = paste0("obs has NAs in its first column; this is not allowed in ", - "single-season models" - ) - ) - - if (n_rep > 2) { - for (j in 2:(n_rep - 1)) { - the_nas <- is.na(obs[ , j]) - if (any(the_nas)) { - the_nas2 <- which(the_nas) - assertthat::assert_that( - all(is.na(obs[the_nas2, j+1])), - msg = "Some rows of obs have non-trailing NAs" - ) - } - } - } - assertthat::assert_that( - !all(is.na(obs[ , n_rep])), - msg = "The final column of obs contains only NAs." - ) - if (!is.null(unit_covs)) { - assertthat::assert_that( - nrow(unit_covs) == nrow(obs), - msg = "Different numbers of rows found for obs and unit_covs." - ) - assertthat::assert_that( - !any(is.na(unit_covs)), - msg = "A unit covariate contains missing values." - ) - } - if (!is.null(event_covs)) { - assertthat::assert_that( - is_named_list(event_covs), - msg = "event_covs must be NULL or a named list with no duplicate names." - ) - n_event_covs <- length(event_covs) - missing_covs <- vector() - for (ec in 1:n_event_covs) { - assertthat::assert_that( - all.equal(dim(event_covs[[ec]]), dim(obs)), - msg = paste0( - "Dimension mismatch found between obs and event_covs[[", ec, "]]." - ) - ) - missing_covs <- unique(c(missing_covs, which(is.na(event_covs[[ec]])))) - } - if (length(missing_covs) > 0) { - assertthat::assert_that( - all(missing_covs %in% which(is.na(obs))), - msg = paste0("An event covariate contains missing values ", - "at a position where the response is not missing.") - ) - } - } + if (is.null(event_covs)) { n_trial <- rowSums(!is.na(obs)) n_suc <- rowSums(obs, na.rm = T) @@ -312,157 +209,14 @@ make_flocker_data_static <- function( #' @export make_flocker_data_dynamic <- function(obs, unit_covs = NULL, event_covs = NULL, quiet = FALSE, newdata_checks = FALSE) { + + standard_mfd_checks(obs, unit_covs, event_covs, "multi", quiet, newdata_checks) + n_year <- nslice(obs) # nslice checks that obs is a 3-D array n_series <- nrow(obs) n_rep <- ncol(obs) n_total <- n_year*n_series*n_rep - assertthat::assert_that( - newdata_checks | (n_year > 1), - msg = paste0( - "obs must contain at least two slices (seasons/years) or you must ", - "format data explicitly as newdata (see newdata_checks argument)." - ) - ) - assertthat::assert_that( - newdata_checks | (n_rep > 1), - msg = paste0( - "obs must contain at least two columns (repeat visits to at ", - "least one unit), or you mus format data explicitly as newdata (see ", - "newdata_checks argument)." - ) - ) - unique_y <- unique(obs)[!is.na(unique(obs))] - assertthat::assert_that( - all(unique_y %in% c(0, 1)), - msg = "obs may only contain the values 0, 1, or NA" - ) - - # Check that no NAs are non-trailing across columns (i.e. reps within series- - # years) - for (k in seq(n_year)) { - for (j in 1:(n_rep - 1)) { - the_nas <- is.na(obs[ , j, k]) - if (any(the_nas)) { - the_nas2 <- which(the_nas) - assertthat::assert_that( - all(is.na(obs[the_nas2, j+1, k])), - msg = paste0("Some rows/slices of obs have non-trailing NAs ", - "across columns." - ) - ) - } - } - } - - # Check that the first and final reps contain at least one non-NA - assertthat::assert_that( - !all(is.na(obs[ , 1, ])), - msg = "The first column (replicate visit) of obs contains only NAs." - ) - assertthat::assert_that( - !all(is.na(obs[ , n_rep, ])), - msg = "The final column (replicate visit) of obs contains only NAs." - ) - assertthat::assert_that( - is.null(unit_covs) | is.list(unit_covs), - msg = "unit_covs must be a list or NULL." - ) - assertthat::assert_that( - is.null(event_covs) | is_named_list(event_covs), - msg = "event_covs must be a named list or NULL." - ) - if (all(is.na(obs[ , , 1]))) { - warning("The first slice (season) of obs contains only NAs") - } - if (all(is.na(obs[ , , n_year]))) { - warning("The final slice (season) of obs contains only NAs") - } - if (!is.null(unit_covs)) { - assertthat::assert_that( - length(unit_covs) == n_year, - msg = "If provided, unit_covs must have length equal to dim(obs)[3]" - ) - for (k in 1:n_year) { - assertthat::assert_that( - is.data.frame(unit_covs[[k]]), - msg = "All elements of unit_covs must be dataframes." - ) - assertthat::assert_that( - identical(dim(unit_covs[[k]]), dim(unit_covs[[1]])), - msg = "All elements of unit_covs must have identical dimensions." - ) - assertthat::assert_that( - identical(names(unit_covs[[k]]), names(unit_covs[[1]])), - msg = "All elements of unit_covs must have identical column names." - ) - assertthat::assert_that( - !any(is.na(unit_covs[[k]])), - msg = paste0("NA unit covariates are not allowed in dynamic models. ", - "It is safe to impute dummy values in the following ", - "circumstances.", - "Note, however, that imputing values can interfere ", - "with brms's default behavior of centering the ", - "columns of the design matrix. To avoid nonintuitive ", - "prior specifications for the intercepts, impute the ", - "mean value rather than any other choice of dummy.", - "1) the model uses explicit initial occupancy ", - "probabilities, and a unit covariate is used only for ", - "initial occupancy and not for detection, ", - "colonization or extinction; impute values for years ", - "after the first. ", - "2) the model uses explicit initial occupancy ", - "probabilities, and a unit covariate is used only for ", - "colonization/extinction and not for initial ", - "occupancy or detection; impute values for the first ", - "year. ", - "3) a unit covariate is used only for detection; ", - "impute values for the first visit at units with no ", - "visits. ", - "4) a unit covariate for colonization or extinction ", - "is unavailable at a timestep with no observed data ", - "at the end of the timeseries, or a timestep that is ", - "part of a block of timesteps with no observed data ", - "reaching uninterrupted to the and of the timeseries, ", - "and inference on likely occupancy probabilties is ", - "not desired at any of those timesteps; impute values ", - "for the trailing block of timesteps with no observations.") - ) - } - assertthat::assert_that( - nrow(unit_covs[[1]]) == n_series, - msg = "each element of unit_covs must have the same number of rows as obs" - ) - } - if (!is.null(event_covs)) { - assertthat::assert_that( - is_named_list(event_covs), - msg = "If provided, event_covs must be a named list." - ) - n_event_covs <- length(event_covs) - missing_covs <- vector() - for (ec in 1:n_event_covs) { - assertthat::assert_that( - all.equal(dim(event_covs[[ec]]), dim(obs)), - msg = paste0("Dimension mismatch found between obs and event_covs[[", ec, "]].") - ) - missing_covs <- unique(c(missing_covs, which(is.na(event_covs[[ec]])))) - } - if (length(missing_covs) > 0) { - assertthat::assert_that( - all(missing_covs %in% which(is.na(obs))), - msg = paste0("An event covariate contains missing values ", - "at a position where the response is not missing.") - ) - } - } - assertthat::assert_that( - !is.null(event_covs), - msg = paste0("Construction alert! The model contains no event covariates. ", - "This is fine, but for now please add a dummy event covariate.", - "You do not need to use this covariate in your model formula.") - ) - # All unit covs are guaranteed to be not NA provided the unit is not part of, # a block of trailing NAs, and all event covs are not NA provided that the # response is not missing @@ -470,11 +224,6 @@ make_flocker_data_dynamic <- function(obs, unit_covs = NULL, event_covs = NULL, # add dummy data for the first visit to each unit, whether the unit was # sampled or not, unless the unit is part of a block of trailing NAs. n_year_obs <- apply(obs[ , 1, ], 1, max_position_not_na) - assertthat::assert_that( - !any(n_year_obs == 0), - msg = paste0("at least one series (i.e. row; generally a site or a ", - "species-site) has no observations at any timestep") - ) for (i in seq_along(n_year_obs)) { obs[i, 1, 1 : n_year_obs[i]][is.na(obs[i, 1, 1 : n_year_obs[i]])] <- -99 } @@ -612,7 +361,7 @@ make_flocker_data_dynamic <- function(obs, unit_covs = NULL, event_covs = NULL, ##### make_flocker_data_augmented ##### -#' #' Format data for data-augmented occupancy model, to be passed to +#' Format data for data-augmented occupancy model, to be passed to #' \code{flock()}. #' @param obs An I x J x K array where rows I are sites, columns J are #' repeat sampling events, and slices K are species. Allowable values are 1 @@ -628,82 +377,9 @@ make_flocker_data_dynamic <- function(obs, unit_covs = NULL, event_covs = NULL, #' @export make_flocker_data_augmented <- function(obs, n_aug, site_covs = NULL, event_covs = NULL, quiet = FALSE) { - assertthat::assert_that( - length(dim(obs)) == 3, - msg = "obs must have exactly three dimensions." - ) - assertthat::assert_that( - is_one_pos_int(n_aug), - msg = "n_aug must be a positive integer" - ) + standard_mfd_checks(obs, unit_covs, event_covs, "augmented", quiet, newdata_checks) obs1 <- obs[,,1] - na_obs <- which(is.na(obs1)) - for (i in 2:dim(obs)[3]) { - na_obs_i <- which(is.na(obs[,,i])) - assertthat::assert_that( - identical(na_obs, na_obs_i), - msg = "Different species have different sampling events NA" - ) - } n_rep <- ncol(obs1) - assertthat::assert_that( - n_rep >= 2, - msg = "obs must contain at least two columns." - ) - assertthat::assert_that( - all(unique(obs) %in% c(0, 1, NA)), - msg = "obs contains values other than 0, 1, NA." - ) - assertthat::assert_that( - all(!is.na(obs1[ , 1])), - msg = "Some sites have NAs on the first sampling event." - ) - if (n_rep > 2) { - for (j in 2:(n_rep - 1)) { - the_nas <- is.na(obs1[ , j]) - if (any(the_nas)) { - the_nas2 <- which(the_nas) - assertthat::assert_that(all(is.na(obs1[the_nas2, j+1])), - msg = "Some sites have non-trailing NA visits." - ) - } - } - } - assertthat::assert_that(!all(is.na(obs1[ , n_rep])), - msg = "The final repeat event contains only NAs." - ) - - if (!is.null(site_covs)) { - assertthat::assert_that( - nrow(site_covs) == nrow(obs1), - msg = "Different numbers of rows found for obs and site_covs." - ) - assertthat::assert_that( - all(!is.na(site_covs)), - msg = "A site covariate contains missing values." - ) - } - if (!is.null(event_covs)) { - assertthat::assert_that( - is_named_list(event_covs), - msg = "event_covs must be NULL or a named list with unique names" - ) - n_event_covs <- length(event_covs) - missing_covs <- vector() - for (ec in 1:n_event_covs) { - if (!identical(dim(event_covs[[ec]]), dim(obs1))) { - stop(paste0("Dimension mismatch found between obs and event_covs[[", ec, "]].")) - } - missing_covs <- unique(c(missing_covs, which(is.na(event_covs[[ec]])))) - } - if (length(missing_covs) > 0) { - if (!all(missing_covs %in% which(is.na(obs1)))) { - stop(paste0("An event covariate contains missing values ", - "at a position where the response is not missing.")) - } - } - } - n_sp_obs <- dim(obs)[3] n_sp <- n_sp_obs + n_aug n_site <- dim(obs)[1] @@ -766,3 +442,378 @@ make_flocker_data_augmented <- function(obs, n_aug, site_covs = NULL, out } + +##### mfd input checking ##### +#' input checking for make_flocker_data +#' @inheritParams make_flocker_data +standard_mfd_checks <- function( + obs, unit_covs, event_covs, type, quiet, newdata_checks +) { + + unique_y <- unique(obs) + assertthat::assert_that( + all(unique_y %in% c(0, 1, NA)), + msg = "obs may only contain the values 0, 1, or NA" + ) + + assertthat::assert_that( + is.null(event_covs) | is_named_list(event_covs), + msg = "event_covs must be a named list or NULL" + ) + + assertthat::assert_that( + type %in% flocker_data_input_types(), + msg = paste0("Invalid type argument. Type given as '", type, "' but must ", + "be one of the following: ", + paste(flocker_data_input_types(), collapse = ", ")) + ) + + assertthat::assert_that( + !any(names(unit_covs) %in% names(event_covs)) & + !any(names(unit_covs[[1]]) %in% names(event_covs)), + msg = "overlapping names detected between unit_covs and event_covs" + ) + + for (i in seq_along(flocker_reserved())) { + assertthat::assert_that( + !any(grepl(flocker_reserved()[i], names(unit_covs))), + msg = paste0("names of unit_covs include a reserved string matching ", + "the following regular expression: ", + flocker_reserved()[i]) + ) + assertthat::assert_that( + !any(grepl(flocker_reserved()[i], names(unit_covs[[1]]))), + msg = paste0("names of unit_covs include a reserved string matching ", + "the following regular expression: ", + flocker_reserved()[i]) + ) + assertthat::assert_that( + !any(grepl(flocker_reserved()[i], names(event_covs))), + msg = paste0("names of event_covs include a reserved string matching ", + "the following regular expression: ", + flocker_reserved()[i]) + ) + } + + assertthat::assert_that( + is_one_logical(quiet), + msg = "quiet must be TRUE or FALSE" + ) + assertthat::assert_that( + is_one_logical(newdata_checks), + msg = "newdata_checks must be TRUE or FALSE" + ) + + #### type specific checks #### + if (!quiet & !is.null(n_aug) & (type != "augmented")) { + warning(paste0("n_aug is set but will be ignored for type = '", type, "'.")) + } + + #### single checks #### + if(type == "single") { + n_unit <- nrow(obs) + n_rep <- ncol(obs) + + assertthat::assert_that( + length(dim(obs)) == 2, + msg = "in a single-season model, obs must have exactly two dimensions" + ) + + assertthat::assert_that( + !any(is.na(obs[ , 1])), + msg = paste0("obs has NAs in its first column; this is not allowed in ", + "single-season models" + ) + ) + + assertthat::assert_that( + newdata_checks | (n_rep >= 2), + msg = paste0( + "obs must contain at least two columns unless being used for newdata ", + "(see newdata_checks argument)." + ) + ) + + if (n_rep > 2) { + for (j in 2:(n_rep - 1)) { + the_nas <- is.na(obs[ , j]) + if (any(the_nas)) { + the_nas2 <- which(the_nas) + assertthat::assert_that( + all(is.na(obs[the_nas2, j+1])), + msg = "Some rows of obs have non-trailing NAs" + ) + } + } + } + assertthat::assert_that( + !all(is.na(obs[ , n_rep])), + msg = "The final column of obs contains only NAs." + ) + if (!is.null(unit_covs)) { + assertthat::assert_that( + nrow(unit_covs) == nrow(obs), + msg = "Different numbers of rows found for obs and unit_covs." + ) + assertthat::assert_that( + !any(is.na(unit_covs)), + msg = "A unit covariate contains missing values." + ) + } + if (!is.null(event_covs)) { + assertthat::assert_that( + is_named_list(event_covs), + msg = "event_covs must be NULL or a named list with no duplicate names." + ) + n_event_covs <- length(event_covs) + missing_covs <- vector() + for (ec in 1:n_event_covs) { + assertthat::assert_that( + all.equal(dim(event_covs[[ec]]), dim(obs)), + msg = paste0( + "Dimension mismatch found between obs and event_covs[[", ec, "]]." + ) + ) + missing_covs <- unique(c(missing_covs, which(is.na(event_covs[[ec]])))) + } + if (length(missing_covs) > 0) { + assertthat::assert_that( + all(missing_covs %in% which(is.na(obs))), + msg = paste0("An event covariate contains missing values ", + "at a position where the response is not missing.") + ) + } + } + } + + #### multi checks #### + if(type == "multi") { + n_year <- nslice(obs) # nslice checks that obs is a 3-D array + n_series <- nrow(obs) + n_rep <- ncol(obs) + n_total <- n_year*n_series*n_rep + + assertthat::assert_that( + newdata_checks | (n_year > 1), + msg = paste0( + "obs must contain at least two slices (seasons/years) or you must ", + "format data explicitly as newdata (see newdata_checks argument)." + ) + ) + assertthat::assert_that( + newdata_checks | (n_rep > 1), + msg = paste0( + "obs must contain at least two columns (repeat visits to at ", + "least one unit), or you mus format data explicitly as newdata (see ", + "newdata_checks argument)." + ) + ) + + # Check that no NAs are non-trailing across columns (i.e. reps within series- + # years) + for (k in seq(n_year)) { + for (j in 1:(n_rep - 1)) { + the_nas <- is.na(obs[ , j, k]) + if (any(the_nas)) { + the_nas2 <- which(the_nas) + assertthat::assert_that( + all(is.na(obs[the_nas2, j+1, k])), + msg = paste0("Some rows/slices of obs have non-trailing NAs ", + "across columns." + ) + ) + } + } + } + + # Check that the first and final reps contain at least one non-NA + assertthat::assert_that( + !all(is.na(obs[ , 1, ])), + msg = "The first column (replicate visit) of obs contains only NAs." + ) + assertthat::assert_that( + (!all(is.na(obs[ , n_rep, ]))) | newdata_checks, + msg = "The final column (replicate visit) of obs contains only NAs." + ) + assertthat::assert_that( + is.null(unit_covs) | is.list(unit_covs), + msg = "unit_covs must be a list or NULL." + ) + assertthat::assert_that( + is.null(event_covs) | is_named_list(event_covs), + msg = "event_covs must be a named list or NULL." + ) + if (all(is.na(obs[ , , 1]))) { + warning("The first slice (season) of obs contains only NAs") + } + if (all(is.na(obs[ , , n_year]))) { + warning("The final slice (season) of obs contains only NAs") + } + if (!is.null(unit_covs)) { + assertthat::assert_that( + length(unit_covs) == n_year, + msg = "If provided, unit_covs must have length equal to dim(obs)[3]" + ) + for (k in 1:n_year) { + assertthat::assert_that( + is.data.frame(unit_covs[[k]]), + msg = "All elements of unit_covs must be dataframes." + ) + assertthat::assert_that( + identical(dim(unit_covs[[k]]), dim(unit_covs[[1]])), + msg = "All elements of unit_covs must have identical dimensions." + ) + assertthat::assert_that( + identical(names(unit_covs[[k]]), names(unit_covs[[1]])), + msg = "All elements of unit_covs must have identical column names." + ) + assertthat::assert_that( + !any(is.na(unit_covs[[k]])), + msg = paste0("NA unit covariates are not allowed in dynamic models. ", + "It is safe to impute dummy values in the following ", + "circumstances.", + "Note, however, that imputing values can interfere ", + "with brms's default behavior of centering the ", + "columns of the design matrix. To avoid nonintuitive ", + "prior specifications for the intercepts, impute the ", + "mean value rather than any other choice of dummy.", + "1) the model uses explicit initial occupancy ", + "probabilities, and a unit covariate is used only for ", + "initial occupancy and not for detection, ", + "colonization or extinction; impute values for years ", + "after the first. ", + "2) the model uses explicit initial occupancy ", + "probabilities, and a unit covariate is used only for ", + "colonization/extinction and not for initial ", + "occupancy or detection; impute values for the first ", + "year. ", + "3) a unit covariate is used only for detection; ", + "impute values for the first visit at units with no ", + "visits. ", + "4) a unit covariate for colonization or extinction ", + "is unavailable at a timestep with no observed data ", + "at the end of the timeseries, or a timestep that is ", + "part of a block of timesteps with no observed data ", + "reaching uninterrupted to the and of the timeseries, ", + "and inference on likely occupancy probabilties is ", + "not desired at any of those timesteps; impute values ", + "for the trailing block of timesteps with no observations.") + ) + } + assertthat::assert_that( + nrow(unit_covs[[1]]) == n_series, + msg = "each element of unit_covs must have the same number of rows as obs" + ) + } + if (!is.null(event_covs)) { + n_event_covs <- length(event_covs) + missing_covs <- vector() + for (ec in 1:n_event_covs) { + assertthat::assert_that( + all.equal(dim(event_covs[[ec]]), dim(obs)), + msg = paste0("Dimension mismatch found between obs and event_covs[[", ec, "]].") + ) + missing_covs <- unique(c(missing_covs, which(is.na(event_covs[[ec]])))) + } + assertthat::assert_that( + all(missing_covs %in% which(is.na(obs))), + msg = paste0("An event covariate contains missing values ", + "at a position where the response is not missing.") + ) + } + assertthat::assert_that( + !is.null(event_covs), + msg = paste0("Construction alert! The model contains no event covariates. ", + "This is fine, but for now please add a dummy event covariate.", + "You do not need to use this covariate in your model formula.") + ) + + + n_year_obs <- apply(obs[ , 1, ], 1, max_position_not_na) + assertthat::assert_that( + !any(n_year_obs == 0), + msg = paste0("at least one series (i.e. row; generally a site or a ", + "species-site) has no observations at any timestep") + ) + } + + #### augmented checks #### + if(type == "augmented"){ + obs1 <- obs[,,1] + n_rep <- ncol(obs1) + na_obs <- which(is.na(obs1)) + + assertthat::assert_that( + length(dim(obs)) == 3, + msg = "obs must have exactly three dimensions." + ) + assertthat::assert_that( + is_one_pos_int(n_aug), + msg = "n_aug must be a positive integer" + ) + + for (i in 2:dim(obs)[3]) { + na_obs_i <- which(is.na(obs[,,i])) + assertthat::assert_that( + identical(na_obs, na_obs_i), + msg = "Different species have different sampling events NA" + ) + } + + assertthat::assert_that( + n_rep >= 2, + msg = "obs must contain at least two columns." + ) + + assertthat::assert_that( + all(!is.na(obs1[ , 1])), + msg = "Some sites have NAs on the first sampling event." + ) + if (n_rep > 2) { + for (j in 2:(n_rep - 1)) { + the_nas <- is.na(obs1[ , j]) + if (any(the_nas)) { + the_nas2 <- which(the_nas) + assertthat::assert_that(all(is.na(obs1[the_nas2, j+1])), + msg = "Some sites have non-trailing NA visits." + ) + } + } + } + assertthat::assert_that(!all(is.na(obs1[ , n_rep])), + msg = "The final repeat event contains only NAs." + ) + + if (!is.null(site_covs)) { + assertthat::assert_that( + nrow(site_covs) == nrow(obs1), + msg = "Different numbers of rows found for obs and site_covs." + ) + assertthat::assert_that( + all(!is.na(site_covs)), + msg = "A site covariate contains missing values." + ) + } + if (!is.null(event_covs)) { + assertthat::assert_that( + is_named_list(event_covs), + msg = "event_covs must be NULL or a named list with unique names" + ) + n_event_covs <- length(event_covs) + missing_covs <- vector() + for (ec in 1:n_event_covs) { + assertthat::assert_that( + identical(dim(event_covs[[ec]]), dim(obs1)), + msg = paste0("Dimension mismatch found between obs and event_covs[[", ec, "]].") + ) + missing_covs <- unique(c(missing_covs, which(is.na(event_covs[[ec]])))) + } + assertthat::assert_that( + all(missing_covs %in% which(is.na(obs1))), + msg = paste0("An event covariate contains missing values ", + "at a position where the response is not missing.") + ) + } + } +} + diff --git a/man/make_flocker_data.Rd b/man/make_flocker_data.Rd index bef308f..524c646 100644 --- a/man/make_flocker_data.Rd +++ b/man/make_flocker_data.Rd @@ -10,7 +10,8 @@ make_flocker_data( event_covs = NULL, type = "single", n_aug = NULL, - quiet = FALSE + quiet = FALSE, + newdata_checks = FALSE ) } \arguments{ @@ -55,6 +56,10 @@ data-augmentation for never-observed pseudospecies.} \code{type = "augmented"}.} \item{quiet}{Hide progress bars and informational messages?} + +\item{newdata_checks}{If TRUE, turn off checks that must pass in order +to use the data for model fitting, but not in other contexts (e.g. making +predictions or assessing log-likelihoods over new data).} } \value{ A flocker_data list that can be passed as data to \code{flock()}. diff --git a/man/make_flocker_data_augmented.Rd b/man/make_flocker_data_augmented.Rd index f339cdd..c6902e6 100644 --- a/man/make_flocker_data_augmented.Rd +++ b/man/make_flocker_data_augmented.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/make_flocker_data.R \name{make_flocker_data_augmented} \alias{make_flocker_data_augmented} -\title{#' Format data for data-augmented occupancy model, to be passed to +\title{Format data for data-augmented occupancy model, to be passed to \code{flock()}.} \usage{ make_flocker_data_augmented( @@ -33,6 +33,6 @@ covariate that varies across repeated sampling events within sites} A flocker_data list that can be passed as data to \code{flocker()}. } \description{ -#' Format data for data-augmented occupancy model, to be passed to +Format data for data-augmented occupancy model, to be passed to \code{flock()}. } diff --git a/man/make_flocker_data_dynamic.Rd b/man/make_flocker_data_dynamic.Rd index 13f389e..1677543 100644 --- a/man/make_flocker_data_dynamic.Rd +++ b/man/make_flocker_data_dynamic.Rd @@ -9,7 +9,8 @@ make_flocker_data_dynamic( obs, unit_covs = NULL, event_covs = NULL, - quiet = FALSE + quiet = FALSE, + newdata_checks = FALSE ) } \arguments{ @@ -29,6 +30,10 @@ dataframes must have I rows.} a covariate that varies across repeated sampling events within closure-units} \item{quiet}{Hide progress bars and informational messages?} + +\item{newdata_checks}{If TRUE, turn off checks that must pass in order +to use the data for model fitting, but not in other contexts (e.g. making +predictions or assessing log-likelihoods over new data).} } \value{ A flocker_data list that can be passed as data to \code{flock()}. diff --git a/man/make_flocker_data_static.Rd b/man/make_flocker_data_static.Rd index d896dac..1d6afb1 100644 --- a/man/make_flocker_data_static.Rd +++ b/man/make_flocker_data_static.Rd @@ -9,7 +9,8 @@ make_flocker_data_static( obs, unit_covs = NULL, event_covs = NULL, - quiet = FALSE + quiet = FALSE, + newdata_checks = FALSE ) } \arguments{ @@ -24,6 +25,10 @@ across repeated sampling events within closure-units.} that varies across repeated sampling events within closure-units} \item{quiet}{Hide progress bars and informational messages?} + +\item{newdata_checks}{If TRUE, turn off checks that must pass in order +to use the data for model fitting, but not in other contexts (e.g. making +predictions or assessing log-likelihoods over new data).} } \value{ A flocker_data list that can be passed as data to \code{flock()}. diff --git a/man/standard_mfd_checks.Rd b/man/standard_mfd_checks.Rd new file mode 100644 index 0000000..6511306 --- /dev/null +++ b/man/standard_mfd_checks.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/make_flocker_data.R +\name{standard_mfd_checks} +\alias{standard_mfd_checks} +\title{input checking for make_flocker_data} +\usage{ +standard_mfd_checks(obs, unit_covs, event_covs, type, quiet, newdata_checks) +} +\arguments{ +\item{obs}{If \code{type = "single"}, an I x J matrix-like object where +closure is assumed across rows and columns are repeated sampling events. + If \code{type = "multi"}, an I x J x K array where rows are sites or +species-sites, columns are repeated sampling events, and slices along the +third dimension are seasons. Allowable values are 1 (detection), 0 (no +detection), and NA (no sampling event). + If \code{type = "augmented"}, an L x J x K array where rows L are sites, +columns J are repeat sampling events, and slices K are species. + The data must be packed so that, for a given unit (site, site-species, +site-timestep, site-species-timestep) all realized visits come before any +missing visits (NAs are trailing within their rows).} + +\item{unit_covs}{If \code{type = "single"} a dataframe of covariates for each +closure-unit that are constant across repeated sampling events within units. + If \code{type = "multi"}, a list of such dataframes, one per timestep. All +dataframes must have identical column names and types, and all +dataframes must have I rows. + If \code{type = "augmented"}, a dataframe of covariates for each site that +are constant across repeated sampling events within sites (no dependence on +species is allowed).} + +\item{event_covs}{If \code{type = "single"}, a named list of I x J matrices, +each one corresponding to a covariate that varies across repeated sampling +events within closure-units. + If \code{type = "multi"}, a named list of I x J x K arrays, each one +corresponding to a covariate that varies across repeated sampling events +within closure-units. + If \code{type = "augmented"}, a named list of L x J matrices, each one +corresponding to a covariate that varies across repeated sampling events +within sites (no dependence on species is allowed).} + +\item{type}{The type of occupancy model desired. Options are: +\code{"single"} for a single_season model, +\code{"multi"} for a multi-season (dynamic) model, or +\code{"augmented"} for a single-season multi-species model with +data-augmentation for never-observed pseudospecies.} + +\item{quiet}{Hide progress bars and informational messages?} + +\item{newdata_checks}{If TRUE, turn off checks that must pass in order +to use the data for model fitting, but not in other contexts (e.g. making +predictions or assessing log-likelihoods over new data).} +} +\description{ +input checking for make_flocker_data +} From c3b2759d94cc548860bee64bbdaa56fe39be6ea3 Mon Sep 17 00:00:00 2001 From: jsocolar Date: Sun, 24 Nov 2024 17:49:33 -0500 Subject: [PATCH 3/7] updated args --- R/make_flocker_data.R | 10 +++++----- man/standard_mfd_checks.Rd | 13 ++++++++++++- 2 files changed, 17 insertions(+), 6 deletions(-) diff --git a/R/make_flocker_data.R b/R/make_flocker_data.R index d8da919..b23788b 100644 --- a/R/make_flocker_data.R +++ b/R/make_flocker_data.R @@ -58,7 +58,7 @@ make_flocker_data <- function(obs, unit_covs = NULL, event_covs = NULL, type = "single", n_aug = NULL, quiet = FALSE, newdata_checks = FALSE) { - standard_mfd_checks(obs, unit_covs, event_covs, type, quiet, newdata_checks) + standard_mfd_checks(obs, unit_covs, event_covs, type, n_aug, quiet, newdata_checks) if (!quiet) { if (type == "single") { @@ -132,7 +132,7 @@ make_flocker_data_static <- function( obs, unit_covs = NULL, event_covs = NULL, quiet = FALSE, newdata_checks = FALSE ) { - standard_mfd_checks(obs, unit_covs, event_covs, "single", quiet, newdata_checks) + standard_mfd_checks(obs, unit_covs, event_covs, "single", n_aug, quiet, newdata_checks) n_unit <- nrow(obs) n_rep <- ncol(obs) @@ -210,7 +210,7 @@ make_flocker_data_static <- function( make_flocker_data_dynamic <- function(obs, unit_covs = NULL, event_covs = NULL, quiet = FALSE, newdata_checks = FALSE) { - standard_mfd_checks(obs, unit_covs, event_covs, "multi", quiet, newdata_checks) + standard_mfd_checks(obs, unit_covs, event_covs, "multi", n_aug, quiet, newdata_checks) n_year <- nslice(obs) # nslice checks that obs is a 3-D array n_series <- nrow(obs) @@ -377,7 +377,7 @@ make_flocker_data_dynamic <- function(obs, unit_covs = NULL, event_covs = NULL, #' @export make_flocker_data_augmented <- function(obs, n_aug, site_covs = NULL, event_covs = NULL, quiet = FALSE) { - standard_mfd_checks(obs, unit_covs, event_covs, "augmented", quiet, newdata_checks) + standard_mfd_checks(obs, unit_covs, event_covs, "augmented", n_aug, quiet, newdata_checks) obs1 <- obs[,,1] n_rep <- ncol(obs1) n_sp_obs <- dim(obs)[3] @@ -447,7 +447,7 @@ make_flocker_data_augmented <- function(obs, n_aug, site_covs = NULL, #' input checking for make_flocker_data #' @inheritParams make_flocker_data standard_mfd_checks <- function( - obs, unit_covs, event_covs, type, quiet, newdata_checks + obs, unit_covs, event_covs, type, n_aug, quiet, newdata_checks ) { unique_y <- unique(obs) diff --git a/man/standard_mfd_checks.Rd b/man/standard_mfd_checks.Rd index 6511306..d72098e 100644 --- a/man/standard_mfd_checks.Rd +++ b/man/standard_mfd_checks.Rd @@ -4,7 +4,15 @@ \alias{standard_mfd_checks} \title{input checking for make_flocker_data} \usage{ -standard_mfd_checks(obs, unit_covs, event_covs, type, quiet, newdata_checks) +standard_mfd_checks( + obs, + unit_covs, + event_covs, + type, + n_aug, + quiet, + newdata_checks +) } \arguments{ \item{obs}{If \code{type = "single"}, an I x J matrix-like object where @@ -44,6 +52,9 @@ within sites (no dependence on species is allowed).} \code{"augmented"} for a single-season multi-species model with data-augmentation for never-observed pseudospecies.} +\item{n_aug}{Number of pseudo-species to augment. Only applicable if +\code{type = "augmented"}.} + \item{quiet}{Hide progress bars and informational messages?} \item{newdata_checks}{If TRUE, turn off checks that must pass in order From 1c6390da6ef3e2fed21aa4a2498f8b3414ea8dc4 Mon Sep 17 00:00:00 2001 From: jsocolar Date: Sun, 24 Nov 2024 17:55:55 -0500 Subject: [PATCH 4/7] more tinkering --- R/make_flocker_data.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/make_flocker_data.R b/R/make_flocker_data.R index b23788b..5c566e4 100644 --- a/R/make_flocker_data.R +++ b/R/make_flocker_data.R @@ -132,7 +132,7 @@ make_flocker_data_static <- function( obs, unit_covs = NULL, event_covs = NULL, quiet = FALSE, newdata_checks = FALSE ) { - standard_mfd_checks(obs, unit_covs, event_covs, "single", n_aug, quiet, newdata_checks) + standard_mfd_checks(obs, unit_covs, event_covs, "single", NULL, quiet, newdata_checks) n_unit <- nrow(obs) n_rep <- ncol(obs) @@ -210,7 +210,7 @@ make_flocker_data_static <- function( make_flocker_data_dynamic <- function(obs, unit_covs = NULL, event_covs = NULL, quiet = FALSE, newdata_checks = FALSE) { - standard_mfd_checks(obs, unit_covs, event_covs, "multi", n_aug, quiet, newdata_checks) + standard_mfd_checks(obs, unit_covs, event_covs, "multi", NULL, quiet, newdata_checks) n_year <- nslice(obs) # nslice checks that obs is a 3-D array n_series <- nrow(obs) From 155b6b387d4aa5e25531647c73db8f2b0fa8a63b Mon Sep 17 00:00:00 2001 From: jsocolar Date: Sun, 24 Nov 2024 18:20:28 -0500 Subject: [PATCH 5/7] fixing site covs issues --- R/make_flocker_data.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/make_flocker_data.R b/R/make_flocker_data.R index 5c566e4..d67f5b8 100644 --- a/R/make_flocker_data.R +++ b/R/make_flocker_data.R @@ -377,7 +377,7 @@ make_flocker_data_dynamic <- function(obs, unit_covs = NULL, event_covs = NULL, #' @export make_flocker_data_augmented <- function(obs, n_aug, site_covs = NULL, event_covs = NULL, quiet = FALSE) { - standard_mfd_checks(obs, unit_covs, event_covs, "augmented", n_aug, quiet, newdata_checks) + standard_mfd_checks(obs, site_covs, event_covs, "augmented", n_aug, quiet, newdata_checks) obs1 <- obs[,,1] n_rep <- ncol(obs1) n_sp_obs <- dim(obs)[3] @@ -739,6 +739,7 @@ standard_mfd_checks <- function( #### augmented checks #### if(type == "augmented"){ + site_covs <- unit_covs obs1 <- obs[,,1] n_rep <- ncol(obs1) na_obs <- which(is.na(obs1)) From 654afe72fe2faaf686c8706a29f736a9c3de8d81 Mon Sep 17 00:00:00 2001 From: jsocolar Date: Sun, 24 Nov 2024 18:31:29 -0500 Subject: [PATCH 6/7] more tinkering 2 --- R/make_flocker_data.R | 4 +++- man/make_flocker_data_augmented.Rd | 5 ++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/R/make_flocker_data.R b/R/make_flocker_data.R index d67f5b8..7f03488 100644 --- a/R/make_flocker_data.R +++ b/R/make_flocker_data.R @@ -373,10 +373,12 @@ make_flocker_data_dynamic <- function(obs, unit_covs = NULL, event_covs = NULL, #' @param event_covs A named list of I x J matrices, each one corresponding to a #' covariate that varies across repeated sampling events within sites #' @param quiet Hide progress bars and informational messages? +#' @param newdata_checks turn off some checking for newdata? #' @return A flocker_data list that can be passed as data to \code{flocker()}. #' @export make_flocker_data_augmented <- function(obs, n_aug, site_covs = NULL, - event_covs = NULL, quiet = FALSE) { + event_covs = NULL, quiet = FALSE, + newdata_checks = FALSE) { standard_mfd_checks(obs, site_covs, event_covs, "augmented", n_aug, quiet, newdata_checks) obs1 <- obs[,,1] n_rep <- ncol(obs1) diff --git a/man/make_flocker_data_augmented.Rd b/man/make_flocker_data_augmented.Rd index c6902e6..378fe61 100644 --- a/man/make_flocker_data_augmented.Rd +++ b/man/make_flocker_data_augmented.Rd @@ -10,7 +10,8 @@ make_flocker_data_augmented( n_aug, site_covs = NULL, event_covs = NULL, - quiet = FALSE + quiet = FALSE, + newdata_checks = FALSE ) } \arguments{ @@ -28,6 +29,8 @@ across repeated sampling events.} covariate that varies across repeated sampling events within sites} \item{quiet}{Hide progress bars and informational messages?} + +\item{newdata_checks}{turn off some checking for newdata?} } \value{ A flocker_data list that can be passed as data to \code{flocker()}. From eaeb1acc3f8c645ad18219c2cea44cb0ed646000 Mon Sep 17 00:00:00 2001 From: jsocolar Date: Sun, 24 Nov 2024 18:58:04 -0500 Subject: [PATCH 7/7] fixing ambiguous test --- R/make_flocker_data.R | 4 +++- man/make_flocker_data_augmented.Rd | 4 +++- tests/testthat/test-make_flocker_data.R | 2 +- 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/R/make_flocker_data.R b/R/make_flocker_data.R index 7f03488..df4b61f 100644 --- a/R/make_flocker_data.R +++ b/R/make_flocker_data.R @@ -373,7 +373,9 @@ make_flocker_data_dynamic <- function(obs, unit_covs = NULL, event_covs = NULL, #' @param event_covs A named list of I x J matrices, each one corresponding to a #' covariate that varies across repeated sampling events within sites #' @param quiet Hide progress bars and informational messages? -#' @param newdata_checks turn off some checking for newdata? +#' @param newdata_checks If TRUE, turn off checks that must pass in order +#' to use the data for model fitting, but not in other contexts (e.g. making +#' predictions or assessing log-likelihoods over new data). #' @return A flocker_data list that can be passed as data to \code{flocker()}. #' @export make_flocker_data_augmented <- function(obs, n_aug, site_covs = NULL, diff --git a/man/make_flocker_data_augmented.Rd b/man/make_flocker_data_augmented.Rd index 378fe61..97eb268 100644 --- a/man/make_flocker_data_augmented.Rd +++ b/man/make_flocker_data_augmented.Rd @@ -30,7 +30,9 @@ covariate that varies across repeated sampling events within sites} \item{quiet}{Hide progress bars and informational messages?} -\item{newdata_checks}{turn off some checking for newdata?} +\item{newdata_checks}{If TRUE, turn off checks that must pass in order +to use the data for model fitting, but not in other contexts (e.g. making +predictions or assessing log-likelihoods over new data).} } \value{ A flocker_data list that can be passed as data to \code{flocker()}. diff --git a/tests/testthat/test-make_flocker_data.R b/tests/testthat/test-make_flocker_data.R index 323d522..08f81a4 100644 --- a/tests/testthat/test-make_flocker_data.R +++ b/tests/testthat/test-make_flocker_data.R @@ -43,7 +43,7 @@ test_that("make_flocker_data works correctly", { obs <- rep(1, 3000) expect_error(fd <- make_flocker_data(obs), "in a single-season model, obs must have exactly two dimensions") - obs <- matrix(1:3000, ncol=1) + obs <- matrix(rep(1, 3000), ncol=1) expect_error(fd <- make_flocker_data(obs), "obs must contain at least two columns.") obs <- example_data$obs