preliminary sf support for plot_mapbox() and plot_ly() based on GeomSf logic

Author: cpsievert

R/plotly_build.R

@@ -115,16 +115,16 @@ plotly_build.plotly <- function(p, registerFrames = TRUE) {
     # perform the evaluation
     dat <- plotly_data(p, y)
 
+      
+    
     # set special defaults for sf
     if (inherits(dat, "sf")) {
       # TODO: 
-      # (1) check/change the crs? https://github.com/rstudio/leaflet/blob/d489e2cd/R/normalize-sf.R#L94-L113
-      # (2) One trace/layer can sometime map to multiple traces (e.g., an sf object with points and lines)   
-      # (3) st_cast() if a geometry collection?
+      # (1) One trace/layer can sometime map to multiple traces (e.g., an sf object with points and lines)   
+      # (2) st_cast() if a geometry collection?
       x$`_bbox` <- sf::st_bbox(dat)
-      dat <- fortify_sf(dat)
-      x$x <- ~x
-      x$y <- ~y
+      dat <- to_basic.GeomSf(dat)
+      x <- modify_list(geom2trace(dat, params = list()), x)
     }
 
     trace <- structure(

R/sf.R

@@ -2,6 +2,8 @@ fortify_sf <- function(model, ...) {
   # TODO: 
   # (1) avoid converting redundant features
   # (2) warn/error if data already contains x/y 
+  sf_crs_check(model)
+  
   geoms <- sf::st_geometry(sf::st_as_sf(model))
   xy <- lapply(geoms, st_as_plotly)
   ids <- rep(seq_len(nrow(model)), sapply(xy, nrow))
@@ -89,3 +91,24 @@ st_as_plotly.COMPOUNDCURVE = st_as_plotly.GEOMETRYCOLLECTION
 empty_xy <- function() {
   matrix(rep(NA, 2), ncol = 2)
 }
+
+
+# thanks Hadley Wickham https://github.com/rstudio/leaflet/blame/d489e2cd/R/normalize-sf.R#L94-L113
+sf_crs_check <- function(x) {
+  crs <- sf::st_crs(x)
+  
+  # Don't have enough information to check
+  if (is.na(crs)) return()
+  
+  if (identical(sf::st_is_longlat(x), FALSE)) {
+    warning("sf layer is not long-lat data", call. = FALSE)
+  }
+  
+  if (!grepl("+datum=WGS84", crs$proj4string, fixed = TRUE)) {
+    warning(
+      "sf layer has inconsistent datum (", crs$proj4string, ").\n",
+      "Need '+proj=longlat +datum=WGS84'",
+      call. = FALSE
+    )
+  }
+}

R/utils.R

@@ -213,6 +213,7 @@ mapbox_fit_bounds <- function(p) {
   mapboxIDs <- grep("^mapbox", sapply(p$x$data, "[[", "subplot"), value = TRUE)
   for (id in mapboxIDs) {
     bboxes <- lapply(p$x$data, function(tr) if (identical(id, tr$subplot)) tr[["_bbox"]])
+    if (sum(lengths(bboxes)) == 0) next
     # intentionally an array of numbers in [west, south, east, north] order
     # https://www.mapbox.com/mapbox-gl-js/api/#lnglatboundslike
     p$x$layout[[id]]$`_fitBounds` <- list(