plotly 会删除分组图例（按颜色、按符号）

问题描述 投票：0回答：4

我不太明白为什么当我使用 

ggplot
将 
plotly
制作的图转换为 
ggplotly
时，图例消失了。 plotly帮助页面没有任何信息。我认为他们的示例在该页面上甚至无法正常工作。 非常感谢任何帮助！

样本数据

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

转换为plotly，图例消失了

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

编辑

guides()
有问题。如果我删除它，
ggplotly
中的图例就会出现

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

r ggplot2 plotly legend
4个回答
6
投票

OP编辑后：

这是使用基本 R {plotly} 根据@Tung 的要求修改图例的解决方法：

result

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：这里可以找到相关的plotly.js GitHub问题。

原答案：

我不确定为什么它们首先设置为

FALSE
，但是在
showlegend = TRUE
和
layout()（用于痕迹）中设置
style()
（用于痕迹）会带回图例：

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

result

3
投票

这个答案是针对

plotly 4.10.1
的。我定义了两个函数：

  1. set_legend_names()
    这会编辑由 
    htmlwidget
    创建的 
    ggplotly()
    的名称，然后再将其传递给 
    plotly.js
    。
  2. set_legend_symbols()
    。 这会向 
    htmlwidget
    对象附加一些 js，以在 
    plotly.js
    绘制符号后更改符号。
plt2  |>
    ggplotly(height = 500)  |>
    layout(xaxis = list(autorange = "reversed")) |>
    set_legend_names() |>
    set_legend_symbols()

enter image description here

函数定义：

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

我以前从未发布过第二个答案，但它在

plotly 4.10.1
中似乎有很大不同。我热切期待 
plotly 4.10.2
的发布，这样我就可以发布第三个答案。

2
投票

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

enter image description here

复制
ggplot2
图例的步骤：

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

更改图例文本

要手动执行此操作，我们可以执行 

p$x$data[[1]]$name <- "Fast"
，并为每一层进行复制。

幸运的是，您已经手动指定了图例顺序，使得在传递到 

plotly
之前可以轻松了解在哪里访问正确的图例名称。如果我们只执行这一步，它将创建一个如下所示的图例，即仍然错误（第一个三角形应该是圆形，并且都不应该有颜色）：

enter image description here

更改符号形状和颜色

我们无法在 R 中执行此操作。我编写了一个 R 辅助函数来生成一些 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)

enter image description here

最终
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)
}
0
投票

当我将 ggplots 转换为 ggplotly 时，我尝试使用这些函数（get_symbol_change_js 和 draw_plotly_with_legend）来避免分组图例。但我遇到了这个错误，我无法解决，你能帮我吗？

rlang::quo_get_expr()
中的错误： ！ 
quo
必须是定理 运行 
rlang::last_trace()
查看错误发生的位置。

PCA分组图例

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.