R语言ggplot2绘制中国区域地图并添加河流信息的小栗子

2021-09-22 10:22:24 浏览数 (1)

今天的推文来自于公众号读者的投稿，作者 RGzxs，编辑排版由 小明 完成。

下面是正文

前几天看了几篇闫大佬绘制的中国沿海地区的地图（公众号：R语言数据分析指南），然后试着自己画了一下。大佬的代码里面只有中国主要河流的信息，没有区域河流信息。这几天我在网上找了找资料，将河流信息添加到地图上。

山东地图及青岛地图下载

因为要画的区域是黄海和胶州湾的地图，所以需要下载一个山东省地图和青岛地图。下载地址：http://datav.aliyun.com/tools/atlas/index.html#&lat=31.769817845138945&lng=104.29901249999999&zoom=4

web.png

这里复制JSON API的链接，然后使用迅雷下载。下载青岛地图的时候先点击山东省地图，然后再点击青岛地图。

设置工作目录

代码语言：javascript复制
getwd()
setwd("C:/Users/zxs/Desktop")
getwd()

加载R包

代码语言：javascript复制
package.list=c("geoviz","tidyverse","sf","terra","rasterVis","ggspatial",
               "rgdal","rnaturalearth","rnaturalearthdata","raster")

for (package in package.list) {
  if(!require(package,character.only=T,quietly=T)){
    install.packages(package)
    library(package,character.only = T)
  }
  
} #头一次这么批量加载R包

山东省沿海地图

代码语言：javascript复制
shp1 <- sf::read_sf("shandong.json")
p1<-ggplot() 
  geom_sf(data=shp1,aes(fill=NULL)) 
  annotation_scale(location="br") # 设置距离刻度尺
  #annotation_north_arrow(location="tl",style = north_arrow_nautical(
  #  fill=c("grey40","white"),line_col="grey20"
  #)) 
  labs(x=NULL,y=NULL) 
  geom_sf(data=shp1,fill="#AFB3B3",size=0.4,color="gray71") #添加地图边界
    xlim(118,123) ylim(34,38.5) 
  theme_bw() 
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        legend.title = element_blank()) 
  theme(plot.background = element_rect(fill="#9ECFDD",
                                       color="gray71",size = 0.5)) 
  annotation_north_arrow(location="tl",
                         style = north_arrow_fancy_orienteering(
                           fill = c("grey40","white"),
                           line_col = "grey20"))
p1

这里面通过xlim(118,123) ylim(34,38.5)设置地图范围。

image.png

绘制青岛地图

代码语言：javascript复制
shp2<- sf::read_sf("qingdao.json")
p2<-ggplot() 
  geom_sf(data=shp2,aes(fill=NULL)) 
  annotation_scale(location="br") # 设置距离刻度尺
  annotation_north_arrow(location="tl",style = north_arrow_nautical(
    fill=c("grey40","white"),line_col="grey20"
  )) 
  labs(x=NULL,y=NULL) 
  geom_sf(data=shp2,fill="#AFB3B3",size=0.4,color="gray71") #添加地图边界
  xlim(120,120.6) ylim(35.8,36.5) 
  theme_bw() 
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        legend.title = element_blank()) 
  theme(plot.background = element_rect(fill="#9ECFDD",
                                       color="gray71",size = 0.5)) 
  annotation_north_arrow(location="tl",
                         style = north_arrow_fancy_orienteering(
                           fill = c("grey40","white"),
                           line_col = "grey20"))
p2

image.png

下载河流信息网站

国家基础地理信息中心

https://www.webmap.cn/mapDataAction.do?method=forw&resType=5&storeId=2&storeName=国家基础地理信息中心&fileId=1A5CEBDB34C04A29AAB7E673930498E7

网站界面 (网站需要注册)

添加河流信息

代码语言：javascript复制
river1<-sf::read_sf("/j51c004001/j51c004001/hydl.shp")
p3<-ggplot() 
  geom_sf(data=shp2,aes(fill=NULL)) 
  annotation_scale(location="br") # 设置距离刻度尺
  annotation_north_arrow(location="tl",style = north_arrow_nautical(
    fill=c("grey40","white"),line_col="grey20"
  )) 
  labs(x=NULL,y=NULL) 
  geom_sf(data=shp2,fill="#AFB3B3",size=0.4,color="gray71") #添加地图边界
  xlim(120,120.6) ylim(35.8,36.5) 
  geom_sf(data = river1,col='#87CEEB',size=0.5) 
  theme_bw() 
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        legend.title = element_blank()) 
  theme(plot.background = element_rect(fill="#9ECFDD",
                                       color="gray71",size = 0.5)) 
  annotation_north_arrow(location="tl",
                         style = north_arrow_fancy_orienteering(
                           fill = c("grey40","white"),
                           line_col = "grey20"))
p3

image.png

现在把胶州湾地区所有的河流都画到地图上了，我们不需要这么多，需要对河流进行筛选

代码语言：javascript复制
river1<-sf::read_sf("j51c004001/j51c004001/hydl.shp")
#筛选目标河流
river12<-filter(river1,river1$NAME=="大沽河")

p4<-ggplot() 
  geom_sf(data=shp2,aes(fill=NULL)) 
  annotation_scale(location="br") # 设置距离刻度尺
  annotation_north_arrow(location="tl",style = north_arrow_nautical(
    fill=c("grey40","white"),line_col="grey20"
  )) 
  labs(x=NULL,y=NULL) 
  geom_sf(data=shp2,fill="#AFB3B3",size=0.4,color="gray71") #添加地图边界
  xlim(120,120.6) ylim(35.8,36.5) 
  geom_sf(data = river12,col='#87CEEB',size=0.5) 
  theme_bw() 
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        legend.title = element_blank()) 
  theme(plot.background = element_rect(fill="#9ECFDD",
                                       color="gray71",size = 0.5)) 
  annotation_north_arrow(location="tl",
                         style = north_arrow_fancy_orienteering(
                           fill = c("grey40","white"),
                           line_col = "grey20"))
p4

image.png

最后是拼图

代码语言：javascript复制
library(patchwork)
p3 p4

image.png

欢迎大家关注我的公众号

小明的数据分析笔记本

今天推文的示例数据和代码可以在公众号后台留言 20210901 获取（精确匹配开头结尾都不能有空格）

小明的数据分析笔记本 公众号 主要分享：1、R语言和python做数据分析和数据可视化的简单小例子；2、园艺植物相关转录组学、基因组学、群体遗传学文献阅读笔记；3、生物信息学入门学习资料及自己的学习笔记！

数据分析 r语言

0 人点赞