有没有办法使用 Plotly (r) 更改图例以显示瀑布图的增加和减少颜色？

Question

我已经使用plotly绘制了瀑布图/图。我正在尝试更改图例，以便它显示我设置的增加/减少颜色（红色/绿色）。有谁知道我将如何去做这件事？我尝试只显示整个图的一个图例，而不是每个子图的一个图例。目前，显示的是带有红色和绿色框的迹线（如图所示）。

这是数据：

structure(list(Date = structure(c(1569888000, 1572566400, 1575158400, 
1577836800, 1580515200, 1583020800, 1585699200, 1588291200, 1590969600, 
1569888000, 1572566400, 1575158400, 1577836800, 1580515200, 1583020800, 
1585699200, 1588291200, 1590969600, 1569888000, 1572566400, 1575158400, 
1577836800, 1580515200, 1583020800, 1585699200, 1588291200, 1590969600
), class = c("POSIXct", "POSIXt"), tzone = "UTC"), Percent_change = c(-45, 
-50, -25, -30, -40, -35, -1, -5, -25, 30, 45, 50, -30, -40, -35, 
-1, -5, -25, 50, -45, -30, -15, -20, -35, -1, -5, -25), Toys = c("Toy 1", 
"Toy 1", "Toy 1", "Toy 1", "Toy 1", "Toy 1", "Toy 1", "Toy 1", 
"Toy 1", "Toy 2", "Toy 2", "Toy 2", "Toy 2", "Toy 2", "Toy 2", 
"Toy 2", "Toy 2", "Toy 2", "Toy 3", "Toy 3", "Toy 3", "Toy 3", 
"Toy 3", "Toy 3", "Toy 3", "Toy 3", "Toy 3")), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -27L))  

这是代码：

  percent <- function(x, digits = 2, format = "f", ...) {
  paste0(formatC(x, format = format, digits = digits, ...), "%")
}
      my_plot <- . %>% 
  plot_ly(x = ~Date, y = ~Percent_change, type = "waterfall",
          hoverinfo = "text",
          hovertext = ~paste("Date :", Date,
                             "<br> % Change:", percent(Percent_change)),
          increasing = list(marker = list(color = "red")),
          decreasing = list(marker = list(color = "green")),
          totals = list(marker = list(color = "blue")),
          textposition = "outside", legendgroup = "trace 1") %>%
  add_annotations(
    text = ~unique(Toys),
    x = 0.5,
    y = 1,
    yref = "paper",
    xref = "paper",
    xanchor = "middle",
    yanchor = "top",
    showarrow = FALSE,
    font = list(size = 15),
    yshift = 10
  )  %>%
  layout(yaxis = list(title = "% Change",
                      ticksuffix = "%"),
         xaxis = list(title = c("Date")),
         showlegend =T)


example_data %>%
  dplyr::filter(!is.na(Date)) %>% 
  group_by(Toys) %>%
  distinct()  %>%
  do(p = my_plot(.)) %>%
  subplot(nrows = 3, shareX = FALSE, titleY= TRUE, titleX= FALSE) 

我希望图例看起来像这样，上面有标题“趋势”：

Answer 1

我们可以创建代表两个图例项的两个初始轨迹。

之后，我们需要将所有增加和减少轨迹分配到与初始轨迹一起引入的图例组中，并隐藏它们的图例项：

library(plotly)
library(dplyr)
library(data.table)

example_data <- structure(list( Date = structure(c(1569888000, 1572566400,
1575158400, 1577836800, 1580515200, 1583020800, 1585699200, 1588291200,
1590969600, 1569888000, 1572566400, 1575158400, 1577836800, 1580515200,
1583020800, 1585699200, 1588291200, 1590969600, 1569888000, 1572566400,
1575158400, 1577836800, 1580515200, 1583020800, 1585699200, 1588291200,
1590969600), class = c("POSIXct",  "POSIXt"), tzone = "UTC"), Percent_change =
c(-45, -50, -25, -30, -40, -35, -1, -5, -25, 30, 45, 50, -30, -40, -35, -1,
-5, -25, 50, -45, -30, -15, -20, -35, -1, -5, -25), Toys = c("Toy 1", "Toy 1",
"Toy 1", "Toy 1", "Toy 1", "Toy 1", "Toy 1", "Toy 1", "Toy 1", "Toy 2", "Toy 2",
"Toy 2", "Toy 2", "Toy 2", "Toy 2", "Toy 2", "Toy 2", "Toy 2", "Toy 3",
"Toy 3", "Toy 3", "Toy 3", "Toy 3", "Toy 3", "Toy 3", "Toy 3", "Toy 3")),
class = c("tbl_df",  "tbl",  "data.frame"), row.names = c(NA, -27L))

percent <- function(x, digits = 2, format = "f", ...) {
  paste0(formatC(x, format = format, digits = digits, ...), "%")
}

my_plot <- . %>%
  plot_ly(
    x = ~ Date[1],
    y = 0,
    type = "bar",
    name = "increasing",
    color = I("darkgreen"),
    legendgroup = "increasing",
    showlegend = ~ all(showlegend)
  ) %>%
  add_trace(
    x = ~ Date[1],
    y = 0,
    type = "bar",
    name = "decreasing",
    color = I("red"),
    legendgroup = "decreasing",
    showlegend = ~ all(showlegend)
  ) %>%
  add_trace(
    x = ~ Date,
    y = ~ Percent_change,
    type = "waterfall",
    # split = ~ legendgroup,
    hoverinfo = "text",
    hovertext = ~ paste("Date :", Date, "<br> % Change:", percent(Percent_change)),
    increasing = list(marker = list(color = "red")),
    decreasing = list(marker = list(color = "green")),
    totals = list(marker = list(color = "blue")),
    textposition = "outside",
    legendgroup = ~ legendgroup,
    showlegend = FALSE
  ) %>%
  add_annotations(
    text = ~ unique(Toys),
    x = 0.5,
    y = 1,
    yref = "paper",
    xref = "paper",
    xanchor = "middle",
    yanchor = "top",
    showarrow = FALSE,
    font = list(size = 15),
    yshift = 10
  )  %>%
  layout(yaxis = list(title = "% Change", ticksuffix = "%"),
         xaxis = list(title = c("Date")),
         legend = list(
           itemclick = FALSE,
           itemdoubleclick = FALSE,
           groupclick = FALSE
         ))

example_data %>%
  dplyr::filter(!is.na(Date))  %>%
  mutate(legendgroup = case_when(
    Percent_change >= 0 ~ "increasing",
    Percent_change < 0 ~ "decreasing",
  )) %>%
  mutate(showlegend = data.table::rleid(Toys, legendgroup) %in% c(1, 2)) %>%
  group_by(Toys) %>%
  distinct() %>%
  do(p = my_plot(.)) %>%
  subplot(
    nrows = 3,
    shareX = FALSE,
    titleY = TRUE,
    titleX = FALSE
  )

split = ~ legendgroupPS：如果您希望使用单独的轨迹来显示瀑布图，以便在调用中使用增加和减少部分add_trace。此外，您需要将itemclick等设置回TRUE调用交互式layout图例。