如何从论文地图中提取数据重新绘制

今天给大家分享一个邪修技能：从论文地图中提取数据重新绘图。

经常我们会遇到一个问题，我们想使用参考文献中某个地图的数据，但是作者并不提供数据。这个时候该怎么办呢？

最近为了解决这个问题，我借助豆包编写了一个网页应用：provmapcolor

可以使用附件中提供的离线文件访问这个应用。

首次打开加载速度会较慢，耐心等待即可。

虽然理论上城市和区县地图也可以用这个方法提取数据，不过由于区域非常小，各个城市难以辨别，所以实操上几乎不能实现，所以这里只能提取省份地图的数据。

首先我们准备一幅地图：

把图片截取下上传到网站上：

然后按照标记控制里面的省份提示顺序在图片上逐个在各省份区域点击即可。需要注意，标记点并不需要刻意与点击点重合，只要鼠标点击位置准确即可：

对于实在难以点击到的小区域，可以点击颜色相同的其他区域。

看原图，数据一共是 5 组，我们可以在把最浅处颜色对应的值设定为 1，最深处的设置为 5，然后点击计算：

这个时候就给每个省份根据颜色深浅计算得到了一个数值，导出数据看看：

library(tidyverse)
readr::read_csv("省份颜色数值数据.csv") -> df
df %>%
  distinct(实际值)

#> # A tibble: 14 × 1
#>    实际值
#>     <dbl>
#>  1   3.71
#>  2   2.79
#>  3   2.08
#>  4   2.99
#>  5   2.00
#>  6   2.02
#>  7   4.12
#>  8   2.98
#>  9   4.00
#> 10   3.76
#> 11   5
#> 12   1
#> 13   1.97
#> 14   4.17

取整：

df %>%
  mutate(实际值 = round(实际值)) -> df

df %>%
  distinct(实际值)

#> # A tibble: 5 × 1
#>   实际值
#>    <dbl>
#> 1      4
#> 2      3
#> 3      2
#> 4      5
#> 5      1

df %>%
  filter(实际值 == 1)

#> # A tibble: 3 × 5
#>   省份名称       行政区划代码 `颜色值（16进制）` `颜色值（RGB值）` 实际值
#>   <chr>                 <dbl> <chr>              <chr>              <dbl>
#> 1 西藏自治区           540000 #FFFFFF            rgb(255,255,255)       1
#> 2 香港特别行政区       810000 #FFFFFF            rgb(255,255,255)       1
#> 3 澳门特别行政区       820000 #FFFFFF            rgb(255,255,255)       1

可以看到台湾被错误归类到了 4 类，所以得到的数据还是需要再进行适当的手动调整。不过我们可以先重新绘制下这幅图，然后比照原图再调整。

使用 R 语言的话，可以学习这个课程：

使用 R 语言绘制历年中国省市区县地图（小地图版本+长版）：https://rstata.duanshu.com/#/brief/course/379d19770956478ebc4d919910fca74c

# 重命令变量名称
df %>%
  rename(省 = 省份名称, 省代码 = 行政区划代码) -> df

# 这里的调整是根据后面的绘图结果进行的
df %>%
  mutate(实际值 = if_else(省 == "台湾省", 1, 实际值),
         实际值 = if_else(省 == "天津市", 2, 实际值),
         实际值 = if_else(省 == "北京市", 3, 实际值),
         实际值 = if_else(省 == "上海市", 2, 实际值)) -> df

# 中国地图通常使用这样的坐标系：
library(sf)
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("2021行政区划/省.shp") %>%
  select(-contains("类型")) %>%
  st_transform(mycrs) %>%
  st_make_valid() -> prov
read_sf("海岸线/海岸线.shp") %>%
  st_transform(mycrs) -> hax
read_sf("九段线.geojson") %>%
  st_transform(mycrs) -> jdx

# 合并绘图数据和地图数据
prov %>%
  left_join(df) -> mydata

# 然后就可以绘图了：
# 颜色选择：<https://tidyfriday.cn/colors>

library(ggspatial)
ggplot(mydata) +
  geom_sf(aes(fill = factor(实际值)),
          color = "black", linewidth = 0.1) +
  geom_sf(data = jdx,
          color = "#A29AC4", linewidth = 0.6) +
  geom_sf(data = hax,
          color = "#0055AA", linewidth = 0.3) +
  stat_sf_coordinates(data = mydata,
                      geom = "text", color = "black",
                      aes(label = 省), family = cnfont,
                      fun.geometry = st_point_on_surface,
                      size = 3) +
  scale_fill_manual(breaks = 1:5,
                    values = c("white", "#cccccc", "#969696", "#636363", "#252525"),
                    labels = c("No data", "0~20", "20~50", "50~100", "100~200"),
                    name = "2011年食源性疾病事件数") +
  ggthemes::theme_map(base_family = cnfont) +
  theme(legend.position.inside = c(0, 0.15),
        plot.background = element_rect(fill = "white", color = "white"),
        legend.key.height = unit(6, "mm"),
        legend.key.width = unit(16, "mm"),
        legend.key.spacing.y = unit(3, "mm"),
        legend.title = element_text(size = 12)) +
  annotation_scale(location = "bl",
                   width_hint = 0.3,
                   text_family = cnfont) +
  annotation_north_arrow(
    location = "tr",
    which_north = "false",
    pad_y = unit(0.1, "cm"),
    style = north_arrow_fancy_orienteering(
      text_family = cnfont
    )
  ) -> p5

ggsave("pic5.png", width = 10, height = 8.5, device = png)

这样基本就重现了这幅地图。

如果想要使用 Stata 绘制，感兴趣的小伙伴也可以学习这个课程：

使用 Stata 绘制历年中国省级行政区划（小地图版本 + 长版）：https://rstata.duanshu.com/#/brief/course/e194d75fe1674f7c8921daec1ece7f7d

点击这里跳转到 RStata 短书平台获取附件：如何从论文地图中提取数据重新绘制