In clauswilke/ungeviz: Tools for visualizing uncertainty with ggplot2

knitr::opts_chunk$set(
  collapse = TRUE,
  fig.width = 5,
  fig.asp = 3/4,
  comment = "#>"
)

set.seed(5743)

animate = FALSE
animate = TRUE # uncomment to build animated plots

The functions sampler() and bootstrapper() generate sampling and bootstrapping objects that are useful in ggplot2 layers. They are meant to sample from data frames and/or bootstrap sample frames.

Sampling from data frames

Both sampler() and bootstrapper() return functions that can be applied to data frames to carry out the sampling or bootstrapping. The benefit of using these generated functions is that we can reproducibly sample or bootstrap multiple times. As an exampe of this concept, assume we want to sample three times two rows each (without replacement) from a data frame that holds one row for each letter in the alphabet.

library(ungeviz)

# sampling object that samples 3 times a sample of size 2
spl <- sampler(times = 3, size = 2)

# input data frame
df <- data.frame(letter = letters, number = 1:26)
head(df)

# resample the data frame
spl(df)

# repeated application of the same sampler object produces the same sample
spl(df)

We see that repeated sampling produces the exact same output. We also see that the sampling adds four data columns, called .draw, .id, .original_id, and .row. These provide information about the sampled rows. .draw identifies the repeated draws, .id identifies individual data row within each repeated draw, .original_id identifies the data row from which a sampled row originates, and .row simply counts all rows in the final data frame. All these additional columns can be useful in conjunction with gganimate.

Sampling without replacement is the default. If we want to sample with replacement, we can set the replace argument to TRUE.

# sampling object that samples once a sample of size 5 with replacement
spl <- sampler(times = 1, size = 5, replace = TRUE)

# input data frame
df <- data.frame(letter = letters[1:4], number = 1:4)
df

# resample the data frame
spl(df)

For both sampling and bootstrapping, we can specify groups to sample from or to bootstrap. This can be done either by using the group argument or by applying the sampler or bootstrapper object on a grouped tibble.

library(dplyr)

set.seed(1234)

df <- data.frame(
  type = c(rep("A", 100), rep("B", 10), rep("C", 3)),
  y = rnorm(113)
)
head(df)

# sample without considering any grouping
sampler(2, 2, seed = 123)(df)

# sample within groups defined by `type` column
sampler(2, 2, group = type, seed = 123)(df)

# sample within groups defined by `type` column
group_by(df, type) %>% sampler(2, 2, seed = 123)()

Now let's make a hypothetical outcome plot (HOP). We will use the cacao dataset, which contains ratings for chocolate bars from manufacturers in many different locations. Let's make a plot that shows the ratings of randomly drawn pairs of chocolate bars, one from a U.S. manufacturer and one from a Canadian manufacturer. The trick to doing this is to use the appropriate sampler object as the data argument to a layer in ggplot2. This trick makes use of the ggplot2 feature that if data is a function then this function is used to modify the main dataset of the plot for this layer.

library(ggplot2)
library(gganimate)

cacao %>% filter(location %in% c("Canada", "U.S.A.")) %>%
  ggplot(aes(rating, location)) +
  geom_point(
    position = position_jitter(height = 0.3, width = 0.05), 
    size = 0.4, color = "#0072B2", alpha = 1/2
  ) +
  geom_vpline(data = sampler(25, group = location), height = 0.6, color = "#D55E00") +
  theme_bw() + 
  transition_states(.draw, 1, 3)

By default, gganimate shows the vertical bars sliding from one position to another. If instead we want the bars to disappear and reappear, we need to tell gganimate that it should consider them to be different. We do this by setting the group aesthetic of the vpline layer to .row. Since .row simply counts all rows in the sampled data frame, this group setting guarantees that gganimate thinks of all vertical bars as independent objects.

cacao %>% filter(location %in% c("Canada", "U.S.A.")) %>%
  ggplot(aes(rating, location)) +
  geom_point(
    position = position_jitter(height = 0.3, width = 0.05), 
    size = 0.4, color = "#0072B2", alpha = 1/2
  ) +
  geom_vpline(
    data = sampler(25, group = location),
    aes(group = .row), # here is where we set the group aesthetic for vertical bars
    height = 0.6, color = "#D55E00"
  ) +
  theme_bw() + 
  transition_states(.draw, 1, 3) +
  enter_fade() + exit_fade() # smooth enter and exit

Bootstrapping data frames

Bootstrapper objects work just like sampler objects. A bootstrapper can be thought of as a special case of a sampler where sampling is done with replacement and the sample size is the group size.

# bootstrapper object that bootstraps 2 times
bsr <- bootstrapper(times = 2)

# input data frame
df <- data.frame(letter = letters[1:4], number = 1:4)
head(df)

# bootstrap the data frame
bsr(df)

The columns .draw, .id, .original_id, and .row are the same as generated by a sampler. The column .copies represents the number of times each original id appears in a bootstrapped draw.

The .copies column is useful if we want to make a bootstrap demonstration that shows how often individual data points are oversampled. In this example, we use geom_text() to plot the copy number of each duplicated point. We also take advantage of the fact that a bootstrapper can be used multiple times with identical results, and hand it as the data argument to multiple layers.

set.seed(69527)

# randomly generate dataset
x <- rnorm(15)
df <- data.frame(x, y = x + 0.5*rnorm(15))

# bootstrapper object
bsr <- bootstrapper(10)

ggplot(df, aes(x, y)) +
  geom_point(shape = 21, size = 6, fill = "white") +
  geom_text(label = "0", hjust = 0.5, vjust = 0.5, size = 10/.pt) +
  geom_point(data = bsr, aes(group = .row), shape = 21, size = 6, fill = "blue") +
  geom_text(data = bsr, aes(label = .copies, group = .row), hjust = 0.5, vjust = 0.5, size = 10/.pt, color = "white") +
  geom_smooth(data = bsr, aes(group = .draw), method = "lm", se = FALSE) +
  ggtitle("Bootstrap demonstration") +
  theme_bw() + 
  transition_states(.draw, 1, 2) +
  enter_fade() + exit_fade()