【R语言】地图信息数据可视化

最近需要对国内疫情分布情况绘制可视化地图，查找资料R中地图绘制思路，显示在R中绘制地图主要有三种方式：第一种是利用某些特定R包中自带的地图数据进行绘图；第二种从其他途径获取地理信息数据，调用相应的软件包对数据进行读取，进而绘图；第三种是基于某些供应商的tiles与Google、NASA、高德等网络在线地图相关联，调用其地图数据为自己绘图所用。下面进行举例说明：

1.【绘图前准备】爬取丁香园每日疫情数据

##加载程序包，设置路径##
setwd("f://data")
library(rvest)
library(stringr)
library(dplyr)
library(ggplot2)
library(leaflet)
library(leafletCN)
library(RColorBrewer)
library(chinamap)
library(sp)
###爬取丁香园网站国内34个省份疫情实时数据###
url<-"https://ncov.dxy.cn/ncovh5/view/pneumonia"
web_mess<-read_html(url)
web_node<-web_mess%>%html_nodes("#getAreaStat")
web_text<-html_text(web_node,trim=T)

###数据正则化处理###
web_str<-str_extract_all(web_text,"provinceName\":\".{2,9}\",\"provinceShortName\":\".{2,9}\",\"currentConfirmedCount\":.{1,7},")
pp<-str_extract_all(web_str[[1]],"provinceName\":\".{2,9}\"")
province<-data.frame()
for(i in 1:length(web_str[[1]])){
  province[i,1]<-str_sub(pp[[i]][1],16,str_length(pp[[i]][1])-3)
}
cc<-str_extract_all(web_str[[1]],"\"currentConfirmedCount\":.{1,7},")
num<-as.vector(34,mode = "numeric")
for(i in 1:length(web_str[[1]])){
 num[i]<-str_sub(cc[[i]][1],str_locate(cc[[i]][1],":")[,1]+1,str_locate(cc[[i]][1],",")[,1]-1)
}
mydata<-data.frame(province,as.numeric(num))%>%setNames(c("area","confirm"))
case.cate<-function(x){###将数值型变量转换为分类变量函数###
  for(i in 1:length(x)){
    if(x[i]==0){
      x[i]<-"0"
    }else if(x[i]>0&x[i]<=10){
      x[i]<-"1~10"
    }else if(x[i]>10&x[i]<=50){
      x[i]<-"10~50"
    }else if(x[i]>50&x[i]<=100){
      x[i]<-"50~100"
    }else if(x[i]>100&x[i]<=200){
      x[i]<-"100~200"
    }else if(x[i]>200&x[i]<=500){
      x[i]<-"200~500"
    }else if(x[i]>500&x[i]<=1000){
      x[i]<-"500~1000"
    }else if(x[i]>1000&x[i]<=2000){
      x[i]<-"1000~2000"
    }else if(x[i]>2000&x[i]<=300000){
      x[i]<-"2000~300000"
    }else{
      x[i]<-"1000000~"
    }
  }
  return(x)
}
lapply(mydata$confirm,case.cate)%>%as.character()%>%as.factor()->mydata$nvalue
substr(mydata$area,1,2)->mydata$id_area##最终的绘图数据##

2. 结合前两种方式绘制静态地图

第一种方式是利用Y叔提供的chinamap包，里面包含了全国各省份的地理信息数据，get_map_china( )一句命令直接获取，没有安装的可以从Github上安装，但是这个包也存在一些不足，里面没有南海九段线的数据，故通过第二种方式从外部途径获取南海的地理信息数据。

remotes::install_github(“GuangchuangYu/chinamap”)

绘制静态地图

###绘制静态地图###
cn<-get_map_china()
factor(mydata$nvalue,levels = c("0","1~10","10~50","50~100","100~200","200~500","500~1000","1000~2000","2000~300000","1000000~"))->mydata$category##绘图前因子变量需要对其level进行重排，以便地图数据成功对应##
str_sub(cn$province,1,2)->cn$id_area
mapdata<-left_join(cn,mydata,by=c("id_area"="id_area"))
##自定义背景元素清除函数##
theme_white<-function(){
  theme(axis.line=element_blank(),axis.ticks = element_blank(),axis.text = element_blank(),axis.title = element_blank(),panel.grid.major=element_blank(),panel.grid.minor=element_blank(),panel.background = element_blank())
}
colo<-colorRampPalette(brewer.pal(9,"Reds"))(10)##调配填充颜色，由于数据变量是分类型，scale_fill_brewer(Palette="")中提供的颜色种类最多9种，故需要自行调配##
source("lines_nanhai.R")##纳入南海九段线数据##
read.csv("省会坐标.csv")->city##纳入省会标记##
##绘制静态地图##
ggplot()+geom_polygon(data=mapdata,aes(x=long,y=lat,fill=category,group=group),colour="black",size=0.25)+scale_fill_manual(values = colo)+theme(legend.key.size=unit(0.3,"cm"),legend.position=c(0.2,0.2),legend.key.width=unit(0.3,"cm"),legend.title = element_text(size=8,hjust = 0))+theme_white()+labs(fill="现存确诊人数")+geom_sf(data=lines_nanhai,aes(geometry=geometry))+geom_text(data=city,aes(x=lon,y=lat,label=province),size=2)

结果如下图

如图所示，ggplot绘制的图形可视化是非常nice的，但是发现图例中存在NA，经检查发现原来是chinamap包中并没有提供澳门地区的地理信息数据。前两种方式绘制的图形通常不具备交互能力，无非进行拖拽，实际应用中比较受限，故考虑第三种方式绘图。

3. 应用第三种方式绘制交互地图

本来想利用Remap包调用百度地图，一方面是需要事先申请注册地图认证，获取API秘钥AK；另一方面搭配的系统总是会存在崩溃状况。偶然发现李誉辉的一篇关于leaflet包的介绍，其在图形交互性能上能够得到有效实现。

绘制交互地图

###绘制疫情交互式地图###

##1.绘制确诊病例分布热图##
regionNames("china")%>%substr(1,2)%>%data.frame()%>%setNames("id_area")->pr
mydata<-left_join(pr,mydata,by=c("id_area"="id_area"))
dat<-cbind(data.frame(regionNames("china")),mydata[,3:4])%>%setNames(c("area","confirm","category"))
factor(dat$category,levels = c("0","1~10","10~50","50~100","100~200","200~500","500~1000","1000~2000","2000~300000","1000000~"))->dat$category##因子变量需要对其level进行重排，以便地图数据成功对应##
map<-leafletGeo("china",dat)##将数据与地图数据关联##
pal<-colorFactor(palette = c("Reds"),dat$category)##调取地图填充颜色fillcolor()，由于数据范围差异较大，不宜用连续性变量[colorNumeric]进行填充，故转化为分类变量填充##

##依据数据填充色彩，添加popup参数标签及鼠标显示,添加图例##
casemap<-leaflet(map)%>%amap()%>%addPolygons(stroke = T,smoothFactor = 1,fillOpacity = 0.9,opacity = 0.8,weight = 1,color="gray",fillColor = ~pal(dat$category),popup=~htmltools::htmlEscape(value),popupOptions = popupOptions(closeButton = F,minWidth = 20),highlightOptions = highlightOptions(bringToFront = T,color = "blue",weight = 1))%>%addLegend(pal=pal,values = dat$category,position="bottomright",title = "现存本土确诊病例",opacity=1)

##2.添加风险区域标记##
##[1]纳入风险区域经纬度##
read.csv("风险地区.csv",header=T)->fxarea
str_sub(fxarea$name,1,3)->fxarea$area
name<-as.character()
for(i in 1:length(fxarea$name)){
  name[i]<-str_sub(fxarea$name[i],4,str_length(fxarea$name[i]))
}
name->fxarea$name
content<-data.frame()

##[2]将网页链接转化为popup参数提示框中能够识别的HTML语言##
for(i in 1:length(fxarea$link)){
  content[i,1]<-paste0("<br/>", "<b><a href='",fxarea$link[i],"'>",fxarea$area[i],"</a></b>","<br/>",fxarea$name[i])
}
content$V1->fxarea$content

##自定义标记样式##
mask<-makeIcon(iconUrl = "F://data//MASS//train//mask-100.png",iconWidth = 22,iconHeight = 32,iconAnchorX = 12,iconAnchorY =22)##标记可以来源于网络也可以来源于路径下存储的图片##

###绘制标记地图（添加popup参数提示框以及label参数标记标签###
casemap%>%addTiles()%>%addMarkers(lng = ~fxarea$lng,lat=~fxarea$lat,popup = ~fxarea$content,label=~fxarea$cate,labelOptions = labelOptions(noHide = F,textOnly = F,style = list("color"="red","font-family"="serif","border-color"="blue")),icon=mask,popupOptions=popupOptions(closeButton = F,autoPan = F))

绘图中几个常用函数说明：

leaflet包
1.leaflet(dat)-----调用地图信息数据，可以是包含经纬度（lon,lat）的数据框，也可以是源于sp包传递的地理信息数据，最常用的是调用leafletGeo()合成的地图数据
2.addPolygons( )----主要参数：

1. stroke = T 显示绘制地图中多边形阴影,
2. smoothFactor = 1 指定多边形边线平滑水平,
3. fillOpacity = 0.9,opacity = 0.8 指定多边形透明度,
4. weight = 1 指定多变形像素,
5. color=“gray” 指定多边形边框颜色 ,
6. fillColor =~pal(category) 指定数框中的变量填充多边形颜色（pal调色）,
7. popup=~htmltools::htmlEscape(value) html语言指定多边形中文本框显示内容,
8. popupOptions = popupOptions(closeButton = F,minWidth = 20) 调解文本框位置及大小,
9. highlightOptions = highlightOptions(bringToFront = T,color = “blue”,weight = 1))调解鼠标移动到多边形处显示情况。

3.addLegend(pal=pal 指定图例颜色,values = category 指定图例与数据框变量对应, position=“bottomright”,title = “现存本土确诊病例”,opacity=1 图例透明度)
4.addTiles()-----添加地理位置标记
5.addMarkers(）----主要参数：

1. lng =~ lng,lat=~lat,需要标记位置的数据框中经纬度,
2. popup=~content,popupOptions=popupOptions(closeButton = F,autoPan = F))指定标记位置文本框中显示内容,
3. label=~fxarea$cate,labelOptions = labelOptions(noHide = F,textOnly = F,style = list(“color”=“red”,“font-family”=“serif”,“border-color”=“blue”)),指定标记显示内容, 调解鼠标移动到标记位置时显示情况
4. mask<-makeIcon(iconUrl = “F://data//MASS//train//mask-100.png”,iconWidth = 22,iconHeight = 32,iconAnchorX = 12,iconAnchorY =22) 自定义标记样式
5. icon=mask，改变标记样式

leafletCN包
是基于leaflet包做的一个大中华扩展，可以获取国内省市县的地理信息数据，在绘制国内地图时常用（举例）：
1.regionNames(“china”）---------返回国内各省份所在名称
2.demomap(“北京市”)--------绘制北京市地图
3.geojsonMap(beijing_data,“北京市”)------依据数据框中数据为北京市地图填充颜色
4.leafletGeo(“china”,data_china)------将中国地图与数据框结合在一起，以便于leafet调用
5.amap()----调用高德地图图层

结果如下图