support all sf geometry types

Author: cpsievert

R/ggplotly.R

@@ -621,7 +621,7 @@ gg2list <- function(p, width = NULL, height = NULL,
 
         if (sum(isGrill) == 0) {
           # TODO: reduce the number of points (via coord_munch?)
-          d <- sf_fortify(rng$graticule)
+          d <- fortify_sf(rng$graticule)
           d$x <- scales::rescale(d$x, rng$x_range, from = c(0, 1))
           d$y <- scales::rescale(d$y, rng$y_range, from = c(0, 1))
           params <- list(

R/group2NA.R

@@ -49,7 +49,7 @@ group2NA <- function(data, groupNames = "group", nested = NULL, ordered = NULL,
   datClass <- oldClass(data)
 
   # data.table doesn't play nice with list-columns
-  if (inherits(data, "sf") || inherits(data, "GeomSf")) data <- sf_fortify(data)
+  if (inherits(data, "sf")) data <- fortify_sf(data)
 
   # evaluate this lazy argument now (in case we change class of data)
   retrace <- force(retrace.first)

R/layers2traces.R

@@ -273,12 +273,27 @@ to_basic.GeomRect <- function(data, prestats_data, layout, params, p, ...) {
 #' @export
 to_basic.GeomSf <- function(data, prestats_data, layout, params, p, ...) {
 
-  # map sf geometry types to a suitable "basic geom"
-  # TODO: support more of the esoteric geometry types, see sf::st_geometry_type
-  # most important is probable geometry collection
-  geom_type <- sf::st_geometry_type(sf::st_as_sf(data))
+  data <- sf::st_as_sf(data)
+  geom_type <- sf::st_geometry_type(data)
+  # st_cast should "expand" a collection into multiple rows (one per feature)
+  if ("GEOMETRYCOLLECTION" %in% geom_type) {
+    data <- sf::st_cast(data)
+    geom_type <- sf::st_geometry_type(data)
+  }
+  data <- remove_class(data, "sf")
+  
   basic_type <- dplyr::recode(
     as.character(geom_type),
+    TRIANGLE = "GeomPolygon",
+    TIN = "GeomPolygon",
+    POLYHEDRALSURFACE = "GeomPolygon",
+    SURFACE = "GeomPolygon",
+    CURVE = "GeomPath",
+    MULTISURFACE = "GeomPolygon",
+    MULTICURVE = "GeomPath",
+    CURVEPOLYGON = "GeomPolygon",
+    COMPOUNDCURVE = "GeomPath",
+    CIRCULARSTRING = "GeomPath",
     MULTIPOLYGON = "GeomPolygon",
     MULTILINESTRING = "GeomPath",
     MULTIPOINT = "GeomPoint",
@@ -290,7 +305,9 @@ to_basic.GeomSf <- function(data, prestats_data, layout, params, p, ...) {
   # return a list of data frames...one for every geometry (a la, GeomSmooth)
   d <- split(data, basic_type)
   for (i in seq_along(d)) {
-    d[[i]] <- prefix_class(d[[i]], names(d)[[i]])
+    d[[i]] <- prefix_class(
+      fortify_sf(d[[i]]), c(names(d)[[i]], "GeomSf")
+    )
   }
   if (length(d) == 1) d[[1]] else d
 }

R/sf.R

@@ -1,22 +1,24 @@
-sf_fortify <- function(model, ...) {
+fortify_sf <- function(model, ...) {
   # TODO: 
   # (1) avoid converting redundant features
   # (2) warn/error if data already contains x/y 
   geoms <- sf::st_geometry(sf::st_as_sf(model))
   xy <- lapply(geoms, st_as_plotly)
   ids <- rep(seq_len(nrow(model)), sapply(xy, nrow))
+  # TODO: faster way to row bind matrices?
   xy_all <- cbind(do.call(rbind, xy), ids)
-  sf_key_name <- ".sf-group-id"
-  xy_dat <- setNames(as.data.frame(xy_all), c("x", "y", sf_key_name))
+  xy_dat <- setNames(as.data.frame(xy_all), c("x", "y", sf_key()))
 
   d <- as.data.frame(model)
   d$geometry <- NULL
-  d[[sf_key_name]] <- seq_len(nrow(d))
-  xy_dat <- dplyr::left_join(xy_dat, d, by = sf_key_name)
-  xy_dat[[sf_key_name]] <- NULL
+  d[[sf_key()]] <- seq_len(nrow(d))
+  xy_dat <- dplyr::left_join(xy_dat, d, by = sf_key())
+  xy_dat[[sf_key()]] <- NULL
   xy_dat
 }
 
+sf_key <- function() ".sf-group-id"
+
 # kind of like sf_as_grob(), but maps to a plotly data structure, rather than a grob
 st_as_plotly <- function(x, ...) {
   UseMethod("st_as_plotly")
@@ -84,7 +86,6 @@ st_as_plotly.CURVEPOLYGON = st_as_plotly.GEOMETRYCOLLECTION
 st_as_plotly.COMPOUNDCURVE = st_as_plotly.GEOMETRYCOLLECTION
 
 
-
 empty_xy <- function() {
   matrix(rep(NA, 2), ncol = 2)
 }

tests/testthat/test-ggplot-sf.R

@@ -2,7 +2,6 @@ context("geom_sf")
 
 nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)
 
-
 test_that("geom_sf() basic polygons.", {
   skip_if_not_installed("sf")
 
@@ -20,7 +19,30 @@ test_that("geom_sf() basic polygons.", {
   )
 })
 
-
+test_that("geom_sf() geometry collection.", {
+  skip_if_not_installed("sf")
+  
+  # example from the sf vignette
+  a <- sf::st_polygon(list(cbind(c(0,0,7.5,7.5,0),c(0,-1,-1,0,0))))
+  b <- sf::st_polygon(list(cbind(c(0,1,2,3,4,5,6,7,7,0),c(1,0,.5,0,0,0.5,-0.5,-0.5,1,1))))
+  i <- sf::st_intersection(a, b)
+  cd <- sf::st_as_sf(data.frame(x = 1, geometry = sf::st_sfc(i)))
+  
+  p <- ggplot(cd) + geom_sf()
+  l <- save_outputs(p, "sf-geom-collection")
+  
+  # graticule, point, line, polygon
+  expect_length(l$data, 4)
+  
+  # test data/default for line
+  # TODO: test that defaults are correct one geom_sf() becomes stable
+  expect_equivalent(l$data[[2]]$x, c(4, 3))
+  expect_equivalent(l$data[[2]]$y, c(0, 0))
+  expect_equivalent(l$data[[3]]$x, I(1))
+  expect_equivalent(l$data[[3]]$y, I(0))
+  expect_equivalent(l$data[[4]]$x, c(5.5, 7, 7, 6, 5.5, NA, 5.5))
+  expect_equivalent(l$data[[4]]$y, c(0, 0, -.5, -.5, 0, NA, 0))
+})
 
 test_that("geom_sf() polygons with fill/text.", {
   skip_if_not_installed("sf")
@@ -40,8 +62,6 @@ test_that("geom_sf() polygons with fill/text.", {
   )
 })
 
-
-
 test_that("geom_sf() with basic polygons and points.", {
   skip_if_not_installed("sf")
 
@@ -65,7 +85,6 @@ test_that("sf aspect ratio is correct", {
   p <- ggplot(nc) + geom_sf() 
 
   l <- save_outputs(p, "sf-aspect")
-  
   expect_equivalent(l$layout$xaxis$scaleanchor, "y")
   expect_equal(l$layout$xaxis$scaleratio, 0.81678435872298)
 })