空间绘图 | R语言克里金插值绘图

上篇推文我们介绍了使用Python-pykrige包实现了克里金(Kriging)插值计算及对应的可视化结果绘制,详细内容点击下方链接:Python-pykrige包-克里金(Kriging)插值计算及可视化绘制,相比你也感受到了Python的简单方便性。本期推文,我们就推出使用R-gstat包实现克里金(Kriging)插值的计算及对应结果的可视化绘制,主要知识点如下:

  • gstat.krige()实现克里金插值计算

  • 插值结果的可视化绘制

  • 插值系列代码合集已免费新增的我们的系统课程啦,有需要的小伙伴可以咨询订阅哈

gstat.krige()实现克里金插值计算

model选择

我们之前使用gstat包进行IDW插值计算,本期的推文全部在上次操作的基础之上(可能有些地方大家不是很明白,这个系列结束,我会分享完整的源码、文档和数据的),大家不明白的地方,也可以参考之前的文档(R-gstat-ggplot2 IDW计算及空间插值可视化绘制)。在进行krige计算之前,需要对数据进行“查看”,根据数据的分布情况选择合适的核函数进行拟合计算。代码如下:

semivariog<-variogram(PM2.5~1, locations=scatter_df, data=scatter_df)
plot(semivariog)

这里的scatter_df 都是经sp包转换后的地理类型数据,可得数据距离分布情况如下(根据距离分布选择合适的model):

我们根据数据分布选择 model="Exp",使用如下代码进行拟合线的绘制:

model.variog<-vgm(psill=125, model="Exp", nugget=45, range=.6)
fit.variog<-fit.variogram(semivariog, model.variog)
plot(semivariog, fit.variog)

结果如下:

空间绘图 | R语言克里金插值绘图_第1张图片

由于上篇Python的结果我们使用高斯函数,这里我们也选择相同的model,代码如下:

model.variog<-vgm(psill=125, model="Gau", nugget=45, range=.6)
fit.variog<-fit.variogram(semivariog, model.variog)
plot(semivariog, fit.variog)

结果如下:

空间绘图 | R语言克里金插值绘图_第2张图片

注意:

  • 以上psill=125、nugget=45, range=.6等参数则是根据数据分布情况进行合理设置。接下来我们就选择对应model仅克里金插值计算。

  • 使用vgm()函数即可查看gstat包支持的model种类。

krige 计算

「model="Exp"」

首先,我们对model="Exp" 进行krige 计算,主要代码如下:

model.variog<-vgm(psill=125, model="Exp", nugget=45, range=.6)
#插值计算
krig<-krige(formula=PM2.5 ~ 1, locations=scatter_df, newdata=grid, model=model.variog)
#将结果转成df 数据类型
krig_output=as.data.frame(krig)
names(krig_output)[1:3]<-c("long","lat","OK_pred")
head(krig_output)

得到的插值结果如下(部分):

空间绘图 | R语言克里金插值绘图_第3张图片

「model="Gau"」

model.variog<-vgm(psill=125, model="Gau", nugget=45, range=.6)
#插值计算
krig_Gau<-krige(formula=PM2.5 ~ 1, locations=scatter_df, newdata=grid, model=model.variog)
krig_output_Gau=as.data.frame(krig_Gau)
names(krig_output_Gau)[1:3]<-c("long","lat","OK_Gau_pred")
head(krig_output_Gau)

结果如下(部分):

空间绘图 | R语言克里金插值绘图_第4张图片

接下来我们就这两种情况进行可视化绘制。

插值结果的可视化绘制

我们有了规整好的df类型数据,这就可以方便的使用ggplot2进行可视化绘制。

针对model="Exp"的结果

首先我们绘制网格数据可视化结果,代码如下:

library(sf)
library(tidyverse)
library(ggspatial)
library(RColorBrewer)
library(ggtext)
library(hrbrthemes)

#自定义颜色
my_colormap <- colorRampPalette(rev(brewer.pal(11,'Spectral')))(32)
OK_Map_title <- ggplot() + 
  geom_tile(data = krig_output,aes(x=long,y=lat,fill=OK_pred)) +
  geom_sf(data = jiangsu,fill="NA",size=.5,color="gray40") +
  #geom_sf(data = scatter_df_tro,aes(fill=PM2.5),shape=21,size=4,show.legend = FALSE)+
  scale_fill_gradientn(colours = my_colormap)+
  annotation_scale(location = "bl") +
      # spatial-aware automagic north arrow
       annotation_north_arrow(location = "tr", which_north = "false",
                             style = north_arrow_fancy_orienteering) +
  labs(x="",y="",
       title = "Map Charts in R Exercise 02: Map OK Interpolation",
       subtitle = "processed map charts with geom_tile()",
       caption = "Visualization by DataCharm") +
  theme_ipsum(base_family = "Roboto Condensed") +
  theme(
        plot.title = element_markdown(hjust = 0.5,vjust = .5,color = "black",
                             size = 20, margin = margin(t = 1, b = 12)),
        plot.subtitle = element_markdown(hjust = 0,vjust = .5,size=15),
        plot.caption = element_markdown(face = 'bold',size = 12),
  )

可视化结果如下:

空间绘图 | R语言克里金插值绘图_第5张图片

当然,还可以通过*geom_contour()*绘制二维等值线:

geom_contour(data = krig_output,aes(x=long,y=lat,z=OK_pred),colour="white")

可视化结果如下:

空间绘图 | R语言克里金插值绘图_第6张图片

「裁剪操作」

这步骤说了很多遍了,这里直接给出的代码:

#需要对数据进行投影转换
OK_output_sf <- st_as_sf(krig_output,coords = c("long", "lat"),crs = 4326)
OK_mask_result <- sf::st_intersection(OK_output_sf,jiangsu,tolerance=.01)
#可视化绘制
OK_mask_map <- ggplot() + 
  geom_sf(data = OK_mask_result,aes(color=OK_pred)) +
  geom_sf(data = jiangsu,fill="NA",size=.5,color="gray40",alpha=.4) +
  scale_color_gradientn(colours = my_colormap)+
  annotation_scale(location = "bl") +
      # spatial-aware automagic north arrow
       annotation_north_arrow(location = "tr", which_north = "false",
                             style = north_arrow_fancy_orienteering) +
  labs(
       title = "Map Charts in R Exercise 02: Map OK Interpolation Mask",
       subtitle = "processed map charts with geom_sf()",
       caption = "Visualization by DataCharm") +
  theme_ipsum(base_family = "Roboto Condensed") +
  theme(
        plot.title = element_markdown(hjust = 0.5,vjust = .5,color = "black",
                             size = 20, margin = margin(t = 1, b = 12)),
        plot.subtitle = element_markdown(hjust = 0,vjust = .5,size=15),
        plot.caption = element_markdown(face = 'bold',size = 12),
  )

可视化结果如下:

空间绘图 | R语言克里金插值绘图_第7张图片

注意: 这里的裁剪方法存在一些问题:在面对较大面积时,裁剪处不够明确(出现过多的范围,这个问题在本系列结束时给出的完整文档中会给出解决方法)。

针对model="Gau"的结果

由于步骤类似,我们这里直接给出代码和绘图结果即可:

library(sf)
library(tidyverse)
library(ggspatial)
library(RColorBrewer)
library(ggtext)
library(hrbrthemes)

#自定义颜色
my_colormap <- colorRampPalette(rev(brewer.pal(11,'Spectral')))(32)
OK_Map_title_Gau <- ggplot() + 
  geom_tile(data = krig_output_Gau,aes(x=long,y=lat,fill=OK_Gau_pred)) +
  geom_sf(data = jiangsu,fill="NA",size=.5,color="gray40") +
  geom_contour(data = krig_output_Gau,aes(x=long,y=lat,z=OK_Gau_pred),colour="white")+
  #geom_sf(data = scatter_df_tro,aes(fill=PM2.5),shape=21,size=4,show.legend = FALSE)+
  scale_fill_gradientn(colours = my_colormap)+
  annotation_scale(location = "bl") +
      # spatial-aware automagic north arrow
       annotation_north_arrow(location = "tr", which_north = "false",
                             style = north_arrow_fancy_orienteering) +
  labs(x="",y="",
       title = "Map Charts in R Exercise 02: Map OK Interpolation",
       subtitle = "processed map charts with geom_tile()",
       caption = "Visualization by DataCharm") +
  theme_ipsum(base_family = "Roboto Condensed") +
  theme(
        plot.title = element_markdown(hjust = 0.5,vjust = .5,color = "black",
                             size = 20, margin = margin(t = 1, b = 12)),
        plot.subtitle = element_markdown(hjust = 0,vjust = .5,size=15),
        plot.caption = element_markdown(face = 'bold',size = 12),
  )

可视化结果如下:

空间绘图 | R语言克里金插值绘图_第8张图片

总结

到这里,R版本的克里金(Kriging)插值计算结果及可视化绘制就完成了,相比于Python-pykrige包计算的结果,由于计算及部分参数设置的不同,导致结果有所偏差,大家可以根据自己的实际情况进行选择(个人建议选择R版本的)。大家不理解的地方可以查看gstat官网。目前小编在制作类别空间插值可视化绘制(Categorical spatial interpolation),希望可以同时制作Python和R两个版本的,可能还会涉及到机器学习的内容,大家尽请期待哦!*(有小伙伴问我是GIS方面的学生吗?为啥做空间可视化多一点?我的回答是”我只是数据可视化设计爱好者,当然,研究生期间也涉及空间GIS方法,最重要的是空间可视化作品比较炫!!“)*

你可能感兴趣的:(数据可视化,人工智能,python,算法,r语言,数据可视化,论文阅读)