R/geom_lineribbon.R

Defines functions draw_key_lineribbon geom_lineribbon

Documented in geom_lineribbon

# A combination of geom_line and geom_ribbon  with sensible defaults for displaying multiple bands
#
# Author: mjskay
###############################################################################


# Names that should be suppressed from global variable check by codetools
# Names used broadly should be put in _global_variables.R
globalVariables(c(".lower", ".upper", ".width"))


#' Line + multiple probability ribbon plots (ggplot geom)
#'
#' A combination of \code{\link{geom_line}} and \code{\link{geom_ribbon}} with default aesthetics
#' designed for use with output from \code{\link{point_interval}}.
#'
#' \code{geom_lineribbon} is a combination version of a \code{\link{geom_line}}, and \code{geom_ribbon} designed for use
#' with output from \code{\link{point_interval}}. This geom sets some default aesthetics equal to the \code{.lower},
#' \code{.upper}, and \code{.width} columns generated by the \code{point_interval} family of functions, making them
#' often more convenient than a vanilla \code{\link{geom_ribbon}} + \code{\link{geom_line}}.
#'
#' Specifically, \code{geom_lineribbon} acts as if its default aesthetics are
#' \code{aes(ymin = .lower, ymax = .upper, forcats::fct_rev(ordered(.width)))}.
#'
#' @inheritParams ggplot2::geom_line
#' @param ...  Other arguments passed to \code{\link{layer}}.
#' @author Matthew Kay
#' @seealso See \code{\link{stat_lineribbon}} for a version that does summarizing of samples into points and intervals
#' within ggplot. See \code{\link{geom_pointinterval}} / \code{\link{geom_pointintervalh}} for a similar geom intended
#' for point summaries and intervals. See \code{\link{geom_ribbon}} and \code{\link{geom_line}} for the geoms this is
#' based on.
#' @examples
#'
#' library(dplyr)
#' library(ggplot2)
#'
#' tibble(x = 1:10) %>%
#'   group_by_all() %>%
#'   do(tibble(y = rnorm(100, .$x))) %>%
#'   median_qi(.width = c(.5, .8, .95)) %>%
#'   ggplot(aes(x = x, y = y)) +
#'   # automatically uses aes(ymin = .lower, ymax = .upper, fill = fct_rev(ordered(.width)))
#'   geom_lineribbon() +
#'   scale_fill_brewer()
#'
#' @importFrom forcats fct_rev
#' @import ggplot2
#' @export
geom_lineribbon = function(mapping = NULL, data = NULL,
  stat = "identity", position = "identity",
  ...,
  na.rm = FALSE,
  show.legend = NA,
  inherit.aes = TRUE
) {

  l = layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomLineribbon,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      ...
    )
  )

  add_default_computed_aesthetics(l,
    aes(ymin = .lower, ymax = .upper, fill = forcats::fct_rev(ordered(.width)))
  )
}

draw_key_lineribbon = function(data, params, size) {
  if (is.na(data$fill)) {
    draw_key_path(data, params, size)
  } else {
    draw_key_rect(data, params, size)
  }
}

#' @rdname tidybayes-ggproto
#' @format NULL
#' @usage NULL
#' @importFrom plyr dlply
#' @importFrom purrr map map_dbl
#' @import ggplot2
#' @export
GeomLineribbon = ggproto("GeomLineribbon", Geom,
  default_aes = aes(colour = "black", size = 1.25, linetype = 1, shape = 19,
    fill = NA, alpha = NA, stroke = 1),

  draw_key = draw_key_lineribbon,

  required_aes = c("x", "y", "ymin", "ymax"),

  draw_panel = function(data, panel_scales, coord) {
    # ribbons do not autogroup by color/fill/linetype, so if someone groups by changing the color
    # of the line or by setting fill, the ribbons might give an error. So we will do the
    # grouping ourselves
    grouping_columns = names(data) %>%
      intersect(c("colour", "fill", "linetype", "group"))

    # draw all the ribbons
    ribbon_grobs = data %>%
      dlply(grouping_columns, function(d) {
        group_grobs = list(GeomRibbon$draw_panel(transform(d, size = NA), panel_scales, coord))
        list(
          width = d %$% mean(abs(ymax - ymin)),
          grobs = group_grobs
        )
      })

    # this is a slightly hackish approach to getting the draw order correct for the common
    # use case of fit lines / curves: draw the ribbons in order from largest mean width to
    # smallest mean width, so that the widest intervals are on the bottom.
    ribbon_grobs = ribbon_grobs[order(-map_dbl(ribbon_grobs, "width"))] %>%
      map("grobs") %>%
      reduce(c)

    # now draw all the lines
    line_grobs = data %>%
      dlply(grouping_columns, function(d) {
        if (!is.null(d$y)) {
          list(GeomLine$draw_panel(d, panel_scales, coord))
        } else {
          list()
        }
      })

    line_grobs = reduce(line_grobs, c)

    grobs = c(ribbon_grobs, line_grobs)

    ggname("geom_lineribbon",
      gTree(children = do.call(gList, grobs))
    )
  }
)
mjskay/tidybayes documentation built on Oct. 11, 2019, 5:18 p.m.