Merge branch 'master' into sizemode-pixel

Author: cpsievert

inst/examples/shiny/event_data/app.R

@@ -6,10 +6,10 @@ ui <- fluidPage(
   plotlyOutput("plot"),
   verbatimTextOutput("hover"),
   verbatimTextOutput("click"),
-  verbatimTextOutput("selected"),
+  verbatimTextOutput("brushing"),
   verbatimTextOutput("selecting"),
   verbatimTextOutput("brushed"),
-  verbatimTextOutput("brushing")
+  verbatimTextOutput("selected")
 )
 
 server <- function(input, output, session) {
@@ -37,24 +37,24 @@ server <- function(input, output, session) {
     if (is.null(d)) "Click events appear here (double-click to clear)" else d
   })
 
-  output$selected <- renderPrint({
-    d <- event_data("plotly_selected")
-    if (is.null(d)) "Click and drag events (i.e., select/lasso) appear here (double-click to clear)" else d
+  output$brushing <- renderPrint({
+    d <- event_data("plotly_brushing")
+    if (is.null(d)) "Brush extents appear here (double-click to clear)" else d
   })
 
   output$selecting <- renderPrint({
     d <- event_data("plotly_selecting")
-    if (is.null(d)) "Click and drag events (i.e., select/lasso) appear here (double-click to clear)" else d
+    if (is.null(d)) "Brush points appear here (double-click to clear)" else d
   })
 
   output$brushed <- renderPrint({
     d <- event_data("plotly_brushed")
-    if (is.null(d)) "Extents of the selection brush will appear here." else d
+    if (is.null(d)) "Brush extents appear here (double-click to clear)" else d
   })
 
-  output$brushing <- renderPrint({
-    d <- event_data("plotly_brushing")
-    if (is.null(d)) "Extents of the selection brush will appear here." else d
+  output$selected <- renderPrint({
+    d <- event_data("plotly_selected")
+    if (is.null(d)) "Brushed points appear here (double-click to clear)" else d
   })
 
 }

inst/examples/shiny/event_data/tests/mytest-expected/001.json

@@ -3,8 +3,8 @@
     "plotType": "ggplotly"
   },
   "output": {
-    "brushed": "[1] \"Extents of the selection brush will appear here.\"",
-    "brushing": "[1] \"Extents of the selection brush will appear here.\"",
+    "brushed": "[1] \"Brush extents appear here (double-click to clear)\"",
+    "brushing": "[1] \"Brush extents appear here (double-click to clear)\"",
     "click": "[1] \"Click events appear here (double-click to clear)\"",
     "hover": "[1] \"Hover events appear here (unhover to clear)\"",
     "plot": {
@@ -449,8 +449,8 @@
         }
       ]
     },
-    "selected": "[1] \"Click and drag events (i.e., select/lasso) appear here (double-click to clear)\"",
-    "selecting": "[1] \"Click and drag events (i.e., select/lasso) appear here (double-click to clear)\""
+    "selected": "[1] \"Brushed points appear here (double-click to clear)\"",
+    "selecting": "[1] \"Brush points appear here (double-click to clear)\""
   },
   "export": {
 

inst/examples/shiny/event_data/tests/mytest-expected/001.png

@@ -20,8 +20,8 @@
     "plotType": "ggplotly"
   },
   "output": {
-    "brushed": "[1] \"Extents of the selection brush will appear here.\"",
-    "brushing": "[1] \"Extents of the selection brush will appear here.\"",
+    "brushed": "[1] \"Brush extents appear here (double-click to clear)\"",
+    "brushing": "[1] \"Brush extents appear here (double-click to clear)\"",
     "click": "  curveNumber pointNumber    x    y customdata\n1           0           7 24.4 3.19  Merc 240D",
     "hover": "[1] \"Hover events appear here (unhover to clear)\"",
     "plot": {
@@ -466,8 +466,8 @@
         }
       ]
     },
-    "selected": "[1] \"Click and drag events (i.e., select/lasso) appear here (double-click to clear)\"",
-    "selecting": "[1] \"Click and drag events (i.e., select/lasso) appear here (double-click to clear)\""
+    "selected": "[1] \"Brushed points appear here (double-click to clear)\"",
+    "selecting": "[1] \"Brush points appear here (double-click to clear)\""
   },
   "export": {
 

inst/examples/shiny/event_data/tests/mytest-expected/002.json

@@ -25,8 +25,8 @@
     "plotType": "ggplotly"
   },
   "output": {
-    "brushed": "[1] \"Extents of the selection brush will appear here.\"",
-    "brushing": "[1] \"Extents of the selection brush will appear here.\"",
+    "brushed": "[1] \"Brush extents appear here (double-click to clear)\"",
+    "brushing": "[1] \"Brush extents appear here (double-click to clear)\"",
     "click": "[1] \"Click events appear here (double-click to clear)\"",
     "hover": "[1] \"Hover events appear here (unhover to clear)\"",
     "plot": {
@@ -471,8 +471,8 @@
         }
       ]
     },
-    "selected": "[1] \"Click and drag events (i.e., select/lasso) appear here (double-click to clear)\"",
-    "selecting": "[1] \"Click and drag events (i.e., select/lasso) appear here (double-click to clear)\""
+    "selected": "[1] \"Brushed points appear here (double-click to clear)\"",
+    "selecting": "[1] \"Brush points appear here (double-click to clear)\""
   },
   "export": {
 

inst/examples/shiny/event_data/tests/mytest-expected/002.png

@@ -1,28 +1,48 @@
-library(shiny)
 library(plotly)
+library(shiny)
 
 ui <- fluidPage(
   plotlyOutput("plot"),
   verbatimTextOutput("hover"),
-  verbatimTextOutput("click")
+  verbatimTextOutput("click"),
+  verbatimTextOutput("legendclick"),
+  verbatimTextOutput("legend2click"),
+  verbatimTextOutput("relayout")
 )
 
 server <- function(input, output, session) {
 
   output$plot <- renderPlotly({
-    plot_ly(x = rnorm(10), y = rnorm(10), z = rnorm(10), type = "scatter3d")
+    plot_ly(mtcars, x = ~wt, y = ~mpg, z = ~disp, color = ~factor(cyl)) %>%
+      event_register("plotly_legendclick") %>%
+      event_register("plotly_legenddoubleclick") 
   })
 
   output$hover <- renderPrint({
     d <- event_data("plotly_hover")
-    if (is.null(d)) "Hover events appear here (unhover to clear)" else d
+    if (is.null(d)) "Hover events appear here" else d
   })
 
   output$click <- renderPrint({
     d <- event_data("plotly_click")
     if (is.null(d)) "Click events appear here" else d
   })
 
+  output$legendclick <- renderPrint({
+    d <- event_data("plotly_legendclick")$name
+    if (is.null(d)) "Legend click" else d
+  })
+  
+  output$legend2click <- renderPrint({
+    d <- event_data("plotly_legenddoubleclick")$name
+    if (is.null(d)) "Legend double-click" else d
+  })
+  
+  output$relayout <- renderPrint({
+    d <- event_data("plotly_relayout")$scene.camera$eye
+    if (is.null(d)) "Camera eye info" else d
+  })
+  
 }
 
-shinyApp(ui, server, options = list(display.mode = "showcase"))
+shinyApp(ui, server)

inst/examples/shiny/event_data/tests/mytest-expected/003.png

@@ -0,0 +1,60 @@
+library(shiny)
+library(plotly)
+
+ui <- fluidPage(
+  actionButton("stream", "Turn stream on/off"),
+  plotlyOutput("plot")
+)
+
+server <- function(input, output, session) {
+  
+  # initial values
+  yint <- c(0, 1)
+  
+  # initiate graph with initial values
+  output$plot <- renderPlotly({
+    plot_ly(y = yint, x = seq_along(yint)) %>%
+      add_lines()
+  })
+  
+  # reactiveValues() act very much like input values, but may be used to 
+  # maintain state (e.g., are we currently streaming?)
+  rv <- reactiveValues(
+    stream = FALSE,
+    yend = sum(yint), 
+    n = length(yint)
+  )
+  
+  # turn streaming on/off when the button is pressed
+  observeEvent(input$stream, {
+    rv$stream <- if (rv$stream) FALSE else TRUE
+  })
+  
+  observe({
+    # if we're not streaming, don't do anything
+    if (!rv$stream) return()
+    
+    # re-execute this code block to every 100 milliseconds
+    invalidateLater(100, session)
+    # changing a reactive value "invalidates" it, so isolate() is needed 
+    # to avoid recursion
+    isolate({
+      rv$n <- rv$n + 1
+      rv$yend <- rv$yend + sample(c(-1, 1), 1)
+    })
+    
+    # add the new value to the plot
+    plotlyProxy("plot", session) %>%
+      plotlyProxyInvoke(
+        "extendTraces", 
+        list(
+          y = list(list(rv$yend)), 
+          x = list(list(rv$n))
+        ), 
+        list(0)
+      )
+  })
+  
+}
+
+shinyApp(ui, server)