rstudio::conf2019 code

# Code for presentation at rstudio::conf2019 
# Slides:
# https://docs.google.com/presentation/d/1zMuBSADaxdFnosOPWJNA10DaxGEheW6gDxqEPYAuado/edit?usp=sharing

# Setup -------------------------------------------------------------------

library(ggplot2)
library(gganimate)
library(ungeviz)
library(mgcv)
theme_set(theme_bw())

fig.width = 6
fig.asp = 3/4


# HOP intro ---------------------------------------------------------------

fit <- gam(mpg ~ s(disp), data = mtcars, method = "REML")
newdata <- data.frame(disp = scales::fullseq(range(mtcars$disp), diff(range(mtcars$disp))/80))
cb <- confidence_band(fit, newdata = newdata, unconditional = TRUE)

p <- ggplot(mtcars, aes(disp, mpg)) +
  geom_ribbon(data = cb, aes(ymin = lo, ymax = hi), fill = "gray70", alpha = 0.5) +
  geom_point() +
  coord_cartesian(xlim = range(mtcars$disp), ylim = c(8, 34)) +
  geom_line(data = cb, color = "#0072B2", size = 1)
p
ggsave("figures/mtcars-smooth.png", p, width = fig.width, height = fig.asp*fig.width)

p <- ggplot(mtcars, aes(disp, mpg)) +
  #geom_ribbon(data = cb, aes(ymin = lo, ymax = hi), fill = "gray70", alpha = 0.5) +
  geom_point() +
  coord_cartesian(xlim = range(mtcars$disp), ylim = c(8, 34)) +
  stat_smooth_draws(aes(group = stat(.draw)), times = 20, color = "#0072B2", size = 0.2)
p
ggsave("figures/mtcars-smooth-draws.png", p, width = fig.width, height = fig.asp*fig.width)


pa <- ggplot(mtcars, aes(disp, mpg)) +
  geom_point() +
  stat_smooth_draws(aes(group = stat(.draw)), times = 20, color = "#0072B2", size = 0.5) +
  coord_cartesian(xlim = range(mtcars$disp), ylim = c(8, 34)) +
  transition_states(stat(.draw), 0, 1)
pa
anim_save("figures/mtcars-smooth-draws-HOP.gif", pa, width = fig.width, height = fig.asp*fig.width,
          units = "in", res = 150)


# mtcars bootstrap --------------------------------------------------------

p <- 
mtcars %>%
  ggplot(aes(disp, mpg)) +
  geom_point() +
  geom_smooth(
    se = FALSE, color = "#0072B2", size = 0.5
  ) +
  coord_cartesian(xlim = range(mtcars$disp), ylim = c(8, 34))
p
ggsave("figures/mtcars-smooth.png", p, width = fig.width, height = fig.asp*fig.width)


mtcars_bs <- mtcars %>%
  bootstrapify(times = 20, key = ".draw") %>%
  collect()

p <- 
mtcars %>%
  ggplot(aes(disp, mpg)) +
  geom_point() +
  geom_smooth(
    data = mtcars_bs, aes(group = .draw),
    se = FALSE, color = "#0072B2", size = 0.2
  ) +
  coord_cartesian(xlim = range(mtcars$disp), ylim = c(8, 34))
p
ggsave("figures/mtcars-smooth-bootstraps.png", p, width = fig.width, height = fig.asp*fig.width)

pa <- ggplot(mtcars, aes(disp, mpg)) +
  geom_point() +
  geom_smooth(
    data = bootstrapper(20), aes(group = .draw),
    se = FALSE, color = "#0072B2", size = 0.5
  ) +
  coord_cartesian(xlim = range(mtcars$disp), ylim = c(8, 34)) +
  transition_states(.draw, 0, 1) # gganimate
pa
anim_save("figures/mtcars-smooth-bootstraps-HOP.gif", pa, width = fig.width, height = fig.asp*fig.width,
          units = "in", res = 150)


# cacao example -----------------------------------------------------------


library(dplyr)
library(forcats)
library(broom)
library(emmeans)

cacao_lumped <- cacao %>%
  filter(rating < 5) %>% # remove the few cases with a rating of 5
  mutate(
    location = fct_lump(location, n = 6)
  ) %>%
  mutate(
    location = fct_reorder(location, rating, .fun = mean)
  )

cacao_means <- lm(rating ~ location, data = cacao_lumped) %>%
  emmeans("location") %>%
  tidy() %>%
  mutate(location = fct_reorder(location, estimate))

p <- ggplot(cacao_lumped, aes(x = rating, y = location)) +
  geom_point(position = position_jitter(height = 0.3, width = 0.05), size = 0.2, alpha = 1/2) +
  geom_point(data = cacao_means, aes(x = estimate), size = 3, color = "#D55E00") +
  xlab("chocolate bar rating") + ylab(NULL)
p
ggsave("figures/cacao-ratings.png", p, width = fig.width, height = 0.5*fig.width)

pa <- 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.2, alpha = 1/2) +
  geom_vpline(data = sampler(25, group = location), aes(group = .row),
              height = 0.6, color = "#0072B2") +
  transition_states(.draw, 0, 1)

anim_save("figures/cacao-common-language-effect-size-HOP.gif", pa, width = fig.width, height = 0.5*fig.width,
          units = "in", res = 150)



# fitted draws ------------------------------------------------------------


p1 <- ggplot(mtcars, aes(disp, mpg)) +
  geom_point() +
  geom_smooth(
    data = bootstrapper(10), aes(group = .draw),
    se = FALSE, color = "#0072B2", size = 0.2
  ) +
  coord_cartesian(xlim = range(mtcars$disp), ylim = c(8, 34))
  
p2 <- ggplot(mtcars, aes(disp, mpg)) +
  geom_point() +
  stat_smooth_draws(
    times = 10, aes(group = stat(.draw)),
    color = "#0072B2", size = 0.2
  ) +
  coord_cartesian(xlim = range(mtcars$disp), ylim = c(8, 34))

p <- cowplot::plot_grid(p1, p2, nrow = 1)

ggsave("figures/mtcars-bs-fitted-draws.png", p, width = 2*fig.width, height = fig.asp*fig.width)

set.seed(1234)

pa <- ggplot(mtcars, aes(disp, mpg)) +
  geom_point() +
  stat_smooth_draws(
    times = 20, aes(group = stat(.draw)),
    color = "#0072B2", size = 0.5
  ) +
  coord_cartesian(xlim = range(mtcars$disp), ylim = c(8, 34)) +
  transition_states(stat(.draw), 0, 1) # gganimate
pa

anim_save("figures/mtcars-fitted-draws-HOP.gif", pa, width = fig.width, height = fig.asp*fig.width,
          units = "in", res = 150)



# Design choices ----------------------------------------------------------

set.seed(1234)
pa <- ggplot(mtcars, aes(disp, mpg)) +
  geom_point() +
  stat_smooth_draws(
    times = 20, aes(group = stat(.draw)),
    color = "#0072B2", size = 0.5
  ) +
  coord_cartesian(xlim = range(mtcars$disp), ylim = c(8, 34)) +
  transition_states(stat(.draw), 0, 1) +
  shadow_mark(future = TRUE, color = "gray70", size = 0.2)
pa

anim_save("figures/mtcars-fitted-draws-HOP-w-ensemble.gif", pa, width = fig.width, height = fig.asp*fig.width,
          units = "in", res = 150)

set.seed(1234)
pa <- ggplot(mtcars, aes(disp, mpg)) +
  geom_point() +
  stat_smooth_draws(
    times = 20,
    aes(group = stat(.draw)),
    color = "#0072B2", size = 0.5
  ) +
  coord_cartesian(xlim = range(mtcars$disp), ylim = c(8, 34)) +
  transition_states(stat(.draw), 1, 2) +
  enter_fade() + exit_fade()
pa

anim_save("figures/mtcars-fitted-draws-HOP-fade.gif", pa, width = fig.width, height = fig.asp*fig.width,
          units = "in", res = 150)

set.seed(1234)
pa <- ggplot(mtcars, aes(disp, mpg)) +
  geom_point() +
  stat_smooth_draws(
    times = 20,
    color = "#0072B2", size = 0.5
  ) +
  coord_cartesian(xlim = range(mtcars$disp), ylim = c(8, 34)) +
  transition_states(stat(.draw), 1, 2)
pa

anim_save("figures/mtcars-fitted-draws-HOP-transform.gif", pa, width = fig.width, height = fig.asp*fig.width,
          units = "in", res = 150)



# bootstrap example -------------------------------------------------------

set.seed(69527)

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

# bootstrapper object
bsr <- bootstrapper(10)

pa <- 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 = "#0072B2") +
  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, color = "#0072B2") +
  transition_states(.draw, 1, 2) +
  enter_fade() + exit_fade()

pa

anim_save("figures/bootstrap-example-HOP.gif", pa, width = fig.width, height = fig.asp*fig.width,
          units = "in", res = 150)