使用 ggplot2 + sf 绘制中国地图

使用 ggplot2 + sf 绘制中国地图

使用 ggplot2 + sf 绘制地图可以使用 shp 数据,我提供的附件里有两个文件夹,一个是 chinamap,这个文件夹里面有很多数据,包括:

  1. 中国县界;
  2. 中国市界;
  3. 中国省界;
  4. 中国湖泊;
  5. 主要公路;
  6. 主要河流;
  7. 主要铁路;
  8. 县城驻地;
  9. 国界线;
  10. 地级城市驻地;
  11. 省会城市;
  12. 线状县界;
  13. 线状省界;
  14. 经纬网。

另一个文件夹是 chinaboundary 这里面有一个 china_official_boundary.shp 数据,这个边界含有九段线,所以这个非常重要。

视频讲解(上篇)

需要注意的是,绘图需要 shp 文件,但是其它类型的文件不能删除。

首先是导入所需的 R 包:

R
1
2
3
4
5
6
library(ggplot2)
library(sf)
library(tidyverse)
library(hrbrthemes)
# 设置绘图主题
theme_set(theme_ipsum(base_family = "CascadiaCode-Regular"))

绘制省级填充地图

首先读入中国省界的 shp 数据:

R
1
mapdata <- read_sf("chinamap/中国省界.shp")

查看 mapdata 的类别:

R
1
2
3
class(mapdata)

## [1] "sf" "tbl_df" "tbl" "data.frame"

可以看出我们得到的是个 sf 类数据,这是个非常方便使用的数据格式文件。

如果你想深入学习 ggplot2 的绘图方法,可以参考:ggplot2: Elegant Graphics for Data Analysis

R
1
2
ggplot(mapdata) + 
geom_sf()

可以看到,没有九段线,然后再读入国界数据:

R
1
2
3
4
mapborder <- read_sf("chinamap/国界线.shp")
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry)) +
geom_sf(data = mapborder, aes(geometry = geometry))

但是这个国界线数据的东南沿海部分有点不好看(这些黑点其实是东南沿海的岛屿),所以我们还是使用另外一个国界线数据:

R
1
2
3
4
mapborder <- read_sf("chinaboundary/china_official_boundary.shp")
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry)) +
geom_sf(data = mapborder, aes(geometry = geometry))

我现在手头上也没有各个省的数据,我们可以先随机生成一些数据:

R
1
2
3
4
5
6
7
8
9
mapdata$pop <- round(runif(34, 100, 1000))
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
color = "white",
size = 0.05) +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05) +
scale_fill_viridis_c()

由于我们生成的 pop 变量是个连续变量,所以需要使用连续的scale:scale_fill_viridis_c()

还可以再添加一些文字:

R
1
2
3
4
5
6
7
8
9
10
11
12
ggplot() + 
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
color = "white",
size = 0.05) +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05) +
scale_fill_viridis_c() +
labs(title = "China Map",
subtitle = "TidyFriday",
caption = "Source: Random data",
fill = "Population")

再调整下让这个图更好看些:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
theme_map <- function(...) {
theme_minimal() +
theme(
text = element_text(family = "CascadiaCode-Regular",
color = "black"),
# remove all axes
axis.line = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
# add a subtle grid
panel.grid.major = element_line(color = "#dbdbd9", size = 0.2),
panel.grid.minor = element_blank(),
# background colors
plot.background = element_rect(fill = "white",
color = NA),
panel.background = element_rect(fill = "white",
color = NA),
legend.background = element_rect(fill = "white",
color = NA),
# borders and margins
plot.margin = unit(c(.5, .5, .2, .5), "cm"),
panel.border = element_blank(),
panel.spacing = unit(c(-.1, 0.2, .2, 0.2), "cm"),
# titles
legend.title = element_text(size = 11),
legend.text = element_text(size = 9, hjust = 0.1, vjust = 1,
color = "black"),
plot.title = element_text(size = 15, hjust = 0.1,vjust = 1,
color = "black"),
plot.subtitle = element_text(size = 10, hjust = 0.1,
color = "black",
margin = margin(b = -0.1,
t = -0.1,
l = 2,
unit = "cm"),
debug = F),
# captions
plot.caption = element_text(size = 7,
hjust = .5,
margin = margin(t = 0.2,
b = 0,
unit = "cm"),
color = "#939184"),
...
)
}
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
color = "white",
size = 0.05) +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05) +
scale_fill_viridis_c() +
labs(title = "China Map",
subtitle = "TidyFriday",
caption = "Source: Random data",
fill = "Population") +
worldtilegrid::theme_enhance_wtg()

中国地图比较长,所以可以把图例放在左下方:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
ggplot() + 
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
color = "white",
size = 0.05) +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05) +
scale_fill_viridis_c() +
theme_map() +
theme(legend.position = c(0.2, 0.3),
legend.title = element_blank(),
legend.text = element_text(vjust = 0.5),
legend.background = element_blank())

经常需要组合多幅地图,可以使用 patchwork 包:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
# devtools::install_github("thomasp85/patchwork")
library(patchwork)
p <- ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
color = "white",
size = 0.05) +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05) +
scale_fill_viridis_c() +
theme_map()
{p + theme(legend.position = "none")} +
{p}

还可以为每个省添加标签,标签图层需要经纬度,所以我们先根据 geometry 计算每个省的质心,然后再叠加标签图层:

R
1
2
3
4
5
6
7
8
9
10
11
12
mapdata <- cbind(mapdata, st_coordinates(st_centroid(mapdata)))

ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
color = "white",
size = 0.05) +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05) +
geom_label(data = mapdata, aes(x = X, y = Y,
label = NAME), family = "STYuanti-SC-Regular") +
scale_fill_viridis_c()

以后会单独讲解如何设置字体。Windows 系统的用户可以先抛开字体设置,因为电脑默认支持中文绘图。但是上图中的标签遮盖问题很严重,使用 ggrepel 可以解决这个问题:

R
1
2
3
4
5
6
7
8
9
10
11
12
library(ggrepel)
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
color = "white",
size = 0.05) +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05) +
geom_label_repel(data = mapdata, aes(x = X, y = Y,
label = NAME),
family = "STYuanti-SC-Regular") +
scale_fill_viridis_c()

添加比例尺和指北针可以使用 ggspatial 包:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
library(ggspatial)
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
color = "white",
size = 0.05) +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05) +
geom_label_repel(data = mapdata, aes(x = X, y = Y,
label = NAME),
family = "STYuanti-SC-Regular") +
scale_fill_viridis_c() +
annotation_scale(location = "bl", width_hint = 0.3,
bar_cols = viridis::plasma(2)) +
annotation_north_arrow(location = "bl", which_north = "true",
pad_x = unit(0.75, "cm"),
pad_y = unit(0.5, "cm"),
style = north_arrow_fancy_orienteering(
line_col = viridis::plasma(2)[1],
text_col = viridis::plasma(2)[2],
fill = viridis::plasma(2)
))

县级地图

首先读入县级数据:

R
1
2
3
4
5
6
7
8
9
10
11
12
county <- read_sf("chinamap/中国县界.shp")
# 制造掉随机数据
county$pop <- round(runif(2391, 100, 1000))
ggplot() +
geom_sf(data = county, aes(geometry = geometry,
fill = pop),
color = "white",
size = 0.05) +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05) +
scale_fill_viridis_c() +
theme_map()

中国主要河流

如果想展示中国的主要河流,只需要再叠加一层河流图层就好了:

R
1
2
3
4
5
6
7
8
9
10
11
12
river <- read_sf("chinamap/主要河流.shp")
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
color = "white",
size = 0.05) +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05) +
geom_sf(data = river, aes(geometry = geometry),
size = 0.1, color = "lightblue") +
scale_fill_viridis_c() +
theme_map()

因为河流是线元素,所以使用 color 进行映射。

地图描点

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
city <- read_sf("chinamap/县城驻地.shp")
city$pop <- round(runif(2423, 100, 1000))
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry),
color = "white",
size = 0.05) +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05) +
geom_sf(data = city, aes(geometry = geometry,
color = pop,
fill = pop,
size = pop)) +
scale_color_viridis_c() +
scale_fill_viridis_c() +
theme_map()

还可以先计算质心,然后使用 geom_point() 绘制散点图层:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
city <- cbind(city, st_coordinates(st_centroid(city)))
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry),
color = "white",
size = 0.05) +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05) +
geom_point(data = city, aes(x = X,
y = Y,
color = pop,
size = pop)) +
scale_color_viridis_c() +
labs(x = "", y = "")

emmm,就不好看了哈哈。

# R

评论

Your browser is out-of-date!

Update your browser to view this website correctly. Update my browser now

×