# 1、采样地图与数据映射地图
# 2、世界地图与中国地图
# 3、绘制中国地图的时候，一点都不能少！
#采样地图
library(ggplot2)
library()
worldData <- map_data('world')
set.seed(2019)
library(dplyr)
##
## 载入程辑包：'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
locations <- tibble(long = c(116.2,-82.22,2.20,23.46,77.13,
32.35,-77.02,149.08),
lat = c(39.55,23.08,48.5,37.58,28.37,
15.31,39.91,-35.15),
size = sample(50:100,8))
ggplot() + geom_polygon(data=worldData,
aes(x=long, y=lat, group = group),
colour="black",size = .2,fill = 'white') +
theme_void()+labs(x="", y="")+ # 去掉背景网格、横纵坐标轴 的主题函数
geom_point(data = locations,aes(x = long, y = lat, size = size),
color = 'gray30',shape = 21, fill = '#ef4b4b')+
scale_size_continuous(range = c(3,5))
#展示单个变量的大小
country_asr <- read.csv('code85data.csv')
country_asr$location <- as.character(country_asr$location)
# 匹配country_asr 和 location 中的地名，改为相同地名
country_asr$location[country_asr$location == 'United States'] = 'USA'
country_asr$location[country_asr$location == 'Russian Federation'] = 'Russia'
country_asr$location[country_asr$location == 'The Gambia'] = 'Gambia'
country_asr$location[country_asr$location == 'United Kingdom'] = 'UK'
country_asr$location[country_asr$location == 'The Bahamas'] = 'Bahamas'
country_asr$location[country_asr$location == 'Congo'] = 'Republic of Congo'
country_asr$location[country_asr$location == "Cote d'Ivoire"] = 'Ivory Coast'
worldData <- map_data('world')
total <- full_join(worldData,country_asr,by = c('region'='location'))
p <- ggplot()
p + geom_polygon(data=total,
aes(x=long, y=lat, group = group,fill=val),
colour="black",size = .2) +
scale_fill_gradient(low = "white", high = "red")+
theme_void()+labs(x="", y="")+
guides(fill = guide_colorbar(title='Incidence'))+
theme(legend.position = 'right')
# 由于外蒙古的颜色非常深，导致其他国家的颜色看不出区别，因此将连续型变量 离散化
# 利用新切分的离散变量，进行重新画图，就可以看出各个国家的差异
total <- total %>% mutate(val2 = cut(val, breaks = c(0,5,7.5,10,15,20,30,110),
labels = c("0~5.0","5.1~7.5","7.6~10.0",
"10.1~15.0","15.1~20.0",
"20.1~30.0",">30.1"),
include.lowest = T,right = T))
p + geom_polygon(data=total,
aes(x=long, y=lat, group = group,fill=val2),
colour="black",size = .2) +
scale_fill_manual(values = c('#fee5d9','#fcbba1','#fc9272','#fb6a4a',
'#ef3b2c','#cb181d','#99000d'))+
theme_void()+labs(x="", y="")+
guides(fill = guide_legend(title='Incidence'))+
theme(legend.position = 'right')
#去除南极洲
total2 <- total %>% filter(val2!=0)
p + geom_polygon(data=total2,
aes(x=long, y=lat, group = group,fill=val2),
colour="black",size = .2) +
scale_fill_manual(values = c('#fee5d9','#fcbba1','#fc9272','#fb6a4a',
'#ef3b2c','#cb181d','#99000d'))+
theme_void()+labs(x="", y="")+
guides(fill = guide_legend(title='Incidence'))+
theme(legend.position = 'right')
#展示/反应 某个变量的变化趋势
set.seed(2019)
apcs <- tibble(apc = c(rnorm(nrow(country_asr)-10,0,2),rep(0,10)),
location = unique(country_asr$location))
worldData <- map_data('world')
total <- full_join(worldData,apcs,by = c('region'='location'))
p <- ggplot()
p + geom_polygon(data=total,
aes(x=long, y=lat, group = group,fill=apc),
colour="black",size = .2) +
scale_fill_gradient2(low = "forestgreen",mid = 'white', high = "red",
midpoint = 0)+ # scale_fill_gradient2 颜色渐变
theme_void()+labs(x="", y="")+
guides(fill = guide_colorbar(title='APC'))+
theme(legend.position = 'right')
# 红色表示上升趋势，绿色为下降趋势，白色为趋势没有改变
# 将连续变量 切分为离散变量，进行重新画图
total <- total %>% mutate(apc2 = cut(apc, breaks = c(-5.5,-2.5,-0.0001,0.0001,
2.5,5.3),
labels = c("-5.50~-2.50",
"-2.49~0",0,
"0~2.50",
"2.51~5.30"),
include.lowest = T,right = T))
p + geom_polygon(data=total,
aes(x=long, y=lat, group = group,fill=apc2),
colour="black",size = .2) +
scale_fill_manual(values = c('#238b45','#a1d99b','gray90',
'#fcbba1','#fb6a4a'))+
theme_void()+labs(x="", y="")+
guides(fill = guide_legend(title='APC'))+
theme(legend.position = 'right')
#我爱我的祖国
# ggplot2中内置的地图没有台湾省，
# 到国家基础地理信息中心 的网站上 下载完整的shp文件
# install.packages('rgdal')
library(rgdal)
## 载入需要的程辑包：sp
## Please note that rgdal will be retired by the end of 2023,
## plan transition to sf/stars/terra functions using GDAL and PROJ
## at your earliest convenience.
##
## rgdal: version: 1.5-30, (SVN revision 1171)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 3.4.2, released 2022/03/08
## Path to GDAL shared files: /Library/Frameworks/R.framework/Versions/4.2/Resources/library/rgdal/gdal
## GDAL binary built with GEOS: FALSE
## Loaded PROJ runtime: Rel. 8.2.1, January 1st, 2022, [PJ_VERSION: 821]
## Path to PROJ shared files: /Library/Frameworks/R.framework/Versions/4.2/Resources/library/rgdal/proj
## PROJ CDN enabled: FALSE
## Linking to sp version:1.4-6
## To mute warnings of possible GDAL/OSR exportToProj4() degradation,
## use options("rgdal_show_exportToProj4_warnings"="none") before loading sp or rgdal.
getwd()
## [1] "/Volumes/岳_T7/2022卓越计划/0-卓越计划-笔记/第2次考核_SCI绘图之道-笔记"
china <- readOGR('ChinaMap/bou2_4m/bou2_4p.shp')
## OGR data source with driver: ESRI Shapefile
## Source: "/Volumes/岳_T7/2022卓越计划/0-卓越计划-笔记/第2次考核_SCI绘图之道-笔记/ChinaMap/bou2_4m/bou2_4p.shp", layer: "bou2_4p"
## with 925 features
## It has 7 fields
## Integer64 fields read as strings: BOU2_4M_ BOU2_4M_ID
china2 <- fortify(china)
## Regions defined for each Polygons
head(china2)
## long lat order hole piece id group
## 1 121.4884 53.33265 1 FALSE 1 0 0.1
## 2 121.4995 53.33601 2 FALSE 1 0 0.1
## 3 121.5184 53.33919 3 FALSE 1 0 0.1
## 4 121.5391 53.34172 4 FALSE 1 0 0.1
## 5 121.5738 53.34818 5 FALSE 1 0 0.1
## 6 121.5840 53.34964 6 FALSE 1 0 0.1
mymap <- china@data
mymap$id <- 0:924
china.map2 <- plyr::join(mymap,china2)
## Joining by: id
library(readr)
mydata <- read_csv('code87data.csv')
## Rows: 31 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): NAME
## dbl (8): HBOR, HBLO, HBUP, HBP, HCOR, HCLO, HCUP, HCP
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
datamap <- full_join(china.map2,mydata)
## Joining, by = "NAME"
p1 <- ggplot() + geom_polygon(data=datamap,
aes(x=long, y=lat, group = group,fill=HBOR),
colour="black",size = .2) +
scale_fill_gradient2(low = "green",mid = 'white', high = "red",
midpoint = 1)+
theme_void()+labs(x="", y="")+
guides(fill = guide_colorbar(title='HBV OR'))+
theme(legend.position = c(0.15,0.2))
#code 87 continued
df_China <- datamap
Width<-9
Height<-9
long_Start<-124
lat_Start<-16
df_Nanhai<-df_China[df_China$long>106.55 & df_China$long<123.58,]
df_Nanhai<-df_Nanhai[df_Nanhai$lat>4.61 & df_Nanhai$lat<25.45,]
min_long<-min(df_Nanhai$long, na.rm = TRUE)
min_lat<-min(df_Nanhai$lat, na.rm = TRUE)
max_long<-max(df_Nanhai$long, na.rm = TRUE)
max_lat<-max(df_Nanhai$lat, na.rm = TRUE)
df_Nanhai$long<-(df_Nanhai$long-min_long)/(max_long-min_long)*Width+long_Start
df_Nanhai$lat<-(df_Nanhai$lat-min_lat)/(max_lat-min_lat)*Height+lat_Start
df_Nanhai$class<-rep("NanHai",nrow(df_Nanhai))
df_China$class<-rep("Mainland",nrow(df_China))
df_China<-rbind(df_China,df_Nanhai)
df_NanHaiLine <- read.csv("中国南海九段线.csv")
colnames(df_NanHaiLine)<-c("long","lat","ID")
df_NanHaiLine$long<-(df_NanHaiLine$long-min_long)/(max_long-min_long)*Width+long_Start
df_NanHaiLine$lat<-(df_NanHaiLine$lat-min_lat)/(max_lat-min_lat)*Height+lat_Start
p2 <- ggplot()+
geom_polygon(data=df_China,aes(x=long,y=lat,group=interaction(class,group),
fill=HBOR),colour="black",size=0.25)+
geom_rect(aes(xmin=long_Start, xmax=long_Start+Width+0.8,
ymin=lat_Start-0.6, ymax=lat_Start+Height),fill=NA,
colour="black",size=0.25)+
geom_line(data=df_NanHaiLine, aes(x=long, y=lat, group=ID),
colour="black", size=1)+
scale_fill_gradient2(low = "green",mid = 'white', high = "red",
midpoint = 1)+
coord_cartesian()+
ylim(15,55)+
theme_void()+labs(x="", y="")+
theme(
legend.position=c(0.15,0.2),
legend.background = element_blank())
library(cowplot)
plot_grid(p1,p2,ncol=2,align = 'h',labels = c('A','B'))
#code 88
library(rgdal)
china <- readOGR('ChinaMap/bou2_4m/bou2_4p.shp')
## OGR data source with driver: ESRI Shapefile
## Source: "/Volumes/岳_T7/2022卓越计划/0-卓越计划-笔记/第2次考核_SCI绘图之道-笔记/ChinaMap/bou2_4m/bou2_4p.shp", layer: "bou2_4p"
## with 925 features
## It has 7 fields
## Integer64 fields read as strings: BOU2_4M_ BOU2_4M_ID
china2 <- fortify(china)
## Regions defined for each Polygons
mymap <- china@data
mymap$id <- 0:924
china.map2 <- plyr::join(mymap,china2)
## Joining by: id
mydata <- read_csv('code83data.csv')
## Rows: 31 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): NAME
## dbl (8): HBOR, HBLO, HBUP, HBP, HCOR, HCLO, HCUP, HCP
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
set.seed(2019)
mydata <- mydata %>% mutate(A = abs(rnorm(31,10,5)),
B = sample(1000:10000,31),
C = abs(rnorm(31,5,2)),
long2 = c(116.39,117.2,114.5,112.6,111.7,123.4,125.3,
126.6,121.5,118.8,120.2,117.3,119.3,115.9,
117.0,113.6,114.3,113,113.3,108.3,110.3,
106.6,104.1,106.7,102.7,91.1,108.9,103.8,
101.8,106.2,87.6),
lat2 = c(39.9,39.1,38,37.9,40.8,41.8,43.8,45.8,31.2,
32.1,30.2,31.9,26,28.7,36.7,34.8,30.6,28.2,
23.1,22.8,20,29.6,30.6,26.6,24.9,29.7,34.3,
36.1,36.6,38.5,43.8))
datamap <- full_join(china.map2,mydata)
## Joining, by = "NAME"
ggplot() +
geom_polygon(data=datamap,aes(x=long, y=lat, group = group,fill=A),
colour="gray",size = .2)+
scale_fill_gradient2(name = 'A',low = "pink", high = "red")+
geom_point(data = mydata,aes(x=long2, y=lat2,size = B, color = C),
alpha = .8, shape = 16)+
scale_color_gradient(name ='C',low = 'skyblue',high = 'blue')+
theme_void()+
guides(size = guide_legend(order = 2),
fill = guide_colorbar(order = 1),
color = guide_colorbar(order = 3))
#code 89 散射饼图
library(rgdal)
china <- readOGR('ChinaMap/bou2_4m/bou2_4p.shp')
## OGR data source with driver: ESRI Shapefile
## Source: "/Volumes/岳_T7/2022卓越计划/0-卓越计划-笔记/第2次考核_SCI绘图之道-笔记/ChinaMap/bou2_4m/bou2_4p.shp", layer: "bou2_4p"
## with 925 features
## It has 7 fields
## Integer64 fields read as strings: BOU2_4M_ BOU2_4M_ID
china2 <- fortify(china)
## Regions defined for each Polygons
mymap <- china@data
mymap$id <- 0:924
china.map2 <- plyr::join(mymap,china2)
## Joining by: id
mydata <- read_csv('code83data.csv')
## Rows: 31 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): NAME
## dbl (8): HBOR, HBLO, HBUP, HBP, HCOR, HCLO, HCUP, HCP
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
set.seed(2019)
mydata <- mydata %>% mutate(A = sample(1000:10000,31),
B = sample(1000:10000,31),
C = sample(1000:10000,31),
long2 = c(116.39,117.2,114.5,112.6,111.7,123.4,125.3,
126.6,121.5,118.8,120.2,117.3,119.3,115.9,
117.0,113.6,114.3,113,113.3,108.3,110.3,
106.6,104.1,106.7,102.7,91.1,108.9,103.8,
101.8,106.2,87.6),
lat2 = c(39.9,39.1,38,37.9,40.8,41.8,43.8,45.8,31.2,
32.1,30.2,31.9,26,28.7,36.7,34.8,30.6,28.2,
23.1,22.8,20,29.6,30.6,26.6,24.9,29.7,34.3,
36.1,36.6,38.5,43.8),
D = runif(31,1,2))
datamap <- full_join(china.map2,mydata)
## Joining, by = "NAME"
library(scatterpie)
##
## 载入程辑包：'scatterpie'
##
## The following object is masked from 'package:sp':
##
## recenter
ggplot() +
geom_polygon(data=datamap,aes(x=long, y=lat, group = group),
fill = 'white',colour="black",size = .2)+
geom_scatterpie(data = mydata,aes(x=long2,y=lat2,group = NAME, r=D),
cols = c('A','B','C'),color = 'black',alpha = .8)+
scale_fill_manual(values = c('#7fc97f','#beaed4','#fdc086'))+
geom_scatterpie_legend(mydata$D,x = 80,y = 20, n = 4,
labeller = function(x)x*1e3)+
theme_void()+
theme(legend.position = c(.9,.5))
