歡迎關注天善智能，我們是專注於商業智能BI，人工智能AI，大數據分析與挖掘領域的垂直社區，學習，問答、求職一站式搞定！
對商業智能BI、大數據分析挖掘、機器學習，python，R等數據領域感興趣的同學加微信：tstoutiao，邀請你進入數據愛好者交流羣，數據愛好者們都在這兒。
作者：李譽輝
四川大學在讀研究生
前言
本文是R空間插值—必知必會的最後一篇，上一篇請戳：
R_空間插值_必知必會（一）
6、ggplot2繪圖
6.1
rasterLayer轉化爲dataframe
1library(raster)
2library(sp)
3library(dplyr)
4library(magrittr)
5
6# 定義一個函數，將rasterLayer柵格數據轉化爲data.frame
7# 將rasterLayer柵格數據轉化爲dataframe數據。
8rasterL_to_DF <- function(climate_mask) {
9 climate_mask_df <- as.data.frame(cbind(coordinates(climate_mask), # 合併座標數據和柵格值
10 values(climate_mask))
11 )
12 climate_mask_df %<>% rename(climate_variable = V3) %<>% na.omit()
13 return(climate_mask_df)
14}
15
16# 調用函數
17TEM_mask_df <- rasterL_to_DF(climate_mask = TEM_mask)
18
19# 生成等值線數據
20
21breaks_lines <- seq(min(TEM_1th$aver_TEM), max(TEM_1th$aver_TEM), length.out = 10)
6.2
繪圖
1library(ggplot2)
2
3ggplot_TEM <- function(temperature_data = TEM_mask_df) {
4 ggplot(data = temperature_data) +
5 geom_raster(aes(x = x, y = y, fill = climate_variable)) +
6 # 增加等值線
7 geom_contour(aes(x = x,y = y,z = climate_variable),
8 color ="white", breaks=breaks_lines) +
9 # 中國省級地圖輪廓
10 geom_polygon(data = Chinaprovinces_df,
11 aes(x = long, y = lat, group = group),
12 color = "black", fill = "transparent", size = 0.5) +
13 # 臺灣地圖
14 geom_polygon(data = Taiwan_df,
15 aes(x = long, y = lat, group = group),
16 color = NA, fill = "grey", size = 0.5) +
17 # 增加南海九段線
18 geom_line(data = Nine_lines,
19 aes(x=long, y=lat, group=ID),
20 colour="black", size=1) +
21 # 各省名字，座標爲省會所在位置
22 geom_text(data = provinces,
23 aes(x = x, y = y, label = shortname),
24 color = "green", size = 2) +
25 coord_cartesian() + # geom_raster只能搭配笛卡爾座標系
26 # 柵格顏色填充標度
27 scale_fill_gradient2(low = "blue", mid = "white", midpoint = 0,
28 high= "red",na.value = "grey", # 設定缺失值爲灰色
29 name = "氣溫(℃)") + #
30 labs(title = "中國平均氣溫分佈圖\n(2017年1月1日)",
31 caption = "注：圖中數據不含臺灣地區") +
32 theme_void()+
33 theme(
34 legend.position=c(0.2,0.2),
35 legend.background=element_blank(),
36 plot.title = element_text(colour = "magenta", size = 13,
37 face = "bold", hjust = 0.5),
38 legend.title = element_text(face = "bold", colour = "deeppink")
39 )
40}
41
42ggplot_TEM()
43
7.1
多項式擬合
7.1.1 創建一個柵格產生函數
將：多項式模型、業務數據、空柵格、邊界條件代入函數，即可產生柵格。
1library(gstat)
2library(sp)
3library(raster)
4
5# 首先定義迴歸模型
6
7# 將自定義的多項式公式代入迴歸運算，然後將回歸運算預測空柵格中的值，相當於插值計算。
8## 生成一個函數，可以直接調用多項式模型公式，和sp數據及空柵格數據
9climate_mask_lm <- function(climate_sp, grd_climate, polynomial_function, boundary_sp) {
10
11 ### 添加變量X和Y
12 climate_sp$X <- coordinates(climate_sp)[,1]
13 climate_sp$Y <- coordinates(climate_sp)[,2]
14
15 ### 進行線性迴歸運算
16 lm_n <- lm(polynomial_function, data = climate_sp)
17
18 ### 將回歸模型當做插值進行運算
19 climate_lm <- SpatialGridDataFrame(grd_climate,
20 data.frame(var1.pred = predict(lm_n,
21 newdata = grd_climate)))
22
23 climate_raster <- raster(climate_lm) # 柵格化
24 climate_mask <- mask(climate_raster, boundary_sp) # 篩選邊界範圍內的柵格
25
26 rm(lm_n, climate_lm, climate_raster)
27 return(climate_mask)
28}
7.1.2 一階線性擬合
1library(gstat)
2library(sp)
3library(raster)
4library(tmap)
5
6# 自定義一個一階線性公式
7polynomial_1 <- as.formula(aver_TEM ~ X + Y)
8
9# 調用上述自定義函數
10TEM_mask <- climate_mask_lm(climate_sp = TEM_sp,
11 grd_climate = grd_TEM,
12 polynomial_function = polynomial_1,
13 boundary_sp = Chinaboundary_noTaiwan_sp)
14
15# tmap繪圖
16tmap_TEM()
17
18## ggplot2繪圖
19TEM_mask_df <- rasterL_to_DF(climate_mask = TEM_mask)
20ggplot_TEM()
7.1.3 二階多項式擬合
1library(gstat)
2library(sp)
3library(raster)
4library(tmap)
5
6# 自定義一個二階多項式公式
7polynomial_2 <- as.formula(aver_TEM ~ X + Y + I(X^2)+I(Y^2) + I(X*Y))
8
9# 調用上述自定義函數
10TEM_mask <- climate_mask_lm(climate_sp = TEM_sp,
11 grd_climate = grd_TEM,
12 polynomial_function = polynomial_2,
13 boundary_sp = Chinaboundary_noTaiwan_sp)
14
15# tmap繪圖
16tmap_TEM()
17
18## ggplot2繪圖
19TEM_mask_df <- rasterL_to_DF(climate_mask = TEM_mask)
20ggplot_TEM()
7.2
Kriging(克里金)插值
7.2.1 普通克里金插值
7.2.1.1 求擬合模型
求變異函數,首先繪製樣本實驗變異函數圖(sample experimental variogram plot)。
1library(gstat)
2
3TEM_v <- variogram(aver_TEM ~ 1, data = TEM_sp, cloud = FALSE) # cloud = F只顯示各個區間數字
4plot(TEM_v, plot.number = T)
5
根據半變異圖可知，已知點的自相關關係semivariance隨着距離distance的增加而增加， 通過其分佈，結合下圖，可初步確定用線性函數或power函數來擬合，
擬合後繪圖發現power函數更加恰當。
1library(gstat)
2
3TEM_v_fit <- fit.variogram(object = TEM_v,
4 model = vgm(1, "Pow", 1))
5plot(TEM_v, TEM_v_fit) # 結果非常好
1TEM_v_fit <- fit.variogram(object = TEM_v,
2 fit.ranges = FALSE, fit.sills = FALSE,
3 model = vgm(psill = 18, model = "Sph", range = 28, nugget = 2.5))
4
5plot(TEM_v, TEM_v_fit)
6
7.2.1.2 開始擬合運算
1library(gstat)
2library(raster)
3
4# 根據上面的擬合模型進行克里金插值的計算
5TEM_krg <- gstat::krige(formula = aver_TEM ~ 1,
6 model = TEM_v_fit,
7 locations = TEM_sp, # 數據點座標
8 newdata = grd_TEM, # 需要插值點的位置
9 nmax = 15, nmin = 10 # 分佈表示最多和最少搜索點的個數
10 )
11
12TEM_raster <- raster(TEM_krg) # 柵格化
13TEM_mask <- mask(TEM_raster, Chinaboundary_noTaiwan_sp) # 篩選邊界條件內的柵格
14
15rm(TEM_v, TEM_v_fit, TEM_krg, TEM_raster)
## [using ordinary kriging]
7.2.1.3 繪圖
1library(tmap)
2library(ggplot2)
3
4# tmap繪圖
5tmap_TEM()
6
7## ggplot2繪圖
8TEM_mask_df <- rasterL_to_DF(climate_mask = TEM_mask)
9ggplot_TEM()
7.2.2 泛克里金插值
用泛克里金法需謹慎，因其假定數據中存在覆蓋趨勢，
應該僅在瞭解數據中存在某種趨勢並能夠提供科學判斷描述泛克里金法時，纔可使用該方法
這在地質統計領域用得比較多，如礦藏的分佈。
我這兒沒有相關數據，僅僅用氣溫數據，可能不太準確，但是思路和流程是對的。
首先建立趨勢模型，根據將大部分點，繪製樣本實驗變異函數圖。
如下圖，通過調節cutoff和width將大多數點顯示在範圍內，
可以使用plot.number = TRUE顯示點的數量。
1library(gstat)
2
3### 添加變量X和Y
4TEM_sp2 <- TEM_sp # 複製一份
5TEM_sp2$X <- coordinates(TEM_sp2)[,1]
6TEM_sp2$Y <- coordinates(TEM_sp2)[,2]
7trend_1 <- as.formula(aver_TEM ~ X + Y)
8
9TEM_v <- variogram(object = trend_1, data = TEM_sp2, cloud = FALSE,
10 cutoff = 30, # cutoff爲對角線長度調整，其與width會相互影響
11 width = 2) # width表示相鄰2個點之間的distance，width越小，點越多
12plot(TEM_v)
1TEM_v_fit <- fit.variogram(object = TEM_v,
2 fit.ranges = FALSE, fit.sills = FALSE,
3 model = vgm(psill = 18, model = "Sph", range = 28, nugget = 2.5))
4
5plot(TEM_v, TEM_v_fit)
6
運算量非常大，經常溢出，這裏不進行運算。
1library(gstat)
2library(raster)
3
4# 根據上面的擬合模型進行克里金插值的計算
5TEM_krg <- gstat::krige(formula = trend_1,
6 locations = TEM_sp2, # 數據點座標
7 newdata = grd_TEM, # 需要插值點的位置
8 model = TEM_v_fit
9 )
10
11TEM_raster <- raster(TEM_krg) # 柵格化
12TEM_mask <- mask(TEM_raster, Chinaboundary_noTaiwan_sp) # 篩選邊界條件內的柵格
13
14rm(TEM_v, TEM_v_fit, TEM_krg, TEM_raster, TEM_sp2)
1library(tmap)
2library(ggplot2)
3
4# tmap繪圖
5tmap_TEM()
6
7## ggplot2繪圖
8TEM_mask_df <- rasterL_to_DF(climate_mask = TEM_mask)
9ggplot_TEM()
7.3
akima插值
akima插值不支持sp數據對象的插值，只支持dataframe和matrix對象插值。
插值結果爲dataframe對象, 只能形成SpatialPixelsDataFrame柵格類型，
與前面的sp對象插值不同，sp對象插值結果爲SpatialGridDataFrame柵格類型。
目前dataframe對象插值更簡單，
但是SpatialPixelsDataFrame對象不支持多個多邊形邊界進行篩選。 over()不支持多個多邊形邊界進行篩選 ，mask()不支持SpatialPixelsDataFrame對象。
所以只能一個個邊界進行篩選，然後索引內部元素進行合併。
7.3.1 插值運算
1library(akima)
2library(sp)
3library(raster)
4
5# 對整個TEM_1th進行插值
6TEM_interp <- interp(x = TEM_1th$long, y = TEM_1th$lat, z = TEM_1th$aver_TEM,
7 xo = seq(60, 140, by = 0.1), # 指定插值經度範圍
8 yo = seq(10, 60, 0.1), # 指定插值緯度範圍
9 linear = FALSE, # 表示是線性插值還是樣條插值
10 extrap = TRUE) # 表示是否接受外插，有的柵格只能外插才能得到，
11
12# 生成網格數據
13TEM_grd <- SpatialPoints(expand.grid(x=TEM_interp$x, y = TEM_interp$y))
14TEM_grd <- SpatialPixelsDataFrame(TEM_grd, data.frame(kde = array(TEM_interp$z,
15 length(TEM_interp$z))))
16# 分離地圖邊界
17df_as_sp <- function(map_df, area) { # x,y指定經緯度
18 map_subset <- subset(map_df, AREA == area)
19 Sr1 <- Polygon(cbind(map_subset$long, map_subset$lat))
20 Srs1 <- Polygons(list(Sr1), ID = "1")
21 SpP <- SpatialPolygons(Srl = list(Srs1), 1:1)
22 partmap_sp <- SpatialPolygonsDataFrame(
23 Sr = SpP,
24 data = data.frame(Names = "coords", row.names = row.names(SpP)))
25 return(partmap_sp)
26}
27
28Mainland_sp <- df_as_sp(Chinaboundary_df, 954.943)
29Hainan_sp <- df_as_sp(Chinaboundary_df, 2.903)
30
31# 篩選各個邊界內的柵格數據
32Mainland_overcheck <- !is.na(sp::over(x = TEM_grd, y = Mainland_sp))
33Hainan_overcheck <- !is.na(sp::over(x = TEM_grd, y = Hainan_sp))
34Mainland_grd <- TEM_grd[Mainland_overcheck[,1], ]
35Hainan_grd <- TEM_grd[Hainan_overcheck[,1], ]
36
37# 柵格合併
38Mainland_grd <-cbind(Mainland_grd@coords,Mainland_grd@data) #
39Hainan_grd <- cbind(Hainan_grd@coords,Hainan_grd@data)
40
41grd_bind_noTaiwan <- rbind(Mainland_grd, Hainan_grd)
42
43rm(TEM_interp, TEM_grd, df_as_sp,
44 Mainland_overcheck, Hainan_overcheck,
45 Mainland_grd, Hainan_grd )# 移除中途數據
46
47# 生成等值線數據
48breaks_lines <- seq(min(TEM_1th$aver_TEM), max(TEM_1th$aver_TEM), length.out = 10)
7.3.2 ggplot2繪圖
1library(ggplot2)
2
3ggplot(data = grd_bind_noTaiwan) +
4 # 所有柵格
5 geom_raster(aes(x=x,y=y,fill=kde)) +
6 # 增加等值線
7 geom_contour(aes(x=x,y=y,z=kde),
8 color ="white",breaks=breaks_lines) +
9 # 中國省級地圖輪廓
10 geom_polygon(data = Chinaprovinces_df,
11 aes(x = long, y = lat, group = group),
12 color = "black", fill = "transparent", size = 0.5) +
13 # 臺灣地圖
14 geom_polygon(data = Taiwan_df,
15 aes(x = long, y = lat, group = group),
16 color = NA, fill = "grey", size = 0.5) +
17 # 各省名字，座標爲省會所在位置
18 geom_text(data = provinces,
19 aes(x = x, y = y, label = shortname),
20 color = "green", size = 2) +
21 # 增加南海九段線
22 geom_line(data = Nine_lines,
23 aes(x=long, y=lat, group=ID),
24 colour="black", size=1) +
25 coord_cartesian() + # geom_raster只能搭配笛卡爾座標系
26 # 柵格顏色填充標度
27 scale_fill_gradient2(low = "blue", mid = "white", midpoint = 0,
28 high= "red",na.value = "grey", # 設定缺失值爲灰色
29 name = "氣溫(℃)") + #
30 labs(title = "中國平均氣溫分佈圖\n(2017年1月1日)",
31 caption = "注：圖中數據不含臺灣地區") +
32 theme_void()+
33 theme(
34 legend.position=c(0.2,0.2),
35 legend.background=element_blank(),
36 plot.title = element_text(colour = "magenta", size = 13,
37 face = "bold", hjust = 0.5),
38 legend.title = element_text(face = "bold", colour = "deeppink")
39 )
tmap中只能插入與leaflet中類似的小地圖，即在線小地圖。
實際上還是用PS截圖拼圖更加方便，甚至用PPT也行。
小地圖會增加上百行代碼。
參
考來源
R語言空間插值的幾種方法及案例應用
gstat插值參數確定
https://mgimond.github.io/Spatial/spatial-interpolation.html
tmap空間插值
https://mgimond.github.io/Spatial/interpolation-in-r.html
R中的點插值
https://www.cdrc.ac.uk/wp-content/uploads/2016/11/Practical_11.html
tmap實例
https://cran.r-project.org/web/packages/tmap/vignettes/tmap-getstarted.html
tmap繪製人口調查地圖
http://zevross.com/blog/2018/10/02/creating-beautiful-demographic-maps-in-r-with-the-tidycensus-and-tmap-packages/
tmap分面及佈局
https://geocompr.robinlovelace.net/adv-map.html
sf介紹
https://cran.r-project.org/web/packages/sf/vignettes/sf1.html
SpatialLinesDataFrame創建
https://gis.stackexchange.com/questions/163286/how-do-i-create-a-spatiallinesdataframe-from-a-dataframe
SpatialPolygonsDataFrame創建
https://www.rdocumentation.org/packages/sp/versions/1.3-1/topics/SpatialPolygonsDataFrame-class
SPDF轉化爲SLDF
https://gis.stackexchange.com/questions/200679/convert-spatialpolygonsdf-boundaries-to-spatiallinesdf-keeping-information-on-po
sp對象及柵格數據介紹(最全)
https://rspatial.org/spatial/8-rastermanip.html
合併多個SPDF
https://gis.stackexchange.com/questions/155328/merging-multiple-spatialpolygondataframes-into-1-spdf-in-r
Kriging插值
https://rpubs.com/nabilabd/118172
IDW插值
https://nceas.github.io/oss-lessons/spatial-data-gis-law/4-tues-spatial-analysis-in-r.html
akima插值與ggplot2繪圖
https://stackoverflow.com/questions/50533738/best-method-of-spatial-interpolation-for-geographic-heat-contour-maps
IDW插值與ggplot2
http://aasa.ut.ee/LOOM02331/R_idw_interpolation.html
kknn插值與ggplot2
https://timogrossenbacher.ch/2018/03/categorical-spatial-interpolation-with-r/
反距離加權插值
https://www.jianshu.com/p/b38c5e464d16
將rasterLayer對象轉化爲SpatialGrid/SpatialPixels對象
https://gis.stackexchange.com/questions/43707/how-to-produce-spatial-grid-from-raster
KNN插值原理
http://www.kuqin.com/algorithm/20120817/329048.html
往期精彩：
-
R_空間插值_必知必
會（一）
ggplot2圖集彙總（一）
R_ggplot2地理信息可視化_史上最全（一）
R語言中文社區2018年終文章整理（作者篇）
R語言中文社區2018年終文章整理（類型篇）
公衆號後臺回覆關鍵字即可學習
回覆 爬蟲 爬蟲三大案例實戰
回覆 Python 1小時破冰入門
回覆 數據挖掘 R語言入門及數據挖掘
回覆 人工智能 三個月入門人工智能
回覆 數據分析師 數據分析師成長之路
回覆 機器學習 機器學習的商業應用
回覆 數據科學 數據科學實戰
回覆 常用算法 常用數據挖掘算法