Merge branch 'master' into wrap-fct-lbls

Author: salim-b

DESCRIPTION

@@ -28,7 +28,7 @@ Depends:
 Imports:
     tools,
     scales,
-    httr,
+    httr (>= 1.3.0),
     jsonlite (>= 1.6),
     magrittr,
     digest,

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

@@ -1,9 +1,17 @@
 # 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.

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"]]
     }
@@ -806,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 <-
@@ -836,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
@@ -873,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"]],
@@ -890,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"]],
@@ -1180,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
@@ -1215,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

@@ -478,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