Visualizing uncertainty with hypothetical outcome plots (HOPs)
@clauswilke
clauswilke
Best fit + confidence band
Fitted draws
Hypothetical Outcome Plot (HOP)
Hullman J, Resnick P, Adar E (2015)
PLoS ONE 10: e0142444.
Hadley’s challenge poses three questions
Is there anything to be done?
Problem solved!
How do we generate outcomes?
How do we generate outcomes?
How do we generate outcomes?
Bootstrapping is going to be super easy
iris %>% group_by(Species) %>% bootstrapify(5)
coming to rsample, thanks to Davis Vaughan
Bootstrapping is going to be super easy
iris %>% group_by(Species) %>% bootstrapify(5)
#> # A tibble: 150 x 5
#> # Groups: Species, .bootstrap [15]
#> Sepal.Length Sepal.Width Petal.Length Petal.Width Species
#> <dbl> <dbl> <dbl> <dbl> <fct>
#> 1 5.1 3.5 1.4 0.2 setosa
#> 2 4.9 3 1.4 0.2 setosa
#> 3 4.7 3.2 1.3 0.2 setosa
#> 4 4.6 3.1 1.5 0.2 setosa
#> 5 5 3.6 1.4 0.2 setosa
#> 6 5.4 3.9 1.7 0.4 setosa
#> 7 4.6 3.4 1.4 0.3 setosa
#> 8 5 3.4 1.5 0.2 setosa
#> 9 4.4 2.9 1.4 0.2 setosa
#> 10 4.9 3.1 1.5 0.1 setosa
#> # ... with 140 more rows
coming to rsample, thanks to Davis Vaughan
Bootstrapping is going to be super easy
iris %>% group_by(Species) %>% bootstrapify(5) %>%
summarize(mean.length = mean(Sepal.Length))
coming to rsample, thanks to Davis Vaughan
Bootstrapping is going to be super easy
coming to rsample, thanks to Davis Vaughan
iris %>% group_by(Species) %>% bootstrapify(5) %>%
summarize(mean.length = mean(Sepal.Length))
#> # A tibble: 15 x 3
#> # Groups: Species [3]
#> Species .bootstrap mean.length
#> <fct> <int> <dbl>
#> 1 setosa 1 4.97
#> 2 setosa 2 5.00
#> 3 setosa 3 4.94
#> 4 setosa 4 4.97
#> 5 setosa 5 4.9
#> 6 versicolor 1 5.99
#> 7 versicolor 2 5.99
#> 8 versicolor 3 5.93
#> 9 versicolor 4 5.96
#> 10 versicolor 5 5.94
#> 11 virginica 1 6.50
#> 12 virginica 2 6.71
#> 13 virginica 3 6.56
#> 14 virginica 4 6.81
#> 15 virginica 5 6.72
How do we get the bootstraps into ggplot2?
mtcars %>%
ggplot(aes(disp, mpg)) +
geom_point() +
geom_smooth(se = FALSE)
How do we get the bootstraps into ggplot2?
mtcars_bs <- mtcars %>%
bootstrapify(times = 20, key = ".draw") %>%
collect()
�mtcars %>%
ggplot(aes(disp, mpg)) +
geom_point() +
geom_smooth(
data = mtcars_bs,
aes(group = .draw),
se = FALSE
)
More elegant: bootstrap inside ggplot2 layer
library(ungeviz)
mtcars %>%
ggplot(aes(disp, mpg)) +
geom_point() +
geom_smooth(
data = bootstrapper(20),
aes(group = .draw),
se = FALSE
)
More elegant: bootstrap inside ggplot2 layer
library(ungeviz)
mtcars %>%
ggplot(aes(disp, mpg)) +
geom_point() +
geom_smooth(
data = bootstrapper(20),
aes(group = .draw),
se = FALSE
)
More elegant: bootstrap inside ggplot2 layer
library(ungeviz)
mtcars %>%
ggplot(aes(disp, mpg)) +
geom_point() +
geom_smooth(
data = bootstrapper(20),
aes(group = .draw),
se = FALSE
)
Bootstrap inside ggplot2 layer, w/ animation
library(ungeviz)
mtcars %>%
ggplot(aes(disp, mpg)) +
geom_point() +
geom_smooth(
data = bootstrapper(20),
aes(group = .draw),
se = FALSE
) +
transition_states(.draw, 0, 1) # gganimate
Bootstrap inside ggplot2 layer, w/ animation
library(ungeviz)
mtcars %>%
ggplot(aes(disp, mpg)) +
geom_point() +
geom_smooth(
data = bootstrapper(20),
aes(group = .draw),
se = FALSE
) +
transition_states(.draw, 0, 1) # gganimate
2nd example: chocolate bar ratings
Does a randomly chosen Canadian chocolate bar taste better than a U.S. one?
Does a randomly chosen Canadian chocolate bar taste better than a U.S. one?
cacao %>% filter(location %in% c("Canada", "U.S.A.")) %>%
ggplot(aes(rating, location)) +
Does a randomly chosen Canadian chocolate bar taste better than a U.S. one?
cacao %>% filter(location %in% c("Canada", "U.S.A.")) %>%
ggplot(aes(rating, location)) +
geom_point( # point cloud of all ratings
position = position_jitter(height = 0.3, width = 0.05)
) +
Does a randomly chosen Canadian chocolate bar taste better than a U.S. one?
cacao %>% filter(location %in% c("Canada", "U.S.A.")) %>%
ggplot(aes(rating, location)) +
geom_point(
position = position_jitter(height = 0.3, width = 0.05)
) +
geom_vpline( # like geom_point(), but draws a vertical line
data = sampler(25, group = location),
aes(group = .row),
height = 0.6
) +
Does a randomly chosen Canadian chocolate bar taste better than a U.S. one?
cacao %>% filter(location %in% c("Canada", "U.S.A.")) %>%
ggplot(aes(rating, location)) +
geom_point(
position = position_jitter(height = 0.3, width = 0.05)
) +
geom_vpline(
data = sampler(25, group = location), # sample within locations
aes(group = .row),
height = 0.6
) +
Does a randomly chosen Canadian chocolate bar taste better than a U.S. one?
cacao %>% filter(location %in% c("Canada", "U.S.A.")) %>%
ggplot(aes(rating, location)) +
geom_point(
position = position_jitter(height = 0.3, width = 0.05)
) +
geom_vpline(
data = sampler(25, group = location),
aes(group = .row), # turn off tweening in gganimate
height = 0.6
) +
Does a randomly chosen Canadian chocolate bar taste better than a U.S. one?
cacao %>% filter(location %in% c("Canada", "U.S.A.")) %>%
ggplot(aes(rating, location)) +
geom_point(
position = position_jitter(height = 0.3, width = 0.05)
) +
geom_vpline(
data = sampler(25, group = location),
aes(group = .row),
height = 0.6
) +
transition_states(.draw, 0, 1) # animate draws
Does a randomly chosen Canadian chocolate bar taste better than a U.S. one?
How do we generate outcomes?
Can generate fitted draws with a custom stat
# bootstrap within layer
ggplot(mtcars, aes(disp, mpg)) +
geom_point() +
geom_smooth(
data = bootstrapper(10), aes(group = .draw),
se = FALSE
)
Can generate fitted draws with a custom stat
# bootstrap within layer
ggplot(mtcars, aes(disp, mpg)) +
geom_point() +
geom_smooth(
data = bootstrapper(10), aes(group = .draw),
se = FALSE
)
# use stat that generates fitted draws
ggplot(mtcars, aes(disp, mpg)) +
geom_point() +
stat_smooth_draws(
times = 10, aes(group = stat(.draw))
)
Can generate fitted draws with a custom stat
# bootstrap within layer
ggplot(mtcars, aes(disp, mpg)) +
geom_point() +
geom_smooth(
data = bootstrapper(10), aes(group = .draw),
se = FALSE
)
# use stat that generates fitted draws
ggplot(mtcars, aes(disp, mpg)) +
geom_point() +
stat_smooth_draws(
times = 10, aes(group = stat(.draw))
)
Can generate fitted draws with a custom stat
# bootstrap within layer
ggplot(mtcars, aes(disp, mpg)) +
geom_point() +
geom_smooth(
data = bootstrapper(10), aes(group = .draw),
se = FALSE
)
# use stat that generates fitted draws
ggplot(mtcars, aes(disp, mpg)) +
geom_point() +
stat_smooth_draws(
times = 10, aes(group = stat(.draw))
)
Can generate fitted draws with a custom stat
# bootstrap within layer
ggplot(mtcars, aes(disp, mpg)) +
geom_point() +
geom_smooth(
data = bootstrapper(10), aes(group = .draw),
se = FALSE
)
# use stat that generates fitted draws
ggplot(mtcars, aes(disp, mpg)) +
geom_point() +
stat_smooth_draws(
times = 10, aes(group = stat(.draw))
)
Bootstrap
Fitted draws
Custom stat works with gganimate as well
ggplot(mtcars, aes(disp, mpg)) +
geom_point() +
stat_smooth_draws(
times = 20, aes(group = stat(.draw))
) +
transition_states(stat(.draw), 0, 1) # gganimate
Custom stat works with gganimate as well
ggplot(mtcars, aes(disp, mpg)) +
geom_point() +
stat_smooth_draws(
times = 20, aes(group = stat(.draw))
) +
transition_states(stat(.draw), 0, 1) # gganimate
Hard transitions
Fade outcomes
Tween outcomes
Outcome ensemble
Take-home message: Make HOPs. It’s easy.
@clauswilke
clauswilke
Bonus: Visual demonstration of the bootstrap
Bonus: Visual demonstration of the bootstrap
# 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 = "#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()