Status Quo
library(tidyverse)
data.frame(event = c(
"Sales",
"Refunds",
"Payouts",
"Court Losses",
"Court Wins",
"Contracts",
"Fees"),
change = c(6400, -1100,
-100, -4200, 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))
compute_panel_waterfall <- function(data, scales, width = .90, starting = 0){
if(is.null(starting)){starting <- 0}
data %>%
dplyr::mutate(x_pos = .data$x %>% as.numeric()) %>%
dplyr::arrange(.data$x_pos) %>%
dplyr::mutate(balance = cumsum(c(starting,
.data$change[-nrow(.)]))) %>%
dplyr::mutate(direction = factor(sign(.data$change))) %>%
dplyr::mutate(xmin = .data$x_pos - width/2,
xmax = .data$x_pos + width/2,
ymin = .data$balance,
ymax = .data$balance + .data$change) %>%
dplyr::mutate(x = .data$x_pos) %>%
dplyr::mutate(y = .data$ymax) %>%
dplyr::mutate(gain_loss = ifelse(.data$direction == 1, "gain", "loss"))
}
### Step 1.1 Test compute
flow_df %>%
rename(x = event) %>%
compute_panel_waterfall(starting = 55)
## x change x_pos balance direction xmin xmax ymin ymax y gain_loss
## 1 1 1400 1 55 1 0.55 1.45 55 1455 1455 gain
## 2 2 -4200 2 1455 -1 1.55 2.45 1455 -2745 -2745 loss
## 3 3 3800 3 -2745 1 2.55 3.45 -2745 1055 1055 gain
## 4 4 -2800 4 1055 -1 3.55 4.45 1055 -1745 -1745 loss
## 5 5 -100 5 -1745 -1 4.55 5.45 -1745 -1845 -1845 loss
## 6 6 -1100 6 -1845 -1 5.55 6.45 -1845 -2945 -2945 loss
## 7 7 6400 7 -2945 1 6.55 7.45 -2945 3455 3455 gain
## Step 2. Pass compute to ggproto
stat_waterfall <- function(geom = "rect", ...){
statexpress::stat_panel(compute_panel_waterfall, geom = geom, ...)
}
flow_df %>%
ggplot() +
aes(x = event, change = change) +
stat_waterfall(starting = 1000, alpha = .7)
compute_panel_starting_balance <- function(data, scales, starting = 0, width = .90){
data.frame(x = 0, y = 0, ymin = 0, ymax = starting) %>%
mutate(xmin = x - width/2,
xmax = x + width/2) %>%
mutate(x = x - .75) # so that it renders
}
stat_waterfall_start <- function(geom = "rect", ...){
statexpress::stat_panel(compute_panel_starting_balance, geom, ...)
}
last_plot() +
stat_waterfall_start(starting = 1000)
compute_panel_final_balance <- function(data, scales, starting = 0, width = .90){
compute_panel_waterfall(data, starting = starting, width = width) ->
data
data %>%
slice(nrow(data)) %>%
mutate(ymin = ymax) %>%
mutate(ymax = 0) %>%
mutate(x = max(x) + 1) %>%
mutate(xmin = x - width/2,
xmax = x + width/2) %>%
mutate(x = x + .75) # spacing
}
flow_df %>%
rename(x = event, change = change) %>%
compute_panel_final_balance()
## x change x_pos balance direction xmin xmax ymin ymax y gain_loss
## 1 8.75 6400 7 -3000 1 7.55 8.45 3400 0 3400 gain
stat_waterfall_end <- function(geom = "rect", ...){
statexpress::stat_panel(compute_panel_final_balance, geom, ...)
}
last_plot() +
stat_waterfall_end(starting = 1000)
