R plotly separate functional legends

Question

I want to produce a plot via R plotly with independent legends while respecting the colorscale.

This is what I have:

library(plotly)

X <- data.frame(xcoord = 1:6,
                ycoord = 1:6,
                score  = 1:6,
                gender = c("M", "M", "M", "F", "F", "F"),
                age = c("young", "old", "old", "old", "young", "young"))

plot_ly(data = X, x = ~xcoord, y = ~ycoord, split = ~interaction(age, gender),
        type = "scatter", mode = "markers",
        marker = list(color = ~score,
                      colorbar = list(len = .5, y = .3)))

This is the outcome:

As you can see, the colorbar is messed up and the two categories are entangled.

I need to have separate legends for age (young vs old) and gender (M vs F), that can be clicked independently from one another. This would be the expected outcome:

---

Edit 1
This is the equivalent with ggplot2:

gg <- ggplot(X, aes(x = xcoord, y = ycoord)) +
  geom_point(aes(color = score, shape = gender, alpha = age), size = 5) +
  scale_shape_manual(values = c("M" = 19, "F" = 19)) +
  scale_alpha_manual(values = c("young" = 1, "old" = 1))

ggplotly(gg)

It does display correctly in ggplot, but breaks when applying ggplotly().

Please note that I would favor a solution with the native plotly plot, rather than a post hoc ggplotly() fix as has been proposed in other posts.

---

Edit 2
Although the current answers do disentangle the two legends (age and gender), they are not functional. For instance, if you click on the young level, the whole age legend will be toggled on/off. The objective here is that each sub level of each legend can be toggled independently from the others, and that by clicking on the legend's levels, the dot will show/hide accordingly.

Answer 1

Plotly does not seem to easily support this, since different guides are linked to multiple traces. So deselecting e.g. "old" on an "Age" trace will not remove anything from the separate set of points from the "Gender" trace.

This is a workaround using crosstalk and a SharedData data object. Instead of (de)selecting plotly traces, this uses filters on the dataset that is used by plotly. It technically achieves the selection behaviour that is requested, but whether or not it is a working solution depends on the final application. There are likely ways to adjust the styling and layout to make it more plotly-ish, if the mechanism works for you.

library(crosstalk)

#SharedData object used for filters and plot
shared <- SharedData$new(X) 

crosstalk::bscols(
  widths = c(2, 10),
   list(
     crosstalk::filter_checkbox("Age", 
                                label = "Age",
                                sharedData = shared, 
                                group = ~age),
     crosstalk::filter_checkbox("Gender", 
                                label = "Gender",
                                sharedData = shared, 
                                group = ~gender)
   ),
   plot_ly(data = shared, x = ~xcoord, y = ~ycoord,
           type = "scatter", mode = "markers",
           marker = list(color = ~score,
                         colorbar = list(len = .5, y = .3),
                         cmin = 0, cmax = 6)) %>%
    layout(
      xaxis = list(range=c(.5,6.5)),
      yaxis = list(range=c(.5,6.5))
    )
   )

Edit: initialize all checkboxes as "checked"

I only managed to do this by modifying the output HTML tags. This produces the same plot, but has all boxes checked at the beginning.

out <- crosstalk::bscols(...) #previous output object

library(htmltools)
out_tags <- htmltools::renderTags(out)

#check all Age and Gender checkboxes
out_tags$html <- stringr::str_replace_all(
  out_tags$html, 
  '(<input type="checkbox" name="(Age|Gender)" value=".*")/>',
  '\\1 checked="checked"/>'
)
out_tags$html <- HTML(out_tags$html)
# view in RStudio Viewer
browsable(as.tags(out_tags))
#or from Rmd chunk
as.tags(out_tags)

Answer 2

This isn't exactly what you're looking for. I was able to create a meaningful color bar, though.

I removed the call for interaction between the groups and created a separate trace. Then I created legend groups and named them to create separate legends for gender and age. When I pull color = out of the call to create a colorbar, this synced the color scales.

However, it assigns colors to the labels for age and gender and that's not meaningful! There are a few things that don't line up with your request, but someone may be able to build on this information.

plot_ly(data = X, x = ~xcoord, y = ~ycoord, 
        split = ~age,
        legendgroup = 'age', # create first split and name it
        legendgrouptitle = list(text = "Age"),
        type = "scatter", mode = "markers",
        color = ~score,
        marker = list(colorbar = list(len = .5, y = .3))) %>% 
  add_trace(split = ~gender,
            legendgroup = 'gender', # create second split and name it
            color = ~score,
            legendgrouptitle = list(text = "Gender")) %>% 
    colorbar(title = 'Score')

Answer 3

I am not sure if this is exactly what you want. I tried to made the legends for age and gender using two markers. The legends are independently clickable, but I am not sure if this is the way you want them to have clickable. It is also possible to click on the colorbar. You can use this code:

library(tidyverse)
library(plotly)
plot_ly() %>%
  add_markers(data = X,
            x = ~xcoord, 
            y = ~ycoord, 
            type = "scatter", 
            mode = "markers",
            #name = "M",
            color = I("grey"),
            split = ~gender,
            legendgroup = 'gender', 
            legendgrouptitle = list(text = "Gender")) %>%
  add_markers(data = X,
              x = ~xcoord, 
              y = ~ycoord, 
              type = "scatter", 
              mode = "markers",
              #name = "M",
              color = I("grey"),
              split = ~age,
              legendgroup = 'age', 
              legendgrouptitle = list(text = "Age")) %>%
  add_trace(data = X,
            x = ~xcoord, 
            y = ~ycoord, 
            type = "scatter", 
            mode = "markers",
            name = "",
            marker = list(color = ~score,
                          colorbar = list(len = .5, y = .3)))

The output looks like this: