make legend detection code more robust. (#3964)

* make legend detection code more robust. fixes #3963

* properly infer geometry from the right column

* add unit test

* add news.md

Author: clauswilke

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* Fixed a bug in `geom_sf()` that caused problems with legend-type
+  autodetection (@clauswilke, #3963).
+
 * `annotation_raster()` adds support for native rasters. For large rasters,
   native rasters render significantly faster than arrays (@kent37, #3388)
 

R/layer-sf.R

@@ -42,20 +42,25 @@ LayerSf <- ggproto("LayerSf", Layer,
         (!isTRUE(self$inherit.aes) && is.null(self$mapping$geometry))) {
       if (is_sf(data)) {
         geometry_col <- attr(data, "sf_column")
-        self$mapping$geometry <- as.name(geometry_col)
+        self$mapping$geometry <- sym(geometry_col)
       }
     }
 
     # automatically determine the legend type
     if (is.null(self$legend_key_type)) {
-      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"
+      # first, set default value in case downstream tests fail
+      self$geom_params$legend <- "polygon"
+
+      # now check if the type should not be polygon
+      if (!is.null(self$mapping$geometry)) {
+        geometry_column <- as_name(self$mapping$geometry)
+        if (inherits(data[[geometry_column]], "sfc")) {
+          sf_type <- detect_sf_type(data[[geometry_column]])
+          if (sf_type == "point") {
+            self$geom_params$legend <- "point"
+          } else if (sf_type == "line") {
+            self$geom_params$legend <- "line"
+          }
         }
       }
     } else {

tests/testthat/test-geom-sf.R

@@ -52,6 +52,32 @@ test_that("geom_sf() determines the legend type automatically", {
   expect_identical(fun_geom_sf(mpol, "point")$plot$layers[[1]]$geom_params$legend, "point")
 })
 
+test_that("geom_sf() determines the legend type from mapped geometry column", {
+  skip_if_not_installed("sf")
+  if (packageVersion("sf") < "0.5.3") skip("Need sf 0.5.3")
+
+  p1 <- rbind(c(1,1), c(2,2), c(3,3))
+  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))
+
+  d_sf <- sf::st_sf(
+    g_point = sf::st_sfc(sf::st_multipoint(p1)),
+    g_line = sf::st_sfc(sf::st_multilinestring(list(s1, s2, s3))),
+    v = "a"
+  )
+
+  p <- ggplot_build(
+    ggplot(d_sf) + geom_sf(aes(geometry = g_point, colour = "a"))
+  )
+  expect_identical(p$plot$layers[[1]]$geom_params$legend, "point")
+
+  p <- ggplot_build(
+    ggplot(d_sf) + geom_sf(aes(geometry = g_line, colour = "a"))
+  )
+  expect_identical(p$plot$layers[[1]]$geom_params$legend, "line")
+})
+
 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")