choropleth_map

数据与边界

economy_countries 提供 2023 年经济指标和 ISO3 代码。属性数据来自 Tessera CSV；Natural Earth 只负责国界几何，不提供着色数值。

library(dplyr)
library(sf)
library(rnaturalearth)
library(ggplot2)
library(scales)
library(biopalette)

economy <- read.csv(
  "content/tessera/data/csv/economy_countries.csv",
  na.strings = c("", "NA")
)

valid_gdp <- economy |>
  filter(!is.na(gdp_per_capita_usd), gdp_per_capita_usd > 0)

world_median <- median(valid_gdp$gdp_per_capita_usd)

economy_map_data <- economy |>
  mutate(
    relative_log2 = if_else(
      !is.na(gdp_per_capita_usd) & gdp_per_capita_usd > 0,
      log2(gdp_per_capita_usd / world_median),
      NA_real_
    )
  ) |>
  select(iso3, country, gdp_per_capita_usd, relative_log2)

world_sf <- ne_countries(scale = "medium", returnclass = "sf") |>
  mutate(
    map_key = if_else(is.na(iso_a3) | iso_a3 == "-99", adm0_a3, iso_a3)
  )

# 当前版本全部有效；只有检查失败时才进入几何修复流程。
stopifnot(all(st_is_valid(world_sf)))

# ISO3 对 ISO3，不使用国家名。
world_map <- world_sf |>
  left_join(economy_map_data, by = c("map_key" = "iso3"))

# 属性表里存在、底图里不存在的代码必须显式检查。
unmatched <- setdiff(economy_map_data$iso3, world_sf$map_key)
if (length(unmatched)) {
  message("Natural Earth 未匹配：", paste(unmatched, collapse = ", "))
}

map_colors <- get_palette("mitonuclear_blue", type = "sequential")
missing_color <- "#D7D6D0"

map_theme <- theme_void(base_size = 13) +
  theme(
    legend.position = "bottom",
    legend.title = element_text(face = "bold", size = 11),
    legend.text = element_text(size = 10),
    plot.title = element_text(face = "bold", size = 16, hjust = 0),
    plot.subtitle = element_text(color = "grey35", hjust = 0),
    plot.caption = element_text(color = "grey45", hjust = 0),
    plot.margin = margin(14, 14, 10, 14)
  )

A · 从低到高的连续渐进色阶

色阶限制固定为 -5 到 +5，即全球中位数的约 1/32 到 32 倍；极少数超出范围的值压到端点。每个颜色位置固定，切换年份时不会因为样本极值变化而重新解释同一种颜色。

#| fig: continuous
#| fig-width: 10
#| fig-height: 6.3
ggplot(world_map) +
  geom_sf(
    aes(fill = relative_log2),
    color = "white",
    linewidth = 0.12
  ) +
  scale_fill_gradientn(
    colors = map_colors,
    limits = c(-5, 5),
    breaks = c(-4, -2, 0, 2, 4),
    labels = c("1/16×", "1/4×", "Median", "4×", "16×"),
    oob = squish,
    na.value = missing_color,
    name = "GDP per capita\nrelative to median"
  ) +
  coord_sf(xlim = c(-180, 180), ylim = c(-60, 85), expand = FALSE) +
  labs(
    title = "GDP per capita relative to the global median",
    subtitle = paste0(
      "2023 · log₂ ratio · median $",
      comma(round(world_median))
    ),
    caption = "Economic data: World Bank WDI · Boundaries: Natural Earth · Grey: unavailable"
  ) +
  map_theme +
  theme(legend.key.width = unit(1.55, "cm"))

B · 固定倍数分箱

五档边界固定为中位数的 1/4、约 0.7、约 1.4 和 4 倍。它们来自 log₂ 空间中的 -2、-0.5、0.5 和 2，不是每次重算的分位数。

#| fig: binned
#| fig-width: 10
#| fig-height: 6.3
bin_breaks <- c(-Inf, -2, -0.5, 0.5, 2, Inf)
bin_levels <- c("≤ 1/4×", "1/4–0.7×", "0.7–1.4×", "1.4–4×", "≥ 4×")

world_map_binned <- world_map |>
  mutate(
    relative_band = cut(
      relative_log2,
      breaks = bin_breaks,
      labels = bin_levels,
      include.lowest = TRUE,
      ordered_result = TRUE
    )
  )

binned_colors <- map_colors[
  round(seq(1, length(map_colors), length.out = length(bin_levels)))
]
binned_palette <- setNames(binned_colors, bin_levels)

ggplot(world_map_binned) +
  geom_sf(
    aes(fill = relative_band),
    color = "white",
    linewidth = 0.12
  ) +
  scale_fill_manual(
    values = binned_palette,
    breaks = bin_levels,
    drop = FALSE,
    na.value = missing_color,
    na.translate = TRUE,
    name = "GDP per capita\nrelative to median"
  ) +
  coord_sf(xlim = c(-180, 180), ylim = c(-60, 85), expand = FALSE) +
  labs(
    title = "GDP per capita in five fixed bands",
    subtitle = "2023 · thresholds stay comparable across datasets and years",
    caption = "Economic data: World Bank WDI · Boundaries: Natural Earth · Grey: unavailable"
  ) +
  map_theme +
  theme(legend.key.width = unit(1.15, "cm"))

两种方法怎么选

1. 连续数据、需要保留细微差别 → A。
2. 定性色板、屏幕较小或读者只需要稳定档位 → B。
3. 跨年份比较 → 固定中心、固定限制或固定倍数边界；不要每年按各自分位数重新切。
4. 需要精确排名 → 不用地图，改画排序柱状图并标出有效样本量。

Palette Lab 固定使用相同的 relative_log2 指标：渐进与发散色板走连续插值，定性色板走五档固定分箱。改变的只是色板的呈现方式，国家、年份、指标和基准都不变。