route sf::st_bbox to mapbox's fitBounds method

Author: cpsievert

R/plotly_build.R

@@ -117,6 +117,11 @@ plotly_build.plotly <- function(p, registerFrames = TRUE) {
 
     # 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?
+      x$`_bbox` <- sf::st_bbox(dat)
       dat <- fortify_sf(dat)
       x$x <- ~x
       x$y <- ~y
@@ -333,6 +338,10 @@ plotly_build.plotly <- function(p, registerFrames = TRUE) {
     tr
   })
 
+  # Compute sensible bounding boxes for each mapbox subplot
+  # TODO: could/should we do this for plot_ly()/plot_geo() as well?
+  p <- mapbox_fit_bounds(p)
+  
   # polar charts don't like null width/height keys
   if (is.null(p$x$layout[["height"]])) p$x$layout[["height"]] <- NULL
   if (is.null(p$x$layout[["width"]])) p$x$layout[["width"]] <- NULL

R/utils.R

@@ -209,6 +209,31 @@ mapbox_token <- function() {
   token
 }
 
+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"]])
+    # 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(
+      bounds = c(
+        min(unlist(lapply(bboxes, "[[", "xmin")), na.rm = TRUE),
+        min(unlist(lapply(bboxes, "[[", "ymin")), na.rm = TRUE),
+        max(unlist(lapply(bboxes, "[[", "xmax")), na.rm = TRUE),
+        max(unlist(lapply(bboxes, "[[", "ymax")), na.rm = TRUE)
+      ),
+      options = list(
+        padding = 10, 
+        linear = FALSE,
+        # NOTE TO SELF: can do something like this to customize easing
+        # easing = htmlwidgets::JS("function(x) { return 1; }"),
+        offset = c(0, 0)
+      )
+    )
+  }
+  p
+}
+
 # rename attrs (unevaluated arguments) from geo locations (lat/lon) to cartesian
 geo2cartesian <- function(p) {
   p$x$attrs <- lapply(p$x$attrs, function(tr) {

demo/sf-data-scattermapbox.R

@@ -2,24 +2,15 @@ library(sf)
 library(plotly)
 
 nc <- st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)
-bb <- st_bbox(nc)
 
-# TODO: make this more obvious and automatic
-plot_mapbox(
-  data = group2NA(nc), 
-  x = ~x, 
-  y = ~y, 
+p1 <- plot_mapbox(
+  nc,
   mode = "lines", 
   fillcolor = "green", 
   fill = "toself", 
   line = list(size = 0.01, color = "black")
-) %>%
-  layout(
-    mapbox = list(
-      center = list(
-        lat  = mean(bb[c("ymin", "ymax")]), 
-        lon = mean(bb[c("xmin", "xmax")])
-      ),
-      zoom = 6
-    )
-  )
+)
+
+subplot(p1, p1)
+
+# TODO: dropdown button for changing the baselayer

inst/htmlwidgets/plotly.js

@@ -192,6 +192,22 @@ HTMLWidgets.widget({
           Plotly[msg.method].apply(null, args);
         });
       }
+      
+      // plotly's mapbox API doesn't currently support setting bounding boxes
+      // https://www.mapbox.com/mapbox-gl-js/example/fitbounds/
+      // so we do this manually...
+      var mapboxIDs = graphDiv._fullLayout._subplots.mapbox;
+      for (var i = 0; i < mapboxIDs.length; i++) {
+        var id = mapboxIDs[i];
+        var mapOpts = x.layout[id] || {};
+        var args = mapOpts._fitBounds || {}
+        if (!args) {
+          continue;
+        }
+        var mapObj = graphDiv._fullLayout[id]._subplot.map;
+        mapObj.fitBounds(args.bounds, args.options);
+      }
+      
     });
 
     // Attach attributes (e.g., "key", "z") to plotly event data