R语言学习笔记：地理可视化

Posted 2021-04-18 阿灿的读书小阁

R语言有很多绘制地图的包，如map，maptools或ggmap。

1.气泡地图

library(tidyverse)library(ggsci)library(rgdal)library(Cairo)library(cowplot)#map_data里面存储了世界地图map_dataworldData <- map_data('world')

set.seed(2020)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))
CairoPNG('P1.jpg',height = 1200,width = 2800,res = 300)#将地图以多边形给描绘出来。黑色边界线，线宽为0.2,内部填充为白色ggplot()+geom_polygon(data=worldData, aes(x=long, y=lat, group=group), color='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)) #限制气泡大小dev.off()

2.热力地图（单颜色连续渐变填充/单颜色离散填充）

#画图CairoPNG('P2.jpg',height = 2400,width = 2800,res = 300)p <- ggplot()#填充改为了相应的变量数据p1 <- p + geom_polygon(data=total, aes(x=long, y=lat, group=group, fill=val), color='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))
p2 <- 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')
plot_grid(p1,p2,ncol=1,align = 'v',labels = c('A','B'))
dev.off()

这是画出来带南极洲和缺失值的图

修饰后的图

3.热力地图（双颜色连续渐变填充/双颜色离散填充）

set.seed(2020)apcs <- tibble(apc = c(rnorm(nrow(country_asr)-10,0,2),rep(0,10)), location = unique(country_asr$location))
head(apcs)
worldData <- map_data('world')total <- left_join(worldData, apcs, by=c('region' = 'location'))
#画图CairoPNG('P3.jpg',height = 2400,width = 2800,res = 300)p <- gglot()p1 <- 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)+ 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))p2 <- 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')plot_grid(p1,p2,ncol=1,align = 'v',labels = c('A','B'))

dev.off()

可以将缺失值去掉

4.中国地图

library(rgdal)#在官网下载中国地图shp文件china <- readOGR('test\bou2_4m\bou2_4p.shp')#将数据转换为数据框形式china2 <- fortify(china)mymap <- china@datamymap$id <- 0:924
china.map2 <- plyr::join(mymap,china2)mydata <- read.csv('test\data2.csv')
datamap <- full_join(china.map2,mydata)df_China <- datamap
#绘制九段线Width<-9Height<-9long_Start<-124lat_Start<-16df_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_Startdf_Nanhai$lat<-(df_Nanhai$lat-min_lat)/(max_lat-min_lat)*Height+lat_Startdf_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("test\中国南海九段线.csv") colnames(df_NanHaiLine)<-c("long","lat","ID")df_NanHaiLine$long<-(df_NanHaiLine$long-min_long)/(max_long-min_long)*Width+long_Startdf_NanHaiLine$lat<-(df_NanHaiLine$lat-min_lat)/(max_lat-min_lat)*Height+lat_Start


CairoPNG('P4.jpg',height = 2400,width = 2800,res = 1200)p1 <- 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())
dev.off()