使用 R 语言绘图展示 2020 年中国各省市地区生产总值（地图 + 柱状图）

之前从 GitHub 上看到过不少类似的图表，就想着其实也可以绘制一副中国的。本次课程我们就以之前讲解的「使用 R 语言绘制中国省级地图」课程中的数据为底图来绘制：

通常大家会喜欢把柱状图放到地图的右边，不过因为国内地图的审图要求不能存在压盖南海诸岛的问题，所以我把柱状图调整到了左边。

使用的数据是 2020年中国各省市地区生产总值.csv，地图数据我们使用的是 2020 年中国行政区划。

首先加载所需的 R 包：

library(ggspatial)
library(hrbrthemes)
library(tidyverse)
library(sf)
library(ggbump)
library(BBmisc)

ggbump 提供 geom_sigmoid() 图层，用以绘制 S 形连接线；BBmisc 包提供 normalsize() 函数，用以对数据进行变换，本案例中使用的是 range 方法，用以把数据尺度变换到到指定范围内。

在之前的课程中我们介绍了使用 showtext 包设置字体的方法：

# 设定 ggplot2 绘图主题
# 字体设置
library(showtext)
showtext_auto(enable = TRUE)
font_add("songti", regular = "song.otf")
cnfont <- "songti"

theme_set(
  theme_ipsum(base_family = cnfont) +
    theme(axis.text.x = element_blank(),
          axis.text.y = element_blank(),
          axis.title.x = element_blank(),
          axis.title.y = element_blank(),
          panel.grid.major = element_blank())
)

读取 2020 年中国省级行政区划：

mycrs <- "+proj=aea +lat_0=0 +lon_0=105 +lat_1=25 +lat_2=47 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs"
read_sf("2020行政区划/省.shp") %>%
  st_transform(mycrs) %>%
  rename(prov = 省) -> prov
read_sf("海岸线/海岸线.shp") %>%
  st_transform(mycrs) -> hax
read_sf("九段线.geojson") %>%
  st_transform(mycrs) -> jdx

配色网站：https://tidyfriday.cn/colors

直接绘制出来的地图会是这个样子的：

ggplot() +
  geom_sf(data = prov, fill = NA,
          color = "gray10", size = 0.1) +
  geom_sf(data = hax, color = "#0055AA", size = 0.5) +
  geom_sf(data = jdx, color = "black", size = 0.5)

这个地图的坐标范围是：

st_bbox(prov)

#>       xmin       ymin       xmax       ymax
#> -2625762.0   407031.1  2207277.8  5921888.6

等下我们就会根据这个范围来构造用于绘制柱状图的辅助数据集。

读取 GDP 数据并与地图数据合并（使用省份的前两个字）：

# GDP 数据
read_csv("2020年中国各省市地区生产总值.csv") -> df
# 合并地图和 prov 数据
prov %>%
  mutate(z = str_sub(prov, 1, 2)) %>%
  left_join(
    df %>%
      mutate(z = str_sub(省份, 1, 2))
  ) %>%
  select(-z, -省份) -> prov

构造辅助数据集：

prov$地区生产总值 -> gdp
prov %>%
  st_geometry() %>%
  st_point_on_surface() %>%
  st_coordinates() %>%
  as_tibble() %>%
  bind_cols(
    tibble(y = normalize(rank(gdp),
                         range = c(407031.1, 5921888.6), # prov 的 ymin 和 ymax
                         method = "range"),
           prov = prov$prov,
           xend = -2625762.0, # prov 的 xmax
           x_axis_start = xend - 1200000,
           y_x = x_axis_start - normalize(gdp, range = c(1000000, 3000000),
                                          method = "range"),
           val_txt = paste0(format(gdp / 1000, digits = 0, nsmall = 2)))
  ) -> ranking

# 去除缺失的
ranking %>%
  dplyr::filter(!is.na(y_x)) -> ranking

通过下面的绘图过程，大家就会明白其中每个变量的用处和构造方法：

library(ggnewscale)
library(scico)

首先绘制基础的省份填充地图：

ggplot() +
  geom_sf(data = prov, aes(fill = 地区生产总值),
          color = "gray10", size = 0.1,
          show.legend = F, alpha = 0.2) +
  geom_sf(data = hax, color = "#0055AA", size = 0.5) +
  geom_sf(data = jdx, color = "black", size = 0.5) +
  scale_fill_scico(palette = "turku", direction = -1,
                   end = 0.8) -> p1
p1

绘制从地图到柱状图的 S 形连接线：

p1 + geom_sigmoid(data = ranking,
               aes(x = X, y = Y,
                   xend = x_axis_start - 0.2,
                   yend = y, group = prov, color = y),
               alpha = 0.6, smooth = 10, size = 1) -> p2
p2

柱状图（使用 geom_segment 绘制）：

p2 + geom_segment(data = ranking,
               aes(x = x_axis_start, y = y,
                   xend = y_x, yend = y,
                   color = y), alpha = .6, size = 1,
               lineend = "round") -> p3
p3

绘制 y 轴分割线：

p3 + geom_segment(data = ranking,
               aes(x = x_axis_start, y = 357031.1,
                   xend = x_axis_start, yend = 5921888.6),
               alpha = .6, size = 1.3, color = "white") -> p4
p4

添加地图上的散点：

p4 + geom_point(data = ranking,
             aes(x = X, y = Y, color = y), size = 2) -> p5
p5

添加省份标签：

p5 + geom_text(data = ranking,
            aes(x = x_axis_start - 40000,
                y = y + 40000,
                label = prov,
                color = y),
            hjust = 1, size = 2.5, nudge_y = 50000,
            family = cnfont) -> p6
p6

添加值标签：

p6 +
  geom_text(data = ranking,
            aes(x = y_x - 460000, y = y, label = val_txt,
                color = y), hjust = 0, size = 3,
            nudge_x = 10000, family = cnfont) -> p7
p7

其他设置：

p7 +
  coord_sf(clip = "off") +
  scale_fill_scico(palette = "turku", direction = -1,
                   end = 0.8) +
  scale_color_scico(palette = "turku", direction = -1,
                    end = 0.8) +
  labs(title = "2020 年中国各省市地区生产总值（单位：千亿）",
       subtitle = "绘制：微信公众号 RStata",
       caption = "数据来源：国家统计局") +
  theme(legend.position = "none",
        plot.background = element_rect(fill = "white",
                                       color = "white")) -> p

ggsave("pic2020.png", device = png, width = 12, height = 8)

完整代码为：

ggplot() +
  geom_sf(data = prov, aes(fill = 地区生产总值),
          color = "gray10", size = 0.1,
          show.legend = F, alpha = 0.2) +
  geom_sf(data = hax, color = "#0055AA", size = 0.5) +
  geom_sf(data = jdx, color = "black", size = 0.5) +
  scale_fill_scico(palette = "turku", direction = -1,
                   end = 0.8) +
  new_scale("fill") +
  # 从地图到柱状图的 S 形连接线：
  geom_sigmoid(data = ranking,
               aes(x = X, y = Y,
                   xend = x_axis_start - 0.2,
                   yend = y, group = prov, color = y),
               alpha = 0.6, smooth = 10, size = 1) +
  # 柱状图（使用 geom_segment 绘制）
  geom_segment(data = ranking,
               aes(x = x_axis_start, y = y,
                   xend = y_x, yend = y,
                   color = y), alpha = .6, size = 1,
               lineend = "round") +
  # y 轴分割线
  geom_segment(data = ranking,
               aes(x = x_axis_start, y = 357031.1,
                   xend = x_axis_start, yend = 5921888.6),
               alpha = .6, size = 1.3, color = "white") +
  # 地图上的散点
  geom_point(data = ranking,
             aes(x = X, y = Y, color = y), size = 2) +
  # 省份标签
  geom_text(data = ranking,
            aes(x = x_axis_start - 40000,
                y = y + 40000,
                label = prov,
                color = y),
            hjust = 1, size = 2.5, nudge_y = 50000,
            family = cnfont) +
  # 值标签
  geom_text(data = ranking,
            aes(x = y_x - 460000, y = y, label = val_txt,
                color = y), hjust = 0, size = 3,
            nudge_x = 10000, family = cnfont) +
  coord_sf(clip = "off") +
  scale_fill_scico(palette = "turku", direction = -1,
                   end = 0.8) +
  scale_color_scico(palette = "turku", direction = -1,
                    end = 0.8) +
  labs(title = "2020 年中国各省市地区生产总值（单位：千亿）",
       subtitle = "绘制：微信公众号 RStata",
       caption = "数据来源：国家统计局") +
  theme(legend.position = "none",
        plot.background = element_rect(fill = "white",
                                       color = "white"))

如果需要添加指北针和比例尺，可以使用：

p +
  annotation_scale(location = "bl",
                   width_hint = 0.15,
                   text_family = cnfont) +
  annotation_north_arrow(
    location = "tr",
    which_north = "false",
    pad_x = unit(0.75, "cm"),
    pad_y = unit(0.15, "cm"),
    style = north_arrow_fancy_orienteering(
      text_family = cnfont
    )
  )

点击这里跳转到 RStata 短书平台获取附件：使用 R 语言绘图展示 2020 年中国各省市地区生产总值（地图 + 柱状图）