fix various geom_sf related issues (#2216)

* addresses #2119

* tidy graticule fixes

* ggplot2 side of issue r-spatial/sf#396

* tabs -> spaces

* add ndiscr to docs

* fix #2200

* attempt to fix #2060

All cases were in sf.R a geometry column is address with x$geometry, ggplot2 made the wrong assumption that the geometry column has a fixed name. I replaced this in certain instances, where the data are already pretty transformed and no longer have properties of sf objects, with a fixed position, i.e. x[[1]], which seems to work.

* fixes r-spatial/sf#438

* address review comments

* fix break on geom_raster, objects without list-column

see https://gist.github.com/mdsumner/573ec70014df177baa2d1df7e55e1943 for the case that this PR fixes

* tidy up

* trying @karawoo's suggestion

* adds some sf tests

* tidy further

Author: edzer

R/sf.R

@@ -61,6 +61,22 @@
 #' @name ggsf
 NULL
 
+geom_column <- function(data) {
+  w <- which(vapply(data, inherits, TRUE, what = "sfc"))
+  if (length(w) == 0) {
+    "geometry" # avoids breaks when objects without geometry list-column are examined
+  } else {
+    # this may not be best in case more than one geometry list-column is present:
+    if (length(w) > 1)
+      warning("more than one geometry column present: taking the first")
+    w[[1]]
+  }
+}
+
+is_sf <- function(data) {
+  inherits(data, "sf")
+}
+
 # stat --------------------------------------------------------------------
 
 #' @export
@@ -69,7 +85,7 @@ NULL
 #' @format NULL
 StatSf <- ggproto("StatSf", Stat,
   compute_group = function(data, scales) {
-    bbox <- sf::st_bbox(data$geometry)
+    bbox <- sf::st_bbox(data[[ geom_column(data) ]])
     data$xmin <- bbox[["xmin"]]
     data$xmax <- bbox[["xmax"]]
     data$ymin <- bbox[["ymin"]]
@@ -151,7 +167,7 @@ geom_sf <- function(mapping = aes(), data = NULL, stat = "sf",
                     inherit.aes = TRUE, ...) {
 
   # Automatically determin name of geometry column
-  if (!is.null(data) && inherits(data, "sf")) {
+  if (!is.null(data) && is_sf(data)) {
     geometry_col <- attr(data, "sf_column")
   } else {
     geometry_col <- "geometry"
@@ -189,8 +205,9 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     }
 
     for (layer_data in data) {
-      geometry <- layer_data$geometry
-      if (is.null(geometry))
+      if (is_sf(layer_data)) {
+        geometry <- sf::st_geometry(layer_data)
+      } else
         next
 
       crs <- sf::st_crs(geometry)
@@ -209,18 +226,17 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
       return(data)
 
     lapply(data, function(layer_data) {
-      if (is.null(layer_data$geometry)) {
+      if (! is_sf(layer_data)) {
         return(layer_data)
       }
 
-      layer_data$geometry <- sf::st_transform(layer_data$geometry, params$crs)
-      layer_data
+      sf::st_transform(layer_data, params$crs)
     })
   },
 
   transform = function(self, data, panel_params) {
-    data$geometry <- sf_rescale01(
-      data$geometry,
+    data[[ geom_column(data) ]] <- sf_rescale01(
+      data[[ geom_column(data) ]],
       panel_params$x_range,
       panel_params$y_range
     )
@@ -257,13 +273,14 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     # remove tick labels not on axes 1 (bottom) and 2 (left)
     if (!is.null(graticule$plot12))
       graticule$degree_label[!graticule$plot12] <- NA
-	
+
     sf::st_geometry(graticule) <- sf_rescale01(sf::st_geometry(graticule), x_range, y_range)
     graticule$x_start <- sf_rescale01_x(graticule$x_start, x_range)
     graticule$x_end <- sf_rescale01_x(graticule$x_end, x_range)
     graticule$y_start <- sf_rescale01_x(graticule$y_start, y_range)
     graticule$y_end <- sf_rescale01_x(graticule$y_end, y_range)
-    graticule$degree_label <- lapply(graticule$degree_label, function(x) parse(text = x)[[1]])
+    if (any(grepl("degree", graticule$degree_label)))
+      graticule$degree_label <- lapply(graticule$degree_label, function(x) parse(text = x)[[1]])
 
     list(
       x_range = x_range,

man/ggsf.Rd

@@ -13,7 +13,7 @@ test_that("geom_xxx and GeomXxx$draw arg defaults match", {
   # These aren't actually geoms, or need special parameters and can't be tested this way.
   geom_fun_names <- setdiff(
     geom_fun_names,
-    c("geom_map", "geom_sf", "annotation_custom", "annotation_map",
+    c("geom_map", "geom_sf", "geom_column", "annotation_custom", "annotation_map",
       "annotation_raster", "annotation_id")
   )
 

tests/testthat/test-function-args.r

@@ -0,0 +1,15 @@
+context("geom-sf")
+
+# Visual tests ------------------------------------------------------------
+
+test_that("geom_sf draws correctly", {
+  skip_if_not_installed("sf")
+
+  f <- system.file("gpkg/nc.gpkg", package="sf")
+  nc <- sf::read_sf(f)
+  ggplot() + geom_sf(data = nc)
+  ggplot() + geom_sf(data = nc) + coord_sf(datum = 4326)
+
+  pts <- sf::st_sf(a = 1:2, geometry = sf::st_sfc(sf::st_point(0:1), sf::st_point(1:2)))
+  ggplot() + geom_sf(data = pts)
+})