diff --git a/DESCRIPTION b/DESCRIPTION index ad495e67..6ba83ed3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -11,8 +11,8 @@ Authors@R: c(person("Jonah", "Gabry", role = c("aut", "cre"), email = "jgabry@gm person("Frank", "Weber", role = "ctb"), person("Eduardo", "Coronado Sroka", role = "ctb"), person("Teemu", "Sailynoja", role = "ctb"), - person("Aki", "Vehtari", role = "ctb"), - person("Behram", "Ulukır", role = "ctb"), + person("Aki", "Vehtari", role = "ctb"), + person("Behram", "Ulukır", role = "ctb"), person("Visruth", "Srimath Kandali", role = "ctb"), person("Mattan S.", "Ben-Shachar", role = "ctb")) Maintainer: Jonah Gabry @@ -36,7 +36,7 @@ Imports: ggridges (>= 0.5.5), glue, lifecycle, - posterior, + posterior (>= 1.7.0), reshape2, rlang (>= 1.0.0), stats, diff --git a/R/bayesplot-ggplot-themes.R b/R/bayesplot-ggplot-themes.R index f552b5fc..419d87db 100644 --- a/R/bayesplot-ggplot-themes.R +++ b/R/bayesplot-ggplot-themes.R @@ -180,3 +180,23 @@ bayesplot_theme_replace <- function(...) { .bayesplot_theme_env$current <- theme_default() .bayesplot_theme_env$gg_current <- ggplot2::theme_grey() +.theme_text_size <- function(theme = bayesplot_theme_get()) { + el <- ggplot2::calc_element("text", theme) + size <- el$size + if (!is.numeric(size) || length(size) != 1 || is.na(size)) { + size <- 12 + } + size +} + +.theme_text_size <- function(theme = bayesplot_theme_get()) { + el <- ggplot2::calc_element("text", theme) + size <- el$size + if (is.null(size) && isS4(el)) { + size <- el@size + } + if (!is.numeric(size) || length(size) != 1 || is.na(size)) { + size <- 12 + } + size +} \ No newline at end of file diff --git a/R/helpers-ppc.R b/R/helpers-ppc.R index b530b0f9..7608fe68 100644 --- a/R/helpers-ppc.R +++ b/R/helpers-ppc.R @@ -583,6 +583,352 @@ ecdf_intervals <- function(gamma, N, K, L = 1) { lims } +# Shared PIT-ECDF helpers ------------------------------------------------ + +#' @noRd +.pit_ecdf_warn_ignored <- function(method_name, args) { + if (length(args) == 0) { + return(invisible(NULL)) + } + + inform(paste0( + "As method = ", method_name, " specified; ignoring: ", + paste(args, collapse = ", "), "." + )) +} + +#' @noRd +.pit_ecdf_resolve_method_args <- function( + method, pit, prob, interpolate_adj, test, gamma, + linewidth, color, help_text, pareto_pit, help_text_shrinkage +) { + if (is.null(method)) { + inform(c( + "i" = paste( + "In the next major release, the default `method`", + "will change to 'correlated'." + ), + "*" = paste( + "To silence this message, explicitly set", + "`method = 'independent'` or `method = 'correlated'`." + ) + )) + method <- "independent" + } else { + method <- rlang::arg_match(method, values = c("independent", "correlated")) + if (identical(method, "independent")) { + inform("The 'independent' method is superseded by the 'correlated' method.") + } + } + + alpha <- 1 - prob + + if (identical(method, "correlated")) { + if (!is.null(interpolate_adj)) { + .pit_ecdf_warn_ignored("'correlated'", "interpolate_adj") + } + if (!is.null(pit) && isTRUE(pareto_pit)) { + stop(paste( + "`pareto_pit = TRUE` cannot be used together with a non-`NULL`", + "`pit` value. Set either `pareto_pit = FALSE` or `pit = NULL`." + )) + } + test <- test %||% "POT" + test <- rlang::arg_match(test, values = c("POT", "PRIT", "PIET")) + gamma <- gamma %||% 0 + linewidth <- linewidth %||% 0.3 + color <- color %||% c(ecdf = "grey60", highlight = "red") + help_text <- help_text %||% TRUE + pareto_pit <- pareto_pit %||% (is.null(pit) && test %in% c("POT", "PIET")) + help_text_shrinkage <- help_text_shrinkage %||% 0.8 + } else { + ignored <- c( + if (!is.null(test)) "test", + if (!is.null(gamma)) "gamma", + if (!is.null(help_text)) "help_text", + if (!is.null(help_text_shrinkage)) "help_text_shrinkage" + ) + .pit_ecdf_warn_ignored("'independent'", ignored) + pareto_pit <- pareto_pit %||% FALSE + } + + list( + method = method, + alpha = alpha, + test = test, + gamma = gamma, + linewidth = linewidth, + color = color, + help_text = help_text, + pareto_pit = pareto_pit, + help_text_shrinkage = help_text_shrinkage + ) +} + +#' @noRd +.pit_ecdf_correlated_data <- function(pit, K, plot_diff, test, alpha, gamma) { + unit_interval <- seq(0, 1, length.out = K) + ecdf_pit_fn <- ecdf(pit) + test_res <- posterior::uniformity_test(pit = pit, test = test) + p_value_CCT <- test_res$pvalue + pointwise_contrib <- test_res$pointwise + max_contrib <- max(pointwise_contrib) + if (gamma < 0 || gamma > max_contrib) { + stop(sprintf( + "gamma must be in [0, %.2f], but gamma = %s was provided.", + max_contrib, gamma + )) + } + + x_combined <- sort(unique(c(unit_interval, pit))) + df_main <- tibble::tibble( + x = x_combined, + ecdf_val = ecdf_pit_fn(x_combined) - plot_diff * x_combined + ) + pit_sorted <- sort(pit) + df_pit <- tibble::tibble( + pit = pit_sorted, + ecdf_val = ecdf_pit_fn(pit_sorted) - plot_diff * pit_sorted + ) + + df_segments <- tibble::tibble( + x = numeric(0), + ecdf_val = numeric(0), + segment = integer(0) + ) + df_isolated <- tibble::tibble( + pit = numeric(0), + ecdf_val = numeric(0) + ) + + if (p_value_CCT < alpha) { + red_idx <- which(pointwise_contrib > gamma) + + if (length(red_idx) > 0) { + df_red <- df_pit[red_idx, ] + df_red$segment <- cumsum(c(1, diff(red_idx) != 1)) + seg_sizes <- stats::ave(df_red$pit, df_red$segment, FUN = length) + df_isolated <- df_red[seg_sizes == 1, ] + df_grouped <- df_red[seg_sizes > 1, ] + + if (nrow(df_grouped) > 0) { + df_segments <- do.call(rbind, lapply( + split(df_grouped, df_grouped$segment), + function(grp) { + pit_idx <- match(grp$pit, x_combined) + idx_range <- seq(min(pit_idx), max(pit_idx)) + tibble::tibble( + x = df_main$x[idx_range], + ecdf_val = df_main$ecdf_val[idx_range], + segment = grp$segment[1L] + ) + } + )) + } + } + } + + list( + main = df_main, + segments = df_segments, + isolated = df_isolated, + p_value = p_value_CCT + ) +} + +#' @noRd +.pit_ecdf_plot_single <- function( + pit, K, prob, plot_diff, interpolate_adj, method, test, + gamma, linewidth, color, help_text, x_label, help_text_shrinkage +) { + n_obs <- length(pit) + unit_interval <- seq(0, 1, length.out = K) + ecdf_pit_fn <- ecdf(pit) + + if (method == "correlated") { + correlated <- .pit_ecdf_correlated_data( + pit = pit, + K = K, + plot_diff = plot_diff, + test = test, + alpha = 1 - prob, + gamma = gamma + ) + + p <- ggplot() + + geom_step( + data = correlated$main, + mapping = aes(x = .data$x, y = .data$ecdf_val), + show.legend = FALSE, + linewidth = linewidth, + color = color["ecdf"] + ) + + geom_segment( + mapping = aes(x = 0, y = 0, xend = 1, yend = if (plot_diff) 0 else 1), + linetype = "dashed", + color = "darkgrey", + linewidth = 0.3 + ) + + labs(x = x_label, y = ifelse(plot_diff, "ECDF difference", "ECDF")) + + if (nrow(correlated$segments) > 0) { + p <- p + geom_step( + data = correlated$segments, + mapping = aes(x = .data$x, y = .data$ecdf_val, group = .data$segment), + color = color["highlight"], + linewidth = linewidth + 0.8 + ) + } + + if (nrow(correlated$isolated) > 0) { + p <- p + geom_point( + data = correlated$isolated, + mapping = aes(x = .data$pit, y = .data$ecdf_val), + color = color["highlight"], + size = linewidth + 1 + ) + } + + if (isTRUE(help_text)) { + label_size <- help_text_shrinkage * .theme_text_size() / ggplot2::.pt + p <- p + annotate( + "text", + x = -Inf, y = Inf, + label = sprintf( + "p[unif]^{%s} == '%s' ~ (alpha == '%.2f')", + test, fmt_p(correlated$p_value), 1 - prob + ), + hjust = -0.05, + vjust = 1.5, + color = "black", + parse = TRUE, + size = label_size + ) + } + + if (plot_diff) { + epsilon <- max( + sqrt(log(2 / (1 - prob)) / (2 * n_obs)), + max(abs(correlated$main$ecdf_val)) + ) + p <- p + scale_y_continuous(limits = c(-epsilon, epsilon)) + } + + return(p + + yaxis_ticks(FALSE) + + scale_color_ppc() + + bayesplot_theme_get()) + } + + # independent method + gamma_indep <- adjust_gamma( + N = n_obs, K = K, prob = prob, interpolate_adj = interpolate_adj + ) + lims <- ecdf_intervals(gamma = gamma_indep, N = n_obs, K = K) + lims_upper <- lims$upper[-1L] / n_obs - plot_diff * unit_interval + lims_lower <- lims$lower[-1L] / n_obs - plot_diff * unit_interval + ecdf_eval <- ecdf_pit_fn(unit_interval) - plot_diff * unit_interval + + ggplot() + + geom_step( + mapping = aes(x = unit_interval, y = lims_upper, color = "yrep"), + linetype = "dashed", + linewidth = 0.3, + show.legend = FALSE + ) + + geom_step( + mapping = aes(x = unit_interval, y = lims_lower, color = "yrep"), + linetype = "dashed", + linewidth = 0.3, + show.legend = FALSE + ) + + geom_step( + mapping = aes(x = unit_interval, y = ecdf_eval, color = "y"), + linewidth = 0.5, + show.legend = FALSE + ) + + labs(x = x_label, y = ifelse(plot_diff, "ECDF difference", "ECDF")) + + yaxis_ticks(FALSE) + + scale_color_ppc() + + bayesplot_theme_get() +} + +#' @noRd +.compute_pit_values <- function(y, yrep, lw, psis_object, group, K, pareto_pit, + pit, loo_cv +) { + # pareto-pit values + if (isTRUE(pareto_pit) && is.null(pit)) { + suggested_package("rstantools") + y <- validate_y(y) + yrep <- validate_predictions(yrep, length(y)) + if (isTRUE(loo_cv)) { + lw <- .get_lw(lw, psis_object) + stopifnot(identical(dim(yrep), dim(lw))) + } else { + lw <- NULL + } + if (!is.null(group)) { + group <- validate_group(group, length(y)) + } + pit <- posterior::pareto_pit(x = yrep, y = y, weights = lw, log = TRUE) + K <- K %||% length(pit) + # custom pit values + } else if (!is.null(pit)) { + pit <- validate_pit(pit) + K <- K %||% length(pit) + ignored <- c( + if (!missing(y) && !is.null(y)) "y", + if (!missing(yrep) && !is.null(yrep)) "yrep" + ) + if (!is.null(group)) { + group <- validate_group(group, length(pit)) + } + if (isTRUE(loo_cv)) { + ignored <- c( + ignored, + if (!is.null(lw)) "lw" + ) + } + if (length(ignored) > 0) { + inform(paste0( + "As 'pit' specified; ignoring: ", + paste(ignored, collapse = ", "), "." + )) + } + # empirical pit values + } else { + y <- validate_y(y) + yrep <- validate_predictions(yrep, length(y)) + K <- K %||% min(nrow(yrep) + 1, 1000) + + if (isTRUE(loo_cv) && is.null(group)) { + suggested_package("rstantools") + lw <- .get_lw(lw, psis_object) + stopifnot(identical(dim(yrep), dim(lw))) + pit <- pmin(1, rstantools::loo_pit(object = yrep, y = y, lw = lw)) + } else if (is.null(group) && !loo_cv) { + pit <- ppc_data(y, yrep) |> + group_by(.data$y_id) |> + dplyr::group_map( + ~ mean(.x$value[.x$is_y] > .x$value[!.x$is_y]) + + runif(1, max = mean(.x$value[.x$is_y] == .x$value[!.x$is_y])) + ) |> + unlist() + } else if (!is.null(group) && !loo_cv) { + group <- validate_group(group, length(y)) + pit <- ppc_data(y, yrep, group) %>% + group_by(.data$y_id) %>% + dplyr::group_map( + ~ mean(.x$value[.x$is_y] > .x$value[!.x$is_y]) + + runif(1, max = mean(.x$value[.x$is_y] == .x$value[!.x$is_y])) + ) %>% + unlist() + } + } + return(list("group" = group, "pit" = pit, "K" = K)) +} + #' Helper for 'adjust_gamma_simulate` #' Transforms observations in 'x' into their corresponding fractional ranks. #' @noRd @@ -594,9 +940,14 @@ u_scale <- function(x) { create_rep_ids <- function(ids) paste('italic(y)[rep] (', ids, ")") y_label <- function() expression(italic(y)) yrep_label <- function() expression(italic(y)[rep]) +ypred_label <- function() expression(italic(y)[pred]) ypred_label <- function() { c( PPD = "PPD", ypred = expression(italic(y)[pred]) ) } +# helper function for formatting p-value when displayed in a plot +fmt_p <- function(x) { + dplyr::if_else(x < 0.0005, "0.000", as.character(round(signif(x, 2) + 1e-10, 3))) +} diff --git a/R/mcmc-traces.R b/R/mcmc-traces.R index 78990ceb..ddf9c549 100644 --- a/R/mcmc-traces.R +++ b/R/mcmc-traces.R @@ -10,7 +10,6 @@ #' @template args-regex_pars #' @template args-transformations #' @template args-facet_args -#' @template args-pit-ecdf #' @param ... Currently ignored. #' @param size An optional value to override the default line size #' for `mcmc_trace()` or the default point size for `mcmc_trace_highlight()`. @@ -458,12 +457,27 @@ mcmc_rank_hist <- function(x, } #' @rdname MCMC-traces +#' @param K An optional integer defining the number of equally spaced evaluation +#' points for the PIT-ECDF. Reducing K when using `interpolate_adj = FALSE` +#' makes computing the confidence bands faster. For `ppc_pit_ecdf()` and +#' `ppc_pit_ecdf_grouped()` when `method = 'independent'`. If `pit` is +#' supplied, defaults to `length(pit)`, otherwise `yrep` determines the +#' maximum accuracy of the estimated PIT values and `K` is set to +#' `min(nrow(yrep) + 1, 1000)`. For `mcmc_rank_ecdf()`, defaults to the number +#' of iterations per chain in `x`. #' @param prob For `mcmc_rank_ecdf()`, a value between 0 and 1 -#' specifying the desired simultaneous confidence of the confidence bands to be -#' drawn for the rank ECDF plots. +#' specifying the desired simultaneous confidence of the confidence bands to be +#' drawn for the rank ECDF plots. #' @param plot_diff For `mcmc_rank_ecdf()`, a boolean specifying if the -#' difference between the observed rank ECDFs and the theoretical expectation -#' should be drawn instead of the unmodified rank ECDF plots. +#' difference between the observed rank ECDFs and the theoretical expectation +#' should be drawn instead of the unmodified rank ECDF plots. +#' @param interpolate_adj A boolean defining if the simultaneous confidence +#' bands should be interpolated based on precomputed values rather than +#' computed exactly. Computing the bands may be computationally intensive and +#' the approximation gives a fast method for assessing the ECDF trajectory. +#' For `ppc_pit_ecdf()` and `ppc_pit_ecdf_grouped()` when +#' `method = 'independent'` and for `mcmc_rank_ecdf()`. The default is to use +#' interpolation if `K` is greater than 200. #' @export mcmc_rank_ecdf <- function(x, diff --git a/R/ppc-distributions.R b/R/ppc-distributions.R index 7ab9ffb8..c39a2f05 100644 --- a/R/ppc-distributions.R +++ b/R/ppc-distributions.R @@ -53,12 +53,13 @@ #' both, depending on the `y_draw` argument. #' } #' \item{`ppc_pit_ecdf()`, `ppc_pit_ecdf_grouped()`}{ -#' The PIT-ECDF of the empirical PIT values of `y` computed with respect to -#' the corresponding `yrep` values. `100 * prob`% central simultaneous -#' confidence intervals are provided to asses if `y` and `yrep` originate -#' from the same distribution. The PIT values can also be provided directly -#' as `pit`. -#' See Säilynoja et al. (2021) for more details. +#' The PIT-ECDF of empirical PIT values for `y` relative to corresponding +#' draws in `yrep` (or precomputed values supplied via `pit`). +#' With `method = "independent"`, the plot shows `100 * prob`% central +#' simultaneous confidence intervals under an independence assumption. +#' With `method = "correlated"`, the plot uses a dependence-aware +#' uniformity assessment and can highlight suspicious regions. +#' See Säilynoja et al. (2025) and Tesso & Vehtari (2026) for details. #' } #' \item{`ppc_data()`}{ #' This function prepares data for plotting with **ggplot2** and doesn't @@ -666,13 +667,42 @@ ppc_violin_grouped <- bayesplot_theme_get() } - +#' @rdname PPC-distributions #' @export +#' @template args-pit-ecdf +#' @param K An optional integer defining the number of equally spaced evaluation +#' points for the PIT-ECDF. Reducing K when using `interpolate_adj = FALSE` +#' makes computing the confidence bands faster. For `ppc_pit_ecdf()` and +#' `ppc_pit_ecdf_grouped()` when `method = 'independent'`. If `pit` is +#' supplied, defaults to `length(pit)`, otherwise `yrep` determines the +#' maximum accuracy of the estimated PIT values and `K` is set to +#' `min(nrow(yrep) + 1, 1000)`. For `mcmc_rank_ecdf()`, defaults to the number +#' of iterations per chain in `x`. +#' @param prob The desired simultaneous coverage level of the bands around the +#' ECDF. A value in (0,1). For `ppc_pit_ecdf()` and `ppc_pit_ecdf_grouped()`. +#' @param plot_diff A boolean defining whether to plot the difference between +#' the observed PIT-ECDF and the theoretical expectation for uniform PIT +#' values rather than plotting the regular ECDF. For `ppc_pit_ecdf()` and +#' `ppc_pit_ecdf_grouped()` when `method = 'independent'`. The default is +#' `FALSE`, but for large samples we recommend setting `plot_diff = TRUE` to +#' better use the plot area. +#' @param interpolate_adj A boolean defining if the simultaneous confidence +#' bands should be interpolated based on precomputed values rather than +#' computed exactly. Computing the bands may be computationally intensive and +#' the approximation gives a fast method for assessing the ECDF trajectory. +#' For `ppc_pit_ecdf()` and `ppc_pit_ecdf_grouped()` when +#' `method = 'independent'` and for `mcmc_rank_ecdf()`. The default is to use +#' interpolation if `K` is greater than 200. #' @param pit An optional vector of probability integral transformed values for -#' which the ECDF is to be drawn. If NULL, PIT values are computed to `y` with +#' which the ECDF is to be drawn. For `ppc_pit_ecdf()` and +#' `ppc_pit_ecdf_grouped()`. If `NULL`, PIT values are computed to `y` with #' respect to the corresponding values in `yrep`. -#' @rdname PPC-distributions -#' +#' @param linewidth When `method = "correlated"`, the line width of the ECDF. +#' Defaults to `0.3`. +#' @note +#' Note that the default "independent" method is **superseded** by +#' the "correlated" method (Tesso & Vehtari, 2026) which accounts for dependent +#' PIT values. ppc_pit_ecdf <- function(y, yrep, ..., @@ -680,64 +710,118 @@ ppc_pit_ecdf <- function(y, K = NULL, prob = .99, plot_diff = FALSE, - interpolate_adj = NULL) { + interpolate_adj = NULL, + method = NULL, + test = NULL, + gamma = NULL, + linewidth = NULL, + color = NULL, + help_text = NULL, + pareto_pit = NULL, + help_text_shrinkage = NULL + ) { check_ignored_arguments(..., - ok_args = c("K", "pit", "prob", "plot_diff", "interpolate_adj") + ok_args = c( + "K", "pareto_pit", "pit", "prob", "plot_diff", + "interpolate_adj", "method", "test", "gamma", "linewidth", + "color", "help_text", "help_text_shrinkage" + ) ) - if (is.null(pit)) { - pit <- ppc_data(y, yrep) %>% - group_by(.data$y_id) %>% - dplyr::group_map( - ~ mean(.x$value[.x$is_y] > .x$value[!.x$is_y]) + - runif(1, max = mean(.x$value[.x$is_y] == .x$value[!.x$is_y])) - ) %>% - unlist() - if (is.null(K)) { - K <- min(nrow(yrep) + 1, 1000) - } - } else { - inform("'pit' specified so ignoring 'y', and 'yrep' if specified.") - pit <- validate_pit(pit) - if (is.null(K)) { - K <- length(pit) - } + method_args <- .pit_ecdf_resolve_method_args( + method = method, + pit = pit, + prob = prob, + interpolate_adj = interpolate_adj, + test = test, + gamma = gamma, + linewidth = linewidth, + color = color, + help_text = help_text, + pareto_pit = pareto_pit, + help_text_shrinkage = help_text_shrinkage + ) + method <- method_args$method + test <- method_args$test + gamma <- method_args$gamma + linewidth <- method_args$linewidth + color <- method_args$color + help_text <- method_args$help_text + pareto_pit <- method_args$pareto_pit + help_text_shrinkage <- method_args$help_text_shrinkage + + pit_data <- .compute_pit_values(y = y, yrep = yrep, lw = NULL, + psis_object = NULL, group = NULL, K = K, pareto_pit = pareto_pit, + pit = pit, loo_cv = FALSE) + pit <- pit_data$pit + K <- pit_data$K + + if ( + (method == "correlated") && + ((test %in% c("POT", "PIET")) && any(pit %in% c(0, 1))) + ) { + stop( + "PIT values contain 0 or 1, but 'POT' and 'PIET' uniformity tests expect\n", + " continuous input (0, 1). If PIT values are discrete,\n", + " use 'PRIT' test instead. If 0 or 1 arise due to rounding, consider\n", + " appropriate scaling approach or perturbing 0 and 1 values by a\n", + " small epsilon so that they are strictly non-zero and non-one." + ) } - N <- length(pit) - gamma <- adjust_gamma( - N = N, + + .pit_ecdf_plot_single( + pit = pit, K = K, prob = prob, - interpolate_adj = interpolate_adj + plot_diff = plot_diff, + interpolate_adj = interpolate_adj, + method = method, + test = test, + gamma = gamma, + linewidth = linewidth, + color = color, + help_text = help_text, + x_label = "PIT", + help_text_shrinkage = help_text_shrinkage ) - lims <- ecdf_intervals(gamma = gamma, N = N, K = K) - ggplot() + - aes( - x = seq(0,1,length.out = K), - y = ecdf(pit)(seq(0, 1, length.out = K)) - - (plot_diff == TRUE) * seq(0, 1, length.out = K), - color = "y" - ) + - geom_step(show.legend = FALSE) + - geom_step(aes( - y = lims$upper[-1] / N - (plot_diff == TRUE) * seq(0, 1, length.out = K), - color = "yrep" - ), - linetype = 2, show.legend = FALSE) + - geom_step(aes( - y = lims$lower[-1] / N - (plot_diff == TRUE) * seq(0, 1, length.out = K), - color = "yrep" - ), - linetype = 2, show.legend = FALSE) + - labs(y = ifelse(plot_diff,"ECDF - difference","ECDF"), x = "PIT") + - yaxis_ticks(FALSE) + - scale_color_ppc() + - bayesplot_theme_get() } -#' @export #' @rdname PPC-distributions -#' +#' @export +#' @template args-pit-ecdf +#' @param K An optional integer defining the number of equally spaced evaluation +#' points for the PIT-ECDF. Reducing K when using `interpolate_adj = FALSE` +#' makes computing the confidence bands faster. For `ppc_pit_ecdf()` and +#' `ppc_pit_ecdf_grouped()` when `method = 'independent'`. If `pit` is +#' supplied, defaults to `length(pit)`, otherwise `yrep` determines the +#' maximum accuracy of the estimated PIT values and `K` is set to +#' `min(nrow(yrep) + 1, 1000)`. For `mcmc_rank_ecdf()`, defaults to the number +#' of iterations per chain in `x`. +#' @param prob The desired simultaneous coverage level of the bands around the +#' ECDF. A value in (0,1). For `ppc_pit_ecdf()` and `ppc_pit_ecdf_grouped()`. +#' @param plot_diff A boolean defining whether to plot the difference between +#' the observed PIT-ECDF and the theoretical expectation for uniform PIT +#' values rather than plotting the regular ECDF. For `ppc_pit_ecdf()` and +#' `ppc_pit_ecdf_grouped()` when `method = 'independent'`. The default is +#' `FALSE`, but for large samples we recommend setting `plot_diff = TRUE` to +#' better use the plot area. +#' @param interpolate_adj A boolean defining if the simultaneous confidence +#' bands should be interpolated based on precomputed values rather than +#' computed exactly. Computing the bands may be computationally intensive and +#' the approximation gives a fast method for assessing the ECDF trajectory. +#' For `ppc_pit_ecdf()` and `ppc_pit_ecdf_grouped()` when +#' `method = 'independent'` and for `mcmc_rank_ecdf()`. The default is to use +#' interpolation if `K` is greater than 200. +#' @param pit An optional vector of probability integral transformed values for +#' which the ECDF is to be drawn. For `ppc_pit_ecdf()` and +#' `ppc_pit_ecdf_grouped()`. If `NULL`, PIT values are computed to `y` with +#' respect to the corresponding values in `yrep`. +#' @param linewidth When `method = "correlated"`, the line width of the ECDF. +#' Defaults to `0.3`. +#' @note +#' Note that the default "independent" method is **superseded** by +#' the "correlated" method (Tesso & Vehtari, 2026) which accounts for dependent +#' PIT values. ppc_pit_ecdf_grouped <- function(y, yrep, @@ -747,56 +831,228 @@ ppc_pit_ecdf_grouped <- pit = NULL, prob = .99, plot_diff = FALSE, - interpolate_adj = NULL) { + interpolate_adj = NULL, + method = NULL, + test = NULL, + gamma = NULL, + linewidth = NULL, + color = NULL, + help_text = NULL, + pareto_pit = NULL, + help_text_shrinkage = NULL) { check_ignored_arguments(..., - ok_args = c("K", "pit", "prob", "plot_diff", "interpolate_adj") + ok_args = c("K", "pareto_pit", "pit", "prob", "plot_diff", + "interpolate_adj", "method", "test", "gamma", + "linewidth", "color", "help_text", "help_text_shrinkage") ) - if (is.null(pit)) { - pit <- ppc_data(y, yrep, group) %>% - group_by(.data$y_id) %>% - dplyr::group_map( - ~ mean(.x$value[.x$is_y] > .x$value[!.x$is_y]) + - runif(1, max = mean(.x$value[.x$is_y] == .x$value[!.x$is_y])) - ) %>% - unlist() - if (is.null(K)) { - K <- min(nrow(yrep) + 1, 1000) + method_args <- .pit_ecdf_resolve_method_args( + method = method, + pit = pit, + prob = prob, + interpolate_adj = interpolate_adj, + test = test, + gamma = gamma, + linewidth = linewidth, + color = color, + help_text = help_text, + pareto_pit = pareto_pit, + help_text_shrinkage = help_text_shrinkage + ) + method <- method_args$method + alpha <- method_args$alpha + test <- method_args$test + gamma <- method_args$gamma + linewidth <- method_args$linewidth + color <- method_args$color + help_text <- method_args$help_text + pareto_pit <- method_args$pareto_pit + help_text_shrinkage <- method_args$help_text_shrinkage + + pit_data <- .compute_pit_values(y = y, yrep = yrep, lw = NULL, + psis_object = NULL, group = group, K = K, pareto_pit = pareto_pit, + pit = pit, loo_cv = FALSE) + group <- pit_data$group + pit <- pit_data$pit + K <- pit_data$K + + if ( + (method == "correlated") && + ((test %in% c("POT", "PIET")) && any(pit %in% c(0, 1))) + ) { + stop( + "PIT values contain 0 or 1, but 'POT' and 'PIET' uniformity tests expect\n", + " continuous input (0, 1). If PIT values are discrete,\n", + " use 'PRIT' test instead. If 0 or 1 arise due to rounding, consider\n", + " appropriate scaling approach or perturbing 0 and 1 values by a\n", + " small epsilon so that they are strictly non-zero and non-one." + ) + } + data <- data.frame(pit = pit, group = group, stringsAsFactors = FALSE) + group_levels <- unique(data$group) + + if (method == "correlated") { + data_cor <- dplyr::group_by(data, .data$group) %>% + dplyr::group_map(function(.x, .y) { + n_obs <- nrow(.x) + K_g <- K %||% n_obs + correlated <- .pit_ecdf_correlated_data( + pit = .x$pit, + K = K_g, + plot_diff = plot_diff, + test = test, + alpha = alpha, + gamma = gamma + ) + df_main <- data.frame( + x = correlated$main$x, + ecdf_value = correlated$main$ecdf_val, + group = .y[[1]], + stringsAsFactors = FALSE + ) + red <- NULL + if (nrow(correlated$segments) > 0) { + red <- data.frame( + x = correlated$segments$x, + ecdf_value = correlated$segments$ecdf_val, + segment = correlated$segments$segment, + group = .y[[1]], + stringsAsFactors = FALSE + ) + } + red_points <- NULL + if (nrow(correlated$isolated) > 0) { + red_points <- data.frame( + x = correlated$isolated$pit, + ecdf_value = correlated$isolated$ecdf_val, + group = .y[[1]], + stringsAsFactors = FALSE + ) + } + + ann <- NULL + if (isTRUE(help_text)) { + ann <- data.frame( + group = .y[[1]], + x = -Inf, + y = Inf, + label = sprintf( + "p[unif]^{%s} == '%s' ~ (alpha == '%.2f')", + test, fmt_p(correlated$p_value), alpha + ), + stringsAsFactors = FALSE + ) + } + + list(main = df_main, red = red, red_points = red_points, ann = ann) + }) + + main_df <- dplyr::bind_rows(lapply(data_cor, `[[`, "main")) + red_df <- dplyr::bind_rows(lapply(data_cor, `[[`, "red")) + red_points_df <- dplyr::bind_rows(lapply(data_cor, `[[`, "red_points")) + ann_df <- dplyr::bind_rows(lapply(data_cor, `[[`, "ann")) + ref_df <- data.frame( + group = group_levels, + x = 0, + y = 0, + xend = 1, + yend = if (plot_diff) 0 else 1, + stringsAsFactors = FALSE + ) + + p <- ggplot() + + geom_step( + data = main_df, + mapping = aes(x = .data$x, y = .data$ecdf_value, group = .data$group), + show.legend = FALSE, + linewidth = linewidth, + color = color["ecdf"] + ) + + geom_segment( + data = ref_df, + mapping = aes( + x = .data$x, + y = .data$y, + xend = .data$xend, + yend = .data$yend + ), + linetype = "dashed", + color = "darkgrey", + linewidth = 0.3 + ) + + if (nrow(red_df) > 0) { + p <- p + geom_step( + data = red_df, + mapping = aes(x = .data$x, y = .data$ecdf_value, + group = interaction(.data$group, .data$segment)), + color = color["highlight"], + linewidth = linewidth + 0.8 + ) + } + + if (nrow(red_points_df) > 0) { + p <- p + geom_point( + data = red_points_df, + mapping = aes(x = .data$x, y = .data$ecdf_value), + color = color["highlight"], + size = linewidth + 1 + ) } - } else { - inform("'pit' specified so ignoring 'y' and 'yrep' if specified.") - pit <- validate_pit(pit) + + if (isTRUE(help_text) && nrow(ann_df) > 0) { + label_size <- help_text_shrinkage * .theme_text_size() / ggplot2::.pt + p <- p + geom_text( + data = ann_df, + mapping = aes(x = .data$x, y = .data$y, label = .data$label), + hjust = -0.05, + vjust = 1.5, + color = "black", + parse = TRUE, + size = label_size + ) + } + + return( + p + + labs(y = ifelse(plot_diff, "ECDF difference", "ECDF"), x = "PIT") + + yaxis_ticks(FALSE) + + bayesplot_theme_get() + + facet_wrap("group") + + scale_color_ppc() + + force_axes_in_facets() + ) } - N <- length(pit) - gammas <- lapply(unique(group), function(g) { - N_g <- sum(group == g) + # independent method + gammas <- lapply(group_levels, function(g) { + N_g <- sum(data$group == g) adjust_gamma( N = N_g, - K = ifelse(is.null(K), N_g, K), + K = K %||% N_g, prob = prob, interpolate_adj = interpolate_adj ) }) - names(gammas) <- unique(group) + names(gammas) <- group_levels - data <- data.frame(pit = pit, group = group) %>% - group_by(group) %>% + data <- data %>% + dplyr::group_by(.data$group) %>% dplyr::group_map( ~ data.frame( - ecdf_value = ecdf(.x$pit)(seq(0, 1, length.out = ifelse(is.null(K), nrow(.x), K))), + ecdf_value = ecdf(.x$pit)(seq(0, 1, length.out = K %||% nrow(.x))), group = .y[1], lims_upper = ecdf_intervals( gamma = gammas[[unlist(.y[1])]], N = nrow(.x), - K = ifelse(is.null(K), nrow(.x), K) + K = K %||% nrow(.x) )$upper[-1] / nrow(.x), lims_lower = ecdf_intervals( gamma = gammas[[unlist(.y[1])]], N = nrow(.x), - K = ifelse(is.null(K), nrow(.x), K) + K = K %||% nrow(.x) )$lower[-1] / nrow(.x), - x = seq(0, 1, length.out = ifelse(is.null(K), nrow(.x), K)) + x = seq(0, 1, length.out = K %||% nrow(.x)) ) ) %>% dplyr::bind_rows() diff --git a/R/ppc-loo.R b/R/ppc-loo.R index 1be70f14..ec25d901 100644 --- a/R/ppc-loo.R +++ b/R/ppc-loo.R @@ -21,7 +21,9 @@ #' [ggplot2::geom_density()], respectively. For `ppc_loo_intervals()`, `size` #' `linewidth` and `fatten` are passed to [ggplot2::geom_pointrange()]. For #' `ppc_loo_ribbon()`, `alpha` and `size` are passed to -#' [ggplot2::geom_ribbon()]. +#' [ggplot2::geom_ribbon()]. For `ppc_loo_pit_ecdf()`, linewidth for the ECDF plot. When +#' `method = "correlated"`, defaults to 0.3. When `method = "independent"`, +#' if `NULL` no linewidth is specified for the ECDF line. #' #' @template return-ggplot-or-data #' @@ -65,12 +67,13 @@ #' Q-Q plot. #' #' The `ppc_loo_pit_ecdf()` function visualizes the empirical cumulative -#' distribution function (ECDF) of the LOO PITs overlaid with simultaneous -#' confidence intervals for a standard uniform sample. For large samples, -#' these confidence intervals are visually very narrow. Setting the -#' `plot_diff` argument to `TRUE` transforms the plot to display the -#' difference of the ECDF and the theoretical expectation, which can aid in -#' the visual assessment of calibration. +#' distribution function (ECDF) of the LOO PIT values. +#' With `method = "independent"`, the plot overlays `100 * prob`% +#' simultaneous confidence intervals for a standard uniform sample. +#' With `method = "correlated"`, the plot uses a dependence-aware +#' uniformity assessment and can highlight suspicious regions. +#' Setting `plot_diff = TRUE` displays the ECDF minus the theoretical +#' expectation, which can improve visual assessment of calibration. #' } #' \item{`ppc_loo_intervals()`, `ppc_loo_ribbon()`}{ #' Similar to [ppc_intervals()] and [ppc_ribbon()] but the intervals are for @@ -396,23 +399,31 @@ ppc_loo_pit_qq <- function(y, #' @rdname PPC-loo #' @export -#' @param K For `ppc_loo_pit_ecdf()` an optional integer defining the number -#' of equally spaced evaluation points for the PIT-ECDF. Reducing K when -#' using `interpolate_adj = FALSE` makes computing the confidence bands -#' faster. If `pit` is supplied, defaults to `length(pit)`, otherwise -#' `yrep` determines the maximum accuracy of the estimated PIT values and -#' `K` is set to `min(nrow(yrep) + 1, 1000)`. -#' @param plot_diff For `ppc_loo_pit_ecdf()`, a boolean defining whether to -#' plot the difference between the observed PIT-ECDF and the theoretical -#' expectation for uniform PIT values rather than plotting the regular ECDF. -#' The default is `FALSE`, but for large samples we recommend setting -#' `plot_diff = TRUE` to better use the plot area. -#' @param interpolate_adj For `ppc_loo_pit_ecdf()`, a boolean defining if the -#' simultaneous confidence bands should be interpolated based on precomputed -#' values rather than computed exactly. Computing the bands may be -#' computationally intensive and the approximation gives a fast method for -#' assessing the ECDF trajectory. The default is to use interpolation if `K` -#' is greater than 200. +#' @template args-pit-ecdf +#' @param K An optional integer defining the number of equally spaced evaluation +#' points for the PIT-ECDF. Reducing K when using `interpolate_adj = FALSE` +#' makes computing the confidence bands faster. For `ppc_loo_pit_ecdf()`, +#' when `method = 'independent'`. If `pit` is supplied, defaults to +#' `length(pit)`, otherwise `yrep` determines the maximum accuracy of the +#' estimated PIT values and `K` is set to `min(nrow(yrep) + 1, 1000)`. +#' @param plot_diff A boolean defining whether to plot the difference between +#' the observed PIT-ECDF and the theoretical expectation for uniform PIT +#' values rather than plotting the regular ECDF. For `ppc_loo_pit_ecdf()`, +#' when `method = 'independent'`. The default is `FALSE`, but for large +#' samples we recommend setting `plot_diff = TRUE` to better use the plot area. +#' @param interpolate_adj A boolean defining if the simultaneous confidence +#' bands should be interpolated based on precomputed values rather than +#' computed exactly. Computing the bands may be computationally intensive and +#' the approximation gives a fast method for assessing the ECDF trajectory. +#' For `ppc_loo_pit_ecdf()` when `method = 'independent'`. +#' The default is to use interpolation if `K` is greater than 200. +#' @param pit An optional vector of probability integral transformed values for +#' which the ECDF is to be drawn. For `ppc_loo_pit_ecdf()`. If `NULL`, PIT +#' values are computed to `y` with respect to the corresponding values in `yrep`. +#' @note +#' Note that the default "independent" method is **superseded** by +#' the "correlated" method (Tesso & Vehtari, 2026) which accounts for dependent +#' LOO-PIT values. ppc_loo_pit_ecdf <- function(y, yrep, lw = NULL, @@ -422,63 +433,73 @@ ppc_loo_pit_ecdf <- function(y, K = NULL, prob = .99, plot_diff = FALSE, - interpolate_adj = NULL) { + interpolate_adj = NULL, + method = NULL, + test = NULL, + gamma = NULL, + linewidth = NULL, + color = NULL, + help_text = NULL, + pareto_pit = NULL, + help_text_shrinkage = NULL) { check_ignored_arguments(..., ok_args = list("moment_match")) - if (!is.null(pit)) { - inform("'pit' specified so ignoring 'y','yrep','lw' if specified.") - pit <- validate_pit(pit) - if (is.null(K)) { - K <- length(pit) - } - } else { - suggested_package("rstantools") - y <- validate_y(y) - yrep <- validate_predictions(yrep, length(y)) - lw <- .get_lw(lw, psis_object) - stopifnot(identical(dim(yrep), dim(lw))) - pit <- pmin(1, rstantools::loo_pit(object = yrep, y = y, lw = lw)) - if (is.null(K)) { - K <- min(nrow(yrep) + 1, 1000) - } + method_args <- .pit_ecdf_resolve_method_args( + method = method, + pit = pit, + prob = prob, + interpolate_adj = interpolate_adj, + test = test, + gamma = gamma, + linewidth = linewidth, + color = color, + help_text = help_text, + pareto_pit = pareto_pit, + help_text_shrinkage = help_text_shrinkage + ) + method <- method_args$method + test <- method_args$test + gamma <- method_args$gamma + linewidth <- method_args$linewidth + color <- method_args$color + help_text <- method_args$help_text + pareto_pit <- method_args$pareto_pit + help_text_shrinkage <- method_args$help_text_shrinkage + + pit_data <- .compute_pit_values(y = y, yrep = yrep, lw = lw, + psis_object = psis_object, group = NULL, K = K, pareto_pit = pareto_pit, + pit = pit, loo_cv = TRUE) + pit <- pit_data$pit + K <- pit_data$K + + if ( + (method == "correlated") && + ((test %in% c("POT", "PIET")) && any(pit %in% c(0, 1))) + ) { + stop( + "PIT values contain 0 or 1, but 'POT' and 'PIET' uniformity tests expect\n", + " continuous input (0, 1). If PIT values are discrete,\n", + " use 'PRIT' test instead. If 0 or 1 arise due to rounding, consider\n", + " appropriate scaling approach or perturbing 0 and 1 values by a\n", + " small epsilon so that they are strictly non-zero and non-one." + ) } - n_obs <- length(pit) - gamma <- adjust_gamma( - N = n_obs, + .pit_ecdf_plot_single( + pit = pit, K = K, prob = prob, - interpolate_adj = interpolate_adj + plot_diff = plot_diff, + interpolate_adj = interpolate_adj, + method = method, + test = test, + gamma = gamma, + linewidth = linewidth, + color = color, + help_text = help_text, + x_label = "LOO-PIT", + help_text_shrinkage = help_text_shrinkage ) - lims <- ecdf_intervals(gamma = gamma, N = n_obs, K = K) - ggplot() + - aes( - x = seq(0, 1, length.out = K), - y = ecdf(pit)(seq(0, 1, length.out = K)) - - (plot_diff == TRUE) * seq(0, 1, length.out = K), - color = "y" - ) + - geom_step(show.legend = FALSE) + - geom_step( - aes( - y = lims$upper[-1] / n_obs - - (plot_diff == TRUE) * seq(0, 1, length.out = K), - color = "yrep" - ), - linetype = 2, show.legend = FALSE - ) + - geom_step( - aes( - y = lims$lower[-1] / n_obs - - (plot_diff == TRUE) * seq(0, 1, length.out = K), - color = "yrep" - ), - linetype = 2, show.legend = FALSE - ) + - labs(y = ifelse(plot_diff, "ECDF difference", "ECDF"), x = "LOO PIT") + - yaxis_ticks(FALSE) + - scale_color_ppc() + - bayesplot_theme_get() } @@ -845,7 +866,7 @@ ppc_loo_ribbon <- bc_mat <- matrix(0, nrow(unifs), ncol(unifs)) # Generate boundary corrected reference values - for (i in 1:nrow(unifs)) { + for (i in seq_len(nrow(unifs))) { bc_list <- .kde_correction(unifs[i, ], bw = bw, grid_len = grid_len diff --git a/man-roxygen/args-methods-dots.R b/man-roxygen/args-methods-dots.R new file mode 100644 index 00000000..4e0e6c4a --- /dev/null +++ b/man-roxygen/args-methods-dots.R @@ -0,0 +1 @@ +#' @param ... Arguments passed to individual methods (if applicable). diff --git a/man-roxygen/args-pit-ecdf.R b/man-roxygen/args-pit-ecdf.R index 65a676bf..8ed007cb 100644 --- a/man-roxygen/args-pit-ecdf.R +++ b/man-roxygen/args-pit-ecdf.R @@ -1,19 +1,24 @@ -#' @param K An optional integer defining the number of equally spaced evaluation -#' points for the PIT-ECDF. Reducing K when using `interpolate_adj = FALSE` -#' makes computing the confidence bands faster. For `ppc_pit_ecdf` and -#' `ppc_pit_ecdf_grouped`, if PIT values are supplied, defaults to -#' `length(pit)`, otherwise yrep determines the maximum accuracy of the -#' estimated PIT values and `K` is set to `min(nrow(yrep) + 1, 1000)`. For -#' `mcmc_rank_ecdf`, defaults to the number of iterations per chain in `x`. -#' @param prob The desired simultaneous coverage level of the bands around the -#' ECDF. A value in (0,1). -#' @param plot_diff A boolean defining whether to plot the difference between -#' the observed PIT- ECDF and the theoretical expectation for uniform PIT -#' values rather than plotting the regular ECDF. The default is `FALSE`, but -#' for large samples we recommend setting `plot_diff=TRUE` as the difference -#' plot will visually show a more dynamic range. -#' @param interpolate_adj A boolean defining if the simultaneous confidence -#' bands should be interpolated based on precomputed values rather than -#' computed exactly. Computing the bands may be computationally intensive and -#' the approximation gives a fast method for assessing the ECDF trajectory. -#' The default is to use interpolation if `K` is greater than 200. +#' @param method The method used to calculate the uniformity test: +#' * `"independent"`: assumes independent PIT values (Säilynoja et al., 2022). +#' * `"correlated"`: accounts for correlated PIT values (Tesso & Vehtari, 2026). +#' @param test When `method = "correlated"`, which dependence-aware test to use: +#' `"POT"`, `"PRIT"`, or `"PIET"`. Defaults to `"POT"`. +#' @param gamma When `method = "correlated"`, tolerance threshold controlling +#' how strongly suspicious points are flagged. Larger values (`gamma > 0`) +#' emphasize points with larger deviations. If `NULL`, defaults to `0` and +#' thus all suspicious points are flagged. +#' @param color When `method = "correlated"`, a vector with base color and +#' highlight color for the ECDF plot. Defaults to +#' `c(ecdf = "grey60", highlight = "red")`. The first element is used for +#' the main ECDF line, the second for highlighted suspicious regions. +#' @param help_text When `method = "correlated"`, a boolean defining whether +#' to add information about p-value to the plot. Defaults to `TRUE`. +#' @param help_text_shrinkage When `method = "correlated"`, a numeric value +#' between 0 and 1 defining the factor by which the help-text (p-value +#' information) is scaled. The default is `0.8`. +#' @param pareto_pit A boolean defining whether to compute PIT values using +#' Pareto-PIT method. Defaults to `TRUE` if `test` is either `"POT"` or +#' `"PIET"` and no `pit` values are provided otherwise `FALSE`. This argument +#' should normally not be modified by the user, except for development +#' purposes. If `pit` is non-`NULL`, `pareto_pit` cannot be simultaneously +#' `TRUE`. diff --git a/man/MCMC-traces.Rd b/man/MCMC-traces.Rd index 9a280361..52cb6da3 100644 --- a/man/MCMC-traces.Rd +++ b/man/MCMC-traces.Rd @@ -195,11 +195,12 @@ average number of ranks per bin. Defaults to \code{FALSE}.} \item{K}{An optional integer defining the number of equally spaced evaluation points for the PIT-ECDF. Reducing K when using \code{interpolate_adj = FALSE} -makes computing the confidence bands faster. For \code{ppc_pit_ecdf} and -\code{ppc_pit_ecdf_grouped}, if PIT values are supplied, defaults to -\code{length(pit)}, otherwise yrep determines the maximum accuracy of the -estimated PIT values and \code{K} is set to \code{min(nrow(yrep) + 1, 1000)}. For -\code{mcmc_rank_ecdf}, defaults to the number of iterations per chain in \code{x}.} +makes computing the confidence bands faster. For \code{ppc_pit_ecdf()} and +\code{ppc_pit_ecdf_grouped()} when \code{method = 'independent'}. If \code{pit} is +supplied, defaults to \code{length(pit)}, otherwise \code{yrep} determines the +maximum accuracy of the estimated PIT values and \code{K} is set to +\code{min(nrow(yrep) + 1, 1000)}. For \code{mcmc_rank_ecdf()}, defaults to the number +of iterations per chain in \code{x}.} \item{prob}{For \code{mcmc_rank_ecdf()}, a value between 0 and 1 specifying the desired simultaneous confidence of the confidence bands to be @@ -213,7 +214,9 @@ should be drawn instead of the unmodified rank ECDF plots.} bands should be interpolated based on precomputed values rather than computed exactly. Computing the bands may be computationally intensive and the approximation gives a fast method for assessing the ECDF trajectory. -The default is to use interpolation if \code{K} is greater than 200.} +For \code{ppc_pit_ecdf()} and \code{ppc_pit_ecdf_grouped()} when +\code{method = 'independent'} and for \code{mcmc_rank_ecdf()}. The default is to use +interpolation if \code{K} is greater than 200.} } \value{ The plotting functions return a ggplot object that can be further diff --git a/man/PPC-distributions.Rd b/man/PPC-distributions.Rd index 1aed7318..eb0ef109 100644 --- a/man/PPC-distributions.Rd +++ b/man/PPC-distributions.Rd @@ -131,7 +131,15 @@ ppc_pit_ecdf( K = NULL, prob = 0.99, plot_diff = FALSE, - interpolate_adj = NULL + interpolate_adj = NULL, + method = NULL, + test = NULL, + gamma = NULL, + linewidth = NULL, + color = NULL, + help_text = NULL, + pareto_pit = NULL, + help_text_shrinkage = NULL ) ppc_pit_ecdf_grouped( @@ -143,7 +151,15 @@ ppc_pit_ecdf_grouped( pit = NULL, prob = 0.99, plot_diff = FALSE, - interpolate_adj = NULL + interpolate_adj = NULL, + method = NULL, + test = NULL, + gamma = NULL, + linewidth = NULL, + color = NULL, + help_text = NULL, + pareto_pit = NULL, + help_text_shrinkage = NULL ) } \arguments{ @@ -219,31 +235,72 @@ to control the appearance of \code{y} points. The default of \code{y_jitter=NULL will let \strong{ggplot2} determine the amount of jitter.} \item{pit}{An optional vector of probability integral transformed values for -which the ECDF is to be drawn. If NULL, PIT values are computed to \code{y} with +which the ECDF is to be drawn. For \code{ppc_pit_ecdf()} and +\code{ppc_pit_ecdf_grouped()}. If \code{NULL}, PIT values are computed to \code{y} with respect to the corresponding values in \code{yrep}.} \item{K}{An optional integer defining the number of equally spaced evaluation points for the PIT-ECDF. Reducing K when using \code{interpolate_adj = FALSE} -makes computing the confidence bands faster. For \code{ppc_pit_ecdf} and -\code{ppc_pit_ecdf_grouped}, if PIT values are supplied, defaults to -\code{length(pit)}, otherwise yrep determines the maximum accuracy of the -estimated PIT values and \code{K} is set to \code{min(nrow(yrep) + 1, 1000)}. For -\code{mcmc_rank_ecdf}, defaults to the number of iterations per chain in \code{x}.} +makes computing the confidence bands faster. For \code{ppc_pit_ecdf()} and +\code{ppc_pit_ecdf_grouped()} when \code{method = 'independent'}. If \code{pit} is +supplied, defaults to \code{length(pit)}, otherwise \code{yrep} determines the +maximum accuracy of the estimated PIT values and \code{K} is set to +\code{min(nrow(yrep) + 1, 1000)}. For \code{mcmc_rank_ecdf()}, defaults to the number +of iterations per chain in \code{x}.} \item{prob}{The desired simultaneous coverage level of the bands around the -ECDF. A value in (0,1).} +ECDF. A value in (0,1). For \code{ppc_pit_ecdf()} and \code{ppc_pit_ecdf_grouped()}.} \item{plot_diff}{A boolean defining whether to plot the difference between -the observed PIT- ECDF and the theoretical expectation for uniform PIT -values rather than plotting the regular ECDF. The default is \code{FALSE}, but -for large samples we recommend setting \code{plot_diff=TRUE} as the difference -plot will visually show a more dynamic range.} +the observed PIT-ECDF and the theoretical expectation for uniform PIT +values rather than plotting the regular ECDF. For \code{ppc_pit_ecdf()} and +\code{ppc_pit_ecdf_grouped()} when \code{method = 'independent'}. The default is +\code{FALSE}, but for large samples we recommend setting \code{plot_diff = TRUE} to +better use the plot area.} \item{interpolate_adj}{A boolean defining if the simultaneous confidence bands should be interpolated based on precomputed values rather than computed exactly. Computing the bands may be computationally intensive and the approximation gives a fast method for assessing the ECDF trajectory. -The default is to use interpolation if \code{K} is greater than 200.} +For \code{ppc_pit_ecdf()} and \code{ppc_pit_ecdf_grouped()} when +\code{method = 'independent'} and for \code{mcmc_rank_ecdf()}. The default is to use +interpolation if \code{K} is greater than 200.} + +\item{method}{The method used to calculate the uniformity test: +\itemize{ +\item \code{"independent"}: assumes independent PIT values (Säilynoja et al., 2022). +\item \code{"correlated"}: accounts for correlated PIT values (Tesso & Vehtari, 2026). +}} + +\item{test}{When \code{method = "correlated"}, which dependence-aware test to use: +\code{"POT"}, \code{"PRIT"}, or \code{"PIET"}. Defaults to \code{"POT"}.} + +\item{gamma}{When \code{method = "correlated"}, tolerance threshold controlling +how strongly suspicious points are flagged. Larger values (\code{gamma > 0}) +emphasize points with larger deviations. If \code{NULL}, defaults to \code{0} and +thus all suspicious points are flagged.} + +\item{linewidth}{When \code{method = "correlated"}, the line width of the ECDF. +Defaults to \code{0.3}.} + +\item{color}{When \code{method = "correlated"}, a vector with base color and +highlight color for the ECDF plot. Defaults to +\code{c(ecdf = "grey60", highlight = "red")}. The first element is used for +the main ECDF line, the second for highlighted suspicious regions.} + +\item{help_text}{When \code{method = "correlated"}, a boolean defining whether +to add information about p-value to the plot. Defaults to \code{TRUE}.} + +\item{pareto_pit}{A boolean defining whether to compute PIT values using +Pareto-PIT method. Defaults to \code{TRUE} if \code{test} is either \code{"POT"} or +\code{"PIET"} and no \code{pit} values are provided otherwise \code{FALSE}. This argument +should normally not be modified by the user, except for development +purposes. If \code{pit} is non-\code{NULL}, \code{pareto_pit} cannot be simultaneously +\code{TRUE}.} + +\item{help_text_shrinkage}{When \code{method = "correlated"}, a numeric value +between 0 and 1 defining the factor by which the help-text (p-value +information) is scaled. The default is \code{0.8}.} } \value{ The plotting functions return a ggplot object that can be further @@ -261,6 +318,15 @@ For Binomial data, the plots may be more useful if the input contains the "success" \emph{proportions} (not discrete "success" or "failure" counts). } +\note{ +Note that the default "independent" method is \strong{superseded} by +the "correlated" method (Tesso & Vehtari, 2026) which accounts for dependent +PIT values. + +Note that the default "independent" method is \strong{superseded} by +the "correlated" method (Tesso & Vehtari, 2026) which accounts for dependent +PIT values. +} \section{Plot Descriptions}{ \describe{ @@ -295,12 +361,13 @@ quantiles. \code{y} is overlaid on the plot either as a violin, points, or both, depending on the \code{y_draw} argument. } \item{\code{ppc_pit_ecdf()}, \code{ppc_pit_ecdf_grouped()}}{ -The PIT-ECDF of the empirical PIT values of \code{y} computed with respect to -the corresponding \code{yrep} values. \code{100 * prob}\% central simultaneous -confidence intervals are provided to asses if \code{y} and \code{yrep} originate -from the same distribution. The PIT values can also be provided directly -as \code{pit}. -See Säilynoja et al. (2021) for more details. +The PIT-ECDF of empirical PIT values for \code{y} relative to corresponding +draws in \code{yrep} (or precomputed values supplied via \code{pit}). +With \code{method = "independent"}, the plot shows \code{100 * prob}\% central +simultaneous confidence intervals under an independence assumption. +With \code{method = "correlated"}, the plot uses a dependence-aware +uniformity assessment and can highlight suspicious regions. +See Säilynoja et al. (2025) and Tesso & Vehtari (2026) for details. } \item{\code{ppc_data()}}{ This function prepares data for plotting with \strong{ggplot2} and doesn't diff --git a/man/PPC-loo.Rd b/man/PPC-loo.Rd index 6c57dc5c..50f9e43a 100644 --- a/man/PPC-loo.Rd +++ b/man/PPC-loo.Rd @@ -65,7 +65,15 @@ ppc_loo_pit_ecdf( K = NULL, prob = 0.99, plot_diff = FALSE, - interpolate_adj = NULL + interpolate_adj = NULL, + method = NULL, + test = NULL, + gamma = NULL, + linewidth = NULL, + color = NULL, + help_text = NULL, + pareto_pit = NULL, + help_text_shrinkage = NULL ) ppc_loo_pit( @@ -131,11 +139,9 @@ the \strong{Examples} section, below. If \code{lw} is not specified then object returned by the \code{psis()} function (or by the \code{loo()} function with argument \code{save_psis} set to \code{TRUE}).} -\item{pit}{For \code{ppc_loo_pit_overlay()}, \code{ppc_loo_pit_qq()}, and -\code{ppc_loo_pit_ecdf()} optionally a vector of precomputed PIT values that -can be specified instead of \code{y}, \code{yrep}, and \code{lw} (these are all ignored -if \code{pit} is specified). If not specified the PIT values are computed -internally before plotting.} +\item{pit}{An optional vector of probability integral transformed values for +which the ECDF is to be drawn. For \code{ppc_loo_pit_ecdf()}. If \code{NULL}, PIT +values are computed to \code{y} with respect to the corresponding values in \code{yrep}.} \item{samples}{For \code{ppc_loo_pit_overlay()}, the number of data sets (each the same size as \code{y}) to simulate from the standard uniform @@ -149,7 +155,9 @@ and \code{alpha} are passed to \code{\link[ggplot2:geom_point]{ggplot2::geom_poi \code{\link[ggplot2:geom_density]{ggplot2::geom_density()}}, respectively. For \code{ppc_loo_intervals()}, \code{size} \code{linewidth} and \code{fatten} are passed to \code{\link[ggplot2:geom_linerange]{ggplot2::geom_pointrange()}}. For \code{ppc_loo_ribbon()}, \code{alpha} and \code{size} are passed to -\code{\link[ggplot2:geom_ribbon]{ggplot2::geom_ribbon()}}.} +\code{\link[ggplot2:geom_ribbon]{ggplot2::geom_ribbon()}}. For \code{ppc_loo_pit_ecdf()}, linewidth for the ECDF plot. When +\code{method = "correlated"}, defaults to 0.3. When \code{method = "independent"}, +if \code{NULL} no linewidth is specified for the ECDF line.} \item{boundary_correction}{For \code{ppc_loo_pit_overlay()}, when set to \code{TRUE} (the default) the function will compute boundary corrected density values @@ -175,30 +183,63 @@ compares computed PIT values to the standard uniform distribution. If calculated from the PIT values to the theoretical standard normal quantiles.} -\item{K}{For \code{ppc_loo_pit_ecdf()} an optional integer defining the number -of equally spaced evaluation points for the PIT-ECDF. Reducing K when -using \code{interpolate_adj = FALSE} makes computing the confidence bands -faster. If \code{pit} is supplied, defaults to \code{length(pit)}, otherwise -\code{yrep} determines the maximum accuracy of the estimated PIT values and -\code{K} is set to \code{min(nrow(yrep) + 1, 1000)}.} +\item{K}{An optional integer defining the number of equally spaced evaluation +points for the PIT-ECDF. Reducing K when using \code{interpolate_adj = FALSE} +makes computing the confidence bands faster. For \code{ppc_loo_pit_ecdf()}, +when \code{method = 'independent'}. If \code{pit} is supplied, defaults to +\code{length(pit)}, otherwise \code{yrep} determines the maximum accuracy of the +estimated PIT values and \code{K} is set to \code{min(nrow(yrep) + 1, 1000)}.} \item{prob, prob_outer}{Values between \code{0} and \code{1} indicating the desired probability mass to include in the inner and outer intervals. The defaults are \code{prob=0.5} and \code{prob_outer=0.9} for \code{ppc_loo_intervals()} and \code{prob = 0.99} for \code{ppc_loo_pit_ecdf()}.} -\item{plot_diff}{For \code{ppc_loo_pit_ecdf()}, a boolean defining whether to -plot the difference between the observed PIT-ECDF and the theoretical -expectation for uniform PIT values rather than plotting the regular ECDF. -The default is \code{FALSE}, but for large samples we recommend setting -\code{plot_diff = TRUE} to better use the plot area.} - -\item{interpolate_adj}{For \code{ppc_loo_pit_ecdf()}, a boolean defining if the -simultaneous confidence bands should be interpolated based on precomputed -values rather than computed exactly. Computing the bands may be -computationally intensive and the approximation gives a fast method for -assessing the ECDF trajectory. The default is to use interpolation if \code{K} -is greater than 200.} +\item{plot_diff}{A boolean defining whether to plot the difference between +the observed PIT-ECDF and the theoretical expectation for uniform PIT +values rather than plotting the regular ECDF. For \code{ppc_loo_pit_ecdf()}, +when \code{method = 'independent'}. The default is \code{FALSE}, but for large +samples we recommend setting \code{plot_diff = TRUE} to better use the plot area.} + +\item{interpolate_adj}{A boolean defining if the simultaneous confidence +bands should be interpolated based on precomputed values rather than +computed exactly. Computing the bands may be computationally intensive and +the approximation gives a fast method for assessing the ECDF trajectory. +For \code{ppc_loo_pit_ecdf()} when \code{method = 'independent'}. +The default is to use interpolation if \code{K} is greater than 200.} + +\item{method}{The method used to calculate the uniformity test: +\itemize{ +\item \code{"independent"}: assumes independent PIT values (Säilynoja et al., 2022). +\item \code{"correlated"}: accounts for correlated PIT values (Tesso & Vehtari, 2026). +}} + +\item{test}{When \code{method = "correlated"}, which dependence-aware test to use: +\code{"POT"}, \code{"PRIT"}, or \code{"PIET"}. Defaults to \code{"POT"}.} + +\item{gamma}{When \code{method = "correlated"}, tolerance threshold controlling +how strongly suspicious points are flagged. Larger values (\code{gamma > 0}) +emphasize points with larger deviations. If \code{NULL}, defaults to \code{0} and +thus all suspicious points are flagged.} + +\item{color}{When \code{method = "correlated"}, a vector with base color and +highlight color for the ECDF plot. Defaults to +\code{c(ecdf = "grey60", highlight = "red")}. The first element is used for +the main ECDF line, the second for highlighted suspicious regions.} + +\item{help_text}{When \code{method = "correlated"}, a boolean defining whether +to add information about p-value to the plot. Defaults to \code{TRUE}.} + +\item{pareto_pit}{A boolean defining whether to compute PIT values using +Pareto-PIT method. Defaults to \code{TRUE} if \code{test} is either \code{"POT"} or +\code{"PIET"} and no \code{pit} values are provided otherwise \code{FALSE}. This argument +should normally not be modified by the user, except for development +purposes. If \code{pit} is non-\code{NULL}, \code{pareto_pit} cannot be simultaneously +\code{TRUE}.} + +\item{help_text_shrinkage}{When \code{method = "correlated"}, a numeric value +between 0 and 1 defining the factor by which the help-text (p-value +information) is scaled. The default is \code{0.8}.} \item{subset}{For \code{ppc_loo_intervals()} and \code{ppc_loo_ribbon()}, an optional integer vector indicating which observations in \code{y} (and \code{yrep}) to @@ -234,6 +275,11 @@ Leave-One-Out (LOO) predictive checks. See the \strong{Plot Descriptions} sectio below, and \href{https://github.com/jgabry/bayes-vis-paper#readme}{Gabry et al. (2019)} for details. } +\note{ +Note that the default "independent" method is \strong{superseded} by +the "correlated" method (Tesso & Vehtari, 2026) which accounts for dependent +LOO-PIT values. +} \section{Plot Descriptions}{ \describe{ @@ -275,12 +321,13 @@ function will provide a clearer picture of calibration problems than the Q-Q plot. The \code{ppc_loo_pit_ecdf()} function visualizes the empirical cumulative -distribution function (ECDF) of the LOO PITs overlaid with simultaneous -confidence intervals for a standard uniform sample. For large samples, -these confidence intervals are visually very narrow. Setting the -\code{plot_diff} argument to \code{TRUE} transforms the plot to display the -difference of the ECDF and the theoretical expectation, which can aid in -the visual assessment of calibration. +distribution function (ECDF) of the LOO PIT values. +With \code{method = "independent"}, the plot overlays \code{100 * prob}\% +simultaneous confidence intervals for a standard uniform sample. +With \code{method = "correlated"}, the plot uses a dependence-aware +uniformity assessment and can highlight suspicious regions. +Setting \code{plot_diff = TRUE} displays the ECDF minus the theoretical +expectation, which can improve visual assessment of calibration. } \item{\code{ppc_loo_intervals()}, \code{ppc_loo_ribbon()}}{ Similar to \code{\link[=ppc_intervals]{ppc_intervals()}} and \code{\link[=ppc_ribbon]{ppc_ribbon()}} but the intervals are for diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-color-change.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-color-change.svg new file mode 100644 index 00000000..ee184d4d --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-color-change.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.000 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +PIT +ECDF +ppc_pit_ecdf (color change) + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-diff.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-diff.svg new file mode 100644 index 00000000..1d59df84 --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-diff.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.000 + +( +α += +0.01 +) + + + +-0.1 +0.0 +0.1 + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +PIT +ECDF difference +ppc_pit_ecdf (correlated diff) + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-piet-2.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-piet-2.svg new file mode 100644 index 00000000..9bf0a9ee --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-piet-2.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +I +E +T += +0.19 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +PIT +ECDF +ppc_pit_ecdf (correlated piet 2) + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-piet.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-piet.svg new file mode 100644 index 00000000..e770c90d --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-piet.svg @@ -0,0 +1,76 @@ + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +I +E +T += +0.000 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +PIT +ECDF +ppc_pit_ecdf (correlated PIET) + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-pot.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-pot.svg new file mode 100644 index 00000000..47478893 --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-pot.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.000 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +PIT +ECDF +ppc_pit_ecdf (correlated pot) + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-prit-2.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-prit-2.svg new file mode 100644 index 00000000..ec3adb47 --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-prit-2.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +R +I +T += +0.001 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +PIT +ECDF +ppc_pit_ecdf (correlated prit 2) + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-prit.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-prit.svg new file mode 100644 index 00000000..151a21ae --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated-prit.svg @@ -0,0 +1,76 @@ + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +R +I +T += +0.000 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +PIT +ECDF +ppc_pit_ecdf (correlated PRIT) + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated.svg new file mode 100644 index 00000000..f79c8d22 --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-correlated.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.000 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +PIT +ECDF +ppc_pit_ecdf (correlated) + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-default.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-default.svg index 8de07070..8a46a332 100644 --- a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-default.svg +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-default.svg @@ -25,9 +25,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-diff-correlated-piet.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-diff-correlated-piet.svg new file mode 100644 index 00000000..afae3f76 --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-diff-correlated-piet.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +I +E +T += +0.19 + +( +α += +0.01 +) + + + +-0.10 +-0.05 +0.00 +0.05 +0.10 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +PIT +ECDF difference +ppc_pit_ecdf (diff, correlated piet) + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-diff-correlated-pot.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-diff-correlated-pot.svg new file mode 100644 index 00000000..b3435bb7 --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-diff-correlated-pot.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.000 + +( +α += +0.01 +) + + + +-0.10 +-0.05 +0.00 +0.05 +0.10 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +PIT +ECDF difference +ppc_pit_ecdf (diff, correlated pot) + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-diff-correlated-prit.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-diff-correlated-prit.svg new file mode 100644 index 00000000..c4501aa2 --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-diff-correlated-prit.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +R +I +T += +0.001 + +( +α += +0.01 +) + + + +-0.10 +-0.05 +0.00 +0.05 +0.10 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +PIT +ECDF difference +ppc_pit_ecdf (diff, correlated prit) + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-diff.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-diff.svg index 94693daf..36e743b5 100644 --- a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-diff.svg +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-diff.svg @@ -25,9 +25,9 @@ - - - + + + @@ -51,7 +51,7 @@ 0.75 1.00 PIT -ECDF - difference +ECDF difference ppc_pit_ecdf (diff) diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-grouped-correlated-diff.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-grouped-correlated-diff.svg new file mode 100644 index 00000000..ccdcfdf6 --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-grouped-correlated-diff.svg @@ -0,0 +1,228 @@ + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.004 + +( +α += +0.01 +) + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.002 + +( +α += +0.01 +) + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.34 + +( +α += +0.01 +) + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.34 + +( +α += +0.01 +) + + + + + + + + + + + +C + + + + + + + + + +D + + + + + + + + + +A + + + + + + + + + +B + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 + +-0.2 +-0.1 +0.0 +0.1 +0.2 + + + + + + +-0.2 +-0.1 +0.0 +0.1 +0.2 + + + + + +PIT +ECDF difference +ppc_pit_ecdf_grouped (correlated diff) + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-grouped-correlated.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-grouped-correlated.svg new file mode 100644 index 00000000..6f225944 --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-grouped-correlated.svg @@ -0,0 +1,228 @@ + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.004 + +( +α += +0.01 +) + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.002 + +( +α += +0.01 +) + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.34 + +( +α += +0.01 +) + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.34 + +( +α += +0.01 +) + + + + + + + + + + + +C + + + + + + + + + +D + + + + + + + + + +A + + + + + + + + + +B + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + +PIT +ECDF +ppc_pit_ecdf_grouped (correlated) + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-linewidth-1.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-linewidth-1.svg new file mode 100644 index 00000000..f3085191 --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-linewidth-1.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.000 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +PIT +ECDF +ppc_pit_ecdf (linewidth = 1) + + diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-linewidth-2.svg b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-linewidth-2.svg new file mode 100644 index 00000000..1302fe58 --- /dev/null +++ b/tests/testthat/_snaps/ppc-distributions/ppc-pit-ecdf-linewidth-2.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.000 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +PIT +ECDF +ppc_pit_ecdf (linewidth = 2) + + diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-alpha-0-05.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-alpha-0-05.svg new file mode 100644 index 00000000..3cc6c94f --- /dev/null +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-alpha-0-05.svg @@ -0,0 +1,74 @@ + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.37 + +( +α += +0.05 +) + + + +-0.10 +-0.05 +0.00 +0.05 +0.10 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +LOO-PIT +ECDF difference +ppc_loo_pit_ecdf (alpha=0.05) + + diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-changed-theme.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-changed-theme.svg new file mode 100644 index 00000000..f33e821a --- /dev/null +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-changed-theme.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.37 + +( +α += +0.01 +) + + + +-0.1 +0.0 +0.1 + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +LOO-PIT +ECDF difference +ppc_loo_pit_ecdf (changed theme) + + diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-color-change.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-color-change.svg new file mode 100644 index 00000000..41d02e96 --- /dev/null +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-color-change.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.000 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +LOO-PIT +ECDF +ppc_loo_pit_ecdf (color change) + + diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-correlated-piet.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-correlated-piet.svg new file mode 100644 index 00000000..8cde51ac --- /dev/null +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-correlated-piet.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +I +E +T += +0.19 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +LOO-PIT +ECDF +ppc_loo_pit_ecdf (correlated piet) + + diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-correlated-pot.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-correlated-pot.svg new file mode 100644 index 00000000..8d8b25fd --- /dev/null +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-correlated-pot.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.000 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +LOO-PIT +ECDF +ppc_loo_pit_ecdf (correlated pot) + + diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-correlated-prit.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-correlated-prit.svg new file mode 100644 index 00000000..f83ff30d --- /dev/null +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-correlated-prit.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +R +I +T += +0.001 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +LOO-PIT +ECDF +ppc_loo_pit_ecdf (correlated prit) + + diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-default.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-default.svg index 9bdd3960..83330ce3 100644 --- a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-default.svg +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-default.svg @@ -25,9 +25,9 @@ - - - + + + @@ -52,7 +52,7 @@ 0.50 0.75 1.00 -LOO PIT +LOO-PIT ECDF ppc_loo_pit_ecdf (default) diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-diff-correlated-piet.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-diff-correlated-piet.svg new file mode 100644 index 00000000..41904632 --- /dev/null +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-diff-correlated-piet.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +I +E +T += +0.19 + +( +α += +0.01 +) + + + +-0.10 +-0.05 +0.00 +0.05 +0.10 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +LOO-PIT +ECDF difference +ppc_loo_pit_ecdf (diff, correlated piet) + + diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-diff-correlated-pot.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-diff-correlated-pot.svg new file mode 100644 index 00000000..a1bd045f --- /dev/null +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-diff-correlated-pot.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.000 + +( +α += +0.01 +) + + + +-0.10 +-0.05 +0.00 +0.05 +0.10 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +LOO-PIT +ECDF difference +ppc_loo_pit_ecdf (diff, correlated pot) + + diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-diff-correlated-prit.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-diff-correlated-prit.svg new file mode 100644 index 00000000..350a356e --- /dev/null +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-diff-correlated-prit.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +R +I +T += +0.001 + +( +α += +0.01 +) + + + +-0.10 +-0.05 +0.00 +0.05 +0.10 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +LOO-PIT +ECDF difference +ppc_loo_pit_ecdf (diff, correlated prit) + + diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-ecdf-difference.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-ecdf-difference.svg index 5441468f..9e353cba 100644 --- a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-ecdf-difference.svg +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-ecdf-difference.svg @@ -25,9 +25,9 @@ - - - + + + @@ -48,7 +48,7 @@ 0.50 0.75 1.00 -LOO PIT +LOO-PIT ECDF difference ppc_loo_pit_ecdf (ecdf difference) diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-k.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-k.svg index 48f3cb24..25ab6c43 100644 --- a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-k.svg +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-k.svg @@ -25,9 +25,9 @@ - - - + + + @@ -52,7 +52,7 @@ 0.50 0.75 1.00 -LOO PIT +LOO-PIT ECDF ppc_loo_pit_ecdf (K) diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-linewidth-1.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-linewidth-1.svg new file mode 100644 index 00000000..70b0d229 --- /dev/null +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-linewidth-1.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.000 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +LOO-PIT +ECDF +ppc_loo_pit_ecdf (linewidth = 1) + + diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-linewidth-2.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-linewidth-2.svg new file mode 100644 index 00000000..0f339023 --- /dev/null +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-linewidth-2.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +p +u +n +i +f +P +O +T += +0.000 + +( +α += +0.01 +) + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +LOO-PIT +ECDF +ppc_loo_pit_ecdf (linewidth = 2) + + diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-no-help-text.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-no-help-text.svg new file mode 100644 index 00000000..310a4987 --- /dev/null +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-no-help-text.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + +-0.10 +-0.05 +0.00 +0.05 +0.10 + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +LOO-PIT +ECDF difference +ppc_loo_pit_ecdf (no help_text) + + diff --git a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-prob.svg b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-prob.svg index dadcb9e6..97b89103 100644 --- a/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-prob.svg +++ b/tests/testthat/_snaps/ppc-loo/ppc-loo-pit-ecdf-prob.svg @@ -25,9 +25,9 @@ - - - + + + @@ -52,7 +52,7 @@ 0.50 0.75 1.00 -LOO PIT +LOO-PIT ECDF ppc_loo_pit_ecdf (prob) diff --git a/tests/testthat/test-helpers-ppc.R b/tests/testthat/test-helpers-ppc.R index 506b666a..4d259207 100644 --- a/tests/testthat/test-helpers-ppc.R +++ b/tests/testthat/test-helpers-ppc.R @@ -203,3 +203,11 @@ test_that("ecdf_intervals returns right dimensions and values", { expect_equal(min(lims$lower), 0) expect_equal(max(lims$lower), 100) }) + +# display p-values in plots ------------------------------------------------ +test_that("formatting of p-values works as expected", { + expect_equal(fmt_p(0.446), "0.45") + expect_equal(fmt_p(0.045), "0.045") + expect_equal(fmt_p(0.0045), "0.005") + expect_equal(fmt_p(0.00045), "0.000") +}) \ No newline at end of file diff --git a/tests/testthat/test-ppc-distributions.R b/tests/testthat/test-ppc-distributions.R index c8e3faa5..29c5fb74 100644 --- a/tests/testthat/test-ppc-distributions.R +++ b/tests/testthat/test-ppc-distributions.R @@ -120,13 +120,112 @@ test_that("ppc_dots returns a ggplot object", { }) test_that("ppc_pit_ecdf, ppc_pit_ecdf_grouped returns a ggplot object", { + # Independent method (default) expect_gg(ppc_pit_ecdf(y, yrep, interpolate_adj = FALSE)) + expect_gg(ppc_pit_ecdf(y, yrep, method = "independent", interpolate_adj = FALSE)) expect_gg(ppc_pit_ecdf_grouped(y, yrep, group = group, interpolate_adj = FALSE)) - expect_message(ppc_pit_ecdf(pit = runif(100)), "'pit' specified") + + # Correlated method + expect_gg(ppc_pit_ecdf(y, yrep, method = "correlated")) + expect_gg(ppc_pit_ecdf(y, yrep, method = "correlated", plot_diff = TRUE)) + expect_gg(ppc_pit_ecdf(y, yrep, method = "correlated", test = "PRIT")) + expect_gg(ppc_pit_ecdf(y, yrep, method = "correlated", test = "PIET")) + expect_gg(ppc_pit_ecdf_grouped(y, yrep, group = group, method = "correlated")) + expect_gg(ppc_pit_ecdf_grouped(y, yrep, group = group, method = "correlated", plot_diff = TRUE)) + expect_gg(ppc_pit_ecdf_grouped(y, yrep, group = group, method = "correlated", test = "PRIT")) + expect_gg(ppc_pit_ecdf_grouped(y, yrep, group = group, method = "correlated", test = "PIET")) + + # Specify 'pit' directly (with y/yrep still supplied) expect_message( - ppc_pit_ecdf_grouped(pit = runif(length(group)), group = group, interpolate_adj = FALSE), + ppc_pit_ecdf_grouped( + y = y, yrep = yrep, pit = runif(length(group)), + group = group, interpolate_adj = FALSE + ), "'pit' specified" ) + + # No y/yrep provided with pit -> no ignored-input message but "independent" method message + expect_message( + ppc_pit_ecdf_grouped(pit = runif(length(group)), group = group, + method = "independent", interpolate_adj = FALSE), + "The 'independent' method is superseded by the 'correlated' method." + ) +}) + +test_that("ppc_pit_ecdf method validation and ignored-argument warnings", { + # Invalid method + expect_error(ppc_pit_ecdf(y, yrep, method = "bogus")) + + # method = "correlated" warns about interpolate_adj + expect_message( + ppc_pit_ecdf(y, yrep, method = "correlated", interpolate_adj = TRUE), + "ignoring.*interpolate_adj" + ) + + # method = "independent" warns about test and gamma + expect_message( + ppc_pit_ecdf(y, yrep, method = "independent", test = "POT", + interpolate_adj = FALSE), + "ignoring.*test" + ) + expect_message( + ppc_pit_ecdf(y, yrep, method = "independent", test = "POT", gamma = 0.5, + interpolate_adj = FALSE), + "ignoring.*test, gamma" + ) + + # Invalid test type for correlated + expect_error( + ppc_pit_ecdf(y, yrep, method = "correlated", test = "INVALID") + ) +}) + +test_that("ppc_pit_ecdf correlated method validates gamma", { + expect_error( + ppc_pit_ecdf(y, yrep, method = "correlated", gamma = -1), + regexp = "gamma must be in" + ) +}) + +test_that("ppc_pit_ecdf_grouped method validation and ignored-argument warnings", { + # Invalid method + expect_error(ppc_pit_ecdf_grouped(y, yrep, group = group, method = "bogus")) + + # method = "correlated" warns about interpolate_adj + expect_message( + ppc_pit_ecdf_grouped( + y, yrep, group = group, method = "correlated", interpolate_adj = TRUE + ), + "ignoring.*interpolate_adj" + ) + + # method = "independent" warns about correlated-only args + expect_message( + ppc_pit_ecdf_grouped( + y, yrep, group = group, method = "independent", + test = "POT", interpolate_adj = FALSE + ), + "ignoring.*test" + ) + expect_message( + ppc_pit_ecdf_grouped( + y, yrep, group = group, method = "independent", + test = "POT", gamma = 0.5, interpolate_adj = FALSE + ), + "ignoring.*test, gamma" + ) + + # Invalid test type for correlated + expect_error( + ppc_pit_ecdf_grouped(y, yrep, group = group, method = "correlated", test = "INVALID") + ) +}) + +test_that("ppc_pit_ecdf_grouped correlated method validates gamma", { + expect_error( + ppc_pit_ecdf_grouped(y, yrep, group = group, method = "correlated", gamma = -1), + regexp = "gamma must be in" + ) }) test_that("ppc_freqpoly_grouped returns a ggplot object", { @@ -534,6 +633,7 @@ test_that("ppc_pit_ecdf, ppc_pit_ecdf_grouped renders correctly", { testthat::skip_if_not_installed("vdiffr") skip_on_r_oldrel() + # Independent method p_base <- ppc_pit_ecdf(y, yrep, interpolate_adj = FALSE) g_base <- ppc_pit_ecdf_grouped(y, yrep, group = group, interpolate_adj = FALSE) p_diff <- ppc_pit_ecdf(y, yrep, plot_diff = TRUE, interpolate_adj = FALSE) @@ -543,4 +643,302 @@ test_that("ppc_pit_ecdf, ppc_pit_ecdf_grouped renders correctly", { vdiffr::expect_doppelganger("ppc_pit_ecdf_grouped (default)", g_base) vdiffr::expect_doppelganger("ppc_pit_ecdf (diff)", p_diff) vdiffr::expect_doppelganger("ppc_pit_ecdf_grouped (diff)", g_diff) + + # Correlated method + p_corr <- ppc_pit_ecdf(y, yrep, method = "correlated") + vdiffr::expect_doppelganger("ppc_pit_ecdf (correlated)", p_corr) + + p_corr_diff <- ppc_pit_ecdf(y, yrep, method = "correlated", plot_diff = TRUE) + vdiffr::expect_doppelganger("ppc_pit_ecdf (correlated diff)", p_corr_diff) + + p_corr_prit <- ppc_pit_ecdf(y, yrep, method = "correlated", test = "PRIT") + vdiffr::expect_doppelganger("ppc_pit_ecdf (correlated PRIT)", p_corr_prit) + + p_corr_piet <- ppc_pit_ecdf(y, yrep, method = "correlated", test = "PIET") + vdiffr::expect_doppelganger("ppc_pit_ecdf (correlated PIET)", p_corr_piet) + + g_corr <- ppc_pit_ecdf_grouped(y, yrep, group = group, method = "correlated") + vdiffr::expect_doppelganger("ppc_pit_ecdf_grouped (correlated)", g_corr) + + g_corr_diff <- ppc_pit_ecdf_grouped( + y, yrep, group = group, method = "correlated", plot_diff = TRUE + ) + vdiffr::expect_doppelganger("ppc_pit_ecdf_grouped (correlated diff)", g_corr_diff) +}) + +test_that("ppc_pit_ecdf with method correlated renders different tests correctly", { + set.seed(2025) + pit <- 1 - (1 - runif(300))^(1.2) + + p_cor_pot <- ppc_pit_ecdf( + pit = pit, + method = "correlated" + ) + vdiffr::expect_doppelganger("ppc_pit_ecdf (correlated pot)", p_cor_pot) + + p_cor_prit <- ppc_pit_ecdf( + pit = pit, + method = "correlated", + test = "PRIT" + ) + vdiffr::expect_doppelganger("ppc_pit_ecdf (correlated prit 2)", p_cor_prit) + + p_cor_piet <- ppc_pit_ecdf( + pit = pit, + method = "correlated", + test = "PIET" + ) + vdiffr::expect_doppelganger("ppc_pit_ecdf (correlated piet 2)", p_cor_piet) +}) + +test_that("ppc_pit_ecdf with plot_diff=TRUE and method correlated renders different tests correctly", { + set.seed(2025) + pit <- 1 - (1 - runif(300))^(1.2) + + p_cor_pot <- ppc_pit_ecdf( + pit = pit, + method = "correlated", + plot_diff = TRUE + ) + vdiffr::expect_doppelganger("ppc_pit_ecdf (diff, correlated pot)", p_cor_pot) + + p_cor_prit <- ppc_pit_ecdf( + pit = pit, + method = "correlated", + test = "PRIT", + plot_diff = TRUE + ) + vdiffr::expect_doppelganger("ppc_pit_ecdf (diff, correlated prit)", p_cor_prit) + + p_cor_piet <- ppc_pit_ecdf( + pit = pit, + method = "correlated", + test = "PIET", + plot_diff = TRUE + ) + vdiffr::expect_doppelganger("ppc_pit_ecdf (diff, correlated piet)", p_cor_piet) }) + +test_that("ppc_pit_ecdf renders different linewidths and colors correctly", { + set.seed(2025) + pit <- 1 - (1 - runif(300))^(1.2) + + p_cor_lw1 <- ppc_pit_ecdf( + pit = pit, + method = "correlated", + linewidth = 1. + ) + vdiffr::expect_doppelganger("ppc_pit_ecdf (linewidth = 1)", p_cor_lw1) + + p_cor_lw2 <- ppc_pit_ecdf( + pit = pit, + method = "correlated", + linewidth = 2. + ) + vdiffr::expect_doppelganger("ppc_pit_ecdf (linewidth = 2)", p_cor_lw2) + + p_cor_col <- ppc_pit_ecdf( + pit = pit, + method = "correlated", + color = c(ecdf = "darkblue", highlight = "red") + ) + vdiffr::expect_doppelganger("ppc_pit_ecdf (color change)", p_cor_col) +}) + + +# Test PIT computation branches ------------------------------------------------ +# use monkey-patching to test whether the correct branch of the +# PIT computation is taken + +testthat::test_that("ppc_pit_ecdf takes correct PIT computation branch", { + skip_on_cran() + skip_if_not_installed("loo") + skip_on_r_oldrel() + skip_if(packageVersion("rstantools") <= "2.4.0") + + compute_pit_values_patched <- .compute_pit_values + + body(compute_pit_values_patched)[[ + # Replace the PIT computation block with diagnostics. + which(sapply(as.list(body(.compute_pit_values)), function(e) { + if (!is.call(e)) return(FALSE) + identical(e[[1]], as.name("if")) && + grepl("pareto_pit", paste(deparse(e[[2]]), collapse = " ")) + }))[1] + ]] <- quote({ + if (isTRUE(pareto_pit) && is.null(pit)) { + message("[PIT BRANCH] Pareto-smoothed LOO PIT") + suggested_package("rstantools") + y <- validate_y(y) + yrep <- validate_predictions(yrep, length(y)) + pit <- posterior::pareto_pit(x = yrep, y = y, weights = NULL, log = TRUE) + K <- K %||% length(pit) + } else if (!is.null(pit)) { + message("[PIT BRANCH] Pre-supplied PIT") + pit <- validate_pit(pit) + K <- K %||% length(pit) + + ignored <- c( + if (!missing(y) && !is.null(y)) "y", + if (!missing(yrep) && !is.null(yrep)) "yrep" + ) + if (length(ignored) > 0) { + inform(paste0("As 'pit' specified; ignoring: ", + paste(ignored, collapse = ", "), ".")) + } + } else { + message("[PIT BRANCH] Empirical PIT") + y <- validate_y(y) + yrep <- validate_predictions(yrep, length(y)) + pit <- ppc_data(y, yrep) |> + group_by(.data$y_id) |> + dplyr::group_map( + ~ mean(.x$value[.x$is_y] > .x$value[!.x$is_y]) + + runif(1, max = mean(.x$value[.x$is_y] == .x$value[!.x$is_y])) + ) |> + unlist() + K <- K %||% min(nrow(yrep) + 1, 1000) + } + list("group" = group, "pit" = pit, "K" = K) + }) + + pit_branch_probe <- function(y = NULL, + yrep = NULL, + pit = NULL, + method = NULL, + test = NULL, + pareto_pit = NULL) { + method_args <- .pit_ecdf_resolve_method_args( + method = method, + pit = pit, + prob = 0.99, + interpolate_adj = NULL, + test = test, + gamma = NULL, + linewidth = NULL, + color = NULL, + help_text = NULL, + pareto_pit = pareto_pit, + help_text_shrinkage = NULL + ) + compute_pit_values_patched( + y = y, + yrep = yrep, + group = NULL, + K = NULL, + pareto_pit = method_args$pareto_pit, + pit = pit, + loo_cv = FALSE + ) + } + + # | yrep | y | pit | method | test | pareto_pit | approach | + # |------|---|-----|-------------|------|------------|--------------------| + # | x | x | | independent | NULL | FALSE | empirical pit | + # | | | x | independent | NULL | FALSE | | + # | x | x | | independent | NULL | TRUE | compute pareto-pit | + # | x | x | | correlated | POT | TRUE | compute pareto-pit | + # | | | x | correlated | POT | FALSE | | + # | x | x | | correlated | PIET | TRUE | compute pareto-pit | + # | | | x | correlated | PIET | FALSE | | + # | x | x | | correlated | PRIT | FALSE | empirical pit | + # | | | x | correlated | PRIT | FALSE | | + + pits <- rstantools::loo_pit(vdiff_loo_yrep, vdiff_loo_y, vdiff_loo_lw) + + # method = independent ------------------------------------------ + expect_message( + pit_branch_probe( + y = vdiff_loo_y, + yrep = vdiff_loo_yrep, + method = "independent" + ), + regexp = "\\[PIT BRANCH\\] Empirical PIT" + ) + + expect_message( + pit_branch_probe( + y = vdiff_loo_y, + yrep = vdiff_loo_yrep, + method = "independent", + pareto_pit = TRUE + ), + regexp = "\\[PIT BRANCH\\] Pareto-smoothed LOO PIT" + ) + + expect_message( + pit_branch_probe( + method = "independent", + pit = pits, + ), + regexp = "\\[PIT BRANCH\\] Pre-supplied PIT" + ) + + # method = correlated + POT test ------------------------------- + expect_message( + pit_branch_probe( + y = vdiff_loo_y, + yrep = vdiff_loo_yrep, + method = "correlated" + ), + regexp = "\\[PIT BRANCH\\] Pareto-smoothed LOO PIT" + ) + + expect_message( + pit_branch_probe( + y = vdiff_loo_y, + yrep = vdiff_loo_yrep, + method = "correlated", + pareto_pit = FALSE + ), + regexp = "\\[PIT BRANCH\\] Empirical PIT" + ) + + expect_message( + pit_branch_probe( + method = "correlated", + pit = pits, + ), + regexp = "\\[PIT BRANCH\\] Pre-supplied PIT" + ) + + # method = correlated + PIET test ------------------------------- + expect_message( + pit_branch_probe( + y = vdiff_loo_y, + yrep = vdiff_loo_yrep, + method = "correlated", + test = "PIET" + ), + regexp = "\\[PIT BRANCH\\] Pareto-smoothed LOO PIT" + ) + + expect_message( + pit_branch_probe( + method = "correlated", + test = "PIET", + pit = pits, + ), + regexp = "\\[PIT BRANCH\\] Pre-supplied PIT" + ) + + # method = correlated + PRIT test ------------------------------- + expect_message( + pit_branch_probe( + y = vdiff_loo_y, + yrep = vdiff_loo_yrep, + method = "correlated", + test = "PRIT" + ), + regexp = "\\[PIT BRANCH\\] Empirical PIT" + ) + + expect_message( + pit_branch_probe( + method = "correlated", + test = "PRIT", + pit = pits, + ), + regexp = "\\[PIT BRANCH\\] Pre-supplied PIT" + ) +}) \ No newline at end of file diff --git a/tests/testthat/test-ppc-loo.R b/tests/testthat/test-ppc-loo.R index 1cef194c..965e2914 100644 --- a/tests/testthat/test-ppc-loo.R +++ b/tests/testthat/test-ppc-loo.R @@ -137,7 +137,7 @@ test_that("ppc_loo_pit_ecdf returns a ggplot object", { } else { ll1 <- p1$labels } - expect_equal(ll1$x, "LOO PIT") + expect_equal(ll1$x, "LOO-PIT") expect_equal(ll1$y, "ECDF") expect_equal(p1$data, p2$data) expect_gg(p3 <- ppc_loo_pit_ecdf(y, yrep, lw, plot_diff = TRUE)) @@ -149,6 +149,118 @@ test_that("ppc_loo_pit_ecdf returns a ggplot object", { expect_equal(ll3$y, "ECDF difference") }) +test_that("ppc_loo_pit_ecdf with method='correlated' validates input correctly", { + set.seed(2025) + pit <- 1 - (1 - runif(300))^(1.2) + y_mock <- 1:length(pit) + + expect_message( + ppc_loo_pit_ecdf(pit = pit, method = "correlated", interpolate_adj = FALSE), + "As method = 'correlated' specified; ignoring: interpolate_adj." + ) + expect_message( + ppc_loo_pit_ecdf(pit = pit, method = "independent", y = y_mock), + "As 'pit' specified; ignoring: y." + ) + expect_message( + ppc_loo_pit_ecdf(pit = pit, method = "independent", gamma = 1.0), + "As method = 'independent' specified; ignoring: gamma." + ) + expect_message( + ppc_loo_pit_ecdf(pit = pit, method = "independent", test = "POT"), + "As method = 'independent' specified; ignoring: test." + ) +}) + +test_that("ppc_loo_pit_ecdf with method='correlated' returns ggplot object", { + skip_if_not_installed("rstanarm") + skip_if_not_installed("loo") + + # Test with POT-C (default) + expect_gg(p1 <- ppc_loo_pit_ecdf(y, yrep, lw, method = "correlated")) + + # Test with PRIT-C + expect_gg(p2 <- ppc_loo_pit_ecdf(y, yrep, lw, method = "correlated", + test = "PRIT")) + + # Test with PIET-C + expect_gg(p3 <- ppc_loo_pit_ecdf(y, yrep, lw, method = "correlated", + test = "PIET")) + + # Test with plot_diff = TRUE + expect_gg(p4 <- ppc_loo_pit_ecdf(y, yrep, lw, method = "correlated", + plot_diff = TRUE)) + + # Test with gamma specified + expect_gg(p5 <- ppc_loo_pit_ecdf(y, yrep, lw, method = "correlated", + gamma = 0.1)) +}) + +test_that("error if 0,1 in PIT values and test POT or PIET", { + expect_error( + ppc_loo_pit_ecdf(pit = c(0, runif(3)), method = "correlated", + test = "POT") + ) + expect_error( + ppc_loo_pit_ecdf(pit = c(0, runif(3)), method = "correlated", + test = "PIET") + ) + expect_no_error( + ppc_loo_pit_ecdf(pit = c(0, runif(3)), method = "correlated", + test = "PRIT") + ) +}) + +test_that("ppc_loo_pit_ecdf method argument works correctly", { + skip_if_not_installed("rstanarm") + skip_if_not_installed("loo") + + # Test default (should inform about upcoming change) + expect_message( + p1 <- ppc_loo_pit_ecdf(y, yrep, lw), + "In the next major release" + ) + expect_gg(p1) + + # Test explicit independent method (should inform about supersession) + expect_message( + p2 <- ppc_loo_pit_ecdf(y, yrep, lw, method = "independent"), + "superseded by the 'correlated' method" + ) + expect_gg(p2) + + # Test correlated method (no message expected) + expect_gg(p3 <- ppc_loo_pit_ecdf(y, yrep, lw, method = "correlated")) + + # Test that independent and correlated produce different plots + expect_true(!identical(p2$data, p3$data) || !identical(p2$layers, p3$layers)) +}) + +test_that("ppc_loo_pit_ecdf correlated method handles edge cases", { + skip_if_not_installed("rstanarm") + skip_if_not_installed("loo") + + set.seed(2026) + + # Test with small sample + small_pit <- runif(10) + expect_gg(p1 <- ppc_loo_pit_ecdf(pit = small_pit, method = "correlated")) + + # Test with perfect uniform + uniform_pit <- seq(0.0001, 0.9999, length.out = 100) + expect_gg(p2 <- ppc_loo_pit_ecdf(pit = uniform_pit, method = "correlated")) + + # Test with extreme values + extreme_pit <- c(rep(0.0001, 10), rep(0.99999, 10), runif(80)) + expect_gg(p3 <- ppc_loo_pit_ecdf(pit = extreme_pit, method = "correlated")) + + # Test with single value (edge case) + single_pit <- 0.5 + expect_error(ppc_loo_pit_ecdf(pit = single_pit, method = "correlated")) + expect_gg(p5 <- ppc_loo_pit_ecdf(pit = single_pit, method = "correlated", + test = "PIET")) +}) + test_that("ppc_loo_pit functions work when pit specified instead of y, yrep, and lw", { skip_if_not_installed("rstanarm") skip_if_not_installed("loo") @@ -167,7 +279,7 @@ test_that("ppc_loo_pit functions work when pit specified instead of y, yrep, and expect_gg(ppc_loo_pit_ecdf(pit = rep(pits, 4))) expect_message( p1 <- ppc_loo_pit_ecdf(y = y, yrep = yrep, lw = lw, pit = rep(pits, 4)), - "'pit' specified so ignoring 'y','yrep','lw' if specified" + "As 'pit' specified; ignoring: y, yrep, lw." ) expect_message( p2 <- ppc_loo_pit_ecdf(pit = rep(pits, 4)) @@ -182,7 +294,6 @@ test_that("ppc_loo_pit functions work when pit specified instead of y, yrep, and ) }) - test_that("ppc_loo_intervals returns ggplot object", { skip_if_not_installed("rstanarm") skip_if_not_installed("loo") @@ -345,6 +456,85 @@ test_that("ppc_loo_ribbon renders correctly", { vdiffr::expect_doppelganger("ppc_loo_ribbon (subset)", p_custom) }) +test_that("ppc_loo_pit_ecdf with method correlated renders different tests correctly", { + set.seed(2025) + pit <- 1 - (1 - runif(300))^(1.2) + + p_cor_pot <- ppc_loo_pit_ecdf( + pit = pit, + method = "correlated" + ) + vdiffr::expect_doppelganger("ppc_loo_pit_ecdf (correlated pot)", p_cor_pot) + + p_cor_prit <- ppc_loo_pit_ecdf( + pit = pit, + method = "correlated", + test = "PRIT" + ) + vdiffr::expect_doppelganger("ppc_loo_pit_ecdf (correlated prit)", p_cor_prit) + + p_cor_piet <- ppc_loo_pit_ecdf( + pit = pit, + method = "correlated", + test = "PIET" + ) + vdiffr::expect_doppelganger("ppc_loo_pit_ecdf (correlated piet)", p_cor_piet) +}) + +test_that("ppc_loo_pit_ecdf with plot_diff=TRUE and method correlated renders different tests correctly", { + set.seed(2025) + pit <- 1 - (1 - runif(300))^(1.2) + + p_cor_pot <- ppc_loo_pit_ecdf( + pit = pit, + method = "correlated", + plot_diff = TRUE + ) + vdiffr::expect_doppelganger("ppc_loo_pit_ecdf (diff, correlated pot)", p_cor_pot) + + p_cor_prit <- ppc_loo_pit_ecdf( + pit = pit, + method = "correlated", + test = "PRIT", + plot_diff = TRUE + ) + vdiffr::expect_doppelganger("ppc_loo_pit_ecdf (diff, correlated prit)", p_cor_prit) + + p_cor_piet <- ppc_loo_pit_ecdf( + pit = pit, + method = "correlated", + test = "PIET", + plot_diff = TRUE + ) + vdiffr::expect_doppelganger("ppc_loo_pit_ecdf (diff, correlated piet)", p_cor_piet) +}) + +test_that("ppc_loo_pit_ecdf renders different linewidths and colors correctly", { + set.seed(2025) + pit <- 1 - (1 - runif(300))^(1.2) + + p_cor_lw1 <- ppc_loo_pit_ecdf( + pit = pit, + method = "correlated", + linewidth = 1. + ) + vdiffr::expect_doppelganger("ppc_loo_pit_ecdf (linewidth = 1)", p_cor_lw1) + + p_cor_lw2 <- ppc_loo_pit_ecdf( + pit = pit, + method = "correlated", + linewidth = 2. + ) + vdiffr::expect_doppelganger("ppc_loo_pit_ecdf (linewidth = 2)", p_cor_lw2) + + p_cor_col <- ppc_loo_pit_ecdf( + pit = pit, + method = "correlated", + color = c(ecdf = "darkblue", highlight = "red") + ) + vdiffr::expect_doppelganger("ppc_loo_pit_ecdf (color change)", p_cor_col) +}) + test_that("ppc_loo_pit_ecdf renders correctly", { skip_on_cran() skip_if_not_installed("vdiffr") @@ -384,6 +574,243 @@ test_that("ppc_loo_pit_ecdf renders correctly", { K = 100 ) vdiffr::expect_doppelganger("ppc_loo_pit_ecdf (ecdf difference)", p_custom) + + p_custom <- ppc_loo_pit_ecdf( + vdiff_loo_y, + vdiff_loo_yrep, + psis_object = psis_object, + method = "correlated", + plot_diff = TRUE, + prob = 0.95 + ) + vdiffr::expect_doppelganger("ppc_loo_pit_ecdf (alpha=0.05)", p_custom) + + p_custom <- ppc_loo_pit_ecdf( + vdiff_loo_y, + vdiff_loo_yrep, + psis_object = psis_object, + method = "correlated", + plot_diff = TRUE, + prob = 0.95, + help_text = FALSE + ) + vdiffr::expect_doppelganger("ppc_loo_pit_ecdf (no help_text)", p_custom) + + + theme_set(bayesplot::theme_default(base_family = "sans", base_size = 12)) + p_custom <- ppc_loo_pit_ecdf( + vdiff_loo_y, + vdiff_loo_yrep, + psis_object = psis_object, + method = "correlated", + plot_diff = TRUE + ) + vdiffr::expect_doppelganger("ppc_loo_pit_ecdf (changed theme)", p_custom) +}) + +# Test PIT computation branches ------------------------------------------------ +# use monkey-patching to test whether the correct branch of the +# PIT computation is taken + +testthat::test_that("ppc_loo_pit_ecdf takes correct PIT computation branch", { + skip_on_cran() + skip_if_not_installed("loo") + skip_on_r_oldrel() + skip_if(packageVersion("rstantools") <= "2.4.0") + + compute_pit_values_patched <- .compute_pit_values + + body(compute_pit_values_patched)[[ + # Replace the PIT computation block with diagnostics. + which(sapply(as.list(body(.compute_pit_values)), function(e) { + if (!is.call(e)) return(FALSE) + identical(e[[1]], as.name("if")) && + grepl("pareto_pit", paste(deparse(e[[2]]), collapse = " ")) + }))[1] + ]] <- quote({ + if (isTRUE(pareto_pit) && is.null(pit)) { + message("[PIT BRANCH] Pareto-smoothed LOO PIT") + suggested_package("rstantools") + y <- validate_y(y) + yrep <- validate_predictions(yrep, length(y)) + stopifnot(isTRUE(loo_cv), identical(dim(yrep), dim(lw))) + pit <- posterior::pareto_pit(x = yrep, y = y, weights = lw, log = TRUE) + K <- K %||% length(pit) + } else if (!is.null(pit)) { + message("[PIT BRANCH] Pre-supplied PIT") + pit <- validate_pit(pit) + K <- K %||% length(pit) + + ignored <- c( + if (!missing(y) && !is.null(y)) "y", + if (!missing(yrep) && !is.null(yrep)) "yrep", + if (isTRUE(loo_cv) && !is.null(lw)) "lw" + ) + if (length(ignored) > 0) { + inform(paste0("As 'pit' specified; ignoring: ", + paste(ignored, collapse = ", "), ".")) + } + } else { + message("[PIT BRANCH] Standard LOO PIT") + suggested_package("rstantools") + y <- validate_y(y) + yrep <- validate_predictions(yrep, length(y)) + stopifnot(isTRUE(loo_cv), identical(dim(yrep), dim(lw))) + pit <- pmin(1, rstantools::loo_pit(object = yrep, y = y, lw = lw)) + K <- K %||% min(nrow(yrep) + 1, 1000) + } + list("group" = group, "pit" = pit, "K" = K) + }) + + pit_branch_probe <- function(y = NULL, + yrep = NULL, + lw = NULL, + pit = NULL, + method = NULL, + test = NULL, + pareto_pit = NULL) { + method_args <- .pit_ecdf_resolve_method_args( + method = method, + pit = pit, + prob = 0.99, + interpolate_adj = NULL, + test = test, + gamma = NULL, + linewidth = NULL, + color = NULL, + help_text = NULL, + pareto_pit = pareto_pit, + help_text_shrinkage = NULL + ) + compute_pit_values_patched( + y = y, + yrep = yrep, + lw = lw, + psis_object = psis_object, + group = NULL, + K = NULL, + pareto_pit = method_args$pareto_pit, + pit = pit, + loo_cv = TRUE + ) + } + + # | yrep | y | lw | pit | method | test | pareto_pit | approach | + # |------|---|----|-----|-------------|------|------------|--------------------| + # | x | x | x | | independent | NULL | FALSE (D) | compute loo-pit | + # | x | x | x | | independent | NULL | TRUE | compute pareto-pit | + # | | | | x | independent | NULL | FALSE | | + # | x | x | x | | correlated | POT | TRUE | compute pareto-pit | + # | x | x | x | | correlated | POT | FALSE | compute loo-pit | + # | | | | x | correlated | POT | FALSE | | + # | x | x | x | | correlated | PIET | TRUE | compute pareto-pit | + # | | | | x | correlated | PIET | FALSE | | + # | x | x | x | | correlated | PRIT | FALSE | compute loo-pit | + # | | | | x | correlated | PRIT | FALSE | | + + pits <- rstantools::loo_pit(vdiff_loo_yrep, vdiff_loo_y, vdiff_loo_lw) + + # method = independent ------------------------------------------ + expect_message( + pit_branch_probe( + y = vdiff_loo_y, + yrep = vdiff_loo_yrep, + method = "independent", + lw = vdiff_loo_lw + ), + regexp = "\\[PIT BRANCH\\] Standard LOO PIT" + ) + + expect_message( + pit_branch_probe( + y = vdiff_loo_y, + yrep = vdiff_loo_yrep, + method = "independent", + lw = vdiff_loo_lw, + pareto_pit = TRUE + ), + regexp = "\\[PIT BRANCH\\] Pareto-smoothed LOO PIT" + ) + + expect_message( + pit_branch_probe( + method = "independent", + pit = pits, + ), + regexp = "\\[PIT BRANCH\\] Pre-supplied PIT" + ) + + # method = correlated + POT test ------------------------------- + expect_message( + pit_branch_probe( + y = vdiff_loo_y, + yrep = vdiff_loo_yrep, + method = "correlated", + lw = vdiff_loo_lw + ), + regexp = "\\[PIT BRANCH\\] Pareto-smoothed LOO PIT" + ) + + expect_message( + pit_branch_probe( + y = vdiff_loo_y, + yrep = vdiff_loo_yrep, + method = "correlated", + lw = vdiff_loo_lw, + pareto_pit = FALSE + ), + regexp = "\\[PIT BRANCH\\] Standard LOO PIT" + ) + + expect_message( + pit_branch_probe( + method = "correlated", + pit = pits, + ), + regexp = "\\[PIT BRANCH\\] Pre-supplied PIT" + ) + + # method = correlated + PIET test ------------------------------- + expect_message( + pit_branch_probe( + y = vdiff_loo_y, + yrep = vdiff_loo_yrep, + method = "correlated", + test = "PIET", + lw = vdiff_loo_lw + ), + regexp = "\\[PIT BRANCH\\] Pareto-smoothed LOO PIT" + ) + + expect_message( + pit_branch_probe( + method = "correlated", + test = "PIET", + pit = pits, + ), + regexp = "\\[PIT BRANCH\\] Pre-supplied PIT" + ) + + # method = correlated + PRIT test ------------------------------- + expect_message( + pit_branch_probe( + y = vdiff_loo_y, + yrep = vdiff_loo_yrep, + method = "correlated", + test = "PRIT", + lw = vdiff_loo_lw + ), + regexp = "\\[PIT BRANCH\\] Standard LOO PIT" + ) + + expect_message( + pit_branch_probe( + method = "correlated", + test = "PRIT", + pit = pits, + ), + regexp = "\\[PIT BRANCH\\] Pre-supplied PIT" + ) }) @@ -439,3 +866,48 @@ test_that("ppc_loo_pit_data works with a single pit value", { expect_equal(nrow(y_rows), 1) expect_equal(y_rows$value, 0.5) }) + +test_that("check pareto_pit argument is chosen as expected", { + # pareto_pit defaults to TRUE if test = "POT", pareto_pit = NULL, pit = NULL + pareto_pit = NULL + pit = NULL + test = "POT" + expect_true(pareto_pit %||% (is.null(pit) && test %in% c("POT", "PIET"))) + + # pareto_pit defaults to TRUE if test = "PIET", pareto_pit = NULL, pit = NULL + pareto_pit = NULL + pit = NULL + test = "PIET" + expect_true(pareto_pit %||% (is.null(pit) && test %in% c("POT", "PIET"))) + + # pareto_pit defaults to FALSE if test = "PRIT", and + # pareto_pit = NULL, pit = NULL + pareto_pit = NULL + pit = NULL + test = "PRIT" + expect_false(pareto_pit %||% (is.null(pit) && test %in% c("POT", "PIET"))) + + # pareto_pit is TRUE if user sets pareto_pit = TRUE, and + # test = "PRIT", pit = NULL + pareto_pit = TRUE + pit = NULL + test = "PRIT" + expect_true(pareto_pit %||% (is.null(pit) && test %in% c("POT", "PIET"))) + + # pareto_pit is FALSE if pit != NULL irrespective of test + for (test in c("POT", "PIET", "PRIT")) { + pareto_pit = NULL + pit = c(0.1, 0.2, 0.7) + expect_false(pareto_pit %||% (is.null(pit) && test %in% c("POT", "PIET"))) + } + + # if pit != NULL and user sets pareto_pit = TRUE: reset pareto_pit = NULL + # internally and warn user about change of behavior. + pit <- runif(length(y)) + expect_error( + object = ppc_loo_pit_ecdf( + pit = pit, method = "correlated", test = "POT", pareto_pit = TRUE + ), + regexp = "`pareto_pit = TRUE` cannot be used together with a non-`NULL`" + ) +}) \ No newline at end of file