R/geom-offset-bezier.R

In houyunhuang/ggvwline: Extending 'ggplot2' to Draw Variable-Width Lines

#' Offset-bezier Curve with Variable-Width
#' @description The main curve is described by x/y position points and offset
#' bezier curves are calculated to the left and right of the main curve at the
#' specified widths.
#' @inheritParams ggplot2::layer
#' @inheritParams ggplot2::geom_polygon
#' @param open a logical value indicating whether to connect the last
#' location back to the first location to produce a closed line.
#' @param width_units the units of line, detail see \code{\link[grid]{unit}}.
#' @param width_fun either "bezier" (default) or "spline" to specifying the width
#' function:
#'     \itemize{
#'       \item {\code{bezier}}: \code{\link[vwline]{BezierWidth}}
#'       \item {\code{spline}}: \code{\link[vwline]{widthSpline}}
#'    }
#' @param width_shape the shape parameter for the width spline.
#' @param rep a logical value indicating whether to repeat the widths along the full
#' length of the line.
#' @param step_fn function called to generate steps in t when rendering.
#' @param linejoin the line join style; one of "round" (default), "mitre", or "bevel".
#' @param lineend the line ending style; one of "round" (default), "mitre", "butt",
#' or "square".
#' @param mitre_limit a numeric that controls when a mitre join is converted to
#' a bevel join or a mitre ending is converted to a square ending.
#' @param debug a logical value indicating whether to produce graphical debugging output.
#' @section Aesthetics:
#' \code{geom_offset_bezier()} understands the following aesthetics (required
#' aesthetics are in bold):
#'     \itemize{
#'       \item \strong{\code{x}}
#'       \item \strong{\code{y}}
#'       \item \code{alpha}
#'       \item \code{colour}
#'       \item \code{dist}
#'       \item \code{fill}
#'       \item \code{linetype}
#'       \item \code{size}
#'       \item \code{width}
#'    }
#' @seealso \code{\link[vwline]{offsetBezierGrob}}, \code{\link[vwline]{BezierWidth}},
#'     \code{\link[vwline]{widthSpline}}.
#' @importFrom ggplot2 layer
#' @rdname geom_offset_bezier
#' @export
#' @examples
#' df <- data.frame(
#'   x = c(.2, .4, .6, .8),
#'   y = c(-.05, .05, -.05, .05),
#'   width = c(0.5, 1, 1.5, 2)
#'   )
#'
#' ggplot(df, aes(x, y, width = width)) + geom_offset_bezier()
#' ggplot(df, aes(x, y, width = width)) + geom_offset_bezier(lineend = "round")
#' ggplot(df, aes(x, y, width = width)) +
#'   geom_offset_bezier(colour = "black", fill = NA, debug = TRUE)
geom_offset_bezier <- function(mapping = NULL,
                         data = NULL,
                         stat = "identity",
                         position = "identity",
                         ...,
                         open = TRUE,
                         width_units = "cm",
                         width_fun = "bezier",
                         width_shape = -1,
                         rep = FALSE,
                         step_fn = nSteps(100),
                         linejoin = "round",
                         lineend = "butt",
                         mitre_limit = 4,
                         debug = FALSE,
                         na.rm = FALSE,
                         show.legend = NA,
                         inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomOffsetBezier,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      open = open,
      width_units = width_units,
      width_fun = width_fun,
      width_shape = width_shape,
      rep = rep,
      step_fn = step_fn,
      linejoin = linejoin,
      lineend = lineend,
      mitre_limit = mitre_limit,
      debug = debug,
      na.rm = na.rm,
      ...
    )
  )
}

#' @importFrom ggplot2 ggproto Geom zeroGrob draw_key_polygon
#' @importFrom grid gpar grobTree
#' @importFrom vwline widthSpline BezierWidth offsetBezierGrob vwPolygon vwPath
#' @importFrom gridBezier nSteps
#' @importFrom scales alpha
#' @rdname geom_offset_bezier
#' @format NULL
#' @usage NULL
#' @export
GeomOffsetBezier <- ggproto(
  "GeomOffsetBezier", Geom,
  draw_panel = function(data, panel_params, coord, open = TRUE, width0 = NULL, width_units = "cm",
                        width_fun = "bezier", width_shape = -1, rep = FALSE, step_fn = nSteps(100),
                        linejoin = "round", lineend = "butt", mitre_limit = 4,
                        render=if (open) vwPolygon else vwPath(), debug = FALSE) {
    width_fun <- match.arg(width_fun, c("spline", "bezier"))
    width_fun <- switch(width_fun,
                        spline = "widthSpline",
                        bezier = "BezierWidth")
    data <- coord$transform(data, panel_params)
    if(!is.null(data$group) && length(unique(data$group)) > 1) {
      data <- split(data, data$group)
      grobs <- lapply(data, function(.data) {
        n <- nrow(.data)
        if (n < 4) return(ggplot2::zeroGrob())
        first_row = .data[1, , drop = FALSE]
        args <- if(width_fun == "BezierWidth") {
          list(w = .data$width, default.units = width_units, d = .data$dist,
               rep = rep)
        } else {
          list(w = .data$width, default.units = width_units, d = .data$dist,
               shape = width_shape, rep = rep)
        }
        width <- width0 %||% do.call(width_fun, args)

        if (!inherits(width, "widthSpline") && !inherits(width, "BezierWidth")) {
          width <- widthSpline(width, width_units)
        }

        offsetBezierGrob(
          .data$x, .data$y, width, default.units = "native", open = open,
          stepFn = step_fn, lineend = lineend, linejoin = linejoin,
          mitrelimit = mitre_limit, render = render, debug = debug,
          gp = gpar(
            col = scales::alpha(first_row$colour, first_row$alpha),
            fill = scales::alpha(first_row$fill, first_row$alpha),
            lwd = first_row$size * ggplot2::.pt,
            lty = first_row$linetype
          )
        )
      })
      ggname("geom_offset_bezier", do.call("grobTree", grobs))
    } else {
      n <- nrow(data)
      if (n < 4)
        return(ggplot2::zeroGrob())
      first_row = data[1, , drop = FALSE]
      args <- if(width_fun == "BezierWidth") {
        list(w = data$width, default.units = width_units, d = data$dist,
             rep = rep)
      } else {
        list(w = data$width, default.units = width_units, d = data$dist,
             shape = width_shape, rep = rep)
      }

      width <- width0 %||% do.call(width_fun, args)

      if (!inherits(width, "widthSpline") && !inherits(width, "BezierWidth")) {
        width <- widthSpline(width, width_units)
      }

      ggname(
        "geom_offset_bezier",
        offsetBezierGrob(
          data$x, data$y, width, default.units = "native", open = open,
          stepFn = step_fn, lineend = lineend, linejoin = linejoin,
          mitrelimit = mitre_limit, render = render, debug = debug,
          gp = gpar(
            col = scales::alpha(first_row$colour, first_row$alpha),
            fill = scales::alpha(first_row$fill, first_row$alpha),
            lwd = first_row$size * ggplot2::.pt,
            lty = first_row$linetype
          )
        )
      )
    }
  },

  default_aes = aes(colour = NA, fill = "grey35", size = 0.25, linetype = 1,
                    alpha = NA, width = 1, dist = NULL),
  required_aes = c("x", "y"),

  draw_key = draw_key_polygon
)