Skip to content

Instantly share code, notes, and snippets.

@clauswilke

clauswilke/rstudio::conf2019 code

Created January 18, 2019 03:38
Show Gist options
  • Save clauswilke/423644418adfe83ad7f07cdc384cb17b to your computer and use it in GitHub Desktop.
Save clauswilke/423644418adfe83ad7f07cdc384cb17b to your computer and use it in GitHub Desktop.
Download ZIP
Raw
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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment