Add arrow to line params (#4659)

Author: JakeRuss

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* `geom_sf()` now respects `arrow` parameter for lines (@jakeruss, #4659)
+
 * Updated documentation for `print.ggplot` to reflect that it returns
   the original plot, not the result of `ggplot_build()`. (@r2evans, #4390)
 

R/geom-sf.R

@@ -128,14 +128,15 @@ GeomSf <- ggproto("GeomSf", Geom,
 
   draw_panel = function(data, panel_params, coord, legend = NULL,
                         lineend = "butt", linejoin = "round", linemitre = 10,
-                        na.rm = TRUE) {
+                        arrow = NULL, na.rm = TRUE) {
     if (!inherits(coord, "CoordSf")) {
       abort("geom_sf() must be used with coord_sf()")
     }
 
     # Need to refactor this to generate one grob per geometry type
     coord <- coord$transform(data, panel_params)
-    sf_grob(coord, lineend = lineend, linejoin = linejoin, linemitre = linemitre, na.rm = na.rm)
+    sf_grob(coord, lineend = lineend, linejoin = linejoin, linemitre = linemitre,
+            arrow = arrow, na.rm = na.rm)
   },
 
   draw_key = function(data, params, size) {
@@ -160,7 +161,8 @@ default_aesthetics <- function(type) {
   }
 }
 
-sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10, na.rm = TRUE) {
+sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10,
+                    arrow = NULL, na.rm = TRUE) {
   type <- sf_types[sf::st_geometry_type(x$geometry)]
   is_point <- type == "point"
   is_line <- type == "line"
@@ -210,7 +212,7 @@ sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10, na.
     col = col, fill = fill, fontsize = fontsize, lwd = lwd, lty = lty,
     lineend = lineend, linejoin = linejoin, linemitre = linemitre
   )
-  sf::st_as_grob(x$geometry, pch = pch, gp = gp)
+  sf::st_as_grob(x$geometry, pch = pch, gp = gp, arrow = arrow)
 }
 
 #' @export

tests/testthat/_snaps/geom-sf/north-carolina-county-boundaries-with-arrow.svg

@@ -200,3 +200,38 @@ test_that("geom_sf_text() and geom_sf_label() draws correctly", {
     ggplot() + geom_sf_label(data = nc_3857, aes(label = NAME))
   )
 })
+
+test_that("geom_sf draws arrows correctly", {
+  skip_if_not_installed("sf")
+  if (packageVersion("sf") < "0.5.3") skip("Need sf 0.5.3")
+
+  nc_tiny_coords <- data_frame(
+    x = c(-81.473, -81.741, -81.67, -81.345, -81.266, -81.24, -81.473),
+    y = c(36.234, 36.392, 36.59, 36.573, 36.437, 36.365, 36.234)
+  )
+
+  nc <- sf::st_linestring(
+      sf::st_coordinates(sf::st_as_sf(nc_tiny_coords, coords = c("x", "y"), crs = 4326))
+    )
+
+  nc2 <- sf::st_cast(
+    sf::st_sfc(
+      sf::st_multilinestring(lapply(
+        1:(length(sf::st_coordinates(nc)[, 1]) - 1),
+          function(x) rbind(
+            as.numeric(sf::st_coordinates(nc)[x, 1:2]),
+            as.numeric(sf::st_coordinates(nc)[x + 1, 1:2])
+            )
+        )
+      ), sf::st_crs(nc)
+    ), "LINESTRING"
+  )
+
+  expect_doppelganger("North Carolina county boundaries with arrow",
+    ggplot() + geom_sf(data = nc, arrow = arrow()) + coord_sf(datum = 4326)
+  )
+
+  expect_doppelganger("North Carolina county boundaries with more than one arrow",
+    ggplot() + geom_sf(data = nc2, arrow = arrow()) + coord_sf(datum = 4326)
+  )
+})