making plotly subplots using crosstalk SharedData object

I would like to make plotly subplots using a crosstalk::SharedData object in R. I can think of 2 ways to approach this:

1. use plotly::ggplotly() on a faceted ggplot
2. create each subplot directly with plotly using dplyr::group_map() on a grouped dataframe and pass the list of subplots to plotly::subplot().

Problems with the first approach:

• ggplot2::facet_grid() blocks off space for all facet levels, even if they're filtered out the data (see image below).
• I prefer making the plots directly in plotly because complex plots don't convert from ggplot to plotly very nicely.

Problems with the second approach:

• I don't know how to do this successfully. I can't directly pass a crosstalk::SharedData object to dplyr functions like group_by. The documentation for crosstalk makes it sound like I can extract the filtered data using shared_data$data(withFilter = TRUE), but doing so returns all the data regardless of the filter condition.

Here's what I end up with

code:

---
title: "test_crosstalk"
format: html
---

```{r}
#| echo: false
#| warning: false

data(mtcars)

library(tidyverse)
library(plotly)
library(crosstalk)
```

# create plots

```{r}

# create a SharedData object
sd <- crosstalk::SharedData$new(data = mtcars)

crosstalk::bscols(
  widths = c(12, # put the filter on its own row
             6, 6,
             6, 6), 
  # create an interactive filter checkbox
  crosstalk::filter_checkbox(
    id = "cyl",
    label = "Filter Cylinders",
    sharedData = sd,
    group = ~cyl, 
    inline = TRUE
  ),
  # ggplotly
  plotly::ggplotly(ggplot(data = sd, 
                          mapping = aes(x = hp, 
                                        y = qsec, 
                                        color = factor(cyl), 
                                        group = factor(cyl))) + 
                     geom_point()  + 
                     ggtitle("ggplotly") +
                     facet_grid(rows = dplyr::vars(cyl), drop = T)
                   ),
  # plotly with subplots
  # can't directly use dplyr functions (like group_by) on a SharedData object, so pull the (supposedly filtered) data out of the SharedData object first
  sd$data(withFilter = T) %>%
    dplyr::group_by(cyl) %>%
    dplyr::group_map(~{
      plotly::plot_ly(
        data = .x,
        x = ~hp,
        y = ~qsec,
        type = "scatter",
        mode = "markers"
      )
    }) %>%
    do.call(what = function(...){
            plotly::subplot(...,
                            nrows  = length(unique(sd$data(withFilter = T)$cyl)),
                            shareX = TRUE,
                            shareY = TRUE,
                            margin = 0.0025 # this controls the internal margins
                            )},
            args = .) %>% 
    plotly::layout(title = 'Plotly with sd$data(withFilter=T)'),
  # a plotly plot with crosstalk filtering, but w/o faceting
  plotly::plot_ly(
    data = sd,
    x = ~hp,
    y = ~qsec,
    color = ~factor(cyl),
    type = "scatter",
    mode = "markers"
  ) %>% 
    plotly::layout(title = 'Plotly w/o faceting'),
  # a plotly plot with faceting, but w/o crosstalk filtering
  mtcars %>%
    dplyr::group_by(cyl) %>%
    dplyr::group_map(~{
      plotly::plot_ly(
        data = .x,
        x = ~hp,
        y = ~qsec,
        # color = ~cyl,
        type = "scatter",
        mode = "markers"
      )
    }) %>% 
    do.call(what = function(...){
            plotly::subplot(..., 
                            nrows  = length(unique(mtcars$cyl)), 
                            shareX = TRUE, 
                            shareY = TRUE,
                            margin = 0.025 # this controls the internal margins
                            )},
            args = .) %>% 
    plotly::layout(title = 'Plotly without crosstalk filtering')
  )


```

(A generalization of this question is how to use dplyr functions, like dplyr::filter or dplyr::group_by() on a crosstalk::SharedData object.)

You can dplyr::filter the sharedData and create a new sharedData for each subplot like this - not sure, what the crosstalk is usefull though here other than skipping shiny, but plotly also allows for interactive filtering.

Code

library(tidyverse)
library(plotly)
library(crosstalk)

create_crosstalk_subplots <- function(shared_data, facet_var) {
  facet_values <- unique(shared_data$origData()[[facet_var]])
  
  divs <- lapply(facet_values, function(val) {
    data_subset <- shared_data$origData()[shared_data$origData()[[facet_var]] == val, ]
    
    sub_sd <- SharedData$new(
      data_subset,
      key = ~row.names(data_subset),
      group = shared_data$groupName()
    )
    plot_ly(
      data = sub_sd,
      x = ~hp, 
      y = ~qsec,
      type = "scatter",
      mode = "markers",
      text = ~rownames(data_subset)
    ) %>%
      layout(
        title = paste("cyl =", val),
        showlegend = FALSE
      )
  })
  
  subplot(
    divs,
    nrows = length(facet_values),
    shareX = TRUE,
    shareY = TRUE,
    titleY = TRUE,
    margin = 0.05
  ) %>%
    layout(
      title = paste('Plotly Subplots with Crosstalk Filtering by', facet_var),
      showlegend = FALSE
    )
  
}

# create a SharedData object
sd <- crosstalk::SharedData$new(data = mtcars)

bscols(
  widths = c(12, 12),
  filter_checkbox(
    id = "cyl_alt",
    label = "Filter Cylinders",
    sharedData = sd,
    group = ~cyl,
    inline = TRUE
  ),
  create_crosstalk_subplots(sd, "cyl")
)