Intro Thoughts
Status Quo
library(tidyverse)
Experiment
data.frame(event = c("Starting Cash",
"Sales",
"Refunds",
"Payouts",
"Court Losses",
"Court Wins",
"Contracts",
"End Cash"),
change = c(2000, 3400, -1100,
-100, -6600, 3800,
1400, -2800)) ->
flow_df
flow_df %>%
mutate(balance = cumsum(c(0,
change[-nrow(.)]))) %>%
mutate(time = row_number()) %>%
mutate(flow = factor(sign(change))) ->
balance_df
ggplot(balance_df) +
geom_rect(
aes(xmin = time - 0.45,
xmax = time + 0.45,
ymin = balance,
ymax = balance + change)) +
geom_text(aes(x = time,
y = pmin(balance,
balance + change) - 50,
label = balance))
Step 1. compute
compute_panel_waterfall <- function(data, scales){
data %>%
mutate(balance = cumsum(c(0,
change[-nrow(.)]))) %>%
mutate(x = row_number()) %>%
mutate(direction = factor(sign(change))) %>%
mutate(xmin = x - .45,
xmax = x + .45,
ymin = balance,
ymax = balance + change)
}
flow_df %>%
compute_panel_waterfall()
## event change balance x direction xmin xmax ymin ymax
## 1 Starting Cash 2000 0 1 1 0.55 1.45 0 2000
## 2 Sales 3400 2000 2 1 1.55 2.45 2000 5400
## 3 Refunds -1100 5400 3 -1 2.55 3.45 5400 4300
## 4 Payouts -100 4300 4 -1 3.55 4.45 4300 4200
## 5 Court Losses -6600 4200 5 -1 4.55 5.45 4200 -2400
## 6 Court Wins 3800 -2400 6 1 5.55 6.45 -2400 1400
## 7 Contracts 1400 1400 7 1 6.55 7.45 1400 2800
## 8 End Cash -2800 2800 8 -1 7.55 8.45 2800 0
Step 2. Pass to ggproto
StatWaterfall <- ggproto(`_class` = "StatWaterfall",
`_inherit` = ggplot2::Stat,
required_aes = c("change"),
compute_panel = compute_panel_waterfall)
Step 3. pass to geom_ / stat_
geom_waterfall <- function(
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 = ggplot2::GeomRect, # inherit other behavior
data = data,
mapping = mapping,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
Step 4. Enjoy (test)
flow_df %>%
ggplot() +
aes(change = change) +
geom_waterfall()
