improve event_data shine example apps

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_3D/app.R

@@ -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)