---
title: "Plotting Posterior Distributions with `ggdistribute`"
author: "Joseph M. Burling"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{GeomPosterior}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup, include = FALSE, warning=FALSE, message=FALSE}
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%"
)
```

```{r load-and-opts, echo=FALSE, message=FALSE}
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,

```{r load-ggdistribute}
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`.

```{r make-data}
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`.

```{r ex1}
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.

```{r ex2}
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.

```{r ex3, fig.height=6}
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.

```{r ex4}
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.

```{r ex5}
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.

```{r ex6}
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`.

```{r ex-plot-print, fig.width=5, fig.height=3, out.width="100%"}
# 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)
```

```{r other-tests, eval=FALSE, echo=FALSE}
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")
```
