Displayr · chschan · Mar 12, 2020 · Dec 3, 2018 · Mar 18, 2019 · Mar 18, 2019
diff --git a/.travis.yml b/.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
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: plotly
 Title: Create Interactive Web Graphics via 'plotly.js'
-Version: 4.9.0.9000
+Version: 4.9.2.1
 Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"),
     email = "[email protected]", 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)
diff --git a/NAMESPACE b/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)

diff --git a/NEWS.md b/NEWS.md
@@ -1,9 +1,45 @@
-# 4.9.0.9000
+# 4.9.2.1
+
+This is minor patch release with a few minor bug fixes and updates test expectations in anticipation of new R 4.0 defaults.
+
+## BUG FIXES
+
+* `plot_mapbox()` now correctly defaults to a scattermapbox trace (unless z is present, then it defaults to choroplethmapbox) (#1702).
+* `ggplotly()` now correctly resolves overlapping axis tick text in `coord_sf()` (#1673).
+* A false-positive warning is no longer thrown when attempting to cast `toWebGL()` (#1569).
+
+# 4.9.2
+
+## 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).
+* Specifying an english locale no longer results in error (#1686).
+
+# 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.48.3. The [plotly.js release page](https://github.com/plotly/plotly.js/releases) has the full list of changes.
+* 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).
+* Fixed a resizing issue where graphs could be incorrectly resized to their initial size in some cases (#1553). 
+* `ggplotly()` now positions the x-axis in the last column of a `facet_wrap()` properly (#1501).
+* `ggplotly()` now handles `geom_hline()`/`geom_vline()` correctly in conjunction with `coord_flip()` (#1519).
+* `event_data()` now correctly relays the `key` attribute for statistical traces (#1610).
 
 # 4.9.0
 

diff --git a/R/add.R b/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.

diff --git a/R/embed.R b/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.

diff --git a/R/ggplotly.R b/R/ggplotly.R
@@ -465,37 +465,51 @@ gg2list <- function(p, width = NULL, height = NULL,
 
   # panel -> plotly.js axis/anchor info
   # (assume a grid layout by default)
-  layout$layout$xaxis <- layout$layout$COL
-  layout$layout$yaxis <- layout$layout$ROW
-  layout$layout$xanchor <- nRows
-  layout$layout$yanchor <- 1
+  layout$layout <- dplyr::mutate(
+    layout$layout,
+    xaxis = COL,
+    yaxis = ROW,
+    xanchor = nRows,
+    yanchor = 1L
+  )
   if (inherits(plot$facet, "FacetWrap")) {
-    if (plot$facet$params$free$x) {
-      layout$layout$xaxis <- layout$layout$PANEL
-      layout$layout$xanchor <- layout$layout$ROW
-    }
-    if (plot$facet$params$free$y) {
-      layout$layout$yaxis <- layout$layout$PANEL
-      layout$layout$yanchor <- layout$layout$COL
-      layout$layout$xanchor <- nPanels
-    }
     if (plot$facet$params$free$x && plot$facet$params$free$y) {
-      layout$layout$xaxis <- layout$layout$PANEL
-      layout$layout$yaxis <- layout$layout$PANEL
-      layout$layout$xanchor <- layout$layout$PANEL
-      layout$layout$yanchor <- layout$layout$PANEL
+      layout$layout <- dplyr::mutate(
+        layout$layout,
+        xaxis = PANEL,
+        yaxis = PANEL,
+        xanchor = PANEL,
+        yanchor = PANEL
+      )
+    } else if (plot$facet$params$free$x) {
+      layout$layout <- dplyr::mutate(
+        layout$layout,
+        xaxis = PANEL,
+        xanchor = ROW
+      )
+    } else if (plot$facet$params$free$y) {
+      layout$layout <- dplyr::mutate(
+        layout$layout,
+        yaxis = PANEL,
+        yanchor = COL
+      )
     }
+    # anchor X axis to the lowest plot in its column
+    layout$layout <- dplyr::group_by_(layout$layout, "xaxis")
+    layout$layout <-  dplyr::mutate(layout$layout, xanchor = max(as.integer(yaxis)))
   }
+  layout$layout <- as.data.frame(layout$layout)
+
   # format the axis/anchor to a format plotly.js respects
   layout$layout$xaxis <- paste0("xaxis", sub("^1$", "", layout$layout$xaxis))
   layout$layout$yaxis <- paste0("yaxis", sub("^1$", "", layout$layout$yaxis))
   layout$layout$xanchor <- paste0("y", sub("^1$", "", layout$layout$xanchor))
   layout$layout$yanchor <- paste0("x", sub("^1$", "", layout$layout$yanchor))
   # for some layers2traces computations, we need the range of each panel
-  layout$layout$x_min <- sapply(layout$panel_params, function(z) min(z$x.range %||% z$x_range))
-  layout$layout$x_max <- sapply(layout$panel_params, function(z) max(z$x.range %||% z$x_range))
-  layout$layout$y_min <- sapply(layout$panel_params, function(z) min(z$y.range %||% z$y_range))
-  layout$layout$y_max <- sapply(layout$panel_params, function(z) max(z$y.range %||% z$y_range))
+  layout$layout$x_min <- sapply(layout$panel_params, function(z) { min(z[["x"]]$dimension %()% z$x.range %||% z$x_range) })
+  layout$layout$x_max <- sapply(layout$panel_params, function(z) { max(z[["x"]]$dimension %()% z$x.range %||% z$x_range) })
+  layout$layout$y_min <- sapply(layout$panel_params, function(z) { min(z[["y"]]$dimension %()% z$y.range %||% z$y_range) })
+  layout$layout$y_max <- sapply(layout$panel_params, function(z) { max(z[["y"]]$dimension %()% z$y.range %||% z$y_range) })
 
   # layers -> plotly.js traces
   plot$tooltip <- tooltip
@@ -552,7 +566,7 @@ gg2list <- function(p, width = NULL, height = NULL,
       )
       # allocate enough space for the _longest_ text label
       axisTextX <- theme[["axis.text.x"]] %||% theme[["axis.text"]]
-      labz <- unlist(lapply(layout$panel_params, "[[", "x.labels"))
+      labz <- unlist(lapply(layout$panel_params, function(pp) { pp[["x"]]$get_labels %()% pp$x.labels }))
       lab <- labz[which.max(nchar(labz))]
       panelMarginY <- panelMarginY + axisTicksX +
         bbox(lab, axisTextX$angle, unitConvert(axisTextX, "npc", "height"))[["height"]]
@@ -564,7 +578,7 @@ gg2list <- function(p, width = NULL, height = NULL,
       )
       # allocate enough space for the _longest_ text label
       axisTextY <- theme[["axis.text.y"]] %||% theme[["axis.text"]]
-      labz <- unlist(lapply(layout$panel_params, "[[", "y.labels"))
+      labz <- unlist(lapply(layout$panel_params, function(pp) { pp[["y"]]$get_labels %()% pp$y.labels }))
       lab <- labz[which.max(nchar(labz))]
       panelMarginX <- panelMarginX + axisTicksY +
         bbox(lab, axisTextY$angle, unitConvert(axisTextY, "npc", "width"))[["width"]]
@@ -598,10 +612,19 @@ gg2list <- function(p, width = NULL, height = NULL,
       if ("CoordSf" %in% class(p$coordinates)) {
         # see CoordSf$render_axis_v
         direction <- if (xy == "x") "E" else "N"
-        idx <- rng$graticule$type == direction & !is.na(rng$graticule$degree_label)
+        idx <- rng$graticule$type == direction & 
+          !is.na(rng$graticule$degree_label) &
+          # Respect the logical 'plot12' column which sf constructs for 
+          # determining which tick labels should be drawn
+          # https://github.com/r-spatial/sf/blob/b49d37/R/graticule.R#L199
+          # https://github.com/r-spatial/sf/blob/52a8351/R/plot.R#L580
+          (rng$graticule$plot12 %||% TRUE)
         tickData <- rng$graticule[idx, ]
         # TODO: how to convert a language object to unicode character string?
-        rng[[paste0(xy, ".labels")]] <- as.character(tickData[["degree_label"]])
+        rng[[paste0(xy, ".labels")]] <- sub(
+          "\\*\\s+degree[ ]?[\\*]?", "&#176;", 
+          gsub("\"", "", tickData[["degree_label"]])
+        )
         rng[[paste0(xy, ".major")]] <- tickData[[paste0(xy, "_start")]]
 
         # If it doesn't already exist (for this panel), 
@@ -636,14 +659,7 @@ gg2list <- function(p, width = NULL, height = NULL,
         tickExists <- with(rng$graticule, sapply(degree_label, is.language))
         if (sum(tickExists) == 0) {
           theme$axis.ticks.length <- 0
-        } else{
-          # convert the special *degree expression in plotmath to HTML entity
-          # TODO: can this be done more generally for all ?
-          rng[[paste0(xy, ".labels")]] <- sub(
-            "\\*\\s+degree[ ]?[\\*]?", "&#176;", rng[[paste0(xy, ".labels")]]
-          )
         }
-
       }
 
       # stuff like layout$panel_params is already flipped, but scales aren't
@@ -673,16 +689,23 @@ gg2list <- function(p, width = NULL, height = NULL,
       isDiscrete <- identical(sc$scale_name, "position_d")
       isDiscreteType <- isDynamic && isDiscrete
 
+      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",
         autorange = isDynamic,
         range = rng[[paste0(xy, ".range")]] %||% rng[[paste0(xy, "_range")]],
         tickmode = if (isDynamic) "auto" else "array",
-        ticktext = rng[[paste0(xy, ".labels")]],
-        tickvals = rng[[paste0(xy, ".major")]],
+        ticktext = ticktext,
+        tickvals = tickvals,
         categoryorder = "array",
-        categoryarray = rng[[paste0(xy, ".labels")]],
+        categoryarray = ticktext,
         nticks = nrow(rng),
         ticks = if (is_blank(axisTicks)) "" else "outside",
         tickcolor = toRGB(axisTicks$colour),
@@ -1124,22 +1147,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

diff --git a/R/helpers.R b/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)