add event_data() support for ggplot2 & update example; move source to plot level

Author: cpsievert

R/ggplotly.R

@@ -4,15 +4,9 @@
 #' \url{https://plot.ly/ggplot2}
 #'
 #' @param p a ggplot object.
-#' @param filename character string describing the name of the plot in your plotly account. 
-#' Use / to specify directories. If a directory path does not exist it will be created.
-#' If this argument is not specified and the title of the plot exists,
-#' that will be used for the filename.
-#' @param fileopt character string describing whether to create a "new" plotly, "overwrite" an existing plotly, 
-#' "append" data to existing plotly, or "extend" it.
-#' @param world_readable logical. If \code{TRUE}, the graph is viewable 
-#' by anyone who has the link and in the owner's plotly account.
-#' If \code{FALSE}, graph is only viewable in the owner's plotly account.
+#' @param width Width of the plot in pixels (optional, defaults to automatic sizing).
+#' @param height Height of the plot in pixels (optional, defaults to automatic sizing).
+#' @param source Only relevant for \link{event_data}.
 #' @seealso \link{signup}, \link{plot_ly}
 #' @import httr jsonlite
 #' @export
@@ -32,13 +26,9 @@
 #'  ggplotly(viz)
 #' }
 #' 
-ggplotly <- function(p = ggplot2::last_plot(), filename, fileopt, 
-                     world_readable = TRUE) {
-  l <- gg2list(p)
-  # tack on special keyword arguments
-  if (!missing(filename)) l$filename <- filename
-  if (!missing(fileopt)) l$fileopt <- fileopt
-  l$world_readable <- world_readable
+ggplotly <- function(p = ggplot2::last_plot(), width = NULL, height = NULL,
+                     source = "A") {
+  l <- gg2list(p, width = width, height = height, source = source)
   hash_plot(p$data, l)
 }
 
@@ -116,9 +106,12 @@ guide_names <- function(p, aes = c("shape", "fill", "alpha", "area",
 #' Convert a ggplot to a list.
 #' @import ggplot2
 #' @param p ggplot2 plot.
+#' @param width Width of the plot in pixels (optional, defaults to automatic sizing).
+#' @param height Height of the plot in pixels (optional, defaults to automatic sizing).
+#' @param source Only relevant for \link{event_data}.
 #' @return figure object (list with names "data" and "layout").
 #' @export
-gg2list <- function(p) {
+gg2list <- function(p, width = NULL, height = NULL, source = "A") {
   # ggplot now applies geom_blank() (instead of erroring) when no layers exist
   if (length(p$layers) == 0) p <- p + geom_blank()
   layout <- list()
@@ -960,6 +953,8 @@ gg2list <- function(p) {
   }
 
   l <- list(data = flipped.traces, layout = flipped.layout)
-
+  l$width <- width
+  l$height <- width
+  l$source <- source
   structure(add_boxed(rm_asis(l)), class = "plotly")
 }

R/plotly.R

@@ -23,7 +23,7 @@
 #' @param height Height in pixels (optional, defaults to automatic sizing).
 #' @param inherit logical. Should future traces inherit properties from this initial trace?
 #' @param evaluate logical. Evaluate arguments when this function is called?
-#' @param source Only relevant for \link{event_data}
+#' @param source Only relevant for \link{event_data}.
 #' @seealso \code{\link{layout}()}, \code{\link{add_trace}()}, \code{\link{style}()}
 #' @author Carson Sievert
 #' @export
@@ -90,16 +90,16 @@ plot_ly <- function(data = data.frame(), ..., type = "scatter",
     args = argz,
     env = list2env(data),    # environment in which to evaluate arguments
     enclos = parent.frame(), # if objects aren't found in env, look here
-    inherit = inherit,
-    source = source
+    inherit = inherit
   )
   # plotly objects should always have a _list_ of trace(s)
   p <- list(
     data = list(tr),
     layout = NULL,
     url = NULL,
     width = width,
-    height = height
+    height = height,
+    source = source
   )
 
   if (evaluate) p <- plotly_build(p)

inst/examples/plotlyEvents/app.R

@@ -2,6 +2,7 @@ library(shiny)
 library(plotly)
 
 ui <- fluidPage(
+  radioButtons("plotType", "Plot Type:", choices = c("ggplotly", "plotly")),
   plotlyOutput("plot"),
   verbatimTextOutput("click"),
   verbatimTextOutput("brush")
@@ -10,8 +11,13 @@ ui <- fluidPage(
 server <- function(input, output, session) {
 
   output$plot <- renderPlotly({
-    plot_ly(mtcars, x = mpg, y = wt, mode = "markers") %>%
-      layout(dragmode =  "select")
+    if (identical(input$plotType, "ggplotly")) {
+      p <- ggplot(mtcars, aes(x = mpg, y = wt)) + geom_point()
+      ggplotly(p) %>% layout(dragmode = "select")
+    } else {
+      plot_ly(mtcars, x = mpg, y = wt, mode = "markers") %>%
+        layout(dragmode = "select")
+    }
   })
 
   output$click <- renderPrint({

inst/htmlwidgets/plotly.js

@@ -53,7 +53,7 @@ HTMLWidgets.widget({
           return obj;
         });
         Shiny.onInputChange(
-          ".clientValue-plotly_click-" + x.data[0].source, 
+          ".clientValue-plotly_click-" + x.source, 
           d
         );
       });
@@ -70,7 +70,7 @@ HTMLWidgets.widget({
             y: pts.map(function(pt) {return pt.y; })
           };
           Shiny.onInputChange(
-            ".clientValue-plotly_selected-" + x.data[0].source, 
+            ".clientValue-plotly_selected-" + x.source, 
             obj
           );
         }