使用R语言ggplot2包绘制Tornado图的颜色设置问题

用户尝试使用R的ggplot2绘制龙卷风图，希望为y=0参考线左侧的条形部分设置一种颜色，右侧设置另一种颜色，但现有代码无法实现该需求，原代码如下：

# tornado plot
library(forcats)
library(ggplot2)

# construct empty matrix
D<-matrix(data = NA,
          nrow = 10,
          ncol = 3)
rownames(D)<-     c("Sex_man","Sex_woman","Age_45","Age_90","p_N_Event_high","p_N_Event_low","p_E_Event_high","p_E_Event_low","discount","no_discount")
colnames(D)<-c("txe", "txn", "diff")

# fill in matrix with minimum and maximum value for both strategies
D[,1]<-c(16.370930,17.238380,19.32026,2.472129,17.23838,17.23838,14.81019,17.44902,16.56,20.86)
D[,2]<-  c(15.516060,16.354510,18.375550,2.294882,15.23853,16.44606,16.35451,16.35451,15.74,19.84)
D[,3]<-D[,1]-D[,2]
D

# parameters
sex_woman <- 0.883870 
sex_man <- 0.854870
age_high_90 <- 0.944710 # age not reflected in initial health state dis or RB/RT probability or state-transition probabilities
age_low_45 <- 0.177247
p_N_Event_high <- 2.880820
p_N_Event_low <- 0.671710
p_E_Event_high <- -3.248930
p_E_Event_low <- 1.350520
discount <- 0.820000
no_discount <- 1.020000

# combine all data
grp <- c("Patient sex", 
     "Patient age", 
     "Cycle-dependent probability of event after Clipping", 
     "Cycle-dependent probability of event after Coiling",
     "Discounting")
hi <- c(sex_woman,age_high_90,p_N_Event_high,p_E_Event_high,discount)
lo <- c(sex_man,age_low_45,p_N_Event_low,p_E_Event_low,no_discount)
diff <- abs(hi-lo)
benefit <- c("Coiling","Coiling","Coiling","Clipping","Coiling")

df.t <- data.frame(grp,lo,hi,diff,benefit)
df.t <- df.t[order(df.t$diff),] #ordered on effect size

# make plot
ggplot(data=df.t, aes(x=fct_inorder(grp), y=diff, ymin=lo, ymax=hi, fill=benefit)) + 
 geom_linerange(size = 8, colour=c("steelblue","steelblue","steelblue","steelblue","darkred")) +
 coord_flip() +
 theme_bw() +
 geom_hline(yintercept = 0, color = "black", linetype = "dashed") +
 theme(panel.grid=element_blank(),
    axis.title.x = element_text(size = 13),
    axis.text = element_text(size = 11, colour = "black")) +
 ylab("Benefit of Treatment (QALYs)") +
 xlab("")

要实现参考线两侧分色，需将每个条形拆分为0左侧段和0右侧段分别绘制，具体修改步骤如下：

1. 预处理数据：为每个分组生成左右分段的记录，过滤掉无长度的无效分段。
2. 分段绘制：用两个geom_linerange分别渲染左右分段，并指定对应颜色。

修改后的完整代码如下：

# tornado plot
library(forcats)
library(ggplot2)
library(dplyr) # 用于数据分段处理

# construct empty matrix
D<-matrix(data = NA,
          nrow = 10,
          ncol = 3)
rownames(D)<-     c("Sex_man","Sex_woman","Age_45","Age_90","p_N_Event_high","p_N_Event_low","p_E_Event_high","p_E_Event_low","discount","no_discount")
colnames(D)<-c("txe", "txn", "diff")

# fill in matrix with minimum and maximum value for both strategies
D[,1]<-c(16.370930,17.238380,19.32026,2.472129,17.23838,17.23838,14.81019,17.44902,16.56,20.86)
D[,2]<-  c(15.516060,16.354510,18.375550,2.294882,15.23853,16.44606,16.35451,16.35451,15.74,19.84)
D[,3]<-D[,1]-D[,2]
D

# parameters
sex_woman <- 0.883870 
sex_man <- 0.854870
age_high_90 <- 0.944710 # age not reflected in initial health state dis or RB/RT probability or state-transition probabilities
age_low_45 <- 0.177247
p_N_Event_high <- 2.880820
p_N_Event_low <- 0.671710
p_E_Event_high <- -3.248930
p_E_Event_low <- 1.350520
discount <- 0.820000
no_discount <- 1.020000

# combine all data
grp <- c("Patient sex", 
     "Patient age", 
     "Cycle-dependent probability of event after Clipping", 
     "Cycle-dependent probability of event after Coiling",
     "Discounting")
hi <- c(sex_woman,age_high_90,p_N_Event_high,p_E_Event_high,discount)
lo <- c(sex_man,age_low_45,p_N_Event_low,p_E_Event_low,no_discount)
diff <- abs(hi-lo)
benefit <- c("Coiling","Coiling","Coiling","Clipping","Coiling")

df.t <- data.frame(grp,lo,hi,diff,benefit)
df.t <- df.t[order(df.t$diff),] #ordered on effect size

# 拆分数据为参考线左右分段
df_split <- df.t %>%
  rowwise() %>%
  summarize(
    grp = grp,
    segment = c("left", "right"),
    ymin = c(lo, ifelse(hi > 0, 0, hi)),
    ymax = c(ifelse(lo < 0, 0, lo), hi),
    .groups = "drop"
  ) %>%
  filter(ymin != ymax) # 移除无长度的无效分段

# 绘制分色龙卷风图
ggplot(data = df_split, aes(x = fct_inorder(grp), ymin = ymin, ymax = ymax)) +
  geom_linerange(size = 8, aes(colour = segment)) +
  scale_colour_manual(values = c(left = "steelblue", right = "darkred")) + # 自定义左右颜色
  coord_flip() +
  theme_bw() +
  geom_hline(yintercept = 0, color = "black", linetype = "dashed") +
  theme(
    panel.grid = element_blank(),
    axis.title.x = element_text(size = 13),
    axis.text = element_text(size = 11, colour = "black")
  ) +
  ylab("Benefit of Treatment (QALYs)") +
  xlab("") +
  labs(colour = "Segment") # 可选：添加图例标题

代码说明 #

• 用dplyr的行处理功能拆分每个条形的左右分段，自动过滤掉无实际长度的分段（比如整个条形都在0右侧时，左段无意义）。
• 通过colour = segment映射分段颜色，再用scale_colour_manual指定自定义颜色，确保参考线两侧颜色区分明确。
• 保留了原代码的排序、主题设置等逻辑，保证图表风格与原需求一致。

内容的提问来源于stack exchange，提问作者Jordi de Winkel