Using Crosstalk to filter multiple Plotly/GGplotly figures

[arifyali]

In shiny, I've built a heatmap using plotly. When you click on a cell in the heatmaps, it subsets the source dataframe and feeds that subset into two additional ggplots (converted to ggplotly via plotly). I'm trying convert this process to an HTML Doc in RMarkdown that can be emailed.
Outside of using subplot, is there an example of crosstalk where a click event from one plot can filter data for other plots or is this too interactive to pull off within an RMD file?

[cpsievert]

Crosstalk wasn't really designed to support raster graphics, but it's possible you could hack something together with it. Specifically, I'm thinking you could place invisible markers on each cell to trigger the crosstalk event, but even in that case, it could be that the updating logic doesn't quite do exactly what you want. I'd need to know about what you want to happen in these filtered graph to know for sure.

Anyway, adding a bit of custom JavaScript would be more flexible, and may be a better way to go. Here is an example that draws a scatterplot in response to a click on a correlation heatmap. It leverages the customdata attribute which effectively allows you attach 'metadata' to graphical elements (i.e. cells) and retrieve that information in a plotly.js event like "plotly_click". You could use this attribute to attach the (pre-filtered) data to show when the cell is clicked. In this example, I'm using it to effectively attach the x/y data that corresponds to each cell of the heatmap.

library(plotly)
library(htmltools)
library(htmlwidgets)

# compute correlation matrix
correlation <- round(cor(mtcars), 3)

customdata <- setNames(lapply(mtcars, function(var) {
  setNames(lapply(mtcars, function(var2) {
    list(x = var, y = var2)
  }), NULL)
}), NULL)

p <- plot_ly() %>%
  add_heatmap(
    x = names(mtcars), 
    y = names(mtcars), 
    z = correlation,
    customdata = customdata
  ) %>%
  onRender(
    "function(el, x) {
       el.on('plotly_click', function(d) {
          var cdata = d.points[0].customdata;
          cdata.mode = 'markers';
          cdata.type = 'scattergl';
          Plotly.newPlot('filtered-plot', [cdata]);
       })
    }"
  )

browsable(tagList(p,
  tags$div(id = 'filtered-plot')
))

It's worth noting that, even though on the R side z is a matrix and customdata is a list, they are both 2D arrays on the JavaScript side (in this case, an array of length 11 where each element is an array of length 11). When you implement this on your own, it's important to match up those dimenstions.

Update: I recently realized it would be better to not use customdata at all and do similar to this:

library(plotly)
library(htmltools)

nms <- names(mtcars)

p <- plot_ly(d, colors = "RdBu") %>%
  add_heatmap(
    x = nms, 
    y = nms, 
    z = ~round(cor(mtcars), 3)
  ) %>%
  onRender("
    function(el) {
      Plotly.d3.json('mtcars.json', function(mtcars) {
        el.on('plotly_click', function(d) {
          var x = d.points[0].x;
          var y = d.points[0].y;
          var trace = {
            x: mtcars[x],
            y: mtcars[y],
            mode: 'markers'
          };
          Plotly.newPlot('filtered-plot', [trace]);
        });
      });
    }
")


# In a temporary directory, save the mtcars dataset as json and
# the html to an index.html file, then open via a web server
withr::with_path(tempdir(), {
  jsonlite::write_json(as.list(mtcars), "mtcars.json")
  html <- tagList(p, tags$div(id = 'filtered-plot'))
  save_html(html, "index.html")
  if (interactive()) servr::httd()
})