在中国地图上填充离散变量

在中国地图上填充离散变量

继续昨天的话题,昨天我们介绍了如何使用 ggplot2 + sf 绘制中国各级行政地图。然后在地图上填充了随机生成的数据。需要注意的是,我们生成的随机数据是一个连续变量,所以我们使用的 scale_fill_viridis_c() 方案进行颜色映射。实际工作中我们还有可能会遇到离散变量的情形,或者需要把连续变量分割成离散变量进行绘图的情形。本文就介绍了如何进行这两种操作。

首先,同样我们先加载所需的 R 包和读入相关的数据集:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
library(ggplot2)
library(sf)
library(tidyverse)
library(hrbrthemes)
# 设置绘图主题
enfont = "CascadiaCode-Regular"
cnfont = "STYuanti-SC-Regular"
theme_set(theme_ipsum(base_family = enfont))
mapdata <- read_sf("chinamap/中国省界.shp")
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
10
# 生成一个 level 变量,这个变量是从字母 ABCDE 里面采用有放回抽取的方式随机抽 34 个。
mapdata$level <- sample(LETTERS[1:5], 34, replace = TRUE)

glimpse(mapdata)

## Observations: 34
## Variables: 3
## $ NAME <chr> "黑龙江", "新疆", "山西", "宁夏", "西藏", "山东", "河南", "江苏", "安徽", "湖北",…
## $ geometry <MULTIPOLYGON [m]> MULTIPOLYGON (((1329152 561..., MULTIPOLYGON ((…
## $ level <chr> "C", "C", "D", "E", "B", "C", "B", "A", "E", "A", "B", "A", …

可以看到这里的 level 变量的类型是 character。在绘图的时候 ggplot2
会自动将 character 转换成因子变量:

R
1
2
3
4
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = level)) +
geom_sf(data = mapborder, aes(geometry = geometry))

默认的颜色映射方案不是很好看,下面我们把这个图调整下:

R
1
2
3
4
5
6
7
8
9
10
11
12
# install.packages("worldtilegrid", repos = "https://cinc.rud.is")
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = level),
size = 0.05, color = "white") +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05, color = "white") +
scale_fill_viridis_d() +
hrbrthemes::theme_ft_rc(base_family = enfont) +
labs(title = "China Map",
fill = "Level") +
worldtilegrid::theme_enhance_wtg()

切割连续变量为离散变量

先生成一列随机数据:

R
1
2
3
# 设定随机数种子
set.seed(1)
mapdata$pop <- round(runif(34, 0, 500))

首先我们可以观察一下 mapdata$pop 的分布,是个均匀分布,但是数据量很小,所以就不容易看出来是均匀分布:

R
1
hist(mapdata$pop)

R
1
2
3
4
5
6
7
8
9
10
11
12
13
# 使用分位数进行切割,例如我们想分成 4 组
nclass = 4

# 计算分位数
quantiles <- mapdata %>%
pull(pop) %>%
quantile(probs = seq(0, 1,
length.out = nclass + 1),
na.rm = TRUE) %>%
as.vector()
quantiles

## [1] 7.00 133.25 244.00 355.25 496.00

quantiles 有 5 个数,这是怎么来的呢?mapdata$pop 的范围是 7, 496,最小值是7,最大值是 496。中间三个分别是 25%、50% 和 75% 分位数。正好分成四段,加上缺失组一共五组:

  1. 最小值 ~ 25% 分位数;
  2. 25% 分位数 ~ 50% 分位数;
  3. 50% 分位数 ~ 75% 分位数;
  4. 75% 分位数 ~ 最大值;
  5. 最大值 ~ 缺失值(也就是缺失值了,当然这个数据里面没有缺失值的)。

再为每段添加一个标签:

R
1
2
3
4
5
6
7
8
9
10
library(purrr)
labels <- imap_chr(quantiles, function(., idx){
return(paste0(quantiles[idx], "m", " – ",
quantiles[idx + 1], "m"))
})
# 删除最后一个标签,要不然我们就会看到像 "484m - NA" 这样的标签:
labels <- labels[1:length(labels) - 1]
labels

## [1] "7m – 133.25m" "133.25m – 244m" "244m – 355.25m" "355.25m – 496m"

然后对变量进行分割:

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
mapdata <- 
mapdata %>%
mutate(
pop = cut(pop,
breaks = quantiles,
labels = labels,
include.lowest = TRUE)
)
unique(mapdata$pop)

## [1] 7m – 133.25m 133.25m – 244m 244m – 355.25m 355.25m – 496m
## Levels: 7m – 133.25m 133.25m – 244m 244m – 355.25m 355.25m – 496m

ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
size = 0.05, color = "white") +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05, color = "white") +
scale_fill_viridis_d() +
hrbrthemes::theme_ft_rc(base_family = enfont) +
labs(title = "China Map",
fill = "Level") +
worldtilegrid::theme_enhance_wtg()

scale

想要绘制一幅漂亮的地图,选择恰当的 scale 非常关键,scale 定义的是映射规则,例如上面的地图绘制中选择的 scale 是 scale_fill_viridis_d(),这意味着在绘图的过程中 ggplot2 会先为 pop 的每个值映射一个颜色(来自 viridis 调色板),然后再将这些颜色填充在相应的位置上,scale_fill_viridis_d() 的调色板是这样的:

R
1
2
viridis::viridis(n = 9) %>% 
scales::show_col()

还有很多 scale 可以选择,例如
scale_fill_brewer(),这个调色板非常常用,可以浏览这个网站选择恰当的调色板:ColorBrewer:
Color Advice for
Maps
,例如我们选择
Set2 这个调色板:

R
1
2
3
4
5
6
7
8
9
10
11
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
size = 0.05, color = "white") +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05, color = "white") +
scale_fill_brewer(palette = 'Paired') +
theme_modern_rc(base_family = enfont) +
labs(title = "China Map",
fill = "Level") +
worldtilegrid::theme_enhance_wtg()

这个调色板是这样的:

R
1
2
RColorBrewer::brewer.pal(name = "Paired", n = 12) %>% 
scales::show_col()

如果你觉得这些智能的调色板都不是很好用,可以使用 scale_fill_manual() 自行设定颜色映射规则:

R
1
2
3
4
5
mapdata$pop %>% 
unique() %>%
as.character()

## [1] "7m – 133.25m" "133.25m – 244m" "244m – 355.25m" "355.25m – 496m"

%>%
是管道操作符,可以把符号前面的操作结果返回给后面的函数的第一个参数,例如 x %>% f() 等价于 f(x),更多关于管道操作符的内容可以参考:czxa/hotkeys

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
size = 0.05, color = "white") +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05, color = "white") +
scale_fill_manual(
values = c(
"7m – 133.25m" = "#FB9A99",
"133.25m – 244m" = "#6A3D9A",
"244m – 355.25m" = "#FF7F00",
"355.25m – 496m" = "#33A02C"
)
) +
theme_modern_rc(base_family = enfont) +
labs(title = "China Map",
fill = "Level") +
worldtilegrid::theme_enhance_wtg()

连续变量的映射也可以自己设定映射规则:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
mapdata$pop2 <- round(runif(34, 100, 1000))
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop2),
size = 0.05, color = "white") +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05, color = "white") +
scale_fill_gradient(
name = "Level",
low = "#CAB2D6",
high = "#6A3D9A",
aesthetics = "fill"
) +
theme_modern_rc(base_family = enfont) +
labs(title = "China Map") +
worldtilegrid::theme_enhance_wtg()

该去那里寻找这些智能的 scale 呢?我推荐几个,仅供参考:

  1. ggthemes
R
1
2
3
4
5
6
7
8
9
10
11
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
size = 0.05, color = "white") +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05, color = "white") +
ggthemes::scale_fill_excel() +
theme_modern_rc(base_family = enfont) +
labs(title = "China Map",
fill = "Level") +
worldtilegrid::theme_enhance_wtg()

  1. tidyquant
R
1
2
3
4
5
6
7
8
9
10
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
size = 0.05, color = "white") +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05, color = "white") +
tidyquant::scale_fill_tq() +
labs(title = "China Map",
fill = "Level") +
worldtilegrid::theme_enhance_wtg()

  1. awtools
R
1
2
3
4
5
6
7
8
9
10
11
# devtools::install_github('awhstin/awtools')
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
size = 0.05, color = "white") +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05, color = "white") +
awtools::a_flat_fill() +
labs(title = "China Map",
fill = "Level") +
worldtilegrid::theme_enhance_wtg()

  1. ggrapid(实际上 ggrapid 包使用的调色板是 awtools::a_palette)
R
1
2
3
4
5
6
7
8
9
10
11
12
# devtools::install_github("konradsemsch/ggrapid")
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
size = 0.05, color = "white") +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05, color = "white") +
scale_fill_manual(values = awtools::a_palette) +
awtools::a_dark_theme(base_family = enfont) +
labs(title = "China Map",
fill = "Level") +
worldtilegrid::theme_enhance_wtg()

  1. hrbrthemes
R
1
2
3
4
5
6
7
8
9
10
11
12
# devtools::install_github("konradsemsch/ggrapid")
ggplot() +
geom_sf(data = mapdata, aes(geometry = geometry,
fill = pop),
size = 0.05, color = "white") +
geom_sf(data = mapborder, aes(geometry = geometry),
size = 0.05, color = "white") +
scale_fill_ipsum() +
theme_modern_rc(base_family = enfont) +
labs(title = "China Map",
fill = "Level") +
worldtilegrid::theme_enhance_wtg()

# R

评论

Your browser is out-of-date!

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

×