add quantile dot plot functions

DESCRIPTION

@@ -41,6 +41,7 @@ Imports:
     tidyselect,
     utils
 Suggests:
+    ggdist,
     ggfortify,
     gridExtra (>= 2.2.1),
     hexbin,

R/ppc-distributions.R

@@ -15,7 +15,7 @@
 #' @template args-pit-ecdf
 #' @param size,alpha Passed to the appropriate geom to control the appearance of
 #'   the predictive distributions.
-#' @param ... Currently unused.
+#' @param ... For dot plots, optional additional arguments to pass to [ggdist::stat_dots()].
 #'
 #' @template details-binomial
 #' @template return-ggplot-or-data
@@ -28,6 +28,11 @@
 #'    dataset (row) in `yrep`. For these plots `yrep` should therefore
 #'    contain only a small number of rows. See the **Examples** section.
 #'   }
+#'   \item{`ppc_qdotplot()`}{
+#'    A dot plot plot is displayed for `y` and each dataset (row) in `yrep`.
+#'    For these plots `yrep` should therefore contain only a small number of rows.
+#'    See the **Examples** section. This function requires [ggdist::stat_dots] to be installed.
+#'    }
 #'   \item{`ppc_freqpoly_grouped()`}{
 #'    A separate frequency polygon is plotted for each level of a grouping
 #'    variable for `y` and each dataset (row) in `yrep`. For this plot
@@ -80,7 +85,7 @@
 #' ppc_pit_ecdf(y, yrep, prob = 0.99, plot_diff = TRUE)
 #' }
 #'
-#' # for ppc_hist,dens,freqpoly,boxplot definitely use a subset yrep rows so
+#' # for ppc_hist,dens,freqpoly,boxplot,qdotplot definitely use a subset yrep rows so
 #' # only a few (instead of nrow(yrep)) histograms are plotted
 #' ppc_hist(y, yrep[1:8, ])
 #' \donttest{
@@ -90,6 +95,9 @@
 #' # wizard hat plot
 #' color_scheme_set("blue")
 #' ppc_dens(y, yrep[200:202, ])
+#'
+#' # dot plot
+#' ppc_qdotplot(y, yrep[1:8, ])
 #' }
 #'
 #' \donttest{
@@ -507,6 +515,45 @@ ppc_boxplot <-
       xaxis_title(FALSE)
   }
 
+#' @rdname PPC-distributions
+#' @export
+#' @template args-qdotplot
+ppc_qdotplot <-
+  function(y,
+           yrep,
+           ...,
+           binwidth = NA,
+           quantiles = NA,
+           freq = TRUE) {
+    check_ignored_arguments(..., ok_args = c("dotsize", "layout", "stackratio", "overflow"))
+
+    suggested_package("ggdist")
+
+    data <- ppc_data(y, yrep)
+
+    ggplot(data, mapping = set_hist_aes(
+      freq = freq,
+      fill = .data$is_y_label,
+      color = .data$is_y_label
+    )) +
+      ggdist::stat_dots(
+        binwidth = binwidth,
+        quantiles = quantiles,
+        ...
+      ) +
+      scale_fill_ppc() +
+      scale_color_ppc() +
+      facet_wrap_parsed("rep_label") +
+      force_axes_in_facets() +
+      bayesplot_theme_get() +
+      space_legend_keys() +
+      yaxis_text(FALSE) +
+      yaxis_title(FALSE) +
+      yaxis_ticks(FALSE) +
+      xaxis_title(FALSE) +
+      facet_text(FALSE) +
+      facet_bg(FALSE)
+  }
 
 #' @rdname PPC-distributions
 #' @export

R/ppd-distributions.R

@@ -187,6 +187,43 @@ ppd_hist <-
       facet_text(FALSE)
   }
 
+#' @rdname PPD-distributions
+#' @export
+ppd_qdotplot <-
+  function(ypred,
+           ...,
+           binwidth = NA,
+           quantiles = NA,
+           freq = TRUE) {
+    check_ignored_arguments(..., ok_args = c("dotsize", "layout", "stackratio", "overflow"))
+
+    suggested_package("ggdist")
+
+    data <- ppd_data(ypred)
+    ggplot(data, mapping = set_hist_aes(
+      freq,
+      color = "ypred",
+      fill = "ypred"
+    )) +
+      ggdist::stat_dots(
+        binwidth = binwidth,
+        quantiles = quantiles,
+        ...
+      ) +
+      scale_color_ppd() +
+      scale_fill_ppd() +
+      bayesplot_theme_get() +
+      facet_wrap_parsed("rep_label") +
+      force_axes_in_facets() +
+      dont_expand_y_axis() +
+      legend_none() +
+      yaxis_text(FALSE) +
+      yaxis_title(FALSE) +
+      yaxis_ticks(FALSE) +
+      xaxis_title(FALSE) +
+      facet_text(FALSE)
+  }
+
 
 #' @rdname PPD-distributions
 #' @export

man-roxygen/args-qdotplot.R

@@ -0,0 +1,4 @@
+#' @param quantiles For dot plots, an optional integer passed to
+#'   [ggdist::stat_dots()] specifying the number of quantiles to use for a
+#'   quantile dot plot. If `quantiles` is `NA` (the default) then all data
+#'   points are plotted.

tests/testthat/test-ppc-distributions.R

@@ -58,6 +58,22 @@ test_that("ppc_dens,pp_hist,ppc_freqpoly,ppc_boxplot return ggplot objects", {
   expect_gg(ppd_boxplot(yrep2, notch = FALSE))
 })
 
+test_that("ppc_qdotplot returns a ggplot object", {
+  testthat::skip_if_not_installed("ggdist")
+
+  expect_gg(ppc_qdotplot(y, yrep[1:8, ]))
+  expect_gg(ppc_qdotplot(y, yrep[1,, drop = FALSE], quantiles = 25))
+  expect_gg(ppc_qdotplot(y, yrep[1:8, ], binwidth = 0.1))
+  expect_gg(ppc_qdotplot(y2, yrep2, binwidth = 0.1, quantiles = 25))
+
+  # ppd versions
+  expect_gg(ppd_qdotplot(yrep[1:8, ]))
+  expect_gg(ppd_qdotplot(yrep[1,, drop = FALSE], quantiles = 25))
+  expect_gg(ppd_qdotplot(yrep[1:8, ], binwidth = 0.1))
+  expect_gg(ppd_qdotplot(yrep2, binwidth = 0.1, quantiles = 25))
+
+})
+
 test_that("ppc_pit_ecdf, ppc_pit_ecdf_grouped returns a ggplot object", {
   expect_gg(ppc_pit_ecdf(y, yrep, interpolate_adj = FALSE))
   expect_gg(ppc_pit_ecdf_grouped(y, yrep, group = group, interpolate_adj = FALSE))
@@ -177,6 +193,42 @@ test_that("ppc_boxplot renders correctly", {
   vdiffr::expect_doppelganger("ppd_boxplot (alpha, size)", p_custom)
 })
 
+test_that("ppc_qdotplot renders correctly", {
+  testthat::skip_on_cran()
+  testthat::skip_if_not_installed("vdiffr")
+  testthat::skip_if_not_installed("ggdist")
+  skip_on_r_oldrel()
+
+  p_base <- ppc_qdotplot(vdiff_y, vdiff_yrep[1:8, ])
+  vdiffr::expect_doppelganger("ppc_qdotplot (default)", p_base)
+
+  p_binwidth <- ppc_qdotplot(vdiff_y, vdiff_yrep[1:8, ], binwidth = 3)
+  expect_warning(vdiffr::expect_doppelganger("ppc_qdotplot (binwidth)", p_binwidth),
+                 "The provided binwidth will cause dots to overflow the boundaries of the geometry.")
+
+  p_quantile <- ppc_qdotplot(vdiff_y, vdiff_yrep[1:8, ], quantiles = 50)
+  vdiffr::expect_doppelganger("ppc_qdotplot (quantile)", p_quantile)
+
+  p_quantile_binwidth <- ppc_qdotplot(vdiff_y, vdiff_yrep[1:8, ], binwidth = 3, quantiles = 50)
+  expect_warning(vdiffr::expect_doppelganger("ppc_qdotplot (quantile-binwidth)", p_quantile_binwidth),
+                 "The provided binwidth will cause dots to overflow the boundaries of the geometry.")
+
+  # ppd versions
+  p_base <- ppd_qdotplot(vdiff_yrep[1:8, ])
+  vdiffr::expect_doppelganger("ppd_qdotplot (default)", p_base)
+
+  p_binwidth <- ppd_qdotplot(vdiff_yrep[1:8, ], binwidth = 3)
+  expect_warning(vdiffr::expect_doppelganger("ppd_qdotplot (binwidth)", p_binwidth),
+                 "The provided binwidth will cause dots to overflow the boundaries of the geometry.")
+
+  p_quantile <- ppd_qdotplot(vdiff_yrep[1:8, ], quantiles = 50)
+  vdiffr::expect_doppelganger("ppd_qdotplot (quantile)", p_quantile)
+
+  p_quantile_binwidth <- ppd_qdotplot(vdiff_yrep[1:8, ], binwidth = 3, quantiles = 50)
+  expect_warning(vdiffr::expect_doppelganger("ppd_qdotplot (quantile-binwidth)", p_quantile_binwidth),
+                 "The provided binwidth will cause dots to overflow the boundaries of the geometry.")
+})
+
 test_that("ppc_ecdf_overlay renders correctly", {
   testthat::skip_on_cran()
   testthat::skip_if_not_installed("vdiffr")