Merge pull request #725 from ropensci/maps

Maps

Author: cpsievert

NAMESPACE

@@ -97,7 +97,6 @@ export(event_data)
 export(export)
 export(filter)
 export(filter_)
-export(geo)
 export(geom2trace)
 export(get_figure)
 export(gg2list)
@@ -111,11 +110,12 @@ export(hide_legend)
 export(knit_print.plotly_figure)
 export(last_plot)
 export(layout)
-export(mapbox)
 export(mutate)
 export(mutate_)
 export(offline)
+export(plot_geo)
 export(plot_ly)
+export(plot_mapbox)
 export(plotly)
 export(plotlyOutput)
 export(plotly_IMAGE)

NEWS.md

@@ -1,3 +1,16 @@
+# 4.5.0 -- 21 September 2016
+
+## NEW FEATURES
+
+* Added the `plot_mapbox()` and `plot_geo()` functions, which make it easier to work with the "scattermapbox", "scattergeo", and "choropleth" trace types. See the maps chapter of the plotly book for examples -- <https://cpsievert.github.io/plotly_book/maps.html> 
+* Added the `add_mesh3d()` and `add_pie()` functions as wrappers around the "mesh3d", and "pie" trace types.
+
+## CHANGES
+
+* The `add_scattergeo()` and `add_choropleth()` functions have been deprecated in favor of `plot_geo()`. 
+* The `add_area(...)` function changed it's meaning from `add_lines(..., fill = 'tozeroy')` to a wrapper around the area trace <https://plot.ly/r/reference/#area>. This is more consistent with the naming conventions already in place for other `add_()` functions.
+* `add_ribbons()` now shows points (instead of fill) on hover.
+
 # 4.4.5 -- 19 September 2016
 
 ## NEW FEATURES

R/add.R

@@ -82,20 +82,6 @@ add_trace <- function(p, ..., color, symbol, size, linetype,
     attrs <- modify_list(p$x$attrs[[1]], attrs)
   }
 
-  if (is_mapbox(p) || is_geo(p)) {
-    attrs[["x"]] <- attrs[["x"]] %||% attrs[["lat"]]
-    attrs[["y"]] <- attrs[["y"]] %||% attrs[["lon"]]
-    if (!grepl("scatter", attrs[["type"]])) {
-      stop("Cant add a '", attrs[["type"]], "' trace to a map object", call. = FALSE)
-    }
-    if (is_mapbox(p)) {
-      attrs[["type"]] <- "scattermapbox"
-    }
-    if (is_geo(p)) {
-      attrs[["type"]] <- "scattergeo"
-    }
-  }
-  
   p$x$attrs <- c(
     p$x$attrs %||% list(), 
     setNames(list(attrs), p$x$cur_data)
@@ -528,7 +514,6 @@ add_mesh <- function(p, x = NULL, y = NULL, z = NULL, ...,
 #' @inheritParams add_trace
 #' @rdname add_trace
 #' @export
-#' 
 add_scattergeo <- function(p, ...) {
   .Deprecated("geo")
   p
@@ -537,24 +522,10 @@ add_scattergeo <- function(p, ...) {
 #' @inheritParams add_trace
 #' @rdname add_trace
 #' @export
-#' @examples 
-#' density <- state.x77[, "Population"] / state.x77[, "Area"]
-#' plot_ly(z = ~density) %>% 
-#'   add_choropleth(locations = state.abb, locationmode = 'USA-states') %>%
-#'   layout(geo = list(scope = "usa"))
 add_choropleth <- function(p, z = NULL, geo = NULL, ..., 
                            data = NULL, inherit = TRUE) {
-  if (inherit) {
-    z <- z %||% p$x$attrs[[1]][["z"]]
-    geo <- geo %||% p$x$attrs[[1]][["geo"]] %||% "geo"
-  }
-  if (is.null(z)) {
-    stop("Must supply `z` attribute", call. = FALSE)
-  }
-  add_trace_classed(
-    p, class = "plotly_choropleth", z = z, type = "choropleth", geo = geo,
-    ..., data = data, inherit = inherit
-  )
+  .Deprecated("geo")
+  p
 }
 
 # attach a class to a trace which informs data processing in plotly_build

R/coord.R

@@ -0,0 +1,66 @@
+#' *** This won't be possible until plotly.js implements aspect ratios... ***
+#' 
+#' #' Force the aspect ratio according to x and y scales
+#' #' 
+#' #' When x and y are numeric variables measured on the same scale,
+#' #' or are related in some meaningful way, forcing the aspect ratio of the
+#' #' plot to be proportional to the ratio of a unit change in x versus y improves
+#' #' our ability to correctly perceive the data.
+#' #' 
+#' #' @param p a plotly object
+#' #' @param ratio aspect ratio, expressed as y / x
+#' #' @export
+#' #' @examples 
+#' #' 
+#' #' canada <- map_data("world", "canada")
+#' #' 
+#' #' canada %>%
+#' #'   group_by(group) %>%
+#' #'   plot_ly(x = ~long, y = ~lat, alpha = 0.2) %>%
+#' #'   add_polygons(hoverinfo = "none", color = I("black")) %>%
+#' #'   coord_fix()
+#' #' 
+#' #' # works on (non-faceted) ggplot2 plots, too
+#' #' gg <- ggplot(canada, aes(long, lat, group = group)) + 
+#' #'   geom_polygon() + coord_fixed()
+#' #' 
+#' #' gg %>%
+#' #'   ggplotly() %>%
+#' #'   coord_fix()
+#' #'   
+#' 
+#' coord_fix <- function(p, ratio = 1) {
+#'   p <- plotly_build(p)
+#'   # this won't work for subplots, or categorical data
+#'   x <- grepl("^xaxis", names(p$x$layout))
+#'   y <- grepl("^yaxis", names(p$x$layout))
+#'   if (sum(x) > 1 || sum(y) > 1) {
+#'     stop("Can not impose aspect ratio a plot with more than one x/y axis", call. = FALSE)
+#'   }
+#'   xDat <- unlist(lapply(p$x$data, "[[", "x"))
+#'   yDat <- unlist(lapply(p$x$data, "[[", "y"))
+#'   if (!is.numeric(xDat) || !is.numeric(yDat)) {
+#'     stop("Must have numeric data on both x and y axes to enforce aspect ratios", call. = FALSE)
+#'   }
+#'   
+#'   # warn about any pre-populated domains, they will get squashed
+#'   xDom <- p$x$layout[["xaxis"]]$domain %||% c(0, 1)
+#'   yDom <- p$x$layout[["yaxis"]]$domain %||% c(0, 1)
+#'   if (!identical(yDom, c(0, 1)) || !identical(xDom, c(0, 1))) {
+#'     warning(
+#'       "coord_fix() won't respect prespecified axis domains (other than the default)",
+#'       call. = FALSE
+#'     )
+#'   }
+#'   
+#'   xRng <- range(xDat, na.rm = TRUE)
+#'   yRng <- range(yDat, na.rm = TRUE)
+#'   asp <- ratio * diff(yRng) / diff(xRng)
+#'   if (asp < 1) {
+#'     p$x$layout[["yaxis"]]$domain <- c(0 + asp / 2, 1 - asp / 2)
+#'   } else {
+#'     asp <- 1 / asp
+#'     p$x$layout[["xaxis"]]$domain <- c(0 + asp / 2, 1 - asp / 2)
+#'   }
+#'   p
+#' }

R/dev.R

@@ -12,7 +12,7 @@
 #' plotly_json(plot_ly())
 #' plotly_json(plot_ly(), FALSE)
 
-plotly_json <- function(p = plot_ly(), jsonedit = interactive(), ...) {
+plotly_json <- function(p = last_plot(), jsonedit = interactive(), ...) {
   plotlyJSON <- to_JSON(plotly_build(p)$x, pretty = TRUE)
   if (jsonedit) {
     if (system.file(package = "listviewer") == "") {

R/plotly.R

@@ -34,8 +34,14 @@
 #' @param width	Width in pixels (optional, defaults to automatic sizing).
 #' @param height Height in pixels (optional, defaults to automatic sizing).
 #' @param source Only relevant for \link{event_data}.
-#' @seealso \code{\link{layout}()}, \code{\link{add_trace}()}, \code{\link{style}()}
 #' @author Carson Sievert
+#' @seealso \itemize{
+#'  \item For initializing a plotly-geo object: \code{\link{plot_geo}()}.
+#'  \item For initializing a plotly-mapbox object: \code{\link{plot_mapbox}()}.
+#'  \item For translating a ggplot2 object to a plotly object: \code{\link{ggplotly}()}.
+#'  \item For modifying any plotly object: \code{\link{layout}()}, \code{\link{add_trace}()}, \code{\link{style}()}
+#'  \item
+#' }
 #' @export
 #' @examples
 #' \dontrun{
@@ -153,11 +159,14 @@ plot_ly <- function(data = data.frame(), ..., type = NULL,
 #' valid scattermapbox attributes - \url{https://plot.ly/r/reference/#scattermapbox}.
 #' Note that x/y can also be used in place of lat/lon.
 #' @export
+#' @author Carson Sievert
+#' @seealso \code{\link{plot_ly}()}, \code{\link{plot_geo}()}, \code{\link{ggplotly}()} 
+#' 
 #' @examples \dontrun{
 #' 
 #' map_data("world", "canada") %>%
 #'   group_by(group) %>%
-#'   mapbox(x = ~lat, y = ~long) %>%
+#'   plot_mapbox(x = ~long, y = ~lat) %>%
 #'   add_polygons() %>%
 #'   layout(
 #'     mapbox = list(
@@ -166,10 +175,11 @@ plot_ly <- function(data = data.frame(), ..., type = NULL,
 #'   )
 #' }
 #' 
-mapbox <- function(data = data.frame(), ...) {
-  p <- plot_ly(data, ...)
-  p <- config(p, mapboxAccessToken = mapbox_token())
-  p$x$mapType <- "mapbox"
+plot_mapbox <- function(data = data.frame(), ...) {
+  p <- config(plot_ly(data, ...), mapboxAccessToken = mapbox_token())
+  # not only do we use this for is_mapbox(), but also setting the layout attr
+  # https://plot.ly/r/reference/#layout-mapbox
+  p$x$layout$mapType <- "mapbox"
   p
 }
 
@@ -182,16 +192,20 @@ mapbox <- function(data = data.frame(), ...) {
 #' 
 #' @param ... arguments passed along to \code{\link{plot_ly}()}.
 #' @export
+#' @author Carson Sievert
+#' @seealso \code{\link{plot_ly}()}, \code{\link{plot_mapbox}()}, \code{\link{ggplotly}()} 
 #' @examples
 #' 
 #' map_data("world", "canada") %>%
 #'   group_by(group) %>%
-#'   geo(x = ~lat, y = ~long) %>%
-#'   add_polygons()
+#'   plot_geo(x = ~long, y = ~lat) %>%
+#'   add_markers(size = I(1))
 #' 
-geo <- function(data = data.frame(), ...) {
+plot_geo <- function(data = data.frame(), ...) {
   p <- plot_ly(data, ...)
-  p$x$mapType <- "geo"
+  # not only do we use this for is_geo(), but also setting the layout attr
+  # https://plot.ly/r/reference/#layout-geo
+  p$x$layout$mapType <- "geo"
   p
 }
 

R/plotly_build.R

@@ -26,7 +26,8 @@ plotly_build.list <- function(p) {
 
 #' @export
 plotly_build.gg <- function(p) {
-  ggplotly(p)
+  p <- ggplotly(p)
+  supply_defaults(p)
 }
 
 #' @export
@@ -71,6 +72,24 @@ plotly_build.plotly <- function(p) {
       p$x$attrs[[1]] <- NULL
     }
   }
+  
+  # trace type checking and renaming for plot objects
+  if (is_mapbox(p) || is_geo(p)) {
+    p$x$attrs <- lapply(p$x$attrs, function(tr) {
+      tr[["x"]] <- tr[["x"]] %||% tr[["lat"]]
+      tr[["y"]] <- tr[["y"]] %||% tr[["lon"]]
+      if (!grepl("scatter|choropleth", tr[["type"]] %||% "scatter")) {
+        stop("Cant add a '", tr[["type"]], "' trace to a map object", call. = FALSE)
+      }
+      if (is_mapbox(p)) {
+        tr[["type"]] <- "scattermapbox"
+      }
+      if (is_geo(p)) {
+        tr[["type"]] <- if (!is.null(tr[["z"]])) "choropleth" else "scattergeo"
+      }
+      tr
+    })
+  }
 
   dats <- Map(function(x, y) {
 
@@ -270,16 +289,18 @@ plotly_build.plotly <- function(p) {
     }
   }
 
-  # attribute naming correction for "geo-like" traces
-  if (is_geo(p) || is_mapbox(p)) {
-    p$x$layout[grepl("^[x-y]axis", names(p$x$layout))] <- NULL
-    p$x$data <- lapply(p$x$data, function(tr) {
+  # supply trace anchor and domain information  
+  p <- supply_defaults(p)
+  
+  # attribute naming corrections for "geo-like" traces
+  p$x$data <- lapply(p$x$data, function(tr) {
+    if (isTRUE(tr[["type"]] %in% c("scattermapbox", "scattergeo"))) {
       tr[["lat"]] <- tr[["lat"]] %||% tr[["y"]]
       tr[["lon"]] <- tr[["lon"]] %||% tr[["x"]]
       tr[c("x", "y")] <- NULL
-      tr
-    })
-  }
+    }
+    tr
+  })
 
   # polar charts don't like null width/height keys 
   if (is.null(p$x$layout[["height"]])) p$x$layout[["height"]] <- NULL