crosstalk integration

.Rbuildignore

@@ -1,5 +1,5 @@
 .travis.yml
-Karthik_local.R
+playground/
 Makefile
 man-roxygen
 man-roxygen/^.*\.Rproj$

.gitignore

@@ -1,6 +1,6 @@
 R/.Rhistory
 Rapp.history
-/Karthik_local.R
+playground/
 *~
 .Rhistory
 .RData

.travis.yml

@@ -9,6 +9,7 @@ before_install:
 
 install:
   - ./travis-tool.sh install_deps
+  - ./travis-tool.sh install_github jcheng5/crosstalk
 
 before_script:
   - git config --global user.name "cpsievert"

DESCRIPTION

@@ -30,6 +30,7 @@ Imports:
     viridis,
     base64enc,
     htmlwidgets,
+    crosstalk,
     plyr
 Suggests:
     dplyr,

R/plotly.R

@@ -19,6 +19,8 @@
 #' @param symbols A character vector of symbol types. Possible values:
 #' 'dot', 'cross', 'diamond', 'square', 'triangle-down', 'triangle-left', 'triangle-right', 'triangle-up' 
 #' @param size A variable name or numeric vector to encode the size of markers.
+#' @param key a selection variable for linked views
+#' @param set share selections across this grouping variable.
 #' @param width	Width in pixels (optional, defaults to automatic sizing).
 #' @param height Height in pixels (optional, defaults to automatic sizing).
 #' @param inherit logical. Should future traces inherit properties from this initial trace?
@@ -64,9 +66,9 @@
 #' }
 #' 
 plot_ly <- function(data = data.frame(), ..., type = "scatter",
-                    group, color, colors, symbol, symbols, size,
-                    width = NULL, height = NULL, inherit = TRUE, 
-                    evaluate = FALSE) {
+                    group, color, colors, symbol, symbols, size, 
+                    key, set = "A", width = NULL, height = NULL, 
+                    inherit = TRUE, evaluate = FALSE) {
   # "native" plotly arguments
   argz <- substitute(list(...))
   # old arguments to this function that are no longer supported
@@ -83,16 +85,19 @@ plot_ly <- function(data = data.frame(), ..., type = "scatter",
   if (!missing(symbol)) argz$symbol <- substitute(symbol)
   if (!missing(symbols)) argz$symbols <- substitute(symbols)
   if (!missing(size)) argz$size <- substitute(size)
+  if (!missing(key)) argz$key <- substitute(key)
   # trace information
   tr <- list(
     type = type,
     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
+    inherit = inherit,
+    set = set
   )
-  # plotly objects should always have a _list_ of trace(s)
+
   p <- list(
+    # plotly objects should always have a _list_ of trace(s)
     data = list(tr),
     layout = NULL,
     url = NULL,

R/print.R

@@ -49,6 +49,7 @@ as.widget <- function(x, ...) {
       padding = 5, 
       browser.fill = TRUE
     ),
+    dependencies = crosstalk::dependencies,
     ...
   )
 }

inst/examples/crosstalk.R

@@ -0,0 +1,34 @@
+# access renderPlotly() selections on a shiny server
+# https://github.com/cpsievert/shiny_apps/blob/master/plotlyCrosstalk/app.R
+
+# TODO: 
+# (1) pass selections from another htmlwidget (rcdimple?) to renderPlotly()
+# (2) crosstalk without shiny (see examples below)
+# (3) define custom event behavior in JS from R?
+
+library(plotly)
+library(htmltools)
+
+# click/show selects?
+mtcars$gear <- factor(mtcars$gear)
+mtcars$cyl <- factor(mtcars$cyl)
+p1 <- plot_ly(mtcars, x = wt, y = mpg, color = gear, mode = "markers", 
+              key = gear, set = "A", width = 400)
+p2 <- plot_ly(mtcars, x = wt, y = disp, color = gear, mode = "markers", 
+              key = gear, set = "A", width = 400)
+# TODO: inline-block?
+browsable(tagList(
+  as.widget(p1),
+  as.widget(p2)
+))
+
+library(dplyr)
+m <- count(mtcars, cyl)
+p1 <- plot_ly(m, x = cyl, y = n, type = "bar", 
+              key = cyl, set = "A", width = 400)
+p2 <- plot_ly(mtcars, x = mpg, y = disp, mode = "markers", 
+              key = cyl, set = "A", width = 400)
+browsable(tagList(
+  as.widget(p1),
+  as.widget(p2)
+))

inst/htmlwidgets/lib/jquery/LICENSE.txt

@@ -0,0 +1,37 @@
+Copyright 2005, 2014 jQuery Foundation and other contributors,
+https://jquery.org/
+
+This software consists of voluntary contributions made by many
+individuals. For exact contribution history, see the revision history
+available at https://github.com/jquery/jquery
+
+The following license applies to all parts of this software except as
+documented below:
+
+====
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+====
+
+All files located in the node_modules and external directories are
+externally maintained libraries used by this software which have their
+own licenses; we recommend you read them, as their terms may differ from
+the terms above.

inst/htmlwidgets/plotly.js

@@ -1,8 +1,9 @@
+
 HTMLWidgets.widget({
   name: "plotly",
   type: "output",
 
-  initialize: function(el, width, height){
+  initialize: function(el, width, height) {
     return {};
   },
 
@@ -22,6 +23,40 @@ HTMLWidgets.widget({
     } else {
       Plotly.newPlot(el.id, x.data, x.layout);
     }
+
+    var g = x.data[0].set;
+    var grp = crosstalk.group(g);
+
+    $('#'+el.id).on('plotly_click', function(event, data) {
+      // extract only the data we may want to access in R
+      var d = data.points.map(function(pt) {
+        var obj = {
+            curveNumber: pt.curveNumber, 
+            pointNumber: pt.pointNumber, 
+            x: pt.x,
+            y: pt.y
+        };
+        if (pt.data.hasOwnProperty("key")) {
+          if (typeof pt.pointNumber === "number") {
+            obj.key = pt.data.key[pt.pointNumber];
+          } else {
+            obj.key = pt.data.key[pt.pointNumber[0]][pt.pointNumber[1]];
+          } // TODO: can pointNumber be 3D?
+        }
+        return obj;
+      });
+
+      // tell crosstalk about click data so we can access it in R (and JS)
+      grp.var("plotly_click").set(d);
+      // TODO: provide visual clue that we've selected point(s)
+      // (it's possible this will be handled natively in plotlyjs...)
+    });
+
+    grp.var('plotly_click').on('change', function(e) {
+      console.log(e.value);
+      // TODO: if e.value.x !=  e.oldValue.x, then newPlot? Otherwise, restyle?
+    });
+
   }
 
 });

inst/htmlwidgets/plotly.yaml

@@ -3,3 +3,7 @@ dependencies:
     version: 1.2.1
     src: "htmlwidgets/lib/plotlyjs"
     script: plotly-latest.min.js
+  - name: jquery
+    version: 2.1.4
+    src: "htmlwidgets/lib/jquery"
+    script: jquery.min.js

inst/plotlyjs.R

@@ -7,3 +7,9 @@ download.file(
   "https://raw.githubusercontent.com/plotly/plotly.js/master/LICENSE",
   "inst/htmlwidgets/lib/plotlyjs/LICENSE"
 )
+
+
+download.file(
+  "https://code.jquery.com/jquery-2.1.4.min.js",
+  "inst/htmlwidgets/lib/jquery/jquery.min.js"
+)