圆形条形图中负值的不同填充颜色

Question

我正在尝试弄清楚如何用蓝色来绘制负值（即俄罗斯、波兰、德国和中国）而不是紫色/粉红色的圆形条形图。我一直在尝试改变颜色和中断，但我无法让它在零处中断。

可重现的示例：

uni_data <- structure(list(from = c("Argentina", "Canada", "China", "Germany", 
"Malawi", "Mexico", "Poland", "Russia", "South Africa", "United Republic of Tanzania", 
"United States", "Zambia"), to = c("Zimbabwe", "Zimbabwe", "Zimbabwe", 
"Zimbabwe", "Zimbabwe", "Zimbabwe", "Zimbabwe", "Zimbabwe", "Zimbabwe", 
"Zimbabwe", "Zimbabwe", "Zimbabwe"), fraction_mean = c(-1.16218764988057, 
0.556848791658583, -0.785724007068475, -0.668776616353553, 2.98715326478044, 
0.632802483886891, -0.952039672216194, -0.275904847337713, 1.91885749928563, 
2.18477200782915, -1.22917889731657, 4.4028142502411), d_long = c(0.124, 
0.2794, 0.2466, 0.0785, 2.8646, 0.202, 0.1153, 0.1238, 0.2247, 
1.6428, 0.1664, 2.3044), mean_exposure = c(0.219336124378027, 
0.964248264036473, -0.833368763174394, -0.520689933363188, 1.45247015618433, 
-1.53268987398912, -1.15713981781644, 0.791178790005572, 0.482041972598713, 
2.02018800214932, 1.40628459671399, 2.61998072810955)), row.names = c(1L, 
5L, 6L, 9L, 14L, 15L, 17L, 19L, 22L, 25L, 26L, 27L), class = "data.frame")

代码（来自https://r-graph-gallery.com/web-circular-barplot-with-R-and-ggplot2.html）：

plot_uni <- uni_data %>%
  group_by(from) %>%
  summarise(
    sum_length = fraction_mean,
    mean_exposure = mean_exposure,
    delta = d_long
  ) %>%
  mutate(mean_exposure = round(mean_exposure, digits = 0))

plt2 <- ggplot(plot_uni) +
  # Make custom panel grid
  # geom_hline(
  #   aes(yintercept = y), 
  #   data.frame(y = c(0:7) * 1),
  #   color = "lightgrey"
  #) + 
  # Add bars to represent the cumulative track lengths
  # str_wrap(region, 5) wraps the text so each line has at most 5 characters
  # (but it doesn't break long words!)
  geom_col(
    aes(
      x = reorder(str_wrap(from, 5), sum_length),
      y = sum_length,
      fill = delta
    ),
    position = "dodge2",
    show.legend = TRUE,
    alpha = .9
  ) +
  
  # Add dots to represent the mean gain
  geom_point(
    aes(
      x = reorder(str_wrap(from, 5),sum_length),
      y = mean_exposure
    ),
    size = 3,
    color = "gray12"
  ) +
  
  # Lollipop shaft for mean gain per region
  geom_segment(
    aes(
      x = reorder(str_wrap(from, 5), sum_length),
      y = 0,
      xend = reorder(str_wrap(from, 5), sum_length),
      yend = 6
    ),
    linetype = "dashed",
    color = "gray12"
  ) + 
  
  # Make it circular!
  coord_polar() + 
  
  labs(x=" ", y=" ")

plt2

plt3 <- plt2 +
  # Scale y axis so bars don't start in the center
  scale_y_continuous(
    limits = c(-1, 6),
    expand = c(0, 0),
    breaks = c(0,2, 3, 4)
  ) + 
  # New fill and legend title for number of tracks per region
  scale_fill_gradientn(
    "Delta in mm of extreme precipitation (%)",
    colours = c("#F8B195","#F67280","#C06C84","#6C5B7B")
  ) +
  # Make the guide for the fill discrete
  guides(
    fill = guide_colorsteps(
      barwidth = 20, barheight = .5, title.position = "top", title.hjust = .5)
  ) +
  theme(
    # Remove axis ticks and text
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    axis.text.y = element_blank(),
    # Use gray text for the region names
    axis.text.x = element_text(color = "gray12", size = 10),
    # Move the legend to the bottom
    legend.position = "bottom",
  )

plt3

Answer 1

其主要思想之前已在多线程中得到解决（例如ggplot2正值和负值不同的颜色渐变）。但在这里，我们需要采取一些额外的步骤来实现这一目标。

首先，由于您的填充颜色基于列

delta

并且您希望为具有负 y 值的条形（即

sum_length

）使用不同的颜色，因此我们需要修改

delta

以反映这一点。所以我将

delta

更改为等于

abs(d_long) * sign(sum_length)

。

然后，我们可以使用上面链接中的相同想法，并定义负值和正值的颜色。我们定义我们的颜色 (

colours = c("#073763", "#0A75AD","white", "#F67280", "#6C5B7B")

)，然后告诉 ggplot 将它们用于我们想要的范围 (

values=rescale(c(min(plot_uni$delta), 0-.Machine$double.eps, 0, 0+.Machine$double.eps, max(plot_uni$delta))))

)。基本上，我们使用蓝色阴影来表示从

delta

的最小值到略小于 0 的任何颜色，白色表示 0 ，以及粉色和紫色阴影的正值，最大可达

delta

。

我还扩展了限制和片段以显示每个数据点，并调整了主题以使绘图看起来更清晰。

library(tidyverse)
library(scales)

uni_data %>%
  group_by(from) %>%
  summarise(sum_length = fraction_mean,
            mean_exposure = mean_exposure,
            delta = d_long * sign(sum_length)) %>%
  mutate(mean_exposure = round(mean_exposure, digits = 0)) -> plot_uni

ggplot(plot_uni) +
  geom_col(aes(x = reorder(str_wrap(from, 5), sum_length), 
               y = sum_length,
               fill = delta),
    position = "dodge2", show.legend = TRUE, alpha = .9) +
  geom_point(aes(x = reorder(str_wrap(from, 5),sum_length),
                 y = mean_exposure),
             size = 3, color = "gray12") +
  geom_segment(aes(x = reorder(str_wrap(from, 5), sum_length),
                   y = -3,
                   xend = reorder(str_wrap(from, 5), sum_length),
                   yend = 6),
               linetype = "dashed", color = "gray12") + 
  coord_polar() + 
  labs(x=" ", y=" ") +

  scale_y_continuous(limits = c(-4, 6), expand = c(0, 0)) + 
  scale_fill_gradientn("Delta in mm of extreme precipitation (%)",
                       colours = c("#073763", "#0A75AD","white", "#F67280", "#6C5B7B"),
                       values=rescale(c(min(plot_uni$delta), 
                                                0-.Machine$double.eps, 
                                                0, 
                                                0+.Machine$double.eps, 
                                                max(plot_uni$delta)))) +
  guides(fill = guide_colorsteps(barwidth = 20, barheight = .5, 
                                 title.position = "top", title.hjust = .5)) +
  theme_minimal() +
  theme(axis.title = element_blank(),
        axis.ticks = element_blank(),
        axis.text.y = element_blank(),
        axis.text.x = element_text(color = "gray12", size = 10),
        line = element_blank(),
        legend.position = "bottom")

^{创建于 2023-11-14，使用 reprex v2.0.2}