Implement geom_function(). Closes tidyverse#3611.

DESCRIPTION

@@ -131,6 +131,7 @@ Collate:
     'geom-errorbar.r'
     'geom-errorbarh.r'
     'geom-freqpoly.r'
+    'geom-function.R'
     'geom-hex.r'
     'geom-histogram.r'
     'geom-hline.r'

NAMESPACE

@@ -175,6 +175,7 @@ export(GeomDensity2dFilled)
 export(GeomDotplot)
 export(GeomErrorbar)
 export(GeomErrorbarh)
+export(GeomFunction)
 export(GeomHex)
 export(GeomHline)
 export(GeomLabel)
@@ -351,6 +352,7 @@ export(geom_dotplot)
 export(geom_errorbar)
 export(geom_errorbarh)
 export(geom_freqpoly)
+export(geom_function)
 export(geom_hex)
 export(geom_histogram)
 export(geom_hline)

R/geom-function.R

@@ -0,0 +1,39 @@
+#' @export
+#' @rdname stat_function
+geom_function <- function(mapping = NULL, data = NULL, stat = "function",
+                          position = "identity", na.rm = FALSE,
+                          show.legend = NA, inherit.aes = TRUE, ...) {
+  layer(
+    data = data,
+    mapping = mapping,
+    stat = stat,
+    geom = GeomFunction,
+    position = position,
+    show.legend = show.legend,
+    inherit.aes = inherit.aes,
+    params = list(
+      na.rm = na.rm,
+      ...
+    )
+  )
+}
+
+#' @rdname ggplot2-ggproto
+#' @format NULL
+#' @usage NULL
+#' @export
+#' @include geom-path.r
+GeomFunction <- ggproto("GeomFunction", GeomPath,
+  draw_panel = function(self, data, panel_params, coord, arrow = NULL,
+                        lineend = "butt", linejoin = "round", linemitre = 10,
+                        na.rm = FALSE) {
+    groups <- unique(data$group)
+    if (length(groups) > 1) {
+      warn("Multiple drawing groups in `geom_function()`. Did you use the correct `group`, `colour`, or `fill` aesthetics?")
+    }
+
+    ggproto_parent(GeomPath, self)$draw_panel(
+      data, panel_params, coord, arrow, lineend, linejoin, linemitre, na.rm
+    )
+  }
+)

R/stat-function.r

@@ -55,7 +55,7 @@
 #' base + stat_function(fun = f)
 #'
 stat_function <- function(mapping = NULL, data = NULL,
-                          geom = "path", position = "identity",
+                          geom = "function", position = "identity",
                           ...,
                           fun,
                           xlim = NULL,
@@ -65,10 +65,7 @@ stat_function <- function(mapping = NULL, data = NULL,
                           show.legend = NA,
                           inherit.aes = TRUE) {
 
-  # Warn if supplied mapping and/or data is going to be overwritten
-  if (!is.null(mapping)) {
-    warn("`mapping` is not used by stat_function()")
-  }
+  # Warn if supplied data is going to be overwritten
   if (!is.null(data)) {
     warn("`data` is not used by stat_function()")
   }