复刻W.E.B DuBois地图：ggplot2颜色与箭头问题排查求助

核心问题梳理 #

1. 维度错误：Error in us_states_centroid_coords[, 1] : incorrect number of dimensions
2. 颜色渲染失效：指定的颜色无法正确映射到州多边形
3. 箭头绘制异常：尺寸过大、起始位置错误、方向不符合要求

分步修正方案 #

1. 修复维度错误 #

st_coordinates()返回的是矩阵类型，无法直接添加列。需先转换为data.frame再进行后续计算：

# 错误写法：直接给矩阵加列
us_states_centroid_coords <- st_coordinates(us_states_centroid_wgs84)
us_states_centroid_coords$angle <- atan2(...)

# 修正写法：先转成数据框
us_states_centroid_coords <- as.data.frame(st_coordinates(us_states_centroid_wgs84))
colnames(us_states_centroid_coords) <- c("centroid_lon", "centroid_lat")

2. 正确提取多边形右下角坐标 #

之前用凸包质心的方式无法得到真实的右下角，改为提取每个州多边形**最大经度（最右）+最小纬度（最下）**的近似点：

bottom_right_coords <- do.call(rbind, lapply(us_states$geometry, function(poly) {
  coords <- st_coordinates(poly)[,1:2]
  # 用经度减纬度的最大值定位右下角（经度越大越右，纬度越小越下）
  idx <- which.max(coords[,1] - coords[,2])
  coords[idx, ]
}))
bottom_right_coords <- as.data.frame(bottom_right_coords)
colnames(bottom_right_coords) <- c("bottom_right_lon", "bottom_right_lat")

3. 修复颜色渲染问题 #

无需将颜色转为因子，直接使用scale_fill_identity()应用数据中的原始颜色值，同时过滤空颜色的州：

# 过滤空颜色条目，避免无效映射
df_join_clean <- df_join[df_join$color != "", ]
us_states_data <- merge(us_states, df_join_clean, by.x = "NAME", by.y = "name")

# 直接使用数据中的颜色值
scale_fill_identity()

4. 修正箭头绘制逻辑 #

确保箭头使用合并后的数据源，从右下角指向质心，并调整尺寸为细线条：

geom_segment(data = us_states_data, 
             aes(x = bottom_right_lon, y = bottom_right_lat, 
                 xend = centroid_lon, yend = centroid_lat),
             arrow = arrow(length = unit(0.1, "cm"), type = "open", angle = 30),
             size = 0.2, color = "black")

完整修正代码 #

library(sf)
library(ggplot2)
library(tigris)

# 原始数据
df_join <- structure(list(name = c("New Mexico", "Puerto Rico", "California", 
                            "Alabama", "Georgia", "Arkansas", "Oregon", "Mississippi", "Colorado", 
                            "Utah", "Oklahoma", "Tennessee", "Wyoming", "Indiana", "Massachusetts", 
                            "Idaho", "Alaska", "Nevada", "Illinois", "Vermont", "New Jersey", 
                            "North Dakota", "Iowa", "South Carolina", "Arizona", "Delaware", 
                            "District of Columbia", "Guam", "American Samoa", "Connecticut", 
                            "New Hampshire", "Nebraska", "Washington", "South Dakota", "Texas", 
                            "Kentucky", "Ohio", "Wisconsin", "Pennsylvania", "Missouri", 
                            "North Carolina", "Virginia", "West Virginia", "Louisiana", "New York", 
                            "Michigan", "Kansas", "Florida", "United States Virgin Islands", 
                            "Montana", "Minnesota", "Minnesota", "Maryland", "Maine", "Hawaii", 
                            "Commonwealth of the Northern Mariana Islands", "Rhode Island"),
                   color = c("#d2b48c", "", "#ffd700", "#00aa00", "#000000", 
                             "#dc143c", "#dc143c", "#d2b48c", "#dc143c", "#654321", "#ffd700", 
                             "#654321", "#ffd700", "#ffb6c1", "#d2b48c", "#4682b4", "", 
                             "#ffb6c1", "#ffd700", "#ffb6c1", "#ffd700", "#d2b48c", "#696969", 
                             "#4682b4", "#4682b4", "#d2b48c", "", "", "", "#d2b48c", "#ffb6c1", 
                             "#ffb6c1", "#696969", "#654321", "#696969", "#696969", "#d2b48c", 
                             "#4682b4", "#dc143c", "#4682b4", "#ffb6c1", "#00aa00", "#ffa500", 
                             "#ffb6c1", "#4682b4", "#654321", "#00aa00", "#ffd700", "", 
                             "#00aa00", "#ffb6c1", "#ffb6c1", "#ffd700", "#ffd700", "", 
                             "", "#dc143c"),
                   present_location = c(
      38L, NA, 254L, 24556L, 798747L, NA, 32L, 589L, 285L, 9L, 
      68L, 9998L, 21L, 193L, 293L, 7L, 12142L, 1L, 556L, 11L, 
      229L, 5L, 120L, 347L, 48L, 12L, 320L, NA, NA, 97L, 14L, 
      121L, 44L, 18L, 12016L, 424L, 474L, 27L, 321L, 480L, 462L, 
      223L, 40L, 6025L, 866L, 51L, 480L, 3981L, 223L, NA, 62L, 
      38L, 148L, 7L, NA, 48L, 44L
    ) ))

# 读取州边界并过滤本土州
us_states <- states(cb = TRUE)
us_states <- us_states[us_states$REGION %in% c("3", "4", "5"),]

# 计算质心并转换坐标
us_states_centroid <- st_centroid(us_states)
us_states_centroid_wgs84 <- st_transform(us_states_centroid, 4326)

# 提取质心坐标
centroid_coords <- as.data.frame(st_coordinates(us_states_centroid_wgs84))
colnames(centroid_coords) <- c("centroid_lon", "centroid_lat")
us_states <- cbind(us_states, centroid_coords)

# 提取每个州的右下角坐标
bottom_right_coords <- do.call(rbind, lapply(us_states$geometry, function(poly) {
  coords <- st_coordinates(poly)[,1:2]
  idx <- which.max(coords[,1] - coords[,2])
  coords[idx, ]
}))
bottom_right_coords <- as.data.frame(bottom_right_coords)
colnames(bottom_right_coords) <- c("bottom_right_lon", "bottom_right_lat")
us_states <- cbind(us_states, bottom_right_coords)

# 合并颜色数据并过滤空值
df_join_clean <- df_join[df_join$color != "", ]
us_states_data <- merge(us_states, df_join_clean, by.x = "NAME", by.y = "name")

# 绘制地图
ggplot() +
  geom_sf(data = us_states_data, aes(fill = color), color = "black", size = 0.2) +
  # 绘制从右下角指向质心的细箭头
  geom_segment(data = us_states_data, 
               aes(x = bottom_right_lon, y = bottom_right_lat, 
                   xend = centroid_lon, yend = centroid_lat),
               arrow = arrow(length = unit(0.1, "cm"), type = "open", angle = 30),
               size = 0.2, color = "black") +
  # 直接应用原始颜色值
  scale_fill_identity() +
  # 添加数值标签
  geom_text(data = us_states_data, 
            aes(x = centroid_lon - 0.5, y = centroid_lat, label = present_location), 
            size = 3, hjust = 1, vjust = 0.5) +
  labs(title = "复刻W.E.B DuBois美国州地图", 
       fill = "颜色") +
  theme_void() +
  theme(plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
        legend.position = "none") +
  xlim(c(-125, -66)) + ylim(c(25, 50))

关键说明 #

• 使用scale_fill_identity()直接映射数据中的颜色值，避免因子转换导致的映射错误
• 右下角坐标采用经度-纬度最大值的近似算法，更贴合多边形实际右下角位置
• 箭头调整为细线条+小尺寸开放样式，匹配DuBois地图的复古视觉风格

内容的提问来源于stack exchange，提问作者Patrick Stephenson