使用 plot_ly() 为每个条创建具有动态自定义颜色的分组条形图

Question

我正在尝试使用如下图所示的顺序调色板创建一个分组柱形图。我在我的 df 中为每个条分配了一种颜色。通常这将是动态的，颜色可能每次都不同，但我得到一个没有颜色多样性的堆叠条形图。

Cum <- structure(list(`Age group` = c("00-04", "00-04", "05-14", "05-14", 
  "15-24", "15-24", "25-49", "25-49", "50-64", "50-64", "65-79", 
  "65-79", "80+", "80+"), Gender = c("Female", "Male", "Female", 
    "Male", "Female", "Male", "Female", "Male", "Female", "Male", 
    "Female", "Male", "Female", "Male"), Cases = c(64578, 70518, 
      187568, 197015, 414405, 388138, 1342394, 1206168, 792180, 742744, 
      400232, 414613, 282268, 198026), color = c("#4285f4", "#4285f4", 
        "#90a9e0", "#90a9e0", "#dd9e5f", "#dd9e5f", "#b45f06", "#b45f06", 
        "#b45f06", "#b45f06", "#dd9e5f", "#dd9e5f", "#aebbd6", "#90a9e0"
      ), width = c("1", "1", "1", "1", "1", "1", "1", "1", "1", "1", 
        "1", "1", "1", "1")), class = "data.frame", row.names = c(NA, 
          -14L))      
mycols<-c("#4285f4","#6e97ea","#90a9e0","#aebbd6","#cccccc","#dd9e5f","#d58739","#c6721f","#b45f06")


fig <- plot_ly(
           data = Cum,
           x = ~ `Age group`,
           y = ~ Cases,
           type = 'bar',
           color = ~ color,
           colors = mycols,
           text=~Gender,
           textposition = 'outside',
           # rotate label
           textangle = 270,
           textfont = list(color = "black"),
           customdata = ~ paste("<b>Gender:</b>", Gender, "<br><b>Age:</b>",`Age group` , "<br><b>Cases:</b>", Cases, "<br><b>Total cases in age group:</b>", `Age group`),
           hovertemplate = paste('%{customdata}<extra></extra>')
         ) %>% layout(barmode = 'group',uniformtext=list(minsize=10, mode='show')
         )%>%config(modeBarButtonsToRemove = c('toImage',"zoom2d","toggleSpikelines","hoverClosestCartesian","hoverCompareCartesian","drawline","autoScale2d" ,"resetScale2d","zoomIn2d","zoomOut2d","pan2d",'select2d','lasso2d'))%>%
           config(displaylogo = FALSE)
         fig

Answer 1

ggplot2 和 ggplot_ly 让这项工作更容易

library(plotly)
library(ggplot2)

mycols <- c("#4285f4", "#6e97ea", "#90a9e0", "#aebbd6", "#cccccc", "#dd9e5f",
  "#d58739", "#c6721f", "#b45f06")
names(mycols) <- mycols

ggplot_obj <- ggplot(data = Cum, aes(x = `Age group`, y = Cases, group = Gender)) +
  geom_bar(aes(fill = color,
    # Define a text object here that can be use for reference by ggplot_ly
    # thought ggplot will throw a warning
    text = paste("<b>Gender:</b>", Gender, "<br><b>Age:</b>", `Age group` ,
      "<br><b>Cases:</b>", Cases, "<br><b>Total cases in age group:</b>",
      `Age group`)), 
    position = "dodge", stat = "identity") +
  geom_text(aes(y = Cases + 10000, label = Gender), vjust = 1,
    position = position_dodge(width=0.9)) +
  scale_fill_manual(values = mycols) +
  coord_cartesian(ylim = c(0, max(Cum$Cases)*1.1), expand = FALSE) +
  theme_bw()
#> Warning: Ignoring unknown aesthetics: text

# running ggplotly with tooltip option reference to the text defined in ggplot object
ggplotly(ggplot_obj, tooltip="text") %>%
  config(modeBarButtonsToRemove = c('toImage', "zoom2d", "toggleSpikelines",
    "hoverClosestCartesian", "hoverCompareCartesian", "drawline", "autoScale2d",
    "resetScale2d", "zoomIn2d", "zoomOut2d", "pan2d", 'select2d', 'lasso2d')) %>%
  config(displaylogo = FALSE)

可以使用完整的plot_ly 来做到这一点，尽管我在调整条宽时遇到了一些挑战

plot_ly(
  data = Cum %>% group_by(`Age group`, Gender),
  x = ~`Age group`,
  y = ~Cases,
  type = "bar",
  name = ~Gender,
  color = ~color,
  colors = mycols,
  text = ~Gender,
  textposition = "outside",
  # rotate label
  textangle = 270,
  textfont = list(color = "black"),
  customdata = ~ paste("<b>Gender:</b>", Gender, "<br><b>Age:</b>", 
    `Age group`, "<br><b>Cases:</b>", Cases,
    "<br><b>Total cases in age group:</b>", `Age group`),
  hovertemplate = paste("%{customdata}<extra></extra>")) %>%
  layout(barmode = "group", uniformtext = list(minsize = 10, mode = "show")) %>%
  config(modeBarButtonsToRemove = c("toImage", "zoom2d", "toggleSpikelines",
    "hoverClosestCartesian", "hoverCompareCartesian", "drawline", "autoScale2d",
    "resetScale2d", "zoomIn2d", "zoomOut2d", "pan2d", "select2d", "lasso2d")) %>%
  config(displaylogo = FALSE)