Intro Thoughts
Status Quo
library(tidyverse)
data.frame(event = c(
"Sales",
"Refunds",
"Payouts",
"Court Losses",
"Court Wins",
"Contracts",
"Fees"),
change = c(6400, -1100,
-100, -6600, 3800,
1400, -2800)) %>%
mutate(event = factor(event)) ->
flow_df
flow_df %>% # maybe add factor in order if factor is not defined...
mutate(x_pos = event %>% as.numeric()) %>%
arrange(x_pos) %>%
mutate(balance = cumsum(c(0,
change[-nrow(.)]))) %>%
mutate(flow = factor(sign(change))) ->
balance_df
ggplot(balance_df) +
geom_rect(
aes(xmin = x_pos - 0.45,
xmax = x_pos + 0.45,
ymin = balance,
ymax = balance + change)) +
geom_text(aes(x = event,
y = pmin(balance,
balance + change) - 50,
label = balance)) ->
p;p
Step 1. compute
compute_panel_waterfall <- function(data, scales){
data %>%
mutate(x_scale = x) %>%
mutate(x_pos = x %>% as.numeric()) %>%
arrange(x_pos) %>%
mutate(balance = cumsum(c(0,
change[-nrow(.)]))) %>%
mutate(direction = factor(sign(change))) %>%
mutate(xmin = x_pos - .45,
xmax = x_pos + .45,
ymin = balance,
ymax = balance + change) %>%
mutate(x = x_pos) %>%
mutate(y = ymax) %>%
mutate(gain_loss = ifelse(direction == 1, "gain", "loss"))
}
flow_df %>%
rename(x = event) %>%
compute_panel_waterfall()
## x change x_scale x_pos balance direction xmin xmax ymin ymax y
## 1 1 1400 Contracts 1 0 1 0.55 1.45 0 1400 1400
## 2 2 -6600 Court Losses 2 1400 -1 1.55 2.45 1400 -5200 -5200
## 3 3 3800 Court Wins 3 -5200 1 2.55 3.45 -5200 -1400 -1400
## 4 4 -2800 Fees 4 -1400 -1 3.55 4.45 -1400 -4200 -4200
## 5 5 -100 Payouts 5 -4200 -1 4.55 5.45 -4200 -4300 -4300
## 6 6 -1100 Refunds 6 -4300 -1 5.55 6.45 -4300 -5400 -5400
## 7 7 6400 Sales 7 -5400 1 6.55 7.45 -5400 1000 1000
## gain_loss
## 1 gain
## 2 loss
## 3 gain
## 4 loss
## 5 loss
## 6 loss
## 7 gain
Step 2. Pass to ggproto
StatWaterfall <- ggproto(`_class` = "StatWaterfall",
`_inherit` = ggplot2::Stat,
required_aes = c("change", "x"),
compute_panel = compute_panel_waterfall,
default_aes = aes(label = after_stat(change),
fill = after_stat(gain_loss),
vjust = after_stat((direction == -1) %>%
as.numeric)))
Step 3. pass to geom_ / stat_
stat_waterfall <- function(geom = ggplot2::GeomRect,
mapping = NULL,
data = NULL,
position = "identity",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE, ...) {
ggplot2::layer(
stat = StatWaterfall, # proto object from step 2
geom = geom, # inherit other behavior
data = data,
mapping = mapping,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
geom_waterfall <- stat_waterfall
geom_waterfall_label <- function(..., lineheight = .8){stat_waterfall(geom = "text", lineheight = lineheight, ...)}
Step 4. Enjoy (test)
flow_df %>%
ggplot() +
geom_hline(yintercept = 0) +
aes(change = change,
x = event) + # event in order
geom_waterfall() +
geom_waterfall_label() +
scale_y_continuous(expand = expansion(.1)) +
scale_fill_manual(values = c("springgreen4", "darkred"))
last_plot() +
aes(x = fct_reorder(event, change)) # in order neg to positive
last_plot() +
aes(x = fct_reorder(event, abs(change))) # in order magnitude
