在 ggplot2 的一个条上添加彩虹渐变

Question

所以我有一个如下的df：

colour_clicks <- structure(list(Color = c("beige", "black", "blue", "brown", "burgundy", 
"gray", "green", "navy blue", "of many colors", "olive", "pink", 
"red", "violet", "white"), avg = c(1.6799741044454, 2.48696524064171, 
2.67327546825034, 1.94043703007519, 1.26768060836502, 1.94480302693078, 
1.47427101200686, 1.09180327868852, 1.90684892897407, 1.11425902864259, 
1.35, 1.48054996646546, 1.49029356060606, 2.02322924600152)), row.names = c(NA, 
14L), class = c("tbl_df", "tbl", "data.frame"))

我想制作一个条形图来说明这些平均值，但我有两个问题：

1. 有一个“多种颜色”条我想成为一个彩虹渐变，这可能只用于一个条吗？
2. 我希望每个条都具有特定的颜色，但是当我这样做时，它们并没有排成一行；我相信这是由于重新排序功能，有什么想法吗？

ggplot(colour_clicks, aes(x = reorder(Color, -avg), y=avg, fill=Color)) +
  geom_bar(stat="identity", color = "black")+
  scale_fill_manual(values=c(
                             "blue",
                             "black",
                             "white",
                             "gray",
                             "brown",
                             "orange",
                             "beige",
                             "violet",
                             "red",
                             "green",
                             "pink",
                             "orangered4",
                             "olivedrab",
                             "navyblue"
                             )) +
  theme(legend.position = "none")

Answer 1

对于(2)，你指定的填充变量是Color，但是x轴变量是reorder(Color)，所以你必须把它们改成同一个变量。我更喜欢在调用 ggplot 之前重新排序以避免这些类型的问题。

colour_clicks %>% 
  mutate(Color = reorder(Color, desc(avg))) %>%   # reorder here, not within ggplot call
  ggplot(aes(x = Color, y=avg, fill=Color)) +
  geom_bar(stat="identity", color = "black")+
  scale_fill_manual(values=c(
    "blue",
    "black",
    "white",
    "gray",
    "brown",
    "orange",
    "beige",
    "violet",
    "red",
    "green",
    "pink",
    "orangered4",
    "olivedrab",
    "navyblue"
  )) +
  theme(legend.position = "none")

对于 (1)，除了制作自己的渐变条之外，没有其他好方法可以做到这一点。基本方法是创建一个从零到avg 的值的序列，然后使用它生成带有colorRamp() 的渐变。不幸的是，这会分别输出 R、G 和 B，因此您必须将其转换为十六进制。但这并没有那么糟糕。在这里。

# Make the gradient
max_y <- colour_clicks$avg[colour_clicks$Color == "of many colors"]
pal <- c('red', 'orange', 'yellow', 'green', 'blue', 'violet')
color_generator <- colorRamp(pal)

df <- data.frame(
  y = seq(0, max_y, length.out = 100)
) %>% 
  mutate(
    R = color_generator(y/max_y)[,1],
    G = color_generator(y/max_y)[,2],
    B = color_generator(y/max_y)[,3],
    hexcol = sprintf("#%02x%02x%02x", (round(R, 0)), 
                     (round(G, 0)), 
                     (round(B, 0)))
  )

colour_clicks %>% 
  mutate(Color = reorder(Color, desc(avg))) %>% 
  ggplot(aes(x = Color, y=avg, fill=Color)) +
  geom_bar(stat="identity", color = "black")+
  scale_fill_manual(values=c(
    "blue", "black", "white", "gray", "brown", "orange", "beige", "violet",
    "red", "green", "pink", "orangered4", "olivedrab", "navyblue"
  )) +
  # Overlay the rainbow column on the old column
  geom_col(data = df, aes(x = 6, y = max_y/100, group = 1:100), fill = df$hexcol) +
  theme(legend.position = "none")

Answer 2

这实际上很难找到解决方案，如果有人找到更优雅的东西，我会很高兴。我不知道彩虹覆盖的单条。最好是明确提出单独的问题以获得更多可见性。

colour_clicks <- structure(list(Color = c("beige", "black", "blue", "brown", "burgundy", 
                                          "gray", "green", "navy blue", "of many colors", "olive", "pink", 
                                          "red", "violet", "white"), avg = c(1.6799741044454, 2.48696524064171, 
                                                                             2.67327546825034, 1.94043703007519, 1.26768060836502, 1.94480302693078, 
                                                                             1.47427101200686, 1.09180327868852, 1.90684892897407, 1.11425902864259, 
                                                                           1.35, 1.48054996646546, 1.49029356060606, 2.02322924600152)), row.names = 1:14, class = c("tbl_df", "tbl", "data.frame")) 
p <- colour_clicks %>%mutate(r=rank(-avg))#%>%
ggplot(p)+geom_bar(stat='identity',aes(x = reorder(Color,-avg), y=avg,fill=Color))+
   #scale_x_discrete(limits = reorder(colour_clicks$Color,colour_clicks$avg))#+

  # geom_bar(stat="identity")+
   scale_fill_manual(values=c(
   "blue",
   "black",
   "white",
   "gray",
   "brown",
   "orange",
   "beige",
   "violet",
   "red",
   "green",
   "pink",
   "orangered4",
   "olivedrab",
   "navyblue"
)[p$r]) + geom_text(aes(x=Color,y=avg,label=round(avg,1)),nudge_y = 0.2)+
   theme(legend.position = "none")