Enable geom_sf to automatically determine the legend type (#3646)

* automatically determine the legend type

* add tests

* add news item

Author: microly

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* `geom_sf()` now determines the legend type automatically (@microly, #3646).
+  
 * `scale_x_continuous()` and `scale_y_continuous()` gains an `n.breaks` argument
   guiding the number of automatic generated breaks (@thomasp85, #3102)
 

R/geom-sf.R

@@ -197,11 +197,10 @@ geom_sf <- function(mapping = aes(), data = NULL, stat = "sf",
       mapping = mapping,
       stat = stat,
       position = position,
-      show.legend = if (is.character(show.legend)) TRUE else show.legend,
+      show.legend = show.legend,
       inherit.aes = inherit.aes,
       params = list(
         na.rm = na.rm,
-        legend = if (is.character(show.legend)) show.legend else "polygon",
         ...
       )
     ),

R/layer-sf.R

@@ -35,6 +35,23 @@ LayerSf <- ggproto("LayerSf", Layer,
         self$mapping$geometry <- as.name(geometry_col)
       }
     }
+
+    # automatically determine the legend type
+    if (is.na(self$show.legend) || isTRUE(self$show.legend)) {
+      if (is_sf(data)) {
+        sf_type <- detect_sf_type(data)
+        if (sf_type == "point") {
+          self$geom_params$legend <- "point"
+        } else if (sf_type == "line") {
+          self$geom_params$legend <- "line"
+        } else {
+          self$geom_params$legend <- "polygon"
+        }
+      }
+    } else if (is.character(self$show.legend)) {
+      self$geom_params$legend <- self$show.legend
+      self$show.legend <- TRUE
+    }
     data
   }
 )
@@ -62,3 +79,9 @@ is_sf <- function(data) {
 #' @export
 scale_type.sfc <- function(x) "identity"
 
+# helper function to determine the geometry type of sf object
+detect_sf_type <- function(sf) {
+  geometry_type <- unique(as.character(sf::st_geometry_type(sf)))
+  if (length(geometry_type) != 1)  geometry_type <- "GEOMETRY"
+  sf_types[geometry_type]
+}

R/stat-sf.R

@@ -28,11 +28,10 @@ stat_sf <- function(mapping = NULL, data = NULL, geom = "rect",
     mapping = mapping,
     geom = geom,
     position = position,
-    show.legend = if (is.character(show.legend)) TRUE else show.legend,
+    show.legend = show.legend,
     inherit.aes = inherit.aes,
     params = list(
       na.rm = na.rm,
-      legend = if (is.character(show.legend)) show.legend else "polygon",
       ...
     )
   )

tests/testthat/test-geom-sf.R

@@ -1,5 +1,57 @@
 context("geom-sf")
 
+test_that("geom_sf() determines the legend type automatically", {
+  skip_if_not_installed("sf")
+  if (packageVersion("sf") < "0.5.3") skip("Need sf 0.5.3")
+
+  mp <- sf::st_sf(
+    geometry = sf::st_sfc(sf::st_multipoint(rbind(c(1,1), c(2,2), c(3,3)))),
+    v = "a")
+
+  s1 <- rbind(c(0,3),c(0,4),c(1,5),c(2,5))
+  s2 <- rbind(c(0.2,3), c(0.2,4), c(1,4.8), c(2,4.8))
+  s3 <- rbind(c(0,4.4), c(0.6,5))
+
+  mls <- sf::st_sf(
+    geometry = sf::st_sfc(sf::st_multilinestring(list(s1,s2,s3))),
+    v = "a")
+
+  p1 <- rbind(c(0,0), c(1,0), c(3,2), c(2,4), c(1,4), c(0,0))
+  p2 <- rbind(c(1,1), c(1,2), c(2,2), c(1,1))
+  p3 <- rbind(c(3,0), c(4,0), c(4,1), c(3,1), c(3,0))
+  p4 <- rbind(c(3.3,0.3), c(3.8,0.3), c(3.8,0.8), c(3.3,0.8), c(3.3,0.3))[5:1,]
+  p5 <- rbind(c(3,3), c(4,2), c(4,3), c(3,3))
+
+  mpol <- sf::st_sf(
+    geometry = sf::st_sfc(sf::st_multipolygon(list(list(p1,p2), list(p3,p4), list(p5)))),
+    v = "a")
+
+  fun_geom_sf <- function(sf, show.legend) {
+    p <- ggplot() + geom_sf(aes(colour = v), data = sf, show.legend = show.legend)
+    ggplot_build(p)
+  }
+
+  # test the automatic choice
+  expect_identical(fun_geom_sf(mp, TRUE)$plot$layers[[1]]$show.legend, TRUE)
+  expect_identical(fun_geom_sf(mp, TRUE)$plot$layers[[1]]$geom_params$legend, "point")
+
+  expect_identical(fun_geom_sf(mls, TRUE)$plot$layers[[1]]$show.legend, TRUE)
+  expect_identical(fun_geom_sf(mls, TRUE)$plot$layers[[1]]$geom_params$legend, "line")
+
+  expect_identical(fun_geom_sf(mpol, TRUE)$plot$layers[[1]]$show.legend, TRUE)
+  expect_identical(fun_geom_sf(mpol, TRUE)$plot$layers[[1]]$geom_params$legend, "polygon")
+
+  # test that automatic choice can be overridden manually
+  expect_identical(fun_geom_sf(mp, "point")$plot$layers[[1]]$show.legend, TRUE)
+  expect_identical(fun_geom_sf(mp, "point")$plot$layers[[1]]$geom_params$legend, "point")
+
+  expect_identical(fun_geom_sf(mls, "point")$plot$layers[[1]]$show.legend, TRUE)
+  expect_identical(fun_geom_sf(mls, "point")$plot$layers[[1]]$geom_params$legend, "point")
+
+  expect_identical(fun_geom_sf(mpol, "point")$plot$layers[[1]]$show.legend, TRUE)
+  expect_identical(fun_geom_sf(mpol, "point")$plot$layers[[1]]$geom_params$legend, "point")
+})
+
 test_that("geom_sf() removes rows containing missing aes", {
   skip_if_not_installed("sf")
   if (packageVersion("sf") < "0.5.3") skip("Need sf 0.5.3")