From 858a7e29f0b797bbdc2ea487aa8aaaca2cce6647 Mon Sep 17 00:00:00 2001 From: James Lamb Date: Mon, 6 Jan 2020 19:56:22 -0600 Subject: [PATCH 1/4] added retry logic to HTTP requests --- NAMESPACE | 6 +- R/api_exports.R | 108 ++++++++++++++++--------------- R/imports.R | 8 +-- R/orca.R | 110 ++++++++++++++++--------------- R/plotly_IMAGE.R | 26 +++++--- R/signup.R | 13 +++- R/utils.R | 164 +++++++++++++++++++++++------------------------ inst/plotlyjs.R | 20 ++++-- man/api.Rd | 12 ++-- 9 files changed, 250 insertions(+), 217 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 458c99bc85..7f9ded1524 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/api_exports.R b/R/api_exports.R index 55238f71e1..68357e13b3 100644 --- a/R/api_exports.R +++ b/R/api_exports.R @@ -1,68 +1,68 @@ #' Tools for working with plotly's REST API (v2) -#' +#' #' Convenience functions for working with version 2 of plotly's REST API. #' Upload R objects to a plotly account via `api_create()` and download #' plotly objects via `api_download_plot()`/`api_download_grid()`. #' For anything else, use `api()`. -#' -#' @param id a filename id. +#' +#' @param id a filename id. #' @param username a plotly username. -#' -#' @param x An R object to hosted on plotly's web platform. +#' +#' @param x An R object to hosted on plotly's web platform. #' Can be a plotly/ggplot2 object or a \link{data.frame}. #' @param filename character vector naming file(s). If `x` is a plot, #' can be a vector of length 2 naming both the plot AND the underlying grid. -#' @param fileopt character string describing whether to "overwrite" existing +#' @param fileopt character string describing whether to "overwrite" existing #' files or ensure "new" file(s) are always created. -#' @param sharing If 'public', anyone can view this graph. It will appear in +#' @param sharing If 'public', anyone can view this graph. It will appear in #' your profile and can appear in search engines. You do not need to be #' logged in to Plotly to view this chart. #' If 'private', only you can view this plot. It will not appear in the -#' Plotly feed, your profile, or search engines. You must be logged in to -#' Plotly to view this graph. You can privately share this graph with other -#' Plotly users in your online Plotly account and they will need to be logged +#' Plotly feed, your profile, or search engines. You must be logged in to +#' Plotly to view this graph. You can privately share this graph with other +#' Plotly users in your online Plotly account and they will need to be logged #' in to view this plot. #' If 'secret', anyone with this secret link can view this chart. It will -#' not appear in the Plotly feed, your profile, or search engines. -#' If it is embedded inside a webpage or an IPython notebook, anybody who is -#' viewing that page will be able to view the graph. +#' not appear in the Plotly feed, your profile, or search engines. +#' If it is embedded inside a webpage or an IPython notebook, anybody who is +#' viewing that page will be able to view the graph. #' You do not need to be logged in to view this plot. -#' -#' @param endpoint the endpoint (i.e., location) for the request. +#' +#' @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()]). -#' If this value is not already converted to JSON +#' @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 +#' @param ... For `api()`, these arguments are passed onto +#' [httr::RETRY()]. For `api_create()`, these arguments are #' included in the body of the HTTP request. -#' +#' #' @export #' @rdname api #' @author Carson Sievert #' @references \url{https://api.plot.ly/v2} #' @seealso [signup()] -#' @examples -#' +#' @examples +#' #' \dontrun{ -#' +#' #' # ------------------------------------------------------------ #' # api_create() makes it easy to upload ggplot2/plotly objects #' # and/or data frames to your plotly account #' # ------------------------------------------------------------ -#' -#' # A data frame creates a plotly "grid". Printing one will take you +#' +#' # A data frame creates a plotly "grid". Printing one will take you #' # to the it's web address so you can start creating! #' (m <- api_create(mtcars)) -#' +#' #' # A plotly/ggplot2 object create a plotly "plot". #' p <- plot_ly(mtcars, x = ~factor(vs)) #' (r <- api_create(p)) -#' +#' #' # api_create() returns metadata about the remote "file". Here is #' # one way you could use that metadata to download a plot for local use: #' fileID <- strsplit(r$file$fid, ":")[[1]] @@ -72,18 +72,18 @@ #' ) #' #' ------------------------------------------------------------ -#' # The api() function provides a low-level interface for performing +#' # The api() function provides a low-level interface for performing #' # any action at any endpoint! It always returns a list. #' # ------------------------------------------------------------ -#' +#' #' # list all the endpoints #' api() -#' +#' #' # search the entire platform! #' # see https://api.plot.ly/v2/search #' api("search?q=overdose") #' api("search?q=plottype:pie trump fake") -#' +#' #' # these examples will require a user account #' usr <- Sys.getenv("plotly_username", NA) #' if (!is.na(usr)) { @@ -92,27 +92,27 @@ #' # your folders/files https://api.plot.ly/v2/folders#user #' api(sprintf("folders/home?user=%s", usr)) #' } -#' +#' #' # Retrieve a specific file https://api.plot.ly/v2/files#retrieve #' api("files/cpsievert:14681") -#' +#' #' # change the filename https://api.plot.ly/v2/files#update #' # (note: this won't work unless you have proper credentials to the relevant account) -#' api("files/cpsievert:14681", "PATCH", list(filename = "toy file")) -#' +#' api("files/cpsievert:14681", "PATCH", list(filename = "toy file")) +#' #' # Copy a file https://api.plot.ly/v2/files#lookup #' api("files/cpsievert:14681/copy", "POST") -#' +#' #' # Create a folder https://api.plot.ly/v2/folders#create #' api("folders", "POST", list(path = "/starts/at/root/and/ends/here")) -#' +#' #' } -#' +#' #' @rdname api #' @export -api_create <- function(x = last_plot(), filename = NULL, +api_create <- function(x = last_plot(), filename = NULL, fileopt = c("overwrite", "new"), sharing = c("public", "private", "secret"), ...) { fileopt <- match.arg(fileopt, c("overwrite", "new")) @@ -140,7 +140,7 @@ api_create.data.frame <- api_create_grid api_download_plot <- function(id, username) { f <- api_download_file(id, username) api_expect_filetype(f, "plot") - + as_widget( api_download_file(id, username, "plots", "content?inline_data=true") ) @@ -152,7 +152,7 @@ api_download_plot <- function(id, username) { api_download_grid <- function(id, username) { f <- api_download_file(id, username) api_expect_filetype(f, "grid") - + prefix_class( api_download_file(id, username, "grids"), "api_grid_local" ) @@ -170,27 +170,35 @@ api_download_file <- function(id, username, endpoint = "files", ...) { #' @rdname api +#' @importFrom httr RETRY #' @export api <- function(endpoint = "/", verb = "GET", body = NULL, ...) { api_check_endpoint(endpoint) - + # construct the url url <- httr::modify_url( - get_domain("api"), + get_domain("api"), scheme = "https", # TODO: should anything else in the endpoint (besides whitespace) be escaped? path = file.path("v2", gsub("\\s+", "+", endpoint)) ) - + # default to unboxing (i.e., no arrays of length 1) if (!is.null(body) && !inherits(body, "json")) { 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") } diff --git a/R/imports.R b/R/imports.R index 804fc19e70..3ec37d7434 100644 --- a/R/imports.R +++ b/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 @@ -18,7 +18,7 @@ NULL -#' @importFrom dplyr mutate +#' @importFrom dplyr mutate #' @name mutate #' @rdname reexports #' @export @@ -66,7 +66,7 @@ dplyr::rename #' @export dplyr::rename_ -#' @importFrom dplyr group_by +#' @importFrom dplyr group_by #' @name group_by #' @rdname reexports #' @export @@ -169,7 +169,7 @@ dplyr::filter_ # #' @rdname reexports # #' @export # tidyr::gather -# +# # #' @importFrom tidyr gather_ # #' @name gather_ # #' @rdname reexports diff --git a/R/orca.R b/R/orca.R index d41ed26158..6d6ada47d5 100644 --- a/R/orca.R +++ b/R/orca.R @@ -1,76 +1,76 @@ -#' Static image exporting -#' +#' Static image exporting +#' #' Export plotly objects to static images (e.g., pdf, png, jpeg, svg, etc) via the #' [orca command-line utility](https://github.com/plotly/orca#installation). -#' +#' #' The `orca()` function is designed for exporting one plotly graph whereas `orca_serve()` #' is meant for exporting many graphs at once. The former starts and stops an external (nodejs) #' process everytime it is called whereas the latter starts up a process when called, then -#' returns an `export()` method for exporting graphs as well as a `close()` method for stopping +#' returns an `export()` method for exporting graphs as well as a `close()` method for stopping #' the external (background) process. -#' +#' #' @param p a plotly object. #' @param file output filename. #' @param format the output format (png, jpeg, webp, svg, pdf, eps). #' @param scale Sets the image scale. Applies to all output images. -#' @param width Sets the image width. If not set, defaults to `layout.width` value. +#' @param width Sets the image width. If not set, defaults to `layout.width` value. #' Applies to all output images. -#' @param height Sets the image height. If not set, defaults to `layout.height` value. +#' @param height Sets the image height. If not set, defaults to `layout.height` value. #' Applies to all output images. #' @param mathjax whether or not to include MathJax (required to render [TeX]). -#' If `TRUE`, the PLOTLY_MATHJAX_PATH environment variable must be set and point -#' to the location of MathJax (this variable is also used to render [TeX] in +#' If `TRUE`, the PLOTLY_MATHJAX_PATH environment variable must be set and point +#' to the location of MathJax (this variable is also used to render [TeX] in #' interactive graphs, see [config]). #' @param parallel_limit Sets the limit of parallel tasks run. #' @param verbose Turn on verbose logging on stdout. #' @param debug Starts app in debug mode and turn on verbose logs on stdout. -#' @param safe Turns on safe mode: where figures likely to make browser window +#' @param safe Turns on safe mode: where figures likely to make browser window #' hang during image generating are skipped. #' @param more_args additional arguments to pass along to system command. This is useful #' for specifying display and/or electron options, such as `--enable-webgl` or `--disable-gpu`. -#' @param ... for `orca()`, additional arguments passed along to `processx::run`. For +#' @param ... for `orca()`, additional arguments passed along to `processx::run`. For #' `orca_serve()`, additional arguments passed along to `processx::process`. #' @export #' @author Carson Sievert #' @md #' @rdname orca #' @examples -#' +#' #' \dontrun{ #' # NOTE: in a headless environment, you may need to set `more_args="--enable-webgl"` #' # to export webgl correctly #' p <- plot_ly(z = ~volcano) %>% add_surface() #' orca(p, "surface-plot.svg") -#' +#' #' #' # launch the server #' server <- orca_serve() -#' +#' #' # export as many graphs as you'd like #' server$export(qplot(1:10), "test1.pdf") #' server$export(plot_ly(x = 1:10, y = 1:10), "test2.pdf") -#' +#' #' # the underlying process is exposed as a field, so you #' # have full control over the external process #' server$process$is_alive() -#' +#' #' # convenience method for closing down the server #' server$close() -#' +#' #' # remove the exported files from disk #' unlink("test1.pdf") #' unlink("test2.pdf") #' } -#' +#' -orca <- function(p, file = "plot.png", format = tools::file_ext(file), +orca <- function(p, file = "plot.png", format = tools::file_ext(file), scale = NULL, width = NULL, height = NULL, mathjax = FALSE, - parallel_limit = NULL, verbose = FALSE, debug = FALSE, + parallel_limit = NULL, verbose = FALSE, debug = FALSE, safe = FALSE, more_args = NULL, ...) { - + orca_available() - + b <- plotly_build(p) - + # find the relevant plotly.js bundle plotlyjs <- plotlyjsBundle(b) plotlyjs_path <- file.path(plotlyjs$src$file, plotlyjs$script) @@ -78,12 +78,12 @@ orca <- function(p, file = "plot.png", format = tools::file_ext(file), if (!is.null(plotlyjs$package)) { plotlyjs_path <- system.file(plotlyjs_path, package = plotlyjs$package) } - + tmp <- tempfile(fileext = ".json") cat(to_JSON(b$x[c("data", "layout")]), file = tmp) - + args <- c( - "graph", tmp, + "graph", tmp, "-o", file, "--format", format, "--plotlyjs", plotlyjs_path, @@ -92,59 +92,59 @@ orca <- function(p, file = "plot.png", format = tools::file_ext(file), if (safe) "--safe-mode", more_args ) - + if (!is.null(scale)) args <- c(args, "--scale", scale) if (!is.null(width)) args <- c(args, "--width", width) if (!is.null(height)) args <- c(args, "--height", height) if (!is.null(parallel_limit)) args <- c(args, "--parallel-limit", parallel_limit) if (!is.null(tryNULL(mapbox_token()))) args <- c(args, "--mapbox-access-token", mapbox_token()) if (isTRUE(mathjax)) args <- c(args, "--mathjax", file.path(mathjax_path(), "MathJax.js")) - + # TODO: point to local topojson? Should this only work if plot_geo(standalone = TRUE)? try_library("processx", "orca") invisible(processx::run("orca", args, echo = TRUE, spinner = TRUE, ...)) } #' Orca image export server -#' +#' #' @inheritParams orca #' @param port Sets the server's port number. #' @param keep_alive Turn on keep alive mode where orca will (try to) relaunch server if process unexpectedly exits. #' @param window_max_number Sets maximum number of browser windows the server can keep open at a given time. #' @param request_limit Sets a request limit that makes orca exit when reached. #' @param quiet Suppress all logging info. -#' +#' #' @section Methods: -#' +#' #' The `orca_serve()` function returns an object with two methods: -#' +#' #' \describe{ #' \item{\code{export(p, file = "plot.png", format = tools::file_ext(file), scale = NULL, width = NULL, height = NULL)}}{ #' Export a static image of a plotly graph. Arguments found here are the same as those found in `orca()` #' } #' \item{\code{close()}}{Close down the orca server and kill the underlying node process.} #' } -#' +#' #' @section Fields: -#' +#' #' The `orca_serve()` function returns an object with two fields: -#' +#' #' \describe{ #' \item{\code{port}}{The port number that the server is listening to.} #' \item{\code{process}}{An R6 class for controlling and querying the underlying node process.} #' } -#' +#' #' @export #' @rdname orca orca_serve <- function(port = 5151, mathjax = FALSE, safe = FALSE, request_limit = NULL, - keep_alive = TRUE, window_max_number = NULL, quiet = FALSE, + keep_alive = TRUE, window_max_number = NULL, quiet = FALSE, debug = FALSE, more_args = NULL, ...) { - + # make sure we have the required infrastructure orca_available() try_library("processx", "orca_serve") - + # use main bundle since any plot can be thrown at the server plotlyjs <- plotlyMainBundle() plotlyjs_path <- file.path(plotlyjs$src$file, plotlyjs$script) @@ -152,7 +152,7 @@ orca_serve <- function(port = 5151, mathjax = FALSE, safe = FALSE, request_limit if (!is.null(plotlyjs$package)) { plotlyjs_path <- system.file(plotlyjs_path, package = plotlyjs$package) } - + args <- c( "serve", "-p", port, @@ -164,21 +164,21 @@ orca_serve <- function(port = 5151, mathjax = FALSE, safe = FALSE, request_limit if (quiet) "--quiet", more_args ) - + if (!is.null(request_limit)) args <- c(args, "--request-limit", request_limit) - + if (!is.null(window_max_number)) args <- c(args, "--window-max-number", window_max_number) - - if (!is.null(tryNULL(mapbox_token()))) + + if (!is.null(tryNULL(mapbox_token()))) args <- c(args, "--mapbox-access-token", mapbox_token()) - - if (isTRUE(mathjax)) + + if (isTRUE(mathjax)) args <- c(args, "--mathjax", file.path(mathjax_path(), "MathJax.js")) - + process <- processx::process$new("orca", args, ...) - + list( port = port, process = process, @@ -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) @@ -218,7 +222,7 @@ orca_available <- function() { call. = FALSE ) } - + TRUE } @@ -226,7 +230,7 @@ orca_version <- function() { orca_available() # default to initial release if we can't correctly parse version tryCatch( - as.package_version(system("orca --version", intern = TRUE)), + as.package_version(system("orca --version", intern = TRUE)), error = function(e) "1.0.0" ) } diff --git a/R/plotly_IMAGE.R b/R/plotly_IMAGE.R index dd3f2b20fb..db6b1c9f43 100644 --- a/R/plotly_IMAGE.R +++ b/R/plotly_IMAGE.R @@ -1,6 +1,6 @@ #' Create a static image #' -#' The images endpoint turns a plot (which may be given in multiple forms) +#' The images endpoint turns a plot (which may be given in multiple forms) #' into an image of the desired format. #' #' @param x either a plotly object or a list. @@ -9,7 +9,8 @@ #' @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` +#' @importFrom httr RETRY write_disk #' @export #' @examples \dontrun{ #' p <- plot_ly(x = 1:10) @@ -18,12 +19,12 @@ #' Svg <- plotly_IMAGE(p, format = "svg", out_file = "plotly-test-image.svg") #' Pdf <- plotly_IMAGE(p, format = "pdf", out_file = "plotly-test-image.pdf") #' } -#' +#' -plotly_IMAGE <- function(x, width = 1000, height = 500, format = "png", +plotly_IMAGE <- function(x, width = 1000, height = 500, format = "png", scale = 1, out_file, ...) { x <- plotly_build(x)[["x"]] - + bod <- list( figure = x[c("data", "layout")], width = width, @@ -34,10 +35,17 @@ 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")) invisible(con) diff --git a/R/signup.R b/R/signup.R index 1f9472bcdc..63f2cc4faf 100644 --- a/R/signup.R +++ b/R/signup.R @@ -30,9 +30,9 @@ #' Sys.setenv("plotly_domain" = "http://mydomain.com") #' #' # If you want to automatically load these environment variables when you -#' # start R, you can put them inside your ~/.Rprofile +#' # start R, you can put them inside your ~/.Rprofile #' # (see help(.Rprofile) for more details) -#' +#' #' } signup <- function(username, email, save = TRUE) { if (missing(username)) username <- verify("username") @@ -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 diff --git a/R/utils.R b/R/utils.R index 6fc2472f13..def5d635e9 100644 --- a/R/utils.R +++ b/R/utils.R @@ -78,7 +78,7 @@ to_milliseconds <- function(x) { retain <- function(x, f = identity) { y <- structure(f(x), class = oldClass(x)) attrs <- attributes(x) - # TODO: do we set any other "special" attributes internally + # TODO: do we set any other "special" attributes internally # (grepping "structure(" suggests no) attrs <- attrs[names(attrs) %in% "apiSrc"] if (length(attrs)) { @@ -156,35 +156,35 @@ is_type <- function(p, type) { } # Replace elements of a nested list -# +# # @param x a named list -# @param indicies a vector of indices. +# @param indicies a vector of indices. # A 1D list may be used to specify both numeric and non-numeric inidices -# @param val the value used to -# @examples -# +# @param val the value used to +# @examples +# # x <- list(a = 1) # # equivalent to `x$a <- 2` # re_place(x, "a", 2) -# +# # y <- list(a = list(list(b = 2))) -# +# # # equivalent to `y$a[[1]]$b <- 2` # y <- re_place(y, list("a", 1, "b"), 3) # y re_place <- function(x, indicies = 1, val) { - + expr <- call("[[", quote(x), indicies[[1]]) if (length(indicies) == 1) { eval(call("<-", expr, val)) return(x) } - + for (i in seq(2, length(indicies))) { expr <- call("[[", expr, indicies[[i]]) } - + eval(call("<-", expr, val)) x } @@ -224,7 +224,7 @@ fit_bounds <- function(p) { max(rng$yrng) ), options = list( - padding = 10, + padding = 10, linear = FALSE, # NOTE TO SELF: can do something like this to customize easing # easing = htmlwidgets::JS("function(x) { return 1; }"), @@ -234,7 +234,7 @@ fit_bounds <- function(p) { p$x$layout[[id]]$center$lat <- mean(rng$yrng) p$x$layout[[id]]$center$lon <- mean(rng$xrng) } - + # Compute layout.geoid.lonaxis.range & layout.geoid.lataxis.range # for scattergeo geoIDs <- grep("^geo", sapply(p$x$data, "[[", "geo"), value = TRUE) @@ -245,7 +245,7 @@ fit_bounds <- function(p) { p$x$layout[[id]]$lataxis$range <- rng$yrng p$x$layout[[id]]$lonaxis$range <- rng$xrng } - + # Compute layout.axisid.scaleanchor & layout.axisid.scaleratio # for scatter/scattergl rows <- compact(lapply(p$x$data, function(x) c(x[["xaxis"]], x[["yaxis"]]))) @@ -271,7 +271,7 @@ fit_bounds <- function(p) { # TODO: only do this for lat/lon dat p$x$layout[[xname]]$scaleratio <- cos(mean(rng$yrng) * pi/180) } - + # Internal _bbox field no longer needed #p$x$data <- lapply(p$x$data, function(tr) { tr[["_bbox"]] <- NULL; tr }) p @@ -326,7 +326,7 @@ supply_defaults <- function(p) { if (is_subplot(p)) return(p) # supply trace anchor defaults anchors <- if (is_geo(p)) c("geo" = "geo") else if (is_mapbox(p)) c("subplot" = "mapbox") else c("xaxis" = "x", "yaxis" = "y") - + p$x$data <- lapply(p$x$data, function(tr) { for (i in seq_along(anchors)) { key <- names(anchors)[[i]] @@ -337,7 +337,7 @@ supply_defaults <- function(p) { }) # hack to avoid https://github.com/ropensci/plotly/issues/945 if (is_type(p, "parcoords")) p$x$layout$margin$t <- NULL - + # supply domain defaults geoDomain <- list(x = c(0, 1), y = c(0, 1)) if (is_geo(p) || is_mapbox(p)) { @@ -362,13 +362,13 @@ supply_defaults <- function(p) { supply_highlight_attrs <- function(p) { # set "global" options via crosstalk variable p$x$highlight <- p$x$highlight %||% highlight_defaults() - - # defaults are now populated, allowing us to populate some other + + # defaults are now populated, allowing us to populate some other # attributes such as the selectize widget definition sets <- unlist(lapply(p$x$data, "[[", "set")) keys <- setNames(lapply(p$x$data, "[[", "key"), sets) p$x$highlight$ctGroups <- i(unique(sets)) - + # TODO: throw warning if we don't detect valid keys? hasKeys <- FALSE for (i in p$x$highlight$ctGroups) { @@ -383,13 +383,13 @@ supply_highlight_attrs <- function(p) { items = data.frame(value = k, label = k), group = i ) } - + # set default values via crosstalk api vals <- p$x$highlight$defaultValues[p$x$highlight$defaultValues %in% k] if (length(vals)) { p <- htmlwidgets::onRender( p, sprintf( - "function(el, x) { crosstalk.group('%s').var('selection').set(%s) }", + "function(el, x) { crosstalk.group('%s').var('selection').set(%s) }", i, jsonlite::toJSON(as.character(vals), auto_unbox = FALSE) ) ) @@ -398,7 +398,7 @@ supply_highlight_attrs <- function(p) { # add HTML dependencies, set a sensible dragmode default, & throw messages if (hasKeys) { - p$x$layout$dragmode <- p$x$layout$dragmode %|D|% + p$x$layout$dragmode <- p$x$layout$dragmode %|D|% default(switch(p$x$highlight$on %||% "", plotly_selected = "select") %||% "zoom") if (is.default(p$x$highlight$off)) { message( @@ -409,7 +409,7 @@ supply_highlight_attrs <- function(p) { ) } } - + p } @@ -432,8 +432,8 @@ verify_attr_names <- function(p) { attrSpec <- Schema$traces[[thisTrace$type %||% "scatter"]]$attributes # make sure attribute names are valid attrs_name_check( - names(thisTrace), - c(names(attrSpec), "key", "set", "frame", "transforms", "_isNestedKey", "_isSimpleKey", "_isGraticule", "_bbox"), + names(thisTrace), + c(names(attrSpec), "key", "set", "frame", "transforms", "_isNestedKey", "_isSimpleKey", "_isGraticule", "_bbox"), thisTrace$type ) } @@ -457,7 +457,7 @@ verify_attr_spec <- function(p) { p$x$data[[tr]][["xaxis"]] <- p$x$data[[tr]][["xaxis"]] %||% NULL p$x$data[[tr]][["yaxis"]] <- p$x$data[[tr]][["yaxis"]] %||% NULL } - + p } @@ -466,29 +466,29 @@ verify_attr <- function(proposed, schema, layoutAttr = FALSE) { attrSchema <- schema[[attr]] %||% schema[[sub("[0-9]+$", "", attr)]] # if schema is missing (i.e., this is an un-official attr), move along if (is.null(attrSchema)) next - + valType <- tryNULL(attrSchema[["valType"]]) %||% "" role <- tryNULL(attrSchema[["role"]]) %||% "" arrayOK <- tryNULL(attrSchema[["arrayOk"]]) %||% FALSE isDataArray <- identical(valType, "data_array") - - # where applicable, reduce single valued vectors to a constant + + # where applicable, reduce single valued vectors to a constant # (while preserving attributes) if (!isDataArray && !arrayOK && !identical(role, "object")) { proposed[[attr]] <- retain(proposed[[attr]], uniq) } - - # If we deliberately only want hover on fills, send a string to - # plotly.js so it does something sensible + + # If we deliberately only want hover on fills, send a string to + # plotly.js so it does something sensible if (identical(proposed[["hoveron"]], "fills")) { proposed[["text"]] <- paste(uniq(proposed[["text"]]), collapse = "\n") } - + # ensure data_arrays of length 1 are boxed up by to_JSON() if (isDataArray) { proposed[[attr]] <- i(proposed[[attr]]) } - + # tag 'src-able' attributes (needed for api_create()) # note that layout has 'src-able' attributes that shouldn't # be turned into grids https://github.com/ropensci/plotly/pull/1489 @@ -496,12 +496,12 @@ verify_attr <- function(proposed, schema, layoutAttr = FALSE) { if ((isDataArray || isSrcAble) && !isTRUE(layoutAttr)) { proposed[[attr]] <- structure(proposed[[attr]], apiSrc = TRUE) } - + if (length(proposed[["name"]]) > 0) { proposed$name <- uniq(proposed$name) } - - # if marker.size was populated via `size` arg (i.e., internal map_size()), + + # if marker.size was populated via `size` arg (i.e., internal map_size()), # then it should _always_ be an array # of appropriate length... # (when marker.size is a constant, it always sets the diameter!) @@ -510,21 +510,21 @@ verify_attr <- function(proposed, schema, layoutAttr = FALSE) { if (is.default(proposed$marker$size)) { s <- proposed$marker[["size"]] if (length(s) == 1) { - # marker.size could be of length 1, but we may have multiple - # markers -- in that case, if marker.size is an array + # marker.size could be of length 1, but we may have multiple + # markers -- in that case, if marker.size is an array # of length 1 will result in just one marker # https://codepen.io/cpsievert/pen/aMmOza n <- length(proposed[["x"]] %||% proposed[["y"]] %||% proposed[["lat"]] %||% proposed[["lon"]]) proposed$marker[["size"]] <- default(i(rep(s, n))) } } - + # do the same for "sub-attributes" if (identical(role, "object") && is.recursive(proposed[[attr]])) { proposed[[attr]] <- verify_attr(proposed[[attr]], schema[[attr]], layoutAttr = layoutAttr) } } - + proposed } @@ -536,9 +536,9 @@ attrs_name_check <- function(proposedAttrs, validAttrs, type = "scatter") { } if (length(illegalAttrs)) { warning("'", type, "' objects don't have these attributes: '", - paste(illegalAttrs, collapse = "', '"), "'\n", + paste(illegalAttrs, collapse = "', '"), "'\n", "Valid attributes include:\n'", - paste(validAttrs, collapse = "', '"), "'\n", + paste(validAttrs, collapse = "', '"), "'\n", call. = FALSE) } invisible(proposedAttrs) @@ -558,21 +558,21 @@ verify_type <- function(trace) { if (xNumeric && yNumeric) { if (any(attrLengths) > 15000) "scattergl" else "scatter" } else if (xNumeric || yNumeric) { - "bar" + "bar" } else "histogram2d" } else if ("y" %in% attrs || "x" %in% attrs) { "histogram" } else if ("z" %in% attrs) { "heatmap" } else { - warning("No trace type specified and no positional attributes specified", + warning("No trace type specified and no positional attributes specified", call. = FALSE) "scatter" } relay_type(trace$type) } if (!is.character(trace$type) || length(trace$type) != 1) { - stop("The trace type must be a character vector of length 1.\n", + stop("The trace type must be a character vector of length 1.\n", call. = FALSE) } if (!trace$type %in% names(Schema$traces)) { @@ -594,21 +594,21 @@ verify_type <- function(trace) { relay_type <- function(type) { message( - "No trace type specified:\n", + "No trace type specified:\n", " Based on info supplied, a '", type, "' trace seems appropriate.\n", " Read more about this trace type -> https://plot.ly/r/reference/#", type ) type } -# Searches a list for character strings and translates R linebreaks to HTML -# linebreaks (i.e., '\n' -> '
'). JavaScript function definitions created +# Searches a list for character strings and translates R linebreaks to HTML +# linebreaks (i.e., '\n' -> '
'). JavaScript function definitions created # via `htmlwidgets::JS()` are ignored translate_linebreaks <- function(p) { recurse <- function(a) { typ <- typeof(a) if (typ == "list") { - # retain the class of list elements + # retain the class of list elements # which important for many things, such as colorbars a[] <- lapply(a, recurse) } else if (typ == "character" && !inherits(a, "JS_EVAL")) { @@ -672,12 +672,12 @@ verify_colorscale <- function(p) { trace$colorscale <- colorscale_json(trace$colorscale) trace$marker$colorscale <- colorscale_json(trace$marker$colorscale) trace - }) + }) p } # Coerce `x` into a data structure that can map to a colorscale attribute. -# Note that colorscales can either be the name of a scale (e.g., 'Rainbow') or +# Note that colorscales can either be the name of a scale (e.g., 'Rainbow') or # a 2D array (e.g., [[0, 'rgb(0,0,255)'], [1, 'rgb(255,0,0)']]) colorscale_json <- function(x) { if (!length(x)) return(x) @@ -730,7 +730,7 @@ populate_categorical_axes <- function(p) { # collect all the data that goes on this axis d <- lapply(p$x$data, "[[", axisType) isOnThisAxis <- function(tr) { - is.null(tr[["geo"]]) && sub("axis", "", axisName) %in% + is.null(tr[["geo"]]) && sub("axis", "", axisName) %in% (tr[[sub("[0-9]+", "", axisName)]] %||% axisType) && # avoid reordering matrices (see #863) !is.matrix(tr[["z"]]) @@ -740,7 +740,7 @@ populate_categorical_axes <- function(p) { isDiscrete <- vapply(d, is.discrete, logical(1)) if (0 < sum(isDiscrete) & sum(isDiscrete) < length(d)) { warning( - "Can't display both discrete & non-discrete data on same axis", + "Can't display both discrete & non-discrete data on same axis", call. = FALSE ) next @@ -749,11 +749,11 @@ populate_categorical_axes <- function(p) { categories <- lapply(d, getLevels) categories <- unique(unlist(categories)) if (any(!vapply(d, is.factor, logical(1)))) categories <- sort(categories) - p$x$layout[[axisName]]$type <- + p$x$layout[[axisName]]$type <- p$x$layout[[axisName]]$type %||% "category" - p$x$layout[[axisName]]$categoryorder <- + p$x$layout[[axisName]]$categoryorder <- p$x$layout[[axisName]]$categoryorder %||% "array" - p$x$layout[[axisName]]$categoryarray <- + p$x$layout[[axisName]]$categoryarray <- p$x$layout[[axisName]]$categoryarray %||% categories } p @@ -797,8 +797,8 @@ verify_key_type <- function(p) { # does it *ever* make sense to have a missing key value? uk <- uniq(k) if (length(uk) == 1) { - # i.e., the key for this trace has one value. In this case, - # we don't have iterate through the entire key, so instead, + # i.e., the key for this trace has one value. In this case, + # we don't have iterate through the entire key, so instead, # we provide a flag to inform client side logic to match the _entire_ # trace if this one key value is a match p$x$data[[i]]$key <- uk[[1]] @@ -814,7 +814,7 @@ verify_key_type <- function(p) { p$x$data[[i]]$key <- I(as.character(p$x$data[[i]]$key)) } } - p + p } verify_webgl <- function(p) { @@ -844,44 +844,44 @@ verify_showlegend <- function(p) { ann <- p$x$layout$annotations is_title <- vapply(ann, function(x) isTRUE(x$legendTitle), logical(1)) p$x$layout$annotations <- ann[!is_title] - p$x$layout$showlegend <- FALSE + p$x$layout$showlegend <- FALSE } show <- vapply(p$x$data, function(x) x$showlegend %||% TRUE, logical(1)) - # respect only _user-specified_ defaults - isSinglePie <- identical("pie", unlist(lapply(p$x$data, function(tr) tr$type))) + # respect only _user-specified_ defaults + isSinglePie <- identical("pie", unlist(lapply(p$x$data, function(tr) tr$type))) p$x$layout$showlegend <- p$x$layout$showlegend %|D|% default(sum(show) > 1 || isTRUE(p$x$highlight$showInLegend) || isSinglePie) p } verify_guides <- function(p) { - + # since colorbars are implemented as "invisible" traces, prevent a "trivial" legend if (has_colorbar(p) && has_legend(p) && length(p$x$data) <= 2) { p$x$layout$showlegend <- default(FALSE) } - + isVisibleBar <- function(tr) { is.colorbar(tr) && (tr$showscale %||% TRUE) } isBar <- vapply(p$x$data, isVisibleBar, logical(1)) nGuides <- sum(isBar) + has_legend(p) - + if (nGuides > 1) { - + # place legend at bottom since its scrolly yanchor <- default("top") y <- default(1 - ((nGuides - 1) / nGuides)) p$x$layout$legend$yanchor <- p$x$layout$legend$yanchor %|D|% yanchor p$x$layout$legend$y <- p$x$layout$legend[["y"]] %|D|% y - + # shrink/position colorbars idx <- which(isBar) for (i in seq_along(idx)) { len <- default(1 / nGuides) lenmode <- default("fraction") y <- default(1 - ((i - 1) / nGuides)) - + j <- idx[[i]] tr <- p$x$data[[j]] if (inherits(tr, "zcolor")) { @@ -896,19 +896,19 @@ verify_guides <- function(p) { p$x$data[[j]]$marker$colorbar$yanchor <- tr$marker$colorbar$yanchor %|D|% yanchor } } - + } - + p } verify_mathjax <- function(p) { hasMathjax <- "mathjax" %in% sapply(p$dependencies, "[[", "name") if (hasMathjax) return(p) - + hasTeX <- any(rapply(p$x, is.TeX)) if (!hasTeX) return(p) - + # TODO: it would be much better to add the dependency here, but # htmlwidgets doesn't currently support adding dependencies at print-time! warning( @@ -922,7 +922,7 @@ verify_mathjax <- function(p) { verify_scattergl_platform <- function(p) { if (!identical(.Platform$OS.type, "windows")) return(p) if (!is_rstudio()) return(p) - + types <- vapply(p$x$data, function(x) x[["type"]] %||% "scatter", character(1)) if ("scattergl" %in% types) { warning( @@ -931,7 +931,7 @@ verify_scattergl_platform <- function(p) { call. = FALSE ) } - + p } @@ -963,7 +963,7 @@ has_legend <- function(p) { showLegend <- function(tr) { tr$showlegend %||% TRUE } - any(vapply(p$x$data, showLegend, logical(1))) && + any(vapply(p$x$data, showLegend, logical(1))) && isTRUE(p$x$layout$showlegend %|D|% TRUE) } @@ -1042,17 +1042,17 @@ rm_asis <- function(x) { # https://github.com/jeroenooms/jsonlite/issues/29 if (is.null(x)) return(NA) if (is.data.frame(x)) return(x) - if (is.list(x)) lapply(x, rm_asis) + if (is.list(x)) lapply(x, rm_asis) # strip any existing 'AsIs' list elements of their 'AsIs' status. - # this is necessary since ggplot_build(qplot(1:10, fill = I("red"))) - # returns list element with their 'AsIs' class, + # this is necessary since ggplot_build(qplot(1:10, fill = I("red"))) + # returns list element with their 'AsIs' class, # which conflicts with our JSON unboxing strategy. else if (inherits(x, "AsIs")) class(x) <- setdiff(class(x), "AsIs") else x } -# add a class to an object only if it is new, and keep any existing classes of +# add a class to an object only if it is new, and keep any existing classes of # that object append_class <- function(x, y) { structure(x, class = unique(c(class(x), y))) @@ -1131,7 +1131,7 @@ try_library <- function(pkg, fun = NULL) { if (system.file(package = pkg) != "") { return(invisible()) } - stop("Package `", pkg, "` required", if (!is.null(fun)) paste0(" for `", fun, "`"), ".\n", + stop("Package `", pkg, "` required", if (!is.null(fun)) paste0(" for `", fun, "`"), ".\n", "Please install and try again.", call. = FALSE) } diff --git a/inst/plotlyjs.R b/inst/plotlyjs.R index d29e1496d7..8598201f2f 100644 --- a/inst/plotlyjs.R +++ b/inst/plotlyjs.R @@ -1,7 +1,13 @@ library(httr) # download latest GitHub release # for a particular version: `zip <- "https://github.com/plotly/plotly.js/archive/v1.33.1.zip"` -x <- GET('https://api.github.com/repos/plotly/plotly.js/releases/latest') +x <- httr::RETRY( + verb = "GET" + , url = 'https://api.github.com/repos/plotly/plotly.js/releases/latest' + , times = 5 + , terminate_on = c(400, 401, 403, 404) + , terminate_on_success = TRUE +) zip <- content(x)$zipball_url tmp <- tempfile(fileext = ".zip") download.file(zip, tmp) @@ -9,14 +15,14 @@ unzip(tmp) # update the default bundle file.copy( - Sys.glob("*plotly.js*/dist/plotly.min.js"), - "inst/htmlwidgets/lib/plotlyjs/plotly-latest.min.js", + Sys.glob("*plotly.js*/dist/plotly.min.js"), + "inst/htmlwidgets/lib/plotlyjs/plotly-latest.min.js", overwrite = TRUE ) # update the plotly.js LICENSE file.copy( - Sys.glob("*plotly.js*/LICENSE"), - "inst/htmlwidgets/lib/plotlyjs/LICENSE", + Sys.glob("*plotly.js*/LICENSE"), + "inst/htmlwidgets/lib/plotlyjs/LICENSE", overwrite = TRUE ) # update the locale files @@ -43,8 +49,8 @@ message("Manually update plotly.R with this version") -# download latest build from master +# download latest build from master #download.file( -# "https://raw.githubusercontent.com/plotly/plotly.js/master/dist/plotly.min.js", +# "https://raw.githubusercontent.com/plotly/plotly.js/master/dist/plotly.min.js", # destfile = "inst/htmlwidgets/lib/plotlyjs/plotly-latest.min.js" #) diff --git a/man/api.Rd b/man/api.Rd index ef1ab1ac14..0f1aaf13d2 100644 --- a/man/api.Rd +++ b/man/api.Rd @@ -67,7 +67,7 @@ viewing that page will be able to view the graph. You do not need to be logged in to view this plot.} \item{...}{For \code{api()}, these arguments are passed onto -\code{\link[httr:VERB]{httr::VERB()}}. For \code{api_create()}, these arguments are +\code{\link[httr:RETRY]{httr::RETRY()}}. For \code{api_create()}, these arguments are included in the body of the HTTP request.} \item{id}{a filename id.} @@ -78,9 +78,9 @@ included in the body of the HTTP request.} To see a list of all available endpoints, call \code{api()}. Any relevant query parameters should be included here (see examples).} -\item{verb}{name of the HTTP verb to use (as in, \code{\link[httr:VERB]{httr::VERB()}}).} +\item{verb}{name of the HTTP verb to use (as in, \code{\link[httr:RETRY]{httr::RETRY()}}).} -\item{body}{body of the HTTP request(as in, \code{\link[httr:VERB]{httr::VERB()}}). +\item{body}{body of the HTTP request(as in, \code{\link[httr:RETRY]{httr::RETRY()}}). If this value is not already converted to JSON (via \code{\link[jsonlite:toJSON]{jsonlite::toJSON()}}), it uses the internal \code{to_JSON()} to ensure values are "automatically unboxed" (i.e., vec.} @@ -100,7 +100,7 @@ For anything else, use \code{api()}. # and/or data frames to your plotly account # ------------------------------------------------------------ -# A data frame creates a plotly "grid". Printing one will take you +# A data frame creates a plotly "grid". Printing one will take you # to the it's web address so you can start creating! (m <- api_create(mtcars)) @@ -117,7 +117,7 @@ layout( ) ------------------------------------------------------------ -# The api() function provides a low-level interface for performing +# The api() function provides a low-level interface for performing # any action at any endpoint! It always returns a list. # ------------------------------------------------------------ @@ -143,7 +143,7 @@ api("files/cpsievert:14681") # change the filename https://api.plot.ly/v2/files#update # (note: this won't work unless you have proper credentials to the relevant account) -api("files/cpsievert:14681", "PATCH", list(filename = "toy file")) +api("files/cpsievert:14681", "PATCH", list(filename = "toy file")) # Copy a file https://api.plot.ly/v2/files#lookup api("files/cpsievert:14681/copy", "POST") From 312494460a4911e3c401f822d0e94e9b446d1e1c Mon Sep 17 00:00:00 2001 From: James Lamb Date: Mon, 6 Jan 2020 20:05:55 -0600 Subject: [PATCH 2/4] cleaned up whitespace changes --- R/api_exports.R | 88 ++++++++++++------------- R/imports.R | 6 +- R/orca.R | 100 ++++++++++++++--------------- R/plotly_IMAGE.R | 8 +-- R/signup.R | 4 +- R/utils.R | 164 +++++++++++++++++++++++------------------------ inst/plotlyjs.R | 12 ++-- man/api.Rd | 6 +- 8 files changed, 194 insertions(+), 194 deletions(-) diff --git a/R/api_exports.R b/R/api_exports.R index 68357e13b3..02ba433e81 100644 --- a/R/api_exports.R +++ b/R/api_exports.R @@ -1,68 +1,68 @@ #' Tools for working with plotly's REST API (v2) -#' +#' #' Convenience functions for working with version 2 of plotly's REST API. #' Upload R objects to a plotly account via `api_create()` and download #' plotly objects via `api_download_plot()`/`api_download_grid()`. #' For anything else, use `api()`. -#' -#' @param id a filename id. +#' +#' @param id a filename id. #' @param username a plotly username. -#' -#' @param x An R object to hosted on plotly's web platform. +#' +#' @param x An R object to hosted on plotly's web platform. #' Can be a plotly/ggplot2 object or a \link{data.frame}. #' @param filename character vector naming file(s). If `x` is a plot, #' can be a vector of length 2 naming both the plot AND the underlying grid. -#' @param fileopt character string describing whether to "overwrite" existing +#' @param fileopt character string describing whether to "overwrite" existing #' files or ensure "new" file(s) are always created. -#' @param sharing If 'public', anyone can view this graph. It will appear in +#' @param sharing If 'public', anyone can view this graph. It will appear in #' your profile and can appear in search engines. You do not need to be #' logged in to Plotly to view this chart. #' If 'private', only you can view this plot. It will not appear in the -#' Plotly feed, your profile, or search engines. You must be logged in to -#' Plotly to view this graph. You can privately share this graph with other -#' Plotly users in your online Plotly account and they will need to be logged +#' Plotly feed, your profile, or search engines. You must be logged in to +#' Plotly to view this graph. You can privately share this graph with other +#' Plotly users in your online Plotly account and they will need to be logged #' in to view this plot. #' If 'secret', anyone with this secret link can view this chart. It will -#' not appear in the Plotly feed, your profile, or search engines. -#' If it is embedded inside a webpage or an IPython notebook, anybody who is -#' viewing that page will be able to view the graph. +#' not appear in the Plotly feed, your profile, or search engines. +#' If it is embedded inside a webpage or an IPython notebook, anybody who is +#' viewing that page will be able to view the graph. #' You do not need to be logged in to view this plot. -#' -#' @param endpoint the endpoint (i.e., location) for the request. +#' +#' @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::RETRY()]). #' @param body body of the HTTP request(as in, [httr::RETRY()]). -#' If this value is not already converted to JSON +#' 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 +#' @param ... For `api()`, these arguments are passed onto #' [httr::RETRY()]. For `api_create()`, these arguments are #' included in the body of the HTTP request. -#' +#' #' @export #' @rdname api #' @author Carson Sievert #' @references \url{https://api.plot.ly/v2} #' @seealso [signup()] -#' @examples -#' +#' @examples +#' #' \dontrun{ -#' +#' #' # ------------------------------------------------------------ #' # api_create() makes it easy to upload ggplot2/plotly objects #' # and/or data frames to your plotly account #' # ------------------------------------------------------------ -#' -#' # A data frame creates a plotly "grid". Printing one will take you +#' +#' # A data frame creates a plotly "grid". Printing one will take you #' # to the it's web address so you can start creating! #' (m <- api_create(mtcars)) -#' +#' #' # A plotly/ggplot2 object create a plotly "plot". #' p <- plot_ly(mtcars, x = ~factor(vs)) #' (r <- api_create(p)) -#' +#' #' # api_create() returns metadata about the remote "file". Here is #' # one way you could use that metadata to download a plot for local use: #' fileID <- strsplit(r$file$fid, ":")[[1]] @@ -72,18 +72,18 @@ #' ) #' #' ------------------------------------------------------------ -#' # The api() function provides a low-level interface for performing +#' # The api() function provides a low-level interface for performing #' # any action at any endpoint! It always returns a list. #' # ------------------------------------------------------------ -#' +#' #' # list all the endpoints #' api() -#' +#' #' # search the entire platform! #' # see https://api.plot.ly/v2/search #' api("search?q=overdose") #' api("search?q=plottype:pie trump fake") -#' +#' #' # these examples will require a user account #' usr <- Sys.getenv("plotly_username", NA) #' if (!is.na(usr)) { @@ -92,27 +92,27 @@ #' # your folders/files https://api.plot.ly/v2/folders#user #' api(sprintf("folders/home?user=%s", usr)) #' } -#' +#' #' # Retrieve a specific file https://api.plot.ly/v2/files#retrieve #' api("files/cpsievert:14681") -#' +#' #' # change the filename https://api.plot.ly/v2/files#update #' # (note: this won't work unless you have proper credentials to the relevant account) -#' api("files/cpsievert:14681", "PATCH", list(filename = "toy file")) -#' +#' api("files/cpsievert:14681", "PATCH", list(filename = "toy file")) +#' #' # Copy a file https://api.plot.ly/v2/files#lookup #' api("files/cpsievert:14681/copy", "POST") -#' +#' #' # Create a folder https://api.plot.ly/v2/folders#create #' api("folders", "POST", list(path = "/starts/at/root/and/ends/here")) -#' +#' #' } -#' +#' #' @rdname api #' @export -api_create <- function(x = last_plot(), filename = NULL, +api_create <- function(x = last_plot(), filename = NULL, fileopt = c("overwrite", "new"), sharing = c("public", "private", "secret"), ...) { fileopt <- match.arg(fileopt, c("overwrite", "new")) @@ -140,7 +140,7 @@ api_create.data.frame <- api_create_grid api_download_plot <- function(id, username) { f <- api_download_file(id, username) api_expect_filetype(f, "plot") - + as_widget( api_download_file(id, username, "plots", "content?inline_data=true") ) @@ -152,7 +152,7 @@ api_download_plot <- function(id, username) { api_download_grid <- function(id, username) { f <- api_download_file(id, username) api_expect_filetype(f, "grid") - + prefix_class( api_download_file(id, username, "grids"), "api_grid_local" ) @@ -174,20 +174,20 @@ api_download_file <- function(id, username, endpoint = "files", ...) { #' @export api <- function(endpoint = "/", verb = "GET", body = NULL, ...) { api_check_endpoint(endpoint) - + # construct the url url <- httr::modify_url( - get_domain("api"), + get_domain("api"), scheme = "https", # TODO: should anything else in the endpoint (besides whitespace) be escaped? path = file.path("v2", gsub("\\s+", "+", endpoint)) ) - + # default to unboxing (i.e., no arrays of length 1) if (!is.null(body) && !inherits(body, "json")) { body <- to_JSON(body) } - + resp <- httr::RETRY( verb = verb , url = url @@ -199,6 +199,6 @@ api <- function(endpoint = "/", verb = "GET", body = NULL, ...) { , terminate_on_success = TRUE , ... ) - + structure(process(resp), class = "api") } diff --git a/R/imports.R b/R/imports.R index 3ec37d7434..907d3ba772 100644 --- a/R/imports.R +++ b/R/imports.R @@ -18,7 +18,7 @@ NULL -#' @importFrom dplyr mutate +#' @importFrom dplyr mutate #' @name mutate #' @rdname reexports #' @export @@ -66,7 +66,7 @@ dplyr::rename #' @export dplyr::rename_ -#' @importFrom dplyr group_by +#' @importFrom dplyr group_by #' @name group_by #' @rdname reexports #' @export @@ -169,7 +169,7 @@ dplyr::filter_ # #' @rdname reexports # #' @export # tidyr::gather -# +# # #' @importFrom tidyr gather_ # #' @name gather_ # #' @rdname reexports diff --git a/R/orca.R b/R/orca.R index 6d6ada47d5..88b10259ce 100644 --- a/R/orca.R +++ b/R/orca.R @@ -1,76 +1,76 @@ -#' Static image exporting -#' +#' Static image exporting +#' #' Export plotly objects to static images (e.g., pdf, png, jpeg, svg, etc) via the #' [orca command-line utility](https://github.com/plotly/orca#installation). -#' +#' #' The `orca()` function is designed for exporting one plotly graph whereas `orca_serve()` #' is meant for exporting many graphs at once. The former starts and stops an external (nodejs) #' process everytime it is called whereas the latter starts up a process when called, then -#' returns an `export()` method for exporting graphs as well as a `close()` method for stopping +#' returns an `export()` method for exporting graphs as well as a `close()` method for stopping #' the external (background) process. -#' +#' #' @param p a plotly object. #' @param file output filename. #' @param format the output format (png, jpeg, webp, svg, pdf, eps). #' @param scale Sets the image scale. Applies to all output images. -#' @param width Sets the image width. If not set, defaults to `layout.width` value. +#' @param width Sets the image width. If not set, defaults to `layout.width` value. #' Applies to all output images. -#' @param height Sets the image height. If not set, defaults to `layout.height` value. +#' @param height Sets the image height. If not set, defaults to `layout.height` value. #' Applies to all output images. #' @param mathjax whether or not to include MathJax (required to render [TeX]). -#' If `TRUE`, the PLOTLY_MATHJAX_PATH environment variable must be set and point -#' to the location of MathJax (this variable is also used to render [TeX] in +#' If `TRUE`, the PLOTLY_MATHJAX_PATH environment variable must be set and point +#' to the location of MathJax (this variable is also used to render [TeX] in #' interactive graphs, see [config]). #' @param parallel_limit Sets the limit of parallel tasks run. #' @param verbose Turn on verbose logging on stdout. #' @param debug Starts app in debug mode and turn on verbose logs on stdout. -#' @param safe Turns on safe mode: where figures likely to make browser window +#' @param safe Turns on safe mode: where figures likely to make browser window #' hang during image generating are skipped. #' @param more_args additional arguments to pass along to system command. This is useful #' for specifying display and/or electron options, such as `--enable-webgl` or `--disable-gpu`. -#' @param ... for `orca()`, additional arguments passed along to `processx::run`. For +#' @param ... for `orca()`, additional arguments passed along to `processx::run`. For #' `orca_serve()`, additional arguments passed along to `processx::process`. #' @export #' @author Carson Sievert #' @md #' @rdname orca #' @examples -#' +#' #' \dontrun{ #' # NOTE: in a headless environment, you may need to set `more_args="--enable-webgl"` #' # to export webgl correctly #' p <- plot_ly(z = ~volcano) %>% add_surface() #' orca(p, "surface-plot.svg") -#' +#' #' #' # launch the server #' server <- orca_serve() -#' +#' #' # export as many graphs as you'd like #' server$export(qplot(1:10), "test1.pdf") #' server$export(plot_ly(x = 1:10, y = 1:10), "test2.pdf") -#' +#' #' # the underlying process is exposed as a field, so you #' # have full control over the external process #' server$process$is_alive() -#' +#' #' # convenience method for closing down the server #' server$close() -#' +#' #' # remove the exported files from disk #' unlink("test1.pdf") #' unlink("test2.pdf") #' } -#' +#' -orca <- function(p, file = "plot.png", format = tools::file_ext(file), +orca <- function(p, file = "plot.png", format = tools::file_ext(file), scale = NULL, width = NULL, height = NULL, mathjax = FALSE, - parallel_limit = NULL, verbose = FALSE, debug = FALSE, + parallel_limit = NULL, verbose = FALSE, debug = FALSE, safe = FALSE, more_args = NULL, ...) { - + orca_available() - + b <- plotly_build(p) - + # find the relevant plotly.js bundle plotlyjs <- plotlyjsBundle(b) plotlyjs_path <- file.path(plotlyjs$src$file, plotlyjs$script) @@ -78,12 +78,12 @@ orca <- function(p, file = "plot.png", format = tools::file_ext(file), if (!is.null(plotlyjs$package)) { plotlyjs_path <- system.file(plotlyjs_path, package = plotlyjs$package) } - + tmp <- tempfile(fileext = ".json") cat(to_JSON(b$x[c("data", "layout")]), file = tmp) - + args <- c( - "graph", tmp, + "graph", tmp, "-o", file, "--format", format, "--plotlyjs", plotlyjs_path, @@ -92,59 +92,59 @@ orca <- function(p, file = "plot.png", format = tools::file_ext(file), if (safe) "--safe-mode", more_args ) - + if (!is.null(scale)) args <- c(args, "--scale", scale) if (!is.null(width)) args <- c(args, "--width", width) if (!is.null(height)) args <- c(args, "--height", height) if (!is.null(parallel_limit)) args <- c(args, "--parallel-limit", parallel_limit) if (!is.null(tryNULL(mapbox_token()))) args <- c(args, "--mapbox-access-token", mapbox_token()) if (isTRUE(mathjax)) args <- c(args, "--mathjax", file.path(mathjax_path(), "MathJax.js")) - + # TODO: point to local topojson? Should this only work if plot_geo(standalone = TRUE)? try_library("processx", "orca") invisible(processx::run("orca", args, echo = TRUE, spinner = TRUE, ...)) } #' Orca image export server -#' +#' #' @inheritParams orca #' @param port Sets the server's port number. #' @param keep_alive Turn on keep alive mode where orca will (try to) relaunch server if process unexpectedly exits. #' @param window_max_number Sets maximum number of browser windows the server can keep open at a given time. #' @param request_limit Sets a request limit that makes orca exit when reached. #' @param quiet Suppress all logging info. -#' +#' #' @section Methods: -#' +#' #' The `orca_serve()` function returns an object with two methods: -#' +#' #' \describe{ #' \item{\code{export(p, file = "plot.png", format = tools::file_ext(file), scale = NULL, width = NULL, height = NULL)}}{ #' Export a static image of a plotly graph. Arguments found here are the same as those found in `orca()` #' } #' \item{\code{close()}}{Close down the orca server and kill the underlying node process.} #' } -#' +#' #' @section Fields: -#' +#' #' The `orca_serve()` function returns an object with two fields: -#' +#' #' \describe{ #' \item{\code{port}}{The port number that the server is listening to.} #' \item{\code{process}}{An R6 class for controlling and querying the underlying node process.} #' } -#' +#' #' @export #' @rdname orca orca_serve <- function(port = 5151, mathjax = FALSE, safe = FALSE, request_limit = NULL, - keep_alive = TRUE, window_max_number = NULL, quiet = FALSE, + keep_alive = TRUE, window_max_number = NULL, quiet = FALSE, debug = FALSE, more_args = NULL, ...) { - + # make sure we have the required infrastructure orca_available() try_library("processx", "orca_serve") - + # use main bundle since any plot can be thrown at the server plotlyjs <- plotlyMainBundle() plotlyjs_path <- file.path(plotlyjs$src$file, plotlyjs$script) @@ -152,7 +152,7 @@ orca_serve <- function(port = 5151, mathjax = FALSE, safe = FALSE, request_limit if (!is.null(plotlyjs$package)) { plotlyjs_path <- system.file(plotlyjs_path, package = plotlyjs$package) } - + args <- c( "serve", "-p", port, @@ -164,21 +164,21 @@ orca_serve <- function(port = 5151, mathjax = FALSE, safe = FALSE, request_limit if (quiet) "--quiet", more_args ) - + if (!is.null(request_limit)) args <- c(args, "--request-limit", request_limit) - + if (!is.null(window_max_number)) args <- c(args, "--window-max-number", window_max_number) - - if (!is.null(tryNULL(mapbox_token()))) + + if (!is.null(tryNULL(mapbox_token()))) args <- c(args, "--mapbox-access-token", mapbox_token()) - - if (isTRUE(mathjax)) + + if (isTRUE(mathjax)) args <- c(args, "--mathjax", file.path(mathjax_path(), "MathJax.js")) - + process <- processx::process$new("orca", args, ...) - + list( port = port, process = process, @@ -222,7 +222,7 @@ orca_available <- function() { call. = FALSE ) } - + TRUE } @@ -230,7 +230,7 @@ orca_version <- function() { orca_available() # default to initial release if we can't correctly parse version tryCatch( - as.package_version(system("orca --version", intern = TRUE)), + as.package_version(system("orca --version", intern = TRUE)), error = function(e) "1.0.0" ) } diff --git a/R/plotly_IMAGE.R b/R/plotly_IMAGE.R index db6b1c9f43..08a22d15a4 100644 --- a/R/plotly_IMAGE.R +++ b/R/plotly_IMAGE.R @@ -1,6 +1,6 @@ #' Create a static image #' -#' The images endpoint turns a plot (which may be given in multiple forms) +#' The images endpoint turns a plot (which may be given in multiple forms) #' into an image of the desired format. #' #' @param x either a plotly object or a list. @@ -19,12 +19,12 @@ #' Svg <- plotly_IMAGE(p, format = "svg", out_file = "plotly-test-image.svg") #' Pdf <- plotly_IMAGE(p, format = "pdf", out_file = "plotly-test-image.pdf") #' } -#' +#' -plotly_IMAGE <- function(x, width = 1000, height = 500, format = "png", +plotly_IMAGE <- function(x, width = 1000, height = 500, format = "png", scale = 1, out_file, ...) { x <- plotly_build(x)[["x"]] - + bod <- list( figure = x[c("data", "layout")], width = width, diff --git a/R/signup.R b/R/signup.R index 63f2cc4faf..921ef046a7 100644 --- a/R/signup.R +++ b/R/signup.R @@ -30,9 +30,9 @@ #' Sys.setenv("plotly_domain" = "http://mydomain.com") #' #' # If you want to automatically load these environment variables when you -#' # start R, you can put them inside your ~/.Rprofile +#' # start R, you can put them inside your ~/.Rprofile #' # (see help(.Rprofile) for more details) -#' +#' #' } signup <- function(username, email, save = TRUE) { if (missing(username)) username <- verify("username") diff --git a/R/utils.R b/R/utils.R index def5d635e9..6fc2472f13 100644 --- a/R/utils.R +++ b/R/utils.R @@ -78,7 +78,7 @@ to_milliseconds <- function(x) { retain <- function(x, f = identity) { y <- structure(f(x), class = oldClass(x)) attrs <- attributes(x) - # TODO: do we set any other "special" attributes internally + # TODO: do we set any other "special" attributes internally # (grepping "structure(" suggests no) attrs <- attrs[names(attrs) %in% "apiSrc"] if (length(attrs)) { @@ -156,35 +156,35 @@ is_type <- function(p, type) { } # Replace elements of a nested list -# +# # @param x a named list -# @param indicies a vector of indices. +# @param indicies a vector of indices. # A 1D list may be used to specify both numeric and non-numeric inidices -# @param val the value used to -# @examples -# +# @param val the value used to +# @examples +# # x <- list(a = 1) # # equivalent to `x$a <- 2` # re_place(x, "a", 2) -# +# # y <- list(a = list(list(b = 2))) -# +# # # equivalent to `y$a[[1]]$b <- 2` # y <- re_place(y, list("a", 1, "b"), 3) # y re_place <- function(x, indicies = 1, val) { - + expr <- call("[[", quote(x), indicies[[1]]) if (length(indicies) == 1) { eval(call("<-", expr, val)) return(x) } - + for (i in seq(2, length(indicies))) { expr <- call("[[", expr, indicies[[i]]) } - + eval(call("<-", expr, val)) x } @@ -224,7 +224,7 @@ fit_bounds <- function(p) { max(rng$yrng) ), options = list( - padding = 10, + padding = 10, linear = FALSE, # NOTE TO SELF: can do something like this to customize easing # easing = htmlwidgets::JS("function(x) { return 1; }"), @@ -234,7 +234,7 @@ fit_bounds <- function(p) { p$x$layout[[id]]$center$lat <- mean(rng$yrng) p$x$layout[[id]]$center$lon <- mean(rng$xrng) } - + # Compute layout.geoid.lonaxis.range & layout.geoid.lataxis.range # for scattergeo geoIDs <- grep("^geo", sapply(p$x$data, "[[", "geo"), value = TRUE) @@ -245,7 +245,7 @@ fit_bounds <- function(p) { p$x$layout[[id]]$lataxis$range <- rng$yrng p$x$layout[[id]]$lonaxis$range <- rng$xrng } - + # Compute layout.axisid.scaleanchor & layout.axisid.scaleratio # for scatter/scattergl rows <- compact(lapply(p$x$data, function(x) c(x[["xaxis"]], x[["yaxis"]]))) @@ -271,7 +271,7 @@ fit_bounds <- function(p) { # TODO: only do this for lat/lon dat p$x$layout[[xname]]$scaleratio <- cos(mean(rng$yrng) * pi/180) } - + # Internal _bbox field no longer needed #p$x$data <- lapply(p$x$data, function(tr) { tr[["_bbox"]] <- NULL; tr }) p @@ -326,7 +326,7 @@ supply_defaults <- function(p) { if (is_subplot(p)) return(p) # supply trace anchor defaults anchors <- if (is_geo(p)) c("geo" = "geo") else if (is_mapbox(p)) c("subplot" = "mapbox") else c("xaxis" = "x", "yaxis" = "y") - + p$x$data <- lapply(p$x$data, function(tr) { for (i in seq_along(anchors)) { key <- names(anchors)[[i]] @@ -337,7 +337,7 @@ supply_defaults <- function(p) { }) # hack to avoid https://github.com/ropensci/plotly/issues/945 if (is_type(p, "parcoords")) p$x$layout$margin$t <- NULL - + # supply domain defaults geoDomain <- list(x = c(0, 1), y = c(0, 1)) if (is_geo(p) || is_mapbox(p)) { @@ -362,13 +362,13 @@ supply_defaults <- function(p) { supply_highlight_attrs <- function(p) { # set "global" options via crosstalk variable p$x$highlight <- p$x$highlight %||% highlight_defaults() - - # defaults are now populated, allowing us to populate some other + + # defaults are now populated, allowing us to populate some other # attributes such as the selectize widget definition sets <- unlist(lapply(p$x$data, "[[", "set")) keys <- setNames(lapply(p$x$data, "[[", "key"), sets) p$x$highlight$ctGroups <- i(unique(sets)) - + # TODO: throw warning if we don't detect valid keys? hasKeys <- FALSE for (i in p$x$highlight$ctGroups) { @@ -383,13 +383,13 @@ supply_highlight_attrs <- function(p) { items = data.frame(value = k, label = k), group = i ) } - + # set default values via crosstalk api vals <- p$x$highlight$defaultValues[p$x$highlight$defaultValues %in% k] if (length(vals)) { p <- htmlwidgets::onRender( p, sprintf( - "function(el, x) { crosstalk.group('%s').var('selection').set(%s) }", + "function(el, x) { crosstalk.group('%s').var('selection').set(%s) }", i, jsonlite::toJSON(as.character(vals), auto_unbox = FALSE) ) ) @@ -398,7 +398,7 @@ supply_highlight_attrs <- function(p) { # add HTML dependencies, set a sensible dragmode default, & throw messages if (hasKeys) { - p$x$layout$dragmode <- p$x$layout$dragmode %|D|% + p$x$layout$dragmode <- p$x$layout$dragmode %|D|% default(switch(p$x$highlight$on %||% "", plotly_selected = "select") %||% "zoom") if (is.default(p$x$highlight$off)) { message( @@ -409,7 +409,7 @@ supply_highlight_attrs <- function(p) { ) } } - + p } @@ -432,8 +432,8 @@ verify_attr_names <- function(p) { attrSpec <- Schema$traces[[thisTrace$type %||% "scatter"]]$attributes # make sure attribute names are valid attrs_name_check( - names(thisTrace), - c(names(attrSpec), "key", "set", "frame", "transforms", "_isNestedKey", "_isSimpleKey", "_isGraticule", "_bbox"), + names(thisTrace), + c(names(attrSpec), "key", "set", "frame", "transforms", "_isNestedKey", "_isSimpleKey", "_isGraticule", "_bbox"), thisTrace$type ) } @@ -457,7 +457,7 @@ verify_attr_spec <- function(p) { p$x$data[[tr]][["xaxis"]] <- p$x$data[[tr]][["xaxis"]] %||% NULL p$x$data[[tr]][["yaxis"]] <- p$x$data[[tr]][["yaxis"]] %||% NULL } - + p } @@ -466,29 +466,29 @@ verify_attr <- function(proposed, schema, layoutAttr = FALSE) { attrSchema <- schema[[attr]] %||% schema[[sub("[0-9]+$", "", attr)]] # if schema is missing (i.e., this is an un-official attr), move along if (is.null(attrSchema)) next - + valType <- tryNULL(attrSchema[["valType"]]) %||% "" role <- tryNULL(attrSchema[["role"]]) %||% "" arrayOK <- tryNULL(attrSchema[["arrayOk"]]) %||% FALSE isDataArray <- identical(valType, "data_array") - - # where applicable, reduce single valued vectors to a constant + + # where applicable, reduce single valued vectors to a constant # (while preserving attributes) if (!isDataArray && !arrayOK && !identical(role, "object")) { proposed[[attr]] <- retain(proposed[[attr]], uniq) } - - # If we deliberately only want hover on fills, send a string to - # plotly.js so it does something sensible + + # If we deliberately only want hover on fills, send a string to + # plotly.js so it does something sensible if (identical(proposed[["hoveron"]], "fills")) { proposed[["text"]] <- paste(uniq(proposed[["text"]]), collapse = "\n") } - + # ensure data_arrays of length 1 are boxed up by to_JSON() if (isDataArray) { proposed[[attr]] <- i(proposed[[attr]]) } - + # tag 'src-able' attributes (needed for api_create()) # note that layout has 'src-able' attributes that shouldn't # be turned into grids https://github.com/ropensci/plotly/pull/1489 @@ -496,12 +496,12 @@ verify_attr <- function(proposed, schema, layoutAttr = FALSE) { if ((isDataArray || isSrcAble) && !isTRUE(layoutAttr)) { proposed[[attr]] <- structure(proposed[[attr]], apiSrc = TRUE) } - + if (length(proposed[["name"]]) > 0) { proposed$name <- uniq(proposed$name) } - - # if marker.size was populated via `size` arg (i.e., internal map_size()), + + # if marker.size was populated via `size` arg (i.e., internal map_size()), # then it should _always_ be an array # of appropriate length... # (when marker.size is a constant, it always sets the diameter!) @@ -510,21 +510,21 @@ verify_attr <- function(proposed, schema, layoutAttr = FALSE) { if (is.default(proposed$marker$size)) { s <- proposed$marker[["size"]] if (length(s) == 1) { - # marker.size could be of length 1, but we may have multiple - # markers -- in that case, if marker.size is an array + # marker.size could be of length 1, but we may have multiple + # markers -- in that case, if marker.size is an array # of length 1 will result in just one marker # https://codepen.io/cpsievert/pen/aMmOza n <- length(proposed[["x"]] %||% proposed[["y"]] %||% proposed[["lat"]] %||% proposed[["lon"]]) proposed$marker[["size"]] <- default(i(rep(s, n))) } } - + # do the same for "sub-attributes" if (identical(role, "object") && is.recursive(proposed[[attr]])) { proposed[[attr]] <- verify_attr(proposed[[attr]], schema[[attr]], layoutAttr = layoutAttr) } } - + proposed } @@ -536,9 +536,9 @@ attrs_name_check <- function(proposedAttrs, validAttrs, type = "scatter") { } if (length(illegalAttrs)) { warning("'", type, "' objects don't have these attributes: '", - paste(illegalAttrs, collapse = "', '"), "'\n", + paste(illegalAttrs, collapse = "', '"), "'\n", "Valid attributes include:\n'", - paste(validAttrs, collapse = "', '"), "'\n", + paste(validAttrs, collapse = "', '"), "'\n", call. = FALSE) } invisible(proposedAttrs) @@ -558,21 +558,21 @@ verify_type <- function(trace) { if (xNumeric && yNumeric) { if (any(attrLengths) > 15000) "scattergl" else "scatter" } else if (xNumeric || yNumeric) { - "bar" + "bar" } else "histogram2d" } else if ("y" %in% attrs || "x" %in% attrs) { "histogram" } else if ("z" %in% attrs) { "heatmap" } else { - warning("No trace type specified and no positional attributes specified", + warning("No trace type specified and no positional attributes specified", call. = FALSE) "scatter" } relay_type(trace$type) } if (!is.character(trace$type) || length(trace$type) != 1) { - stop("The trace type must be a character vector of length 1.\n", + stop("The trace type must be a character vector of length 1.\n", call. = FALSE) } if (!trace$type %in% names(Schema$traces)) { @@ -594,21 +594,21 @@ verify_type <- function(trace) { relay_type <- function(type) { message( - "No trace type specified:\n", + "No trace type specified:\n", " Based on info supplied, a '", type, "' trace seems appropriate.\n", " Read more about this trace type -> https://plot.ly/r/reference/#", type ) type } -# Searches a list for character strings and translates R linebreaks to HTML -# linebreaks (i.e., '\n' -> '
'). JavaScript function definitions created +# Searches a list for character strings and translates R linebreaks to HTML +# linebreaks (i.e., '\n' -> '
'). JavaScript function definitions created # via `htmlwidgets::JS()` are ignored translate_linebreaks <- function(p) { recurse <- function(a) { typ <- typeof(a) if (typ == "list") { - # retain the class of list elements + # retain the class of list elements # which important for many things, such as colorbars a[] <- lapply(a, recurse) } else if (typ == "character" && !inherits(a, "JS_EVAL")) { @@ -672,12 +672,12 @@ verify_colorscale <- function(p) { trace$colorscale <- colorscale_json(trace$colorscale) trace$marker$colorscale <- colorscale_json(trace$marker$colorscale) trace - }) + }) p } # Coerce `x` into a data structure that can map to a colorscale attribute. -# Note that colorscales can either be the name of a scale (e.g., 'Rainbow') or +# Note that colorscales can either be the name of a scale (e.g., 'Rainbow') or # a 2D array (e.g., [[0, 'rgb(0,0,255)'], [1, 'rgb(255,0,0)']]) colorscale_json <- function(x) { if (!length(x)) return(x) @@ -730,7 +730,7 @@ populate_categorical_axes <- function(p) { # collect all the data that goes on this axis d <- lapply(p$x$data, "[[", axisType) isOnThisAxis <- function(tr) { - is.null(tr[["geo"]]) && sub("axis", "", axisName) %in% + is.null(tr[["geo"]]) && sub("axis", "", axisName) %in% (tr[[sub("[0-9]+", "", axisName)]] %||% axisType) && # avoid reordering matrices (see #863) !is.matrix(tr[["z"]]) @@ -740,7 +740,7 @@ populate_categorical_axes <- function(p) { isDiscrete <- vapply(d, is.discrete, logical(1)) if (0 < sum(isDiscrete) & sum(isDiscrete) < length(d)) { warning( - "Can't display both discrete & non-discrete data on same axis", + "Can't display both discrete & non-discrete data on same axis", call. = FALSE ) next @@ -749,11 +749,11 @@ populate_categorical_axes <- function(p) { categories <- lapply(d, getLevels) categories <- unique(unlist(categories)) if (any(!vapply(d, is.factor, logical(1)))) categories <- sort(categories) - p$x$layout[[axisName]]$type <- + p$x$layout[[axisName]]$type <- p$x$layout[[axisName]]$type %||% "category" - p$x$layout[[axisName]]$categoryorder <- + p$x$layout[[axisName]]$categoryorder <- p$x$layout[[axisName]]$categoryorder %||% "array" - p$x$layout[[axisName]]$categoryarray <- + p$x$layout[[axisName]]$categoryarray <- p$x$layout[[axisName]]$categoryarray %||% categories } p @@ -797,8 +797,8 @@ verify_key_type <- function(p) { # does it *ever* make sense to have a missing key value? uk <- uniq(k) if (length(uk) == 1) { - # i.e., the key for this trace has one value. In this case, - # we don't have iterate through the entire key, so instead, + # i.e., the key for this trace has one value. In this case, + # we don't have iterate through the entire key, so instead, # we provide a flag to inform client side logic to match the _entire_ # trace if this one key value is a match p$x$data[[i]]$key <- uk[[1]] @@ -814,7 +814,7 @@ verify_key_type <- function(p) { p$x$data[[i]]$key <- I(as.character(p$x$data[[i]]$key)) } } - p + p } verify_webgl <- function(p) { @@ -844,44 +844,44 @@ verify_showlegend <- function(p) { ann <- p$x$layout$annotations is_title <- vapply(ann, function(x) isTRUE(x$legendTitle), logical(1)) p$x$layout$annotations <- ann[!is_title] - p$x$layout$showlegend <- FALSE + p$x$layout$showlegend <- FALSE } show <- vapply(p$x$data, function(x) x$showlegend %||% TRUE, logical(1)) - # respect only _user-specified_ defaults - isSinglePie <- identical("pie", unlist(lapply(p$x$data, function(tr) tr$type))) + # respect only _user-specified_ defaults + isSinglePie <- identical("pie", unlist(lapply(p$x$data, function(tr) tr$type))) p$x$layout$showlegend <- p$x$layout$showlegend %|D|% default(sum(show) > 1 || isTRUE(p$x$highlight$showInLegend) || isSinglePie) p } verify_guides <- function(p) { - + # since colorbars are implemented as "invisible" traces, prevent a "trivial" legend if (has_colorbar(p) && has_legend(p) && length(p$x$data) <= 2) { p$x$layout$showlegend <- default(FALSE) } - + isVisibleBar <- function(tr) { is.colorbar(tr) && (tr$showscale %||% TRUE) } isBar <- vapply(p$x$data, isVisibleBar, logical(1)) nGuides <- sum(isBar) + has_legend(p) - + if (nGuides > 1) { - + # place legend at bottom since its scrolly yanchor <- default("top") y <- default(1 - ((nGuides - 1) / nGuides)) p$x$layout$legend$yanchor <- p$x$layout$legend$yanchor %|D|% yanchor p$x$layout$legend$y <- p$x$layout$legend[["y"]] %|D|% y - + # shrink/position colorbars idx <- which(isBar) for (i in seq_along(idx)) { len <- default(1 / nGuides) lenmode <- default("fraction") y <- default(1 - ((i - 1) / nGuides)) - + j <- idx[[i]] tr <- p$x$data[[j]] if (inherits(tr, "zcolor")) { @@ -896,19 +896,19 @@ verify_guides <- function(p) { p$x$data[[j]]$marker$colorbar$yanchor <- tr$marker$colorbar$yanchor %|D|% yanchor } } - + } - + p } verify_mathjax <- function(p) { hasMathjax <- "mathjax" %in% sapply(p$dependencies, "[[", "name") if (hasMathjax) return(p) - + hasTeX <- any(rapply(p$x, is.TeX)) if (!hasTeX) return(p) - + # TODO: it would be much better to add the dependency here, but # htmlwidgets doesn't currently support adding dependencies at print-time! warning( @@ -922,7 +922,7 @@ verify_mathjax <- function(p) { verify_scattergl_platform <- function(p) { if (!identical(.Platform$OS.type, "windows")) return(p) if (!is_rstudio()) return(p) - + types <- vapply(p$x$data, function(x) x[["type"]] %||% "scatter", character(1)) if ("scattergl" %in% types) { warning( @@ -931,7 +931,7 @@ verify_scattergl_platform <- function(p) { call. = FALSE ) } - + p } @@ -963,7 +963,7 @@ has_legend <- function(p) { showLegend <- function(tr) { tr$showlegend %||% TRUE } - any(vapply(p$x$data, showLegend, logical(1))) && + any(vapply(p$x$data, showLegend, logical(1))) && isTRUE(p$x$layout$showlegend %|D|% TRUE) } @@ -1042,17 +1042,17 @@ rm_asis <- function(x) { # https://github.com/jeroenooms/jsonlite/issues/29 if (is.null(x)) return(NA) if (is.data.frame(x)) return(x) - if (is.list(x)) lapply(x, rm_asis) + if (is.list(x)) lapply(x, rm_asis) # strip any existing 'AsIs' list elements of their 'AsIs' status. - # this is necessary since ggplot_build(qplot(1:10, fill = I("red"))) - # returns list element with their 'AsIs' class, + # this is necessary since ggplot_build(qplot(1:10, fill = I("red"))) + # returns list element with their 'AsIs' class, # which conflicts with our JSON unboxing strategy. else if (inherits(x, "AsIs")) class(x) <- setdiff(class(x), "AsIs") else x } -# add a class to an object only if it is new, and keep any existing classes of +# add a class to an object only if it is new, and keep any existing classes of # that object append_class <- function(x, y) { structure(x, class = unique(c(class(x), y))) @@ -1131,7 +1131,7 @@ try_library <- function(pkg, fun = NULL) { if (system.file(package = pkg) != "") { return(invisible()) } - stop("Package `", pkg, "` required", if (!is.null(fun)) paste0(" for `", fun, "`"), ".\n", + stop("Package `", pkg, "` required", if (!is.null(fun)) paste0(" for `", fun, "`"), ".\n", "Please install and try again.", call. = FALSE) } diff --git a/inst/plotlyjs.R b/inst/plotlyjs.R index 8598201f2f..d64cf413b2 100644 --- a/inst/plotlyjs.R +++ b/inst/plotlyjs.R @@ -15,14 +15,14 @@ unzip(tmp) # update the default bundle file.copy( - Sys.glob("*plotly.js*/dist/plotly.min.js"), - "inst/htmlwidgets/lib/plotlyjs/plotly-latest.min.js", + Sys.glob("*plotly.js*/dist/plotly.min.js"), + "inst/htmlwidgets/lib/plotlyjs/plotly-latest.min.js", overwrite = TRUE ) # update the plotly.js LICENSE file.copy( - Sys.glob("*plotly.js*/LICENSE"), - "inst/htmlwidgets/lib/plotlyjs/LICENSE", + Sys.glob("*plotly.js*/LICENSE"), + "inst/htmlwidgets/lib/plotlyjs/LICENSE", overwrite = TRUE ) # update the locale files @@ -49,8 +49,8 @@ message("Manually update plotly.R with this version") -# download latest build from master +# download latest build from master #download.file( -# "https://raw.githubusercontent.com/plotly/plotly.js/master/dist/plotly.min.js", +# "https://raw.githubusercontent.com/plotly/plotly.js/master/dist/plotly.min.js", # destfile = "inst/htmlwidgets/lib/plotlyjs/plotly-latest.min.js" #) diff --git a/man/api.Rd b/man/api.Rd index 0f1aaf13d2..c05689caf2 100644 --- a/man/api.Rd +++ b/man/api.Rd @@ -100,7 +100,7 @@ For anything else, use \code{api()}. # and/or data frames to your plotly account # ------------------------------------------------------------ -# A data frame creates a plotly "grid". Printing one will take you +# A data frame creates a plotly "grid". Printing one will take you # to the it's web address so you can start creating! (m <- api_create(mtcars)) @@ -117,7 +117,7 @@ layout( ) ------------------------------------------------------------ -# The api() function provides a low-level interface for performing +# The api() function provides a low-level interface for performing # any action at any endpoint! It always returns a list. # ------------------------------------------------------------ @@ -143,7 +143,7 @@ api("files/cpsievert:14681") # change the filename https://api.plot.ly/v2/files#update # (note: this won't work unless you have proper credentials to the relevant account) -api("files/cpsievert:14681", "PATCH", list(filename = "toy file")) +api("files/cpsievert:14681", "PATCH", list(filename = "toy file")) # Copy a file https://api.plot.ly/v2/files#lookup api("files/cpsievert:14681/copy", "POST") From 1bf6a4a09bfa0bb39270d356862af0555a92f6f9 Mon Sep 17 00:00:00 2001 From: James Lamb Date: Tue, 19 May 2020 16:29:12 -0500 Subject: [PATCH 3/4] style fixes from code review --- DESCRIPTION | 2 +- R/api_exports.R | 19 +++++++++---------- R/orca.R | 12 ++++++------ R/plotly_IMAGE.R | 23 +++++++++++------------ R/signup.R | 12 ++++++------ inst/plotlyjs.R | 10 +++++----- 6 files changed, 38 insertions(+), 40 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5a489c942a..e9551518f0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,7 +26,7 @@ Depends: Imports: tools, scales, - httr, + httr (>= 1.3.0), jsonlite (>= 1.6), magrittr, digest, diff --git a/R/api_exports.R b/R/api_exports.R index 02ba433e81..7a585468e3 100644 --- a/R/api_exports.R +++ b/R/api_exports.R @@ -170,7 +170,6 @@ api_download_file <- function(id, username, endpoint = "files", ...) { #' @rdname api -#' @importFrom httr RETRY #' @export api <- function(endpoint = "/", verb = "GET", body = NULL, ...) { api_check_endpoint(endpoint) @@ -189,15 +188,15 @@ api <- function(endpoint = "/", verb = "GET", body = NULL, ...) { } 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 - , ... + 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") diff --git a/R/orca.R b/R/orca.R index 88b10259ce..1a394788e4 100644 --- a/R/orca.R +++ b/R/orca.R @@ -193,12 +193,12 @@ orca_serve <- function(port = 5151, mathjax = FALSE, safe = FALSE, request_limit scale = scale ) 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 + 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) diff --git a/R/plotly_IMAGE.R b/R/plotly_IMAGE.R index 08a22d15a4..188c703ce8 100644 --- a/R/plotly_IMAGE.R +++ b/R/plotly_IMAGE.R @@ -9,8 +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::RETRY` -#' @importFrom httr RETRY write_disk +#' @param ... arguments passed onto `httr::RETRY` #' @export #' @examples \dontrun{ #' p <- plot_ly(x = 1:10) @@ -36,16 +35,16 @@ plotly_IMAGE <- function(x, width = 1000, height = 500, format = "png", ) base_url <- file.path(get_domain("api"), "v2", "images") 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) - , ... + 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")) invisible(con) diff --git a/R/signup.R b/R/signup.R index 921ef046a7..cbf2f748d8 100644 --- a/R/signup.R +++ b/R/signup.R @@ -46,12 +46,12 @@ signup <- function(username, email, save = TRUE) { ) base_url <- file.path(get_domain(), "apimkacct") resp <- httr::RETRY( - verb = "POST" - , base_url - , body = bod - , times = 5 - , terminate_on = c(400, 401, 403, 404) - , terminate_on_success = TRUE + 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) { diff --git a/inst/plotlyjs.R b/inst/plotlyjs.R index d64cf413b2..b67833eb07 100644 --- a/inst/plotlyjs.R +++ b/inst/plotlyjs.R @@ -2,11 +2,11 @@ library(httr) # download latest GitHub release # for a particular version: `zip <- "https://github.com/plotly/plotly.js/archive/v1.33.1.zip"` x <- httr::RETRY( - verb = "GET" - , url = 'https://api.github.com/repos/plotly/plotly.js/releases/latest' - , times = 5 - , terminate_on = c(400, 401, 403, 404) - , terminate_on_success = TRUE + verb = "GET", + url = 'https://api.github.com/repos/plotly/plotly.js/releases/latest', + times = 5, + terminate_on = c(400, 401, 403, 404), + terminate_on_success = TRUE ) zip <- content(x)$zipball_url tmp <- tempfile(fileext = ".zip") From 0f1f1819dc18eac493cc85d784e49afc524f377a Mon Sep 17 00:00:00 2001 From: James Lamb Date: Tue, 19 May 2020 16:56:27 -0500 Subject: [PATCH 4/4] fix missing comma and add NEWS.md item --- NEWS.md | 2 ++ R/api_exports.R | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 3d64491146..762df24359 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,8 @@ ## 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). diff --git a/R/api_exports.R b/R/api_exports.R index 7a585468e3..02ae27638e 100644 --- a/R/api_exports.R +++ b/R/api_exports.R @@ -195,7 +195,7 @@ api <- function(endpoint = "/", verb = "GET", body = NULL, ...) { body = body, times = 5, terminate_on = c(400, 401, 403, 404), - terminate_on_success = TRUE + terminate_on_success = TRUE, ... )