ggpk_tukey_ribbons <- function(...) {
ggpacket(...) %+%
# Tukey Box Edges
geom_ribbon(.id = "box",
mapping = aes(fill = ..color..),
stat = 'summary',
fun = median,
fun.min = ~quantile(., 0.25, names = FALSE),
fun.max = ~quantile(., 0.75, names = FALSE),
alpha = 0.15,
...,
color = NA) %+%
# Tukey Whiskers
geom_ribbon(.id = "whisker",
mapping = aes(fill = ..color..),
stat = 'summary',
fun = median,
fun.min = ~.[head(which(. > quantile(., 0.25, names = FALSE) - 1.5 * IQR(.)), 1)],
fun.max = ~.[tail(which(. < quantile(., 0.75, names = FALSE) + 1.5 * IQR(.)), 1)],
alpha = 0.15,
...,
color = NA) %+%
# Median Line
geom_line(.id = list(NULL, 'line'),
stat = 'summary',
fun = median,
alpha = 0.8,
...)
}
economics_long %>%
filter(variable %in% c('pop', 'unemploy')) %>%
mutate(year = as.integer(format(as.Date(date, format="%Y-%m-%d"),"%Y"))) %>%
ggplot() + aes(x = year, y = value, color = variable) +
ggpk_tukey_ribbons() +
scale_y_log10()