Experiment
library(tidyverse)
compute_panel_pairs <- function(data, scales){
data %>%
mutate(group_label = group) %>%
group_by(group) %>%
arrange(x) %>%
mutate(change = y - lag(y) ) %>%
fill(change, .direction = "up")
}
StatPairs <- ggproto("StatPairs", Stat,
compute_panel = compute_panel_pairs,
default_aes = aes(color = after_stat(change)))
gapminder::gapminder %>%
filter(year %in% c(1992, 2002)) %>%
ggplot() +
aes(x = year,
y = gdpPercap,
group = country) +
geom_point(stat = StatPairs) +
geom_path(stat = StatPairs)
last_plot() +
geom_text(
stat = StatPairs,
aes(label = country),
hjust = "outward",
check_overlap = T
)
last_plot() +
aes(x = as.factor(year))
last_plot() +
stat_summary(geom = "point",
fun = "mean",
aes(group = NULL,
color = I("goldenrod") # why do I have to do this? When I have color *set* above?
),
size = 4)
last_plot() +
aes(color = sign(after_stat(change)))
ggwipe::last_plot_wipe_last() +
stat_summary(geom = "point",
color = "goldenrod",
fun = "mean",
aes(group = NULL,
color = I("goldenrod")
),
size = 4)
last_plot() +
aes(y = lifeExp)
last_plot() +
aes(color = I("grey"))
StatSummary$compute_layer
## <ggproto method>
## <Wrapper function>
## function (...)
## compute_layer(..., self = self)
##
## <Inner function (f)>
## function (self, data, params, layout)
## {
## check_required_aesthetics(self$required_aes, c(names(data),
## names(params)), snake_class(self))
## required_aes <- intersect(names(data), unlist(strsplit(self$required_aes,
## "|", fixed = TRUE)))
## data <- remove_missing(data, params$na.rm, c(required_aes,
## self$non_missing_aes), snake_class(self), finite = TRUE)
## params <- params[intersect(names(params), self$parameters())]
## args <- c(list(data = quote(data), scales = quote(scales)),
## params)
## dapply(data, "PANEL", function(data) {
## scales <- layout$get_scales(data$PANEL[1])
## try_fetch(inject(self$compute_panel(data = data, scales = scales,
## !!!params)), error = function(cnd) {
## cli::cli_warn("Computation failed in {.fn {snake_class(self)}}.",
## parent = cnd)
## data_frame0()
## })
## })
## }