如何在ggplot2条形图的文本标签下添加可控制宽度的彩色下划线？

我用以下代码生成了一份条形图，目前运行正常，但希望在条形右侧的数值标签（如89、86.4%）下方添加彩色下划线，且能控制下划线的宽度，请问如何通过程序化方式实现？

require(ggplot2)
require(dplyr)

df <- data.frame (Origin = c("Canada", "Canada","USA","USA"),
                  Year = c("2021", "2022","2021","2022"),
                  Sales = c(103, 192, 144, 210),
                  diff = c(89, " ",66," "),
                  perdiff = c(86.4, " ",45.83," "))


df <- df %>% mutate(label= ifelse(diff!=" ",paste0(diff,", ",perdiff,'%'),NA))
ggplot(df, aes(fill=Year, y=Origin, x=Sales)) + 
  geom_bar(position="dodge", stat="identity")+ 
  geom_text(aes(label=label, x=200), fontface='bold') +
  scale_x_continuous(breaks=seq(0,200,25))+
  theme()

可以用geom_segment()来模拟下划线，因为geom_text本身不支持自定义下划线样式，通过线段可以灵活控制颜色、宽度和位置。具体实现方案如下：

固定宽度下划线实现 #

先整理数据标记需要添加下划线的行，再通过geom_segment()绘制线段，自定义位置、颜色和粗细：

require(ggplot2)
require(dplyr)

df <- data.frame (Origin = c("Canada", "Canada","USA","USA"),
                  Year = c("2021", "2022","2021","2022"),
                  Sales = c(103, 192, 144, 210),
                  diff = c(89, " ",66," "),
                  perdiff = c(86.4, " ",45.83," "))

# 处理标签和下划线的位置数据
df <- df %>% 
  mutate(label= ifelse(diff!=" ",paste0(diff,", ",perdiff,'%'),NA),
         # 标记需要添加下划线的行
         has_underline = !is.na(label),
         # 下划线的y轴偏移（根据文本大小调整，这里用-0.1）
         underline_y = as.numeric(factor(Origin)) - 0.1,
         # 自定义下划线宽度：设置x起点和终点
         underline_x_start = 190,
         underline_x_end = 210)

ggplot(df, aes(fill=Year, y=Origin, x=Sales)) + 
  geom_bar(position="dodge", stat="identity")+ 
  # 先绘制下划线（放在文本下方，所以先画）
  geom_segment(aes(x=underline_x_start, xend=underline_x_end,
                   y=underline_y, yend=underline_y,
                   color=Origin), # 按Origin区分颜色，也可设固定色如"red"
               size=1.2, # 控制下划线粗细
               data = filter(df, has_underline)) +
  # 绘制标签
  geom_text(aes(label=label, x=200), fontface='bold') +
  scale_x_continuous(breaks=seq(0,220,25))+ # 扩展x轴范围避免下划线被截断
  scale_color_manual(values = c("Canada"="blue", "USA"="red"))+ # 自定义下划线颜色
  theme()

匹配文本长度的动态下划线 #

如果希望下划线宽度自动匹配标签文本长度，可以用strwidth()计算文本宽度，动态调整x轴起止位置：

require(ggplot2)
require(dplyr)

df <- data.frame (Origin = c("Canada", "Canada","USA","USA"),
                  Year = c("2021", "2022","2021","2022"),
                  Sales = c(103, 192, 144, 210),
                  diff = c(89, " ",66," "),
                  perdiff = c(86.4, " ",45.83," "))

# 动态计算下划线宽度
df <- df %>% 
  mutate(label= ifelse(diff!=" ",paste0(diff,", ",perdiff,'%'),NA),
         has_underline = !is.na(label),
         underline_y = as.numeric(factor(Origin)) - 0.1,
         # 计算文本宽度并转换为x轴单位（系数80根据x轴范围调整）
         text_width = strwidth(label, units="inches") * 80,
         # 基于文本中心（x=200）计算下划线起止位置
         underline_x_start = 200 - text_width/2,
         underline_x_end = 200 + text_width/2)

ggplot(df, aes(fill=Year, y=Origin, x=Sales)) + 
  geom_bar(position="dodge", stat="identity")+ 
  geom_segment(aes(x=underline_x_start, xend=underline_x_end,
                   y=underline_y, yend=underline_y,
                   color=Origin),
               size=1.2,
               data = filter(df, has_underline)) +
  geom_text(aes(label=label, x=200), fontface='bold') +
  scale_x_continuous(breaks=seq(0,220,25))+
  scale_color_manual(values = c("Canada"="blue", "USA"="red"))+
  theme()

内容的提问来源于stack exchange，提问作者Brian Smith