Merge branch 'master' of https://github.com/ropensci/plotly into ropensci-master

Author: chschan

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: plotly
 Title: Create Interactive Web Graphics via 'plotly.js'
-Version: 4.9.2.1
+Version: 4.9.2.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",
@@ -26,7 +26,7 @@ Depends:
 Imports:
     tools,
     scales,
-    httr,
+    httr (>= 1.3.0),
     jsonlite (>= 1.6),
     magrittr,
     digest,
@@ -72,6 +72,10 @@ Suggests:
     plotlyGeoAssets,
     forcats
 LazyData: true
+<<<<<<< HEAD
 RoxygenNote: 7.0.2
+=======
+RoxygenNote: 7.1.0
+>>>>>>> c19594b1fb54b28952895344fec3ad0060a1c646
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -241,14 +241,14 @@ importFrom(htmlwidgets,saveWidget)
 importFrom(htmlwidgets,shinyRenderWidget)
 importFrom(htmlwidgets,shinyWidgetOutput)
 importFrom(htmlwidgets,sizingPolicy)
-importFrom(httr,GET)
-importFrom(httr,PATCH)
-importFrom(httr,POST)
+importFrom(httr,RETRY)
 importFrom(httr,add_headers)
+importFrom(httr,authenticate)
 importFrom(httr,config)
 importFrom(httr,content)
 importFrom(httr,stop_for_status)
 importFrom(httr,warn_for_status)
+importFrom(httr,write_disk)
 importFrom(jsonlite,parse_json)
 importFrom(jsonlite,read_json)
 importFrom(jsonlite,toJSON)

NEWS.md

@@ -35,6 +35,60 @@ This is minor patch release with a few minor bug fixes and updates test expectat
 
 ## BUG FIXES
 
+=======
+# 4.9.2.9000
+
+## Changes to plotly.js
+
+* This version of the R package upgrades the version of the underlying plotly.js library from v1.52.2 to v1.54.1. This includes many bug fixes and improvements. The [plotly.js release page](https://github.com/plotly/plotly.js/releases) has the full list of changes.
+
+## IMPROVEMENTS
+
+* All HTTP requests are now retried upon failure (#1656)
+
+## BUG FIXES
+
+* `ggplotly()` now handles `element_blank()` and `factor()` labels in positional scales correctly (#1731 and #1772).
+
+# 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
+
+* Fixes rendering issues non-HTML **rmarkdown** output formats, which was introduced in the 4.9.2 release (#1702).
+* Fixes a `ggplotly()` bug in axis tick translation (#1725, #1721).
+* `plot_mapbox()` now correctly defaults to a scattermapbox trace (unless z is present, then it defaults to choroplethmapbox) (#1707).
+* `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.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).

R/api_exports.R

@@ -31,14 +31,14 @@
 #' @param endpoint the endpoint (i.e., location) for the request. 
 #' To see a list of all available endpoints, call `api()`.
 #' Any relevant query parameters should be included here (see examples).
-#' @param verb name of the HTTP verb to use (as in, [httr::VERB()]).
-#' @param body body of the HTTP request(as in, [httr::VERB()]).
+#' @param verb name of the HTTP verb to use (as in, [httr::RETRY()]).
+#' @param body body of the HTTP request(as in, [httr::RETRY()]).
 #' If this value is not already converted to JSON 
 #' (via [jsonlite::toJSON()]), it uses the internal `to_JSON()`
 #' to ensure values are "automatically unboxed" (i.e., vec.
 #'
 #' @param ... For `api()`, these arguments are passed onto 
-#' [httr::VERB()]. For `api_create()`, these arguments are
+#' [httr::RETRY()]. For `api_create()`, these arguments are
 #' included in the body of the HTTP request.
 #' 
 #' @export
@@ -187,9 +187,16 @@ api <- function(endpoint = "/", verb = "GET", body = NULL, ...) {
     body <- to_JSON(body)
   }
 
-  resp <- httr::VERB(
-    verb = verb, url = url, api_headers(), api_auth(), 
-    body = body, ...
+  resp <- httr::RETRY(
+    verb = verb,
+    url = url,
+    api_headers(),
+    api_auth(),
+    body = body,
+    times = 5,
+    terminate_on = c(400, 401, 403, 404),
+    terminate_on_success = TRUE,
+    ...
   )
 
   structure(process(resp), class = "api")

R/ggplotly.R

@@ -127,7 +127,7 @@ ggplotly.ggmatrix <- function(p = ggplot2::last_plot(), width = NULL,
                titleY = TRUE, titleX = TRUE) %>% 
     hide_legend() %>%
     layout(dragmode = "select")
-  if (nchar(p$title %||% "") > 0) {
+  if (robust_nchar(p$title) > 0) {
     s <- layout(s, title = p$title)
   }
   for (i in seq_along(p$xAxisLabels)) {
@@ -436,7 +436,7 @@ gg2list <- function(p, width = NULL, height = NULL,
     font = text2font(theme$text)
   )
   # main plot title
-  if (nchar(plot$labels$title %||% "") > 0) {
+  if (robust_nchar(plot$labels$title) > 0) {
     gglayout$title <- list(
       text = faced(plot$labels$title, theme$plot.title$face),
       font = text2font(theme$plot.title),
@@ -567,7 +567,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, function(pp) { pp[["x"]]$get_labels %()% pp$x.labels }))
-      lab <- labz[which.max(nchar(labz))]
+      lab <- longest_element(labz)
       panelMarginY <- panelMarginY + axisTicksX +
         bbox(lab, axisTextX$angle, unitConvert(axisTextX, "npc", "height"))[["height"]]
     }
@@ -579,7 +579,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, function(pp) { pp[["y"]]$get_labels %()% pp$y.labels }))
-      lab <- labz[which.max(nchar(labz))]
+      lab <- longest_element(labz)
       panelMarginX <- panelMarginX + axisTicksY +
         bbox(lab, axisTextY$angle, unitConvert(axisTextY, "npc", "width"))[["width"]]
     }
@@ -693,8 +693,9 @@ gg2list <- function(p, width = NULL, height = NULL,
       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)]
+      hasTickText <- !(is.na(ticktext) | is.na(tickvals))
+      ticktext <- ticktext[hasTickText]
+      tickvals <- tickvals[hasTickText]
 
       axisObj <- list(
         # TODO: log type?
@@ -805,15 +806,15 @@ gg2list <- function(p, width = NULL, height = NULL,
 
       # do some stuff that should be done once for the entire plot
       if (i == 1) {
-        axisTickText <- axisObj$ticktext[which.max(nchar(axisObj$ticktext))]
+        axisTickText <- longest_element(axisObj$ticktext)
         side <- if (xy == "x") "b" else "l"
         # account for axis ticks, ticks text, and titles in plot margins
         # (apparently ggplot2 doesn't support axis.title/axis.text margins)
         gglayout$margin[[side]] <- gglayout$margin[[side]] + axisObj$ticklen +
           bbox(axisTickText, axisObj$tickangle, axisObj$tickfont$size)[[type]] +
           bbox(axisTitleText, axisTitle$angle, unitConvert(axisTitle, "pixels", type))[[type]]
 
-        if (nchar(axisTitleText) > 0) {
+        if (robust_nchar(axisTitleText) > 0) {
           axisTextSize <- unitConvert(axisText, "npc", type)
           axisTitleSize <- unitConvert(axisTitle, "npc", type)
           offset <-
@@ -835,7 +836,7 @@ gg2list <- function(p, width = NULL, height = NULL,
           }
           # facets have multiple axis objects, but only one title for the plot,
           # so we empty the titles and try to draw the title as an annotation
-          if (nchar(axisTitleText) > 0) {
+          if (robust_nchar(axisTitleText) > 0) {
             # npc is on a 0-1 scale of the _entire_ device,
             # but these units _should_ be wrt to the plotting region
             # multiplying the offset by 2 seems to work, but this is a terrible hack
@@ -872,7 +873,7 @@ gg2list <- function(p, width = NULL, height = NULL,
       )
       if (is_blank(theme[["strip.text.x"]])) col_txt <- ""
       if (inherits(plot$facet, "FacetGrid") && lay$ROW != 1) col_txt <- ""
-      if (nchar(col_txt) > 0) {
+      if (robust_nchar(col_txt) > 0) {
         col_lab <- make_label(
           col_txt, x = mean(xdom), y = max(ydom),
           el = theme[["strip.text.x"]] %||% theme[["strip.text"]],
@@ -889,7 +890,7 @@ gg2list <- function(p, width = NULL, height = NULL,
       )
       if (is_blank(theme[["strip.text.y"]])) row_txt <- ""
       if (inherits(plot$facet, "FacetGrid") && lay$COL != nCols) row_txt <- ""
-      if (nchar(row_txt) > 0) {
+      if (robust_nchar(row_txt) > 0) {
         row_lab <- make_label(
           row_txt, x = max(xdom), y = mean(ydom),
           el = theme[["strip.text.y"]] %||% theme[["strip.text"]],
@@ -1179,7 +1180,7 @@ is_blank <- function(x) {
 # given text, and x/y coordinates on 0-1 scale,
 # convert ggplot2::element_text() to plotly annotation
 make_label <- function(txt = "", x, y, el = ggplot2::element_text(), ...) {
-  if (is_blank(el) || is.null(txt) || nchar(txt) == 0 || length(txt) == 0) {
+  if (is_blank(el) || is.null(txt) || robust_nchar(txt) == 0 || length(txt) == 0) {
     return(NULL)
   }
   angle <- el$angle %||% 0
@@ -1214,9 +1215,9 @@ has_facet <- function(x) {
 
 bbox <- function(txt = "foo", angle = 0, size = 12) {
   # assuming the horizontal size of a character is roughly half of the vertical
-  n <- nchar(txt)
+  n <- robust_nchar(txt)
   if (sum(n) == 0) return(list(height = 0, width = 0))
-  w <- size * (nchar(txt) / 2)
+  w <- size * (robust_nchar(txt) / 2)
   angle <- abs(angle %||% 0)
   # do the sensible thing in the majority of cases
   if (angle == 0) return(list(height = size, width = w))

R/imports.R

@@ -6,7 +6,7 @@
 #' @importFrom tidyr unnest
 #' @importFrom viridisLite viridis
 #' @importFrom jsonlite toJSON parse_json read_json
-#' @importFrom httr GET POST PATCH content config add_headers stop_for_status warn_for_status
+#' @importFrom httr RETRY content config add_headers authenticate stop_for_status warn_for_status write_disk
 #' @importFrom htmlwidgets createWidget sizingPolicy saveWidget onRender prependContent
 #' @importFrom lazyeval f_eval is_formula all_dots is_lang f_new
 #' @importFrom tibble as_tibble

R/orca.R

@@ -192,9 +192,13 @@ orca_serve <- function(port = 5151, mathjax = FALSE, safe = FALSE, request_limit
         height = height,
         scale = scale
       )
-      res <- httr::POST(
-        paste0("http://127.0.0.1:", port), 
-        body = to_JSON(bod)
+      res <- httr::RETRY(
+        verb = "POST",
+        url = paste0("http://127.0.0.1:", port),
+        body = to_JSON(bod),
+        times = 5,
+        terminate_on = c(400, 401, 403, 404),
+        terminate_on_success = TRUE
       )
       httr::stop_for_status(res)
       httr::warn_for_status(res)

R/plotly.R

@@ -430,7 +430,7 @@ as_widget <- function(x, ...) {
       # 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"))) {
+      if (needsPrototypePolyfill()) {
         list(setPrototypeOfPolyfill())
       },
       list(typedArrayPolyfill()),
@@ -441,6 +441,18 @@ as_widget <- function(x, ...) {
   )
 }
 
+needsPrototypePolyfill <- function() {
+  if (isTRUE(getOption("shiny.testmode"))) {
+    return(TRUE)
+  }
+  
+  if (isTRUE(getOption("knitr.in.progress"))) {
+    return(!knitr::is_html_output())
+  }
+  
+  return(FALSE)
+}
+
 setPrototypeOfPolyfill <- function() {
   htmltools::htmlDependency(
     name = "setprototypeof", 
@@ -466,7 +478,7 @@ typedArrayPolyfill <- function() {
 plotlyMainBundle <- function() {
   htmltools::htmlDependency(
     name = "plotly-main", 
-    version = "1.52.2",
+    version = "1.54.1",
     package = "plotly",
     src = dependency_dir("plotlyjs"),
     script = "plotly-latest.min.js",

R/plotly_IMAGE.R

@@ -9,7 +9,7 @@
 #' @param format The desired image format 'png', 'jpeg', 'svg', 'pdf', 'eps', or 'webp'
 #' @param scale Both png and jpeg formats will be scaled beyond the specified width and height by this number.
 #' @param out_file A filename for writing the image to a file.
-#' @param ... arguments passed onto `httr::POST`
+#' @param ... arguments passed onto `httr::RETRY`
 #' @export
 #' @examples \dontrun{
 #' p <- plot_ly(x = 1:10)
@@ -34,9 +34,16 @@ plotly_IMAGE <- function(x, width = 1000, height = 500, format = "png",
     filename = Sys.time()
   )
   base_url <- file.path(get_domain("api"), "v2", "images")
-  resp <- httr::POST(
-    base_url, body = to_JSON(bod), api_headers(), api_auth(),
-    if (!missing(out_file)) httr::write_disk(out_file, overwrite = TRUE), 
+  resp <- httr::RETRY(
+    verb = "POST",
+    url = base_url,
+    body = to_JSON(bod),
+    times = 5,
+    terminate_on = c(400, 401, 403, 404),
+    terminate_on_success = TRUE,
+    api_headers(),
+    api_auth(),
+    if (!missing(out_file)) httr::write_disk(out_file, overwrite = TRUE),
     ...
   )
   con <- process(append_class(resp, "api_image"))

R/signup.R

@@ -45,7 +45,14 @@ signup <- function(username, email, save = TRUE) {
     version = as.character(packageVersion("plotly"))
   )
   base_url <- file.path(get_domain(), "apimkacct")
-  resp <- httr::POST(base_url, body = bod)
+  resp <- httr::RETRY(
+    verb = "POST",
+    base_url,
+    body = bod,
+    times = 5,
+    terminate_on = c(400, 401, 403, 404),
+    terminate_on_success = TRUE
+  )
   con <- process(append_class(resp, "signup"))
   if (save) {
     # store API key as an environment variable in .Rprofile