change meaning of add_area(); deprecate add_scattergeo() in favor of geo(); add mapbox(), add_pie(), add_mesh()

Author: cpsievert

NAMESPACE

@@ -72,7 +72,9 @@ export(add_histogram2d)
 export(add_histogram2dcontour)
 export(add_lines)
 export(add_markers)
+export(add_mesh)
 export(add_paths)
+export(add_pie)
 export(add_polygons)
 export(add_ribbons)
 export(add_scattergeo)
@@ -95,6 +97,7 @@ export(event_data)
 export(export)
 export(filter)
 export(filter_)
+export(geo)
 export(geom2trace)
 export(get_figure)
 export(gg2list)
@@ -108,6 +111,7 @@ export(hide_legend)
 export(knit_print.plotly_figure)
 export(last_plot)
 export(layout)
+export(mapbox)
 export(mutate)
 export(mutate_)
 export(offline)

R/add.R

@@ -82,6 +82,20 @@ 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)
@@ -255,32 +269,57 @@ add_ribbons <- function(p, x = NULL, ymin = NULL, ymax = NULL, ...,
   )
 }
 
-
 #' @inheritParams add_trace
 #' @rdname add_trace
+#' @param r For polar chart only. Sets the radial coordinates.
+#' @param t For polar chart only. Sets the radial coordinates.
 #' @export
 #' @examples 
-#' huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron))
-#' plot_ly(huron, x = ~year, ymax = ~level) %>% add_area()
-add_area <- function(p, x = NULL, ymax = NULL, ...,
+#' p <- plot_ly(plotly::wind, r = ~r, t = ~t) %>% add_area(color = ~nms)
+#' layout(p, radialaxis = list(ticksuffix = "%"), orientation = 270)
+add_area <- function(p, r = NULL, t = NULL, ...,
                      data = NULL, inherit = TRUE) {
-  
   if (inherit) {
-    x <- x %||% p$x$attrs[[1]][["x"]]
-    ymax <- ymax %||% p$x$attrs[[1]][["ymax"]]
+    r <- t %||% p$x$attrs[[1]][["r"]]
+    t <- t %||% p$x$attrs[[1]][["t"]]
   }
-  if (is.null(x) || is.null(ymax)) {
-    stop("Must supply `x`/`ymax` attributes", call. = FALSE)
+  if (is.null(r) || is.null(t)) {
+    stop("Must supply `r`/`t` attributes", call. = FALSE)
   }
   add_trace_classed(
-    p, class = c("plotly_area", "plotly_ribbon", "plotly_polygon"), 
-    x = x, ymax = ymax,
-    type = "scatter", fill = "toself", mode = "lines", hoveron = "points",
+    p, class = "plotly_area", r = r, t = t, type = "area",
     ..., data = data, inherit = inherit
   )
 }
 
-
+#' @inheritParams add_trace
+#' @rdname add_trace
+#' @param values the value to associated with each slice of the pie.
+#' @param labels the labels (categories) corresponding to \code{values}.
+#' @export
+#' @examples 
+#' ds <- data.frame(
+#'   labels = c("A", "B", "C"),
+#'   values = c(10, 40, 60)
+#' )
+#' 
+#' plot_ly(ds, labels = ~labels, values = ~values) %>%
+#'   add_pie() %>%
+#'   layout(title = "Basic Pie Chart using Plotly")
+add_pie <- function(p, values = NULL, labels = NULL, ...,
+                     data = NULL, inherit = TRUE) {
+  if (inherit) {
+    values <- values %||% p$x$attrs[[1]][["values"]]
+    labels <- labels %||% p$x$attrs[[1]][["labels"]]
+  }
+  if (is.null(values)) {
+    stop("Must supply `values`", call. = FALSE)
+  }
+  add_trace_classed(
+    p, class = "plotly_pie", values = values, labels = labels, type = "pie",
+    ..., data = data, inherit = inherit
+  )
+}
 
 #' @inheritParams add_trace
 #' @rdname add_trace
@@ -464,24 +503,37 @@ add_surface <- function(p, z = NULL, ..., data = NULL, inherit = TRUE) {
   )
 }
 
-
 #' @inheritParams add_trace
 #' @rdname add_trace
-#' @param geo anchor this trace on which geo object?
 #' @export
 #' @examples 
-#' plot_ly() %>% add_scattergeo()
-add_scattergeo <- function(p, geo = NULL, ..., data = NULL, inherit = TRUE) {
+#' plot_ly(x = c(0, 0, 1), y = c(0, 1, 0), z = c(0, 0, 0)) %>% add_mesh()
+add_mesh <- function(p, x = NULL, y = NULL, z = NULL, ..., 
+                        data = NULL, inherit = TRUE) {
   if (inherit) {
-    geo <- geo %||% p$x$attrs[[1]][["geo"]] %||% "geo"
+    x <- x %||% p$x$attrs[[1]][["x"]]
+    y <- y %||% p$x$attrs[[1]][["y"]]
+    z <- z %||% p$x$attrs[[1]][["z"]]
+  }
+  if (is.null(x) || is.null(y) || is.null(z)) {
+    stop("Must supply `x`/`y`/`z` attributes", call. = FALSE)
   }
   add_trace_classed(
-    p, class = "plotly_scattergeo", type = "scattergeo", geo = geo, 
+    p, class = "plotly_mesh", x = x, y = y, z = z, type = "mesh3d", 
     ..., data = data, inherit = inherit
   )
 }
 
 
+#' @inheritParams add_trace
+#' @rdname add_trace
+#' @export
+#' 
+add_scattergeo <- function(p, ...) {
+  .Deprecated("geo")
+  p
+}
+
 #' @inheritParams add_trace
 #' @rdname add_trace
 #' @export
@@ -515,12 +567,16 @@ add_trace_classed <- function(p, class = "plotly_polygon", ...) {
 
 # retrieve the non-plotly.js attributes for a given trace
 special_attrs <- function(trace) {
-  switch(
+  attrs <- switch(
     class(trace)[[1]],
-    plotly_area = c("ymax"),
     plotly_segment = c("xend", "yend"),
     plotly_ribbon = c("ymin", "ymax")
   )
+  # for data training, we temporarily rename lat/lon as x/y
+  if (isTRUE(trace[["type"]] %in% c("scattermapbox", "scattergeo"))) {
+    attrs <- c(attrs, c("x", "y"))
+  }
+  attrs
 }
 
 

R/plotly.R

@@ -84,6 +84,7 @@ plot_ly <- function(data = data.frame(), ..., type = NULL,
   }
   # "native" plotly arguments
   attrs <- list(...)
+  
   # warn about old arguments that are no longer supported
   for (i in c("filename", "fileopt", "world_readable")) {
     if (is.null(attrs[[i]])) next
@@ -141,6 +142,60 @@ plot_ly <- function(data = data.frame(), ..., type = NULL,
 }
 
 
+#' Initiate a plotly-mapbox object
+#' 
+#' Use this function instead of \code{\link{plot_ly}()} to initialize
+#' a plotly-mapbox object. This enforces the entire plot so use
+#' the scattermapbox trace type, and enables higher level geometries
+#' like \code{\link{add_polygons}()} to work
+#' 
+#' @param ... arguments passed along to \code{\link{plot_ly}()}. They should be
+#' valid scattermapbox attributes - \url{https://plot.ly/r/reference/#scattermapbox}.
+#' Note that x/y can also be used in place of lat/lon.
+#' @export
+#' @examples \dontrun{
+#' 
+#' map_data("world", "canada") %>%
+#'   group_by(group) %>%
+#'   mapbox(x = ~lat, y = ~long) %>%
+#'   add_polygons() %>%
+#'   layout(
+#'     mapbox = list(
+#'       center = list(lat = ~median(lat), lon = ~median(long))
+#'     )
+#'   )
+#' }
+#' 
+mapbox <- function(data = data.frame(), ...) {
+  p <- plot_ly(data, ...)
+  p <- config(p, mapboxAccessToken = mapbox_token())
+  p$x$mapType <- "mapbox"
+  p
+}
+
+#' Initiate a plotly-geo object
+#' 
+#' Use this function instead of \code{\link{plot_ly}()} to initialize
+#' a plotly-geo object. This enforces the entire plot so use
+#' the scattergeo trace type, and enables higher level geometries
+#' like \code{\link{add_polygons}()} to work
+#' 
+#' @param ... arguments passed along to \code{\link{plot_ly}()}.
+#' @export
+#' @examples
+#' 
+#' map_data("world", "canada") %>%
+#'   group_by(group) %>%
+#'   geo(x = ~lat, y = ~long) %>%
+#'   add_polygons()
+#' 
+geo <- function(data = data.frame(), ...) {
+  p <- plot_ly(data, ...)
+  p$x$mapType <- "geo"
+  p
+}
+
+
 #' Convert a list to a plotly htmlwidget object
 #' 
 #' @param x a plotly object.

R/plotly_build.R

@@ -108,7 +108,7 @@ plotly_build.plotly <- function(p) {
         }
       }
     }
-
+    
     if (inherits(trace, c("plotly_surface", "plotly_contour"))) {
       # TODO: generate matrix for users?
       # (1) if z is vector, and x/y are null throw error
@@ -269,6 +269,17 @@ 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) {
+      tr[["lat"]] <- tr[["lat"]] %||% tr[["y"]]
+      tr[["lon"]] <- tr[["lon"]] %||% tr[["x"]]
+      tr[c("x", "y")] <- NULL
+      tr
+    })
+  }
 
   # polar charts don't like null width/height keys 
   if (is.null(p$x$layout[["height"]])) p$x$layout[["height"]] <- NULL
@@ -298,9 +309,6 @@ plotly_build.plotly <- function(p) {
 # ----------------------------------------------------------------
 
 train_data <- function(data, trace) {
-  if (inherits(trace, "plotly_area")) {
-    data$ymin <- 0
-  }
   if (inherits(trace, "plotly_ribbon")) {
     data <- ribbon_dat(data)
   }

R/utils.R

@@ -73,6 +73,29 @@ arrange_safe <- function(data, vars) {
   if (length(vars)) dplyr::arrange_(data, .dots = vars) else data
 }
 
+is_mapbox <- function(p) {
+  identical(p$x[["mapType"]], "mapbox")
+}
+
+is_geo <- function(p) {
+  identical(p$x[["mapType"]], "geo")
+}
+
+# retrive mapbox token if one is set; otherwise, throw error
+mapbox_token <- function() {
+  token <- Sys.getenv("MAPBOX_TOKEN", NA)
+  if (is.na(token)) {
+    stop(
+      "No mapbox access token found. Obtain a token here\n",
+      "https://www.mapbox.com/help/create-api-access-token/\n",
+      "Once you have a token, assign it to an environment variable \n",
+      "named 'MAPBOX_TOKEN', for example,\n",
+      "Sys.setenv('MAPBOX_TOKEN' = 'secret token')", call. = FALSE
+    )
+  }
+  token
+}
+
 # make sure plot attributes adhere to the plotly.js schema
 verify_attr_names <- function(p) {
   # some layout attributes (e.g., [x-y]axis can have trailing numbers)