Merge pull request #402 from stan-dev/mcmc_dots

adding `mcmc_dots` and `mcmc_dots_by_chain` functions

Author: jgabry

NAMESPACE

@@ -74,6 +74,8 @@ export(mcmc_dens)
 export(mcmc_dens_chains)
 export(mcmc_dens_chains_data)
 export(mcmc_dens_overlay)
+export(mcmc_dots)
+export(mcmc_dots_by_chain)
 export(mcmc_hex)
 export(mcmc_hist)
 export(mcmc_hist_by_chain)

NEWS.md

@@ -1,5 +1,8 @@
 # bayesplot (development version)
 
+* New functions `mcmc_dots` and `mcmc_dots_by_chain` for dot plots of MCMC draws by @behramulukir (#402)
+* Default to `quantiles=100` for all dot plots by @behramulukir (#402)
+
 # bayesplot 1.15.0
 
 * Add `shape` argument to `mcmc_scatter` by @behramulukir (#375)

R/mcmc-distributions.R

@@ -12,7 +12,7 @@
 #' @template args-transformations
 #' @template args-facet_args
 #' @template args-density-controls
-#' @param ... Currently ignored.
+#' @param ... For dot plots, optional additional arguments to pass to [ggdist::stat_dots()].
 #' @param alpha Passed to the geom to control the transparency.
 #'
 #' @template return-ggplot
@@ -25,13 +25,19 @@
 #'   \item{`mcmc_dens()`}{
 #'    Kernel density plots of posterior draws with all chains merged.
 #'   }
+#'   \item{`mcmc_dots()`}{
+#'   Dot plots of posterior draws with all chains merged.
+#'   }
 #'   \item{`mcmc_hist_by_chain()`}{
 #'    Histograms of posterior draws with chains separated via faceting.
 #'   }
 #'   \item{`mcmc_dens_overlay()`}{
 #'    Kernel density plots of posterior draws with chains separated but
 #'    overlaid on a single plot.
 #'   }
+#'   \item{`mcmc_dots_by_chain()`}{
+#'   Dot plots of posterior draws with chains separated via faceting.
+#'   }
 #'   \item{`mcmc_violin()`}{
 #'    The density estimate of each chain is plotted as a violin with
 #'    horizontal lines at notable quantiles.
@@ -77,14 +83,14 @@
 #' mcmc_hist(x, transformations = list(sigma = log))
 #'
 #' # separate histograms by chain
-#' color_scheme_set("pink")
+#' color_scheme_set("orange")
 #' mcmc_hist_by_chain(x, regex_pars = "beta")
 #' }
 #'
 #' #################
 #' ### Densities ###
 #' #################
-#'
+#' color_scheme_set("purple")
 #' mcmc_dens(x, pars = c("sigma", "beta[2]"),
 #'           facet_args = list(nrow = 2))
 #' \donttest{
@@ -98,7 +104,26 @@
 #' }
 #' # separate chains as violin plots
 #' color_scheme_set("green")
-#' mcmc_violin(x) + panel_bg(color = "gray20", size = 2, fill = "gray30")
+#' mcmc_violin(x) + panel_bg(color = "gray20", linewidth = 2, fill = "gray30")
+#'
+#'
+#' #################
+#' ### Dot Plots ###
+#' #################
+#'
+#' # dot plots of some parameters
+#' color_scheme_set("pink")
+#' mcmc_dots(x, pars = c("alpha", "beta[2]"))
+#'
+#' \donttest{
+#' color_scheme_set("teal")
+#' # separate dot plots by chain
+#' mcmc_dots_by_chain(x, regex_pars = "beta")
+#'
+#' # custom facet labels (will change row labels to e.g. "Chain: 1" instead of just "1")
+#' chain_labeller <- ggplot2::labeller(.rows = ggplot2::label_both)
+#' mcmc_dots_by_chain(x, regex_pars = "beta", facet_args = list(labeller = chain_labeller))
+#' }
 #'
 NULL
 
@@ -371,7 +396,67 @@ mcmc_violin <- function(
   )
 }
 
+#' @rdname MCMC-distributions
+#' @export
+#' @template args-dots
+mcmc_dots <- function(
+    x,
+    pars = character(),
+    regex_pars = character(),
+    transformations = list(),
+    ...,
+    facet_args = list(),
+    binwidth = NA,
+    alpha = 1,
+    quantiles = 100
+) {
+  check_ignored_arguments(..., ok_args = c("dotsize", "layout", "stackratio", "overflow"))
+
+  suggested_package("ggdist")
 
+  .mcmc_dots(
+    x,
+    pars = pars,
+    regex_pars = regex_pars,
+    transformations = transformations,
+    binwidth = binwidth,
+    facet_args = facet_args,
+    alpha = alpha,
+    quantiles = quantiles,
+    ...
+  )
+}
+
+#' @rdname MCMC-distributions
+#' @export
+mcmc_dots_by_chain <- function(
+    x,
+    pars = character(),
+    regex_pars = character(),
+    transformations = list(),
+    ...,
+    facet_args = list(),
+    binwidth = NA,
+    alpha = 1,
+    quantiles = 100
+) {
+  check_ignored_arguments(..., ok_args = c("dotsize", "layout", "stackratio", "overflow"))
+
+  suggested_package("ggdist")
+
+  .mcmc_dots(
+    x,
+    pars = pars,
+    regex_pars = regex_pars,
+    transformations = transformations,
+    binwidth = binwidth,
+    facet_args = facet_args,
+    by_chain = TRUE,
+    alpha = alpha,
+    quantiles = quantiles,
+    ...
+  )
+}
 
 
 # internal -----------------------------------------------------------------
@@ -558,3 +643,65 @@ mcmc_violin <- function(
     yaxis_title(on = n_param == 1 && violin) +
     xaxis_title(on = n_param == 1)
 }
+
+
+.mcmc_dots <- function(
+    x,
+    pars = character(),
+    regex_pars = character(),
+    transformations = list(),
+    facet_args = list(),
+    binwidth = NA,
+    by_chain = FALSE,
+    alpha = 1,
+    quantiles = NA,
+    ...
+) {
+  x <- prepare_mcmc_array(x, pars, regex_pars, transformations)
+
+  if (by_chain && !has_multiple_chains(x)) {
+    STOP_need_multiple_chains()
+  }
+
+  data <- melt_mcmc(x, value.name = "value")
+  n_param <- num_params(data)
+
+  graph <- ggplot(data, aes(x = .data$value)) +
+    ggdist::stat_dots(
+      binwidth = binwidth,
+      quantiles = quantiles,
+      fill = get_color("mid"),
+      color = get_color("mid_highlight"),
+      alpha = alpha,
+      ...
+    )
+
+  facet_args[["scales"]] <- facet_args[["scales"]] %||% "free"
+  if (!by_chain) {
+    if (n_param > 1) {
+      facet_args[["facets"]] <- vars(.data$Parameter)
+      graph <- graph + do.call("facet_wrap", facet_args)
+    }
+  } else {
+    facet_args[["rows"]] <- vars(.data$Chain)
+    if (n_param > 1) {
+      facet_args[["cols"]] <- vars(.data$Parameter)
+    }
+    graph <- graph +
+      do.call("facet_grid", facet_args) +
+      force_x_axis_in_facets()
+  }
+
+  if (n_param == 1) {
+    graph <- graph + xlab(levels(data$Parameter))
+  }
+
+  graph +
+    dont_expand_y_axis(c(0.005, 0)) +
+    bayesplot_theme_get() +
+    yaxis_text(FALSE) +
+    yaxis_title(FALSE) +
+    yaxis_ticks(FALSE) +
+    theme(axis.line.y = element_blank()) +
+    xaxis_title(on = n_param == 1)
+}

R/ppc-distributions.R

@@ -532,7 +532,7 @@ ppc_dots <-
            yrep,
            ...,
            binwidth = NA,
-           quantiles = NA,
+           quantiles = 100,
            freq = TRUE) {
     check_ignored_arguments(..., ok_args = c("dotsize", "layout", "stackratio", "overflow"))
 

R/ppd-distributions.R

@@ -199,7 +199,7 @@ ppd_dots <-
   function(ypred,
            ...,
            binwidth = NA,
-           quantiles = NA,
+           quantiles = 100,
            freq = TRUE) {
     check_ignored_arguments(..., ok_args = c("dotsize", "layout", "stackratio", "overflow"))
 

man-roxygen/args-dots.R

@@ -1,4 +1,5 @@
 #' @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.
+#'   quantile dot plot. If `quantiles` is `NA` then all data points are plotted.
+#'   The default is `quantiles=100` so that each dot represent one percent of
+#'   posterior mass.