diff --git a/DESCRIPTION b/DESCRIPTION index 55066cb..d9acf9d 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: SBC Title: Simulation Based Calibration for rstan/cmdstanr models -Version: 0.1.1.9000 +Version: 0.2.0.9000 Authors@R: c(person(given = "Shinyoung", family = "Kim", diff --git a/NAMESPACE b/NAMESPACE index 9371fe2..e3fb7cf 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -90,6 +90,7 @@ export(SBC_print_example_model) export(SBC_results) export(SBC_statistics_from_single_fit) export(bind_datasets) +export(bind_derived_quantities) export(bind_generated_quantities) export(bind_results) export(calculate_prior_sd) @@ -98,11 +99,13 @@ export(calculate_sds_draws_matrix) export(check_all_SBC_diagnostics) export(cjs_dist) export(compute_SBC) +export(compute_dquants) export(compute_gen_quants) export(compute_results) export(data_for_ecdf_plots) export(default_chunk_size) export(default_cores_per_fit) +export(derived_quantities) export(draws_rvars_to_standata) export(draws_rvars_to_standata_single) export(empirical_coverage) @@ -123,6 +126,7 @@ export(recompute_statistics) export(set2set) export(validate_SBC_datasets) export(validate_SBC_results) +export(validate_derived_quantities) export(validate_generated_quantities) export(wasserstein) import(ggplot2) diff --git a/R/derived-quantities.R b/R/derived-quantities.R new file mode 100644 index 0000000..4a366d7 --- /dev/null +++ b/R/derived-quantities.R @@ -0,0 +1,162 @@ +#' Create a definition of derived quantities evaluated in R. +#' +#' When the expression contains non-library functions/objects, and parallel processing +#' is enabled, those must be +#' named in the `.globals` parameter (hopefully we'll be able to detect those +#' automatically in the future). Note that [recompute_SBC_statistics()] currently +#' does not use parallel processing, so `.globals` don't need to be set. +#' +#' @param ... named expressions representing the quantitites +#' @param .globals A list of names of objects that are defined +#' in the global environment and need to present for the gen. quants. to evaluate. +#' It is added to the `globals` argument to [future::future()], to make those +#' objects available on all workers. +#' @examples +#'# Derived quantity computing the total log likelihood of a normal distribution +#'# with known sd = 1 +#'normal_lpdf <- function(y, mu, sigma) { +#' sum(dnorm(y, mean = mu, sd = sigma, log = TRUE)) +#'} +#' +#'# Note the use of .globals to make the normal_lpdf function available +#'# within the expression +#'log_lik_dq <- derived_quantities(log_lik = normal_lpdf(y, mu, 1), +#' .globals = "normal_lpdf" ) +#' +#' @export +derived_quantities <- function(..., .globals = list()) { + structure(rlang::enquos(..., .named = TRUE), + class = "SBC_derived_quantities", + globals = .globals + ) +} + +#' @title Validate a definition of derived quantities evaluated in R. +#' @export +validate_derived_quantities <- function(x) { + # Backwards compatibility + if(inherits(x, "SBC_generated_quantities")) { + class(x) <- "SBC_derived_quantities" + } + stopifnot(inherits(x, "SBC_derived_quantities")) + invisible(x) +} + +#' @title Combine two lists of derived quantities +#' @export +bind_derived_quantities <- function(dq1, dq2) { + validate_derived_quantities(dq1) + validate_derived_quantities(dq2) + structure(c(dq1, dq2), + class = "SBC_derived_quantities", + globals = bind_globals(attr(dq1, "globals"), attr(dq2, "globals"))) +} + +#'@title Compute derived quantities based on given data and posterior draws. +#'@param gen_quants Deprecated, use `dquants` +#'@export +compute_dquants <- function(draws, generated, dquants, gen_quants = NULL) { + if(!is.null(gen_quants)) { + warning("gen_quants argument is deprecated, use dquants") + if(rlang::is_missing(dquants)) { + dquants <- gen_quants + } + } + dquants <- validate_derived_quantities(dquants) + draws_rv <- posterior::as_draws_rvars(draws) + + draws_env <- list2env(draws_rv) + if(!is.null(generated)) { + if(!is.list(generated)) { + stop("compute_dquants assumes that generated is a list, but this is not the case") + } + generated_env <- list2env(generated, parent = draws_env) + + data_mask <- rlang::new_data_mask(bottom = generated_env, top = draws_env) + } else { + data_mask <- rlang::new_data_mask(bottom = draws_env) + } + + eval_func <- function(dq) { + # Wrap the expression in `rdo` which will mostly do what we need + # all the tricks are just to have the correct environment when we need it + wrapped_dq <- rlang::new_quosure(rlang::expr(posterior::rdo(!!rlang::get_expr(dq))), rlang::get_env(dq)) + rlang::eval_tidy(wrapped_dq, data = data_mask) + } + rvars <- lapply(dquants, FUN = eval_func) + do.call(posterior::draws_rvars, rvars) +} + + + +#' @title Create a definition of derived quantities evaluated in R. +#' @description Delegates directly to `derived_quantities()`. +#' +#' @name generated_quantities-deprecated +#' @seealso \code{\link{SBC-deprecated}} +#' @keywords internal +NULL + +#' @rdname SBC-deprecated +#' @section \code{generated_quantities}: +#' Instead of \code{generated_quantities}, use \code{\link{derived_quantities}}. +#' +#' @export +generated_quantities <- function(...) { + warning("generated_quantities() is deprecated, use derived_quantities instead.") + derived_quantities(...) +} + +#' @title Validate a definition of derived quantities evaluated in R. +#' @description Delegates directly to `validate_derived_quantities()`. +#' +#' @name generated_quantities-deprecated +#' @seealso \code{\link{SBC-deprecated}} +#' @keywords internal +NULL + +#' @rdname SBC-deprecated +#' @section \code{validate_generated_quantities}: +#' Instead of \code{validate_generated_quantities}, use \code{\link{validate_derived_quantities}}. +#' +#' @export +validate_generated_quantities <- function(...) { + warning("generated_quantities() is deprecated, use validate_derived_quantities instead.") + validate_derived_quantities(...) +} + +#' @title Combine two lists of derived quantities +#' @description Delegates directly to `bind_derived_quantities()`. +#' +#' @name bind_generated_quantities-deprecated +#' @seealso \code{\link{SBC-deprecated}} +#' @keywords internal +NULL + +#' @rdname SBC-deprecated +#' @section \code{bind_generated_quantities}: +#' Instead of \code{bind_generated_quantities}, use \code{\link{bind_derived_quantities}}. +#' +#' @export +bind_generated_quantities <- function(...) { + warning("bind_generated_quantities() is deprecated, use bind_derived_quantities instead.") + bind_derived_quantities(...) +} + +#'@title Compute derived quantities based on given data and posterior draws. +#' @description Delegates directly to `compute_dquants()`. +#' +#' @name compute_gen_quants-deprecated +#' @seealso \code{\link{SBC-deprecated}} +#' @keywords internal +NULL + +#' @rdname SBC-deprecated +#' @section \code{compute_gen_quants}: +#' Instead of \code{compute_gen_quants}, use \code{\link{compute_dquants}}. +#' +#' @export +compute_gen_quants <- function(...) { + warning("compute_gen_quants() is deprecated, use compute_dquants() instead.") + compute_dquants(...) +} diff --git a/R/results.R b/R/results.R index c3d5c05..d5a4223 100644 --- a/R/results.R +++ b/R/results.R @@ -254,7 +254,8 @@ length.SBC_results <- function(x) { errors = x$errors[indices]) } -#' Bind globals used in gen quants or backend +#' Combine two sets globals for use in derived quantities or backend +#' @seealso [compute_SBC()], [derived_quantities()] bind_globals <- function(globals1, globals2) { if(length(globals1) > 0 && length(globals2) > 0) { if(is.list(globals1) != is.list(globals2)) { @@ -365,6 +366,8 @@ compute_results <- function(...) { #' @param cache_location The filesystem location of cache. For `cache_mode = "results"` #' this should be a name of a single file. If the file name does not end with #' `.rds`, this extension is appended. +#' @param dquants Derived quantities to include in SBC. Use [derived_quantities()] to construct them. +#' @param gen_quants Deprecated, use dquants instead #' @param globals A list of names of objects that are defined #' in the global environment and need to present for the backend to work ( #' if they are not already available in package). @@ -378,15 +381,23 @@ compute_SBC <- function(datasets, backend, thin_ranks = SBC_backend_default_thin_ranks(backend), ensure_num_ranks_divisor = 2, chunk_size = default_chunk_size(length(datasets)), - gen_quants = NULL, + dquants = NULL, cache_mode = "none", cache_location = NULL, - globals = list()) { + globals = list(), + gen_quants = NULL) { stopifnot(length(datasets) > 0) - datasets <- validate_SBC_datasets(datasets) if(!is.null(gen_quants)) { - gen_quants <- validate_generated_quantities(gen_quants) + warning("gen_quants argument is deprecated, use dquants") + if(is.null(dquants)) { + dquants <- gen_quants + } + } + + datasets <- validate_SBC_datasets(datasets) + if(!is.null(dquants)) { + dquants <- validate_derived_quantities(dquants) } ## Handle caching @@ -410,9 +421,14 @@ compute_SBC <- function(datasets, backend, if(file.exists(cache_location)) { results_from_cache <- readRDS(cache_location) + # Ensure backwards compatibility of cache + if(!("dquants" %in% names(results_from_cache)) && ("gen_quants" %in% names(results_from_cache))) { + # This type of assignment necessary to preserve NULL values + results_from_cache["dquants"] <- list(results_from_cache$gen_quants) + } if(!is.list(results_from_cache) || !all( - c("result", "backend_hash", "data_hash", "thin_ranks", "gen_quants","keep_fits") + c("result", "backend_hash", "data_hash", "thin_ranks", "dquants","keep_fits") %in% names(results_from_cache))) { warning("Cache file exists but is in invalid format. Will recompute.") } else if(results_from_cache$backend_hash != backend_hash) { @@ -427,21 +443,31 @@ compute_SBC <- function(datasets, backend, result <- tryCatch(validate_SBC_results(results_from_cache$result), error = function(e) { NULL }) + error_dquants <- "error dquants" + if(!is.null(results_from_cache$dquants)) { + results_from_cache$dquants <- + tryCatch(validate_derived_quantities(results_from_cache$dquants), + error = function(e) { error_dquants }) + + } if(is.null(result)) { warning("Cache file contains invalid SBC_results object. Will recompute.") } else if(results_from_cache$thin_ranks != thin_ranks || - !identical(results_from_cache$gen_quants, gen_quants) || + !identical(results_from_cache$dquants, dquants) || results_from_cache$ensure_num_ranks_divisor != ensure_num_ranks_divisor) { + if(identical(results_from_cache$dquants, error_dquants)) { + warning("dquants loaded from cache are invalid") + } if(!results_from_cache$keep_fits) { - message("Cache file exists, but was computed with different thin_ranks/gen_quants/ensure_num_ranks_divisor and keep_fits == FALSE. Will recompute.") + message("Cache file exists, but was computed with different thin_ranks/dquants/ensure_num_ranks_divisor and keep_fits == FALSE. Will recompute.") } else { message(paste0("Results loaded from cache file '", cache_basename, - "' but it was computed with different thin_ranks/gen_quants/ensure_num_ranks_divisor.\n", + "' but it was computed with different thin_ranks/dquants/ensure_num_ranks_divisor.\n", "Calling recompute_SBC_statistics.")) return(recompute_SBC_statistics(old_results = result, datasets = datasets, thin_ranks = thin_ranks, ensure_num_ranks_divisor = ensure_num_ranks_divisor, - gen_quants = gen_quants, + dquants = dquants, backend = backend)) } } else { @@ -470,11 +496,11 @@ compute_SBC <- function(datasets, backend, generated = datasets$generated[[i]] ) } - if(is.null(gen_quants)) { + if(is.null(dquants)) { future.globals <- globals } else { - gq_globals <- attr(gen_quants, "globals") - future.globals <- bind_globals(globals, gq_globals) + dq_globals <- attr(dquants, "globals") + future.globals <- bind_globals(globals, dq_globals) } results_raw <- future.apply::future_lapply( @@ -482,7 +508,7 @@ compute_SBC <- function(datasets, backend, backend = backend, cores = cores_per_fit, keep_fit = keep_fits, thin_ranks = thin_ranks, ensure_num_ranks_divisor = ensure_num_ranks_divisor, - gen_quants = gen_quants, + dquants = dquants, future.seed = TRUE, future.globals = future.globals, future.chunk.size = chunk_size) @@ -591,7 +617,7 @@ compute_SBC <- function(datasets, backend, results_for_cache <- list(result = res, backend_hash = backend_hash, data_hash = data_hash, thin_ranks = thin_ranks, ensure_num_ranks_divisor = ensure_num_ranks_divisor, - gen_quants = gen_quants, keep_fits = keep_fits) + dquants = dquants, keep_fits = keep_fits) tryCatch(saveRDS(results_for_cache, file = cache_location), error = function(e) { warning("Error when saving cache file: ", e) }) } @@ -679,7 +705,7 @@ reemit_captured <- function(captured) { compute_SBC_single <- function(vars_and_generated, backend, cores, keep_fit, thin_ranks, ensure_num_ranks_divisor, - gen_quants) { + dquants) { variables <- vars_and_generated$variables generated <- vars_and_generated$generated @@ -706,7 +732,7 @@ compute_SBC_single <- function(vars_and_generated, backend, cores, res$stats <- SBC::SBC_statistics_from_single_fit( res$fit, variables = variables, thin_ranks = thin_ranks, ensure_num_ranks_divisor = ensure_num_ranks_divisor, - generated = generated, gen_quants = gen_quants, + generated = generated, dquants = dquants, backend = backend) res$backend_diagnostics <- SBC::SBC_fit_to_diagnostics( @@ -752,18 +778,26 @@ compute_SBC_single <- function(vars_and_generated, backend, cores, SBC_statistics_from_single_fit <- function(fit, variables, generated, thin_ranks, ensure_num_ranks_divisor, - gen_quants, - backend) { + dquants, + backend, + gen_quants = NULL) { + + if(!is.null(gen_quants)) { + warning("gen_quants argument is deprecated, use dquants") + if(rlang::is_missing(dquants)) { + dquants <- gen_quants + } + } fit_matrix <- SBC_fit_to_draws_matrix(fit) - if(!is.null(gen_quants)){ - gen_quants <- validate_generated_quantities(gen_quants) - gq_fit <- compute_gen_quants(fit_matrix, generated, gen_quants) - fit_matrix <- posterior::bind_draws(fit_matrix, gq_fit, along = "variable") + if(!is.null(dquants)){ + dquants <- validate_derived_quantities(dquants) + dq_fit <- compute_dquants(fit_matrix, generated, dquants) + fit_matrix <- posterior::bind_draws(fit_matrix, dq_fit, along = "variable") - gq_variable <- compute_gen_quants(variables, generated, gen_quants) - variables <- posterior::bind_draws(variables, gq_variable, along = "variable") + dq_variable <- compute_dquants(variables, generated, dquants) + variables <- posterior::bind_draws(variables, dq_variable, along = "variable") } shared_vars <- intersect(posterior::variables(variables), @@ -857,68 +891,6 @@ check_stats <- function(stats, datasets, thin_ranks, } } -#' Create a definition of generated quantities evaluated in R. -#' -#' When the expression contains non-library functions/objects, and parallel processing -#' is enabled, those must be -#' named in the `.globals` parameter (hopefully we'll be able to detect those -#' automatically in the future). Note that [recompute_SBC_statistics()] currently -#' does not use parallel processing, so `.globals` don't need to be set. -#' -#' @param ... named expressions representing the quantitites -#' @param .globals A list of names of objects that are defined -#' in the global environment and need to present for the gen. quants. to evaluate. -#' It is added to the `globals` argument to [future::future()], to make those -#' objects available on all workers. -#' @export -generated_quantities <- function(..., .globals = list()) { - structure(rlang::enquos(..., .named = TRUE), - class = "SBC_generated_quantities", - globals = .globals - ) -} - -#' @export -validate_generated_quantities <- function(x) { - stopifnot(inherits(x, "SBC_generated_quantities")) - invisible(x) -} - -#' @export -bind_generated_quantities <- function(gq1, gq2) { - validate_generated_quantities(gq1) - validate_generated_quantities(gq2) - structure(c(gq1, gq2), - class = "SBC_generated_quantities", - globals = bind_globals(attr(gq1, "globals"), attr(gq2, "globals"))) -} - -#'@export -compute_gen_quants <- function(draws, generated, gen_quants) { - gen_quants <- validate_generated_quantities(gen_quants) - draws_rv <- posterior::as_draws_rvars(draws) - - draws_env <- list2env(draws_rv) - if(!is.null(generated)) { - if(!is.list(generated)) { - stop("compute_gen_quants assumes that generated is a list, but this is not the case") - } - generated_env <- list2env(generated, parent = draws_env) - - data_mask <- rlang::new_data_mask(bottom = generated_env, top = draws_env) - } else { - data_mask <- rlang::new_data_mask(bottom = draws_env) - } - - eval_func <- function(gq) { - # Wrap the expression in `rdo` which will mostly do what we need - # all the tricks are just to have the correct environment when we need it - wrapped_gq <- rlang::new_quosure(rlang::expr(posterior::rdo(!!rlang::get_expr(gq))), rlang::get_env(gq)) - rlang::eval_tidy(wrapped_gq, data = data_mask) - } - rvars <- lapply(gen_quants, FUN = eval_func) - do.call(posterior::draws_rvars, rvars) -} #' @title Recompute SBC statistics without refitting models. #' @description Delegates directly to `recompute_SBC_statistics()`. @@ -941,7 +913,7 @@ recompute_statistics <- function(...) { #' Recompute SBC statistics without refitting models. #' #' Useful for example to recompute SBC ranks with a different choice of `thin_ranks` -#' or added generated quantities. +#' or added derived quantities. #' @return An S3 object of class `SBC_results` with updated `$stats` and `$default_diagnostics` fields. #' @param backend backend used to fit the results. Used to pull various defaults #' and other setting influencing the computation of statistics. @@ -950,10 +922,18 @@ recompute_statistics <- function(...) { recompute_SBC_statistics <- function(old_results, datasets, backend, thin_ranks = SBC_backend_default_thin_ranks(backend), ensure_num_ranks_divisor = 2, - gen_quants = NULL) { + dquants = NULL, gen_quants = NULL) { validate_SBC_results(old_results) validate_SBC_datasets(datasets) + if(!is.null(gen_quants)) { + warning("gen_quants argument is deprecated, use dquants") + if(is.null(dquants)) { + dquants <- gen_quants + } + } + + if(length(old_results) != length(datasets)) { stop("The number of fits in old_results does not match the number of simulations") } @@ -976,7 +956,7 @@ recompute_SBC_statistics <- function(old_results, datasets, backend, generated = datasets$generated[[i]], thin_ranks = thin_ranks, ensure_num_ranks_divisor = ensure_num_ranks_divisor, - gen_quants = gen_quants, + dquants = dquants, backend = backend) new_stats_list[[i]]$sim_id <- i new_stats_list[[i]] <- dplyr::select(new_stats_list[[i]], sim_id, tidyselect::everything()) diff --git a/README.md b/README.md index 1da10e8..0a11ecd 100755 --- a/README.md +++ b/README.md @@ -65,7 +65,7 @@ plot_ecdf_diff(results_sd) The diagnostic plots show no problems in this case. As with any other software test, we can observe clear failures, but absence of failures does not imply correctness. We can however make the SBC check more thorough by using a lot of -simulations and including suitable generated quantities to guard against +simulations and including suitable derived quantities to guard against [known limitations of vanilla SBC](https://hyunjimoon.github.io/SBC/articles/limits_of_SBC.html). ## Paralellization @@ -99,7 +99,8 @@ With a little additional work, you can integrate SBC with any exact or approxima ## References * Theoretical support - * [Validating Bayesian Inference Algorithms with Simulation-Based Calibration](https://arxiv.org/pdf/1804.06788.pdf) Talts, Betancourt, Simpson, Vehtari, Gelman, 2018 + * [Simulation-Based Calibration Checking for Bayesian Computation: The Choice of Test Quantities Shapes Sensitivity](https://arxiv.org/abs/2211.02383v1) Modrák, Moon, Kim, Bürkner, Huurre, Faltejsková, Gelman, Vehtari, 2022 + * [Validating Bayesian Inference Algorithms with Simulation-Based Calibration](http://www.stat.columbia.edu/~gelman/research/unpublished/sbc.pdf) Talts, Betancourt, Simpson, Vehtari, Gelman, 2018 * [Graphical Test for Discrete Uniformity and its Applications in Goodness of Fit Evaluation and Multiple Sample Comparison](https://arxiv.org/abs/2103.10522) Säilynoja, Bürkner, Vehtari, 2021 * [Bayesian Workflow](https://arxiv.org/abs/2011.01808), Gelman et al., 2020 * [Toward a principled Bayesian workflow in cognitive science](https://psycnet.apa.org/record/2020-43606-001) Schad, Betancourt, Vasishth, 2021 diff --git a/_pkgdown.yml b/_pkgdown.yml index 79ac2b3..3e32d1a 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -90,7 +90,9 @@ reference: - contents: - compute_SBC - contains("SBC_results") - - generated_quantities + - contains("derived_quantities") + - contains("dquants") + - bind_globals - SBC_statistics_from_single_fit - recompute_SBC_statistics - bind_results diff --git a/docs/404.html b/docs/404.html index 149411c..747d6cc 100644 --- a/docs/404.html +++ b/docs/404.html @@ -32,7 +32,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -145,7 +145,7 @@

Page not found (404)

-

Site built with pkgdown 2.0.5.

+

Site built with pkgdown 2.0.6.

diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index cecd59e..dee5374 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -120,7 +120,7 @@

License

-

Site built with pkgdown 2.0.5.

+

Site built with pkgdown 2.0.6.

diff --git a/docs/LICENSE.html b/docs/LICENSE.html index bf31acb..940f2a4 100644 --- a/docs/LICENSE.html +++ b/docs/LICENSE.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -124,7 +124,7 @@

MIT License

-

Site built with pkgdown 2.0.5.

+

Site built with pkgdown 2.0.6.

diff --git a/docs/articles/SBC.html b/docs/articles/SBC.html index 1ef2b25..692fac9 100644 --- a/docs/articles/SBC.html +++ b/docs/articles/SBC.html @@ -33,7 +33,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -127,7 +127,7 @@

Getting Started with SBC

Hyunji Moon, Martin Modrák, Shinyoung Kim

-

2022-07-04

+

2022-12-15

Source: vignettes/SBC.Rmd @@ -164,8 +164,8 @@

What is SBC?Talts et -al.

+described in Modrák et +al. which builds upon Talts et al.

This opens two principal use-cases of SBC:

  1. We have an algorithm that we trust is correct and a generator and @@ -426,7 +426,9 @@

    Computing Ranksresults <- compute_SBC(poisson_dataset, poisson_backend, cache_mode = "results", cache_location = file.path(cache_dir, "results")) +
    ## Results loaded from cache file 'results'
    ##  - 1 (1%) fits had at least one Rhat > 1.01. Largest Rhat was 1.015.
    +
    ##  - 94 (94%) fits had some steps rejected. Maximum number of rejections was 2.
    ## Not all diagnostics are OK.
     ## You can learn more by inspecting $default_diagnostics, $backend_diagnostics 
     ## and/or investigating $outputs/$messages/$warnings for detailed output from the backend.
    @@ -439,7 +441,7 @@

    Viewing Results

    We can now inspect the results to see if there were any errors and check individual stats:

    -
    +
     results$stats
    ## # A tibble: 100 × 15
     ##    sim_id variable simulated_value  rank z_score  mean median    sd   mad    q5
    @@ -464,13 +466,13 @@ 

    Plots are uniformly distributed. We can check the rank histogram and ECDF plots (see vignette("rank_visualizations") for description of the plots):

    -
    +
     plot_rank_hist(results)

    -
    +
     plot_ecdf(results)

    -
    +
     plot_ecdf_diff(results)

    Since our simulator and model do match and Stan works well, we see @@ -550,7 +552,7 @@

    Acknowledgements

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/articles/bad_parametrization.html b/docs/articles/bad_parametrization.html index 2d37169..bed371c 100644 --- a/docs/articles/bad_parametrization.html +++ b/docs/articles/bad_parametrization.html @@ -33,7 +33,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000
    @@ -127,7 +127,7 @@

    Discovering bad parametrization with SBC

    Martin Modrák

    -

    2022-07-04

    +

    2022-12-15

    Source: vignettes/bad_parametrization.Rmd @@ -303,7 +303,7 @@

    2022-07-04

    cache_mode = "results", cache_location = file.path(cache_dir, "model2"))
    ## Results loaded from cache file 'model2'
    -
    ##  - 10 (100%) fits had some steps rejected. Maximum number of rejections was 9.
    +
    ##  - 10 (100%) fits had some steps rejected. Maximum number of rejections was 6.
    ## Not all diagnostics are OK.
     ## You can learn more by inspecting $default_diagnostics, $backend_diagnostics 
     ## and/or investigating $outputs/$messages/$warnings for detailed output from the backend.
    @@ -335,7 +335,7 @@

    2022-07-04

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/articles/brms.html b/docs/articles/brms.html index 0a667b3..bc3a71f 100644 --- a/docs/articles/brms.html +++ b/docs/articles/brms.html @@ -33,7 +33,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000
    @@ -127,7 +127,7 @@

    SBC for brms models

    Martin Modrák

    -

    2022-07-04

    +

    2022-12-15

    Source: vignettes/brms.Rmd @@ -309,12 +309,15 @@

    Using custom generator coden_sims_generator <- SBC_generator_function(one_sim_generator, N = 18, K = 5)

    For increased sensitivity, we also add the log likelihood of the data -given parameters as a generated quantity that we’ll also monitor (see -the limits_of_SBC +given parameters as a derived quantity that we’ll also monitor (see the +limits_of_SBC vignette for discussion on why this is useful).

    -log_lik_gq_func <- generated_quantities(
    -  log_lik = sum(dnorm(y, b_Intercept + x * b_x + r_group[group], sigma, log = TRUE)))
    +log_lik_dq_func <- derived_quantities( + log_lik = sum(dnorm(y, b_Intercept + x * b_x + r_group[group], sigma, log = TRUE)) + # Testing CRPS, probably not worth it + #, CRPS = mean(scoringRules::crps_norm(y, b_Intercept + x * b_x + r_group[group], sigma)) + )
     set.seed(12239755)
     datasets_func <- generate_datasets(n_sims_generator, 100)
    @@ -335,7 +338,7 @@

    Using custom generator code
     results_func <- compute_SBC(datasets_func, backend_func, 
    -                                gen_quants = log_lik_gq_func, 
    +                                dquants = log_lik_dq_func, 
                         cache_mode = "results", 
                         cache_location = file.path(cache_dir, "func"))
    ## Results loaded from cache file 'func'
    @@ -386,7 +389,7 @@

    Using custom generator code
     results_func2 <- compute_SBC(datasets_func, backend_func2, 
    -                                 gen_quants = log_lik_gq_func, 
    +                                 dquants = log_lik_dq_func, 
                         cache_mode = "results", 
                         cache_location = file.path(cache_dir, "func2"))
    ## Results loaded from cache file 'func2'
    @@ -428,7 +431,7 @@

    Using custom generator code

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/articles/computational_algorithm1.html b/docs/articles/computational_algorithm1.html index 6ac4209..8361cd5 100644 --- a/docs/articles/computational_algorithm1.html +++ b/docs/articles/computational_algorithm1.html @@ -33,7 +33,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -127,7 +127,7 @@

    SBC for ADVI and optimizing in Stan (+HMMs)

    Hyunji Moon, Martin Modrák

    -

    2022-07-04

    +

    2022-12-15

    Source: vignettes/computational_algorithm1.Rmd @@ -288,8 +288,8 @@

    Example I - Poisson## variable width width_represented ci_low estimate ci_high ## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> ## 1 lambda 0.5 0.5 0.418 0.449 0.480 -## 2 lambda 0.8 0.8 0.751 0.778 0.803 -## 3 lambda 0.95 0.95 0.934 0.949 0.961 +## 2 lambda 0.8 0.8 0.752 0.779 0.804 +## 3 lambda 0.95 0.95 0.932 0.948 0.960 @@ -566,14 +566,14 @@

    Default ADVI## # A tibble: 8 × 3 ## variable ci_low ci_high ## <chr> <dbl> <dbl> -## 1 mu_background 0.820 0.882 -## 2 mu_signal 0.746 0.818 -## 3 rho[1] 0.864 0.918 -## 4 rho[2] 0.864 0.918 -## 5 t1[1] 0.805 0.869 -## 6 t1[2] 0.805 0.869 -## 7 t2[1] 0.831 0.891 -## 8 t2[2] 0.831 0.891 +## 1 mu_background 0.818 0.880 +## 2 mu_signal 0.752 0.823 +## 3 rho[1] 0.860 0.914 +## 4 rho[2] 0.860 0.914 +## 5 t1[1] 0.814 0.877 +## 6 t1[2] 0.814 0.877 +## 7 t2[1] 0.835 0.895 +## 8 t2[2] 0.835 0.895

    So the 90% central credible interval for mu_signal likely contains less than 82% of true values.

    For a crude result, the default ADVI setup we just tested is not @@ -630,13 +630,13 @@

    Full-rank## variable ci_low ci_high ## <chr> <dbl> <dbl> ## 1 mu_background 0.849 0.906 -## 2 mu_signal 0.888 0.937 -## 3 rho[1] 0.875 0.927 -## 4 rho[2] 0.875 0.927 +## 2 mu_signal 0.893 0.941 +## 3 rho[1] 0.873 0.925 +## 4 rho[2] 0.873 0.925 ## 5 t1[1] 0.866 0.920 ## 6 t1[2] 0.866 0.920 -## 7 t2[1] 0.879 0.930 -## 8 t2[2] 0.879 0.930 +## 7 t2[1] 0.877 0.929 +## 8 t2[2] 0.877 0.929

    This pattern where the default meanfield approximation is overconfident and the fullrank approximation is underconfident is in fact quite frequently seen, which motivated some experiments with a low @@ -692,11 +692,11 @@

    Meanfield + lower tolerance## variable ci_low ci_high ## <chr> <dbl> <dbl> ## 1 mu_background 0.827 0.888 -## 2 mu_signal 0.833 0.893 +## 2 mu_signal 0.835 0.895 ## 3 rho[1] 0.879 0.930 ## 4 rho[2] 0.879 0.930 -## 5 t1[1] 0.816 0.879 -## 6 t1[2] 0.816 0.879 +## 5 t1[1] 0.814 0.877 +## 6 t1[2] 0.814 0.877 ## 7 t2[1] 0.844 0.902 ## 8 t2[2] 0.844 0.902

    This variant has somewhat lower overall mismatch, but tends to be @@ -752,27 +752,22 @@

    Summary= FALSE, cache_mode = "results", cache_location = file.path(cache_dir, "hmm_sample"))
    ## Results loaded from cache file 'hmm_sample'
    -
    ##  - 1 (2%) fits had at least one Rhat > 1.01. Largest Rhat was 1.019.
    -
    ##  - 1 (2%) fits had tail ESS undefined or less than half of the maximum rank, potentially skewing 
    -## the rank statistics. The lowest tail ESS was 154.
    -##  If the fits look good otherwise, increasing `thin_ranks` (via recompute_SBC_statistics) 
    -## or number of posterior draws (by refitting) might help.
    -
    ##  - 1 (2%) fits had divergent transitions. Maximum number of divergences was 51.
    +
    ##  - 2 (4%) fits had divergent transitions. Maximum number of divergences was 70.
    ## Not all diagnostics are OK.
     ## You can learn more by inspecting $default_diagnostics, $backend_diagnostics 
     ## and/or investigating $outputs/$messages/$warnings for detailed output from the backend.

    We get a small number of problematic fits, which we will ignore for now. We check that there are no obvious calibration problems:

    -
    +
     plot_ecdf_diff(res_hmm_sample)

    -
    +
     plot_rank_hist(res_hmm_sample)

    For the machine we built the vignette on, here are the distributions of times (for ADVI and optimizing) and time of longest chain (for HMC):

    -
    +
     hmm_time <- 
       rbind(
           data.frame(alg = "Optimizing", 
    @@ -807,7 +802,7 @@ 

    Summary @@ -820,7 +815,7 @@

    Example III - Hidden difference between the two states) and move to the log scale. So instead of mu_background and mu_signal we have an ordered vector log_mu:

    -
    +
     cat(readLines("stan/hmm_poisson_ordered.stan"), sep = "\n")
    data {
       int N; // Number of observations
    @@ -875,7 +870,7 @@ 

    Example III - Hidden that it implies a slightly different prior on the active (higher mean) state. Here is how we can generate data with this mildly different prior (we need rejection sampling to fulfill the ordering constraint):

    -
    +
     generator_HMM_ordered <- function(N) {
       
       # Rejection sampling for ordered mu with the correct priors
    @@ -922,10 +917,10 @@ 

    Example III - Hidden }

    So let us build a default variational backend and fit it to just 20 simulations.

    -
    +
     model_HMM_ordered <- cmdstan_model("stan/hmm_poisson_ordered.stan")
     backend_HMM_ordered <- SBC_backend_cmdstan_variational(model_HMM_ordered, n_retries_init = 3)
    -
    +
     set.seed(12333654)
     ds_hmm_ordered <- generate_datasets(
       SBC_generator_function(generator_HMM_ordered, N = 100), 
    @@ -937,10 +932,10 @@ 

    Example III - Hidden
    ## Results loaded from cache file 'hmm_ordered'

    Immediately we see that the log_mu[1] variable is heavily miscalibrated.

    -
    +
     plot_ecdf_diff(res_hmm_ordered)

    -
    +
     plot_rank_hist(res_hmm_ordered)

    What changed? To understand that we need to remember how Stan represents @@ -956,7 +951,7 @@

    Example III - Hidden complex correlation structure between the unconstrained parameters that the ADVI algorithm is unable to handle well.

    Even trying the fullrank variant does not help:

    -
    +
     backend_HMM_ordered_fullrank <- 
       SBC_backend_cmdstan_variational(model_HMM_ordered,
                                       algorithm = "fullrank", n_retries_init = 3)
    @@ -966,14 +961,14 @@ 

    Example III - Hidden cache_mode = "results", cache_location = file.path(cache_dir, "hmm_ordered_fullrank"))

    ## Results loaded from cache file 'hmm_ordered_fullrank'

    The results are still strongly miscalibrated.

    -
    +
     plot_ecdf_diff(res_hmm_ordered_fullrank)

    -
    +
     plot_rank_hist(res_hmm_ordered_fullrank)

    To have a complete overview we may also try the optimizing fit:

    -
    +
     model_HMM_ordered_rstan <- stan_model("stan/hmm_poisson_ordered.stan")
     
     res_hmm_ordered_optimizing <- compute_SBC(
    @@ -984,10 +979,10 @@ 

    Example III - Hidden

    in this case, optimizing has better calibration for log_mu, but worse calibration for rho than ADVI.

    -
    +
     plot_ecdf_diff(res_hmm_ordered_optimizing)

    -
    +
     plot_rank_hist(res_hmm_ordered_optimizing)

    @@ -1048,7 +1043,7 @@

    References

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson-1.png b/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson-1.png index 346da2d..997bd08 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson-1.png and b/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson-1.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson-2.png b/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson-2.png index 08aee5e..3228cce 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson-2.png and b/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson-2.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson_100-1.png b/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson_100-1.png index 29acea7..6b5ce3d 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson_100-1.png and b/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson_100-1.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson_100-2.png b/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson_100-2.png index 9aae60f..aba7c4b 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson_100-2.png and b/docs/articles/computational_algorithm1_files/figure-html/ecdf_rank_poisson_100-2.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_2_coverage-1.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_2_coverage-1.png index 08947b6..c58c851 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_2_coverage-1.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_2_coverage-1.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_2_ecdf_ranks-1.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_2_ecdf_ranks-1.png index 3355d06..52f1c9b 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_2_ecdf_ranks-1.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_2_ecdf_ranks-1.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_2_ecdf_ranks-2.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_2_ecdf_ranks-2.png index 379bf36..900efb4 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_2_ecdf_ranks-2.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_2_ecdf_ranks-2.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_coverage-1.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_coverage-1.png index 94d364f..7806418 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_coverage-1.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_coverage-1.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_ecdf_ranks-1.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_ecdf_ranks-1.png index 8d81c1b..9e3b138 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_ecdf_ranks-1.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_ecdf_ranks-1.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_ecdf_ranks-2.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_ecdf_ranks-2.png index 12c12bc..4d844c1 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_ecdf_ranks-2.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_ecdf_ranks-2.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_fullrank_coverage-1.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_fullrank_coverage-1.png index abaaa89..4ce28c0 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_fullrank_coverage-1.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_fullrank_coverage-1.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_fullrank_ecdf_ranks-1.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_fullrank_ecdf_ranks-1.png index 89148ee..93fa917 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_fullrank_ecdf_ranks-1.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_fullrank_ecdf_ranks-1.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_fullrank_ecdf_ranks-2.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_fullrank_ecdf_ranks-2.png index 9e57a59..cd575bb 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_fullrank_ecdf_ranks-2.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_fullrank_ecdf_ranks-2.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_lowtol_coverage-1.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_lowtol_coverage-1.png index 4ed7527..88f74c0 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_lowtol_coverage-1.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_lowtol_coverage-1.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_lowtol_ecdf_ranks-1.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_lowtol_ecdf_ranks-1.png index 2aabd1f..394b883 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_lowtol_ecdf_ranks-1.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_lowtol_ecdf_ranks-1.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_lowtol_ecdf_ranks-2.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_lowtol_ecdf_ranks-2.png index c8e8bd7..8890836 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_lowtol_ecdf_ranks-2.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_lowtol_ecdf_ranks-2.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_ecdf_ranks-1.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_ecdf_ranks-1.png index b9efcf9..68b27f6 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_ecdf_ranks-1.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_ecdf_ranks-1.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_ecdf_ranks-2.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_ecdf_ranks-2.png index 2f324f9..18cf158 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_ecdf_ranks-2.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_ecdf_ranks-2.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_fullrank_ecdf_ranks-1.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_fullrank_ecdf_ranks-1.png index 5601438..2a60bfc 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_fullrank_ecdf_ranks-1.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_fullrank_ecdf_ranks-1.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_fullrank_ecdf_ranks-2.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_fullrank_ecdf_ranks-2.png index b3f9c3e..f7aad01 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_fullrank_ecdf_ranks-2.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_ordered_fullrank_ecdf_ranks-2.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_sample_ecdf_ranks-1.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_sample_ecdf_ranks-1.png index e5179ef..adad8f0 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_sample_ecdf_ranks-1.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_sample_ecdf_ranks-1.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_sample_ecdf_ranks-2.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_sample_ecdf_ranks-2.png index d812c0b..f36fee4 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_sample_ecdf_ranks-2.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_sample_ecdf_ranks-2.png differ diff --git a/docs/articles/computational_algorithm1_files/figure-html/hmm_time-1.png b/docs/articles/computational_algorithm1_files/figure-html/hmm_time-1.png index 8f1b7ba..050d5ea 100644 Binary files a/docs/articles/computational_algorithm1_files/figure-html/hmm_time-1.png and b/docs/articles/computational_algorithm1_files/figure-html/hmm_time-1.png differ diff --git a/docs/articles/discrete_vars.html b/docs/articles/discrete_vars.html index d242305..abf75de 100644 --- a/docs/articles/discrete_vars.html +++ b/docs/articles/discrete_vars.html @@ -33,7 +33,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000

    @@ -128,7 +128,7 @@

    SBC with discrete parameters in Stan and

    Martin Modrák

    -

    2022-07-04

    +

    2022-12-15

    Source: vignettes/discrete_vars.Rmd @@ -256,24 +256,24 @@

    Stan version and debugging
     set.seed(85394672)
     datasets_1 <- generate_datasets(generator_1, 30)

    -

    Additionally, we’ll add a generated quantity expressing the total +

    Additionally, we’ll add a derived quantity expressing the total log-likelihood of data given the fitted parameters. The expression -within the generated_quantities() call is evaluated for -both prior and posterior draws and included as another variable in SBC -checks. It turns out this type of generated quantities can increase the +within the derived_quantities() call is evaluated for both +prior and posterior draws and included as another variable in SBC +checks. It turns out this type of derived quantities can increase the sensitivity of the SBC against some issues in the model. See vignette("limits_of_SBC") for a more detailed discussion of this.

    -log_lik_gq <- generated_quantities(log_lik = sum(dpois(y, ifelse(1:T < s, e, l), log = TRUE)))
    +log_lik_dq <- derived_quantities(log_lik = sum(dpois(y, ifelse(1:T < s, e, l), log = TRUE)))

    So finally, lets actually compute SBC:

     results_1 <- compute_SBC(datasets_1, backend_1, 
                         cache_mode = "results", 
                         cache_location = file.path(cache_dir, "model1"),
    -                    gen_quants = log_lik_gq)
    + dquants = log_lik_dq)
    ## Results loaded from cache file 'model1'
    -
    ##  - 5 (17%) fits had at least one Rhat > 1.01. Largest Rhat was NA.
    +
    ##  - 4 (13%) fits had at least one Rhat > 1.01. Largest Rhat was NA.
    ##  - 20 (67%) fits had tail ESS undefined or less than half of the maximum rank, potentially skewing 
     ## the rank statistics. The lowest tail ESS was NA.
     ##  If the fits look good otherwise, increasing `thin_ranks` (via recompute_SBC_statistics) 
    @@ -297,12 +297,12 @@ 

    Stan version and debugging## # A tibble: 30 × 15 ## sim_id variable simulated_value rank z_score mean median sd mad ## <int> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> -## 1 1 s 3 185 0.0182 2.97 3 1.61 2.97 +## 1 1 s 3 186 0.0200 2.97 3 1.59 2.97 ## 2 2 s 1 24 -1.90 2.02 2 0.537 0 ## 3 3 s 4 126 -1.37 4.67 5 0.489 0 ## 4 4 s 1 10 -2.85 2.86 3 0.651 0 ## 5 5 s 5 397 2.76 2.86 3 0.775 0 -## 6 6 s 2 271 0.0449 1.94 1 1.42 0 +## 6 6 s 2 290 0.118 1.84 1 1.35 0 ## 7 7 s 3 0 -Inf 4 4 0 0 ## 8 8 s 2 129 -0.594 2.87 3 1.46 1.48 ## 9 9 s 2 0 -6.84 2.99 3 0.144 0 @@ -315,7 +315,7 @@

    Stan version and debuggingLooking at the ecdf_diff plot we see that this seems to compromise heavily the inference for s, but the other parameters do not show such bad behaviour. Note that the -log_lik generated quantity shows even starker failure than +log_lik derived quantity shows even starker failure than s, so it indeed poses a stricter check in this scenario.

    @@ -376,7 +376,7 @@ 

    Stan version and debuggingset.seed(5846502) datasets_2 <- generate_datasets(generator_2, 30) results_2 <- compute_SBC(datasets_2, backend_1, - gen_quants = log_lik_gq, + dquants = log_lik_dq, cache_mode = "results", cache_location = file.path(cache_dir, "model2"))

    ## Results loaded from cache file 'model2'
    @@ -401,16 +401,16 @@

    Stan version and debuggingset.seed(54321488) datasets_2_more <- generate_datasets(generator_2, 100) results_2_more <- compute_SBC(datasets_2_more, backend_1, - gen_quants = log_lik_gq, + dquants = log_lik_dq, cache_mode = "results", cache_location = file.path(cache_dir, "model3"))

    ## Results loaded from cache file 'model3'
    ##  - 15 (15%) fits had at least one Rhat > 1.01. Largest Rhat was NA.
    -
    ##  - 73 (73%) fits had tail ESS undefined or less than half of the maximum rank, potentially skewing 
    +
    ##  - 72 (72%) fits had tail ESS undefined or less than half of the maximum rank, potentially skewing 
     ## the rank statistics. The lowest tail ESS was NA.
     ##  If the fits look good otherwise, increasing `thin_ranks` (via recompute_SBC_statistics) 
     ## or number of posterior draws (by refitting) might help.
    -
    ##  - 7 (7%) fits had divergent transitions. Maximum number of divergences was 20.
    +
    ##  - 9 (9%) fits had divergent transitions. Maximum number of divergences was 25.
    ## Not all diagnostics are OK.
     ## You can learn more by inspecting $default_diagnostics, $backend_diagnostics 
     ## and/or investigating $outputs/$messages/$warnings for detailed output from the backend.
    @@ -424,7 +424,7 @@

    Stan version and debugging

    Now - as far as this amount of SBC steps can see, the model is good and we get good behaviour for both the continuous and the discrete -parameters and the log_lik generated quantity. Hooray!

    +parameters and the log_lik derived quantity. Hooray!

    JAGS version @@ -469,12 +469,12 @@

    JAGS version
     datasets_2_all <- bind_datasets(datasets_2, datasets_2_more)
     results_jags <- compute_SBC(datasets_2_all, backend_jags,
    -                            gen_quants = log_lik_gq,
    +                            dquants = log_lik_dq,
                             cache_mode = "results",
                             cache_location = file.path(cache_dir_jags, "rjags"))

    ## Results loaded from cache file 'rjags'
    -
    ##  - 21 (16%) fits had at least one Rhat > 1.01. Largest Rhat was NA.
    -
    ##  - 95 (73%) fits had tail ESS undefined or less than half of the maximum rank, potentially skewing 
    +
    ##  - 20 (15%) fits had at least one Rhat > 1.01. Largest Rhat was NA.
    +
    ##  - 93 (72%) fits had tail ESS undefined or less than half of the maximum rank, potentially skewing 
     ## the rank statistics. The lowest tail ESS was NA.
     ##  If the fits look good otherwise, increasing `thin_ranks` (via recompute_SBC_statistics) 
     ## or number of posterior draws (by refitting) might help.
    @@ -550,12 +550,12 @@

    JAGS version
     results_jags_marginalized <- compute_SBC(datasets_2_all, backend_jags_marginalized,
    -                                         gen_quants = log_lik_gq,
    +                                         dquants = log_lik_dq,
                             cache_mode = "results",
                             cache_location = file.path(cache_dir_jags, "rjags_marginalized"))

    ## Results loaded from cache file 'rjags_marginalized'
    -
    ##  - 24 (18%) fits had at least one Rhat > 1.01. Largest Rhat was NA.
    -
    ##  - 89 (68%) fits had tail ESS undefined or less than half of the maximum rank, potentially skewing 
    +
    ##  - 26 (20%) fits had at least one Rhat > 1.01. Largest Rhat was NA.
    +
    ##  - 93 (72%) fits had tail ESS undefined or less than half of the maximum rank, potentially skewing 
     ## the rank statistics. The lowest tail ESS was NA.
     ##  If the fits look good otherwise, increasing `thin_ranks` (via recompute_SBC_statistics) 
     ## or number of posterior draws (by refitting) might help.
    @@ -590,7 +590,7 @@

    JAGS version

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/articles/discrete_vars_files/figure-html/ranks_jags-1.png b/docs/articles/discrete_vars_files/figure-html/ranks_jags-1.png index e935c69..33b069b 100644 Binary files a/docs/articles/discrete_vars_files/figure-html/ranks_jags-1.png and b/docs/articles/discrete_vars_files/figure-html/ranks_jags-1.png differ diff --git a/docs/articles/discrete_vars_files/figure-html/ranks_jags-2.png b/docs/articles/discrete_vars_files/figure-html/ranks_jags-2.png index af41a33..ee38b00 100644 Binary files a/docs/articles/discrete_vars_files/figure-html/ranks_jags-2.png and b/docs/articles/discrete_vars_files/figure-html/ranks_jags-2.png differ diff --git a/docs/articles/discrete_vars_files/figure-html/ranks_jags_marginalized-1.png b/docs/articles/discrete_vars_files/figure-html/ranks_jags_marginalized-1.png index 9bf4f06..f1ebb9e 100644 Binary files a/docs/articles/discrete_vars_files/figure-html/ranks_jags_marginalized-1.png and b/docs/articles/discrete_vars_files/figure-html/ranks_jags_marginalized-1.png differ diff --git a/docs/articles/discrete_vars_files/figure-html/ranks_jags_marginalized-2.png b/docs/articles/discrete_vars_files/figure-html/ranks_jags_marginalized-2.png index 2257acb..2749716 100644 Binary files a/docs/articles/discrete_vars_files/figure-html/ranks_jags_marginalized-2.png and b/docs/articles/discrete_vars_files/figure-html/ranks_jags_marginalized-2.png differ diff --git a/docs/articles/discrete_vars_files/figure-html/results1_plots-1.png b/docs/articles/discrete_vars_files/figure-html/results1_plots-1.png index 6bd273c..bc8653f 100644 Binary files a/docs/articles/discrete_vars_files/figure-html/results1_plots-1.png and b/docs/articles/discrete_vars_files/figure-html/results1_plots-1.png differ diff --git a/docs/articles/discrete_vars_files/figure-html/results1_plots-2.png b/docs/articles/discrete_vars_files/figure-html/results1_plots-2.png index 24a8368..47a5397 100644 Binary files a/docs/articles/discrete_vars_files/figure-html/results1_plots-2.png and b/docs/articles/discrete_vars_files/figure-html/results1_plots-2.png differ diff --git a/docs/articles/discrete_vars_files/figure-html/results_2_all_plots-1.png b/docs/articles/discrete_vars_files/figure-html/results_2_all_plots-1.png index 962f448..9657c01 100644 Binary files a/docs/articles/discrete_vars_files/figure-html/results_2_all_plots-1.png and b/docs/articles/discrete_vars_files/figure-html/results_2_all_plots-1.png differ diff --git a/docs/articles/discrete_vars_files/figure-html/results_2_all_plots-2.png b/docs/articles/discrete_vars_files/figure-html/results_2_all_plots-2.png index 30f1812..30c788e 100644 Binary files a/docs/articles/discrete_vars_files/figure-html/results_2_all_plots-2.png and b/docs/articles/discrete_vars_files/figure-html/results_2_all_plots-2.png differ diff --git a/docs/articles/discrete_vars_files/figure-html/results_2_plots-1.png b/docs/articles/discrete_vars_files/figure-html/results_2_plots-1.png index 4515ea2..7015412 100644 Binary files a/docs/articles/discrete_vars_files/figure-html/results_2_plots-1.png and b/docs/articles/discrete_vars_files/figure-html/results_2_plots-1.png differ diff --git a/docs/articles/discrete_vars_files/figure-html/results_2_plots-2.png b/docs/articles/discrete_vars_files/figure-html/results_2_plots-2.png index 38556e0..064d2e7 100644 Binary files a/docs/articles/discrete_vars_files/figure-html/results_2_plots-2.png and b/docs/articles/discrete_vars_files/figure-html/results_2_plots-2.png differ diff --git a/docs/articles/implementing_backends.html b/docs/articles/implementing_backends.html index 3a705d3..c38216b 100644 --- a/docs/articles/implementing_backends.html +++ b/docs/articles/implementing_backends.html @@ -33,7 +33,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000
    @@ -128,7 +128,7 @@

    Implementing a new backend (algorithm) +

    Martin Modrák

    -

    2022-07-04

    +

    2022-12-15

    Source: vignettes/implementing_backends.Rmd @@ -275,13 +275,14 @@

    Minimal backend support thin_ranks = 1, cache_mode = "results", cache_location = file.path(cache_dir,"poisson"))

    +
    ## Results loaded from cache file 'poisson'

    We have set thin_ranks = 1 as no thinning is needed (the draws are i.i.d. by construction).

    The rank and ecdf plots show no big problems

    -
    +
     plot_rank_hist(res_poisson)

    -
    +
     plot_ecdf_diff(res_poisson)

    This is not unexpected - we’ve used a large number of observations @@ -290,7 +291,7 @@

    Minimal backend support

    We can see that both variables are recovered almost exactly in almost all fits:

    -
    +
     plot_sim_estimated(res_poisson)

    @@ -307,7 +308,7 @@

    Additional backend improvementsthin_ranks = 1 argument to compute_SBC and will not assess convergence/autocorrelation via the R-hat and ESS diagnostics.

    -
    +
     SBC_backend_iid_draws.SBC_backend_glm <- function(backend) {
       TRUE
     }
    @@ -318,7 +319,7 @@

    Additional backend improvements

    To see some of the problems that glm can encounter, we’ll run a quite pathological logistic regression:

    -
    +
     problematic_data <- data.frame(y = rep(0:1, each = 100), x = 1:200)
     glm(y ~ x, data = problematic_data, family = "binomial")
    ## Warning: glm.fit: algorithm did not converge
    @@ -348,7 +349,7 @@

    Additional backend improvementsglm class:

    -
    +
     SBC_fit_to_diagnostics.glm <- function(fit, fit_output, fit_messages, fit_warnings) {
       res <- data.frame(
         probs_0_1 = any(grepl("fitted probabilities numerically 0 or 1 occurred", fit_warnings)),
    @@ -360,7 +361,7 @@ 

    Additional backend improvements}

    Having a custom class let’s us implement a summary implementation for our diagnostics:

    -
    +
     summary.SBC_glm_diagnostics <- function(x) {
       summ <- list(
         n_fits = nrow(x),
    @@ -378,7 +379,7 @@ 

    Additional backend improvementsSBC_results object.

    We’ll use our summary implementation for SBC_glm_diagnostics to create the messages:

    -
    +
     get_diagnostic_messages.SBC_glm_diagnostics <- function(x) {
       get_diagnostic_messages(summary(x))
     }
    @@ -479,7 +480,7 @@ 

    normal priors on the intercept and predictors. Note that we do some rejection sampling here to avoid using simulations where the generated response is the same or almost the same for all rows.

    -
    +
     generator_single_logistic <- function(formula, 
                                           template_data, 
                                           intercept_prior_loc = 0,
    @@ -532,7 +533,7 @@ 

    Well-informed model
    +
    -
    +
     res_indo_simple <- compute_SBC(datasets_indo_simple, backend_indo_simple,
                                        cache_mode = "results", 
                                        cache_location = file.path(cache_dir,"indo_simple"))
    +
    ## Results loaded from cache file 'indo_simple'

    The rank plots look good:

    -
    +
     plot_rank_hist(res_indo_simple)

    -
    +
     plot_ecdf_diff(res_indo_simple)

    The coverages are very tight

    -
    +
     plot_coverage(res_indo_simple)

    we can make this precise by inspecting the same results numerically:

    -
    +
     stats_effect <- res_indo_simple$stats[res_indo_simple$stats$variable == "rx1_indomethacin",]
     main_eff_coverage <- empirical_coverage(stats_effect, width = c(0.5,0.9, 0.95))
     main_eff_coverage
    @@ -575,13 +577,13 @@

    Well-informed model
    +
     plot_sim_estimated(res_indo_simple)

    There is a simulation where the posterior uncertainty is very large. This corresponds to observed data where the outcome is the same for all rows where the treatment was used:

    -
    +
     biggest_sd_sim <- res_indo_simple$stats$sim_id[
       which.max(res_indo_simple$stats$sd)]
     table(datasets_indo_simple$generated[[biggest_sd_sim]][c("outcome", "rx")])
    @@ -591,7 +593,7 @@

    Well-informed model## 1 281 295

    Filtering the extreme simulations out, we see that most commonly, we get a decently precise estimate.

    -
    +
     

    @@ -608,7 +610,7 @@

    Badly-informed model\(N(0,1)\) prior on the age coefficient have a sensible scale. To make matters worse, we further subsample the data to contain only 100 rows.

    -
    +
     set.seed(21645222)
     
     indo_rct_complex <- droplevels(
    @@ -628,10 +630,11 @@ 

    Badly-informed modelbackend_indo_complex <- SBC_backend_glm(formula = formula_indo_complex, family = "binomial")

    Now we are ready to run SBC:

    -
    +
     res_indo_complex <- compute_SBC(datasets_indo_complex, backend_indo_complex,
                                        cache_mode = "results", 
                                        cache_location = file.path(cache_dir,"indo_complex"))
    +
    ## Results loaded from cache file 'indo_complex'
    ##  - 19 (4%) of fits had 0/1 probabilities.
    ##  - 2 (0%) of fits did not converge.
    ## Not all diagnostics are OK.
    @@ -641,10 +644,10 @@ 

    Badly-informed model
    +
     plot_rank_hist(res_indo_complex)

    -
    +
     plot_ecdf_diff(res_indo_complex)

    What happens is that many of the simulations result in extremely wide @@ -654,7 +657,7 @@

    Badly-informed model
    +
    @@ -672,7 +675,7 @@ 

    Badly-informed model, narrow priors< posterior problematic. We can obviously make things worse by also introducing a strong prior, concentrating away from zero which we’ll do here:

    -
    +
     set.seed(1685554)
     datasets_indo_complex_narrow <- generate_datasets(SBC_generator_function(
       generator_single_logistic, 
    @@ -683,10 +686,11 @@ 

    Badly-informed model, narrow priors< predictor_prior_loc = c(-2, 2), predictor_prior_width = 0.5), n_sims = 500)

    -
    +
     res_indo_complex_narrow <- compute_SBC(datasets_indo_complex_narrow, backend_indo_complex,
                                        cache_mode = "results", 
                                        cache_location = file.path(cache_dir,"indo_complex_narrow"))
    +
    ## Results loaded from cache file 'indo_complex_narrow'
    ##  - 169 (34%) of fits had 0/1 probabilities.
    ##  - 2 (0%) of fits did not converge.
    ## Not all diagnostics are OK.
    @@ -694,10 +698,10 @@ 

    Badly-informed model, narrow priors< ## and/or investigating $outputs/$messages/$warnings for detailed output from the backend.

    This is enough to make basically all the variables poorly calibrated:

    -
    +
     plot_rank_hist(res_indo_complex_narrow)

    -
    +
     plot_ecdf_diff(res_indo_complex_narrow)

    @@ -706,7 +710,7 @@

    Well-informed model, narrow priors

    To make the analysis complete, we’ll also return to the simple, well-informed model, but use narrow priors.

    -
    +
     set.seed(3289542)
     datasets_indo_simple_narrow <- generate_datasets(SBC_generator_function(
       generator_single_logistic, 
    @@ -717,17 +721,18 @@ 

    Well-informed model, narrow priors predictor_prior_loc = c(-2, 2), predictor_prior_width = 0.5), n_sims = 500)

    -
    +
     res_indo_simple_narrow <- compute_SBC(datasets_indo_simple_narrow, backend_indo_simple,
                                        cache_mode = "results", 
                                        cache_location = file.path(cache_dir,"indo_simple_narrow"))
    +
    ## Results loaded from cache file 'indo_simple_narrow'

    Turns out that in this case, the likelihood is sometimes not enough to completely overwhelm the prior and the main treatment effect is poorly calibrated:

    -
    +
     plot_rank_hist(res_indo_simple_narrow)

    -
    +
     plot_ecdf_diff(res_indo_simple_narrow)

    @@ -763,7 +768,7 @@

    Conclusions

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/articles/index.html b/docs/articles/index.html index 7eb0680..e32219f 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000
    @@ -147,7 +147,7 @@

    Additional use cases and advanced topics

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/articles/indexing.html b/docs/articles/indexing.html index 5af0197..a9f9bb8 100644 --- a/docs/articles/indexing.html +++ b/docs/articles/indexing.html @@ -33,7 +33,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000
    @@ -127,7 +127,7 @@

    Discovering indexing errors with SBC

    Martin Modrák

    -

    2022-07-04

    +

    2022-12-15

    Source: vignettes/indexing.Rmd @@ -301,43 +301,46 @@

    2022-07-04

    results_regression_1 <- compute_SBC(datasets_regression, backend_regression_1, cache_mode = "results", cache_location = file.path(cache_dir, "regression1"))
    +
    ## Results loaded from cache file 'regression1'
    ##  - 7 (70%) fits had some steps rejected. Maximum number of rejections was 4.
    ## Not all diagnostics are OK.
     ## You can learn more by inspecting $default_diagnostics, $backend_diagnostics 
     ## and/or investigating $outputs/$messages/$warnings for detailed output from the backend.
    -
    +
     results_regression_2 <- compute_SBC(datasets_regression, backend_regression_2, 
                         cache_mode = "results", 
                         cache_location = file.path(cache_dir, "regression2"))
    +
    ## Results loaded from cache file 'regression2'
    ##  - 1 (10%) fits had at least one Rhat > 1.01. Largest Rhat was 1.011.
    ##  - 6 (60%) fits had some steps rejected. Maximum number of rejections was 4.
    ## Not all diagnostics are OK.
     ## You can learn more by inspecting $default_diagnostics, $backend_diagnostics 
     ## and/or investigating $outputs/$messages/$warnings for detailed output from the backend.
    -
    +
     results_regression_3 <- compute_SBC(datasets_regression, backend_regression_3, 
                         cache_mode = "results", 
                         cache_location = file.path(cache_dir, "regression3"))
    -
    ##  - 3 (30%) fits had some steps rejected. Maximum number of rejections was 3.
    -## Not all diagnostics are OK.
    +
    ## Results loaded from cache file 'regression3'
    +
    ##  - 3 (30%) fits had some steps rejected. Maximum number of rejections was 3.
    +
    ## Not all diagnostics are OK.
     ## You can learn more by inspecting $default_diagnostics, $backend_diagnostics 
     ## and/or investigating $outputs/$messages/$warnings for detailed output from the backend.

    Here we also use the caching feature to avoid recomputing the fits when recompiling this vignette. In practice, caching is not necessary but is often useful.

    -
    +
     plot_ecdf_diff(results_regression_1)

    -
    +
     plot_rank_hist(results_regression_1)

    As far as a quick SBC can see the first code is OK. You could verify further with more iterations but we tested the model for you and it is OK (although the implementation is not the best one).

    -
    +
     plot_ecdf_diff(results_regression_2)

    -
    +
     plot_rank_hist(results_regression_2)

    But the second model is actually not looking good. In fact there is @@ -347,10 +350,10 @@

    2022-07-04

    to the sigma variable (reusing the same x element leads to more similar predictions for each row, so sigma needs to be inflated to accommodate this)

    -
    +
     plot_ecdf_diff(results_regression_3)

    -
    +
     plot_rank_hist(results_regression_3)

    And the third model looks OK once again - and in fact we are pretty @@ -372,7 +375,7 @@

    2022-07-04

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/articles/limits_of_SBC.html b/docs/articles/limits_of_SBC.html index 109514d..2ed4558 100644 --- a/docs/articles/limits_of_SBC.html +++ b/docs/articles/limits_of_SBC.html @@ -33,7 +33,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000
    @@ -127,7 +127,7 @@

    Limits of SBC

    Martin Modrák

    -

    2022-07-04

    +

    2022-12-15

    Source: vignettes/limits_of_SBC.Rmd @@ -136,12 +136,16 @@

    2022-07-04

    -

    Here, we’ll walk through some problems that are hard/impossible to -diagnose with SBC. As usual the focus is on problems with models, -assuming our inference algorithm is correct. But for each of those -problems, one can imagine a corresponding failure in an algorithm — -although some of those failures are quite unlikely for actual +

    Here, we’ll walk through some problems that are hard to diagnose with +SBC in its default settings. As usual the focus is on problems with +models, assuming our inference algorithm is correct. But for each of +those problems, one can imagine a corresponding failure in an algorithm +— although some of those failures are quite unlikely for actual algorithms.

    +

    A more extensive theoretical discussion of those limits can be found +in the Simulation-Based +Calibration Checking for Bayesian Computation: The Choice of Test +Quantities Shapes Sensitivity preprint, additional examples at https://martinmodrak.github.io/sbc_test_quantities_paper/

     library(SBC)
     library(ggplot2)
    @@ -261,23 +265,22 @@ 

    SBC and minor changes to model= "results", cache_location = file.path(cache_dir, "minor_10"))

    ## Results loaded from cache file 'minor_10'
    -
    ##  - 1 (10%) fits had at least one Rhat > 1.01. Largest Rhat was 1.024.
    -
    ##  - 2 (20%) fits had some steps rejected. Maximum number of rejections was 1.
    +
    ##  - 3 (30%) fits had some steps rejected. Maximum number of rejections was 2.
    ## Not all diagnostics are OK.
     ## You can learn more by inspecting $default_diagnostics, $backend_diagnostics 
     ## and/or investigating $outputs/$messages/$warnings for detailed output from the backend.

    Not really…

    -
    +
     plot_rank_hist(results_minor_10)

    -
    +
     plot_ecdf_diff(results_minor_10)

    Will we have better luck with 100 simulations? (Note that we can use bind_results to combine multiple results, letting us start small, but not throw away the computation spent for the initial simulations)

    -
    +
     results_minor_100 <- bind_results(
       results_minor_10,
       compute_SBC(datasets_minor[11:100], backend_minor, 
    @@ -285,21 +288,21 @@ 

    SBC and minor changes to model= file.path(cache_dir, "minor_90")) )

    ## Results loaded from cache file 'minor_90'
    -
    ##  - 6 (7%) fits had at least one Rhat > 1.01. Largest Rhat was 1.02.
    -
    ##  - 16 (18%) fits had some steps rejected. Maximum number of rejections was 1.
    +
    ##  - 7 (8%) fits had at least one Rhat > 1.01. Largest Rhat was 1.02.
    +
    ##  - 13 (14%) fits had some steps rejected. Maximum number of rejections was 1.
    ## Not all diagnostics are OK.
     ## You can learn more by inspecting $default_diagnostics, $backend_diagnostics 
     ## and/or investigating $outputs/$messages/$warnings for detailed output from the backend.

    Here we see something suspicios with the sigma variable, but it is not very convincing.

    -
    +
     plot_rank_hist(results_minor_100)

    -
    +
     plot_ecdf_diff(results_minor_100)

    So let’s do additional 100 SBC steps

    -
    +
     results_minor_200 <- bind_results(
       results_minor_100,
       compute_SBC(datasets_minor[101:200], backend_minor, 
    @@ -307,17 +310,17 @@ 

    SBC and minor changes to model= file.path(cache_dir, "minor_next_100")) )

    ## Results loaded from cache file 'minor_next_100'
    -
    ##  - 6 (6%) fits had at least one Rhat > 1.01. Largest Rhat was 1.02.
    -
    ##  - 14 (14%) fits had some steps rejected. Maximum number of rejections was 1.
    +
    ##  - 9 (9%) fits had at least one Rhat > 1.01. Largest Rhat was 1.016.
    +
    ##  - 12 (12%) fits had some steps rejected. Maximum number of rejections was 2.
    ## Not all diagnostics are OK.
     ## You can learn more by inspecting $default_diagnostics, $backend_diagnostics 
     ## and/or investigating $outputs/$messages/$warnings for detailed output from the backend.

    OK, so this looks at least a bit conclusive, but still, the violation of uniformity is not very big.

    -
    +
     plot_rank_hist(results_minor_200)

    -
    +
     plot_ecdf_diff(results_minor_200)

    If we used more data points per simulation (here we simulated just @@ -329,35 +332,35 @@

    SBC and minor changes to model
    +
     plot_sim_estimated(results_minor_200, alpha = 0.5)

    Another way to investigate this is the coverage plot, showing the attained coverage of various central credible intervals.

    -
    +
     plot_coverage(results_minor_200)

    Or we can even directly inspect some intervals of interest:

    -
    +
     coverage <- empirical_coverage(results_minor_200$stats, width = c(0.5,0.9,0.95))
     coverage
    ## # A tibble: 6 × 6
     ##   variable width width_represented ci_low estimate ci_high
     ##   <chr>    <dbl>             <dbl>  <dbl>    <dbl>   <dbl>
    -## 1 mu        0.5               0.5   0.407    0.475   0.544
    -## 2 mu        0.9               0.9   0.862    0.91    0.942
    -## 3 mu        0.95              0.95  0.930    0.965   0.983
    -## 4 sigma     0.5               0.5   0.368    0.435   0.504
    -## 5 sigma     0.9               0.9   0.750    0.81    0.858
    -## 6 sigma     0.95              0.95  0.839    0.89    0.926
    -
    +## 1 mu        0.5               0.5   0.397    0.465   0.534
    +## 2 mu        0.9               0.9   0.856    0.905   0.938
    +## 3 mu        0.95              0.95  0.923    0.96    0.979
    +## 4 sigma     0.5               0.5   0.373    0.44    0.509
    +## 5 sigma     0.9               0.9   0.728    0.79    0.841
    +## 6 sigma     0.95              0.95  0.828    0.88    0.918
    +
     sigma_90_coverage_string <- paste0(round(100 * as.numeric(
       coverage[coverage$variable == "sigma" & coverage$width == 0.9, c("ci_low","ci_high")])),
       "%",
       collapse = " - ")

    where we see that for example for the 90% central credible interval -of sigma we would expect the actual coverage to be 75% - -86%.

    +of sigma we would expect the actual coverage to be 73% - +84%.

    Prior mismatch @@ -373,7 +376,7 @@

    Missing likelihood
    +
     single_sim_missing <- function(N) {
       mu <- rnorm(n = 1, mean = 0, sd = 1)
       y <- rnorm(n = N, mean = mu, sd = 1)
    @@ -389,7 +392,7 @@ 

    Missing likelihooddatasets_missing <- generate_datasets(generator_missing, n_sims = 200)

    And here is a model that just completely ignores the data, but has the right prior:

    -
    +
     cat(readLines("stan/missing_likelihood.stan"), sep = "\n")
    data {
       int<lower=0> N;
    @@ -403,7 +406,7 @@ 

    Missing likelihood
    +
     

    Now we’ll compute the results for 200 simulations:

    -
    +
     results_missing <- compute_SBC(datasets_missing, backend_missing, 
                         cache_mode = "results", 
                         cache_location = file.path(cache_dir, "missing"))
    ## Results loaded from cache file 'missing'
    -
    ##  - 16 (8%) fits had at least one Rhat > 1.01. Largest Rhat was 1.027.
    +
    ##  - 15 (8%) fits had at least one Rhat > 1.01. Largest Rhat was 1.03.
    ## Not all diagnostics are OK.
     ## You can learn more by inspecting $default_diagnostics, $backend_diagnostics 
     ## and/or investigating $outputs/$messages/$warnings for detailed output from the backend.

    And here are our rank plots:

    -
    +
     plot_rank_hist(results_missing)

    -
    +
     plot_ecdf_diff(results_missing)

    It’s just nothing out of the ordinary.

    @@ -443,7 +446,7 @@

    Missing likelihood
    +
     prior_sd <- c("mu" = 1)
     #prior_sd <- calculate_prior_sd(generate_datasets(generator_missing, 1000))
     plot_contraction(results_missing, prior_sd)
    @@ -456,37 +459,37 @@

    Missing likelihood
    +
     plot_sim_estimated(results_missing, alpha = 0.5)

    There is however even more powerful method - and that is to include -the likelihood in the SBC. This is most easily done by adding a -“generated quantity” to the SBC results - this is a function that is -evaluated within the context of the variables AND data. And it can be -added without recomputing the fits!

    -
    +the likelihood in the SBC. This is most easily done by adding a “derived
    +quantity” to the SBC results - this is a function that is evaluated
    +within the context of the variables AND data. And it can be added
    +without recomputing the fits!

    +
     normal_lpdf <- function(y, mu, sigma) {
       sum(dnorm(y, mean = mu, sd = sigma, log = TRUE))
     }
     
    -log_lik_gq <- generated_quantities(log_lik = normal_lpdf(y, mu, 1), 
    +log_lik_dq <- derived_quantities(log_lik = normal_lpdf(y, mu, 1), 
                                        .globals = "normal_lpdf" )
     
    -results_missing_gq <- recompute_SBC_statistics(
    +results_missing_dq <- recompute_SBC_statistics(
       results_missing, datasets_missing, 
    -  backend = backend_missing, gen_quants = log_lik_gq)
    -
    ##  - 19 (10%) fits had at least one Rhat > 1.01. Largest Rhat was 1.027.
    + backend = backend_missing, dquants = log_lik_dq)
    +
    ##  - 17 (8%) fits had at least one Rhat > 1.01. Largest Rhat was 1.03.
    ## Not all diagnostics are OK.
     ## You can learn more by inspecting $default_diagnostics, $backend_diagnostics 
     ## and/or investigating $outputs/$messages/$warnings for detailed output from the backend.

    The rank plots for the log_lik quantity immediately shows a severe problem:

    +
    +plot_ecdf_diff(results_missing_dq)
    +

    -plot_ecdf_diff(results_missing_gq)
    -

    -
    -plot_rank_hist(results_missing_gq)
    -

    +plot_rank_hist(results_missing_dq)

    +

    Partially missing likelihood @@ -495,7 +498,7 @@

    Partially missing likelihood
    +
     cat(readLines("stan/partially_missing_likelihood.stan"), sep = "\n")
    data {
       int<lower=0> N;
    @@ -516,7 +519,7 @@ 

    Partially missing likelihood
    +
     

    Let us use this model for the same set of simulations.

    -
    -results_missing_2 <- compute_SBC(datasets_missing, backend_missing_2, gen_quants = log_lik_gq, 
    +
    +results_missing_2 <- compute_SBC(datasets_missing, backend_missing_2, dquants = log_lik_dq, 
                         cache_mode = "results", 
                         cache_location = file.path(cache_dir, "missing_2"))
    -
    ## Results loaded from cache file 'missing_2' but it was computed with different thin_ranks/gen_quants/ensure_num_ranks_divisor.
    -## Calling recompute_SBC_statistics.
    -
    ##  - 20 (10%) fits had at least one Rhat > 1.01. Largest Rhat was 1.025.
    +
    ## Results loaded from cache file 'missing_2'
    +
    ##  - 17 (8%) fits had at least one Rhat > 1.01. Largest Rhat was 1.035.
    ## Not all diagnostics are OK.
     ## You can learn more by inspecting $default_diagnostics, $backend_diagnostics 
     ## and/or investigating $outputs/$messages/$warnings for detailed output from the backend.

    The contraction plot would not show anything suspicious - we get decent contraction

    -
    +
     plot_contraction(results_missing_2, prior_sd, variables = "mu")

    Similarly, our posterior estimates now cluster around the true values.

    -
    +
     plot_sim_estimated(results_missing_2, variables = "mu", alpha = 0.5)

    Now contraction is pretty high, and mu is behaving well, -but our log_lik generated quantity shows a clear -problem

    -
    +but our log_lik derived quantity shows a clear problem

    +
     plot_ecdf_diff(results_missing_2)

    -
    +
     plot_rank_hist(results_missing_2)

    We could definitely find even smaller deviations than omitting half @@ -586,7 +587,7 @@

    Incorrect CorrelationsWe however generate posterior samples from a set of independent normal distributions that happen to have the correct mean and standard deviation, just the correlation is missing.

    -
    +
     set.seed(546852)
     
     mvn_sigma <- matrix(c(1, 0.8,0.8,1), nrow = 2)
    @@ -641,38 +642,38 @@ 

    Incorrect Correlations## Results loaded from cache file 'corr'

    Although the posterior is incorrect, the default univariate checks don’t show any problem even with 1000 simulations.

    -
    +
     plot_rank_hist(res_corr)

    -
    +
     plot_ecdf_diff(res_corr)

    We can however add derived quantities that depend on both elements of mu. We’ll try their sum, difference, product and the multivarite normal log likelihood

    -
    -gq_corr <- generated_quantities(sum = mu[1] + mu[2], 
    +
    +dq_corr <- derived_quantities(sum = mu[1] + mu[2], 
                                     diff = mu[1] - mu[2],
                                     prod = mu[1] * mu[2],
                                     mvn_log_lik = sum(mvtnorm::dmvnorm(y, mean = mu, sigma = mvn_sigma, log = TRUE)))
     
     
    -res_corr_gq  <- compute_SBC(datasets_correlated, backend_uncorr, keep_fits = FALSE,
    +res_corr_dq  <- compute_SBC(datasets_correlated, backend_uncorr, keep_fits = FALSE,
                             globals = analytic_backend_uncorr_globals,
    -                        gen_quants = gq_corr,
    +                        dquants = dq_corr,
                             cache_mode = "results", 
    -                        cache_location = file.path(cache_dir, "corr_gq"))
    -
    ## Results loaded from cache file 'corr_gq'
    + cache_location = file.path(cache_dir, "corr_dq"))
    +
    ## Results loaded from cache file 'corr_dq'

    We see that all of the derived quantities show problems, but with different strength of signal. We’ll especially note that the log likelihood is once again a very good choice, while sum is probably the worst of those tested.

    +
    +plot_rank_hist(res_corr_dq)
    +

    -plot_rank_hist(res_corr_gq)
    -

    -
    -plot_ecdf_diff(res_corr_gq)
    -

    +plot_ecdf_diff(res_corr_dq)
    +

    @@ -693,7 +694,7 @@

    Incorrect Correlations

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_corr_dq-1.png b/docs/articles/limits_of_SBC_files/figure-html/results_corr_dq-1.png new file mode 100644 index 0000000..40ee6af Binary files /dev/null and b/docs/articles/limits_of_SBC_files/figure-html/results_corr_dq-1.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_corr_dq-2.png b/docs/articles/limits_of_SBC_files/figure-html/results_corr_dq-2.png new file mode 100644 index 0000000..9f90e45 Binary files /dev/null and b/docs/articles/limits_of_SBC_files/figure-html/results_corr_dq-2.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_minor_100_plots-1.png b/docs/articles/limits_of_SBC_files/figure-html/results_minor_100_plots-1.png index 9bcbbc6..7d410ef 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_minor_100_plots-1.png and b/docs/articles/limits_of_SBC_files/figure-html/results_minor_100_plots-1.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_minor_100_plots-2.png b/docs/articles/limits_of_SBC_files/figure-html/results_minor_100_plots-2.png index 852b434..c790a61 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_minor_100_plots-2.png and b/docs/articles/limits_of_SBC_files/figure-html/results_minor_100_plots-2.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_minor_10_plots-1.png b/docs/articles/limits_of_SBC_files/figure-html/results_minor_10_plots-1.png index bfaf61d..68d3448 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_minor_10_plots-1.png and b/docs/articles/limits_of_SBC_files/figure-html/results_minor_10_plots-1.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_minor_10_plots-2.png b/docs/articles/limits_of_SBC_files/figure-html/results_minor_10_plots-2.png index 1f944e6..6ad4f41 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_minor_10_plots-2.png and b/docs/articles/limits_of_SBC_files/figure-html/results_minor_10_plots-2.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_coverage-1.png b/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_coverage-1.png index 47d78a4..0ff28a8 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_coverage-1.png and b/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_coverage-1.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_plots-1.png b/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_plots-1.png index 38f84a8..fe8fa28 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_plots-1.png and b/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_plots-1.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_plots-2.png b/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_plots-2.png index 7f45465..82be123 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_plots-2.png and b/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_plots-2.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_sim_estimated-1.png b/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_sim_estimated-1.png index 1a4bfeb..f2ba6b3 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_sim_estimated-1.png and b/docs/articles/limits_of_SBC_files/figure-html/results_minor_200_sim_estimated-1.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_contraction-1.png b/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_contraction-1.png index 4618598..69e7ff6 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_contraction-1.png and b/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_contraction-1.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_plots-1.png b/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_plots-1.png index f97b06c..b31153d 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_plots-1.png and b/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_plots-1.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_plots-2.png b/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_plots-2.png index 7a64439..4df3ee6 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_plots-2.png and b/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_plots-2.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_sim_estimated-1.png b/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_sim_estimated-1.png index 5a2617d..94987c0 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_sim_estimated-1.png and b/docs/articles/limits_of_SBC_files/figure-html/results_missing_2_sim_estimated-1.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_missing_contraction-1.png b/docs/articles/limits_of_SBC_files/figure-html/results_missing_contraction-1.png index a0c8ab4..afb1fd3 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_missing_contraction-1.png and b/docs/articles/limits_of_SBC_files/figure-html/results_missing_contraction-1.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_missing_dq_plots-1.png b/docs/articles/limits_of_SBC_files/figure-html/results_missing_dq_plots-1.png new file mode 100644 index 0000000..63c9886 Binary files /dev/null and b/docs/articles/limits_of_SBC_files/figure-html/results_missing_dq_plots-1.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_missing_dq_plots-2.png b/docs/articles/limits_of_SBC_files/figure-html/results_missing_dq_plots-2.png new file mode 100644 index 0000000..2eb9447 Binary files /dev/null and b/docs/articles/limits_of_SBC_files/figure-html/results_missing_dq_plots-2.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_missing_plots-1.png b/docs/articles/limits_of_SBC_files/figure-html/results_missing_plots-1.png index 26e465d..4fdb70e 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_missing_plots-1.png and b/docs/articles/limits_of_SBC_files/figure-html/results_missing_plots-1.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_missing_plots-2.png b/docs/articles/limits_of_SBC_files/figure-html/results_missing_plots-2.png index c19cf45..b4581ed 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_missing_plots-2.png and b/docs/articles/limits_of_SBC_files/figure-html/results_missing_plots-2.png differ diff --git a/docs/articles/limits_of_SBC_files/figure-html/results_missing_sim_estimated-1.png b/docs/articles/limits_of_SBC_files/figure-html/results_missing_sim_estimated-1.png index b93cd1f..9955b58 100644 Binary files a/docs/articles/limits_of_SBC_files/figure-html/results_missing_sim_estimated-1.png and b/docs/articles/limits_of_SBC_files/figure-html/results_missing_sim_estimated-1.png differ diff --git a/docs/articles/overview_wide.png b/docs/articles/overview_wide.png index ec8847c..c95fbb0 100644 Binary files a/docs/articles/overview_wide.png and b/docs/articles/overview_wide.png differ diff --git a/docs/articles/rank_visualizations.html b/docs/articles/rank_visualizations.html index ee21aa4..ef090f1 100644 --- a/docs/articles/rank_visualizations.html +++ b/docs/articles/rank_visualizations.html @@ -33,7 +33,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000

    @@ -127,7 +127,7 @@

    SBC rank visualizations

    Martin Modrák

    -

    2022-07-04

    +

    2022-12-15

    Source: vignettes/rank_visualizations.Rmd @@ -419,7 +419,7 @@

    Side by side comparison

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/articles/rejection_sampling.html b/docs/articles/rejection_sampling.html index 91836d0..3202771 100644 --- a/docs/articles/rejection_sampling.html +++ b/docs/articles/rejection_sampling.html @@ -33,7 +33,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000
    @@ -127,7 +127,7 @@

    Rejection sampling in simulations

    Martin Modrák

    -

    2022-07-04

    +

    2022-12-15

    Source: vignettes/rejection_sampling.Rmd @@ -151,61 +151,38 @@

    2022-07-04

    certain condition we impose (e.g. that no observed count is larger than \(10^8\)). But does rejection sampling when generating simulations affect the validity of SBC?

    -

    Thanks to forum user Niko Huurre who derived the necessary math at Stan -Discourse discussion of the topic we know exactly when it is OK. -Briefly: for algorithms that only need to know the posterior density up -to a constant (which includes Stan and many others), it is OK as long as -the rejection criterion only uses observed data and not the unobserved -variables.

    +

    It turns out that it does not as long as the rejection criterion only +uses observed data and not the unobserved variables.

    We’ll first walk through the math and then show examples of both OK and problematic rejection sampling.

    The math

    -

    Let \(f\left(y\right)\) be the -probability that the simulated data \(y\) is rejected (usually a 0-1 function if -you have a clear idea what a “bad” dataset looks like, but could be -probabilistic if you’re relying on finicky diagnostics). The important -numbers are the probability of rejection for variable \(\theta\)

    +

    Let \(\mathtt{accept}(y)\) be the +probability the the simulated data \(y\) is accepted. Note that \(\mathtt{accept}\) uses only data as input +and would usually be a 0-1 function if you have a clear idea what a +“bad” dataset looks like, but could be probabilistic if you’re relying +on finicky diagnostics.

    +

    We define a variable \(a \sim +\text{Bernoulli}(\mathtt{accept}(y))\). Given the parameter space +\(\Theta\) and a specific \(\theta \in \Theta\), this implies a joint +distribution \(\pi(\theta, y, a)\) that +factorizes as \(\pi(\theta, y, a) = +\pi(a|y)\pi(y | \theta)\pi(\theta)\). We can then look at the +posterior conditional on accepting a dataset to see the claimed +invariance:

    \[ -L\left(\theta\right)=\int -f\left(y\right)\pi\left(y|\theta\right)\mathrm{d}y +\begin{equation} +\pi(\theta | y, a = 1) = \frac{\pi(a = 1 | y) \pi(y | +\theta)\pi(\theta)}{\int_\Theta \mathrm{d}\tilde\theta \: \pi(a = 1 | y) +\pi(y | \tilde\theta)\pi(\tilde\theta)} = +\frac{\pi(y | \theta)\pi(\theta)}{\int_\Theta \mathrm{d}\tilde\theta \: +\pi(y | \tilde\theta)\pi(\tilde\theta)} = \pi(\theta | y) +\end{equation} \]

    -

    and the total rate of rejections from the prior

    -

    \[ -R=\iint -f\left(y\right)\pi\left(y|\theta\right)\pi\left(\theta\right)\mathrm{d}y\mathrm{d}\theta=\int -L\left(\theta\right)\pi\left(\theta\right)\mathrm{d}\theta -\]

    -

    Rejecting the simulation when it generates “bad” data effectively -distorts the prior

    -

    \[ -\pi\left(\theta\right)\to\frac{L\left(\theta\right)}{R}\pi\left(\theta\right) -\]

    -

    and of course rejections change the generating distribution

    -

    \[ -\pi\left(y|\theta\right)\to\frac{f\left(y\right)}{L\left(\theta\right)}\pi\left(y|\theta\right) -\]

    -

    but crucially these changes cancel out when computing the posterior. -Before rejections we have:

    -

    \[ -\pi(\theta | y) \propto \pi(y | \theta) \pi(\theta) -\]

    -

    After rejections we have

    -

    \[ -\pi(\theta | y) \propto \frac{L(\theta)}{R} \pi(y | \theta) -\frac{f(y)}{L(\theta)} \pi(\theta) = \frac{f(y)}{R} \pi(y | \theta) -\pi(\theta) -\]

    -

    And since \(\frac{f(y)}{R}\) is a -constant for any given simulation (and hence the fit), the overall -posterior for Stan (and most other MCMC algorithms) is the same, because -Stan only needs the posterior density up to a constant. So whether we -take rejection into account or not, the model will match the generating -process. However, if \(f\) also -depended on \(\theta\), it would no -longer contribute a constant and we’ll get a mismatch between the -generator and model.

    +

    So whether we take rejection into account or not, the model will +match the generating process. However, if \(\mathtt{accept}\) also depended on \(\theta\), it would no longer contribute a +constant and we’ll get a mismatch between the generator and model.

    Practical examples @@ -408,7 +385,7 @@

    Take home message

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/articles/small_model_workflow.html b/docs/articles/small_model_workflow.html index e018bc8..943ea25 100644 --- a/docs/articles/small_model_workflow.html +++ b/docs/articles/small_model_workflow.html @@ -33,7 +33,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000
    @@ -127,7 +127,7 @@

    Small model implementation workflow

    Martin Modrák

    -

    2022-07-04

    +

    2022-12-15

    Source: vignettes/small_model_workflow.Rmd @@ -528,16 +528,16 @@

    Fixing ordering
     results_fixed_ordered$backend_diagnostics

    ##    sim_id max_chain_time n_failed_chains n_divergent n_max_treedepth n_rejects
    -## 1       1          0.505               0           7               0         0
    -## 2       2          0.715               0         145               0         0
    -## 3       3          0.539               0           0               0         0
    -## 4       4          0.461               0           0               0         0
    -## 5       5          2.524               0           0               0         0
    -## 6       6          0.723               0           0               0         0
    +## 1       1          0.484               0           7               0         0
    +## 2       2          0.777               0         145               0         0
    +## 3       3          0.556               0           0               0         0
    +## 4       4          0.501               0           0               0         0
    +## 5       5          2.629               0           0               0         0
    +## 6       6          0.665               0           0               0         0
     ## 7       7          0.498               0           0               0         0
    -## 8       8          0.440               0           0               0         0
    -## 9       9          0.361               0           0               0         0
    -## 10     10          0.354               0           0               0         0
    +## 8 8 0.455 0 0 0 0 +## 9 9 0.376 0 0 0 0 +## 10 10 0.374 0 0 0 0

    One of the fits has quite a lot of divergent transitions. Let’s look at the pairs plot for the model:

    This gives us no obvious problems.

     plot_rank_hist(results_fixed_ordered_subset)
    @@ -695,7 +695,7 @@

    Fixing degenerate components?## - No fits had divergent transitions. ## - No fits had iterations that saturated max treedepth. ## - No fits had steps rejected. -## - Maximum time per chain was 4.253 sec.

    +## - Maximum time per chain was 4.316 sec.

    And we can use bind_results to combine the new results with the previous fits to not waste our computational effort.

    diff --git a/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_200_coverage-1.png b/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_200_coverage-1.png index 78d5434..79a9ecc 100644 Binary files a/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_200_coverage-1.png and b/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_200_coverage-1.png differ diff --git a/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_200_plots-1.png b/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_200_plots-1.png index d796b85..73c101e 100644 Binary files a/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_200_plots-1.png and b/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_200_plots-1.png differ diff --git a/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_200_plots-2.png b/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_200_plots-2.png index a0c9f8a..673473e 100644 Binary files a/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_200_plots-2.png and b/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_200_plots-2.png differ diff --git a/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_plots-1.png b/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_plots-1.png index 6d456cc..b34b715 100644 Binary files a/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_plots-1.png and b/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_plots-1.png differ diff --git a/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_plots-2.png b/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_plots-2.png index e8866b2..81935c8 100644 Binary files a/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_plots-2.png and b/docs/articles/small_model_workflow_files/figure-html/results_beta_precision_fixed_prior_plots-2.png differ diff --git a/docs/authors.html b/docs/authors.html index 20e849d..cd6fde9 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000
    @@ -150,7 +150,7 @@

    Citation

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/index.html b/docs/index.html index e1a6259..296afd2 100644 --- a/docs/index.html +++ b/docs/index.html @@ -36,7 +36,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000
    @@ -134,7 +134,7 @@

    Installation
    -devtools::install_github("hyunjimoon/SBC")

    +devtools::install_github("hyunjimoon/SBC")

    Quick tour @@ -163,7 +163,7 @@

    Quick tourplot_rank_hist(results_sd) plot_ecdf_diff(results_sd)

    -

    The diagnostic plots show no problems in this case. As with any other software test, we can observe clear failures, but absence of failures does not imply correctness. We can however make the SBC check more thorough by using a lot of simulations and including suitable generated quantities to guard against known limitations of vanilla SBC.

    +

    The diagnostic plots show no problems in this case. As with any other software test, we can observe clear failures, but absence of failures does not imply correctness. We can however make the SBC check more thorough by using a lot of simulations and including suitable derived quantities to guard against known limitations of vanilla SBC.

    Paralellization @@ -192,7 +192,9 @@

    ReferencesValidating Bayesian Inference Algorithms with Simulation-Based Calibration Talts, Betancourt, Simpson, Vehtari, Gelman, 2018

  2. +Simulation-Based Calibration Checking for Bayesian Computation: The Choice of Test Quantities Shapes Sensitivity Modrák, Moon, Kim, Bürkner, Huurre, Faltejsková, Gelman, Vehtari, 2022 +
  3. +Validating Bayesian Inference Algorithms with Simulation-Based Calibration Talts, Betancourt, Simpson, Vehtari, Gelman, 2018
  4. Graphical Test for Discrete Uniformity and its Applications in Goodness of Fit Evaluation and Multiple Sample Comparison Säilynoja, Bürkner, Vehtari, 2021
  5. @@ -278,7 +280,7 @@

    Developers

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 5feb8fb..ece5d2c 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -1,5 +1,5 @@ -pandoc: 2.17.1.1 -pkgdown: 2.0.5 +pandoc: 2.19.2 +pkgdown: 2.0.6 pkgdown_sha: ~ articles: bad_parametrization: bad_parametrization.html @@ -13,7 +13,7 @@ articles: rejection_sampling: rejection_sampling.html SBC: SBC.html small_model_workflow: small_model_workflow.html -last_built: 2022-07-04T11:54Z +last_built: 2022-12-15T13:30Z urls: reference: https://hyunjimoon.github.io/SBC/reference article: https://hyunjimoon.github.io/SBC/articles diff --git a/docs/reference/ECDF-plots.html b/docs/reference/ECDF-plots.html index d13b62e..b8e7563 100644 --- a/docs/reference/ECDF-plots.html +++ b/docs/reference/ECDF-plots.html @@ -19,7 +19,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -200,7 +200,7 @@

    See also

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/Rplot001.png b/docs/reference/Rplot001.png new file mode 100644 index 0000000..17a3580 Binary files /dev/null and b/docs/reference/Rplot001.png differ diff --git a/docs/reference/SBC-deprecated.html b/docs/reference/SBC-deprecated.html index a6ac4be..a5dac6f 100644 --- a/docs/reference/SBC-deprecated.html +++ b/docs/reference/SBC-deprecated.html @@ -20,7 +20,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -102,7 +102,7 @@
    @@ -114,11 +114,43 @@

    Deprecated functions in package SBC.

    -
    compute_results(...)
    +    
    generated_quantities(...)
    +
    +validate_generated_quantities(...)
    +
    +bind_generated_quantities(...)
    +
    +compute_gen_quants(...)
    +
    +compute_results(...)
     
     recompute_statistics(...)
    +
    +

    generated_quantities

    + + +

    Instead of generated_quantities, use derived_quantities.

    +
    +
    +

    validate_generated_quantities

    + + +

    Instead of validate_generated_quantities, use validate_derived_quantities.

    +
    +
    +

    bind_generated_quantities

    + + +

    Instead of bind_generated_quantities, use bind_derived_quantities.

    +
    +
    +

    compute_gen_quants

    + + +

    Instead of compute_gen_quants, use compute_dquants.

    +

    compute_results

    @@ -144,7 +176,7 @@

    recompute_statistics

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_backend_brms.html b/docs/reference/SBC_backend_brms.html index b4721fe..b39569a 100644 --- a/docs/reference/SBC_backend_brms.html +++ b/docs/reference/SBC_backend_brms.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -139,7 +139,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_backend_brms_from_generator.html b/docs/reference/SBC_backend_brms_from_generator.html index 10cecbf..e06b124 100644 --- a/docs/reference/SBC_backend_brms_from_generator.html +++ b/docs/reference/SBC_backend_brms_from_generator.html @@ -20,7 +20,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -129,7 +129,7 @@

    Build a brms backend, reusing the compiled model from a previously created <
    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_backend_cmdstan_sample.html b/docs/reference/SBC_backend_cmdstan_sample.html index 74e20cd..f35554b 100644 --- a/docs/reference/SBC_backend_cmdstan_sample.html +++ b/docs/reference/SBC_backend_cmdstan_sample.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -136,7 +136,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_backend_cmdstan_variational.html b/docs/reference/SBC_backend_cmdstan_variational.html index fae605b..89db017 100644 --- a/docs/reference/SBC_backend_cmdstan_variational.html +++ b/docs/reference/SBC_backend_cmdstan_variational.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -143,7 +143,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_backend_default_thin_ranks.html b/docs/reference/SBC_backend_default_thin_ranks.html index 99cd9e7..64c7fcf 100644 --- a/docs/reference/SBC_backend_default_thin_ranks.html +++ b/docs/reference/SBC_backend_default_thin_ranks.html @@ -18,7 +18,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -129,7 +129,7 @@

    S3 generic to get backend-specific default thinning for rank computation.
    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_backend_hash_for_cache.html b/docs/reference/SBC_backend_hash_for_cache.html index f3783ce..7bc16af 100644 --- a/docs/reference/SBC_backend_hash_for_cache.html +++ b/docs/reference/SBC_backend_hash_for_cache.html @@ -18,7 +18,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -126,7 +126,7 @@

    Get hash used to identify cached results.

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_backend_iid_draws.html b/docs/reference/SBC_backend_iid_draws.html index 56085b4..991f809 100644 --- a/docs/reference/SBC_backend_iid_draws.html +++ b/docs/reference/SBC_backend_iid_draws.html @@ -24,7 +24,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -147,7 +147,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_backend_mock.html b/docs/reference/SBC_backend_mock.html index 4b7be02..8717d7e 100644 --- a/docs/reference/SBC_backend_mock.html +++ b/docs/reference/SBC_backend_mock.html @@ -19,7 +19,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -140,7 +140,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_backend_rjags.html b/docs/reference/SBC_backend_rjags.html index 02c2549..859a272 100644 --- a/docs/reference/SBC_backend_rjags.html +++ b/docs/reference/SBC_backend_rjags.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -163,7 +163,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_backend_rstan_optimizing.html b/docs/reference/SBC_backend_rstan_optimizing.html index aa89a37..c3d854d 100644 --- a/docs/reference/SBC_backend_rstan_optimizing.html +++ b/docs/reference/SBC_backend_rstan_optimizing.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -142,7 +142,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_backend_rstan_sample.html b/docs/reference/SBC_backend_rstan_sample.html index 580104c..c277008 100644 --- a/docs/reference/SBC_backend_rstan_sample.html +++ b/docs/reference/SBC_backend_rstan_sample.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -136,7 +136,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_datasets.html b/docs/reference/SBC_datasets.html index 6a7fc37..f02566e 100644 --- a/docs/reference/SBC_datasets.html +++ b/docs/reference/SBC_datasets.html @@ -18,7 +18,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -142,7 +142,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_example_backend.html b/docs/reference/SBC_example_backend.html index 7146d39..9d26d4e 100644 --- a/docs/reference/SBC_example_backend.html +++ b/docs/reference/SBC_example_backend.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -144,7 +144,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_example_generator.html b/docs/reference/SBC_example_generator.html index adfa705..635cd9c 100644 --- a/docs/reference/SBC_example_generator.html +++ b/docs/reference/SBC_example_generator.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -142,7 +142,7 @@

    Value

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_example_results.html b/docs/reference/SBC_example_results.html index bf6dc84..b43fe35 100644 --- a/docs/reference/SBC_example_results.html +++ b/docs/reference/SBC_example_results.html @@ -20,7 +20,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -160,7 +160,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_fit.html b/docs/reference/SBC_fit.html index 8e761fb..60dbfd8 100644 --- a/docs/reference/SBC_fit.html +++ b/docs/reference/SBC_fit.html @@ -20,7 +20,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -130,7 +130,7 @@

    S3 generic using backend to fit a model to data.

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_fit_to_diagnostics.html b/docs/reference/SBC_fit_to_diagnostics.html index 2738a90..4fb1fef 100644 --- a/docs/reference/SBC_fit_to_diagnostics.html +++ b/docs/reference/SBC_fit_to_diagnostics.html @@ -19,7 +19,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -152,7 +152,7 @@

    Value

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_fit_to_draws_matrix.html b/docs/reference/SBC_fit_to_draws_matrix.html index 319beeb..e47bbb7 100644 --- a/docs/reference/SBC_fit_to_draws_matrix.html +++ b/docs/reference/SBC_fit_to_draws_matrix.html @@ -20,7 +20,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -133,7 +133,7 @@

    S3 generic converting a fitted model to a draws_matrix object.<
    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_generator_brms.html b/docs/reference/SBC_generator_brms.html index d43ae74..8ff6802 100644 --- a/docs/reference/SBC_generator_brms.html +++ b/docs/reference/SBC_generator_brms.html @@ -18,7 +18,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -138,7 +138,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_generator_custom.html b/docs/reference/SBC_generator_custom.html index 2dfdec0..ab01fe9 100644 --- a/docs/reference/SBC_generator_custom.html +++ b/docs/reference/SBC_generator_custom.html @@ -18,7 +18,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -126,10 +126,12 @@

    Arguments

    Details

    -

    Running:

    gen <- SBC_generator_custom(f, <<some other args>>)
    +    

    Running:

    +

    gen <- SBC_generator_custom(f, <<some other args>>)
     datasets <- generate_datasets(gen, n_sims = my_n_sims)
     

    -

    is equivalent to just running

    datasets <- f(<<some other args>>, n_sims = my_n_sims)
    +

    is equivalent to just running

    +

    datasets <- f(<<some other args>>, n_sims = my_n_sims)
     

    So whenever you control the code calling generate_datasets, it usually makes more sense to just create an SBC_datasets @@ -151,7 +153,7 @@

    Details

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_generator_function.html b/docs/reference/SBC_generator_function.html index a03ca45..fc7208e 100644 --- a/docs/reference/SBC_generator_function.html +++ b/docs/reference/SBC_generator_function.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000
    @@ -136,7 +136,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_print_example_model.html b/docs/reference/SBC_print_example_model.html index 6a935f0..b2b1c3d 100644 --- a/docs/reference/SBC_print_example_model.html +++ b/docs/reference/SBC_print_example_model.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -133,7 +133,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_results.html b/docs/reference/SBC_results.html index 0ec0188..8b03d4a 100644 --- a/docs/reference/SBC_results.html +++ b/docs/reference/SBC_results.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -142,7 +142,7 @@

    Details

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/SBC_statistics_from_single_fit.html b/docs/reference/SBC_statistics_from_single_fit.html index 9cae47c..c75297a 100644 --- a/docs/reference/SBC_statistics_from_single_fit.html +++ b/docs/reference/SBC_statistics_from_single_fit.html @@ -19,7 +19,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -118,8 +118,9 @@

    Recompute SBC statistics given a single fit.

    generated, thin_ranks, ensure_num_ranks_divisor, - gen_quants, - backend + dquants, + backend, + gen_quants = NULL )
    @@ -136,6 +137,10 @@

    Arguments

    ensure that this number divides the total number of SBC ranks (see Details).

    +
    dquants
    +

    Derived quantities to include in SBC. Use derived_quantities() to construct them.

    + +
    backend

    the model + sampling algorithm. The built-in backends can be constructed using SBC_backend_cmdstan_sample(), SBC_backend_cmdstan_variational(), @@ -143,6 +148,10 @@

    Arguments

    (more to come: issue 31, 38, 39). The backend is an S3 class supporting at least the SBC_fit(), SBC_fit_to_draws_matrix() methods.

    + +
    gen_quants
    +

    Deprecated, use dquants instead

    +

    See also

    @@ -161,7 +170,7 @@

    See also

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/bind_datasets.html b/docs/reference/bind_datasets.html index 2f9f628..a518a54 100644 --- a/docs/reference/bind_datasets.html +++ b/docs/reference/bind_datasets.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -130,7 +130,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/bind_derived_quantities.html b/docs/reference/bind_derived_quantities.html new file mode 100644 index 0000000..b880e94 --- /dev/null +++ b/docs/reference/bind_derived_quantities.html @@ -0,0 +1,138 @@ + +Combine two lists of derived quantities — bind_derived_quantities • SBC + + +
    +
    + + + +
    +
    + + +
    +

    Combine two lists of derived quantities

    +
    + +
    +
    bind_derived_quantities(dq1, dq2)
    +
    + + +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.6.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/bind_generated_quantities-deprecated.html b/docs/reference/bind_generated_quantities-deprecated.html new file mode 100644 index 0000000..1975ef2 --- /dev/null +++ b/docs/reference/bind_generated_quantities-deprecated.html @@ -0,0 +1,139 @@ + +Combine two lists of derived quantities — bind_generated_quantities-deprecated • SBC + + +
    +
    + + + +
    +
    + + +
    +

    Delegates directly to bind_derived_quantities().

    +
    + + +
    +

    See also

    + +
    + +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.6.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/bind_globals.html b/docs/reference/bind_globals.html new file mode 100644 index 0000000..9d55206 --- /dev/null +++ b/docs/reference/bind_globals.html @@ -0,0 +1,142 @@ + +Combine two sets globals for use in derived quantities or backend — bind_globals • SBC + + +
    +
    + + + +
    +
    + + +
    +

    Combine two sets globals for use in derived quantities or backend

    +
    + +
    +
    bind_globals(globals1, globals2)
    +
    + + + +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.6.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/bind_results.html b/docs/reference/bind_results.html index 55b7e78..faf68dd 100644 --- a/docs/reference/bind_results.html +++ b/docs/reference/bind_results.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -134,7 +134,7 @@

    Details

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/calculate_prior_sd.html b/docs/reference/calculate_prior_sd.html index a85731c..6d9b246 100644 --- a/docs/reference/calculate_prior_sd.html +++ b/docs/reference/calculate_prior_sd.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -130,7 +130,7 @@

    Value

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/calculate_ranks_draws_matrix.html b/docs/reference/calculate_ranks_draws_matrix.html index 908b5d0..6e59e19 100644 --- a/docs/reference/calculate_ranks_draws_matrix.html +++ b/docs/reference/calculate_ranks_draws_matrix.html @@ -18,7 +18,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -140,7 +140,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/check_all_SBC_diagnostics.html b/docs/reference/check_all_SBC_diagnostics.html index 26e3797..785396b 100644 --- a/docs/reference/check_all_SBC_diagnostics.html +++ b/docs/reference/check_all_SBC_diagnostics.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -136,7 +136,7 @@

    Value

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/cjs_dist.html b/docs/reference/cjs_dist.html index 280d286..b144c45 100644 --- a/docs/reference/cjs_dist.html +++ b/docs/reference/cjs_dist.html @@ -18,7 +18,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -179,7 +179,7 @@

    References

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/combine_args.html b/docs/reference/combine_args.html index 5d2cc63..a8d0735 100644 --- a/docs/reference/combine_args.html +++ b/docs/reference/combine_args.html @@ -20,7 +20,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -129,7 +129,7 @@

    Combine two named lists and overwrite elements with the same name
    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/compute_SBC.html b/docs/reference/compute_SBC.html index 6990266..8244479 100644 --- a/docs/reference/compute_SBC.html +++ b/docs/reference/compute_SBC.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -116,10 +116,11 @@

    Fit datasets and evaluate diagnostics and SBC metrics.

    thin_ranks = SBC_backend_default_thin_ranks(backend), ensure_num_ranks_divisor = 2, chunk_size = default_chunk_size(length(datasets)), - gen_quants = NULL, + dquants = NULL, cache_mode = "none", cache_location = NULL, - globals = list() + globals = list(), + gen_quants = NULL )
    @@ -174,6 +175,10 @@

    Arguments

    See documentation of future.chunk.size argument for future.apply::future_lapply() for more details.

    +
    dquants
    +

    Derived quantities to include in SBC. Use derived_quantities() to construct them.

    + +
    cache_mode

    Type of caching of results, currently the only supported modes are "none" (do not cache) and "results" where the whole results object is stored @@ -193,6 +198,10 @@

    Arguments

    It is added to the globals argument to future::future(), to make those objects available on all workers.

    + +
    gen_quants
    +

    Deprecated, use dquants instead

    +

    Value

    @@ -253,7 +262,7 @@

    Rank divisors

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/compute_dquants.html b/docs/reference/compute_dquants.html new file mode 100644 index 0000000..f33ee50 --- /dev/null +++ b/docs/reference/compute_dquants.html @@ -0,0 +1,144 @@ + +Compute derived quantities based on given data and posterior draws. — compute_dquants • SBC + + +
    +
    + + + +
    +
    + + +
    +

    Compute derived quantities based on given data and posterior draws.

    +
    + +
    +
    compute_dquants(draws, generated, dquants, gen_quants = NULL)
    +
    + +
    +

    Arguments

    +
    gen_quants
    +

    Deprecated, use dquants

    + +
    + +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.6.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/compute_gen_quants-deprecated.html b/docs/reference/compute_gen_quants-deprecated.html new file mode 100644 index 0000000..d0db3b2 --- /dev/null +++ b/docs/reference/compute_gen_quants-deprecated.html @@ -0,0 +1,139 @@ + +Compute derived quantities based on given data and posterior draws. — compute_gen_quants-deprecated • SBC + + +
    +
    + + + +
    +
    + + +
    +

    Delegates directly to compute_dquants().

    +
    + + +
    +

    See also

    + +
    + +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.6.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/compute_results-deprecated.html b/docs/reference/compute_results-deprecated.html index 62e5386..1ebc0d1 100644 --- a/docs/reference/compute_results-deprecated.html +++ b/docs/reference/compute_results-deprecated.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -125,7 +125,7 @@

    See also

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/data_for_ecdf_plots.html b/docs/reference/data_for_ecdf_plots.html index cbd68e2..8e6c418 100644 --- a/docs/reference/data_for_ecdf_plots.html +++ b/docs/reference/data_for_ecdf_plots.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -124,7 +124,7 @@

    Maybe not export in the end? Useful for debugging

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/default_chunk_size.html b/docs/reference/default_chunk_size.html index 190e621..18293cd 100644 --- a/docs/reference/default_chunk_size.html +++ b/docs/reference/default_chunk_size.html @@ -20,7 +20,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -130,7 +130,7 @@

    Determines the default chunk size.

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/default_cores_per_fit.html b/docs/reference/default_cores_per_fit.html index 0a1a5c2..acf6c35 100644 --- a/docs/reference/default_cores_per_fit.html +++ b/docs/reference/default_cores_per_fit.html @@ -20,7 +20,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -134,7 +134,7 @@

    Determines the default cores per single fit.

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/derived_quantities.html b/docs/reference/derived_quantities.html new file mode 100644 index 0000000..afbded1 --- /dev/null +++ b/docs/reference/derived_quantities.html @@ -0,0 +1,174 @@ + +Create a definition of derived quantities evaluated in R. — derived_quantities • SBC + + +
    +
    + + + +
    +
    + + +
    +

    When the expression contains non-library functions/objects, and parallel processing +is enabled, those must be +named in the .globals parameter (hopefully we'll be able to detect those +automatically in the future). Note that recompute_SBC_statistics() currently +does not use parallel processing, so .globals don't need to be set.

    +
    + +
    +
    derived_quantities(..., .globals = list())
    +
    + +
    +

    Arguments

    +
    ...
    +

    named expressions representing the quantitites

    + + +
    .globals
    +

    A list of names of objects that are defined +in the global environment and need to present for the gen. quants. to evaluate. +It is added to the globals argument to future::future(), to make those +objects available on all workers.

    + +
    + +
    +

    Examples

    +
    # Derived quantity computing the total log likelihood of a normal distribution
    +# with known sd = 1
    +normal_lpdf <- function(y, mu, sigma) {
    + sum(dnorm(y, mean = mu, sd = sigma, log = TRUE))
    +}
    +
    +# Note the use of .globals to make the normal_lpdf function available
    +# within the expression
    +log_lik_dq <- derived_quantities(log_lik = normal_lpdf(y, mu, 1),
    +                                .globals = "normal_lpdf" )
    +
    +
    +
    +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.6.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/empirical_coverage.html b/docs/reference/empirical_coverage.html index 95df6e0..f0f65cc 100644 --- a/docs/reference/empirical_coverage.html +++ b/docs/reference/empirical_coverage.html @@ -23,7 +23,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -182,7 +182,7 @@

    See also

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/generate_datasets.html b/docs/reference/generate_datasets.html index 95e4cf2..d1a7eeb 100644 --- a/docs/reference/generate_datasets.html +++ b/docs/reference/generate_datasets.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -148,7 +148,7 @@

    Value

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/generated_quantities-deprecated.html b/docs/reference/generated_quantities-deprecated.html new file mode 100644 index 0000000..6a917d4 --- /dev/null +++ b/docs/reference/generated_quantities-deprecated.html @@ -0,0 +1,142 @@ + +Create a definition of derived quantities evaluated in R. — generated_quantities-deprecated • SBC + + +
    +
    + + + +
    +
    + + +
    +

    Delegates directly to derived_quantities().

    +

    Delegates directly to validate_derived_quantities().

    +
    + + +
    +

    See also

    + +
    + +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.6.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/get_diagnostic_messages.html b/docs/reference/get_diagnostic_messages.html index 9a874fa..a5dd320 100644 --- a/docs/reference/get_diagnostic_messages.html +++ b/docs/reference/get_diagnostic_messages.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -130,7 +130,7 @@

    Value

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/guess_rank_hist_bins.html b/docs/reference/guess_rank_hist_bins.html index 4b4660f..c5be918 100644 --- a/docs/reference/guess_rank_hist_bins.html +++ b/docs/reference/guess_rank_hist_bins.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -134,7 +134,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/index.html b/docs/reference/index.html index 8c441ce..635164d 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -219,9 +219,25 @@

    Computation & results generated_quantities()

    +

    bind_derived_quantities()

    -

    Create a definition of generated quantities evaluated in R.

    +

    Combine two lists of derived quantities

    + +

    derived_quantities()

    + +

    Create a definition of derived quantities evaluated in R.

    + +

    validate_derived_quantities()

    + +

    Validate a definition of derived quantities evaluated in R.

    + +

    compute_dquants()

    + +

    Compute derived quantities based on given data and posterior draws.

    + +

    bind_globals()

    + +

    Combine two sets globals for use in derived quantities or backend

    SBC_statistics_from_single_fit()

    @@ -285,7 +301,7 @@

    Plotting & Summarising guess_rank_hist_bins()

    -

    Guess the number of bins for plot_rank_hist().

    +

    Guess the number of bins for plot_rank_hist().

    empirical_coverage()

    @@ -353,7 +369,7 @@

    Miscellaneous
    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/max_diff.html b/docs/reference/max_diff.html index d72695f..46169bd 100644 --- a/docs/reference/max_diff.html +++ b/docs/reference/max_diff.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -144,7 +144,7 @@

    Value

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/plot_contraction.html b/docs/reference/plot_contraction.html index 049509b..c2cc12a 100644 --- a/docs/reference/plot_contraction.html +++ b/docs/reference/plot_contraction.html @@ -19,7 +19,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -171,7 +171,7 @@

    Value

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/plot_coverage.html b/docs/reference/plot_coverage.html index b455aa8..44c12a8 100644 --- a/docs/reference/plot_coverage.html +++ b/docs/reference/plot_coverage.html @@ -23,7 +23,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -125,7 +125,8 @@

    Plot the observed coverage and its uncertainty.

    variables = NULL, prob = 0.95, interval_type = "central", - parameters = NULL + parameters = NULL, + max_points = NULL ) plot_coverage_diff( @@ -133,7 +134,8 @@

    Plot the observed coverage and its uncertainty.

    variables = NULL, prob = 0.95, interval_type = "central", - parameters = NULL + parameters = NULL, + max_points = NULL )
    @@ -154,6 +156,12 @@

    Arguments

    parameters

    DEPRECATED. Use variables instead.

    + +
    max_points
    +

    maximum number of points where to evaluate the coverage. +If set to NULL, coverage is evaluated across the whole range of ranks. +Setting to some smaller number may reduce memory footprint and increase speed.

    +

    Value

    @@ -178,7 +186,7 @@

    See also

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/plot_rank_hist.html b/docs/reference/plot_rank_hist.html index fe221e4..4abf288 100644 --- a/docs/reference/plot_rank_hist.html +++ b/docs/reference/plot_rank_hist.html @@ -22,7 +22,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -165,7 +165,7 @@

    Details

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/plot_sim_estimated.html b/docs/reference/plot_sim_estimated.html index 77a0349..be8623a 100644 --- a/docs/reference/plot_sim_estimated.html +++ b/docs/reference/plot_sim_estimated.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -165,7 +165,7 @@

    Value

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/rank2unif.html b/docs/reference/rank2unif.html index f1288b7..891399c 100644 --- a/docs/reference/rank2unif.html +++ b/docs/reference/rank2unif.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -142,7 +142,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/rdunif.html b/docs/reference/rdunif.html index d10e673..36b408d 100644 --- a/docs/reference/rdunif.html +++ b/docs/reference/rdunif.html @@ -18,7 +18,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -126,7 +126,7 @@

    Discrete uniform distribution allowing for varying lower and upper bounds.
    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/recompute_SBC_statistics.html b/docs/reference/recompute_SBC_statistics.html index 9a0bcbd..abdfa88 100644 --- a/docs/reference/recompute_SBC_statistics.html +++ b/docs/reference/recompute_SBC_statistics.html @@ -1,5 +1,6 @@ -Recompute SBC statistics without refitting models. — recompute_SBC_statistics • SBCRecompute SBC statistics without refitting models. — recompute_SBC_statistics • SBC @@ -17,7 +18,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -104,7 +105,8 @@

    Recompute SBC statistics without refitting models.

    -

    Recompute SBC statistics without refitting models.

    +

    Useful for example to recompute SBC ranks with a different choice of thin_ranks +or added derived quantities.

    @@ -114,6 +116,7 @@

    Recompute SBC statistics without refitting models.

    backend, thin_ranks = SBC_backend_default_thin_ranks(backend), ensure_num_ranks_divisor = 2, + dquants = NULL, gen_quants = NULL )
    @@ -139,6 +142,14 @@

    Arguments

    Potentially drop some posterior samples to ensure that this number divides the total number of SBC ranks (see Details).

    + +
    dquants
    +

    Derived quantities to include in SBC. Use derived_quantities() to construct them.

    + + +
    gen_quants
    +

    Deprecated, use dquants instead

    +

    Value

    @@ -146,11 +157,6 @@

    Value

    An S3 object of class SBC_results with updated $stats and $default_diagnostics fields.

    -
    -

    Details

    -

    Useful for example to recompute SBC ranks with a different choice of thin_ranks -or added generated quantities.

    -
    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/recompute_statistics-deprecated.html b/docs/reference/recompute_statistics-deprecated.html index 93e17ed..a775529 100644 --- a/docs/reference/recompute_statistics-deprecated.html +++ b/docs/reference/recompute_statistics-deprecated.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -125,7 +125,7 @@

    See also

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/set2set.html b/docs/reference/set2set.html index fd0285e..acbdf12 100644 --- a/docs/reference/set2set.html +++ b/docs/reference/set2set.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -142,7 +142,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/sub-.SBC_datasets.html b/docs/reference/sub-.SBC_datasets.html index f63b771..edafe91 100644 --- a/docs/reference/sub-.SBC_datasets.html +++ b/docs/reference/sub-.SBC_datasets.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -125,7 +125,7 @@

    Subset an SBC_datasets object.

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/sub-.SBC_results.html b/docs/reference/sub-.SBC_results.html index c4749d8..492fc48 100644 --- a/docs/reference/sub-.SBC_results.html +++ b/docs/reference/sub-.SBC_results.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -132,7 +132,7 @@

    Arguments

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/reference/validate_derived_quantities.html b/docs/reference/validate_derived_quantities.html new file mode 100644 index 0000000..4e75033 --- /dev/null +++ b/docs/reference/validate_derived_quantities.html @@ -0,0 +1,138 @@ + +Validate a definition of derived quantities evaluated in R. — validate_derived_quantities • SBC + + +
    +
    + + + +
    +
    + + +
    +

    Validate a definition of derived quantities evaluated in R.

    +
    + +
    +
    validate_derived_quantities(x)
    +
    + + +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.6.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/wasserstein.html b/docs/reference/wasserstein.html index d232b6f..495c6ac 100644 --- a/docs/reference/wasserstein.html +++ b/docs/reference/wasserstein.html @@ -17,7 +17,7 @@ SBC - 0.1.1.9000 + 0.2.0.9000 @@ -144,7 +144,7 @@

    Value

    -

    Site built with pkgdown 2.0.5.

    +

    Site built with pkgdown 2.0.6.

    diff --git a/docs/sitemap.xml b/docs/sitemap.xml index a067956..f09eea3 100644 --- a/docs/sitemap.xml +++ b/docs/sitemap.xml @@ -54,6 +54,15 @@ https://hyunjimoon.github.io/SBC/reference/bind_datasets.html + + https://hyunjimoon.github.io/SBC/reference/bind_derived_quantities.html + + + https://hyunjimoon.github.io/SBC/reference/bind_generated_quantities-deprecated.html + + + https://hyunjimoon.github.io/SBC/reference/bind_globals.html + https://hyunjimoon.github.io/SBC/reference/bind_results.html @@ -72,6 +81,12 @@ https://hyunjimoon.github.io/SBC/reference/combine_args.html + + https://hyunjimoon.github.io/SBC/reference/compute_dquants.html + + + https://hyunjimoon.github.io/SBC/reference/compute_gen_quants-deprecated.html + https://hyunjimoon.github.io/SBC/reference/compute_results-deprecated.html @@ -87,12 +102,18 @@ https://hyunjimoon.github.io/SBC/reference/default_cores_per_fit.html + + https://hyunjimoon.github.io/SBC/reference/derived_quantities.html + https://hyunjimoon.github.io/SBC/reference/ECDF-plots.html https://hyunjimoon.github.io/SBC/reference/empirical_coverage.html + + https://hyunjimoon.github.io/SBC/reference/generated_quantities-deprecated.html + https://hyunjimoon.github.io/SBC/reference/generated_quantities.html @@ -219,6 +240,9 @@ https://hyunjimoon.github.io/SBC/reference/sub-.SBC_results.html + + https://hyunjimoon.github.io/SBC/reference/validate_derived_quantities.html + https://hyunjimoon.github.io/SBC/reference/wasserstein.html diff --git a/man/SBC-deprecated.Rd b/man/SBC-deprecated.Rd index 711aff2..6bb3614 100644 --- a/man/SBC-deprecated.Rd +++ b/man/SBC-deprecated.Rd @@ -1,11 +1,24 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SBC-deprecated.R, R/results.R +% Please edit documentation in R/SBC-deprecated.R, R/derived-quantities.R, +% R/results.R \name{SBC-deprecated} \alias{SBC-deprecated} +\alias{generated_quantities} +\alias{validate_generated_quantities} +\alias{bind_generated_quantities} +\alias{compute_gen_quants} \alias{compute_results} \alias{recompute_statistics} \title{Deprecated functions in package \pkg{SBC}.} \usage{ +generated_quantities(...) + +validate_generated_quantities(...) + +bind_generated_quantities(...) + +compute_gen_quants(...) + compute_results(...) recompute_statistics(...) @@ -16,6 +29,26 @@ the near future. When possible, alternative functions with similar functionality are also mentioned. Help pages for deprecated functions are available at \code{help("-deprecated")}. } +\section{\code{generated_quantities}}{ + +Instead of \code{generated_quantities}, use \code{\link{derived_quantities}}. +} + +\section{\code{validate_generated_quantities}}{ + +Instead of \code{validate_generated_quantities}, use \code{\link{validate_derived_quantities}}. +} + +\section{\code{bind_generated_quantities}}{ + +Instead of \code{bind_generated_quantities}, use \code{\link{bind_derived_quantities}}. +} + +\section{\code{compute_gen_quants}}{ + +Instead of \code{compute_gen_quants}, use \code{\link{compute_dquants}}. +} + \section{\code{compute_results}}{ Instead of \code{compute_results}, use \code{\link{compute_SBC}}. diff --git a/man/SBC_statistics_from_single_fit.Rd b/man/SBC_statistics_from_single_fit.Rd index d750ca2..970957a 100644 --- a/man/SBC_statistics_from_single_fit.Rd +++ b/man/SBC_statistics_from_single_fit.Rd @@ -10,8 +10,9 @@ SBC_statistics_from_single_fit( generated, thin_ranks, ensure_num_ranks_divisor, - gen_quants, - backend + dquants, + backend, + gen_quants = NULL ) } \arguments{ @@ -22,11 +23,15 @@ thinned draws See details below.} \item{ensure_num_ranks_divisor}{Potentially drop some posterior samples to ensure that this number divides the total number of SBC ranks (see Details).} +\item{dquants}{Derived quantities to include in SBC. Use \code{\link[=derived_quantities]{derived_quantities()}} to construct them.} + \item{backend}{the model + sampling algorithm. The built-in backends can be constructed using \code{\link[=SBC_backend_cmdstan_sample]{SBC_backend_cmdstan_sample()}}, \code{\link[=SBC_backend_cmdstan_variational]{SBC_backend_cmdstan_variational()}}, \code{\link[=SBC_backend_rstan_sample]{SBC_backend_rstan_sample()}}, \code{\link[=SBC_backend_rstan_optimizing]{SBC_backend_rstan_optimizing()}} and \code{\link[=SBC_backend_brms]{SBC_backend_brms()}}. (more to come: issue 31, 38, 39). The backend is an S3 class supporting at least the \code{\link[=SBC_fit]{SBC_fit()}}, \code{\link[=SBC_fit_to_draws_matrix]{SBC_fit_to_draws_matrix()}} methods.} + +\item{gen_quants}{Deprecated, use dquants instead} } \description{ Potentially useful for doing some advanced stuff, but should not diff --git a/man/bind_derived_quantities.Rd b/man/bind_derived_quantities.Rd new file mode 100644 index 0000000..20efbb2 --- /dev/null +++ b/man/bind_derived_quantities.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derived-quantities.R +\name{bind_derived_quantities} +\alias{bind_derived_quantities} +\title{Combine two lists of derived quantities} +\usage{ +bind_derived_quantities(dq1, dq2) +} +\description{ +Combine two lists of derived quantities +} diff --git a/man/bind_generated_quantities-deprecated.Rd b/man/bind_generated_quantities-deprecated.Rd new file mode 100644 index 0000000..4dbdf9d --- /dev/null +++ b/man/bind_generated_quantities-deprecated.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derived-quantities.R +\name{bind_generated_quantities-deprecated} +\alias{bind_generated_quantities-deprecated} +\title{Combine two lists of derived quantities} +\description{ +Delegates directly to \code{bind_derived_quantities()}. +} +\seealso{ +\code{\link{SBC-deprecated}} +} +\keyword{internal} diff --git a/man/bind_globals.Rd b/man/bind_globals.Rd index 0cbb2bb..5986e6a 100644 --- a/man/bind_globals.Rd +++ b/man/bind_globals.Rd @@ -2,10 +2,13 @@ % Please edit documentation in R/results.R \name{bind_globals} \alias{bind_globals} -\title{Bind globals used in gen quants or backend} +\title{Combine two sets globals for use in derived quantities or backend} \usage{ bind_globals(globals1, globals2) } \description{ -Bind globals used in gen quants or backend +Combine two sets globals for use in derived quantities or backend +} +\seealso{ +\code{\link[=compute_SBC]{compute_SBC()}}, \code{\link[=derived_quantities]{derived_quantities()}} } diff --git a/man/compute_SBC.Rd b/man/compute_SBC.Rd index 0129322..375a321 100644 --- a/man/compute_SBC.Rd +++ b/man/compute_SBC.Rd @@ -12,10 +12,11 @@ compute_SBC( thin_ranks = SBC_backend_default_thin_ranks(backend), ensure_num_ranks_divisor = 2, chunk_size = default_chunk_size(length(datasets)), - gen_quants = NULL, + dquants = NULL, cache_mode = "none", cache_location = NULL, - globals = list() + globals = list(), + gen_quants = NULL ) } \arguments{ @@ -54,6 +55,8 @@ you can often reduce computation time noticeably by increasing this value. You can use \code{options(SBC.min_chunk_size = value)} to set a minimum chunk size globally. See documentation of \code{future.chunk.size} argument for \code{\link[future.apply:future_lapply]{future.apply::future_lapply()}} for more details.} +\item{dquants}{Derived quantities to include in SBC. Use \code{\link[=derived_quantities]{derived_quantities()}} to construct them.} + \item{cache_mode}{Type of caching of results, currently the only supported modes are \code{"none"} (do not cache) and \code{"results"} where the whole results object is stored and recomputed only when the hash of the backend or dataset changes.} @@ -67,6 +70,8 @@ in the global environment and need to present for the backend to work ( if they are not already available in package). It is added to the \code{globals} argument to \code{\link[future:future]{future::future()}}, to make those objects available on all workers.} + +\item{gen_quants}{Deprecated, use dquants instead} } \value{ An object of class \code{\link[=SBC_results]{SBC_results()}}. diff --git a/man/compute_dquants.Rd b/man/compute_dquants.Rd new file mode 100644 index 0000000..bdc0718 --- /dev/null +++ b/man/compute_dquants.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derived-quantities.R +\name{compute_dquants} +\alias{compute_dquants} +\title{Compute derived quantities based on given data and posterior draws.} +\usage{ +compute_dquants(draws, generated, dquants, gen_quants = NULL) +} +\arguments{ +\item{gen_quants}{Deprecated, use \code{dquants}} +} +\description{ +Compute derived quantities based on given data and posterior draws. +} diff --git a/man/compute_gen_quants-deprecated.Rd b/man/compute_gen_quants-deprecated.Rd new file mode 100644 index 0000000..0a18110 --- /dev/null +++ b/man/compute_gen_quants-deprecated.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derived-quantities.R +\name{compute_gen_quants-deprecated} +\alias{compute_gen_quants-deprecated} +\title{Compute derived quantities based on given data and posterior draws.} +\description{ +Delegates directly to \code{compute_dquants()}. +} +\seealso{ +\code{\link{SBC-deprecated}} +} +\keyword{internal} diff --git a/man/generated_quantities.Rd b/man/derived_quantities.Rd similarity index 55% rename from man/generated_quantities.Rd rename to man/derived_quantities.Rd index 812b782..0b51f02 100644 --- a/man/generated_quantities.Rd +++ b/man/derived_quantities.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/results.R -\name{generated_quantities} -\alias{generated_quantities} -\title{Create a definition of generated quantities evaluated in R.} +% Please edit documentation in R/derived-quantities.R +\name{derived_quantities} +\alias{derived_quantities} +\title{Create a definition of derived quantities evaluated in R.} \usage{ -generated_quantities(..., .globals = list()) +derived_quantities(..., .globals = list()) } \arguments{ \item{...}{named expressions representing the quantitites} @@ -21,3 +21,16 @@ named in the \code{.globals} parameter (hopefully we'll be able to detect those automatically in the future). Note that \code{\link[=recompute_SBC_statistics]{recompute_SBC_statistics()}} currently does not use parallel processing, so \code{.globals} don't need to be set. } +\examples{ +# Derived quantity computing the total log likelihood of a normal distribution +# with known sd = 1 +normal_lpdf <- function(y, mu, sigma) { + sum(dnorm(y, mean = mu, sd = sigma, log = TRUE)) +} + +# Note the use of .globals to make the normal_lpdf function available +# within the expression +log_lik_dq <- derived_quantities(log_lik = normal_lpdf(y, mu, 1), + .globals = "normal_lpdf" ) + +} diff --git a/man/generated_quantities-deprecated.Rd b/man/generated_quantities-deprecated.Rd new file mode 100644 index 0000000..aefcb5b --- /dev/null +++ b/man/generated_quantities-deprecated.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derived-quantities.R +\name{generated_quantities-deprecated} +\alias{generated_quantities-deprecated} +\title{Create a definition of derived quantities evaluated in R.} +\description{ +Delegates directly to \code{derived_quantities()}. + +Delegates directly to \code{validate_derived_quantities()}. +} +\seealso{ +\code{\link{SBC-deprecated}} + +\code{\link{SBC-deprecated}} +} +\keyword{internal} diff --git a/man/recompute_SBC_statistics.Rd b/man/recompute_SBC_statistics.Rd index 203c49b..d4463f8 100644 --- a/man/recompute_SBC_statistics.Rd +++ b/man/recompute_SBC_statistics.Rd @@ -10,6 +10,7 @@ recompute_SBC_statistics( backend, thin_ranks = SBC_backend_default_thin_ranks(backend), ensure_num_ranks_divisor = 2, + dquants = NULL, gen_quants = NULL ) } @@ -25,11 +26,15 @@ thinned draws See details below.} \item{ensure_num_ranks_divisor}{Potentially drop some posterior samples to ensure that this number divides the total number of SBC ranks (see Details).} + +\item{dquants}{Derived quantities to include in SBC. Use \code{\link[=derived_quantities]{derived_quantities()}} to construct them.} + +\item{gen_quants}{Deprecated, use dquants instead} } \value{ An S3 object of class \code{SBC_results} with updated \verb{$stats} and \verb{$default_diagnostics} fields. } \description{ Useful for example to recompute SBC ranks with a different choice of \code{thin_ranks} -or added generated quantities. +or added derived quantities. } diff --git a/man/validate_derived_quantities.Rd b/man/validate_derived_quantities.Rd new file mode 100644 index 0000000..79fac3b --- /dev/null +++ b/man/validate_derived_quantities.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/derived-quantities.R +\name{validate_derived_quantities} +\alias{validate_derived_quantities} +\title{Validate a definition of derived quantities evaluated in R.} +\usage{ +validate_derived_quantities(x) +} +\description{ +Validate a definition of derived quantities evaluated in R. +} diff --git a/tests/testthat/test-results.R b/tests/testthat/test-results.R index 3fafd3f..9e877c0 100644 --- a/tests/testthat/test-results.R +++ b/tests/testthat/test-results.R @@ -166,7 +166,7 @@ test_that("SBC_statistics_from_single_fit", { # testing that no error is thrown and structure is OK test_draws <- posterior::example_draws(example = "eight_schools") res <- SBC_statistics_from_single_fit(test_draws, - variables = vars, thin_ranks = 1, gen_quants = NULL, + variables = vars, thin_ranks = 1, dquants = NULL, ensure_num_ranks_divisor = 1, backend = SBC_backend_mock()) @@ -181,7 +181,7 @@ test_that("SBC_statistics_from_single_fit", { # Make sure the test draws have the expected size before proceeding expect_equal(posterior::ndraws(test_draws), 400) res_ensure2 <- SBC_statistics_from_single_fit(posterior::example_draws(example = "eight_schools"), - variables = vars, thin_ranks = 1, gen_quants = NULL, + variables = vars, thin_ranks = 1, dquants = NULL, ensure_num_ranks_divisor = 2, backend = SBC_backend_mock()) # Number of ranks = max_rank + 1 (as 0 is a valid rank) @@ -190,7 +190,7 @@ test_that("SBC_statistics_from_single_fit", { # Test ensure_num_ranks_divisor, combined with thin_ranks res_ensure7 <- SBC_statistics_from_single_fit(posterior::example_draws(example = "eight_schools"), - variables = vars, thin_ranks = 4, gen_quants = NULL, + variables = vars, thin_ranks = 4, dquants = NULL, ensure_num_ranks_divisor = 7, backend = SBC_backend_mock()) expect_equal(unique(res_ensure7$max_rank), 97) diff --git a/vignettes/SBC.Rmd b/vignettes/SBC.Rmd index 8ebc680..641614b 100644 --- a/vignettes/SBC.Rmd +++ b/vignettes/SBC.Rmd @@ -30,7 +30,7 @@ then for each variable, the ranks obtained in SBC should be uniformly distribute This corresponds quite directly to claims like "the posterior 84% credible interval should contain the simulated value in 84% of simulations", the rank uniformity represents this claim for all interval widths at once. The theory of SBC is fully -described in [Talts et al.](https://arxiv.org/abs/1804.06788) +described in [Modrák et al.](https://arxiv.org/abs/2211.02383v1) which builds upon [Talts et al.](https://arxiv.org/abs/1804.06788) This opens two principal use-cases of SBC: diff --git a/vignettes/brms.Rmd b/vignettes/brms.Rmd index 79013a6..b241980 100644 --- a/vignettes/brms.Rmd +++ b/vignettes/brms.Rmd @@ -180,11 +180,11 @@ n_sims_generator <- SBC_generator_function(one_sim_generator, N = 18, K = 5) ``` For increased sensitivity, we also add the log likelihood of the data given parameters -as a generated quantity that we'll also monitor (see the [`limits_of_SBC`](https://hyunjimoon.github.io/SBC/articles/limits_of_SBC.html) +as a derived quantity that we'll also monitor (see the [`limits_of_SBC`](https://hyunjimoon.github.io/SBC/articles/limits_of_SBC.html) vignette for discussion on why this is useful). ```{r} -log_lik_gq_func <- generated_quantities( +log_lik_dq_func <- derived_quantities( log_lik = sum(dnorm(y, b_Intercept + x * b_x + r_group[group], sigma, log = TRUE)) # Testing CRPS, probably not worth it #, CRPS = mean(scoringRules::crps_norm(y, b_Intercept + x * b_x + r_group[group], sigma)) @@ -218,7 +218,7 @@ So we can happily compute: ```{r} results_func <- compute_SBC(datasets_func, backend_func, - gen_quants = log_lik_gq_func, + dquants = log_lik_dq_func, cache_mode = "results", cache_location = file.path(cache_dir, "func")) ``` @@ -262,7 +262,7 @@ Let's fit the same simulations with the new backend. ```{r} results_func2 <- compute_SBC(datasets_func, backend_func2, - gen_quants = log_lik_gq_func, + dquants = log_lik_dq_func, cache_mode = "results", cache_location = file.path(cache_dir, "func2")) ``` diff --git a/vignettes/discrete_vars.Rmd b/vignettes/discrete_vars.Rmd index 9a5586c..338627e 100644 --- a/vignettes/discrete_vars.Rmd +++ b/vignettes/discrete_vars.Rmd @@ -114,15 +114,15 @@ datasets_1 <- generate_datasets(generator_1, 30) ``` Additionally, -we'll add a generated quantity expressing the total log-likelihood of data given the -fitted parameters. The expression within the `generated_quantities()` call is evaluated +we'll add a derived quantity expressing the total log-likelihood of data given the +fitted parameters. The expression within the `derived_quantities()` call is evaluated for both prior and posterior draws and -included as another variable in SBC checks. It turns out this type of generated quantities +included as another variable in SBC checks. It turns out this type of derived quantities can increase the sensitivity of the SBC against some issues in the model. See `vignette("limits_of_SBC")` for a more detailed discussion of this. ```{r} -log_lik_gq <- generated_quantities(log_lik = sum(dpois(y, ifelse(1:T < s, e, l), log = TRUE))) +log_lik_dq <- derived_quantities(log_lik = sum(dpois(y, ifelse(1:T < s, e, l), log = TRUE))) ``` So finally, lets actually compute SBC: @@ -131,7 +131,7 @@ So finally, lets actually compute SBC: results_1 <- compute_SBC(datasets_1, backend_1, cache_mode = "results", cache_location = file.path(cache_dir, "model1"), - gen_quants = log_lik_gq) + dquants = log_lik_dq) ``` Here we also use the caching feature to avoid recomputing the fits when recompiling this vignette. @@ -149,7 +149,7 @@ dplyr::filter(results_1$stats, variable == "s") Inspecting the statistics shows that quite often, the model is quite sure of the value of `s` while the simulated value is just one less. -Looking at the `ecdf_diff` plot we see that this seems to compromise heavily the inference for `s`, but the other parameters do not show such bad behaviour. Note that the `log_lik` generated quantity shows even starker +Looking at the `ecdf_diff` plot we see that this seems to compromise heavily the inference for `s`, but the other parameters do not show such bad behaviour. Note that the `log_lik` derived quantity shows even starker failure than `s`, so it indeed poses a stricter check in this scenario. ```{r results1_plots} @@ -208,7 +208,7 @@ And we can recompute: set.seed(5846502) datasets_2 <- generate_datasets(generator_2, 30) results_2 <- compute_SBC(datasets_2, backend_1, - gen_quants = log_lik_gq, + dquants = log_lik_dq, cache_mode = "results", cache_location = file.path(cache_dir, "model2")) ``` @@ -225,7 +225,7 @@ Looks good, so let us add some more simulations to make sure the model behaves w set.seed(54321488) datasets_2_more <- generate_datasets(generator_2, 100) results_2_more <- compute_SBC(datasets_2_more, backend_1, - gen_quants = log_lik_gq, + dquants = log_lik_dq, cache_mode = "results", cache_location = file.path(cache_dir, "model3")) @@ -238,7 +238,7 @@ plot_ecdf_diff(results_2_all) ``` -Now - as far as this amount of SBC steps can see, the model is good and we get good behaviour for both the continuous and the discrete parameters and the `log_lik` generated quantity. Hooray! +Now - as far as this amount of SBC steps can see, the model is good and we get good behaviour for both the continuous and the discrete parameters and the `log_lik` derived quantity. Hooray! ## JAGS version @@ -276,7 +276,7 @@ data in exactly the same format as Stan, so we can reuse the datasets without an ```{r} datasets_2_all <- bind_datasets(datasets_2, datasets_2_more) results_jags <- compute_SBC(datasets_2_all, backend_jags, - gen_quants = log_lik_gq, + dquants = log_lik_dq, cache_mode = "results", cache_location = file.path(cache_dir_jags, "rjags")) ``` @@ -318,7 +318,7 @@ Then we run the actual SBC: ```{r} results_jags_marginalized <- compute_SBC(datasets_2_all, backend_jags_marginalized, - gen_quants = log_lik_gq, + dquants = log_lik_dq, cache_mode = "results", cache_location = file.path(cache_dir_jags, "rjags_marginalized")) ``` diff --git a/vignettes/limits_of_SBC.Rmd b/vignettes/limits_of_SBC.Rmd index 4980155..e3048a9 100644 --- a/vignettes/limits_of_SBC.Rmd +++ b/vignettes/limits_of_SBC.Rmd @@ -11,12 +11,14 @@ vignette: > \usepackage[utf8]{inputenc} --- -Here, we'll walk through some problems that are hard/impossible to diagnose with SBC. +Here, we'll walk through some problems that are hard to diagnose with SBC in its default settings. As usual the focus is on problems with models, assuming our inference algorithm is correct. But for each of those problems, one can imagine a corresponding failure in an algorithm --- although some of those failures are quite unlikely for actual algorithms. +A more extensive theoretical discussion of those limits can be found in the [Simulation-Based Calibration Checking for Bayesian Computation: The Choice of Test Quantities Shapes Sensitivity](https://arxiv.org/abs/2211.02383v1) preprint, additional examples at https://martinmodrak.github.io/sbc_test_quantities_paper/ + ```{r setup, message=FALSE,warning=FALSE, results="hide"} library(SBC) library(ggplot2) @@ -306,7 +308,7 @@ plot_sim_estimated(results_missing, alpha = 0.5) There is however even more powerful method - and that is to include the likelihood in the SBC. -This is most easily done by adding a "generated quantity" to the SBC results - this is a function +This is most easily done by adding a "derived quantity" to the SBC results - this is a function that is evaluated within the context of the variables AND data. And it can be added without recomputing the fits! @@ -315,19 +317,19 @@ normal_lpdf <- function(y, mu, sigma) { sum(dnorm(y, mean = mu, sd = sigma, log = TRUE)) } -log_lik_gq <- generated_quantities(log_lik = normal_lpdf(y, mu, 1), +log_lik_dq <- derived_quantities(log_lik = normal_lpdf(y, mu, 1), .globals = "normal_lpdf" ) -results_missing_gq <- recompute_SBC_statistics( +results_missing_dq <- recompute_SBC_statistics( results_missing, datasets_missing, - backend = backend_missing, gen_quants = log_lik_gq) + backend = backend_missing, dquants = log_lik_dq) ``` The rank plots for the `log_lik` quantity immediately shows a severe problem: -```{r results_missing_gq_plots} -plot_ecdf_diff(results_missing_gq) -plot_rank_hist(results_missing_gq) +```{r results_missing_dq_plots} +plot_ecdf_diff(results_missing_dq) +plot_rank_hist(results_missing_dq) ``` @@ -359,7 +361,7 @@ if(use_cmdstanr) { Let us use this model for the same set of simulations. ```{r} -results_missing_2 <- compute_SBC(datasets_missing, backend_missing_2, gen_quants = log_lik_gq, +results_missing_2 <- compute_SBC(datasets_missing, backend_missing_2, dquants = log_lik_dq, cache_mode = "results", cache_location = file.path(cache_dir, "missing_2")) ``` @@ -377,7 +379,7 @@ plot_sim_estimated(results_missing_2, variables = "mu", alpha = 0.5) ``` -Now contraction is pretty high, and `mu` is behaving well, but our `log_lik` generated quantity shows a clear problem +Now contraction is pretty high, and `mu` is behaving well, but our `log_lik` derived quantity shows a clear problem ```{r results_missing_2_plots} plot_ecdf_diff(results_missing_2) @@ -470,17 +472,17 @@ We can however add derived quantities that depend on both elements of mu. We'll try their sum, difference, product and the multivarite normal log likelihood ```{r} -gq_corr <- generated_quantities(sum = mu[1] + mu[2], +dq_corr <- derived_quantities(sum = mu[1] + mu[2], diff = mu[1] - mu[2], prod = mu[1] * mu[2], mvn_log_lik = sum(mvtnorm::dmvnorm(y, mean = mu, sigma = mvn_sigma, log = TRUE))) -res_corr_gq <- compute_SBC(datasets_correlated, backend_uncorr, keep_fits = FALSE, +res_corr_dq <- compute_SBC(datasets_correlated, backend_uncorr, keep_fits = FALSE, globals = analytic_backend_uncorr_globals, - gen_quants = gq_corr, + dquants = dq_corr, cache_mode = "results", - cache_location = file.path(cache_dir, "corr_gq")) + cache_location = file.path(cache_dir, "corr_dq")) ``` @@ -488,7 +490,7 @@ We see that all of the derived quantities show problems, but with different stre of signal. We'll especially note that the log likelihood is once again a very good choice, while sum is probably the worst of those tested. -```{r results_corr_gq} -plot_rank_hist(res_corr_gq) -plot_ecdf_diff(res_corr_gq) +```{r results_corr_dq} +plot_rank_hist(res_corr_dq) +plot_ecdf_diff(res_corr_dq) ``` diff --git a/vignettes/overview_wide.graphml b/vignettes/overview_wide.graphml index d72b0d1..1df7ffd 100644 --- a/vignettes/overview_wide.graphml +++ b/vignettes/overview_wide.graphml @@ -1,6 +1,6 @@ - + @@ -257,7 +257,7 @@ data - compute_results + compute_SBC diff --git a/vignettes/overview_wide.png b/vignettes/overview_wide.png index ec8847c..c95fbb0 100644 Binary files a/vignettes/overview_wide.png and b/vignettes/overview_wide.png differ diff --git a/vignettes/rejection_sampling.Rmd b/vignettes/rejection_sampling.Rmd index 6a2f9a8..e46f7c9 100644 --- a/vignettes/rejection_sampling.Rmd +++ b/vignettes/rejection_sampling.Rmd @@ -27,13 +27,8 @@ simulation and only accept it when it passes a certain condition we impose (e.g. that no observed count is larger than $10^8$). But does rejection sampling when generating simulations affect the validity of SBC? -Thanks to forum user Niko Huurre who derived the necessary math -at [Stan Discourse discussion of the topic](https://discourse.mc-stan.org/t/using-narrower-priors-for-sbc/21709/6?u=martinmodrak) -we know exactly when it is OK. Briefly: for algorithms -that only need to know the posterior density up to a constant (which includes Stan -and many others), -it is OK as long as the rejection criterion only -uses observed data and not the unobserved variables. +It turns out that it does not as long as the rejection criterion only +uses observed data and not the unobserved variables. We'll first walk through the math and then show examples of both OK and problematic rejection sampling. @@ -41,47 +36,20 @@ rejection sampling. ## The math -Let $f\left(y\right)$ be the probability that the simulated data $y$ is rejected (usually a 0-1 function if you have a clear idea what a "bad" dataset looks like, but could be probabilistic if you're relying on finicky diagnostics). The important numbers are the probability of rejection for variable $\theta$ +Let $\mathtt{accept}(y)$ be the probability the the simulated data $y$ is accepted. Note that $\mathtt{accept}$ uses only data as input and would usually be a 0-1 function if you have a clear idea what a "bad" dataset looks like, but could be probabilistic if you're relying on finicky diagnostics. -$$ -L\left(\theta\right)=\int f\left(y\right)\pi\left(y|\theta\right)\mathrm{d}y -$$ - -and the total rate of rejections from the prior - -$$ -R=\iint f\left(y\right)\pi\left(y|\theta\right)\pi\left(\theta\right)\mathrm{d}y\mathrm{d}\theta=\int L\left(\theta\right)\pi\left(\theta\right)\mathrm{d}\theta -$$ - -Rejecting the simulation when it generates “bad” data effectively distorts the prior - -$$ -\pi\left(\theta\right)\to\frac{L\left(\theta\right)}{R}\pi\left(\theta\right) -$$ - -and of course rejections change the generating distribution +We define a variable $a \sim \text{Bernoulli}(\mathtt{accept}(y))$. Given the parameter space $\Theta$ and a specific $\theta \in \Theta$, this implies a joint distribution $\pi(\theta, y, a)$ that factorizes as $\pi(\theta, y, a) = \pi(a|y)\pi(y | \theta)\pi(\theta)$. We can then look at the posterior conditional on accepting a dataset to see the claimed invariance: $$ -\pi\left(y|\theta\right)\to\frac{f\left(y\right)}{L\left(\theta\right)}\pi\left(y|\theta\right) +\begin{equation} +\pi(\theta | y, a = 1) = \frac{\pi(a = 1 | y) \pi(y | \theta)\pi(\theta)}{\int_\Theta \mathrm{d}\tilde\theta \: \pi(a = 1 | y) \pi(y | \tilde\theta)\pi(\tilde\theta)} = +\frac{\pi(y | \theta)\pi(\theta)}{\int_\Theta \mathrm{d}\tilde\theta \: \pi(y | \tilde\theta)\pi(\tilde\theta)} = \pi(\theta | y) +\end{equation} $$ -but crucially these changes cancel out when computing the posterior. Before rejections we have: - -$$ -\pi(\theta | y) \propto \pi(y | \theta) \pi(\theta) -$$ - -After rejections we have - -$$ -\pi(\theta | y) \propto \frac{L(\theta)}{R} \pi(y | \theta) \frac{f(y)}{L(\theta)} \pi(\theta) = \frac{f(y)}{R} \pi(y | \theta) \pi(\theta) -$$ -And since $\frac{f(y)}{R}$ is a constant for any given simulation (and hence the fit), -the overall posterior for Stan (and most other MCMC algorithms) is the same, -because Stan only needs the posterior density up to a constant. So whether we take rejection into account or not, the model will match the generating process. -However, if $f$ also depended on $\theta$, it would no longer contribute a constant +However, if $\mathtt{accept}$ also depended on $\theta$, it would no longer contribute a constant and we'll get a mismatch between the generator and model. ## Practical examples