plotly drops grouped legend (by color, by symbol) when converted from ggplot

I don't quite understand why the legend disappeared when I converted a plot made by ggplot to plotly using ggplotly. The plotly help page did not have any information. I don't think their examples even worked properly on that page.
Any help is greatly appreciated!

Sample data

library(scales)
packageVersion("ggplot2")
#> [1] '3.4.0'
library(plotly)
packageVersion("plotly")
#> [1] '4.10.1'

data <- data.frame(
  stringsAsFactors = FALSE,
  Level = c("Fast","Fast","Fast","Fast",
            "Fast","Fast","Slow","Slow","Slow",
            "Slow","Slow","Slow"),
  Period = c("1Year","3Month","1Year","3Month",
             "1Year","3Month","1Year","3Month",
             "1Year","3Month","1Year","3Month"),
  X = c(0.002,0.002,0.1,0.1,0.9,0.9,
        0.002,0.002,0.1,0.1,0.9,0.9),
  Y = c(1.38,1.29,1.61,1.61,1.74,0.98,
        1.14,0.97,1.09,1.1,0.94,0.58)
)

ggplot2

plt <- ggplot(data = data,
             aes(x = X,
                 y = Y,
                 shape = Period,
                 color = Level)) +
  geom_point(alpha = 0.6, size = 3) +
  labs(x = " ",
       y = "Value") +
  scale_y_continuous(labels = number_format(accuracy = 0.1)) +
  guides(color = guide_legend(title = "Level", order = 1),
         shape = guide_legend(title = "Period", order = 2)) +
  theme(axis.text.x = element_text(angle = 90))
plt

<!-- -->

Convert to plotly, legend disappeared

ggplotly(plt, height = 500) %>%
  layout(xaxis = list(autorange = "reversed"))

<!-- -->

Edit

There was an issue with guides(). If I removed it, the legend in ggplotly showed up

plt2 <- ggplot(data = data,
             aes(x = X,
                 y = Y,
                 shape = Period,
                 color = Level)) +
  geom_point(alpha = 0.6, size = 3) +
  labs(x = " ",
       y = "Value") +
  scale_y_continuous(labels = number_format(accuracy = 0.1)) +
  theme(axis.text.x = element_text(angle = 90))
plt2

ggplotly(plt2, height = 500) %>%
  layout(
    xaxis = list(autorange = "reversed"),
    legend = list(
      title = list(text = '(Period, Level)'))
  )

<!-- -->

After OPs Edit:

Here is a workaround using basic R {plotly} to modify the legend according to @Tung's requirements:

library(scales)
library(ggplot2)
library(plotly)
library(data.table)
DT <- data.frame(
stringsAsFactors = FALSE,
Level = c("Fast","Fast","Fast","Fast",
"Fast","Fast","Slow","Slow","Slow",
"Slow","Slow","Slow"),
Period = c("1Year","3Month","1Year","3Month",
"1Year","3Month","1Year","3Month",
"1Year","3Month","1Year","3Month"),
X = c(0.002,0.002,0.1,0.1,0.9,0.9,
0.002,0.002,0.1,0.1,0.9,0.9),
Y = c(1.38,1.29,1.61,1.61,1.74,0.98,
1.14,0.97,1.09,1.1,0.94,0.58)
)
setDT(DT)
LevelDT <- unique(DT, by = "Level")
PeriodDT <- unique(DT, by = "Period")
LevelDT[, Y := min(DT$Y)-1]
PeriodDT[, Y := min(DT$Y)-1]
plt2 <- ggplot(data = DT,
aes(x = X,
y = Y,
shape = Period,
color = Level)) +
geom_point(alpha = 0.6, size = 3) +
labs(x = " ",
y = "Value") +
scale_y_continuous(labels = number_format(accuracy = 0.1)) +
theme(axis.text.x = element_text(angle = 90))
plt2
markercolors <- hue_pal()(2)
ggplotly(plt2, height = 500) |>
layout(
xaxis = list(autorange = "reversed"),
legend = list(
title = list(text = ''),
itemclick = FALSE,
itemdoubleclick = FALSE,
groupclick = FALSE
)
) |>
add_trace(
data = LevelDT,
x = ~ X,
y = ~ Y,
inherit = FALSE,
type = "scatter",
mode = "markers",
marker = list(
color = markercolors,
size = 14,
opacity = 0.6,
symbol = "circle"
),
name = ~ Level,
legendgroup = "Level",
legendgrouptitle = list(text = "Level")
) |>
add_trace(
data = PeriodDT,
x = ~ X,
y = ~ Y,
inherit = FALSE,
type = "scatter",
mode = "markers",
marker = list(
color = "darkgrey",
size = 14,
opacity = 0.6,
symbol = c("circle", "triangle-up")
),
name = ~Period,
legendgroup = "Period",
legendgrouptitle = list(text = "Period")
) |> style(showlegend = FALSE, traces = 1:4)

PS: Here the related plotly.js GitHub issue can be found.

Original answer:

I'm not sure why they are set to FALSE in the first place, but setting showlegend = TRUE in layout() and style() (for the traces) brings back the legend:

library(scales)
library(ggplot2)
library(plotly)
data <- data.frame(
stringsAsFactors = FALSE,
Level = c("Fast","Fast","Fast","Fast",
"Fast","Fast","Slow","Slow","Slow",
"Slow","Slow","Slow"),
Period = c("1Year","3Month","1Year","3Month",
"1Year","3Month","1Year","3Month",
"1Year","3Month","1Year","3Month"),
X = c(0.002,0.002,0.1,0.1,0.9,0.9,
0.002,0.002,0.1,0.1,0.9,0.9),
Y = c(1.38,1.29,1.61,1.61,1.74,0.98,
1.14,0.97,1.09,1.1,0.94,0.58)
)
# ggplot2
plt <- ggplot(data = data,
aes(x = X,
y = Y,
shape = Period,
color = Level)) +
geom_point(alpha = 0.6, size = 3) +
labs(x = " ",
y = "Value") +
scale_y_continuous(labels = number_format(accuracy = 0.1)) +
guides(color = guide_legend(title = "Period", order = 1),
shape = guide_legend(title = "", order = 2)) +
theme(axis.text.x = element_text(angle = 90))
plt
# Convert to plotly, legend disappeared
fig <- ggplotly(plt, height = 500) %>%
layout(showlegend = TRUE, xaxis = list(autorange = "reversed")) %>%
style(showlegend = TRUE)
fig

This answer is for plotly 4.10.1. I have defined two functions:

1. set_legend_names() This edits the names of the htmlwidget created by ggplotly(), before it is passed to plotly.js.
2. set_legend_symbols(). This appends some js to the htmlwidget object to change the symbols after plotly.js has drawn them.

plt2  |>
    ggplotly(height = 500)  |>
    layout(xaxis = list(autorange = "reversed")) |>
    set_legend_names() |>
    set_legend_symbols() 

Function definitions:

1. set_legend_names()

set_legend_names <- function(p,
                             new_legend_names = c(
                                 "Fast", "Slow", "One Year", "Three Month"
                             )) {

    # Update legend names and put in one group
    for (i in seq_along(p$x$data)) {
        p$x$data[[i]]$name <- new_legend_names[i]
    }

    p$x$layout$legend$title <- ""

    return(p)
}

2. set_legend_symbols()

set_legend_symbols <- function(p,
                               symbol_nums_change_color = c(3, 4),
                               new_color_string = "rgb(105, 105, 105)",
                               symbols_num_change_shape = 3,
                               symbols_nums_target_shape = 1) {
    js_get_legend <- htmltools::HTML(
        'let legend = document.querySelector(".scrollbox");
        let symbols = legend.getElementsByClassName("legendsymbols");
        const re = new RegExp("fill: rgb.+;", "i");\n
        '
    )

    js_symbol_const <- paste0(
        'const shape_re = new RegExp(\'d=".*?"\');\n',
        "const correct_shape = symbols[",
        symbols_nums_target_shape,
        "].innerHTML.match(shape_re)[0];\n"
    )

    # subtract 1 for 0-indexed js
    change_symbol_color_code <- lapply(
        symbol_nums_change_color - 1,
        \(i)
        paste0(
            "symbols[", i, "].innerHTML = ",
            "symbols[", i, "].innerHTML.replace(re,",
            ' "fill: ', new_color_string, ';");'
        )
    ) |>
        paste(collapse = "\n")

    # subtract 1 for 0-indexed js
    change_symbols_shape_code <- lapply(
        symbols_num_change_shape - 1,
        \(i)
        paste0(
            "symbols[", i, "].innerHTML = symbols[",
            symbols_nums_target_shape, "].innerHTML.replace(shape_re, correct_shape);"
        )
    ) |>
        paste(collapse = "\n")


    all_js <- htmltools::HTML(
        unlist(c(
            js_get_legend,
            js_symbol_const,
            change_symbols_shape_code,
            change_symbol_color_code
        ))
    )

    # Add it to the plot
    p <- htmlwidgets::prependContent(
        p,
        htmlwidgets::onStaticRenderComplete(all_js)
    )

    return(p)
}

I've never posted a second answer before but it seems substantially different in plotly 4.10.1. I eagerly anticipate the release of plotly 4.10.2 so I can post a third answer.

Plotly generates a different legend from ggplot2 - this can be fixed with R and and a little javascript

The first thing to do is ensure that you have a reasonably current version of the packages:

packageVersion("ggplot2") # 3.4.0
packageVersion("plotly") # 4.10.0

With these versions, like @Quentin, I do get a legend, although it is different to the one generated by ggplot2.

ggplotly(plt, height = 500) %>%
    layout(xaxis = list(autorange = "reversed"))

Steps to replicate the ggplot2 legend:

1. Change the legend text. This can be done by editing the R object before it is passed to plotly.js.
2. Remove the color from the shape guide. This can only be done with javascript after the plot has rendered.
3. Change the third circle into a triangle. This also needs to be done in javascript.

Changing the legend text

To do this manually, we could do p$x$data[[1]]$name <- "Fast", and replicate for each layer.

Fortunately, you have manually specified the legend order, making it easy to know where to access the correct legend names before passing to plotly. If we just do this step, it will create a legend which looks like this, i.e. still wrong (the first triangle should be a circle and neither should be have a color):

Changing the symbol shape and colors

We cannot do this in R. I have written an R helper function to generate some javascript to do this for us:

get_symbol_change_js <- function(symbol_nums,
                                 new_color_string = "rgb(105, 105, 105)") {
    js_get_legend <- htmltools::HTML(
        'let legend = document.querySelector(".scrollbox");
        let symbols = legend.getElementsByClassName("legendsymbols");
        const re = new RegExp("fill: rgb.+;", "i");
        '
    )

    change_symbol_color_code <- lapply(
        symbol_nums,
        \(i)
        paste0(
            "symbols[", i, "].innerHTML = ",
            "symbols[", i, "].innerHTML.replace(re,",
            ' "fill: ', new_color_string, ';");'
        )
    ) |>
        paste(collapse = "\n")


    # shape to change
    shape_change_num <- symbol_nums[1]

    # shape to replace with
    shape_change_from <- shape_change_num - 1

    change_symbols_shape_code <- paste0(
        'const shape_re = new RegExp(\'d=".*?"\');\n',
        "const correct_shape = symbols[", shape_change_from, "].innerHTML.match(shape_re)[0];\n",
        "symbols[2].innerHTML = symbols[", shape_change_num, "].innerHTML.replace(shape_re, correct_shape);"
    )

    all_js <- htmltools::HTML(
        unlist(c(
            js_get_legend,
            change_symbol_color_code,
            change_symbols_shape_code
        ))
    )
    return(all_js)
}

We can put this all together to generate the plot as desired:

draw_plotly_with_legend(plt)

Final draw_plotly_with_legend() function

Note this function calls get_symbol_change_js(), as defined above. It also uses htmlwidgets::prependContent() to attach our custom html to the widget before rendering.

draw_plotly_with_legend <- function(gg = plt,
                                    guide_types = c("colour", "shape")) {

    # Period, Level
    legend_categories <- lapply(
        guide_types, \(x) rlang::quo_get_expr(plt$mapping[[x]])
    )

    new_legend_names <- lapply(legend_categories, \(category) {
        unique(data[[category]])
    }) |> setNames(guide_types)

    # Work out which symbols need to have color removed
    symbols_to_remove_color <- new_legend_names[
        names(new_legend_names) != "colour"
    ] |> unlist()

    new_legend_names <- unlist(new_legend_names)

    symbol_num_remove_color <- which(
        new_legend_names %in% symbols_to_remove_color
    )

    # Create plot
    p <- ggplotly(gg, height = 500) %>%
        layout(xaxis = list(autorange = "reversed"))

    # Show legend
    p$x$layout$showlegend <- TRUE

    # Update legend names and put in one group
    for (i in seq_along(p$x$data)) {
        p$x$data[[i]]$name <- new_legend_names[i]
        p$x$data[[1]]$legendgroup <- "Grouped legend"
    }

    # Get the js code to change legend color

    # js is 0 indexed
    js_symbol_nums <- symbol_num_remove_color - 1
    js_code <- get_symbol_change_js(js_symbol_nums)

    # Add it to the plot
    p <- htmlwidgets::prependContent(
        p,
        htmlwidgets::onStaticRenderComplete(js_code)
    )

    return(p)
}