inst/doc/geom_posterior.R

In ggdistribute: A 'ggplot2' Extension for Plotting Unimodal Distributions

## ----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%"
)

## ----load-and-opts, echo=FALSE, message=FALSE----------------------------
library(ggplot2)
theme_set(theme_gray(10))

## ----load-ggdistribute---------------------------------------------------
library(ggdistribute)

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

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

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

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

## ----ex3, fig.height=6---------------------------------------------------
ggplot(data, aes(x = value, y = Condition))+
  geom_posterior(mirror = TRUE)+
  facet_grid(Group~., scales = "free_y")

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

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

## ----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)))

## ----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)

## ----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")