Expose shape argument in geom_curve() (#6523)

* Expose shape argument in geom_curve() (#5998)

* Add tests for the shape argument in geom_curve()

* Add docs for shape argument in geom_curve()

* Add example for shape and ncp params in geom_curve()

* Apply suggestion to improve geom_curve() test

* Add snapshot for new geom_curve() test

* add news bullet

---------

Co-authored-by: Teun van den Brand <tahvdbrand@gmail.com>

Author: fmarotta

NEWS.md

@@ -2,6 +2,8 @@
 
 * `get_layer_data()` and `get_layer_grob()` now accept layer names as index 
   (@lgaborini, #6724)
+* Added new argument `geom_curve(shape)` that will be passed down to 
+  `grid::curveGrob()` (@fmarotta, #5998).
 
 # ggplot2 4.0.1
 

R/geom-curve.R

@@ -6,8 +6,8 @@
 GeomCurve <- ggproto(
   "GeomCurve", GeomSegment,
 
-  draw_panel = function(data, panel_params, coord, curvature = 0.5, angle = 90,
-                        ncp = 5, arrow = NULL, arrow.fill = NULL, lineend = "butt", na.rm = FALSE) {
+  draw_panel = function(data, panel_params, coord, curvature = 0.5, angle = 90, ncp = 5, shape = 0.5,
+                        arrow = NULL, arrow.fill = NULL, lineend = "butt", na.rm = FALSE) {
 
     if (!coord$is_linear()) {
       cli::cli_warn("{.fn geom_curve} is not implemented for non-linear coordinates")
@@ -31,11 +31,13 @@ GeomCurve <- ggproto(
 
     arrow.fill <- arrow.fill %||% trans$colour
 
+    square <- (ncp == 1 && angle == 90)
+
     curveGrob(
       trans$x, trans$y, trans$xend, trans$yend,
       default.units = "native",
-      curvature = curvature, angle = angle, ncp = ncp,
-      square = FALSE, squareShape = 1, inflect = FALSE, open = TRUE,
+      curvature = curvature, angle = angle, ncp = ncp, shape = shape,
+      square = square, squareShape = 1, inflect = FALSE, open = TRUE,
       gp = gg_par(
         col = alpha(trans$colour, trans$alpha),
         fill = alpha(arrow.fill, trans$alpha),

R/geom-segment.R

@@ -88,6 +88,23 @@ GeomSegment <- ggproto(
 #'   arrow = arrow(length = unit(0.03, "npc"))
 #' )
 #'
+#' # The `shape` and `ncp` arguments of geom_curve control the sharpness of the spline
+#' b +
+#'   geom_curve(
+#'     aes(x = x1, y = y1, xend = x2, yend = y2, colour = "ncp = 5"),
+#'     data = df,
+#'     curvature = 1,
+#'     shape = 0,
+#'     ncp = 5
+#'   ) +
+#'   geom_curve(
+#'     aes(x = x1, y = y1, xend = x2, yend = y2, colour = "ncp = 1"),
+#'     data = df,
+#'     curvature = 1,
+#'     shape = 0,
+#'     ncp = 1
+#'   )
+#'
 #' if (requireNamespace('maps', quietly = TRUE)) {
 #' ggplot(seals, aes(long, lat)) +
 #'   geom_segment(aes(xend = long + delta_long, yend = lat + delta_lat),

man/geom_segment.Rd

@@ -9,3 +9,42 @@ test_that("geom_curve flipping works", {
   expect_doppelganger("flipped geom_curve", p + scale_y_reverse())
 
 })
+
+test_that("geom_curve shape works", {
+
+  df <- data.frame(x = c(1, 3), xend = c(2, 4), y = c(0, 1), yend = c(2, 1.5))
+
+  p <- ggplot(df) +
+    geom_curve(
+      aes(x, y, xend = xend, yend = yend, color = "square"),
+      curvature = 1,
+      shape = 0,
+      ncp = 1
+    ) +
+    geom_curve(
+      # This layer will use `square = FALSE` in curveGrob because angle != 90
+      aes(x, y, xend = xend, yend = yend, color = "square tilted"),
+      angle = 60,
+      curvature = 1,
+      shape = 0,
+      ncp = 1
+    ) +
+    geom_curve(
+      aes(x, y, xend = xend, yend = yend, color = "spline cubic"),
+      curvature = -.5,
+      angle = 40,
+      shape = 1,
+      ncp = 1
+    ) +
+    geom_curve(
+      aes(x, y, xend = xend, yend = yend, color = "spline interpolating"),
+      curvature = -.5,
+      angle = 40,
+      shape = -1,
+      ncp = 1
+    ) +
+    NULL
+
+  expect_doppelganger("multishape geom_curve", p)
+
+})