Plotting Posterior Distributions with `ggdistribute`
In ggdistribute: A 'ggplot2' Extension for Plotting Unimodal Distributions

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  strip.white = FALSE,
  tidy = FALSE,
  fig.align = "center",
  dpi = 300,
  fig.width = 5.25,
  fig.height = 3.8,
  out.width = "90%"
)

library(ggplot2)
theme_set(theme_gray(10))

Introduction

The ggdistribute package is an extension for plotting posterior or other types of unimodal distributions that require overlaying information about a distribution's intervals. It makes use of the ggproto system to extend ggplot2, providing additional "geoms", "stats", and "positions." The extensions integrate with existing ggplot2 layer elements.

To load the package to access the exported ggplot2 extensions, do the following,

library(ggdistribute)

The data object below is a randomly generated dataset of 5 different normal distributions. Two factors Condition and Group are assigned according to the generated values. 1000 samples are generated for each value of mu.

data <- data_normal_sample(mu = c(-1, 0, 2, 5, 10), n = 1000)

Extensions passed to `ggplot2::layer`

`geom_posterior(...)`, `GeomPosterior`

This is the main function wrapper to generate the posterior distribution grobs. See help("geom_posterior") for a list of options passed to the ggproto object GeomPosterior. The geom_posterior() function with no arguments and no y aesthetic defaults to estimating the normalized density (integerates to 1) times the number of data points. This is the same as aes(y = ..count..) with geom_posterior.

b_cond <- data[data$Condition == "B", ]

ggplot(b_cond, aes(x = value))+
  geom_posterior()

If y is discrete, the densities are justified at the bottom of the y value.

ggplot(data, aes(x = value, y = Condition))+
  geom_posterior()

Mirroring can be turned on to generate densities similar to geom_violin, and geom_posterior can be used like other geoms in ggplot2, like specifying facetting.

ggplot(data, aes(x = value, y = Condition))+
  geom_posterior(mirror = TRUE)+
  facet_grid(Group~., scales = "free_y")

`stat_density_ci(...)`, `StatDensityCI`

The StatDensityCI class is the default stat for the geom_posterior wrapper. It computes densities for each group and finds the confidence intervals. See help("stat_density_ci") for additional options and computed variables.

ggplot(data, aes(x = value, y = Condition)) +
  stat_density_ci(n = 1024, interp_thresh = .001)

The stat_density_ci wrapper can also be used with other geoms that make use of density, count, and scaled variables.

ggplot(data, aes(x = value, y = ..density.., fill = Condition)) +
  stat_density_ci(
    alpha = 0.5,
    n = 1024,
    geom = "density",
    position = "identity"
  )

`position_spread(...)`, `PositionSpread`

The PositionSpread class spreads out overlapping densities within the range of their y axis value. For instance, there are two different groups for Condition A-D, but only one group in E. Distributions within each Condition are resized and spread over the group's y interval. Padding is turned off below to see where distributions begin and end.

data$Group[data$Condition == "E"] <- "z"

ggplot(data, aes(x = value, y = Condition, group = Group)) +
  geom_posterior(position = position_spread(padding = 0)) +
  theme(panel.grid.major.y = element_line(color = gray(.8)))

Extended example

The package function example_plot() is an overview of combining ggdistribute with other ggplot2 elements. The contents of this function are printed below and gives details about the extended parts to ggplot2.

# color palette
colors <- mejr_palette()

plt <- 
  ggplot(sre_data(5000), 
  aes(y=effect)) +
  # ggdistribute specific elements -------------------------------------------
  geom_posterior(
    # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    # geom_posterior() aesthetics mappings
    # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    aes(x=value, fill=contrast),
    # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    # options passed to stat_density_ci() for estimating intervals
    # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    interp_thresh=.001, # threshold for interpolating segment gaps
    center_stat="median", # measure of central tendency
    ci_width=0.90, # width corresponding to CI segments
    interval_type="ci", # quantile intervals not highest density interval
    # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    # options passed to stat_density_ci() for estimating density
    # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    bw=".nrd0", # bandwidth estimator type
    adjust=1.5, # adjustment to bandwidth
    n=1024, # number of samples in final density
    trim=.005, # trim `x` this proportion before estimating density
    cut=1.5, # tail extension for zero density estimation
    # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    # geom_posterior() options
    # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    draw_ci=TRUE, # toggle showing confidence interval parts
    draw_sd=TRUE, # toggle showing standard deviation parts
    mirror=FALSE, # toggle horizontal violin distributions
    midline=NULL, # line displaying center of dist. (NULL=aes color)
    brighten=c(3, 0, 1.333), # additive adjustment of segment fill colors
    # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    # position_spread() options
    # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    position=position_spread(
      reverse=TRUE, # order of spreaded groups within panels
      padding=0.3, # shrink heights of distributions
      height="panel" # scale by heights within panels
    ), #
    # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    # standard ggplot layer options
    # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    size=0.15, color=colors$gray, vjust=0.7, show.legend=FALSE
  ) +
  # standard ggplot2 elements ------------------------------------------------
  geom_vline(alpha=0.5, color=colors$gray, size=0.333, linetype=1, xintercept=0) +
  scale_x_continuous(breaks=seq(-1, 1, .05)) +
  facet_grid("contrast ~ .", scales="free_y", space="free_y") +
  scale_fill_manual(values=c(colors$yellow, colors$magenta, colors$cyan)) +
  labs(x="Difference in accuracy (posterior predictions)") +
  theme(
    legend.position="none", strip.text.y=element_text(angle=0, hjust=0.5),
    panel.border=element_rect(fill=NA, color=colors$lightgray, size=0.67),
    panel.grid=element_blank(), panel.ontop=FALSE, axis.title.y=element_blank(),
    plot.margin=margin(t=2, r=4, b=2, l=2, unit="pt")
  )

plot(plt)

library(ggplot2)

# other visual inspections
dt <- ggdistribute:::ggdist_data(1000, j = 5)

ggplot(dt) + aes(x = value) +
  geom_posterior(n = 512, interp_thresh = .001) + labs(title = "no y")

ggplot(dt) + aes(x = value, y = 10) +
  geom_posterior(n = 512, interp_thresh = .001) + labs(title = "scalar y")

ggplot(dt) + aes(x = value, y = j_discrete) +
  geom_posterior(n = 512, interp_thresh = .001) + labs(title = "char y")

ggplot(dt) + aes(x = value, y = j_discrete, group = k_discrete) +
  geom_posterior(n = 512, interp_thresh = .001) +
  labs(title = "char y, w/ group")

ggplot(dt) + aes(x = value, y = k_discrete) +
  geom_posterior(n = 512, interp_thresh = .001, aes(group = j_discrete)) +
  labs(title = "char y, w/ group switched")

ggplot(dt) + aes(x = value) +
  geom_posterior(n = 512, interp_thresh = .001, aes(group = j_discrete)) +
  labs(title = "no y, w/ group")

ggplot(dt) + aes(x = value, y = j_discrete) +
  geom_posterior(n = 512, interp_thresh = .001, aes(group = j_discrete)) +
  labs(title = "char y, w/ same y group")

ggplot(dt) + aes(x = value, y = j_discrete) +
  geom_posterior(n = 512, interp_thresh = .001, aes(fill = k_discrete)) +
  labs(title = "char y, w/ diff group")

ggplot(dt) + aes(x = value, y = I) +
  geom_posterior(n = 512, interp_thresh = .001, aes(group = j_discrete)) +
  labs(title = "integer y, w/ group")

ggplot(dt) + aes(x = value, y = j_discrete) +
  geom_posterior(
    n = 512, interp_thresh = .001,
    position = position_spread(height = 20)) +
  labs(title = "manual height, w/ group")

ggplot(dt) + aes(x = value, y = variable) +
  geom_posterior(
    n = 512, interp_thresh = .001,
    mirror = TRUE, aes(group = j_discrete)) +
  labs(title = "cont. y, w/ group, mirrored")

ggplot(dt) + aes(x = value, y = variable * 10) +
  geom_posterior(
    n = 512, interp_thresh = .001, mirror = TRUE,
    aes(group = j_discrete)) + facet_wrap(~k_discrete) +
  labs(title = "cont. y, w/ group, wrap, mirrored")

dt$k[dt$j == 1 & dt$k == 2] <- NA

ggplot(dt) + aes(x = value, y = j_discrete, group = k_discrete) +
  geom_posterior(n = 512, interp_thresh = .001) +
  facet_grid(j_discrete ~ ., scales = "free_y") +
  labs(title = "char y, w/ group, grid, missing group")

ggplot(dt) + aes(x = value, group = k_discrete) +
  geom_posterior(n = 512, interp_thresh = .001) +
  facet_grid(j_discrete ~ ., scales = "free_y") +
  labs(title = "no y, w/ group, grid, missing group")