R Plotly：如何在 R Plot.ly 中设置瀑布图的各个条形的颜色？

Question

我正在尝试使用 R Plotly 更改瀑布图各个条形的颜色。更具体地说，第一个和最后一个栏，我希望它分别是蓝色和黄色。因此，在下图中，第 1 组必须为蓝色，第 2 组必须为黄色。

R Plotly Waterfall 图表似乎只能选择为增加、减少和总计条形图设置三种颜色。

这是用于生成上图的代码：

library(plotly)

df <- data.frame(Rank = 1:7, Variable = c("Group 1","A","B","C","D","E","Group 2"),
Value = c(10,2,2,2,1,1,20),
measure = c("relative","relative","relative","relative","relative","relative","total"),
colour = c("yellow","green","green","green","green","green","blue"))


df$Variable <- factor(df$Variable, levels = unique(df$Variable))
df$text <- as.character(round(df$Value,2))
df$Factor <- as.numeric(df$Variable)



plot_ly(df, name = "20", type = "waterfall", measure = ~measure,
             x = ~Variable, textposition = "outside", y= ~Value, text =~paste0('$',text),
             hoverinfo='none',cliponaxis = FALSE,
             connector = list(line = list(color= "rgb(63, 63, 63)"))
        ) %>%
  layout(title = "",
         xaxis = list(title = ""),
         yaxis = list(title = "",tickprefix ='$'),
         autosize = TRUE,
         showlegend = FALSE
         )

任何帮助将不胜感激。

Answer 1

R Plotly Waterfall图表似乎只有设置三个的选项 增加、减少和总计条形的颜色。

不幸的是，你似乎是完全正确的。但好消息是，plotly 可以让您几乎按照自己的意愿向图表添加形状。您已经可以通过

totals

颜色将您喜欢的颜色之一设置为 Group2。所以你只需要添加一个形状就可以得到：

我不知道这对于您的现实世界数据是否可行，但在这种情况下效果很好。操作方法如下：

library(plotly)

df <- data.frame(Rank = 1:7, Variable = c("Group 1","A","B","C","D","E","Group 2"),
Value = c(10,2,2,2,1,1,20),
measure = c("relative","relative","relative","relative","relative","relative","total"),
colour = c("yellow","green","green","green","green","green","yellow"))


df$Variable <- factor(df$Variable, levels = unique(df$Variable))
df$text <- as.character(round(df$Value,2))
df$Factor <- as.numeric(df$Variable)



p<-plot_ly(df, name = "20", type = "waterfall", measure = ~measure,
             x = ~Variable, textposition = "outside", y= ~Value, text =~paste0('$',text),
             hoverinfo='none',cliponaxis = FALSE,
             connector = list(line = list(color= "rgb(63, 63, 63)")),
             totals = list(marker = list(color = "yellow", line = list(color = 'yellow', width = 3)))
        ) %>%
  layout(title = "",
         xaxis = list(title = ""),
         yaxis = list(title = "",tickprefix ='$'),
         autosize = TRUE,
         showlegend = FALSE,


         shapes = list(
               list(type = "rect",
                    fillcolor = "blue", line = list(color = "blue"), opacity = 1,
                    x0 = -0.4, x1 = 0.4, xref = "x",
                    y0 = 0.0, y1 = 10, yref = "y"))

         )
p

您想要更多形状吗？只需在

shapes

的

layout

列表中添加另一个，如下所示：

library(plotly)

df <- data.frame(Rank = 1:7, Variable = c("Group 1","A","B","C","D","E","Group 2"),
Value = c(10,2,2,2,1,1,20),
measure = c("relative","relative","relative","relative","relative","relative","total"),
colour = c("yellow","green","green","green","green","green","yellow"))


df$Variable <- factor(df$Variable, levels = unique(df$Variable))
df$text <- as.character(round(df$Value,2))
df$Factor <- as.numeric(df$Variable)



p<-plot_ly(df, name = "20", type = "waterfall", measure = ~measure,
             x = ~Variable, textposition = "outside", y= ~Value, text =~paste0('$',text),
             hoverinfo='none',cliponaxis = FALSE,
             connector = list(line = list(color= "rgb(63, 63, 63)")),
             totals = list(marker = list(color = "yellow", line = list(color = 'yellow', width = 3)))
        ) %>%
  layout(title = "",
         xaxis = list(title = ""),
         yaxis = list(title = "",tickprefix ='$'),
         autosize = TRUE,
         showlegend = FALSE,


         shapes = list(
               list(type = "rect",
                    fillcolor = "blue", line = list(color = "blue"), opacity = 1,
                    x0 = -0.4, x1 = 0.4, xref = "x",
                    y0 = 0.0, y1 = 10, yref = "y"),

               list(type = "rect",
                 fillcolor = "blue", line = list(color = "blue"), opacity = 0.2,
                 x0 = 3, x1 = 4, xref = "x",
                 y0 = 4, y1 = 12.5, yref = "y"))




         )
p

输出：

Answer 2

我最近一直在修改 {waterfalls} 包，这使得通过利用 {ggplot2} 及其大部分逻辑可以轻松创建和自定义瀑布图。之后可以通过

ggplotly()

函数轻松将绘图转换为 {plotly}。

如果需要，主函数

waterfalls::waterfall()

会动态计算总和，因此无需手动进行数学计算。我只保留示例数据中的最后一行作为我的第二个更高级的手动标签放置示例。

library(plotly)

## sample data
df = data.frame(
  Variable = c("Group 1", "A", "B", "C", "D", "E", "Group 2")
  , Value = c(10, 2, 2, 2, 1, 1, 0)
  , Color = c("blue", rep("green", 5L), "yellow")
)

## convert column 'Variable' to `factor`
df$Variable = factor(
  df$Variable
  , levels = unique(df$Variable)
)

以下代码片段创建了一个基本的瀑布图。如前所述，只要

calc_total = TRUE

就不需要手动计算，因此在生成绘图之前丢弃最后一行数据。

## discard row with overall sum
sbs = utils::head(
  df
  , n = -1L
)

## generate waterfall plot
p0 = waterfalls::waterfall(
  sbs
  , rect_text_labels = paste0("$", sbs$Value)
  , calc_total = TRUE
  , total_axis_text = "Group 2"
  , total_rect_text = paste0("$", sum(sbs$Value))
  , total_rect_color = "yellow"
  , total_rect_text_color = "black"
  , total_rect_border_color = "transparent"
  , fill_colours = sbs$Color
  , fill_by_sign = FALSE
  , rect_border = "transparent"
  , draw_axis.x = "front"
) + 
  labs(
    x = NULL
    , y = NULL
  ) + 
  scale_y_continuous(
    labels = scales::dollar_format()
    , expand = c(0, 0)
  ) + 
  theme_minimal()

ggplotly(p0)

让我们还探索第二个更高级的示例，其目标是将标签放置在每个栏的顶部，如示例中所示。尽管有一个参数“put_rect_text_outside_when_value_below” ' 允许将标签放置在框外，但它似乎无法与 'calc_total' 集成 - 至少不能与 {waterfalls} 包版本

‘1.0.0’

集成。相反，我使用

ggplot2::geom_text()

来更好地控制自定义文本注释。

## create custom labels
df$Text = ifelse(
  df$Variable == "Group 2"
  , cumsum(df$Value)
  , df$Value
)

## add offset for label placement (+5% of total)
df$Position = cumsum(df$Value) + 
  0.05 * sum(df$Value)

## generate advanced waterfall plot
p1 = waterfalls::waterfall(
  sbs
  # "turn off" text labels
  , rect_text_labels = rep("", nrow(sbs))
  , calc_total = TRUE
  , total_axis_text = "Group 2"
  # "turn off" total text label
  , total_rect_text = ""
  , total_rect_color = "yellow"
  , total_rect_border_color = "transparent"
  , fill_colours = sbs$Color
  , fill_by_sign = FALSE
  , rect_border = "transparent"
  , draw_axis.x = "front"
) + 
  geom_text(
    aes(
      x = Variable
      , y = Position
      , label = paste0("$", Text)
    )
    , data = df
    , inherit.aes = FALSE
  ) + 
  labs(
    x = NULL
    , y = NULL
  ) + 
  scale_y_continuous(
    labels = scales::dollar_format()
  ) + 
  theme_minimal()

ggplotly(p1)