diff --git a/DESCRIPTION b/DESCRIPTION index b3c01b4..fef5b06 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: glmmboot Type: Package Title: Bootstrap Resampling for Mixed Effects and Plain Models -Version: 0.5.1 +Version: 0.6.0 Authors@R: person("Colman", "Humphrey", email = "humphrc@tcd.ie", role = c("aut", "cre")) Description: Performs bootstrap resampling for most models that update() works for. There @@ -19,12 +19,12 @@ Depends: Imports: methods, stats Suggests: - glmmTMB (>= 0.2.1), + glmmTMB (>= 1.1.0), testthat (>= 0.11.0), parallel (>= 3.0.0), future.apply (>= 1.1.0), knitr, rmarkdown, covr -RoxygenNote: 7.0.2 +RoxygenNote: 7.1.1 VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index d3664a3..223d5ef 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,5 @@ # Generated by roxygen2: do not edit by hand -export(BootCI) -export(BootGlmm) -export(CombineResampledLists) export(bootstrap_ci) export(bootstrap_model) export(combine_resampled_lists) diff --git a/NEWS.md b/NEWS.md index 05726b3..c41dbff 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,13 @@ +# glmmboot 0.6.0 + +* Removing previously deprecated functions (deprecated as of 0.4.0) +* Adding conditional evaluation for tests and the vignette (and the readme) + for `glmmTMB`, in case it's not present / installable on a given system (as + it's only a suggested package) +* Removing `call. = FALSE` for errors and warnings +* adding `future.seed = TRUE` to `future.apply::future_lapply` call for better RNG +* Minor vignette and README copy edits + # glmmboot 0.5.1 * Changing a `donttest` to a `dontrun` within an example. diff --git a/R/bootstrap_ci.R b/R/bootstrap_ci.R index 99c07f4..9cdb731 100644 --- a/R/bootstrap_ci.R +++ b/R/bootstrap_ci.R @@ -91,12 +91,12 @@ bootstrap_individual_ci <- function(base_matrix = NULL, if (is.null(probs)) { if (alpha_level < 0 | alpha_level > 0.5) { stop("Can't calculate a two-sided CI with this alpha value, ", - "must be in (0, 0.5)", call. = FALSE) + "must be in (0, 0.5)") } probs <- sort(c(alpha_level / 2, 1 - alpha_level / 2)) } if (max(probs) > 1 || min(probs) < 0) { - stop("Probabilities should be in (0,1)", call. = FALSE) + stop("Probabilities should be in (0,1)") } base_row_names <- rownames(base_matrix) @@ -107,7 +107,7 @@ bootstrap_individual_ci <- function(base_matrix = NULL, })) if (mean(name_match) != 1) { - stop("Naming mismatch from base to list of coefs", call. = FALSE) + stop("Naming mismatch from base to list of coefs") } resampled_ests_vecs <- lapply(1:nrow(base_matrix), function(j){ @@ -239,24 +239,6 @@ ci_variable <- function(base_est, } -#' @rdname bootstrap_ci -#' @export -#' @param alp_level -#' now alpha_level -BootCI <- function(base_coef_se = NULL, # nocov start - resampled_coef_se = NULL, - orig_df = NULL, - alp_level = 0.05, - probs = NULL){ - .Deprecated("bootstrap_ci") - bootstrap_ci(base_coef_se = base_coef_se, - resampled_coef_se = resampled_coef_se, - orig_df = orig_df, - alpha_level = alp_level, - probs = probs) -} # nocov end - - #' Combines output from multiple bootstrap_model calls #' #' If you run glmmboot on e.g. a grid of computers, @@ -333,12 +315,3 @@ combine_resampled_lists <- function(..., bootstrap_ci(base_coef_se = reg_base_coef, resampled_coef_se = reg_resampled) } - -#' @rdname combine_resampled_lists -#' @export -CombineResampledLists <- function(..., # nocov start - return_combined_list = FALSE){ - .Deprecated("combine_resampled_lists") - combine_resampled_lists(..., - return_combined_list = return_combined_list) -} # nocov end diff --git a/R/bootstrap_methods.R b/R/bootstrap_methods.R index 6bd6fb3..2fbb2fe 100644 --- a/R/bootstrap_methods.R +++ b/R/bootstrap_methods.R @@ -122,8 +122,7 @@ gen_resampling_index <- function(orig_list, sampled_list){ if (length(orig_list) != length(sampled_list)) { stop("lists must be the same length ", - "(the original variables and the sampled variables)", - call. = FALSE) + "(the original variables and the sampled variables)") } ## coercing to character means this works for all types diff --git a/R/bootstrap_model.R b/R/bootstrap_model.R index a5a5115..7c14b53 100644 --- a/R/bootstrap_model.R +++ b/R/bootstrap_model.R @@ -127,12 +127,12 @@ bootstrap_model <- function(base_model, } else { stop("base_data cannot be automatically inferred, ", "please supply data as base_data ", - "to this function", call. = FALSE) + "to this function") } warning("Please supply data through the argument base_data; ", "automatic reading from your model can produce ", - "unforeseeable bugs.", call. = FALSE) + "unforeseeable bugs.") } if (missing(parallelism)) { @@ -142,7 +142,7 @@ bootstrap_model <- function(base_model, if (!requireNamespace("parallel", quietly = TRUE)) { # nocov start stop("setting `num_cores` greater than 1 without setting ", "`parallelism` uses `package:parallel`, ", - "but it's not installed", call. = FALSE) + "but it's not installed") } parallelism <- "parallel" # nocov end } else { @@ -152,25 +152,23 @@ bootstrap_model <- function(base_model, parallelism <- match.arg(parallelism) if (parallelism == "none" && !is.null(num_cores) && num_cores > 1) { stop("contradiction between `parallelism = \"none\"` ", - "and `num_cores = ", num_cores, "`; please resolve", - call. = FALSE) + "and `num_cores = ", num_cores, "`; please resolve") } if (parallelism == "future") { if (!requireNamespace("future.apply", quietly = TRUE)) { # nocov start stop("`parallelism = \"future\"` uses `package:future.apply`, ", - "but it's not installed", call. = FALSE) + "but it's not installed") } # nocov end if (!is.null(num_cores)) { stop("with `parallelism = \"future\"`, the `num_cores` ", "argument is not used to set up the backend; ", - "use `future::plan` instead", - call. = FALSE) + "use `future::plan` instead") } } if (parallelism == "parallel") { if (!requireNamespace("parallel", quietly = TRUE)) { # nocov start stop("`parallelism = \"parallel\"` uses `package:parallel`, ", - "but it's not installed", call. = FALSE) + "but it's not installed") } # nocov end if (is.null(num_cores)) { # nocov start @@ -183,7 +181,7 @@ bootstrap_model <- function(base_model, if (parallelism != "future" && !is.null(future_packages)) { stop("Argument `future_packages` should only be set when ", - "using `parallelism = \"future\"`", call. = FALSE) + "using `parallelism = \"future\"`") } ##------------------------------------ @@ -205,7 +203,7 @@ bootstrap_model <- function(base_model, } else { if (!list_of_matrices(base_coef)) { stop("currently this method needs `coef(summary(base_model))` ", # nocov start - "to be a matrix, or a list of them", call. = FALSE) # nocov end + "to be a matrix, or a list of them") # nocov end } ## only calc not_null once, but local scope the result extract_coef <- (function(not_null){ @@ -234,7 +232,7 @@ bootstrap_model <- function(base_model, if (sum(rand_cols %in% resample_specific_blocks) == 0 && length(rand_cols) > 0) { stop("No random columns from formula found ", - "in resample_specific_blocks", call. = FALSE) + "in resample_specific_blocks") } rand_cols <- rand_cols[rand_cols %in% resample_specific_blocks] } @@ -338,8 +336,7 @@ bootstrap_model <- function(base_model, } if (any(error_ind)) { stop("could not generate error-free resamples in ", # nocov start - max_redos, " attempts", - call. = FALSE) # nocov end + max_redos, " attempts") # nocov end } if (return_coefs_instead) { @@ -361,37 +358,6 @@ bootstrap_model <- function(base_model, } -#' @export -#' @rdname bootstrap_model -#' @param suppress_loading_bar -#' defunct now -#' @param allow_conv_error -#' defunct now -BootGlmm <- function(base_model, # nocov start - resamples = 9999, - base_data = NULL, - return_coefs_instead = FALSE, - resample_specific_blocks = NULL, - unique_resample_lim = NULL, - narrowness_avoid = TRUE, - num_cores = NULL, - suppress_sampling_message = FALSE, - suppress_loading_bar = FALSE, - allow_conv_error = FALSE){ - .Deprecated("bootstrap_model") - - bootstrap_model(base_model = base_model, - base_data = base_data, - resamples = resamples, - return_coefs_instead = return_coefs_instead, - resample_specific_blocks = resample_specific_blocks, - unique_resample_lim = unique_resample_lim, - narrowness_avoid = narrowness_avoid, - num_cores = num_cores, - suppress_sampling_message = suppress_sampling_message) -} # nocov end - - #' Runs the bootstrapping of the models. #' #' This function gets passed a function that runs a single bootstrap resample @@ -417,7 +383,8 @@ bootstrap_runner <- function(bootstrap_function, function(i){ bootstrap_function() }, - future.packages = future_packages)) + future.packages = future_packages, + future.seed = TRUE)) } if (parallelism == "parallel") { diff --git a/README.Rmd b/README.Rmd index 021d8a1..bdb12d4 100644 --- a/README.Rmd +++ b/README.Rmd @@ -25,7 +25,7 @@ options(warnPartialMatchArgs = FALSE, ## Overview -glmmboot provides a simple interface for creating bootstrap +glmmboot provides a simple interface for creating non-parametric bootstrap confidence intervals using a wide set of models. The primary function is `bootstrap_model`, which has three primary arguments: @@ -47,6 +47,8 @@ For models with random effects: With no random effects, performs case resampling: resamples each row with replacement. +All of these are considered non-parametric. + ## Requirements: 1. the model should work with the @@ -88,7 +90,7 @@ devtools::install_github("ColmanHumphrey/glmmboot") We'll provide a quick example using glm. First we'll set up some data: ```{r} -set.seed(15278086) # Happy for Nadia and Alan +set.seed(15278086) x1 <- rnorm(50) x2 <- runif(50) @@ -130,7 +132,8 @@ conservative at `N = 50`. An example with a zero-inflated model (from the `glmmTMB` docs): -```{r} +```{r, eval = requireNamespace("glmmTMB", quietly = TRUE)} +## we'll skip this if glmmTMB not available library(glmmTMB) owls <- transform(Owls, @@ -148,7 +151,7 @@ fit_zipoisson <- glmmTMB( summary(fit_zipoisson) ``` Let's run the bootstrap (ignore the actual results, 3 resamples is basically meaningless - just for illustration): -```{r} +```{r, eval = requireNamespace("glmmTMB", quietly = TRUE)} zi_results <- bootstrap_model(base_model = fit_zipoisson, base_data = owls, resamples = 3) diff --git a/README.md b/README.md index fbe6a37..acbe213 100644 --- a/README.md +++ b/README.md @@ -15,14 +15,14 @@ status](https://www.r-pkg.org/badges/version/glmmboot)](https://cran.r-project.o ## Overview -glmmboot provides a simple interface for creating bootstrap confidence -intervals using a wide set of models. The primary function is -`bootstrap_model`, which has three primary arguments: +glmmboot provides a simple interface for creating non-parametric +bootstrap confidence intervals using a wide set of models. The primary +function is `bootstrap_model`, which has three primary arguments: - - `base_model`: the model run on the full data as you normally would, +- `base_model`: the model run on the full data as you normally would, prior to bootstrapping - - `base_data`: the dataset used - - `resamples`: how many bootstrap resamples you wish to perform +- `base_data`: the dataset used +- `resamples`: how many bootstrap resamples you wish to perform Another function, `bootstrap_ci`, converts output from bootstrap model runs into confidence intervals and p-values. By default, @@ -32,24 +32,24 @@ runs into confidence intervals and p-values. By default, For models with random effects: - - the default (and recommended) behaviour will be to block sample over +- the default (and recommended) behaviour will be to block sample over the effect with the largest entropy (generally the one with the most levels) - - it’s also possible to specify multiple random effects to block +- it’s also possible to specify multiple random effects to block sample over With no random effects, performs case resampling: resamples each row with replacement. +All of these are considered non-parametric. + ## Requirements: 1. the model should work with the function `update`, to change the data 2. the coefficients are extractable using `coef(summary(model))` - - - - either directly, i.e. this gives a matrix - - or it’s a list of matrices; this includes e.g. zero-inflated models, +- either directly, i.e. this gives a matrix +- or it’s a list of matrices; this includes e.g. zero-inflated models, which produce two matrices of coefficients ## Parallel @@ -84,7 +84,7 @@ devtools::install_github("ColmanHumphrey/glmmboot") We’ll provide a quick example using glm. First we’ll set up some data: ``` r -set.seed(15278086) # Happy for Nadia and Alan +set.seed(15278086) x1 <- rnorm(50) x2 <- runif(50) @@ -141,14 +141,14 @@ And the results: ``` r print(boot_results) -# estimate boot 2.5% boot 97.5% boot p_value base p_value -# (Intercept) -0.1160896 -1.2295 0.9809 0.830 0.8446 -# x1 -0.5146778 -1.1245 0.0455 0.076 0.1353 -# x2 1.0932707 -0.7517 3.1328 0.284 0.2829 -# base 2.5% base 97.5% boot/base width -# (Intercept) -1.3010 1.0688 0.9327523 -# x1 -1.1961 0.1667 0.8584962 -# x2 -0.9315 3.1181 0.9592352 +# estimate boot 2.5% boot 97.5% boot p_value base p_value base 2.5% +# (Intercept) -0.1160896 -1.2295 0.9809 0.830 0.8446 -1.3010 +# x1 -0.5146778 -1.1245 0.0455 0.076 0.1353 -1.1961 +# x2 1.0932707 -0.7517 3.1328 0.284 0.2829 -0.9315 +# base 97.5% boot/base width +# (Intercept) 1.0688 0.9327523 +# x1 0.1667 0.8584962 +# x2 3.1181 0.9592352 ``` The estimates are the same, since we just pull from the base model. The @@ -158,6 +158,7 @@ typical logistic regression is fractionally conservative at `N = 50`. An example with a zero-inflated model (from the `glmmTMB` docs): ``` r +## we'll skip this if glmmTMB not available library(glmmTMB) owls <- transform(Owls, @@ -225,26 +226,19 @@ print(zi_results) # SexParentMale 0.44884508 0.1134 1.2690 0.5 # ftSatiated:SexParentMale 0.10472505 -0.1153 0.2804 1.0 # ArrivalTime:SexParentMale -0.02139750 -0.0527 -0.0087 0.5 -# base p_value base 2.5% base 97.5% -# (Intercept) 0.0000 1.8411 3.2388 -# ftSatiated 0.0000 -0.4079 -0.1743 -# ArrivalTime 0.0000 -0.0960 -0.0401 -# SexParentMale 0.3186 -0.4332 1.3309 -# ftSatiated:SexParentMale 0.1506 -0.0381 0.2475 -# ArrivalTime:SexParentMale 0.2436 -0.0574 0.0146 -# boot/base width -# (Intercept) 0.7177368 -# ftSatiated 0.5002454 -# ArrivalTime 0.8479791 -# SexParentMale 0.6550388 -# ftSatiated:SexParentMale 1.3852712 -# ArrivalTime:SexParentMale 0.6116518 +# base p_value base 2.5% base 97.5% boot/base width +# (Intercept) 0.0000 1.8411 3.2388 0.7177368 +# ftSatiated 0.0000 -0.4079 -0.1743 0.5002454 +# ArrivalTime 0.0000 -0.0960 -0.0401 0.8479791 +# SexParentMale 0.3186 -0.4332 1.3309 0.6550388 +# ftSatiated:SexParentMale 0.1506 -0.0381 0.2475 1.3852712 +# ArrivalTime:SexParentMale 0.2436 -0.0574 0.0146 0.6116518 # # $zi -# estimate boot 2.5% boot 97.5% boot p_value base p_value -# (Intercept) -1.057534 -1.0575 -0.84 0.5 0 -# base 2.5% base 97.5% boot/base width -# (Intercept) -1.242 -0.8731 0.5895082 +# estimate boot 2.5% boot 97.5% boot p_value base p_value base 2.5% +# (Intercept) -1.057534 -1.0575 -0.84 0.5 0 -1.242 +# base 97.5% boot/base width +# (Intercept) -0.8731 0.5895082 ``` We could also have run this with the `future.apply` backend: diff --git a/cran-comments.md b/cran-comments.md index f247e78..3fd2e88 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,11 +1,18 @@ ## Release Summary -Changing `donttest` to `dontrun` for an example. +Primary purpose of this change is to add conditional eval statements for tests +and vignettes using `glmmTMB`. The other change was fully removing functions +deprecated as of 0.4.0, hence the minor version bump. ## Test environments -* local OS X install, R 3.6.2 -* Ubuntu 16.04.6 LTS (on travis-ci), R 3.6.2 -* win-builder, devel R 4.0.0 alpha, and release R 3.6.3 + +* local Mac: 11.3.1, aarch64-apple-darwin20 (64-bit), R 4.1.0 +* R-hub: + * Ubuntu Linux 20.04.1 LTS, R-release (4.1.0), GCC + * Fedora Linux, R-devel, clang, gfortran + * Windows Server 2008 R2 SP1, R-devel, 32/64 bit +* win-builder: R Under development (unstable) (2021-06-22 r80544) + ## R CMD check results diff --git a/man/bootstrap_ci.Rd b/man/bootstrap_ci.Rd index b0a076a..21a0068 100644 --- a/man/bootstrap_ci.Rd +++ b/man/bootstrap_ci.Rd @@ -2,7 +2,6 @@ % Please edit documentation in R/bootstrap_ci.R \name{bootstrap_ci} \alias{bootstrap_ci} -\alias{BootCI} \title{Generating bootstrap confidence intervals.} \usage{ bootstrap_ci( @@ -12,14 +11,6 @@ bootstrap_ci( alpha_level = 0.05, probs = NULL ) - -BootCI( - base_coef_se = NULL, - resampled_coef_se = NULL, - orig_df = NULL, - alp_level = 0.05, - probs = NULL -) } \arguments{ \item{base_coef_se}{Estimates and SEs from full sample. In matrix form, @@ -41,8 +32,6 @@ t-values used for the base interval.} \item{probs}{Default \code{NULL}, and will use \code{alpha_level} to set endpoints. Else will calculate these CI endpoints.} - -\item{alp_level}{now alpha_level} } \value{ A matrix containing: diff --git a/man/bootstrap_model.Rd b/man/bootstrap_model.Rd index 10b086f..8d60c88 100644 --- a/man/bootstrap_model.Rd +++ b/man/bootstrap_model.Rd @@ -2,7 +2,6 @@ % Please edit documentation in R/bootstrap_model.R \name{bootstrap_model} \alias{bootstrap_model} -\alias{BootGlmm} \title{Computes bootstrap resamples of your data, stores estimates + SEs.} \usage{ @@ -19,20 +18,6 @@ bootstrap_model( future_packages = NULL, suppress_sampling_message = !interactive() ) - -BootGlmm( - base_model, - resamples = 9999, - base_data = NULL, - return_coefs_instead = FALSE, - resample_specific_blocks = NULL, - unique_resample_lim = NULL, - narrowness_avoid = TRUE, - num_cores = NULL, - suppress_sampling_message = FALSE, - suppress_loading_bar = FALSE, - allow_conv_error = FALSE -) } \arguments{ \item{base_model}{The pre-bootstrap model, i.e. the model output @@ -103,10 +88,6 @@ bootstrapping? If block resampling over random effects, then it'll say what effect it's sampling over; if case resampling - in which case it'll say as much. Set \code{TRUE} to hide message.} - -\item{suppress_loading_bar}{defunct now} - -\item{allow_conv_error}{defunct now} } \value{ By default (with \code{return_coefs_instead} being \code{FALSE}), diff --git a/man/combine_resampled_lists.Rd b/man/combine_resampled_lists.Rd index e4fc983..767822c 100644 --- a/man/combine_resampled_lists.Rd +++ b/man/combine_resampled_lists.Rd @@ -2,12 +2,9 @@ % Please edit documentation in R/bootstrap_ci.R \name{combine_resampled_lists} \alias{combine_resampled_lists} -\alias{CombineResampledLists} \title{Combines output from multiple bootstrap_model calls} \usage{ combine_resampled_lists(..., return_combined_list = FALSE) - -CombineResampledLists(..., return_combined_list = FALSE) } \arguments{ \item{...}{List of outputs to be combined, or just a bunch of output entries diff --git a/man/test_data.Rd b/man/test_data.Rd index b270d71..27f667f 100644 --- a/man/test_data.Rd +++ b/man/test_data.Rd @@ -4,14 +4,16 @@ \name{test_data} \alias{test_data} \title{Simulated data containing three fixed effects and one random effect} -\format{A data frame with 300 rows and 4 variables: +\format{ +A data frame with 300 rows and 4 variables: \describe{ \item{x_var1}{independent normally distributed variable} \item{x_var2}{independent normally distributed variable} \item{x_var3}{independent normally distributed variable} \item{subj}{levels of random effect} \item{y}{outcome: lives in interval [0,1]} -}} +} +} \usage{ test_data } diff --git a/tests/testthat/test-bootstrap_model.R b/tests/testthat/test-bootstrap_model.R index 4dfafed..bcaa665 100644 --- a/tests/testthat/test-bootstrap_model.R +++ b/tests/testthat/test-bootstrap_model.R @@ -188,7 +188,12 @@ test_that("bootstrap_model parallelism modes", { num_cores = NULL, suppress_sampling_message = TRUE), NA) + ## we're not actually using glmmTMB here but for testing it's fine + if (!requireNamespace("glmmTMB", quietly = TRUE)) { + skip("need glmmTMB to be installed for future package tests") + } + expect_error(bootstrap_model(base_model = simple_model, base_data = xy_data, resamples = 20, diff --git a/vignettes/quick_use.Rmd b/vignettes/quick_use.Rmd index bf8a3bd..c4f4b45 100644 --- a/vignettes/quick_use.Rmd +++ b/vignettes/quick_use.Rmd @@ -24,8 +24,9 @@ options(warnPartialMatchArgs = FALSE, For even quicker usage instructions, see the README. -The general idea of this package is that you can throw nearly any -model built in the typical R fashion. For now, we just need +The general idea behind this package is for you to be able to throw +in nearly any model built in the typical R fashion and get back +a non-parametric bootstrap analysis. For now, we just need a somewhat standard way of extracting fixed effects, and that `update` works, which is nearly always the case. @@ -59,7 +60,8 @@ We're assuming the `x_var` variables are fixed, and `subj` is to be treated as a Thus our base analysis is: -```{r, cache=TRUE} +```{r, eval = requireNamespace("glmmTMB", quietly = TRUE), cache=TRUE} +## we'll skip this if glmmTMB not available library(glmmTMB) model_formula <- as.formula(y ~ x_var1 + x_var2 + x_var2 + (1 | subj)) @@ -72,7 +74,7 @@ We get a warning because the outcome data is proportional. Not to worry. Now we'll use the bootstrap. By default it'll perform block bootstrapping over the highest entropy random effect - but there's only one, so of course the winner is `subj`. -```{r, cache=TRUE} +```{r, eval = requireNamespace("glmmTMB", quietly = TRUE), cache=TRUE} bootstrap_over_subj <- bootstrap_model(base_model = base_run, base_data = test_data, resamples = 99) @@ -81,7 +83,7 @@ For publications etc, better to run about ten thousand resamples to avoid noise having much of an effect. Of course 99 is far too small, only for an example. And comparing results: -```{r, cache=TRUE} +```{r, eval = requireNamespace("glmmTMB", quietly = TRUE), cache=TRUE} print(bootstrap_over_subj) ``` @@ -91,7 +93,7 @@ The above might take a long time in a real setting. If it takes far too long on you can ideally run it on a bunch of computers. We don't want each computer to output the fully processed output, only the intermediate outcome. To do this, we set `return_coefs_instead = TRUE` for each run: -```{r, cache=TRUE} +```{r, eval = requireNamespace("glmmTMB", quietly = TRUE), cache=TRUE} b_list1 <- bootstrap_model(base_model = base_run, base_data = test_data, resamples = 29, @@ -107,17 +109,17 @@ b_list3 <- bootstrap_model(base_model = base_run, ``` Combining this is simple enough. If we've used a few, we don't want to mess around with even more lists, so we can enter them into the relevant function: -```{r, cache=TRUE} +```{r, eval = requireNamespace("glmmTMB", quietly = TRUE), cache=TRUE} print(combine_resampled_lists(b_list1, b_list2, b_list3)) ``` If we've run a huge number of such runs, ideally we'll combine all output to a list of lists, like so: -```{r, cache=TRUE} +```{r, eval = requireNamespace("glmmTMB", quietly = TRUE), cache=TRUE} list_of_lists_output <- list(b_list1, b_list2, b_list3) ``` And we'll get the same result: -```{r, cache=TRUE} +```{r, eval = requireNamespace("glmmTMB", quietly = TRUE), cache=TRUE} print(combine_resampled_lists(list_of_lists_output)) ``` diff --git a/vignettes/quick_use_files/figure-html/unnamed-chunk-17-1.png b/vignettes/quick_use_files/figure-html/unnamed-chunk-17-1.png new file mode 100644 index 0000000..aa48e15 Binary files /dev/null and b/vignettes/quick_use_files/figure-html/unnamed-chunk-17-1.png differ diff --git a/vignettes/quick_use_files/figure-html/unnamed-chunk-17-2.png b/vignettes/quick_use_files/figure-html/unnamed-chunk-17-2.png new file mode 100644 index 0000000..8f712cd Binary files /dev/null and b/vignettes/quick_use_files/figure-html/unnamed-chunk-17-2.png differ