Merge pull request #1281 from ropensci/async

Support Shiny async/promises based rendering

Author: cpsievert

DESCRIPTION

@@ -43,7 +43,8 @@ Imports:
     rlang,
     crosstalk,
     purrr,
-    data.table
+    data.table,
+    promises
 Suggests:
     MASS,
     maps,
@@ -52,7 +53,7 @@ Suggests:
     testthat,
     knitr,
     devtools,
-    shiny (>= 0.14),
+    shiny (>= 1.1.0),
     curl,
     rmarkdown,
     Rserve,

R/shiny.R

@@ -38,10 +38,19 @@ renderPlotly <- function(expr, env = parent.frame(), quoted = FALSE) {
   if (!quoted) { expr <- substitute(expr) } # force quoted
   # 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("ggplotly")), expr))
+  expr <- as.call(list(call(":::", quote("plotly"), quote("prepareWidget")), expr))
   shinyRenderWidget(expr, plotlyOutput, env, quoted = TRUE)
 }
 
+# Converts a plot, OR a promise of a plot, to plotly
+prepareWidget <- function(x) {
+  if (promises::is.promising(x)) {
+    promises::then(x, ggplotly)
+  } else {
+    ggplotly(x)
+  }
+}
+
 
 #' Access plotly user input event data in shiny
 #' 

inst/examples/shiny/async/app.R

@@ -0,0 +1,42 @@
+library(shiny)
+library(plotly)
+library(ggplot2)
+library(promises)
+library(future)
+plan(multisession)
+
+ui <- fluidPage(
+  plotlyOutput("plot1"),
+  plotlyOutput("plot2"),
+  plotlyOutput("plot3"),
+  plotlyOutput("plot4")
+)
+
+server <- function(input, output, session) {
+  output$plot1 <- renderPlotly({
+    # Async plot_ly
+    future({ Sys.sleep(2); cars }) %...>%
+      plot_ly(x = ~speed, y = ~dist, type = "scatter", mode = "markers")
+  })
+  
+  output$plot2 <- renderPlotly({
+    # Async ggplotly
+    future({ Sys.sleep(2); mtcars }) %...>%
+    { ggplot(., aes(hp, mpg)) + geom_point() } %...>%
+      ggplotly()
+  })
+  
+  output$plot3 <- renderPlotly({
+    # Not async
+    plot_ly(iris, x = ~Sepal.Length, y = ~Sepal.Width,
+            type = "scatter", mode = "markers")
+  })
+  
+  output$plot4 <- renderPlotly({
+    # Ensure errors are handled properly (should be blank)
+    future({}) %...>%
+    { req(FALSE) }
+  })
+}
+
+shinyApp(ui, server)