Fixes for the development version of ggplot2 (> v3.5.2); migrate to shinytest2

.github/workflows/R-CMD-check.yaml

@@ -29,8 +29,7 @@ jobs:
           # vdiffr & shinytest only runs on mac r-release since the results aren't cross-platform
           - {os: macOS-latest,   r: 'release', visual_tests: true, node: "14.x", shinytest: true}
           - {os: windows-latest, r: 'release'}
-          - {os: windows-latest, r: '4.1'}
-          - {os: windows-latest, r: '3.6'}
+          # - {os: windows-latest, r: 'oldrel-1'} # pak is having issues
           - {os: ubuntu-latest,   r: 'devel'}
           - {os: ubuntu-latest,   r: 'release'}
           - {os: ubuntu-latest,   r: 'oldrel-1'}
@@ -62,26 +61,10 @@ jobs:
           cache-version: 3
           needs: check
 
-      - name: Set up Python 3.8
-        uses: actions/setup-python@v2
-        with:
-          python-version: 3.8
-
       - name: Install kaleido
         if: matrix.config.visual_tests == true
         run: |
-          sudo chown -R $UID $CONDA # https://github.com/nextstrain/conda/issues/5
-          Rscript -e "reticulate::install_miniconda()"
-          Rscript -e "reticulate::conda_install('r-reticulate', 'python-kaleido')"
-          Rscript -e "reticulate::conda_install('r-reticulate', 'plotly', channel = 'plotly')"
-          Rscript -e "reticulate::use_miniconda('r-reticulate')"
-
-      - name: Install shinytest deps
-        if: matrix.config.shinytest == true
-        run: |
-          Rscript -e 'shinytest::installDependencies()'
-          R CMD install .
-        shell: bash
+          Rscript -e 'library(reticulate); use_python(install_python()); py_install(c("kaleido", "plotly"))'
 
         # Run test() before R CMD check since, for some reason, rcmdcheck::rcmdcheck() skips vdiffr tests
       - name: Run Tests

DESCRIPTION

@@ -57,7 +57,7 @@ Suggests:
     testthat,
     knitr,
     shiny (>= 1.1.0),
-    shinytest (>= 1.3.0),
+    shinytest2,
     curl,
     rmarkdown,
     Cairo,

NEWS.md

@@ -4,6 +4,10 @@
 
 * `ggplotly()` now supports the `{ggridges}` package. (#2314)
 
+## Improvements
+
+* `ggplotly()` now works better with the development version of ggplot2 (> v3.4.4). (#2315)
+
 ## Bug fixes
 
 * Closed #2337: Creating a new `event_data()` handler no longer causes a spurious reactive update of existing `event_data()`s. (#2339)

R/ggplotly.R

@@ -463,12 +463,8 @@ gg2list <- function(p, width = NULL, height = NULL,
     assign(var, built_env[[var]], envir = envir)
   }
 
-  # initiate plotly.js layout with some plot-wide theming stuff
-  theme <- ggfun("plot_theme")(plot)
-  elements <- names(which(sapply(theme, inherits, "element")))
-  for (i in elements) {
-    theme[[i]] <- ggplot2::calc_element(i, theme)
-  }
+  theme <- calculated_theme_elements(plot)
+
   # Translate plot wide theme elements to plotly.js layout
   pm <- unitConvert(theme$plot.margin, "pixels")
   gglayout <- list(
@@ -1154,6 +1150,23 @@ gg2list <- function(p, width = NULL, height = NULL,
 # Due to the non-standard use of assign() in g2list() (above)
 utils::globalVariables(c("groupDomains", "layers", "prestats_data", "scales", "sets"))
 
+# Get the "complete" set of theme elements and their calculated values
+calculated_theme_elements <- function(plot) {
+  if (is.function(asNamespace("ggplot2")$complete_theme)) {
+    theme <- ggplot2::complete_theme(plot$theme)
+    elements <- names(theme)
+  } else {
+    theme <- ggfun("plot_theme")(plot)
+    elements <- names(which(sapply(theme, inherits, "element")))
+  }
+
+  for (i in elements) {
+    theme[[i]] <- ggplot2::calc_element(i, theme)
+  }
+
+  theme
+}
+
 
 #-----------------------------------------------------------------------------
 # ggplotly 'utility' functions
@@ -1384,7 +1397,8 @@ rect2shape <- function(rekt = ggplot2::element_rect()) {
       linetype = lty2dash(rekt$linetype)
     ),
     yref = "paper",
-    xref = "paper"
+    xref = "paper",
+    layer = "below"
   )
 }
 
@@ -1408,6 +1422,7 @@ gdef2trace <- function(gdef, theme, gglayout) {
     # N.B. ggplot2 >v3.4.2 (specifically #4879) renamed bar to decor and also 
     # started returning normalized values for the key field
     decor <- gdef$decor %||% gdef$bar
+    decor$value <- decor$value %||% decor$max
     rng <- range(decor$value)
     decor$value <- scales::rescale(decor$value, from = rng)
     if (!"decor" %in% names(gdef)) {

inst/examples/shiny/event_data/tests/testthat.R

@@ -0,0 +1 @@
+shinytest2::test_app()

inst/examples/shiny/event_data/tests/shinytest/mytest-expected/001.json → inst/examples/shiny/event_data/tests/testthat/_snaps/shinytest2/001.json

@@ -1,6 +1,21 @@
 {
   "input": {
-    "plotType": "ggplotly"
+    ".clientValue-default-plotlyCrosstalkOpts": {
+      "on": "plotly_click",
+      "persistent": false,
+      "dynamic": false,
+      "selectize": false,
+      "opacityDim": 0.2,
+      "selected": {
+        "opacity": 1
+      },
+      "debounce": 0,
+      "color": [
+
+      ]
+    },
+    "plotType": "ggplotly",
+    "plotly_afterplot-A": "\"plot\""
   },
   "output": {
     "brushed": "[1] \"Brush extents appear here (double-click to clear)\"",

inst/examples/shiny/event_data/tests/shinytest/mytest-expected/002.json → inst/examples/shiny/event_data/tests/testthat/_snaps/shinytest2/002.json

@@ -14,11 +14,11 @@
 
       ]
     },
+    "plotType": "ggplotly",
     "plotly_afterplot-A": "\"plot\"",
     "plotly_click-A": "[{\"curveNumber\":0,\"pointNumber\":7,\"x\":24.4,\"y\":3.19,\"customdata\":\"Merc 240D\"}]",
     "plotly_hover-A": null,
-    "plotly_relayout-A": "{\"width\":962,\"height\":400}",
-    "plotType": "ggplotly"
+    "plotly_relayout-A": "{\"width\":962,\"height\":400}"
   },
   "output": {
     "brushed": "[1] \"Brush extents appear here (double-click to clear)\"",

inst/examples/shiny/event_data/tests/shinytest/mytest-expected/003.json → inst/examples/shiny/event_data/tests/testthat/_snaps/shinytest2/003.json

@@ -14,15 +14,15 @@
 
       ]
     },
+    "plotType": "ggplotly",
     "plotly_afterplot-A": "\"plot\"",
     "plotly_brushed-A": "{\"x\":[23.95978500551268,25.98332414553473],\"y\":[3.0020072289156627,3.5073743975903615]}",
     "plotly_brushing-A": "{\"x\":[23.95978500551268,25.98332414553473],\"y\":[3.0020072289156627,3.5073743975903615]}",
     "plotly_click-A": "[{\"curveNumber\":0,\"pointNumber\":7,\"x\":24.4,\"y\":3.19,\"customdata\":\"Merc 240D\"}]",
     "plotly_hover-A": null,
     "plotly_relayout-A": "{\"width\":962,\"height\":400}",
     "plotly_selected-A": "[{\"curveNumber\":0,\"pointNumber\":7,\"x\":24.4,\"y\":3.19,\"customdata\":\"Merc 240D\"}]",
-    "plotly_selecting-A": "[{\"curveNumber\":0,\"pointNumber\":7,\"x\":24.4,\"y\":3.19,\"customdata\":\"Merc 240D\"}]",
-    "plotType": "ggplotly"
+    "plotly_selecting-A": "[{\"curveNumber\":0,\"pointNumber\":7,\"x\":24.4,\"y\":3.19,\"customdata\":\"Merc 240D\"}]"
   },
   "output": {
     "brushed": "$x\n[1] 23.95979 25.98332\n\n$y\n[1] 3.002007 3.507374",

inst/examples/shiny/event_data/tests/shinytest/mytest-expected/004.json → inst/examples/shiny/event_data/tests/testthat/_snaps/shinytest2/004.json

@@ -14,6 +14,7 @@
 
       ]
     },
+    "plotType": "ggplotly",
     "plotly_afterplot-A": "\"plot\"",
     "plotly_brushed-A": null,
     "plotly_brushing-A": null,
@@ -22,8 +23,7 @@
     "plotly_hover-A": null,
     "plotly_relayout-A": "{\"width\":962,\"height\":400}",
     "plotly_selected-A": null,
-    "plotly_selecting-A": null,
-    "plotType": "ggplotly"
+    "plotly_selecting-A": null
   },
   "output": {
     "brushed": "[1] \"Brush extents appear here (double-click to clear)\"",

inst/examples/shiny/event_data/tests/testthat/setup-shinytest2.R

@@ -0,0 +1,2 @@
+# Load application support files into testing environment
+shinytest2::load_app_env()

inst/examples/shiny/event_data/tests/testthat/test-shinytest2.R

@@ -0,0 +1,34 @@
+library(shinytest2)
+app <- AppDriver$new(
+  "../../", view = interactive(),
+  options = list(display.mode = "normal")
+)
+
+test_that("Plotly input values in Shiny", {
+  app$expect_values()
+  app$set_inputs(`plotly_hover-A` = "[{\"curveNumber\":0,\"pointNumber\":7,\"x\":24.4,\"y\":3.19,\"customdata\":\"Merc 240D\"}]", allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_click-A` = "[{\"curveNumber\":0,\"pointNumber\":7,\"x\":24.4,\"y\":3.19,\"customdata\":\"Merc 240D\"}]", allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_hover-A` = character(0), allow_no_input_binding_ = TRUE)
+  Sys.sleep(1)
+  app$expect_values()
+  app$set_inputs(`plotly_brushing-A` = "{\"x\":[25.726819184123485,25.98332414553473],\"y\":[1.3174499999999998,5.61955]}", allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_selecting-A` = "[]", allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_brushing-A` = "{\"x\":[24.64379823594267,25.98332414553473],\"y\":[3.2093373493975905,3.5073743975903615]}", allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_brushing-A` = "{\"x\":[24.045286659316428,25.98332414553473],\"y\":[3.040881626506024,3.5073743975903615]}", allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_selecting-A` = "[{\"curveNumber\":0,\"pointNumber\":7,\"x\":24.4,\"y\":3.19,\"customdata\":\"Merc 240D\"}]", allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_brushing-A` = "{\"x\":[23.95978500551268,25.98332414553473],\"y\":[3.0020072289156627,3.5073743975903615]}", allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_selected-A` = "[{\"curveNumber\":0,\"pointNumber\":7,\"x\":24.4,\"y\":3.19,\"customdata\":\"Merc 240D\"}]", allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_brushed-A` = "{\"x\":[23.95978500551268,25.98332414553473],\"y\":[3.0020072289156627,3.5073743975903615]}", allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_hover-A` = "[{\"curveNumber\":0,\"pointNumber\":7,\"x\":24.4,\"y\":3.19,\"customdata\":\"Merc 240D\"}]", allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_hover-A` = character(0), allow_no_input_binding_ = TRUE)
+  app$expect_values()
+  app$set_inputs(`plotly_selected-A` = character(0), allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_brushed-A` = character(0), allow_no_input_binding_ = TRUE)
+  #app$set_inputs(`plotly_selected-A` = character(0), allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_selecting-A` = character(0), allow_no_input_binding_ = TRUE)
+  #app$set_inputs(`plotly_brushed-A` = character(0), allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_brushing-A` = character(0), allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_click-A` = character(0), allow_no_input_binding_ = TRUE)
+  app$set_inputs(`plotly_deselect-A` = "\"plot\"", allow_no_input_binding_ = TRUE)
+  app$expect_values()
+})