merge conflicts

Author: cpsievert

DESCRIPTION

@@ -12,7 +12,7 @@ Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"),
     person("Karthik", "Ram", role = "aut",
     email = "karthik.ram@gmail.com"),
     person("Marianne", "Corvellec", role = "aut",
-    email = "marianne@plot.ly"),
+    email = "marianne.corvellec@igdore.org", comment = c(ORCID = "0000-0002-1994-3581")),
     person("Pedro", "Despouy", role = "aut",
     email = "pedro@plot.ly"),
     person("Plotly Technologies Inc.", role = "cph"))
@@ -32,7 +32,7 @@ Imports:
     digest,
     viridisLite,
     base64enc,
-    htmltools,
+    htmltools (>= 0.3.6),
     htmlwidgets (>= 1.3),
     tidyr,
     hexbin,
@@ -71,6 +71,6 @@ Suggests:
     plotlyGeoAssets,
     forcats
 LazyData: true
-RoxygenNote: 6.1.0
+RoxygenNote: 6.1.1
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)

NEWS.md

@@ -10,14 +10,22 @@
 * Upgraded to plotly.js v1.42.5.
 * The `orca()` function now supports conversion of much larger figures (#1322) and works without a mapbox api token (#1314).
 * The `style()` function now supports "partial updates" (i.e. modification of a particular property of an object, rather than the entire object). For example, notice how the first plot retains the original marker shape (a square): `p <- plot_ly(x = 1:10, y = 1:10, symbol = I(15)); subplot(style(p, marker.color = "red"), style(p, marker = list(color = "red")))` (#1342).
+* **plotly** objects can now be serialized and unserialized in different environments (i.e., you can now use `saveRDS()` to save an object as an rds file and restore it on another machine with `readRDS()`). Note this object is *dynamically* linked to JavaScript libraries, so one should take care to use consistent versions of **plotly** when serializing and unserializing (#1376).
+* The `plotly_example()` will now attempt to open the source file(s) used to run the example. Set `edit = FALSE` to prevent the source file(s) from opening.
 
 ## BUG FIXES
 
 * `subplot()` now bumps annotation `xref`/`yref` anchors correctly (#1181).
 * `subplot()` now accumulates images, repositions paper coordinates, and reanchors axis references (#1332).
+* `event_data("plotly_selected")` is no longer too eager to clear. That is, it is no longer set to `NULL` when clicking on a plot *after* triggering the "plotly_selected" event (#1121) (#1122).
+* The colorscale generated via the `color` argument in `plot_ly()` now uses an evenly spaced grid of values instead of quantiles (#1308).
+* When using **shinytest** to test a **shiny** that contains **plotly** graph, false positive differences are no longer reported (rstudio/shinytest#174). 
+* The `color` and `stroke` arguments now work as expected for trace types with `fillcolor` but no `fill` attribute (e.g. `box` traces) (#1292).
 * Information emitted by in `event_data()` for heatmaps with atomic vectors for `x`/`y`/`z` is now correct (#1141).
 * Fixed issue where **dplyr** groups caused a problem in the ordering of data arrays passed to `marker` objects (#1351).
-* In some cases, a `ggplotly()` colorbar would cause issues with hover behavior, which is now fixed (#1381).  
+* In some cases, a `ggplotly()` colorbar would cause issues with hover behavior, which is now fixed (#1381).
+* An articial marker no longer appears when clearing a crosstalk selection of a plot with a colorbar (#1406).
+* Clearing a highlight event via crosstalk no longer deletes all the traces added since initial draw (#1436).
 * Recursive attribute validation is now only performed on recursive objects (#1315).
 
 # 4.8.0

R/highlight.R

@@ -206,20 +206,26 @@ highlight_defaults <- function() {
 
 selectizeLib <- function(bootstrap = TRUE) {
   htmltools::htmlDependency(
-    "selectize", "0.12.0", depPath("selectize"),
+    name = "selectize", 
+    version = "0.12.0", 
+    package = "plotly",
+    src = dependency_dir("selectize"),
     stylesheet = if (bootstrap) "selectize.bootstrap3.css",
     script = "selectize.min.js"
   )
 }
 
 colourPickerLib <- function() {
   htmltools::htmlDependency(
-    "colourpicker", "1.1", depPath("colourpicker"),
+    name = "colourpicker", 
+    version = "1.1", 
+    package = "plotly",
+    src = dependency_dir("colourpicker"),
     stylesheet = "colourpicker.min.css",
     script = "colourpicker.min.js"
   )
 }
 
-depPath <- function(...) {
-  system.file('htmlwidgets', 'lib', ..., package = 'plotly')
+dependency_dir <- function(...) {
+  file.path('htmlwidgets', 'lib', ...)
 }

R/mathjax.R

@@ -29,7 +29,8 @@ mathjax_cdn <- function() {
   htmltools::htmlDependency(
     name = "mathjax",
     version = "2.7.4",
-    src = c(file = depPath("mathjax")),
+    package = "plotly",
+    src = dependency_dir("mathjax"),
     script = "cdn.js"
   )
 }

R/orca.R

@@ -73,7 +73,11 @@ orca <- function(p, file = "plot.png", format = tools::file_ext(file),
 
   # find the relevant plotly.js bundle
   plotlyjs <- plotlyjsBundle(b)
-  plotlyjs_file <- file.path(plotlyjs$src$file, plotlyjs$script)
+  plotlyjs_path <- file.path(plotlyjs$src$file, plotlyjs$script)
+  # package field means src file path should be relative to pkg dir
+  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)
@@ -82,7 +86,7 @@ orca <- function(p, file = "plot.png", format = tools::file_ext(file),
     "graph", tmp, 
     "-o", file,
     "--format", format,
-    "--plotlyjs", plotlyjs_file,
+    "--plotlyjs", plotlyjs_path,
     if (debug) "--debug",
     if (verbose) "--verbose",
     if (safe) "--safe-mode",
@@ -143,12 +147,16 @@ orca_serve <- function(port = 5151, mathjax = FALSE, safe = FALSE, request_limit
 
   # use main bundle since any plot can be thrown at the server
   plotlyjs <- plotlyMainBundle()
-  plotlyjs_file <- file.path(plotlyjs$src$file, plotlyjs$script)
+  plotlyjs_path <- file.path(plotlyjs$src$file, plotlyjs$script)
+  # package field means src file path should be relative to pkg dir
+  if (!is.null(plotlyjs$package)) {
+    plotlyjs_path <- system.file(plotlyjs_path, package = plotlyjs$package)
+  }
 
   args <- c(
     "serve",
     "-p", port,
-    "--plotly", plotlyjs_file,
+    "--plotly", plotlyjs_path,
     if (safe) "--safe-mode",
     if (orca_version() >= "1.1.1") "--graph-only",
     if (keep_alive) "--keep-alive",
@@ -196,9 +204,14 @@ orca_serve <- function(port = 5151, mathjax = FALSE, safe = FALSE, request_limit
   )
 }
 
+correct_orca <- function() {
+  orca_help <- processx::run("orca", "-h")
+  grepl("plotly", orca_help[["stdout"]], ignore.case = TRUE)
+}
+
 
 orca_available <- function() {
-  if (Sys.which("orca") == "") {
+  if (Sys.which("orca") == "" || !correct_orca()) {
     stop(
       "The orca command-line utility is required for this functionality.\n\n",
       "Please follow the installation instructions here -- https://github.com/plotly/orca#installation",

R/partial_bundles.R

@@ -139,6 +139,8 @@ verify_partial_bundle <- function(p) {
     if (!file.exists(tmpfile)) {
       curl::curl_download(paste0("https://cdn.plot.ly/", bundle_script), tmpfile)
     }
+    # file src is no longer in plotly's path (it's a temp file)
+    p$dependencies[[idx]]$package <- NULL
   }
 
   p

R/plotly.R

@@ -387,14 +387,12 @@ plot_dendro <- function(d, set = "A", xmin = -50, height = 500, width = 500, ...
 }
 
 get_xy <- function(node) {
-  setNames(
-    tibble::as_tibble(dendextend::get_nodes_xy(node)), 
-    c("x", "y")
-  )
+  m <- dendextend::get_nodes_xy(node)
+  colnames(m) <- c("x", "y")
+  tibble::as_tibble(m)
 }
 
 
-
 #' Convert a list to a plotly htmlwidget object
 #' 
 #' @param x a plotly object.
@@ -434,8 +432,10 @@ as_widget <- function(x, ...) {
 
 typedArrayPolyfill <- function() {
   htmltools::htmlDependency(
-    "typedarray", "0.1",
-    src = depPath("typedarray"),
+    name = "typedarray", 
+    version = "0.1",
+    package = "plotly",
+    src = dependency_dir("typedarray"),
     script = "typedarray.min.js",
     all_files = FALSE
   )
@@ -445,19 +445,21 @@ typedArrayPolyfill <- function() {
 # and bundle size at print time.
 plotlyMainBundle <- function() {
   htmltools::htmlDependency(
-    "plotly-main", 
+    name = "plotly-main", 
     version = "1.42.5",
-    src = depPath("plotlyjs"),
+    package = "plotly",
+    src = dependency_dir("plotlyjs"),
     script = "plotly-latest.min.js",
     all_files = FALSE
   )
 }
 
 plotlyHtmlwidgetsCSS <- function() {
   htmltools::htmlDependency(
-    "plotly-htmlwidgets-css", 
+    name = "plotly-htmlwidgets-css", 
     version = plotlyMainBundle()$version,
-    src = depPath("plotlyjs"),
+    package = "plotly",
+    src = dependency_dir("plotlyjs"),
     stylesheet = "plotly-htmlwidgets.css",
     all_files = FALSE
   )
@@ -468,8 +470,8 @@ locale_dependency <- function(locale) {
     stop("locale must be a character string (vector of length 1)", call. = FALSE)
   }
 
-  locale_dir <- depPath("plotlyjs", "locales")
-  locales_all <- sub("\\.js$", "", list.files(locale_dir))
+  locale_dir <- dependency_dir("plotlyjs", "locales")
+  locales_all <- sub("\\.js$", "", list.files(system.file(locale_dir, package = "plotly")))
   if (!tolower(locale) %in% locales_all) {
     stop(
       "Invalid locale: '", locale, "'.\n\n",
@@ -491,6 +493,7 @@ locale_dependency <- function(locale) {
   htmltools::htmlDependency(
     name = paste0("plotly-locale-", locale),
     version = plotlyMainBundle()$version,
+    package = "plotly",
     src = list(file = locale_dir),
     script = tolower(scripts),
     all_files = FALSE

R/plotly_build.R

@@ -348,6 +348,12 @@ plotly_build.plotly <- function(p, registerFrames = TRUE) {
   p <- verify_hovermode(p)
   # try to convert to webgl if toWebGl was used
   p <- verify_webgl(p)
+  # throw warning if webgl is being used in shinytest
+  # currently, shinytest won't rely this warning, but it should
+  # https://github.com/rstudio/shinytest/issues/146
+  if (isTRUE(getOption("shiny.testmode"))) {
+    if (is.webgl(p)) warning("shinytest can't currently render WebGL-based graphics.")
+  }
   # crosstalk dynamically adds traces, meaning that a legend could be dynamically
   # added, which is confusing. So here we populate a sensible default.
   p <- verify_showlegend(p)
@@ -771,7 +777,7 @@ map_color <- function(traces, stroke = FALSE, title = "", colorway, na.color = "
     colScale <- scales::col_numeric(pal, rng, na.color = na.color)
     # generate the colorscale to be shared across traces
     vals <- if (diff(rng) > 0) {
-      as.numeric(stats::quantile(allColor, probs = seq(0, 1, length.out = 25), na.rm = TRUE))
+      seq(rng[1], rng[2], length.out = 25)
     } else {
       c(0, 1)
     }
@@ -1001,4 +1007,13 @@ supplyUserPalette <- function(default, user) {
 
 # helper functions
 array_ok <- function(attr) isTRUE(tryNULL(attr$arrayOk))
-has_fill <- function(trace) isTRUE(trace$fill %in% c('tozeroy', 'tozerox', 'tonexty', 'tonextx', 'toself', 'tonext'))
+has_fill <- function(trace) {
+  trace_type <- trace[["type"]] %||% "scatter"
+  # if trace type has fillcolor, but no fill attribute, then fill is always relevant
+  has_fillcolor <- has_attr(trace_type, "fillcolor")
+  has_fill <- has_attr(trace_type, "fill")
+  if (has_fillcolor && !has_fill) return(TRUE)
+  fill <- trace[["fill"]] %||% "none"
+  if (has_fillcolor && isTRUE(fill != "none")) return(TRUE)
+  FALSE
+}

R/plotly_example.R

@@ -5,20 +5,21 @@
 #' 
 #' @param type the type of example
 #' @param name the name of the example (valid names depend on `type`).
+#' @param edit whether to open the relevant source files using [file.edit]. Only relevant if `type` is `"shiny"` or `"rmd"`.
 #' @param ... arguments passed onto the suitable method.
 #' @export
 #' @author Carson Sievert
 
-plotly_example <- function(type = c("demo", "shiny", "rmd"), name, ...) {
+plotly_example <- function(type = c("demo", "shiny", "rmd"), name, edit = TRUE, ...) {
 
   type <- match.arg(type)
 
   # demos don't necessarily need a name
   if (type == "demo") {
     if (missing(name)) {
-      return(utils::demo(package = "plotly")) 
+      return(utils::demo(package = "plotly", ...)) 
     } else  {
-      return(utils::demo(topic = name, package = "plotly"))
+      return(utils::demo(topic = name, package = "plotly", ...))
     }
   }
 
@@ -36,10 +37,15 @@ plotly_example <- function(type = c("demo", "shiny", "rmd"), name, ...) {
   }
 
   finalDir <- system.file("examples", type, name, package = "plotly")
+  if (edit) {
+    files <- list.files(finalDir, full.names = TRUE)
+    scripts <- files[tools::file_ext(files) %in% c("R", "Rmd")]
+    file.edit(scripts)
+  }
 
   if (type == "shiny") {
     try_library("shiny", "plotly_example")
-    getFromNamespace("runApp", asNamespace("shiny"))(finalDir, display.mode = "showcase", ...)
+    getFromNamespace("runApp", asNamespace("shiny"))(finalDir, ...)
   }
 
   if (type == "rmd") {

R/proxy.R

@@ -100,7 +100,8 @@ plotlyProxyInvoke <- function(p, method, ...) {
 plotlyjs_methods <- function() {
   c(
     "restyle", "relayout", "update", "addTraces", "deleteTraces", "moveTraces",
-    "extendTraces", "prependTraces", "purge", "toImage", "downloadImage", "animate"
+    "extendTraces", "prependTraces", "purge", "toImage", "downloadImage", "animate",
+    "newPlot", "react", "validate", "makeTemplate", "validateTemplate", "addFrames"
   )
 }
 

R/shiny.R

@@ -39,7 +39,18 @@ renderPlotly <- function(expr, env = parent.frame(), quoted = FALSE) {
   # this makes it possible to pass a ggplot2 object to renderPlotly()
   # https://github.com/ramnathv/htmlwidgets/issues/166#issuecomment-153000306
   expr <- as.call(list(call(":::", quote("plotly"), quote("prepareWidget")), expr))
-  shinyRenderWidget(expr, plotlyOutput, env, quoted = TRUE)
+  renderFunc <- shinyRenderWidget(expr, plotlyOutput, env, quoted = TRUE)
+  # remove 'internal' plotly attributes that are known to cause false
+  # positive test results in shinytest (snapshotPreprocessOutput was added 
+  # in shiny 1.0.3.9002, but we require >= 1.1)
+  shiny::snapshotPreprocessOutput(
+    renderFunc,
+    function(value) {
+      json <- from_JSON_safe(value)
+      json$x <- json$x[setdiff(names(json$x), c("visdat", "cur_data", "attrs"))]
+      to_JSON(json)
+    }
+  )
 }
 
 # Converts a plot, OR a promise of a plot, to plotly

R/utils.R

@@ -962,6 +962,13 @@ from_JSON <- function(x, ...) {
   jsonlite::fromJSON(x, simplifyDataFrame = FALSE, simplifyMatrix = FALSE, ...)
 }
 
+from_JSON_safe <- function(txt, ...) {
+  if (!jsonlite::validate(txt)) {
+    stop("Expected a valid JSON string.")
+  }
+  from_JSON(txt, ...)
+}
+
 i <- function(x) {
   if (is.null(x)) {
     return(NULL)

inst/docker/Dockerfile.vtest

@@ -56,6 +56,7 @@ RUN R -e "update.packages(ask = F)"
 RUN R -e "install.packages('devtools')" 
 RUN R -e "install.packages('roxygen2')"
 RUN R -e "install.packages('testthat')"
+RUN R -e "install.packages('vdiffr')"
 
 # sf system dependencies
 RUN add-apt-repository ppa:ubuntugis/ubuntugis-unstable --yes
@@ -86,17 +87,12 @@ RUN printf '#!/bin/bash \nxvfb-run --auto-servernum --server-args "-screen 0 640
 RUN chmod 777 /usr/bin/orca
 
 # install visual testing packages
-RUN R -e "devtools::install_github('lionel-/vdiffr')"
 RUN R -e "devtools::install_github('brodieG/diffobj@development')"
 
 # switch on visual testing
 ENV VDIFFR=true
 EXPOSE 3838
 
-# installing rgeos from CRAN is currently broken
-# http://r-sig-geo.2731867.n2.nabble.com/Re-Unexpected-configure-error-following-recent-rgeos-release-td7592423.html
-RUN R -e "install.packages('rgeos', repos='http://R-Forge.R-project.org', type='source')"
-
 RUN R -e "update.packages(ask=FALSE)"
 
 # install any new dependencies, then either manage cases (the default) or run tests

inst/examples/shiny/Diamonds/server.R

@@ -21,7 +21,7 @@ shinyServer(function(input, output, session) {
 		facets <- paste(input$facet_row, '~', input$facet_col)
 		if (facets != '. ~ .') p <- p + facet_grid(facets)
     # return the ggplot object and renderPlotly() will know how to handle it
-		p
+		toWebGL(p)
 	})
 
 })