Plotly legendgroup for subplots so a single legend controls all charts

Question

I'm using plotly in r to generate a number of subplots. A toy example is shown below.

library(shiny)
library(dplyr)
library(plotly)

## Toy Example
ui <- fluidPage(
  h3("Diamonds"),
  plotlyOutput("plot", height = 600)
)

server <- function(input, output, session) {

  # reduce down the dataset to make the example simpler
  dat <- diamonds %>% 
    filter(clarity %in% c("I1", "IF")) %>%
    mutate(clarity = factor(clarity, levels = c("I1", "IF")))

  output$plot <- renderPlotly({

    # Generates the chart for a single clarity
    byClarity <- function(df){

      Clarity <- df$clarity[1];

      plot_ly(df, x = ~carat, y = ~price, color = ~cut, name = ~clarity) %>%
        add_trace(
          type="bar"
          ## Also tried adding this with no success
          # legendgroup = ~cut
        ) %>%
        layout(
          barmode = "stack"
        )
    }

    dat %>% 
      split(.$clarity) %>% 
      lapply(byClarity) %>%
      subplot(nrows = NROW(.), shareX = TRUE, which_layout = "merge")
  })
} 

shinyApp(ui, server)

I would like to make the legends such that clicking on a 'Cut' on the legend will show/hide that 'Cut' from both charts instead of just the chart associated with that legend.

I looked at legendgroup but can't figure out how to associate it with cut instead of clarity (clarity is the grouping I'm using to make the subplots).

I also need the solution to work with raw plot_ly and not ggplotly as there are other plot_ly functionalities I need that aren't available in ggplotly.

Any help would be appreciated. I am using plotly_4.5.2, dplyr_0.5.0, and shiny_0.14.

Answer 1

Ok, here is a solution using ggplot2:

library(ggplot2)
library(dplyr)
library(plotly)
dat <- diamonds %>% 
  filter(clarity %in% c("I1", "IF")) %>%
  mutate(clarity = factor(clarity, levels = c("I1", "IF")))
# Function for nice labels
k_label <- function(x) {
 c(0, paste0((x)/1000,"K")[-1])
}
# ggplot
p <- ggplot(dat,aes(x=carat, y=price, fill=cut)) + 
           geom_bar(stat="identity") + 
           facet_wrap(~clarity,nrow=2, scales = "free_y") +
           scale_y_continuous(labels = k_label) + 
           theme_minimal() + ylab("") + xlab("") +
           theme(legend.title=element_blank(),
                 panel.grid.major.x=element_blank())
# a plotly
ggplotly(p)