From 7b1f17164be9c5f506ff0594850da3c9100e7000 Mon Sep 17 00:00:00 2001 From: BehramUlukir Date: Wed, 30 Jul 2025 20:42:36 +0300 Subject: [PATCH 01/11] adding discrete option to ppc_rootogram --- R/ppc-discrete.R | 42 ++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 40 insertions(+), 2 deletions(-) diff --git a/R/ppc-discrete.R b/R/ppc-discrete.R index 199c394b..28193664 100644 --- a/R/ppc-discrete.R +++ b/R/ppc-discrete.R @@ -237,7 +237,7 @@ ppc_bars_grouped <- #' ppc_rootogram <- function(y, yrep, - style = c("standing", "hanging", "suspended"), + style = c("standing", "hanging", "suspended", "discrete"), ..., prob = 0.9, size = 1) { @@ -266,6 +266,44 @@ ppc_rootogram <- function(y, } tyrep <- do.call(rbind, tyrep) tyrep[is.na(tyrep)] <- 0 + + #Discrete style + pred_mean <- colMeans(tyrep) + pred_quantile <- t(apply(tyrep, 2, quantile, probs = probs)) + colnames(pred_quantile) <- c("lower", "upper") + + # prepare a table for y + ty <- table(y) + y_count <- as.numeric(ty[match(xpos, rownames(ty))]) + y_count[is.na(y_count)] <- 0 + + if (style == "discrete") { + obs_color <- ifelse(y_count >= pred_quantile[, "lower"] & y_count <= pred_quantile[, "upper"], "blue", "red") + + data <- data.frame( + xpos = xpos, + obs = y_count, + pred_mean = pred_mean, + lower = pred_quantile[, "lower"], + upper = pred_quantile[, "upper"], + obs_color = obs_color + ) + + graph <- ggplot(data, aes(x = xpos)) + + geom_point(aes(y = obs, fill = "Observed"), size = size * 3.5, color = obs_color, shape=18) + + geom_pointrange(aes(y = pred_mean, ymin = lower + (pred_mean - lower)*0.5, ymax = upper - (upper - pred_mean)*0.5, color = "Expected"), linewidth = size, size = size, fatten = 2, alpha = 0.6) + + geom_linerange(aes(y = pred_mean, ymin = lower, ymax = upper, color = "Expected"), linewidth = size, size = size, alpha = 0.4) + + scale_y_sqrt() + + scale_fill_manual("", values = get_color("l")) + + scale_color_manual("", values = get_color("dh")) + + labs(x = expression(italic(y)), y = "Count") + + bayesplot_theme_get() + + reduce_legend_spacing(0.25) + return(graph) + } + + + #Standing, hanging, and suspended styles tyexp <- sqrt(colMeans(tyrep)) tyquantile <- sqrt(t(apply(tyrep, 2, quantile, probs = probs))) colnames(tyquantile) <- c("tylower", "tyupper") @@ -395,7 +433,7 @@ ppc_bars_data <- data <- reshape2::melt(tmp_data, id.vars = "group") %>% count(.data$group, .data$value, .data$variable) %>% - tidyr::complete(.data$group, .data$value, .data$variable, fill = list(n = 0)) %>% + tidyr::complete(.data$group, .data$value, .data$variable, fill = list(n = 0)) %>% group_by(.data$variable, .data$group) %>% mutate(proportion = .data$n / sum(.data$n)) %>% ungroup() %>% From a0034adb287b046d653cd69b573eb966ae79d976 Mon Sep 17 00:00:00 2001 From: BehramUlukir Date: Thu, 31 Jul 2025 16:13:37 +0300 Subject: [PATCH 02/11] updated visuals for discrete rootogram --- R/ppc-discrete.R | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/R/ppc-discrete.R b/R/ppc-discrete.R index 28193664..973274e4 100644 --- a/R/ppc-discrete.R +++ b/R/ppc-discrete.R @@ -198,16 +198,16 @@ ppc_bars_grouped <- fatten = 2.5, linewidth = 1, freq = TRUE) { - check_ignored_arguments(...) - call <- match.call(expand.dots = FALSE) - g <- eval(ungroup_call("ppc_bars", call), parent.frame()) - if (fixed_y(facet_args)) { - g <- g + expand_limits(y = 1.05 * max(g$data[["h"]], na.rm = TRUE)) + check_ignored_arguments(...) + call <- match.call(expand.dots = FALSE) + g <- eval(ungroup_call("ppc_bars", call), parent.frame()) + if (fixed_y(facet_args)) { + g <- g + expand_limits(y = 1.05 * max(g$data[["h"]], na.rm = TRUE)) + } + g + + bars_group_facets(facet_args) + + force_axes_in_facets() } - g + - bars_group_facets(facet_args) + - force_axes_in_facets() -} #' @rdname PPC-discrete @@ -278,7 +278,7 @@ ppc_rootogram <- function(y, y_count[is.na(y_count)] <- 0 if (style == "discrete") { - obs_color <- ifelse(y_count >= pred_quantile[, "lower"] & y_count <= pred_quantile[, "upper"], "blue", "red") + obs_shape <- ifelse(y_count >= pred_quantile[, "lower"] & y_count <= pred_quantile[, "upper"], 24, 25) data <- data.frame( xpos = xpos, @@ -286,19 +286,20 @@ ppc_rootogram <- function(y, pred_mean = pred_mean, lower = pred_quantile[, "lower"], upper = pred_quantile[, "upper"], - obs_color = obs_color + obs_shape = obs_shape ) - + # Create the graph graph <- ggplot(data, aes(x = xpos)) + - geom_point(aes(y = obs, fill = "Observed"), size = size * 3.5, color = obs_color, shape=18) + - geom_pointrange(aes(y = pred_mean, ymin = lower + (pred_mean - lower)*0.5, ymax = upper - (upper - pred_mean)*0.5, color = "Expected"), linewidth = size, size = size, fatten = 2, alpha = 0.6) + - geom_linerange(aes(y = pred_mean, ymin = lower, ymax = upper, color = "Expected"), linewidth = size, size = size, alpha = 0.4) + + geom_pointrange(aes(y = pred_mean, ymin = lower, ymax = upper, color = "Expected"), fill = get_color("d"), linewidth = size, size = size, fatten = 2, alpha = 0.65) + + geom_point(aes(y = obs, shape=ifelse(obs_shape==24, "In", "Out")), size = size * 2, color = get_color("lh"), fill = get_color("lh")) + scale_y_sqrt() + - scale_fill_manual("", values = get_color("l")) + + scale_fill_manual("", values = get_color("lh"), guide="none") + scale_color_manual("", values = get_color("dh")) + labs(x = expression(italic(y)), y = "Count") + bayesplot_theme_get() + - reduce_legend_spacing(0.25) + reduce_legend_spacing(0.25) + + scale_shape_manual(values = c("Out"=24, "In"=25), guide = "legend") + + guides(shape = guide_legend(" Observation \n within bounds")) return(graph) } From 8abdf26fea6acbb243d75e595ea53f4a11549d38 Mon Sep 17 00:00:00 2001 From: BehramUlukir Date: Mon, 4 Aug 2025 19:56:38 +0300 Subject: [PATCH 03/11] updating discrete style, documentation, and adding tests --- R/ppc-discrete.R | 45 ++++++++--- man/PPC-discrete.Rd | 18 +++-- ...iscrete-prob-size-bound-distinct-false.svg | 79 ++++++++++++++++++ ...ppc-rootogram-style-discrete-prob-size.svg | 81 +++++++++++++++++++ tests/testthat/test-ppc-discrete.R | 26 ++++++ 5 files changed, 231 insertions(+), 18 deletions(-) create mode 100644 tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg create mode 100644 tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size.svg diff --git a/R/ppc-discrete.R b/R/ppc-discrete.R index 973274e4..5fe8170f 100644 --- a/R/ppc-discrete.R +++ b/R/ppc-discrete.R @@ -21,9 +21,12 @@ #' @param size,fatten,linewidth For bar plots, `size`, `fatten`, and `linewidth` #' are passed to [ggplot2::geom_pointrange()] to control the appearance of the #' `yrep` points and intervals. For rootograms `size` is passed to -#' [ggplot2::geom_line()]. +#' [ggplot2::geom_line()] and [ggplot2::geom_pointrange()]. #' @param freq For bar plots only, if `TRUE` (the default) the y-axis will #' display counts. Setting `freq=FALSE` will put proportions on the y-axis. +#' @param bound_distinct For `ppc_rootogram(style = "discrete)`, +#' if `TRUE` then the observed counts will be plotted with different shapes +#' depending on whether they are within the bounds of the expected quantiles. #' #' @template return-ggplot-or-data #' @@ -52,10 +55,12 @@ #' style can be adjusted to focus on different aspects of the data: #' * _Standing_: basic histogram of observed counts with curve #' showing expected counts. -#' * _Hanging_: observed counts counts hanging from the curve +#' * _Hanging_: observed counts hanging from the curve #' representing expected counts. #' * _Suspended_: histogram of the differences between expected and #' observed counts. +#' * _Discrete_: a dot-and-whisker plot of the expected counts and dots +#' representing observed counts #' #' **All of the rootograms are plotted on the square root scale**. See Kleiber #' and Zeileis (2016) for advice on interpreting rootograms and selecting @@ -213,7 +218,7 @@ ppc_bars_grouped <- #' @rdname PPC-discrete #' @export #' @param style For `ppc_rootogram`, a string specifying the rootogram -#' style. The options are `"standing"`, `"hanging"`, and +#' style. The options are `"discrete", "standing"`, `"hanging"`, and #' `"suspended"`. See the **Plot Descriptions** section, below, for #' details on the different styles. #' @@ -234,13 +239,15 @@ ppc_bars_grouped <- #' #' ppc_rootogram(y, yrep, style = "hanging", prob = 0.8) #' ppc_rootogram(y, yrep, style = "suspended") +#' ppc_rootogram(y, yrep, style = "discrete") #' ppc_rootogram <- function(y, yrep, style = c("standing", "hanging", "suspended", "discrete"), ..., prob = 0.9, - size = 1) { + size = 1, + bound_distinct = TRUE) { check_ignored_arguments(...) style <- match.arg(style) y <- validate_y(y) @@ -268,7 +275,7 @@ ppc_rootogram <- function(y, tyrep[is.na(tyrep)] <- 0 #Discrete style - pred_mean <- colMeans(tyrep) + pred_median <- apply(tyrep, 2, median) pred_quantile <- t(apply(tyrep, 2, quantile, probs = probs)) colnames(pred_quantile) <- c("lower", "upper") @@ -278,28 +285,40 @@ ppc_rootogram <- function(y, y_count[is.na(y_count)] <- 0 if (style == "discrete") { - obs_shape <- ifelse(y_count >= pred_quantile[, "lower"] & y_count <= pred_quantile[, "upper"], 24, 25) + if (bound_distinct) { + # If the observed count is within the bounds of the predicted quantiles, + # use a different shape for the point + obs_shape <- obs_shape <- ifelse(y_count >= pred_quantile[, "lower"] & y_count <= pred_quantile[, "upper"], "In", "Out") + } else { + obs_shape <- rep("Observed", length(y_count)) # all points are the same shape for obsved + } data <- data.frame( xpos = xpos, obs = y_count, - pred_mean = pred_mean, + pred_median = pred_median, lower = pred_quantile[, "lower"], upper = pred_quantile[, "upper"], obs_shape = obs_shape ) # Create the graph graph <- ggplot(data, aes(x = xpos)) + - geom_pointrange(aes(y = pred_mean, ymin = lower, ymax = upper, color = "Expected"), fill = get_color("d"), linewidth = size, size = size, fatten = 2, alpha = 0.65) + - geom_point(aes(y = obs, shape=ifelse(obs_shape==24, "In", "Out")), size = size * 2, color = get_color("lh"), fill = get_color("lh")) + + geom_pointrange(aes(y = pred_median, ymin = lower, ymax = upper, color = "Expected"), fill = get_color("lh"), linewidth = size, size = size, fatten = 2, alpha = 1) + + geom_point(aes(y = obs, shape = obs_shape), size = size * 1.5, color = get_color("d"), fill = get_color("d")) + scale_y_sqrt() + - scale_fill_manual("", values = get_color("lh"), guide="none") + - scale_color_manual("", values = get_color("dh")) + + scale_fill_manual("", values = get_color("d"), guide="none") + + scale_color_manual("", values = get_color("lh")) + labs(x = expression(italic(y)), y = "Count") + bayesplot_theme_get() + reduce_legend_spacing(0.25) + - scale_shape_manual(values = c("Out"=24, "In"=25), guide = "legend") + - guides(shape = guide_legend(" Observation \n within bounds")) + scale_shape_manual(values = c("In" = 22, "Out" = 23, "Observed" = 22), guide = "legend") + if (bound_distinct) { + graph <- graph + + guides(shape = guide_legend(" Observation \n within bounds")) + } else { + graph <- graph + + guides(shape = guide_legend("")) + } return(graph) } diff --git a/man/PPC-discrete.Rd b/man/PPC-discrete.Rd index 434ba7bd..bff46d34 100644 --- a/man/PPC-discrete.Rd +++ b/man/PPC-discrete.Rd @@ -37,10 +37,11 @@ ppc_bars_grouped( ppc_rootogram( y, yrep, - style = c("standing", "hanging", "suspended"), + style = c("standing", "hanging", "suspended", "discrete"), ..., prob = 0.9, - size = 1 + size = 1, + bound_distinct = TRUE ) ppc_bars_data(y, yrep, group = NULL, prob = 0.9, freq = TRUE) @@ -69,7 +70,7 @@ the bar width.} \item{size, fatten, linewidth}{For bar plots, \code{size}, \code{fatten}, and \code{linewidth} are passed to \code{\link[ggplot2:geom_linerange]{ggplot2::geom_pointrange()}} to control the appearance of the \code{yrep} points and intervals. For rootograms \code{size} is passed to -\code{\link[ggplot2:geom_path]{ggplot2::geom_line()}}.} +\code{\link[ggplot2:geom_path]{ggplot2::geom_line()}} and \code{\link[ggplot2:geom_linerange]{ggplot2::geom_pointrange()}}.} \item{freq}{For bar plots only, if \code{TRUE} (the default) the y-axis will display counts. Setting \code{freq=FALSE} will put proportions on the y-axis.} @@ -83,9 +84,13 @@ to the corresponding observation.} passed to \code{\link[ggplot2:facet_wrap]{ggplot2::facet_wrap()}} to control faceting.} \item{style}{For \code{ppc_rootogram}, a string specifying the rootogram -style. The options are \code{"standing"}, \code{"hanging"}, and +style. The options are \verb{"discrete", "standing"}, \code{"hanging"}, and \code{"suspended"}. See the \strong{Plot Descriptions} section, below, for details on the different styles.} + +\item{bound_distinct}{For \verb{ppc_rootogram(style = "discrete)}, +if \code{TRUE} then the observed counts will be plotted with different shapes +depending on whether they are within the bounds of the expected quantiles.} } \value{ The plotting functions return a ggplot object that can be further @@ -129,10 +134,12 @@ style can be adjusted to focus on different aspects of the data: \itemize{ \item \emph{Standing}: basic histogram of observed counts with curve showing expected counts. -\item \emph{Hanging}: observed counts counts hanging from the curve +\item \emph{Hanging}: observed counts hanging from the curve representing expected counts. \item \emph{Suspended}: histogram of the differences between expected and observed counts. +\item \emph{Discrete}: a dot-and-whisker plot of the expected counts and dots +representing observed counts } \strong{All of the rootograms are plotted on the square root scale}. See Kleiber @@ -206,6 +213,7 @@ ppc_rootogram(y, yrep, prob = 0) ppc_rootogram(y, yrep, style = "hanging", prob = 0.8) ppc_rootogram(y, yrep, style = "suspended") +ppc_rootogram(y, yrep, style = "discrete") } \references{ diff --git a/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg new file mode 100644 index 00000000..dfe3c771 --- /dev/null +++ b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg @@ -0,0 +1,79 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +4 +8 +12 + + + + + + + + + + + +0 +1 +2 +3 +4 +5 +y +Count + +Observed + + +Expected +ppc_rootogram (style='discrete', prob, size, bound_distinct=FALSE) + + diff --git a/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size.svg b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size.svg new file mode 100644 index 00000000..67c9d8a8 --- /dev/null +++ b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 + + + + + + + + + + +0 +1 +2 +3 +4 +5 +y +Count + Observation + within bounds + + +In +Out + + +Expected +ppc_rootogram (style='discrete', prob, size) + + diff --git a/tests/testthat/test-ppc-discrete.R b/tests/testthat/test-ppc-discrete.R index a5ddb622..b91f787e 100644 --- a/tests/testthat/test-ppc-discrete.R +++ b/tests/testthat/test-ppc-discrete.R @@ -87,6 +87,7 @@ test_that("ppc_rootogram returns a ggplot object", { expect_gg(ppc_rootogram(y2, yrep2)) expect_gg(ppc_rootogram(y2, yrep3, style = "hanging", prob = 0.5)) expect_gg(ppc_rootogram(y2, yrep3, style = "suspended")) + expect_gg(ppc_rootogram(y2, yrep3, style = "discrete")) }) test_that("ppc_rootogram errors if y/yrep not counts", { @@ -176,5 +177,30 @@ test_that("ppc_rootogram renders correctly", { vdiffr::expect_doppelganger( title = "ppc_rootogram (style='hanging', prob, size)", fig = p_custom_hanging) + + p_discrete <- ppc_rootogram( + y = vdiff_y2, + yrep = vdiff_yrep2, + prob = 0.5, + size = 1, + style = "discrete" + ) + + vdiffr::expect_doppelganger( + title = "ppc_rootogram (style='discrete', prob, size)", + fig = p_discrete) + + p_discrete_nonbound <- ppc_rootogram( + y = vdiff_y2, + yrep = vdiff_yrep2, + prob = 0.8, + size = 1, + style = "discrete", + bound_distinct = FALSE + ) + + vdiffr::expect_doppelganger( + title = "ppc_rootogram (style='discrete', prob, size, bound_distinct=FALSE)", + fig = p_discrete_nonbound) }) From dbeeb05be8b490749c241f90a56ebdc086398b8f Mon Sep 17 00:00:00 2001 From: BehramUlukir Date: Mon, 11 Aug 2025 16:50:21 +0300 Subject: [PATCH 04/11] updated documentation and labeling for emphasising median choice --- R/ppc-discrete.R | 34 +++--- man/PPC-discrete.Rd | 22 ++-- ...iscrete-prob-size-bound-distinct-false.svg | 84 +++++++------- ...ppc-rootogram-style-discrete-prob-size.svg | 104 ++++++++++-------- 4 files changed, 138 insertions(+), 106 deletions(-) diff --git a/R/ppc-discrete.R b/R/ppc-discrete.R index 5fe8170f..0862018a 100644 --- a/R/ppc-discrete.R +++ b/R/ppc-discrete.R @@ -26,7 +26,7 @@ #' display counts. Setting `freq=FALSE` will put proportions on the y-axis. #' @param bound_distinct For `ppc_rootogram(style = "discrete)`, #' if `TRUE` then the observed counts will be plotted with different shapes -#' depending on whether they are within the bounds of the expected quantiles. +#' depending on whether they are within the bounds of the `y` quantiles. #' #' @template return-ggplot-or-data #' @@ -47,20 +47,26 @@ #' } #' \item{`ppc_rootogram()`}{ #' Rootograms allow for diagnosing problems in count data models such as -#' overdispersion or excess zeros. They consist of a histogram of `y` with the -#' expected counts based on `yrep` overlaid as a line along with uncertainty -#' intervals. The y-axis represents the square roots of the counts to +#' overdispersion or excess zeros. In `standing`, `hanging`, and `suspended` +#' styles, they consist of a histogram of `y` with the expected counts based on +#' `yrep` overlaid as a line along with uncertainty intervals. +#' +#' Meanwhile, in `discrete` style, median counts based on `yrep` are laid +#' as a point range with uncertainty intervals along with dots +#' representing the `y`. +#' +#' The y-axis represents the square roots of the counts to #' approximately adjust for scale differences and thus ease comparison between -#' observed and expected counts. Using the `style` argument, the histogram -#' style can be adjusted to focus on different aspects of the data: +#' observed and expected counts. Using the `style` argument, the rootogram +#' can be adjusted to focus on different aspects of the data: #' * _Standing_: basic histogram of observed counts with curve #' showing expected counts. #' * _Hanging_: observed counts hanging from the curve #' representing expected counts. #' * _Suspended_: histogram of the differences between expected and #' observed counts. -#' * _Discrete_: a dot-and-whisker plot of the expected counts and dots -#' representing observed counts +#' * _Discrete_: a dot-and-whisker plot of the median counts and +#' dots representing observed counts. #' #' **All of the rootograms are plotted on the square root scale**. See Kleiber #' and Zeileis (2016) for advice on interpreting rootograms and selecting @@ -290,7 +296,7 @@ ppc_rootogram <- function(y, # use a different shape for the point obs_shape <- obs_shape <- ifelse(y_count >= pred_quantile[, "lower"] & y_count <= pred_quantile[, "upper"], "In", "Out") } else { - obs_shape <- rep("Observed", length(y_count)) # all points are the same shape for obsved + obs_shape <- rep("y", length(y_count)) # all points are the same shape for observed } data <- data.frame( @@ -303,21 +309,21 @@ ppc_rootogram <- function(y, ) # Create the graph graph <- ggplot(data, aes(x = xpos)) + - geom_pointrange(aes(y = pred_median, ymin = lower, ymax = upper, color = "Expected"), fill = get_color("lh"), linewidth = size, size = size, fatten = 2, alpha = 1) + + geom_pointrange(aes(y = pred_median, ymin = lower, ymax = upper, color = "y_rep"), fill = get_color("lh"), linewidth = size, size = size, fatten = 2, alpha = 1) + geom_point(aes(y = obs, shape = obs_shape), size = size * 1.5, color = get_color("d"), fill = get_color("d")) + scale_y_sqrt() + scale_fill_manual("", values = get_color("d"), guide="none") + - scale_color_manual("", values = get_color("lh")) + + scale_color_manual("", values = get_color("lh"), labels = yrep_label()) + labs(x = expression(italic(y)), y = "Count") + bayesplot_theme_get() + reduce_legend_spacing(0.25) + - scale_shape_manual(values = c("In" = 22, "Out" = 23, "Observed" = 22), guide = "legend") + scale_shape_manual(values = c("In" = 22, "Out" = 23, "y" = 22), guide = "legend") if (bound_distinct) { graph <- graph + - guides(shape = guide_legend(" Observation \n within bounds")) + guides(shape = guide_legend(expression(italic(y)~within~bounds))) } else { graph <- graph + - guides(shape = guide_legend("")) + guides(shape = guide_legend(" ")) } return(graph) } diff --git a/man/PPC-discrete.Rd b/man/PPC-discrete.Rd index bff46d34..11d26ede 100644 --- a/man/PPC-discrete.Rd +++ b/man/PPC-discrete.Rd @@ -90,7 +90,7 @@ details on the different styles.} \item{bound_distinct}{For \verb{ppc_rootogram(style = "discrete)}, if \code{TRUE} then the observed counts will be plotted with different shapes -depending on whether they are within the bounds of the expected quantiles.} +depending on whether they are within the bounds of the \code{y} quantiles.} } \value{ The plotting functions return a ggplot object that can be further @@ -125,12 +125,18 @@ level of a grouping variable. } \item{\code{ppc_rootogram()}}{ Rootograms allow for diagnosing problems in count data models such as -overdispersion or excess zeros. They consist of a histogram of \code{y} with the -expected counts based on \code{yrep} overlaid as a line along with uncertainty -intervals. The y-axis represents the square roots of the counts to +overdispersion or excess zeros. In \code{standing}, \code{hanging}, and \code{suspended} +styles, they consist of a histogram of \code{y} with the expected counts based on +\code{yrep} overlaid as a line along with uncertainty intervals. + +Meanwhile, in \code{discrete} style, median counts based on \code{yrep} are laid +as a point range with uncertainty intervals along with dots +representing the \code{y}. + +The y-axis represents the square roots of the counts to approximately adjust for scale differences and thus ease comparison between -observed and expected counts. Using the \code{style} argument, the histogram -style can be adjusted to focus on different aspects of the data: +observed and expected counts. Using the \code{style} argument, the rootogram +can be adjusted to focus on different aspects of the data: \itemize{ \item \emph{Standing}: basic histogram of observed counts with curve showing expected counts. @@ -138,8 +144,8 @@ showing expected counts. representing expected counts. \item \emph{Suspended}: histogram of the differences between expected and observed counts. -\item \emph{Discrete}: a dot-and-whisker plot of the expected counts and dots -representing observed counts +\item \emph{Discrete}: a dot-and-whisker plot of the median counts and +dots representing observed counts. } \strong{All of the rootograms are plotted on the square root scale}. See Kleiber diff --git a/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg index dfe3c771..1b04d213 100644 --- a/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg +++ b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg @@ -20,29 +20,29 @@ - - + + - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + @@ -54,26 +54,30 @@ - - - - - - - -0 -1 -2 -3 -4 -5 -y + + + + + + + +0 +1 +2 +3 +4 +5 +y Count - -Observed - - -Expected + + +y + + +y +r +e +p ppc_rootogram (style='discrete', prob, size, bound_distinct=FALSE) diff --git a/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size.svg b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size.svg index 67c9d8a8..718cfd76 100644 --- a/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size.svg +++ b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size.svg @@ -20,29 +20,29 @@ - - + + - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + @@ -52,30 +52,46 @@ - - - - - - - -0 -1 -2 -3 -4 -5 -y + + + + + + + +0 +1 +2 +3 +4 +5 +y Count - Observation - within bounds - - -In -Out - - -Expected +y + +w +i +t +h +i +n + +b +o +u +n +d +s + + +In +Out + + +y +r +e +p ppc_rootogram (style='discrete', prob, size) From 059c8589f0d8c80ffabefcd1c9d408fe504675df Mon Sep 17 00:00:00 2001 From: BehramUlukir Date: Mon, 11 Aug 2025 17:22:45 +0300 Subject: [PATCH 05/11] correcting y label when bound_distinct false --- R/ppc-discrete.R | 2 +- ...-rootogram-style-discrete-prob-size-bound-distinct-false.svg | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/ppc-discrete.R b/R/ppc-discrete.R index 0862018a..885bc8ff 100644 --- a/R/ppc-discrete.R +++ b/R/ppc-discrete.R @@ -317,7 +317,7 @@ ppc_rootogram <- function(y, labs(x = expression(italic(y)), y = "Count") + bayesplot_theme_get() + reduce_legend_spacing(0.25) + - scale_shape_manual(values = c("In" = 22, "Out" = 23, "y" = 22), guide = "legend") + scale_shape_manual(values = c("In" = 22, "Out" = 23, "y" = 22), guide = "legend", labels = c("y" = expression(italic(y)))) if (bound_distinct) { graph <- graph + guides(shape = guide_legend(expression(italic(y)~within~bounds))) diff --git a/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg index 1b04d213..589609dc 100644 --- a/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg +++ b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg @@ -71,7 +71,7 @@ Count -y +y y From 4edd6fd1c2deea2ab793d61a98c96b4f756628f2 Mon Sep 17 00:00:00 2001 From: BehramUlukir Date: Mon, 11 Aug 2025 17:22:45 +0300 Subject: [PATCH 06/11] update NEWS.md --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 941ef230..67983ef2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,7 @@ * `ppc_error_scatter_avg_vs_x(x = some_expression)` labels the *x* axis with `some_expression`. * Add `ppc_dots()` and `ppd_dots()` by @behramulukir (#357) * Add `x` argument to `ppc_error_binned` by @behramulukir (#359) +* Add `disrete` style to `ppc_rootogram` by @behramulukir (#360) # bayesplot 1.13.0 From db13aab9f369111a68e381aa1844af5c85ca3a2a Mon Sep 17 00:00:00 2001 From: BehramUlukir Date: Mon, 11 Aug 2025 17:44:17 +0300 Subject: [PATCH 07/11] update NEWS.md --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 67983ef2..7ad30dab 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,7 +4,7 @@ * `ppc_error_scatter_avg_vs_x(x = some_expression)` labels the *x* axis with `some_expression`. * Add `ppc_dots()` and `ppd_dots()` by @behramulukir (#357) * Add `x` argument to `ppc_error_binned` by @behramulukir (#359) -* Add `disrete` style to `ppc_rootogram` by @behramulukir (#360) +* Add `discrete` style to `ppc_rootogram` by @behramulukir (#362) # bayesplot 1.13.0 From 4f6eae7cc3d5822e680a8b73c8e09b4e4c68539c Mon Sep 17 00:00:00 2001 From: BehramUlukir Date: Thu, 14 Aug 2025 11:48:49 +0300 Subject: [PATCH 08/11] fix typo in documentation --- R/ppc-discrete.R | 2 +- man/PPC-discrete.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/ppc-discrete.R b/R/ppc-discrete.R index 885bc8ff..e784761e 100644 --- a/R/ppc-discrete.R +++ b/R/ppc-discrete.R @@ -224,7 +224,7 @@ ppc_bars_grouped <- #' @rdname PPC-discrete #' @export #' @param style For `ppc_rootogram`, a string specifying the rootogram -#' style. The options are `"discrete", "standing"`, `"hanging"`, and +#' style. The options are `"discrete"`, `"standing"`, `"hanging"`, and #' `"suspended"`. See the **Plot Descriptions** section, below, for #' details on the different styles. #' diff --git a/man/PPC-discrete.Rd b/man/PPC-discrete.Rd index 11d26ede..1da81353 100644 --- a/man/PPC-discrete.Rd +++ b/man/PPC-discrete.Rd @@ -84,7 +84,7 @@ to the corresponding observation.} passed to \code{\link[ggplot2:facet_wrap]{ggplot2::facet_wrap()}} to control faceting.} \item{style}{For \code{ppc_rootogram}, a string specifying the rootogram -style. The options are \verb{"discrete", "standing"}, \code{"hanging"}, and +style. The options are \code{"discrete"}, \code{"standing"}, \code{"hanging"}, and \code{"suspended"}. See the \strong{Plot Descriptions} section, below, for details on the different styles.} From 963c237aa3689f2a6bca97f20b955696daed072e Mon Sep 17 00:00:00 2001 From: BehramUlukir Date: Thu, 21 Aug 2025 01:11:22 +0300 Subject: [PATCH 09/11] code refactor and addition of .ppc_rootogram_data --- R/ppc-discrete.R | 272 ++++++++++-------- .../ppc-rootogram-style-hanging-prob-size.svg | 2 +- 2 files changed, 158 insertions(+), 116 deletions(-) diff --git a/R/ppc-discrete.R b/R/ppc-discrete.R index e784761e..cae906d5 100644 --- a/R/ppc-discrete.R +++ b/R/ppc-discrete.R @@ -256,103 +256,23 @@ ppc_rootogram <- function(y, bound_distinct = TRUE) { check_ignored_arguments(...) style <- match.arg(style) - y <- validate_y(y) - yrep <- validate_predictions(yrep, length(y)) - if (!all_counts(y)) { - abort("ppc_rootogram expects counts as inputs to 'y'.") - } - if (!all_counts(yrep)) { - abort("ppc_rootogram expects counts as inputs to 'yrep'.") - } - - alpha <- (1 - prob) / 2 - probs <- c(alpha, 1 - alpha) - ymax <- max(y, yrep) - xpos <- 0L:ymax - - # prepare a table for yrep - tyrep <- as.list(rep(NA, nrow(yrep))) - for (i in seq_along(tyrep)) { - tyrep[[i]] <- table(yrep[i,]) - matches <- match(xpos, rownames(tyrep[[i]])) - tyrep[[i]] <- as.numeric(tyrep[[i]][matches]) - } - tyrep <- do.call(rbind, tyrep) - tyrep[is.na(tyrep)] <- 0 - - #Discrete style - pred_median <- apply(tyrep, 2, median) - pred_quantile <- t(apply(tyrep, 2, quantile, probs = probs)) - colnames(pred_quantile) <- c("lower", "upper") - - # prepare a table for y - ty <- table(y) - y_count <- as.numeric(ty[match(xpos, rownames(ty))]) - y_count[is.na(y_count)] <- 0 - - if (style == "discrete") { - if (bound_distinct) { - # If the observed count is within the bounds of the predicted quantiles, - # use a different shape for the point - obs_shape <- obs_shape <- ifelse(y_count >= pred_quantile[, "lower"] & y_count <= pred_quantile[, "upper"], "In", "Out") - } else { - obs_shape <- rep("y", length(y_count)) # all points are the same shape for observed - } - data <- data.frame( - xpos = xpos, - obs = y_count, - pred_median = pred_median, - lower = pred_quantile[, "lower"], - upper = pred_quantile[, "upper"], - obs_shape = obs_shape - ) - # Create the graph - graph <- ggplot(data, aes(x = xpos)) + - geom_pointrange(aes(y = pred_median, ymin = lower, ymax = upper, color = "y_rep"), fill = get_color("lh"), linewidth = size, size = size, fatten = 2, alpha = 1) + - geom_point(aes(y = obs, shape = obs_shape), size = size * 1.5, color = get_color("d"), fill = get_color("d")) + - scale_y_sqrt() + - scale_fill_manual("", values = get_color("d"), guide="none") + - scale_color_manual("", values = get_color("lh"), labels = yrep_label()) + - labs(x = expression(italic(y)), y = "Count") + - bayesplot_theme_get() + - reduce_legend_spacing(0.25) + - scale_shape_manual(values = c("In" = 22, "Out" = 23, "y" = 22), guide = "legend", labels = c("y" = expression(italic(y)))) - if (bound_distinct) { - graph <- graph + - guides(shape = guide_legend(expression(italic(y)~within~bounds))) - } else { - graph <- graph + - guides(shape = guide_legend(" ")) - } - return(graph) - } - - - #Standing, hanging, and suspended styles - tyexp <- sqrt(colMeans(tyrep)) - tyquantile <- sqrt(t(apply(tyrep, 2, quantile, probs = probs))) - colnames(tyquantile) <- c("tylower", "tyupper") - - # prepare a table for y - ty <- table(y) - ty <- sqrt(as.numeric(ty[match(xpos, rownames(ty))])) - if (style == "suspended") { - ty <- tyexp - ty - } - ty[is.na(ty)] <- 0 - ypos <- ty / 2 - if (style == "hanging") { - ypos <- tyexp - ypos - } + data <- .ppc_rootogram_data( + y = y, + yrep = yrep, + style = style, + prob = prob, + bound_distinct = bound_distinct + ) - data <- data.frame(xpos, ypos, ty, tyexp, tyquantile) - graph <- ggplot(data) + - aes( - ymin = .data$tylower, - ymax = .data$tyupper, - height = .data$ty - ) + + # Building geoms for y and y_rep + geom_y <- if (style == "discrete") { + geom_point( + aes(y = .data$obs, shape = .data$obs_shape), + size = size * 1.5, + color = get_color("d"), + fill = get_color("d")) + } else { geom_tile( aes( x = .data$xpos, @@ -362,34 +282,69 @@ ppc_rootogram <- function(y, color = get_color("lh"), linewidth = 0.25, width = 1 - ) + - bayesplot_theme_get() - - if (style != "standing") { - graph <- graph + hline_0(size = 0.4) + ) } - graph <- graph + + geom_yrep <- if (style == "discrete") { + geom_pointrange( + aes(y = .data$pred_median, ymin = .data$lower, ymax = .data$upper, color = "y_rep"), + fill = get_color("lh"), + linewidth = size, + size = size, + fatten = 2, + alpha = 1 + ) + } else { geom_smooth( - aes( - x = .data$xpos, - y = .data$tyexp, - color = "Expected" - ), + aes(x = .data$xpos, y = .data$tyexp, color = "Expected"), fill = get_color("d"), linewidth = size, stat = "identity" - ) + - scale_fill_manual("", values = get_color("l")) + - scale_color_manual("", values = get_color("dh")) + - labs(x = expression(italic(y)), - y = expression(sqrt(Count))) - - if (style == "standing") { - graph <- graph + dont_expand_y_axis() + ) } - graph + reduce_legend_spacing(0.25) + # Creating the graph + graph <- ggplot(data) + + if (style == "discrete") { + graph <- graph + + geom_yrep + + geom_y + + aes(x = xpos) + + scale_y_sqrt() + + scale_fill_manual("", values = get_color("d"), guide = "none") + + scale_color_manual("", values = get_color("lh"), labels = yrep_label()) + + labs(x = expression(italic(y)), y = "Count") + + bayesplot_theme_get() + + reduce_legend_spacing(0.25) + + scale_shape_manual(values = c("In" = 22, "Out" = 23, "y" = 22), guide = "legend", labels = c("y" = expression(italic(y)))) + if (bound_distinct) { + graph <- graph + guides(shape = guide_legend(expression(italic(y)~within~bounds))) + } else { + graph <- graph + guides(shape = guide_legend(" ")) + } + } else { + graph <- graph + + geom_y + + geom_yrep + + aes( + ymin = .data$tylower, + ymax = .data$tyupper, + height = .data$ty + ) + + scale_fill_manual("", values = get_color("l")) + + scale_color_manual("", values = get_color("dh")) + + labs(x = expression(italic(y)), y = expression(sqrt(Count))) + + bayesplot_theme_get() + + reduce_legend_spacing(0.25) + if (style == "standing") { + graph <- graph + dont_expand_y_axis() + } else { + graph <- graph + hline_0(size = 0.4) + } + } + + return(graph) } @@ -504,3 +459,90 @@ bars_group_facets <- function(facet_args, scales_default = "fixed") { fixed_y <- function(facet_args) { !isTRUE(facet_args[["scales"]] %in% c("free", "free_y")) } + +#' Internal function for `ppc_rootogram()` +#' @param y,yrep User's `y` and `yrep` arguments. +#' @param style,prob,bound_distinct User's `style`, `prob`, and +#' (if applicable) `bound_distinct` arguments. +#' @noRd +.ppc_rootogram_data <- function(y, + yrep, + style = c("standing", "hanging", "suspended", "discrete"), + prob = 0.9, + bound_distinct) { + + y <- validate_y(y) + yrep <- validate_predictions(yrep, length(y)) + if (!all_counts(y)) { + abort("ppc_rootogram expects counts as inputs to 'y'.") + } + if (!all_counts(yrep)) { + abort("ppc_rootogram expects counts as inputs to 'yrep'.") + } + + alpha <- (1 - prob) / 2 + probs <- c(alpha, 1 - alpha) + ymax <- max(y, yrep) + xpos <- 0L:ymax + + # prepare a table for yrep + tyrep <- as.list(rep(NA, nrow(yrep))) + for (i in seq_along(tyrep)) { + tyrep[[i]] <- table(yrep[i,]) + matches <- match(xpos, rownames(tyrep[[i]])) + tyrep[[i]] <- as.numeric(tyrep[[i]][matches]) + } + tyrep <- do.call(rbind, tyrep) + tyrep[is.na(tyrep)] <- 0 + + # discrete style + if (style == "discrete"){ + pred_median <- apply(tyrep, 2, median) + pred_quantile <- t(apply(tyrep, 2, quantile, probs = probs)) + colnames(pred_quantile) <- c("lower", "upper") + + # prepare a table for y + ty <- table(y) + y_count <- as.numeric(ty[match(xpos, rownames(ty))]) + y_count[is.na(y_count)] <- 0 + + if (bound_distinct) { + # If the observed count is within the bounds of the predicted quantiles, + # use a different shape for the point + obs_shape <- obs_shape <- ifelse(y_count >= pred_quantile[, "lower"] & y_count <= pred_quantile[, "upper"], "In", "Out") + } else { + obs_shape <- rep("y", length(y_count)) # all points are the same shape for observed + } + + data <- data.frame( + xpos = xpos, + obs = y_count, + pred_median = pred_median, + lower = pred_quantile[, "lower"], + upper = pred_quantile[, "upper"], + obs_shape = obs_shape + ) + } + # standing, hanging, suspended styles + else { + tyexp <- sqrt(colMeans(tyrep)) + tyquantile <- sqrt(t(apply(tyrep, 2, quantile, probs = probs))) + colnames(tyquantile) <- c("tylower", "tyupper") + + # prepare a table for y + ty <- table(y) + ty <- sqrt(as.numeric(ty[match(xpos, rownames(ty))])) + if (style == "suspended") { + ty <- tyexp - ty + } + ty[is.na(ty)] <- 0 + ypos <- ty / 2 + if (style == "hanging") { + ypos <- tyexp - ypos + } + + data <- data.frame(xpos, ypos, ty, tyexp, tyquantile) + } + + return(data) +} diff --git a/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-hanging-prob-size.svg b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-hanging-prob-size.svg index e3d6e82b..c9cfa081 100644 --- a/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-hanging-prob-size.svg +++ b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-hanging-prob-size.svg @@ -31,11 +31,11 @@ - + From 2438b42f960bdd97f772f4bfe457f015c936a902 Mon Sep 17 00:00:00 2001 From: BehramUlukir Date: Sat, 23 Aug 2025 15:52:29 +0300 Subject: [PATCH 10/11] updates to fix R cmd check problems --- R/ppc-discrete.R | 2 +- ...> ppc-rootogram-discrete-prob-size-bound-distinct-false.svg} | 2 +- tests/testthat/test-ppc-discrete.R | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) rename tests/testthat/_snaps/ppc-discrete/{ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg => ppc-rootogram-discrete-prob-size-bound-distinct-false.svg} (98%) diff --git a/R/ppc-discrete.R b/R/ppc-discrete.R index cae906d5..8586a4c8 100644 --- a/R/ppc-discrete.R +++ b/R/ppc-discrete.R @@ -310,7 +310,7 @@ ppc_rootogram <- function(y, graph <- graph + geom_yrep + geom_y + - aes(x = xpos) + + aes(x = .data$xpos) + scale_y_sqrt() + scale_fill_manual("", values = get_color("d"), guide = "none") + scale_color_manual("", values = get_color("lh"), labels = yrep_label()) + diff --git a/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-discrete-prob-size-bound-distinct-false.svg similarity index 98% rename from tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg rename to tests/testthat/_snaps/ppc-discrete/ppc-rootogram-discrete-prob-size-bound-distinct-false.svg index 589609dc..d44ba715 100644 --- a/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-style-discrete-prob-size-bound-distinct-false.svg +++ b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-discrete-prob-size-bound-distinct-false.svg @@ -78,6 +78,6 @@ r e p -ppc_rootogram (style='discrete', prob, size, bound_distinct=FALSE) +ppc_rootogram ('discrete', prob, size, bound_distinct=FALSE) diff --git a/tests/testthat/test-ppc-discrete.R b/tests/testthat/test-ppc-discrete.R index b91f787e..b52779fb 100644 --- a/tests/testthat/test-ppc-discrete.R +++ b/tests/testthat/test-ppc-discrete.R @@ -200,7 +200,7 @@ test_that("ppc_rootogram renders correctly", { ) vdiffr::expect_doppelganger( - title = "ppc_rootogram (style='discrete', prob, size, bound_distinct=FALSE)", + title = "ppc_rootogram ('discrete', prob, size, bound_distinct=FALSE)", fig = p_discrete_nonbound) }) From 21f9c0276716f5ab814f767c806b232af85f4778 Mon Sep 17 00:00:00 2001 From: BehramUlukir Date: Sat, 23 Aug 2025 16:20:38 +0300 Subject: [PATCH 11/11] shortening test svg output path --- ...alse.svg => ppc-rootogram-discrete-bound-distinct-false.svg} | 2 +- tests/testthat/test-ppc-discrete.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) rename tests/testthat/_snaps/ppc-discrete/{ppc-rootogram-discrete-prob-size-bound-distinct-false.svg => ppc-rootogram-discrete-bound-distinct-false.svg} (98%) diff --git a/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-discrete-prob-size-bound-distinct-false.svg b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-discrete-bound-distinct-false.svg similarity index 98% rename from tests/testthat/_snaps/ppc-discrete/ppc-rootogram-discrete-prob-size-bound-distinct-false.svg rename to tests/testthat/_snaps/ppc-discrete/ppc-rootogram-discrete-bound-distinct-false.svg index d44ba715..0e09c451 100644 --- a/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-discrete-prob-size-bound-distinct-false.svg +++ b/tests/testthat/_snaps/ppc-discrete/ppc-rootogram-discrete-bound-distinct-false.svg @@ -78,6 +78,6 @@ r e p -ppc_rootogram ('discrete', prob, size, bound_distinct=FALSE) +ppc_rootogram ('discrete', bound_distinct=FALSE) diff --git a/tests/testthat/test-ppc-discrete.R b/tests/testthat/test-ppc-discrete.R index b52779fb..c8e749a8 100644 --- a/tests/testthat/test-ppc-discrete.R +++ b/tests/testthat/test-ppc-discrete.R @@ -200,7 +200,7 @@ test_that("ppc_rootogram renders correctly", { ) vdiffr::expect_doppelganger( - title = "ppc_rootogram ('discrete', prob, size, bound_distinct=FALSE)", + title = "ppc_rootogram ('discrete', bound_distinct=FALSE)", fig = p_discrete_nonbound) })