我不确定为什么首先将它们设置为FALSE，但是在layout()和style()（用于跟踪）中设置showlegend = TRUE会使我们想起以下图例：

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

Plotly生成了与ggplot2不同的图例-这可以通过R和少量javascript修复

要做的第一件事是确保您拥有软件包的合理最新版本：

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

使用这些版本，比如@Quentin，我确实得到了一个图例，尽管它与ggplot2生成的图例不同。

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

复制ggplot2图例的步骤：

1.更改图例文本。这可以通过在将R对象传递给plotly.js之前对其进行编辑来完成。
1.从shape参考线中删除颜色。这只能在绘图渲染后使用javascript完成。
1.把第三个圆改成三角形，这也需要用javascript来完成。

更改图例文本

要手动执行此操作，我们可以执行p$x$data[[1]]$name <- "Fast"，并为每一层进行复制。
幸运的是，您已经手动指定了图例的顺序，这样在传递给plotly之前，就很容易知道在哪里可以访问正确的图例名称。如果我们只执行这一步，它将创建一个图例，看起来像这样，也就是说，仍然是错误的（第一个三角形应该是一个圆，并且两个三角形都不应该有颜色）：

更改符号形状和颜色

我们在R中无法做到这一点。我已经编写了一个R helper函数来生成一些javascript来为我们做到这一点：

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)
}

我们可以把这些放在一起生成所需的图：

draw_plotly_with_legend(plt)

最终draw_plotly_with_legend()函数

注意这个函数调用get_symbol_change_js()，正如上面定义的那样，它还使用htmlwidgets::prependContent()在呈现之前将我们的定制html附加到小部件上。

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)
}