11.1 Raster Interpolation Toolset
library(sp)
library(sf)
library(dplyr)
library(stars)
data(meuse)
<- meuse %>% st_as_sf(coords = c("x", "y")) meuse_sf
11.1.1 IDW
<- function(groundtruth, column, cellsize, nmax = Inf, maxdist = Inf, idp = 2,
my_idw extent = NULL) {
require(gstat)
require(sf)
require(raster)
if (is.null(extent)) {
<- groundtruth
extent
}
<- st_make_grid(extent, cellsize, what = "centers") %>% st_as_sf()
samples <- formula(paste(column, "~1"))
my_formula <- gstat::idw(formula = my_formula, groundtruth, newdata = samples, nmin = 1,
idw_sf maxdist = maxdist, idp = idp)
<- cbind(st_coordinates(idw_sf), idw_sf$var1.pred)
idw_matrix
<- raster::rasterFromXYZ(idw_matrix)
ras
if (all(grepl("polygon", st_geometry_type(extent), ignore.case = TRUE))) {
<- raster::mask(ras, st_as_sf(st_zm(extent)))
ras
}
ras }
<- my_idw(meuse_sf, "copper", cellsize = 10, idp = 3) meuse_idw
## [inverse distance weighted interpolation]
ggplot() + geom_stars(data = st_as_stars(meuse_idw)) + scale_fill_viridis_c() + theme_void() +
labs(fill = "copper") + coord_equal()
11.1.2 Kriging
<- function(groundtruth, column, cellsize, nmax = Inf, maxdist = Inf, extent = NULL) {
my_krige require(gstat)
require(sf)
require(raster)
if (is.null(extent)) {
<- groundtruth
extent
}
<- st_make_grid(extent, cellsize, what = "centers") %>% st_as_sf()
samples <- formula(paste(column, "~1"))
my_formula <- gstat::krige(formula = my_formula, groundtruth, newdata = samples,
idw_sf nmin = 1, maxdist = maxdist)
<- cbind(st_coordinates(idw_sf), idw_sf$var1.pred)
idw_matrix
<- raster::rasterFromXYZ(idw_matrix)
ras
if (all(grepl("polygon", st_geometry_type(extent), ignore.case = TRUE))) {
<- raster::mask(ras, st_as_sf(st_zm(extent)))
ras
}
ras }
<- my_krige(meuse_sf, "copper", cellsize = 10, nmax = 30, maxdist = 500) meuse_krige
## [inverse distance weighted interpolation]
ggplot() + geom_stars(data = st_as_stars(meuse_krige)) + scale_fill_viridis_c(na.value = NA) +
theme_void() + labs(fill = "copper") + coord_equal()
11.1.3 Natural Neighbor
Nearest Neighbor:
<- st_voronoi(st_union(meuse_sf))
meuse_thiessen <- st_cast(meuse_thiessen)
meuse_thiessen <- meuse_sf %>% st_bbox() %>% st_as_sfc()
meuse_bbox
<- st_intersection(meuse_thiessen, meuse_bbox)
meuse_thiessen
<- st_as_sf(meuse_thiessen)
meuse_thiessen <- st_join(meuse_thiessen, meuse_sf)
meuse_thiessen
ggplot() + geom_sf(data = meuse_thiessen, aes(fill = copper)) + geom_sf(data = meuse_sf) +
scale_fill_viridis_c() + theme_void()