Merge pull request #519 from ropensci/feature/zoom

Feature/zoom

Author: cpsievert

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: plotly
 Title: Create Interactive Web Graphics via 'plotly.js'
-Version: 3.4.5
+Version: 3.4.6
 Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"),
     email = "cpsievert1@gmail.com"),
     person("Chris", "Parmer", role = c("aut", "cph"),

NEWS

@@ -1,3 +1,11 @@
+3.4.6 -- 17 Mar 2016
+
+NEW FEATURES:
+
+The 'plotly_relayout' event is now accessible via the event_data() function.
+
+Fixed #514.
+
 3.4.5 -- 17 Mar 2016
 
 BUGFIX:

R/shiny.R

@@ -36,7 +36,7 @@ renderPlotly <- function(expr, env = parent.frame(), quoted = FALSE) {
 #' This function must be called within a reactive shiny context.
 #' 
 #' @param event The type of plotly event. Currently 'plotly_hover',
-#' 'plotly_click', and 'plotly_selected' are supported.
+#' 'plotly_click', 'plotly_selected', and 'plotly_relayout' are supported.
 #' @param source Which plot should the listener be tied to? This 
 #' (character string) should match the value of \code{source} in \link{plot_ly}.
 #' @export
@@ -45,8 +45,8 @@ renderPlotly <- function(expr, env = parent.frame(), quoted = FALSE) {
 #' shiny::runApp(system.file("examples", "events", package = "plotly"))
 #' }
 
-event_data <- function(event = c("plotly_hover", "plotly_click", "plotly_selected"), 
-                       source = "A") {
+event_data <- function(event = c("plotly_hover", "plotly_click", "plotly_selected", 
+                                 "plotly_relayout"), source = "A") {
   session <- shiny::getDefaultReactiveDomain()
   if (is.null(session)) {
     stop("No reactive domain detected. This function can only be called \n",

inst/examples/plotlyEvents/app.R

@@ -6,7 +6,8 @@ ui <- fluidPage(
   plotlyOutput("plot"),
   verbatimTextOutput("hover"),
   verbatimTextOutput("click"),
-  verbatimTextOutput("brush")
+  verbatimTextOutput("brush"),
+  verbatimTextOutput("zoom")
 )
 
 server <- function(input, output, session) {
@@ -39,6 +40,11 @@ server <- function(input, output, session) {
     if (is.null(d)) "Click and drag events (i.e., select/lasso) appear here (double-click to clear)" else d
   })
 
+  output$zoom <- renderPrint({
+    d <- event_data("plotly_relayout")
+    if (is.null(d)) "Relayout (i.e., zoom) events appear here" else d
+  })
+  
 }
 
 shinyApp(ui, server, options = list(display.mode = "showcase"))

inst/htmlwidgets/plotly.js

@@ -71,6 +71,13 @@ HTMLWidgets.widget({
 
     // send user input event data to shiny
     if (shinyMode) {
+      // https://plot.ly/javascript/zoom-events/
+      graphDiv.on('plotly_relayout', function(d) {
+        Shiny.onInputChange(
+          ".clientValue-" + "plotly_relayout" + "-" + x.source, 
+          JSON.stringify(d)
+        );
+      });
       graphDiv.on('plotly_hover', sendEventData('plotly_hover'));
       graphDiv.on('plotly_click', sendEventData('plotly_click'));
       graphDiv.on('plotly_selected', sendEventData('plotly_selected'));

man/event_data.Rd

@@ -49,6 +49,6 @@ test_that("tickvals/ticktext are appropriately boxed", {
   d <- data.frame(x = factor(75), y = 10)
   p <- qplot(x, y, data = d) 
   info <- save_outputs(p, "point-box")
-  expect_true(plotly::to_JSON(info$layout$xaxis$tickvals) == '[1]')
-  expect_true(plotly::to_JSON(info$layout$xaxis$ticktext) == '["75"]')
+  expect_true(plotly:::to_JSON(info$layout$xaxis$tickvals) == '[1]')
+  expect_true(plotly:::to_JSON(info$layout$xaxis$ticktext) == '["75"]')
 })