R/geom-bezier-line.R

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

#' Bezier Curve
#' @description The bezier curve layer function is used to draw bezier curve.
#' @inheritParams ggplot2::layer
#' @inheritParams ggplot2::geom_path
#' @param step_fn string, a function  to generate values of t at which
#' the curve will be evaluated for drawing.
#' @section Aesthetics:
#' \code{geom_bezier_line()} 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{fill}
#'       \item \code{linetype}
#'       \item \code{size}
#'    }
#' @importFrom ggplot2 layer
#' @seealso \code{\link[gridBezier]{BezierGrob}}.
#' @rdname geom_bezier_line
#' @export
#' @examples
#' df <- data.frame(
#'   x = rnorm(10),
#'   y = rnorm(10)
#' )
#' ggplot(df, aes(x, y)) + geom_bezier_line()
#' ggplot(df[1:9, ], aes(x, y)) + geom_bezier_line(fill = "red", open = FALSE)
geom_bezier_line <- function(mapping = NULL,
                             data = NULL,
                             stat = "identity",
                             position = "identity",
                             ...,
                             step_fn = nSteps(100),
                             na.rm = FALSE,
                             show.legend = NA,
                             inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomBezierLine,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      step_fn = step_fn,
      na.rm = na.rm,
      ...
    )
  )
}

#' @importFrom ggplot2 ggproto GeomPath zeroGrob draw_key_path
#' @importFrom grid gpar
#' @importFrom gridBezier BezierGrob nSteps
#' @importFrom scales alpha
#' @rdname geom_bezier_line
#' @format NULL
#' @usage NULL
#' @export
GeomBezierLine <- ggproto(
  "GeomBezierLine", GeomPath,
  draw_panel = function(data, panel_params, coord, open = TRUE,
                        step_fn = nSteps(100), lineend = "butt") {
    if (!coord$is_linear()) {
      warning("geom_bezier_line is not implemented for non-linear coordinates",
              call. = FALSE)
    }
    data <- coord$transform(data, panel_params)

    if(open) {
      if(nrow(data) < 4 || (nrow(data) %% 3) != 1)
        return(zeroGrob())
    } else {
      if(nrow(data) < 3 || (nrow(data) %% 3) != 0)
        return(zeroGrob())
    }

    BezierGrob(
      data$x, data$y, default.units = "native",
      open = open, stepFn = step_fn,
      gp = gpar(
        col = scales::alpha(data$colour, data$alpha),
        fill = scales::alpha(data$fill, data$alpha),
        lwd = data$size * ggplot2::.pt,
        lty = data$linetype,
        lineend = lineend)
    )
  },

  default_aes = aes(colour = "black", fill = NA, size = 0.25, linetype = 1,
                    alpha = NA),
  required_aes = c("x", "y"),

  draw_key = draw_key_path
)