Merge branch 'master' into sf-grob

Author: cpsievert

NEWS.md

@@ -2,14 +2,16 @@
 
 ## NEW FEATURES & IMPROVEMENTS
 
+* Upgraded to plotly.js v1.33.1. A _huge_ amount of features and improvements have been made since v1.29.2 (i.e., the version included in the last CRAN release of the R package - v4.7.1). Highlights include a complete re-write of `scattergl` to make it nearly feature complete with `scatter`, localization of text rendering (i.e., international translations), and two new trace types (`violin` & `table`). Read more about the v1.32.0 release [here](https://codeburst.io/notes-from-the-latest-plotly-js-release-b035a5b43e21) and the complete list of changes [here](https://github.com/plotly/plotly.js/releases).
+* The selection mode can now switch from 'transient' to 'persistent' by holding the 'shift' key. It's still possible to _force_ persistent selection by setting `persistent = TRUE` in `highlight()`, but `persistent = FALSE` (the default) is now recommended since it allows one to switch between [persistent/transient selection](https://plotly-book.cpsievert.me/linking-views-without-shiny.html#transient-versus-persistent-selection) in the browser, rather than at the command line.
+
 ## CHANGES
 
 * The `elementId` field is no longer populated, which fixes the "Ignoring explicitly provided widget ID" warning in shiny applications (see #985).
-* Upgraded to plotly.js v1.31.2 -- https://github.com/plotly/plotly.js/releases/tag/v1.31.2
 
 ## BUG FIXES
 
-Fixed algorithm for coercing the proposed layout to the plot schema (see #1156).
+* Fixed algorithm for coercing the proposed layout to the plot schema (see #1156).
 
 # 4.7.1
 

R/ggplotly.R

@@ -46,18 +46,20 @@
 #' # linked scatterplot brushing
 #' library(crosstalk)
 #' d <- SharedData$new(mtcars)
-#' subplot(
-#'  qplot(data = d, x = mpg, y = wt),
-#'  qplot(data = d, x = mpg, y = vs)
-#' )
+#' qplot(data = d, x = mpg, y = wt) %>%
+#'   subplot(qplot(data = d, x = mpg, y = vs)) %>% 
+#'   layout(title = "Click and drag to select points") %>%
+#'   highlight("plotly_selected")
+#' 
 #' 
 #' # more brushing (i.e. highlighting) examples
 #' demo("crosstalk-highlight-ggplotly", package = "plotly")
 #' 
 #' # client-side linked brushing in a scatterplot matrix
 #' SharedData$new(iris) %>%
 #'   GGally::ggpairs(aes(colour = Species), columns = 1:4) %>%
-#'   ggplotly(tooltip = c("x", "y", "colour"))
+#'   ggplotly(tooltip = c("x", "y", "colour")) %>%
+#'   highlight("plotly_selected")
 #' }
 #'
 ggplotly <- function(p = ggplot2::last_plot(), width = NULL, height = NULL,
@@ -592,7 +594,7 @@ gg2list <- function(p, width = NULL, height = NULL,
       axisText <- theme_el("axis.text")
       axisTitle <- theme_el("axis.title")
       axisLine <- theme_el("axis.line")
-      panelGrid <- theme_el("panel.grid.major")
+      panelGrid <- theme_el("panel.grid.major") %||% theme_el("panel.grid") 
       stripText <- theme_el("strip.text")
 
       axisName <- lay[, paste0(xy, "axis")]
@@ -623,9 +625,9 @@ gg2list <- function(p, width = NULL, height = NULL,
           d$x <- scales::rescale(d$x, rng$x_range, from = c(0, 1))
           d$y <- scales::rescale(d$y, rng$y_range, from = c(0, 1))
           params <- list(
-            colour = theme$panel.grid.major$colour,
-            size = theme$panel.grid.major$size,
-            linetype = theme$panel.grid.major$linetype
+            colour = panelGrid$colour, 
+            size = panelGrid$size, 
+            linetype = panelGrid$linetype
           )
           grill <- geom2trace.GeomPath(d, params)
           grill$hoverinfo <- "none"
@@ -711,20 +713,28 @@ gg2list <- function(p, width = NULL, height = NULL,
       )
 
       # set scaleanchor/scaleratio if these are fixed coordinates
+      # the logic here is similar to what p$coordinates$aspect() does,
+      # but the ratio is scaled to the data range by plotly.js 
       fixed_coords <- c("CoordSf", "CoordFixed", "CoordMap", "CoordQuickmap")
       if (inherits(p$coordinates, fixed_coords)) {
         axisObj$scaleanchor <- anchor
         ratio <- p$coordinates$ratio %||% 1
-        # a la CoordSf$aspect
+        axisObj$scaleratio <- if (xy == "y") ratio else 1 / ratio
+        
         if (inherits(p$coordinates, "CoordSf")) {
           if (isTRUE(sf::st_is_longlat(rng$crs))) {
             ratio <- cos(mean(rng$y_range) * pi/180)
           }
+          # note how ratio is flipped in CoordSf$aspect() vs CoordFixed$aspect()
+          axisObj$scaleratio <- if (xy == "y") 1 / ratio else ratio
         }
-        axisObj$scaleratio <- if (xy == "y") ratio else 1 / ratio
       }
 
-      # TODO: should we implement aspect ratios?
+      # TODO: seems like we _could_ support this with scaleanchors, 
+      # but inverse transform by the panel ranges?
+      # also, note how aspect.ratio overwrites fixed coordinates:
+      # ggplot(mtcars, aes(wt, mpg)) + geom_point() + coord_fixed(0.5)
+      # ggplot(mtcars, aes(wt, mpg)) + geom_point() + coord_fixed(0.5) + theme(aspect.ratio = 1)
       if (!is.null(theme$aspect.ratio)) {
         warning(
           "Aspect ratios aren't yet implemented, but you can manually set", 

R/highlight.R

@@ -28,7 +28,10 @@
 #'  (i.e., clicking the home button in the modebar) or whenever the height/width
 #'  of the plot changes.
 #' }
-#' @param persistent should selections persist (i.e., accumulate)?
+#' @param persistent should selections persist (i.e., accumulate)? We often
+#' refer to the default (`FALSE`) as a 'transient' selection mode; 
+#' which is recommended, because one may switch from 'transient' to 
+#' 'persistent' selection by holding the shift key.
 #' @param dynamic should a widget for changing selection colors be included? 
 #' @param color character string of color(s) to use for 
 #' highlighting selections. See [toRGB()] for valid color
@@ -41,6 +44,7 @@
 #' @param opacityDim a number between 0 and 1 used to reduce the
 #' opacity of non-selected traces (by multiplying with the existing opacity).
 #' @param selected attributes of the selection, see [attrs_selected()].
+#' @param unselected attributes of the non-selected marks, see [attrs_unselected()].
 #' @param ... currently not supported.
 #' @export
 #' @author Carson Sievert
@@ -56,13 +60,11 @@
 #' d <- SharedData$new(txhousing, ~city)
 #' p <- ggplot(d, aes(date, median, group = city)) + geom_line()
 #' gg <- ggplotly(p, tooltip = "city") 
-#' highlight(gg, persistent = TRUE, dynamic = TRUE)
+#' highlight(gg, dynamic = TRUE)
 #' 
 #' # supply custom colors to the brush 
 #' cols <- toRGB(RColorBrewer::brewer.pal(3, "Dark2"), 0.5)
-#' highlight(
-#'   gg, on = "plotly_hover", color = cols, persistent = TRUE, dynamic = TRUE
-#' )
+#' highlight(gg, on = "plotly_hover", color = cols, dynamic = TRUE)
 #' 
 #' # Use attrs_selected() for complete control over the selection appearance
 #' # note any relevant colors you specify here should override the color argument
@@ -72,10 +74,7 @@
 #'   marker = list(symbol = "x")
 #' )
 #' 
-#' highlight(
-#'  layout(gg, showlegend = TRUE),  
-#'  selected = s, persistent = TRUE
-#' )
+#' highlight(layout(gg, showlegend = TRUE), selected = s)
 #' 
 
 highlight <- function(p, on = "plotly_click", off, 
@@ -102,12 +101,12 @@ highlight <- function(p, on = "plotly_click", off,
     stop("opacityDim must be between 0 and 1", call. = FALSE)
   }
   if (dynamic && length(color) < 2) {
-    message("Adding more colors to the selection color palette")
+    message("Adding more colors to the selection color palette.")
     color <- c(color, RColorBrewer::brewer.pal(4, "Set1"))
   }
   if (!dynamic && length(color) > 1) {
     warning(
-      "Can only use a single color for selections when dynamic=FALSE",
+      "Can only use a single color for selections when `dynamic = FALSE`.",
       call. = FALSE
     )
     color <- color[1] 
@@ -137,6 +136,14 @@ highlight <- function(p, on = "plotly_click", off,
     off <- default(off_default %||% "plotly_relayout")
   }
 
+  if (isTRUE(persistent)) {
+    message(
+      "We recommend setting `persistent` to `FALSE` (the default) because ",
+      "persistent selection mode can now be used by holding the shift key ",
+      "(while triggering the `on` event)."
+    )
+  }
+  
   # main (non-plotly.js) spec passed along to HTMLwidgets.renderValue()
   p$x$highlight <- list(
     # NULL may be used to disable on/off events

R/plotly.R

@@ -373,7 +373,7 @@ typedArrayPolyfill <- function() {
 # and bundle size at print time.
 plotlyMainBundle <- function() {
   htmltools::htmlDependency(
-    "plotlyjs", "1.31.2.9000",
+    "plotlyjs", "1.33.1",
     src = depPath("plotlyjs"),
     script = "plotly-latest.min.js",
     stylesheet = "plotly-htmlwidgets.css"

R/sysdata.rda

@@ -267,12 +267,6 @@ supply_defaults <- function(p) {
 supply_highlight_attrs <- function(p) {
   # set "global" options via crosstalk variable
   p$x$highlight <- p$x$highlight %||% highlight_defaults()
-  p <- htmlwidgets::onRender(
-    p, sprintf(
-      "function(el, x) { var ctConfig = crosstalk.var('plotlyCrosstalkOpts').set(%s); }", 
-      to_JSON(p$x$highlight)
-    )
-  )
 
   # defaults are now populated, allowing us to populate some other 
   # attributes such as the selectize widget definition

R/utils.R

@@ -3,15 +3,24 @@ library(crosstalk)
 library(plotly)
 
 d <- SharedData$new(mpg)
-dots <- plot_ly(d, color = ~class, x = ~displ, y = ~cyl)
-boxs <- plot_ly(d, color = ~class, x = ~class, y = ~cty) %>% add_boxplot()
-bars <- plot_ly(d, x = ~class, color = ~class)
+dots <- plot_ly(d, colors = "Set1", color = ~class, x = ~displ, y = ~cyl) %>%
+  layout(
+    xaxis = list(title = "Engine displacement"),
+    yaxis = list(title = "Number of cylinders")
+  )
+boxs <- plot_ly(d, colors = "Set1", color = ~class, x = ~class, y = ~cty) %>% 
+  add_boxplot() %>%
+  layout(
+    xaxis = list(title = ""),
+    yaxis = list(title = "Miles per gallon (city)")
+  )
+bars <- plot_ly(d, colors = "Set1", x = ~class, color = ~class)
 
 subplot(dots, boxs, titleX = TRUE, titleY = TRUE) %>%
   subplot(bars, nrows = 2, titleX = TRUE, titleY = TRUE) %>%
   layout(
-    title = "Click and drag on scatterplot",
+    title = "Dynamic 2-way ANOVA (click & drag on scatterplot)",
     barmode = "overlay",
     showlegend = FALSE
   ) %>%
-  highlight("plotly_selected")
+  highlight("plotly_selected", opacityDim = 0.6)

demo/crosstalk-highlight-binned-target-a.R

@@ -10,7 +10,4 @@ p2 <- plot_ly(tx, x = ~median, color = I("black")) %>%
 
 subplot(gg1, p2, titleX = TRUE, titleY = TRUE) %>% 
   layout(barmode = "overlay") %>%
-  highlight(
-    dynamic = TRUE, persistent = TRUE, 
-    selected = attrs_selected(opacity = 0.3)
-  )
+  highlight(dynamic = TRUE, selected = attrs_selected(opacity = 0.3))

demo/crosstalk-highlight-binned-target-c.R

@@ -0,0 +1,43 @@
+library(engsoccerdata)
+library(dplyr)
+library(tidyr)
+library(plotly)
+library(crosstalk)
+
+# shape data into desired format
+dat <- england %>% 
+  gather(location, team, home, visitor) %>% 
+  # focus on tier 1 teams that are still playing in 2015
+  filter(team %in% maketable_eng(england, 2015, 1)[["team"]]) %>%
+  mutate(
+    pts = ifelse(location == "home" & goaldif > 0, 3, 
+                 ifelse(location == "away" & goaldif < 0, 3, 1))
+  ) %>%
+  arrange(Date) %>%
+  group_by(Season, team) %>% 
+  mutate(gameno = row_number(), cumpts = cumsum(pts)) %>%
+  ungroup() %>%
+  group_by(gameno) %>%
+  mutate(meanP = mean(cumpts)) %>%
+  filter(Season > 2006)
+
+sd <- SharedData$new(dat, ~team, "Select a team")
+
+# a 'wormchart' like fig 8 here http://www.gradaanwr.net/wp-content/uploads/2016/06/dataApr16.pdf
+p <- ggplot(sd, aes(x = gameno, y = cumpts - meanP)) + 
+  geom_line(aes(group = team), alpha = 0.5) + 
+  facet_wrap(~ Season, ncol = 3) + 
+  labs(
+    title = "English Premier League Performance",
+    x = "Game in season",
+    y = "Cumulative points (above/below) average"
+  ) 
+
+gg <- ggplotly(p, width = 1050, height = 600, tooltip = "team")
+
+highlight(
+  gg, 
+  dynamic = TRUE, 
+  selectize = TRUE,
+  color = RColorBrewer::brewer.pal(12, "Paired")
+)

demo/crosstalk-highlight-epl-2.R

@@ -6,7 +6,7 @@ d <- SharedData$new(txhousing, ~city, "Select a city")
 p <- ggplot(d, aes(date, median, group = city)) + geom_line()
 ggplotly(p, tooltip = "city") %>%
   layout(title = "Click on a line to highlight a year") %>%
-  highlight(dynamic = TRUE, selectize = TRUE, persistent = TRUE)
+  highlight(dynamic = TRUE, selectize = TRUE)
 
 # crosstalk keys are automatically added to the group aesthetic...
 # if you want to avoid adding the key to group for a layer,