#' Waterfall
#'
#' Creates a waterfall table showing the source(s) of change in sales for one period,
#' relative to the previous period.
#' @param x A RevenueGrowthAccounting object.
#' @param periods A vector of \code{character} indicating the period(s) to plot
#' (relative to the previous period). If NULL, the total, aggregated across all periods, is shown.
#' @importFrom flipFormat FormatAsPercent
#' @importFrom verbs Sum SumEachColumn
#' @export
Waterfall <- function(x, periods = NULL)
{
all.periods <- names(x$Revenue)
if (is.null(periods))
periods <- all.periods[-1]
# Summing up the sales by category
y <- SumEachColumn(x$Table[periods, ], remove.missing = FALSE)
y <- y[c(1:3, 5:4)] # Reordering categories
# Computing the base.
lookup <- match(periods, all.periods) - 1
if (!all(lookup %in% 1:length(all.periods)))
stop("Invalid 'periods': 'periods' must match the labels in the data of 'x' and
must not include the first period.'")
base.periods <- all.periods[lookup ]
base <- Sum(x$Revenue[base.periods], remove.missing = FALSE)
# Growth as a percentage of the base
y <- y / base
# Result
title = paste0("Revenue waterfall: ", base.periods[1], " to ", periods[length(periods)])
result <- list(title = title, change = y, cumulative = cumsum(y))
class(result) <- c("Waterfall", class(result))
result
}
#' plot.Waterfall
#'
#' Creates a waterfall chart showing the source(s) of change in sales for one period, relative to the previous period.
#' @param x An object of class \code{Waterfall}.
#' @param ... Additional parameters.
#' @importFrom plotly plot_ly add_trace layout config add_annotations add_text
#' @importFrom flipFormat FormatAsPercent
#' @importFrom verbs Sum
#' @export
plot.Waterfall <- function(x, ...)
{
y <- x$change
categories <- factor(names(y), levels = names(y))
# Formatting labels
y.text <- FormatAsPercent(y, 3)
y.text <- as.character(ifelse(y > 0, paste0("+", y.text), y.text))
# Creating series for the plot
y <- y * 100
bs <- c(y[1], Sum(y[1:2]), Sum(y[1:2]), Sum(y[1:3]), Sum(y[1:4]))
y.cum <- cumsum(y)
y.cum.text <- unname(FormatAsPercent(y.cum / 100, 3))
# Adding text to show values
label.offsets <- (y.cum[length(y.cum)] - min(y.cum)) / 30
annotation.y <- c(y[1], y[1] + y[2], bs[-1:-2] + y[-1:-2] )
annotation.y.with.offset <- annotation.y + c(-1, -1, 1, 1, 1) * label.offsets# <- c(y[1] - 2, y[1] + y[2] - 2, bs[-1:-2] + y[-1:-2] + 2)
# Creating the plot.
p <- plot_ly(x = categories,
y = bs,
marker = list(color = "white"),
hoverinfo='none',
type = "bar")
temp.y <- abs(y)
colors <- c("red", "orange", "teal", "turquoise", "blue")
for (i in 1:5)
p <- add_trace(p = p,
x = categories[i],
y = temp.y[i],
name = categories[i],
marker = list(color = colors[i]),
type = "bar")
# Adding annotations
for (i in 1:(n.y <- length(y)))
{
p <- add_text(p,
x = categories[i],
y = annotation.y.with.offset[i],
text = y.cum.text[i],
textposition = "bottom middle",
textfont = list(color = "black"),
marker = NULL
)
}
# Differences.
middle.of.bar <- c(y[1] / 2, y[1] + y[2] / 2, (bs[-1:-2] + annotation.y[-1:-2]) / 2)
small.bar <- abs(y) < 4
text.position <- ifelse(small.bar, bs - label.offsets, middle.of.bar) # Correcting for situations where the columns are small.
for (i in 1:n.y)
{
p <- add_text(p,
x = categories[i],
y = text.position[i],
text = y.text[i],
textposition = if(small.bar[i]) "lower middle" else "middle",
textfont = list(color = if(small.bar[i]) "black" else "white"),
marker = NULL
)
}
# Finalizing the lotting options
p <- config(p, displayModeBar = FALSE)
layout(p = p,
barmode = "stack",
showlegend = FALSE,
title = x$title,
xaxis = list(title = "",
zeroline = FALSE,
showticklabels = TRUE,
showgrid = FALSE),
yaxis = list(title = "Revenue change",
zeroline = TRUE,
showticklabels = FALSE,
showgrid = FALSE))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.