如何绘制高度宽度可变且无拥挤的2020美国大选ggplot条形图？

针对2020年美国总统选举，我尝试用ggplot绘制条形图：

• 条形颜色标识各州获胜政党
• 条形高度代表获胜优势
• 条形宽度对应各州选举人票数量

但使用geom_bar（或geom_col）时，部分条形出现拥挤现象，且偏离对应州的刻度线。我希望条形能居中对齐刻度线，且条形间留白最少。尝试过多种dodge参数设置均无效；将选举人票变量EC除以更大数值虽能缓解拥挤，但会丢失各州贡献度差异，并不理想。

可复现代码：

library(tidyverse)

## 州缩写
st  <- c("AL", "AK", "AZ", "AR", "CA", "CO", "CT", "DE", "DC", "FL",
         "GA", "HI", "ID", "IL", "IN", "IA", "KS", "KY", "LA", "ME",
         "MD", "MA", "MI", "MN", "MS", "MO", "MT", "NE", "NV", "NH",
         "NJ", "NM", "NY", "NC", "ND", "OH", "OK", "OR", "PA", "RI",
         "SC", "SD", "TN", "TX", "UT", "VT", "VA", "WA", "WV", "WI",
         "WY")

## 拜登在两党得票率
demvs  <- c(0.371, 0.447, 0.502, 0.358, 0.649, 0.569, 0.602, 0.596,
            0.945, 0.483, 0.501, 0.65, 0.341, 0.587, 0.418, 0.458,
            0.425, 0.368, 0.405, 0.547, 0.67, 0.671, 0.514, 0.536,
            0.416, 0.422, 0.416, 0.402, 0.512, 0.537, 0.581, 0.555,
            0.617, 0.493, 0.328, 0.459, 0.331, 0.583, 0.506, 0.606,
            0.441, 0.366, 0.382, 0.472, 0.393, 0.683, 0.552, 0.599,
            0.302, 0.503, 0.275)

## 各州获胜政党
ptywon  <- c("R", "R", "D", "R", "D", "D", "D", "D", "D", "R", "D",
             "D", "R", "D", "R", "R", "R", "R", "R", "D", "D", "D",
             "D", "D", "R", "R", "R", "R", "D", "D", "D", "D", "D",
             "R", "R", "R", "R", "D", "D", "D", "R", "R", "R", "R",
             "R", "D", "D", "D", "R", "D", "R")

## 获胜优势
marg  <- c(0.258, 0.105, 0.003, 0.284, 0.298, 0.139, 0.204, 0.193,
           0.889, 0.034, 0.002, 0.301, 0.318, 0.173, 0.164, 0.084,
           0.15, 0.264, 0.189, 0.093, 0.341, 0.342, 0.028, 0.073,
           0.168, 0.157, 0.168, 0.196, 0.024, 0.075, 0.161, 0.11,
           0.234, 0.014, 0.344, 0.082, 0.339, 0.166, 0.012, 0.212,
           0.119, 0.269, 0.237, 0.057, 0.214, 0.366, 0.103, 0.199,
           0.396, 0.006, 0.45)

## 各州选举人票数量
EC  <- c(9, 3, 11, 6, 55, 9, 7, 3, 3, 29, 16, 4, 4, 20, 11, 6, 6, 8,
         8, 4, 10, 11, 16, 10, 6, 10, 3, 5, 6, 4, 14, 5, 29, 15, 3,
         18, 7, 7, 20, 4, 9, 3, 11, 38, 6, 3, 13, 12, 5, 10, 3)

df  <- data.frame(st,demvs,ptywon,marg)

## 绘制条形图：颜色表示获胜政党，高度表示优势，宽度表示选举人票
ggplot(df, aes(x=reorder(st,-demvs),y=marg,fill=ptywon,
                      width=EC/10)) +
    geom_bar(stat="identity",position="dodge2") +
    scale_fill_manual(values=c("blue2", "red3")) +
    theme_minimal()  +
    labs(x="State",y="Margin of victory",fill="Winning party") +
    theme(axis.text.x = element_text(angle = 45, hjust = 1),
          legend.position="top")

问题根源在于：当x轴是离散型变量（州缩写）时，geom_bar的position="dodge"或dodge2会尝试分组调整位置，但自定义宽度会打破默认的对齐逻辑。正确的做法是不使用dodge参数，直接把x轴转换为连续型变量，手动控制每个条形的位置和宽度，确保对齐刻度线。

修改后代码 #

library(tidyverse)

## 州缩写
st  <- c("AL", "AK", "AZ", "AR", "CA", "CO", "CT", "DE", "DC", "FL",
         "GA", "HI", "ID", "IL", "IN", "IA", "KS", "KY", "LA", "ME",
         "MD", "MA", "MI", "MN", "MS", "MO", "MT", "NE", "NV", "NH",
         "NJ", "NM", "NY", "NC", "ND", "OH", "OK", "OR", "PA", "RI",
         "SC", "SD", "TN", "TX", "UT", "VT", "VA", "WA", "WV", "WI",
         "WY")

## 拜登在两党得票率
demvs  <- c(0.371, 0.447, 0.502, 0.358, 0.649, 0.569, 0.602, 0.596,
            0.945, 0.483, 0.501, 0.65, 0.341, 0.587, 0.418, 0.458,
            0.425, 0.368, 0.405, 0.547, 0.67, 0.671, 0.514, 0.536,
            0.416, 0.422, 0.416, 0.402, 0.512, 0.537, 0.581, 0.555,
            0.617, 0.493, 0.328, 0.459, 0.331, 0.583, 0.506, 0.606,
            0.441, 0.366, 0.382, 0.472, 0.393, 0.683, 0.552, 0.599,
            0.302, 0.503, 0.275)

## 各州获胜政党
ptywon  <- c("R", "R", "D", "R", "D", "D", "D", "D", "D", "R", "D",
             "D", "R", "D", "R", "R", "R", "R", "R", "D", "D", "D",
             "D", "D", "R", "R", "R", "R", "D", "D", "D", "D", "D",
             "R", "R", "R", "R", "D", "D", "D", "R", "R", "R", "R",
             "R", "D", "D", "D", "R", "D", "R")

## 获胜优势
marg  <- c(0.258, 0.105, 0.003, 0.284, 0.298, 0.139, 0.204, 0.193,
           0.889, 0.034, 0.002, 0.301, 0.318, 0.173, 0.164, 0.084,
           0.15, 0.264, 0.189, 0.093, 0.341, 0.342, 0.028, 0.073,
           0.168, 0.157, 0.168, 0.196, 0.024, 0.075, 0.161, 0.11,
           0.234, 0.014, 0.344, 0.082, 0.339, 0.166, 0.012, 0.212,
           0.119, 0.269, 0.237, 0.057, 0.214, 0.366, 0.103, 0.199,
           0.396, 0.006, 0.45)

## 各州选举人票数量
EC  <- c(9, 3, 11, 6, 55, 9, 7, 3, 3, 29, 16, 4, 4, 20, 11, 6, 6, 8,
         8, 4, 10, 11, 16, 10, 6, 10, 3, 5, 6, 4, 14, 5, 29, 15, 3,
         18, 7, 7, 20, 4, 9, 3, 11, 38, 6, 3, 13, 12, 5, 10, 3)

# 处理数据：添加连续型x坐标，计算矩形边界
df  <- data.frame(st,demvs,ptywon,marg,EC) %>%
  mutate(
    # 按demvs降序排序后，分配连续x值
    x = row_number(),
    # 缩放系数：调整选举人票的宽度比例，避免过宽
    scale_factor = 20,
    xmin = x - (EC/2)/scale_factor,
    xmax = x + (EC/2)/scale_factor,
    ymin = 0,
    ymax = marg
  )

# 绘制图形
ggplot(df) +
  # 使用geom_rect绘制条形，精准控制位置和宽度
  geom_rect(aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax, fill=ptywon)) +
  # 设置x轴刻度和标签，对齐到每个州的x坐标
  scale_x_continuous(breaks=df$x, labels=df$st) +
  scale_fill_manual(values=c("blue2", "red3")) +
  theme_minimal() +
  labs(x="State", y="Margin of victory", fill="Winning party") +
  theme(
    axis.text.x = element_text(angle=45, hjust=1),
    legend.position="top"
  )

关键说明 #

• geom_rect直接定义每个条形的四个边界，完全避免了geom_bar的自动分组对齐问题
• 连续型x轴的刻度设置为每个州的x值，确保标签和条形完全居中对齐
• scale_factor可以微调：如果觉得条形太宽就增大数值，太窄就减小，不会丢失选举人票的相对差异
• 不需要任何dodge参数，条形间的留白由scale_factor和EC数值自动控制，达到最小化留白的效果

内容的提问来源于stack exchange，提问作者Greg W.