diff --git a/.travis.yml b/.travis.yml index 607eea7548..8f7d5c91fa 100644 --- a/.travis.yml +++ b/.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 diff --git a/DESCRIPTION b/DESCRIPTION index 4809a22080..f4217412f3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,6 +30,7 @@ Imports: viridis, base64enc, htmlwidgets, + crosstalk, plyr Suggests: dplyr, diff --git a/R/plotly.R b/R/plotly.R index 0d6e3d1a9b..9fcffeaff2 100644 --- a/R/plotly.R +++ b/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, diff --git a/R/print.R b/R/print.R index ff4c507d63..1d279f50c5 100644 --- a/R/print.R +++ b/R/print.R @@ -49,6 +49,7 @@ as.widget <- function(x, ...) { padding = 5, browser.fill = TRUE ), + dependencies = crosstalk::dependencies, ... ) } diff --git a/R/shiny.R b/R/shiny.R index 57710dce83..174a0ed399 100644 --- a/R/shiny.R +++ b/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 diff --git a/inst/examples/crosstalk.R b/inst/examples/crosstalk.R new file mode 100644 index 0000000000..eb464b238d --- /dev/null +++ b/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) +)) diff --git a/inst/htmlwidgets/plotly.js b/inst/htmlwidgets/plotly.js index 2c4f18e6e3..90411246f5 100644 --- a/inst/htmlwidgets/plotly.js +++ b/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); + } + }); + } }); diff --git a/man/plotly-shiny.Rd b/man/plotly-shiny.Rd index 231c5ae473..7893301eb5 100644 --- a/man/plotly-shiny.Rd +++ b/man/plotly-shiny.Rd @@ -6,7 +6,7 @@ \alias{renderPlotly} \title{Shiny bindings for plotly} \usage{ -plotlyOutput(outputId, width = "100\%", height = "400px") +plotlyOutput(outputId, width = "100\%", height = "400px", inline = FALSE) renderPlotly(expr, env = parent.frame(), quoted = FALSE) } @@ -17,6 +17,9 @@ renderPlotly(expr, env = parent.frame(), quoted = FALSE) \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a string and have \code{"px"} appended.} +\item{inline}{use an inline (\code{span()}) or block container +(\code{div()}) for the output} + \item{expr}{An expression that generates a plotly} \item{env}{The environment in which to evaluate \code{expr}.}