basic crosstalk implementation

.travis.yml

@@ -28,8 +28,10 @@ before_script:
  - git clone https://github.com/cpsievert/plotly-test-table.git ../plotly-test-table
  - "wget -q -O - https://github.com/yihui/crandalf/raw/master/inst/scripts/install-pandoc | bash"
  - Rscript -e 'if (length(find.package("devtools", quiet = TRUE)) == 0L) { install.packages("devtools", repos = "http://cran.rstudio.com") }'
- - Rscript -e 'library(devtools);update_packages("devtools", repos = "http://cran.rstudio.com")'
- - Rscript -e 'library(devtools);install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::update_packages("devtools", repos = "http://cran.rstudio.com")'
+ - Rscript -e 'devtools::install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::install_github("rstudio/crosstalk")'
+ - Rscript -e 'devtools::install_github("cpsievert/htmlwidgets")'
 
 script:
  # run R CMD check on the non-pull request build

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 = FALSE, 
- evaluate = FALSE) {
+ group, color, colors, symbol, symbols, size,
+key, set = "A", width = NULL, height = NULL, 
+inherit = FALSE, 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,
  ...
  )
 }

R/shiny.R

@@ -7,6 +7,8 @@
 #' @param width,height Must be a valid CSS unit (like \code{"100\%"},
 #' \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
 #' string and have \code{"px"} appended.
+#' @param inline use an inline (\code{span()}) or block container 
+#' (\code{div()}) for the output
 #' @param expr An expression that generates a plotly
 #' @param env The environment in which to evaluate \code{expr}.
 #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This 
@@ -17,8 +19,16 @@
 #' @name plotly-shiny
 #'
 #' @export
-plotlyOutput <- function(outputId, width = "100%", height = "400px") {
- htmlwidgets::shinyWidgetOutput(outputId, "plotly", width, height, package = "plotly")
+plotlyOutput <- function(outputId, width = "100%", height = "400px", 
+ inline = FALSE) {
+ htmlwidgets::shinyWidgetOutput(
+ outputId = outputId, 
+ name = "plotly", 
+ width = width, 
+ height = height, 
+ inline = inline, 
+ package = "plotly"
+ )
 }
 
 #' @rdname plotly-shiny

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/plotly.js

@@ -1,12 +1,14 @@
+
 HTMLWidgets.widget({
  name: "plotly",
  type: "output",
 
- initialize: function(el, width, height){
+ initialize: function(el, width, height){
  return {};
  },
 
  resize: function(el, width, height, instance) {
+ // TODO: impose fixed coordinates, if specified (see #342)
  Plotly.relayout(el.id, {width: width, height: height});
  }, 
 
@@ -15,13 +17,57 @@ HTMLWidgets.widget({
  window.PLOTLYENV = window.PLOTLYENV || {};
  window.PLOTLYENV.BASE_URL = x.base_url;
 
+ var graphDiv = document.getElementById(el.id);
+
  // if no plot exists yet, create one with a particular configuration
  if (!instance.plotly) {
- Plotly.plot(el.id, x.data, x.layout, x.config);
+ Plotly.plot(graphDiv, x.data, x.layout, x.config);
  instance.plotly = true;
  } else {
- Plotly.newPlot(el.id, x.data, x.layout);
+ Plotly.newPlot(graphDiv, x.data, x.layout);
  }
+
+ var g = x.data[0].set;
+ var grp = crosstalk.group(g);
+
+ graphDiv.on('plotly_click', function(eventData) {
+ // extract only the data we may want to access in R
+ var d = eventData.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);
+ });
+
+ graphDiv.on('plotly_selected', function(eventData) {
+ if (eventData !== undefined) {
+ // convert the array of objects to object of arrays so this converts
+ // to data frame in R as opposed to a vector
+ var pts = eventData.points;
+ var obj = {
+ curveNumber: pts.map(function(pt) {return pt.curveNumber; }),
+ pointNumber: pts.map(function(pt) {return pt.pointNumber; }), 
+ x: pts.map(function(pt) {return pt.x; }),
+ y: pts.map(function(pt) {return pt.y; })
+ };
+ grp.var("plotly_selected").set(obj);
+ }
+ }); 
+
  }
 
 });

.travis.yml

@@ -28,8 +28,10 @@ before_script:
  - git clone https://github.com/cpsievert/plotly-test-table.git ../plotly-test-table
  - "wget -q -O - https://github.com/yihui/crandalf/raw/master/inst/scripts/install-pandoc | bash"
  - Rscript -e 'if (length(find.package("devtools", quiet = TRUE)) == 0L) { install.packages("devtools", repos = "http://cran.rstudio.com") }'
- - Rscript -e 'library(devtools);update_packages("devtools", repos = "http://cran.rstudio.com")'
- - Rscript -e 'library(devtools);install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::update_packages("devtools", repos = "http://cran.rstudio.com")'
+ - Rscript -e 'devtools::install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::install_github("rstudio/crosstalk")'
+ - Rscript -e 'devtools::install_github("cpsievert/htmlwidgets")'
 
 script:
  # run R CMD check on the non-pull request build

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 = FALSE, 
- evaluate = FALSE) {
+ group, color, colors, symbol, symbols, size,
+key, set = "A", width = NULL, height = NULL, 
+inherit = FALSE, 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,
  ...
  )
 }

R/shiny.R

@@ -7,6 +7,8 @@
 #' @param width,height Must be a valid CSS unit (like \code{"100\%"},
 #' \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
 #' string and have \code{"px"} appended.
+#' @param inline use an inline (\code{span()}) or block container 
+#' (\code{div()}) for the output
 #' @param expr An expression that generates a plotly
 #' @param env The environment in which to evaluate \code{expr}.
 #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This 
@@ -17,8 +19,16 @@
 #' @name plotly-shiny
 #'
 #' @export
-plotlyOutput <- function(outputId, width = "100%", height = "400px") {
- htmlwidgets::shinyWidgetOutput(outputId, "plotly", width, height, package = "plotly")
+plotlyOutput <- function(outputId, width = "100%", height = "400px", 
+ inline = FALSE) {
+ htmlwidgets::shinyWidgetOutput(
+ outputId = outputId, 
+ name = "plotly", 
+ width = width, 
+ height = height, 
+ inline = inline, 
+ package = "plotly"
+ )
 }
 
 #' @rdname plotly-shiny

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/plotly.js

@@ -1,12 +1,14 @@
+
 HTMLWidgets.widget({
  name: "plotly",
  type: "output",
 
- initialize: function(el, width, height){
+ initialize: function(el, width, height){
  return {};
  },
 
  resize: function(el, width, height, instance) {
+ // TODO: impose fixed coordinates, if specified (see #342)
  Plotly.relayout(el.id, {width: width, height: height});
  }, 
 
@@ -15,13 +17,57 @@ HTMLWidgets.widget({
  window.PLOTLYENV = window.PLOTLYENV || {};
  window.PLOTLYENV.BASE_URL = x.base_url;
 
+ var graphDiv = document.getElementById(el.id);
+
  // if no plot exists yet, create one with a particular configuration
  if (!instance.plotly) {
- Plotly.plot(el.id, x.data, x.layout, x.config);
+ Plotly.plot(graphDiv, x.data, x.layout, x.config);
  instance.plotly = true;
  } else {
- Plotly.newPlot(el.id, x.data, x.layout);
+ Plotly.newPlot(graphDiv, x.data, x.layout);
  }
+
+ var g = x.data[0].set;
+ var grp = crosstalk.group(g);
+
+ graphDiv.on('plotly_click', function(eventData) {
+ // extract only the data we may want to access in R
+ var d = eventData.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);
+ });
+
+ graphDiv.on('plotly_selected', function(eventData) {
+ if (eventData !== undefined) {
+ // convert the array of objects to object of arrays so this converts
+ // to data frame in R as opposed to a vector
+ var pts = eventData.points;
+ var obj = {
+ curveNumber: pts.map(function(pt) {return pt.curveNumber; }),
+ pointNumber: pts.map(function(pt) {return pt.pointNumber; }), 
+ x: pts.map(function(pt) {return pt.x; }),
+ y: pts.map(function(pt) {return pt.y; })
+ };
+ grp.var("plotly_selected").set(obj);
+ }
+ }); 
+
  }
 
 });

.travis.yml

@@ -28,8 +28,10 @@ before_script:
  - git clone https://github.com/cpsievert/plotly-test-table.git ../plotly-test-table
  - "wget -q -O - https://github.com/yihui/crandalf/raw/master/inst/scripts/install-pandoc | bash"
  - Rscript -e 'if (length(find.package("devtools", quiet = TRUE)) == 0L) { install.packages("devtools", repos = "http://cran.rstudio.com") }'
- - Rscript -e 'library(devtools);update_packages("devtools", repos = "http://cran.rstudio.com")'
- - Rscript -e 'library(devtools);install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::update_packages("devtools", repos = "http://cran.rstudio.com")'
+ - Rscript -e 'devtools::install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::install_github("rstudio/crosstalk")'
+ - Rscript -e 'devtools::install_github("cpsievert/htmlwidgets")'
 
 script:
  # run R CMD check on the non-pull request build

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 = FALSE, 
- evaluate = FALSE) {
+ group, color, colors, symbol, symbols, size,
+key, set = "A", width = NULL, height = NULL, 
+inherit = FALSE, 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,
  ...
  )
 }

R/shiny.R

@@ -7,6 +7,8 @@
 #' @param width,height Must be a valid CSS unit (like \code{"100\%"},
 #' \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
 #' string and have \code{"px"} appended.
+#' @param inline use an inline (\code{span()}) or block container 
+#' (\code{div()}) for the output
 #' @param expr An expression that generates a plotly
 #' @param env The environment in which to evaluate \code{expr}.
 #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This 
@@ -17,8 +19,16 @@
 #' @name plotly-shiny
 #'
 #' @export
-plotlyOutput <- function(outputId, width = "100%", height = "400px") {
- htmlwidgets::shinyWidgetOutput(outputId, "plotly", width, height, package = "plotly")
+plotlyOutput <- function(outputId, width = "100%", height = "400px", 
+ inline = FALSE) {
+ htmlwidgets::shinyWidgetOutput(
+ outputId = outputId, 
+ name = "plotly", 
+ width = width, 
+ height = height, 
+ inline = inline, 
+ package = "plotly"
+ )
 }
 
 #' @rdname plotly-shiny

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/plotly.js

@@ -1,12 +1,14 @@
+
 HTMLWidgets.widget({
  name: "plotly",
  type: "output",
 
- initialize: function(el, width, height){
+ initialize: function(el, width, height){
  return {};
  },
 
  resize: function(el, width, height, instance) {
+ // TODO: impose fixed coordinates, if specified (see #342)
  Plotly.relayout(el.id, {width: width, height: height});
  }, 
 
@@ -15,13 +17,57 @@ HTMLWidgets.widget({
  window.PLOTLYENV = window.PLOTLYENV || {};
  window.PLOTLYENV.BASE_URL = x.base_url;
 
+ var graphDiv = document.getElementById(el.id);
+
  // if no plot exists yet, create one with a particular configuration
  if (!instance.plotly) {
- Plotly.plot(el.id, x.data, x.layout, x.config);
+ Plotly.plot(graphDiv, x.data, x.layout, x.config);
  instance.plotly = true;
  } else {
- Plotly.newPlot(el.id, x.data, x.layout);
+ Plotly.newPlot(graphDiv, x.data, x.layout);
  }
+
+ var g = x.data[0].set;
+ var grp = crosstalk.group(g);
+
+ graphDiv.on('plotly_click', function(eventData) {
+ // extract only the data we may want to access in R
+ var d = eventData.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);
+ });
+
+ graphDiv.on('plotly_selected', function(eventData) {
+ if (eventData !== undefined) {
+ // convert the array of objects to object of arrays so this converts
+ // to data frame in R as opposed to a vector
+ var pts = eventData.points;
+ var obj = {
+ curveNumber: pts.map(function(pt) {return pt.curveNumber; }),
+ pointNumber: pts.map(function(pt) {return pt.pointNumber; }), 
+ x: pts.map(function(pt) {return pt.x; }),
+ y: pts.map(function(pt) {return pt.y; })
+ };
+ grp.var("plotly_selected").set(obj);
+ }
+ }); 
+
  }
 
 });

.travis.yml

@@ -28,8 +28,10 @@ before_script:
  - git clone https://github.com/cpsievert/plotly-test-table.git ../plotly-test-table
  - "wget -q -O - https://github.com/yihui/crandalf/raw/master/inst/scripts/install-pandoc | bash"
  - Rscript -e 'if (length(find.package("devtools", quiet = TRUE)) == 0L) { install.packages("devtools", repos = "http://cran.rstudio.com") }'
- - Rscript -e 'library(devtools);update_packages("devtools", repos = "http://cran.rstudio.com")'
- - Rscript -e 'library(devtools);install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::update_packages("devtools", repos = "http://cran.rstudio.com")'
+ - Rscript -e 'devtools::install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::install_github("rstudio/crosstalk")'
+ - Rscript -e 'devtools::install_github("cpsievert/htmlwidgets")'
 
 script:
  # run R CMD check on the non-pull request build

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 = FALSE, 
- evaluate = FALSE) {
+ group, color, colors, symbol, symbols, size,
+key, set = "A", width = NULL, height = NULL, 
+inherit = FALSE, 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,
  ...
  )
 }

R/shiny.R

@@ -7,6 +7,8 @@
 #' @param width,height Must be a valid CSS unit (like \code{"100\%"},
 #' \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
 #' string and have \code{"px"} appended.
+#' @param inline use an inline (\code{span()}) or block container 
+#' (\code{div()}) for the output
 #' @param expr An expression that generates a plotly
 #' @param env The environment in which to evaluate \code{expr}.
 #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This 
@@ -17,8 +19,16 @@
 #' @name plotly-shiny
 #'
 #' @export
-plotlyOutput <- function(outputId, width = "100%", height = "400px") {
- htmlwidgets::shinyWidgetOutput(outputId, "plotly", width, height, package = "plotly")
+plotlyOutput <- function(outputId, width = "100%", height = "400px", 
+ inline = FALSE) {
+ htmlwidgets::shinyWidgetOutput(
+ outputId = outputId, 
+ name = "plotly", 
+ width = width, 
+ height = height, 
+ inline = inline, 
+ package = "plotly"
+ )
 }
 
 #' @rdname plotly-shiny

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/plotly.js

@@ -1,12 +1,14 @@
+
 HTMLWidgets.widget({
  name: "plotly",
  type: "output",
 
- initialize: function(el, width, height){
+ initialize: function(el, width, height){
  return {};
  },
 
  resize: function(el, width, height, instance) {
+ // TODO: impose fixed coordinates, if specified (see #342)
  Plotly.relayout(el.id, {width: width, height: height});
  }, 
 
@@ -15,13 +17,57 @@ HTMLWidgets.widget({
  window.PLOTLYENV = window.PLOTLYENV || {};
  window.PLOTLYENV.BASE_URL = x.base_url;
 
+ var graphDiv = document.getElementById(el.id);
+
  // if no plot exists yet, create one with a particular configuration
  if (!instance.plotly) {
- Plotly.plot(el.id, x.data, x.layout, x.config);
+ Plotly.plot(graphDiv, x.data, x.layout, x.config);
  instance.plotly = true;
  } else {
- Plotly.newPlot(el.id, x.data, x.layout);
+ Plotly.newPlot(graphDiv, x.data, x.layout);
  }
+
+ var g = x.data[0].set;
+ var grp = crosstalk.group(g);
+
+ graphDiv.on('plotly_click', function(eventData) {
+ // extract only the data we may want to access in R
+ var d = eventData.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);
+ });
+
+ graphDiv.on('plotly_selected', function(eventData) {
+ if (eventData !== undefined) {
+ // convert the array of objects to object of arrays so this converts
+ // to data frame in R as opposed to a vector
+ var pts = eventData.points;
+ var obj = {
+ curveNumber: pts.map(function(pt) {return pt.curveNumber; }),
+ pointNumber: pts.map(function(pt) {return pt.pointNumber; }), 
+ x: pts.map(function(pt) {return pt.x; }),
+ y: pts.map(function(pt) {return pt.y; })
+ };
+ grp.var("plotly_selected").set(obj);
+ }
+ }); 
+
  }
 
 });

.travis.yml

@@ -28,8 +28,10 @@ before_script:
  - git clone https://github.com/cpsievert/plotly-test-table.git ../plotly-test-table
  - "wget -q -O - https://github.com/yihui/crandalf/raw/master/inst/scripts/install-pandoc | bash"
  - Rscript -e 'if (length(find.package("devtools", quiet = TRUE)) == 0L) { install.packages("devtools", repos = "http://cran.rstudio.com") }'
- - Rscript -e 'library(devtools);update_packages("devtools", repos = "http://cran.rstudio.com")'
- - Rscript -e 'library(devtools);install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::update_packages("devtools", repos = "http://cran.rstudio.com")'
+ - Rscript -e 'devtools::install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::install_github("rstudio/crosstalk")'
+ - Rscript -e 'devtools::install_github("cpsievert/htmlwidgets")'
 
 script:
  # run R CMD check on the non-pull request build

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 = FALSE, 
- evaluate = FALSE) {
+ group, color, colors, symbol, symbols, size,
+key, set = "A", width = NULL, height = NULL, 
+inherit = FALSE, 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,
  ...
  )
 }

R/shiny.R

@@ -7,6 +7,8 @@
 #' @param width,height Must be a valid CSS unit (like \code{"100\%"},
 #' \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
 #' string and have \code{"px"} appended.
+#' @param inline use an inline (\code{span()}) or block container 
+#' (\code{div()}) for the output
 #' @param expr An expression that generates a plotly
 #' @param env The environment in which to evaluate \code{expr}.
 #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This 
@@ -17,8 +19,16 @@
 #' @name plotly-shiny
 #'
 #' @export
-plotlyOutput <- function(outputId, width = "100%", height = "400px") {
- htmlwidgets::shinyWidgetOutput(outputId, "plotly", width, height, package = "plotly")
+plotlyOutput <- function(outputId, width = "100%", height = "400px", 
+ inline = FALSE) {
+ htmlwidgets::shinyWidgetOutput(
+ outputId = outputId, 
+ name = "plotly", 
+ width = width, 
+ height = height, 
+ inline = inline, 
+ package = "plotly"
+ )
 }
 
 #' @rdname plotly-shiny

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/plotly.js

@@ -1,12 +1,14 @@
+
 HTMLWidgets.widget({
  name: "plotly",
  type: "output",
 
- initialize: function(el, width, height){
+ initialize: function(el, width, height){
  return {};
  },
 
  resize: function(el, width, height, instance) {
+ // TODO: impose fixed coordinates, if specified (see #342)
  Plotly.relayout(el.id, {width: width, height: height});
  }, 
 
@@ -15,13 +17,57 @@ HTMLWidgets.widget({
  window.PLOTLYENV = window.PLOTLYENV || {};
  window.PLOTLYENV.BASE_URL = x.base_url;
 
+ var graphDiv = document.getElementById(el.id);
+
  // if no plot exists yet, create one with a particular configuration
  if (!instance.plotly) {
- Plotly.plot(el.id, x.data, x.layout, x.config);
+ Plotly.plot(graphDiv, x.data, x.layout, x.config);
  instance.plotly = true;
  } else {
- Plotly.newPlot(el.id, x.data, x.layout);
+ Plotly.newPlot(graphDiv, x.data, x.layout);
  }
+
+ var g = x.data[0].set;
+ var grp = crosstalk.group(g);
+
+ graphDiv.on('plotly_click', function(eventData) {
+ // extract only the data we may want to access in R
+ var d = eventData.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);
+ });
+
+ graphDiv.on('plotly_selected', function(eventData) {
+ if (eventData !== undefined) {
+ // convert the array of objects to object of arrays so this converts
+ // to data frame in R as opposed to a vector
+ var pts = eventData.points;
+ var obj = {
+ curveNumber: pts.map(function(pt) {return pt.curveNumber; }),
+ pointNumber: pts.map(function(pt) {return pt.pointNumber; }), 
+ x: pts.map(function(pt) {return pt.x; }),
+ y: pts.map(function(pt) {return pt.y; })
+ };
+ grp.var("plotly_selected").set(obj);
+ }
+ }); 
+
  }
 
 });

.travis.yml

@@ -28,8 +28,10 @@ before_script:
  - git clone https://github.com/cpsievert/plotly-test-table.git ../plotly-test-table
  - "wget -q -O - https://github.com/yihui/crandalf/raw/master/inst/scripts/install-pandoc | bash"
  - Rscript -e 'if (length(find.package("devtools", quiet = TRUE)) == 0L) { install.packages("devtools", repos = "http://cran.rstudio.com") }'
- - Rscript -e 'library(devtools);update_packages("devtools", repos = "http://cran.rstudio.com")'
- - Rscript -e 'library(devtools);install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::update_packages("devtools", repos = "http://cran.rstudio.com")'
+ - Rscript -e 'devtools::install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::install_github("rstudio/crosstalk")'
+ - Rscript -e 'devtools::install_github("cpsievert/htmlwidgets")'
 
 script:
  # run R CMD check on the non-pull request build

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 = FALSE, 
- evaluate = FALSE) {
+ group, color, colors, symbol, symbols, size,
+key, set = "A", width = NULL, height = NULL, 
+inherit = FALSE, 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,
  ...
  )
 }

R/shiny.R

@@ -7,6 +7,8 @@
 #' @param width,height Must be a valid CSS unit (like \code{"100\%"},
 #' \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
 #' string and have \code{"px"} appended.
+#' @param inline use an inline (\code{span()}) or block container 
+#' (\code{div()}) for the output
 #' @param expr An expression that generates a plotly
 #' @param env The environment in which to evaluate \code{expr}.
 #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This 
@@ -17,8 +19,16 @@
 #' @name plotly-shiny
 #'
 #' @export
-plotlyOutput <- function(outputId, width = "100%", height = "400px") {
- htmlwidgets::shinyWidgetOutput(outputId, "plotly", width, height, package = "plotly")
+plotlyOutput <- function(outputId, width = "100%", height = "400px", 
+ inline = FALSE) {
+ htmlwidgets::shinyWidgetOutput(
+ outputId = outputId, 
+ name = "plotly", 
+ width = width, 
+ height = height, 
+ inline = inline, 
+ package = "plotly"
+ )
 }
 
 #' @rdname plotly-shiny

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/plotly.js

@@ -1,12 +1,14 @@
+
 HTMLWidgets.widget({
  name: "plotly",
  type: "output",
 
- initialize: function(el, width, height){
+ initialize: function(el, width, height){
  return {};
  },
 
  resize: function(el, width, height, instance) {
+ // TODO: impose fixed coordinates, if specified (see #342)
  Plotly.relayout(el.id, {width: width, height: height});
  }, 
 
@@ -15,13 +17,57 @@ HTMLWidgets.widget({
  window.PLOTLYENV = window.PLOTLYENV || {};
  window.PLOTLYENV.BASE_URL = x.base_url;
 
+ var graphDiv = document.getElementById(el.id);
+
  // if no plot exists yet, create one with a particular configuration
  if (!instance.plotly) {
- Plotly.plot(el.id, x.data, x.layout, x.config);
+ Plotly.plot(graphDiv, x.data, x.layout, x.config);
  instance.plotly = true;
  } else {
- Plotly.newPlot(el.id, x.data, x.layout);
+ Plotly.newPlot(graphDiv, x.data, x.layout);
  }
+
+ var g = x.data[0].set;
+ var grp = crosstalk.group(g);
+
+ graphDiv.on('plotly_click', function(eventData) {
+ // extract only the data we may want to access in R
+ var d = eventData.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);
+ });
+
+ graphDiv.on('plotly_selected', function(eventData) {
+ if (eventData !== undefined) {
+ // convert the array of objects to object of arrays so this converts
+ // to data frame in R as opposed to a vector
+ var pts = eventData.points;
+ var obj = {
+ curveNumber: pts.map(function(pt) {return pt.curveNumber; }),
+ pointNumber: pts.map(function(pt) {return pt.pointNumber; }), 
+ x: pts.map(function(pt) {return pt.x; }),
+ y: pts.map(function(pt) {return pt.y; })
+ };
+ grp.var("plotly_selected").set(obj);
+ }
+ }); 
+
  }
 
 });

.travis.yml

@@ -28,8 +28,10 @@ before_script:
  - git clone https://github.com/cpsievert/plotly-test-table.git ../plotly-test-table
  - "wget -q -O - https://github.com/yihui/crandalf/raw/master/inst/scripts/install-pandoc | bash"
  - Rscript -e 'if (length(find.package("devtools", quiet = TRUE)) == 0L) { install.packages("devtools", repos = "http://cran.rstudio.com") }'
- - Rscript -e 'library(devtools);update_packages("devtools", repos = "http://cran.rstudio.com")'
- - Rscript -e 'library(devtools);install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::update_packages("devtools", repos = "http://cran.rstudio.com")'
+ - Rscript -e 'devtools::install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::install_github("rstudio/crosstalk")'
+ - Rscript -e 'devtools::install_github("cpsievert/htmlwidgets")'
 
 script:
  # run R CMD check on the non-pull request build

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 = FALSE, 
- evaluate = FALSE) {
+ group, color, colors, symbol, symbols, size,
+key, set = "A", width = NULL, height = NULL, 
+inherit = FALSE, 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,
  ...
  )
 }

R/shiny.R

@@ -7,6 +7,8 @@
 #' @param width,height Must be a valid CSS unit (like \code{"100\%"},
 #' \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
 #' string and have \code{"px"} appended.
+#' @param inline use an inline (\code{span()}) or block container 
+#' (\code{div()}) for the output
 #' @param expr An expression that generates a plotly
 #' @param env The environment in which to evaluate \code{expr}.
 #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This 
@@ -17,8 +19,16 @@
 #' @name plotly-shiny
 #'
 #' @export
-plotlyOutput <- function(outputId, width = "100%", height = "400px") {
- htmlwidgets::shinyWidgetOutput(outputId, "plotly", width, height, package = "plotly")
+plotlyOutput <- function(outputId, width = "100%", height = "400px", 
+ inline = FALSE) {
+ htmlwidgets::shinyWidgetOutput(
+ outputId = outputId, 
+ name = "plotly", 
+ width = width, 
+ height = height, 
+ inline = inline, 
+ package = "plotly"
+ )
 }
 
 #' @rdname plotly-shiny

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/plotly.js

@@ -1,12 +1,14 @@
+
 HTMLWidgets.widget({
  name: "plotly",
  type: "output",
 
- initialize: function(el, width, height){
+ initialize: function(el, width, height){
  return {};
  },
 
  resize: function(el, width, height, instance) {
+ // TODO: impose fixed coordinates, if specified (see #342)
  Plotly.relayout(el.id, {width: width, height: height});
  }, 
 
@@ -15,13 +17,57 @@ HTMLWidgets.widget({
  window.PLOTLYENV = window.PLOTLYENV || {};
  window.PLOTLYENV.BASE_URL = x.base_url;
 
+ var graphDiv = document.getElementById(el.id);
+
  // if no plot exists yet, create one with a particular configuration
  if (!instance.plotly) {
- Plotly.plot(el.id, x.data, x.layout, x.config);
+ Plotly.plot(graphDiv, x.data, x.layout, x.config);
  instance.plotly = true;
  } else {
- Plotly.newPlot(el.id, x.data, x.layout);
+ Plotly.newPlot(graphDiv, x.data, x.layout);
  }
+
+ var g = x.data[0].set;
+ var grp = crosstalk.group(g);
+
+ graphDiv.on('plotly_click', function(eventData) {
+ // extract only the data we may want to access in R
+ var d = eventData.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);
+ });
+
+ graphDiv.on('plotly_selected', function(eventData) {
+ if (eventData !== undefined) {
+ // convert the array of objects to object of arrays so this converts
+ // to data frame in R as opposed to a vector
+ var pts = eventData.points;
+ var obj = {
+ curveNumber: pts.map(function(pt) {return pt.curveNumber; }),
+ pointNumber: pts.map(function(pt) {return pt.pointNumber; }), 
+ x: pts.map(function(pt) {return pt.x; }),
+ y: pts.map(function(pt) {return pt.y; })
+ };
+ grp.var("plotly_selected").set(obj);
+ }
+ }); 
+
  }
 
 });

.travis.yml

@@ -28,8 +28,10 @@ before_script:
  - git clone https://github.com/cpsievert/plotly-test-table.git ../plotly-test-table
  - "wget -q -O - https://github.com/yihui/crandalf/raw/master/inst/scripts/install-pandoc | bash"
  - Rscript -e 'if (length(find.package("devtools", quiet = TRUE)) == 0L) { install.packages("devtools", repos = "http://cran.rstudio.com") }'
- - Rscript -e 'library(devtools);update_packages("devtools", repos = "http://cran.rstudio.com")'
- - Rscript -e 'library(devtools);install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::update_packages("devtools", repos = "http://cran.rstudio.com")'
+ - Rscript -e 'devtools::install_deps(repos = "http://cran.rstudio.com", dependencies = TRUE)'
+ - Rscript -e 'devtools::install_github("rstudio/crosstalk")'
+ - Rscript -e 'devtools::install_github("cpsievert/htmlwidgets")'
 
 script:
  # run R CMD check on the non-pull request build

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 = FALSE, 
- evaluate = FALSE) {
+ group, color, colors, symbol, symbols, size,
+key, set = "A", width = NULL, height = NULL, 
+inherit = FALSE, 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,
  ...
  )
 }

R/shiny.R

@@ -7,6 +7,8 @@
 #' @param width,height Must be a valid CSS unit (like \code{"100\%"},
 #' \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
 #' string and have \code{"px"} appended.
+#' @param inline use an inline (\code{span()}) or block container 
+#' (\code{div()}) for the output
 #' @param expr An expression that generates a plotly
 #' @param env The environment in which to evaluate \code{expr}.
 #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This 
@@ -17,8 +19,16 @@
 #' @name plotly-shiny
 #'
 #' @export
-plotlyOutput <- function(outputId, width = "100%", height = "400px") {
- htmlwidgets::shinyWidgetOutput(outputId, "plotly", width, height, package = "plotly")
+plotlyOutput <- function(outputId, width = "100%", height = "400px", 
+ inline = FALSE) {
+ htmlwidgets::shinyWidgetOutput(
+ outputId = outputId, 
+ name = "plotly", 
+ width = width, 
+ height = height, 
+ inline = inline, 
+ package = "plotly"
+ )
 }
 
 #' @rdname plotly-shiny

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/plotly.js

@@ -1,12 +1,14 @@
+
 HTMLWidgets.widget({
  name: "plotly",
  type: "output",
 
- initialize: function(el, width, height){
+ initialize: function(el, width, height){
  return {};
  },
 
  resize: function(el, width, height, instance) {
+ // TODO: impose fixed coordinates, if specified (see #342)
  Plotly.relayout(el.id, {width: width, height: height});
  }, 
 
@@ -15,13 +17,57 @@ HTMLWidgets.widget({
  window.PLOTLYENV = window.PLOTLYENV || {};
  window.PLOTLYENV.BASE_URL = x.base_url;
 
+ var graphDiv = document.getElementById(el.id);
+
  // if no plot exists yet, create one with a particular configuration
  if (!instance.plotly) {
- Plotly.plot(el.id, x.data, x.layout, x.config);
+ Plotly.plot(graphDiv, x.data, x.layout, x.config);
  instance.plotly = true;
  } else {
- Plotly.newPlot(el.id, x.data, x.layout);
+ Plotly.newPlot(graphDiv, x.data, x.layout);
  }
+
+ var g = x.data[0].set;
+ var grp = crosstalk.group(g);
+
+ graphDiv.on('plotly_click', function(eventData) {
+ // extract only the data we may want to access in R
+ var d = eventData.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);
+ });
+
+ graphDiv.on('plotly_selected', function(eventData) {
+ if (eventData !== undefined) {
+ // convert the array of objects to object of arrays so this converts
+ // to data frame in R as opposed to a vector
+ var pts = eventData.points;
+ var obj = {
+ curveNumber: pts.map(function(pt) {return pt.curveNumber; }),
+ pointNumber: pts.map(function(pt) {return pt.pointNumber; }), 
+ x: pts.map(function(pt) {return pt.x; }),
+ y: pts.map(function(pt) {return pt.y; })
+ };
+ grp.var("plotly_selected").set(obj);
+ }
+ }); 
+
  }
 
 });