Merge pull request #1 from ropensci/master

Update to 1.52.2

Author: rpkyle

.travis.yml

@@ -34,10 +34,3 @@ before_install:
 before_script:
   - if [[ "$TRAVIS_R_VERSION_STRING" == "release" ]]; then docker run -e GITHUB_PAT=$GITHUB_PAT -e MAPBOX_TOKEN=$MAPBOX_TOKEN -e VMODE="ci" -v $(pwd):/home/plotly --privileged cpsievert/plotly-orca; fi
 
-# work around temporary travis + R 3.5 bug
-r_packages: devtools  
-
-# temporary: needed for plotly input testing in shiny 
-r_github_packages: 
-  - rstudio/shinytest
-  - r-lib/remotes

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: plotly
 Title: Create Interactive Web Graphics via 'plotly.js'
-Version: 4.9.0.9000
+Version: 4.9.1.9000
 Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"),
     email = "cpsievert1@gmail.com", comment = c(ORCID = "0000-0002-4958-2844")),
     person("Chris", "Parmer", role = "aut",
@@ -72,6 +72,6 @@ Suggests:
     plotlyGeoAssets,
     forcats
 LazyData: true
-RoxygenNote: 6.1.1
+RoxygenNote: 7.0.2
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -94,6 +94,7 @@ export(add_heatmap)
 export(add_histogram)
 export(add_histogram2d)
 export(add_histogram2dcontour)
+export(add_image)
 export(add_lines)
 export(add_markers)
 export(add_mesh)

NEWS.md

@@ -1,9 +1,27 @@
-# 4.9.0.9000
+# 4.9.1.9000
+
+## Changes to plotly.js
+
+* This version of the R package upgrades the version of the underlying plotly.js library from v1.49.4 to v1.52.2. This includes many bug fixes, improvements, as well as 2 new trace types: `treemap` and `image`. The [plotly.js release page](https://github.com/plotly/plotly.js/releases) has the full list of changes.
+
+## IMPROVEMENTS
+
+* The `add_image()` function was added to make it easier to create image traces via `raster` objects.
+
+## BUG FIXES
+
+* `add_sf()`/`geom_sf()` now correctly handle geometry columns that are named something other than `"geometry"` (#1659).
+
+# 4.9.1
 
 ## Changes to plotly.js
 
 * This version of the R package upgrades the version of the underlying plotly.js library from v1.46.1 to v1.49.4. The [plotly.js release page](https://github.com/plotly/plotly.js/releases) has the full list of changes.
 
+## IMPROVEMENTS
+
+* `event_data()` gains support for the `plotly_sunburstclick` event (#1648)
+
 ## BUG FIXES
 
 * Fixed an issue with correctly capturing the return value of user-expressions to `renderPlotly()` (#1528).

R/add.R

@@ -24,7 +24,7 @@ add_data <- function(p, data = NULL) {
 #' @inheritParams plot_ly
 #' @param p a plotly object
 #' @param inherit inherit attributes from [plot_ly()]?
-#' @param z a numeric matrix
+#' @param z a numeric matrix (unless [add_image()], which wants a raster object, see [as.raster()]).
 #' @param x the x variable.
 #' @param y the y variable.
 #' @param text textual labels.
@@ -393,6 +393,43 @@ add_ribbons <- function(p, x = NULL, ymin = NULL, ymax = NULL, ...,
   )
 }
 
+#' @inheritParams add_trace
+#' @rdname add_trace
+#' @param colormodel Sets the colormodel for image traces if `z` is not a raster object. 
+#' If `z` is a raster object (see [as.raster()]), the `'rgba'` colormodel is always used.
+#' @export
+add_image <- function(p, z = NULL, colormodel = NULL, ..., data = NULL, inherit = TRUE) {
+  
+  if (inherit) {
+    z <- z %||% p$x$attrs[[1]][["z"]]
+    colormodel <- colormodel %||% p$x$attrs[[1]][["colormodel"]]
+  }
+  
+  if (inherits(z, "raster")) {
+    cols <- col2rgb(z, alpha = TRUE)
+    dims <- c(dim(z), 4)
+    z <- array(numeric(prod(dims)), dims)
+    matrix_ <- function(x) {
+      matrix(x, byrow = TRUE, nrow = dims[1], ncol = dims[2])
+    }
+    z[,,1] <- matrix_(cols["red",])
+    z[,,2] <- matrix_(cols["green",])
+    z[,,3] <- matrix_(cols["blue",])
+    z[,,4] <- matrix_(cols["alpha",])
+    
+    # Throw if we detect another colormodel
+    if (!identical(colormodel %||% "rgba", "rgba")) {
+      warning("Passing a raster object to z requires rgba colormodel")
+    }
+    colormodel <- "rgba"
+  }
+  
+  add_trace(
+    p, z = z, colormodel = colormodel, ..., 
+    data = data, type = "image"
+  )
+}
+
 #' @inheritParams add_trace
 #' @rdname add_trace
 #' @param r For polar chart only. Sets the radial coordinates.

R/embed.R

@@ -1,7 +1,7 @@
 #' Embed a plot as an iframe into a Jupyter Notebook
 #' @param x a plotly object
 #' @param width attribute of the iframe. If `NULL`, the width in
-#' `plot_ly` is used. If that is also `NULL`, '100\%' is the default.
+#' `plot_ly` is used. If that is also `NULL`, '100%' is the default.
 #' @param height attribute of the iframe. If `NULL`, the height in
 #' `plot_ly` is used. If that is also `NULL`, '400px' is the default.
 #' @param file deprecated.

R/ggplotly.R

@@ -686,6 +686,10 @@ gg2list <- function(p, width = NULL, height = NULL,
       ticktext <- rng[[xy]]$get_labels %()% rng[[paste0(xy, ".labels")]]
       tickvals <- rng[[xy]]$break_positions %()% rng[[paste0(xy, ".major")]]
 
+      # https://github.com/tidyverse/ggplot2/pull/3566#issuecomment-565085809
+      ticktext <- ticktext[!is.na(ticktext)]
+      tickvals <- tickvals[!is.na(tickvals)]
+      
       axisObj <- list(
         # TODO: log type?
         type = if (isDateType) "date" else if (isDiscreteType) "category" else "linear",
@@ -1137,22 +1141,28 @@ unitConvert <- function(u, to = c("npc", "pixels"), type = c("x", "y", "height",
 # from R, but it seems 96 is a reasonable assumption.
 mm2pixels <- function(u) {
   u <- verifyUnit(u)
-  if (attr(u, "unit") != "mm") {
-    stop("Unit must be in millimeters")
+  if (any(getUnitType(u) != "mm")) {
+    stop("All units must be in millimeters")
   }
   (as.numeric(u) * 96) / 25.4
 }
-
+  
 verifyUnit <- function(u) {
-  # the default unit in ggplot2 is millimeters (unless it's element_text())
-  if (is.null(attr(u, "unit"))) {
-    u <- if (inherits(u, "element")) {
-      grid::unit(u$size %||% 0, "points")
-    } else {
-      grid::unit(u %||% 0, "mm")
-    }
+  if (grid::is.unit(u)) return(u)
+  
+  ## the default unit in ggplot2 is millimeters (unless it's element_text())
+  if (inherits(u, "element")) {
+    grid::unit(u$size %||% 0, "points")
+  } else {
+    grid::unit(u %||% 0, "mm")
   }
-  u
+}
+
+# Use public API for getting the unit's type, if available
+# https://github.com/ropensci/plotly/pull/1646#issue-331268260
+getUnitType <- function(u) {
+  tryNULL(get("unitType", envir = asNamespace("grid"))(u)) %||%
+    attr(u, "unit")
 }
 
 # detect a blank theme element

R/helpers.R

@@ -185,15 +185,18 @@ plotly_empty <- function(...) {
 }
 
 
-#' Convert a raster object to a data URI
+#' Encode a raster object as a data URI
 #' 
-#' Convenient embedding images via [layout()]
-#' \href{images}{https://plot.ly/r/reference/#layout-images}.
+#' Encode a raster object as a data URI, which is suitable for 
+#' use with `layout()` \href{https://plot.ly/r/reference/#layout-images}{images}.
+#' This is especially convenient for embedding raster images on a plot in 
+#' a self-contained fashion (i.e., so they don't depend on external URL links).
 #' 
 #' @param r an object coercable to a raster object via [as.raster()]
 #' @param ... arguments passed onto [as.raster()].
 #' @author Carson Sievert
 #' @export
+#' @references <https://plotly-r.com/embedding-images.html>
 #' @examples
 #' 
 #' # a red gradient (from ?as.raster)

R/layers2traces.R

@@ -10,12 +10,14 @@ layers2traces <- function(data, prestats_data, layout, p) {
       position = ggtype(y, "position")
     )
 
+    # add on plot-level mappings, if they're inherited
+    map <- c(y$mapping, if (isTRUE(y$inherit.aes)) p$mapping)
+    
     # consider "calculated" aesthetics (e.g., density, count, etc)
     calc_aes <- y$stat$default_aes[ggfun("is_calculated_aes")(y$stat$default_aes)]
-    map <- c(y$mapping, calc_aes)
+    calc_aes <- calc_aes[!names(calc_aes) %in% names(map)]
 
-    # add on plot-level mappings, if they're inherited
-    if (isTRUE(y$inherit.aes)) map <- c(map, p$mapping)
+    map <- c(calc_aes, map)
 
     # turn symbol (e.g., ..count..) & call (e.g. calc(count)) mappings into text labels 
     map <- ggfun("make_labels")(map)
@@ -271,16 +273,14 @@ to_basic.GeomRect <- function(data, prestats_data, layout, params, p, ...) {
 
 #' @export
 to_basic.GeomSf <- function(data, prestats_data, layout, params, p, ...) {
-  
-  data[["geometry"]] <- sf::st_sfc(data[["geometry"]])
-  data <- sf::st_as_sf(data, sf_column_name = "geometry")
+
+  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),
@@ -308,6 +308,7 @@ to_basic.GeomSf <- function(data, prestats_data, layout, params, p, ...) {
     d[[i]] <- prefix_class(
       fortify_sf(d[[i]]), c(names(d)[[i]], "GeomSf")
     )
+    d[[i]] <- remove_class(d[[i]], "sf")
   }
   if (length(d) == 1) d[[1]] else d
 }
@@ -532,7 +533,7 @@ to_basic.GeomCrossbar <- function(data, prestats_data, layout, params, p, ...) {
     prefix_class(to_basic.GeomSegment(middle), "GeomCrossbar")
   )
 }
-utils::globalVariables(c("xmin", "xmax", "y", "size"))
+utils::globalVariables(c("xmin", "xmax", "y", "size", "COL", "PANEL", "ROW", "yaxis"))
 
 #' @export
 to_basic.GeomRug  <- function(data, prestats_data, layout, params, p, ...) {

R/layout.R

@@ -134,11 +134,15 @@ rangeslider <- function(p, start = NULL, end = NULL, ...) {
 config <- function(p, ..., cloud = FALSE, showSendToCloud = cloud, locale = NULL, mathjax = NULL) {
 
   if (!is.null(locale)) {
-    p$dependencies <- c(
-      p$dependencies,
-      list(locale_dependency(locale))
-    )
     p$x$config$locale <- locale
+    # Plotly.js defaults to US English (en-US) and includes 
+    # British English (en) in the standard bundle.
+    if (!locale %in% c("en", "en-US")) {
+      p$dependencies <- c(
+        p$dependencies,
+        list(locale_dependency(locale))
+      )
+    }
   }
 
   if (!is.null(mathjax)) {

R/partial_bundles.R

@@ -26,6 +26,7 @@
 #' # plotly graph. In this case, we get a 3x file reduction.
 #' # ----------------------------------------------------------------------
 #'
+#' \dontrun{
 #' library(plotly)
 #' p <- plot_ly(x = 1:10, y = 1:10) %>% add_markers()
 #' save_widget <- function(p, f) {
@@ -47,7 +48,6 @@
 #' # heatmap (part of the cartesian bundle) doesn't...
 #' # ----------------------------------------------------------------------
 #' 
-#' \dontrun{
 #' library(htmltools)
 #' p1 <- plot_ly(z = ~volcano) %>% 
 #'   add_heatmap() %>%

R/plotly.R

@@ -424,6 +424,15 @@ as_widget <- function(x, ...) {
     ),
     preRenderHook = plotly_build,
     dependencies = c(
+      # phantomjs doesn't support Object.setPrototypeOf() and a
+      # plotly.js dependency (buffer) uses it to detect TypedArray support.
+      # Thus, we add a polyfill if this is running in shinytest, but otherwise
+      # we shouldn't need it because Object.setPrototypeOf() is pretty widely supported
+      # https://github.com/plotly/plotly.js/issues/4556#issuecomment-583061419
+      # https://caniuse.com/#search=setPrototypeOf
+      if (isTRUE(getOption("shiny.testmode"))) {
+        list(setPrototypeOfPolyfill())
+      },
       list(typedArrayPolyfill()),
       crosstalk::crosstalkLibs(),
       list(plotlyHtmlwidgetsCSS()),
@@ -432,6 +441,17 @@ as_widget <- function(x, ...) {
   )
 }
 
+setPrototypeOfPolyfill <- function() {
+  htmltools::htmlDependency(
+    name = "setprototypeof", 
+    version = "0.1",
+    package = "plotly",
+    src = dependency_dir("setprototypeof"),
+    script = "setprototypeof.js",
+    all_files = FALSE
+  )
+}
+
 typedArrayPolyfill <- function() {
   htmltools::htmlDependency(
     name = "typedarray", 
@@ -446,7 +466,7 @@ typedArrayPolyfill <- function() {
 plotlyMainBundle <- function() {
   htmltools::htmlDependency(
     name = "plotly-main", 
-    version = "1.49.4",
+    version = "1.52.2",
     package = "plotly",
     src = dependency_dir("plotlyjs"),
     script = "plotly-latest.min.js",

R/plotly_build.R

@@ -112,7 +112,7 @@ plotly_build.plotly <- function(p, registerFrames = TRUE) {
       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_mapbox(p)) tr[["type"]] <- tr[["type"]] %||% "scattermapbox"
       if (is_geo(p)) {
         tr[["type"]] <- if (!is.null(tr[["z"]])) "choropleth" else "scattergeo"
       }
@@ -280,10 +280,12 @@ plotly_build.plotly <- function(p, registerFrames = TRUE) {
     )
     for (i in x$.plotlyVariableMapping) {
       # try to reduce the amount of data we have to send for non-positional scales
-      x[[i]] <- structure(
-        if (i %in% npscales()) uniq(d[[i]]) else d[[i]],
-        class = oldClass(x[[i]])
-      )
+      entry <- if (i %in% npscales()) uniq(d[[i]]) else d[[i]]
+      if (is.null(entry)) {
+        x[[i]] <- NULL  
+      } else {
+        x[[i]] <- structure(entry, class = oldClass(x[[i]]))  
+      }
     }
     x
   })
@@ -1031,7 +1033,7 @@ coerce_attr_defaults <- function(trace, layout) {
   if (length(trace[["stroke"]]) && !is.default(trace[["stroke"]])) {
     trace$span <- trace[["span"]] %||% default(I(1))
   }
-  if (trace[["type"]] %in% c("sunburst", "pie")) {
+  if (trace[["type"]] %in% c("sunburst", "pie", "treemap")) {
     # As of v1.46.1, paper_bgcolor defaults to '#fff' which
     # col2rgb() can't parse, but expands to '#ffffff'
     # https://stackoverflow.com/a/2899224/1583084

R/sf.R

@@ -11,7 +11,7 @@ fortify_sf <- function(model, ...) {
   # the coordinate belongs; for POINT this is absent (each coordinate is a feature), 
   # for LINESTRING L1 refers to the feature, for MULTIPOLYGON L1 refers to the main 
   # ring or holes, L2 to the ring id in the MULTIPOLYGON, and L3 to the simple feature.
-  coords <- sf::st_coordinates(model$geometry)
+  coords <- sf::st_coordinates(sf::st_geometry(model))
   colnames(coords) <- tolower(colnames(coords))
   lcols <- grep("^l", colnames(coords))