Merge pull request #212 from stan-dev/ppc-dens-overlay-group

add ppc_*_overlay_grouped functions

Author: jgabry

NAMESPACE

@@ -104,7 +104,9 @@ export(ppc_boxplot)
 export(ppc_data)
 export(ppc_dens)
 export(ppc_dens_overlay)
+export(ppc_dens_overlay_grouped)
 export(ppc_ecdf_overlay)
+export(ppc_ecdf_overlay_grouped)
 export(ppc_error_binned)
 export(ppc_error_hist)
 export(ppc_error_hist_grouped)

NEWS.md

@@ -8,24 +8,30 @@
 * Items for next release go here
 -->
 
+* Added `ppc_dens_overlay_grouped()` and `ppc_ecdf_overlay_grouped()` for
+  plotting density and cumulative distributions of the posterior predictive
+  distribution (versus observed data) by group. (#212)
+
+* Fix bug in `color_scheme_view()` minimal theme (#213).
+
 * On the y axis, `ppc_loo_pit_qq(..., compare = "normal")` now plots standard
   normal quantiles calculated from the PIT values (instead of the standardized
   PIT values). (#240, #243, @fweber144)
 
 * New plotting function `ppc_km_overlay()` for outcome variables that are   
-  right-censored. Empirical CCDF estimates of `yrep` are compared with the 
+  right-censored. Empirical CCDF estimates of `yrep` are compared with the
   Kaplan-Meier estimate of `y`. (#233, #234, @fweber144)
 
-* CmdStanMCMC objects (from CmdStanR) can now be used with extractor 
-  functions `nuts_params()`, `log_posterior()`, `rhat()`, and 
+* CmdStanMCMC objects (from CmdStanR) can now be used with extractor
+  functions `nuts_params()`, `log_posterior()`, `rhat()`, and
   `neff_ratio()`. (#227)
 
 * Added missing `facet_args` argument to `mcmc_rank_overlay()`. (#221, @hhau)
 
-* Size of points and interval lines can set in 
-  `mcmc_intervals(..., outer_size, inner_size, point_size)`. (#215, #228, #229) 
-  
-* `mcmc_areas()` tries to use less blank vertical blank space. (#218, #230) 
+* Size of points and interval lines can set in
+  `mcmc_intervals(..., outer_size, inner_size, point_size)`. (#215, #228, #229)
+
+* `mcmc_areas()` tries to use less blank vertical blank space. (#218, #230)
 
 * `ppc_loo_pit_overlay()` now uses a boundary correction for an improved kernel
   density estimation. The new argument `boundary_correction` defaults to TRUE but
@@ -53,39 +59,39 @@ matrices also inheriting from "array" in R 4.0.
   examples. (#161, #183, #188)
 
 * Two new plots have been added for inspecting the distribution of ranks.
-  Rank histograms were introduced by the Stan team's [new paper on 
+  Rank histograms were introduced by the Stan team's [new paper on
   MCMC diagnostics](https://arxiv.org/abs/1903.08008). (#178, #179)
 
   `mcmc_rank_hist()`: A traditional traceplot (`mcmc_trace()`) visualizes how
   sampled values the MCMC chains mix over the course of sampling. A rank
   histogram (`mcmc_rank_hist()`) visualizes how the *ranks* of values from the
   chains mix together. An ideal plot would show the ranks mixing or overlapping
   in a uniform distribution.
-  
+
   `mcmc_rank_overlay()`: Instead of drawing each chain's histogram in a separate
   panel, this plot draws the top edge of the chains' histograms in a single
   panel.
-  
+
 * Added `mcmc_trace_data()`, which returns the data used for plotting the trace
   plots and rank histograms. (Advances #97)
 
 * [ColorBrewer](http://colorbrewer2.org) palettes are now available as color
   schemes via
   [`color_scheme_set()`](https://mc-stan.org/bayesplot/reference/bayesplot-colors.html).
-  For example, `color_scheme_set("brewer-Spectral")` will use the Spectral 
+  For example, `color_scheme_set("brewer-Spectral")` will use the Spectral
   palette. (#177, #190)
 
-* MCMC plots now also accept objects with an `as.array` method as 
+* MCMC plots now also accept objects with an `as.array` method as
   input (e.g., stanfit objects). (#175, #184)
 
 * [`mcmc_trace()`](https://mc-stan.org/bayesplot/reference/MCMC-traces.html)
   gains an argument `iter1` which can be used to label the traceplot starting
   from the first iteration after warmup. (#14, #155, @mcol)
 
 * [`mcmc_areas()`](https://mc-stan.org/bayesplot/reference/MCMC-intervals.html)
-  gains an argument `area_method` which controls how to draw the density 
-  curves. The default `"equal area"` constrains the heights so that the curves 
-  have the same area. As a result, a narrow interval will appear as a spike 
+  gains an argument `area_method` which controls how to draw the density
+  curves. The default `"equal area"` constrains the heights so that the curves
+  have the same area. As a result, a narrow interval will appear as a spike
   of density, while a wide, uncertain interval is spread thin over the _x_ axis.
   Alternatively `"equal height"` will set the maximum height on each curve to
   the same value. This works well when the intervals are about the same width.
@@ -112,12 +118,12 @@ matrices also inheriting from "array" in R 4.0.
 * The examples in
   [`?ppc_loo_pit_overlay()`](https://mc-stan.org/bayesplot/reference/PPC-loo.html)
   now work as expected. (#166, #167)
-  
-* Added `"viridisD"` as an alternative name for `"viridis"` to the supported 
+
+* Added `"viridisD"` as an alternative name for `"viridis"` to the supported
   colors.
 
-* Added `"viridisE"` (the [cividis](https://github.com/marcosci/cividis) 
-  version of viridis) to the supported colors. 
+* Added `"viridisE"` (the [cividis](https://github.com/marcosci/cividis)
+  version of viridis) to the supported colors.
 
 * `ppc_bars()` and `ppc_bars_grouped()` now allow negative integers as input.
   (#172, @jeffpollock9)
@@ -160,7 +166,7 @@ matrices also inheriting from "array" in R 4.0.
   gains an argument `discrete`, which is `FALSE` by default, but can be used
   to make the Geom more appropriate for discrete data. (#145)
 
-* [PPC intervals 
+* [PPC intervals
   plots](https://mc-stan.org/bayesplot/reference/PPC-intervals.html) and [LOO
   predictive checks](https://mc-stan.org/bayesplot/reference/PPC-loo.html) now
   draw both an outer and an inner probability interval, which can be

R/bayesplot-colors.R

@@ -230,8 +230,9 @@ plot_scheme <- function(scheme = NULL) {
     legend_none() +
     xaxis_text(
       face = "bold",
-      margin = margin(t = -3, b = 10),
+      margin = margin(t = -3, b = 10, unit = "pt"),
       angle = 0,
+      vjust = 1,
       debug = FALSE
     )
 }

R/ppc-distributions.R

@@ -33,7 +33,8 @@
 #'    `yrep` should therefore contain only a small number of rows. See the
 #'    **Examples** section.
 #'   }
-#'   \item{`ppc_dens_overlay(), ppc_ecdf_overlay()`}{
+#'   \item{`ppc_ecdf_overlay(), ppc_dens_overlay(),
+#'          ppc_ecdf_overlay_grouped(), ppc_dens_overlay_grouped()`}{
 #'    Kernel density or empirical CDF estimates of each dataset (row) in
 #'    `yrep` are overlaid, with the distribution of `y` itself on top
 #'    (and in a darker shade). When using `ppc_ecdf_overlay()` with discrete
@@ -58,6 +59,7 @@
 #' yrep <- example_yrep_draws()
 #' dim(yrep)
 #' ppc_dens_overlay(y, yrep[1:25, ])
+#'
 #' \donttest{
 #' # ppc_ecdf_overlay with continuous data (set discrete=TRUE if discrete data)
 #' ppc_ecdf_overlay(y, yrep[sample(nrow(yrep), 25), ])
@@ -85,6 +87,11 @@
 #' ppc_freqpoly_grouped(y, yrep[1:3,], group, freq = FALSE) + yaxis_text()
 #' }
 #'
+#' # density and distribution overlays by group
+#' ppc_dens_overlay_grouped(y, yrep[1:25, ], group = group)
+#'
+#' ppc_ecdf_overlay_grouped(y, yrep[1:25, ], group = group)
+#'
 #' # don't need to only use small number of rows for ppc_violin_grouped
 #' # (as it pools yrep draws within groups)
 #' color_scheme_set("gray")
@@ -265,15 +272,18 @@ ppc_dens <- function(y, yrep, ..., trim = FALSE, size = 0.5, alpha = 1) {
 #' @rdname PPC-distributions
 #' @export
 #' @template args-density-controls
-ppc_dens_overlay <- function(y, yrep, ...,
-                             size = 0.25,
-                             alpha = 0.7,
-                             trim = FALSE,
-                             bw = "nrd0",
-                             adjust = 1,
-                             kernel = "gaussian",
-                             n_dens = 1024) {
-
+ppc_dens_overlay <- function(
+  y,
+  yrep,
+  ...,
+  size = 0.25,
+  alpha = 0.7,
+  trim = FALSE,
+  bw = "nrd0",
+  adjust = 1,
+  kernel = "gaussian",
+  n_dens = 1024
+) {
   check_ignored_arguments(...)
   data <- ppc_data(y, yrep)
 
@@ -315,10 +325,46 @@ ppc_dens_overlay <- function(y, yrep, ...,
     yaxis_ticks(FALSE)
 }
 
+#' @rdname PPC-distributions
+#' @export
+#' @template args-density-controls
+ppc_dens_overlay_grouped <- function(
+  y,
+  yrep,
+  group,
+  ...,
+  size = 0.25,
+  alpha = 0.7,
+  trim = FALSE,
+  bw = "nrd0",
+  adjust = 1,
+  kernel = "gaussian",
+  n_dens = 1024
+) {
+  check_ignored_arguments(...)
 
-
-
-
+  p_overlay <- ppc_dens_overlay(
+    y = y,
+    yrep = yrep,
+    ...,
+    size = size,
+    alpha = alpha,
+    trim = trim,
+    bw = bw,
+    adjust = adjust,
+    kernel = kernel,
+    n_dens = n_dens
+  )
+  # Use + list(data) trick to replace the data in the plot. The layer-specific
+  # data in the y and yrep layers should be safe because they are
+  # specified using a function on the main plot data.
+  data <- ppc_data(y, yrep, group = group)
+  p_overlay <- p_overlay + list(data)
+
+  p_overlay +
+    facet_wrap("group") +
+    force_axes_in_facets()
+}
 
 #' @export
 #' @rdname PPC-distributions
@@ -327,48 +373,90 @@ ppc_dens_overlay <- function(y, yrep, ...,
 #'   passed to [ggplot2::stat_ecdf()]. If `discrete` is set to
 #'   `TRUE` then `geom="step"` is used.
 #' @param pad A logical scalar passed to [ggplot2::stat_ecdf()].
-ppc_ecdf_overlay <-
-  function(y,
-           yrep,
-           ...,
-           discrete = FALSE,
-           pad = TRUE,
-           size = 0.25,
-           alpha = 0.7) {
-    check_ignored_arguments(...)
-    data <- ppc_data(y, yrep)
+ppc_ecdf_overlay <- function(
+  y,
+  yrep,
+  ...,
+  discrete = FALSE,
+  pad = TRUE,
+  size = 0.25,
+  alpha = 0.7
+) {
+  check_ignored_arguments(...)
+  data <- ppc_data(y, yrep)
 
-    ggplot(data) +
-      aes_(x = ~ value) +
-      hline_at(
-        c(0, 0.5, 1),
-        size = c(0.2, 0.1, 0.2),
-        linetype = 2,
-        color = get_color("dh")
-      ) +
-      stat_ecdf(
-        data = function(x) dplyr::filter(x, !.data$is_y),
-        mapping = aes_(group = ~ rep_id, color = "yrep"),
-        geom = if (discrete) "step" else "line",
-        size = size,
-        alpha = alpha,
-        pad = pad
-      ) +
-      stat_ecdf(
-        data = function(x) dplyr::filter(x, .data$is_y),
-        mapping = aes_(color = "y"),
-        geom = if (discrete) "step" else "line",
-        size = 1,
-        pad = pad
-      ) +
-      scale_color_ppc_dist() +
-      xlab(y_label()) +
-      scale_y_continuous(breaks = c(0, 0.5, 1)) +
-      yaxis_title(FALSE) +
-      xaxis_title(FALSE) +
-      yaxis_ticks(FALSE) +
+  ggplot(data) +
+    aes_(x = ~ value) +
+    hline_at(
+      0.5,
+      size = 0.1,
+      linetype = 2,
+      color = get_color("dh")
+    ) +
+    hline_at(
+      c(0, 1),
+      size = 0.2,
+      linetype = 2,
+      color = get_color("dh")
+    ) +
+    stat_ecdf(
+      data = function(x) dplyr::filter(x, !.data$is_y),
+      mapping = aes_(group = ~ rep_id, color = "yrep"),
+      geom = if (discrete) "step" else "line",
+      size = size,
+      alpha = alpha,
+      pad = pad
+    ) +
+    stat_ecdf(
+      data = function(x) dplyr::filter(x, .data$is_y),
+      mapping = aes_(color = "y"),
+      geom = if (discrete) "step" else "line",
+      size = 1,
+      pad = pad
+    ) +
+    scale_color_ppc_dist() +
+    xlab(y_label()) +
+    scale_y_continuous(breaks = c(0, 0.5, 1)) +
+    yaxis_title(FALSE) +
+    xaxis_title(FALSE) +
+    yaxis_ticks(FALSE) +
     bayesplot_theme_get()
-  }
+}
+
+#' @export
+#' @rdname PPC-distributions
+ppc_ecdf_overlay_grouped <- function(
+  y,
+  yrep,
+  group,
+  ...,
+  discrete = FALSE,
+  pad = TRUE,
+  size = 0.25,
+  alpha = 0.7
+) {
+  check_ignored_arguments(...)
+
+  p_overlay <- ppc_ecdf_overlay(
+    y = y,
+    yrep = yrep,
+    ...,
+    discrete = discrete,
+    pad = pad,
+    size = size,
+    alpha = alpha
+  )
+
+  # Use + list(data) trick to replace the data in the plot
+  data <- ppc_data(y, yrep, group = group)
+  p_overlay <- p_overlay + list(data)
+
+  p_overlay +
+    facet_wrap("group") +
+    force_axes_in_facets()
+}
+
+
 
 #' @export
 #' @rdname PPC-distributions