Permalink
243 lines (226 sloc) 7.52 KB
#' Stack overlapping objects on top of each another
#'
#' `position_stack()` stacks bars on top of each other;
#' `position_fill()` stacks bars and standardises each stack to have
#' constant height.
#'
#' `position_fill()` and `position_stack()` automatically stack
#' values in reverse order of the group aesthetic, which for bar charts is
#' usually defined by the fill aesthetic (the default group aesthetic is formed
#' by the combination of all discrete aesthetics except for x and y). This
#' default ensures that bar colours align with the default legend.
#'
#' There are three ways to override the defaults depending on what you want:
#'
#' \enumerate{
#' \item Change the order of the levels in the underyling factor. This
#' will change the stacking order, and the order of keys in the legend.
#'
#' \item Set the legend `breaks` to change the order of the keys
#' without affecting the stacking.
#'
#' \item Manually set the group aesthetic to change the stacking order
#' without affecting the legend.
#' }
#'
#' Stacking of positive and negative values are performed separately so that
#' positive values stack upwards from the x-axis and negative values stack
#' downward.
#'
#' @family position adjustments
#' @param vjust Vertical adjustment for geoms that have a position
#' (like points or lines), not a dimension (like bars or areas). Set to
#' `0` to align with the bottom, `0.5` for the middle,
#' and `1` (the default) for the top.
#' @param reverse If `TRUE`, will reverse the default stacking order.
#' This is useful if you're rotating both the plot and legend.
#' @seealso See [geom_bar()] and [geom_area()] for
#' more examples.
#' @export
#' @examples
#' # Stacking and filling ------------------------------------------------------
#'
#' # Stacking is the default behaviour for most area plots.
#' # Fill makes it easier to compare proportions
#' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) +
#' geom_bar()
#' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) +
#' geom_bar(position = "fill")
#'
#' ggplot(diamonds, aes(price, fill = cut)) +
#' geom_histogram(binwidth = 500)
#' ggplot(diamonds, aes(price, fill = cut)) +
#' geom_histogram(binwidth = 500, position = "fill")
#'
#' # Stacking is also useful for time series
#' series <- data.frame(
#' time = c(rep(1, 4),rep(2, 4), rep(3, 4), rep(4, 4)),
#' type = rep(c('a', 'b', 'c', 'd'), 4),
#' value = rpois(16, 10)
#' )
#' ggplot(series, aes(time, value)) +
#' geom_area(aes(fill = type))
#'
#' # Stacking order ------------------------------------------------------------
#' # The stacking order is carefully designed so that the plot matches
#' # the legend.
#'
#' # You control the stacking order by setting the levels of the underlying
#' # factor. See the forcats package for convenient helpers.
#' series$type2 <- factor(series$type, levels = c('c', 'b', 'd', 'a'))
#' ggplot(series, aes(time, value)) +
#' geom_area(aes(fill = type2))
#'
#' # You can change the order of the levels in the legend using the scale
#' ggplot(series, aes(time, value)) +
#' geom_area(aes(fill = type)) +
#' scale_fill_discrete(breaks = c('a', 'b', 'c', 'd'))
#'
#' # If you've flipped the plot, use reverse = TRUE so the levels
#' # continue to match
#' ggplot(series, aes(time, value)) +
#' geom_area(aes(fill = type2), position = position_stack(reverse = TRUE)) +
#' coord_flip() +
#' theme(legend.position = "top")
#'
#' # Non-area plots ------------------------------------------------------------
#'
#' # When stacking across multiple layers it's a good idea to always set
#' # the `group` aesthetic in the ggplot() call. This ensures that all layers
#' # are stacked in the same way.
#' ggplot(series, aes(time, value, group = type)) +
#' geom_line(aes(colour = type), position = "stack") +
#' geom_point(aes(colour = type), position = "stack")
#'
#' ggplot(series, aes(time, value, group = type)) +
#' geom_area(aes(fill = type)) +
#' geom_line(aes(group = type), position = "stack")
#'
#' # You can also stack labels, but the default position is suboptimal.
#' ggplot(series, aes(time, value, group = type)) +
#' geom_area(aes(fill = type)) +
#' geom_text(aes(label = type), position = "stack")
#'
#' # You can override this with the vjust parameter. A vjust of 0.5
#' # will center the labels inside the corresponding area
#' ggplot(series, aes(time, value, group = type)) +
#' geom_area(aes(fill = type)) +
#' geom_text(aes(label = type), position = position_stack(vjust = 0.5))
#'
#' # Negative values -----------------------------------------------------------
#'
#' df <- tibble::tribble(
#' ~x, ~y, ~grp,
#' "a", 1, "x",
#' "a", 2, "y",
#' "b", 1, "x",
#' "b", 3, "y",
#' "b", -1, "y"
#' )
#' ggplot(data = df, aes(x, y, group = grp)) +
#' geom_col(aes(fill = grp), position = position_stack(reverse = TRUE)) +
#' geom_hline(yintercept = 0)
#'
#' ggplot(data = df, aes(x, y, group = grp)) +
#' geom_col(aes(fill = grp)) +
#' geom_hline(yintercept = 0) +
#' geom_text(aes(label = grp), position = position_stack(vjust = 0.5))
position_stack <- function(vjust = 1, reverse = FALSE) {
ggproto(NULL, PositionStack, vjust = vjust, reverse = reverse)
}
#' @export
#' @rdname position_stack
position_fill <- function(vjust = 1, reverse = FALSE) {
ggproto(NULL, PositionFill, vjust = vjust, reverse = reverse)
}
#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
PositionStack <- ggproto("PositionStack", Position,
type = NULL,
vjust = 1,
fill = FALSE,
reverse = FALSE,
setup_params = function(self, data) {
list(
var = self$var %||% stack_var(data),
fill = self$fill,
vjust = self$vjust,
reverse = self$reverse
)
},
setup_data = function(self, data, params) {
if (is.null(params$var)) {
return(data)
}
data$ymax <- switch(params$var,
y = data$y,
ymax = ifelse(data$ymax == 0, data$ymin, data$ymax)
)
remove_missing(
data,
vars = c("x", "xmin", "xmax", "y"),
name = "position_stack"
)
},
compute_panel = function(data, params, scales) {
if (is.null(params$var)) {
return(data)
}
negative <- data$ymax < 0
neg <- data[negative, , drop = FALSE]
pos <- data[!negative, , drop = FALSE]
if (any(negative)) {
neg <- collide(neg, NULL, "position_stack", pos_stack,
vjust = params$vjust,
fill = params$fill,
reverse = params$reverse
)
}
if (any(!negative)) {
pos <- collide(pos, NULL, "position_stack", pos_stack,
vjust = params$vjust,
fill = params$fill,
reverse = params$reverse
)
}
rbind(neg, pos)
}
)
pos_stack <- function(df, width, vjust = 1, fill = FALSE) {
n <- nrow(df) + 1
y <- ifelse(is.na(df$y), 0, df$y)
heights <- c(0, cumsum(y))
if (fill) {
heights <- heights / abs(heights[length(heights)])
}
df$ymin <- pmin(heights[-n], heights[-1])
df$ymax <- pmax(heights[-n], heights[-1])
df$y <- (1 - vjust) * df$ymin + vjust * df$ymax
df
}
#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
PositionFill <- ggproto("PositionFill", PositionStack,
fill = TRUE
)
stack_var <- function(data) {
if (!is.null(data$ymax)) {
if (any(data$ymin != 0 && data$ymax != 0, na.rm = TRUE)) {
warning("Stacking not well defined when not anchored on the axis", call. = FALSE)
}
"ymax"
} else if (!is.null(data$y)) {
"y"
} else {
warning(
"Stacking requires either ymin & ymin or y aesthetics.\n",
"Maybe you want position = 'identity'?",
call. = FALSE
)
NULL
}
}