library(terra)
library(sf)
library(exactextractr)
library(dplyr)
library(nngeo)
library(stringr)
7 Variable by equal-size grid
7.1 Data import
Load the required packages.
7.2 Generic Function to replace NAs with nearest neighbor.
This is just a generic function that uses nngeo
R package. Feel free to used and adapt it to your needs.
<- function(df, vari) {
fCheckNAs if (sum(is.na(pull(df, !!sym(vari))))>0){ # Check if there are NAs
<- df %>%
gp mutate(isna = is.finite(!!sym(vari))) %>%
group_by(isna) %>%
group_split()
<- gp[[1]] # DF with NAs
out_na <- gp[[2]] # DF without NAs
out_finite
<- st_nn(out_na, out_finite) %>% # Get nearest neighbour
d unlist()
<- out_na %>%
out_na mutate(!!sym(vari) := pull(out_finite, !!sym(vari))[d])
<- rbind(out_finite, out_na)
df
}return(df)
}
7.3 Read, Extract and weighted mean interpolation
# Create the projection
= "+proj=robin +lon_0=0 +datum=WGS84 +units=m +no_defs"
proj.geo # Reading equal grid file
<- st_read("data/PUs_MZ_100km2.shp") %>%
shp_file st_transform(crs = terra::crs(proj.geo))
# Read raster object
<- rast("data/tos_Omon_GFDL-ESM4_ssp585_r1i1p1f1_gr_201501-203412.tif")
rs_file <- subset(rs_file, 1)
rs_file crs(rs_file) <- terra::crs("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0")
<- terra::cellSize(rs_file)
weight_rs <- terra::project(rs_file, y = terra::crs(proj.geo), method = "near")
rs_file <- terra::project(weight_rs, y = terra::crs(proj.geo), method = "near")
weight_rs # Getting value by polygon
<- exact_extract(rs_file,
rs_bypu
shp_file, "weighted_mean",
weights = weight_rs,
append_cols = TRUE,
full_colnames = TRUE)
<- dplyr::right_join(shp_file, rs_bypu, "FID")
rs_shp colnames(rs_shp) <- c(stringr::str_remove_all(string = names(rs_shp), pattern = "weighted_mean."))
7.4 RUN: replace NAs with nearest neighbor.
<- names(rs_shp)
nms <- nms[nms != "geometry" & nms != "FID"]
nms
<- rs_shp %>%
single ::select(FID, nms[1])
dplyr<- fCheckNAs(df = single, vari = names(single)[2]) %>%
rs_sfInt as_tibble() %>%
::arrange(FID) %>%
dplyr::select(-FID, -geometry, -isna)
dplyr
saveRDS(rs_sfInt, "data/tos_Omon_GFDL-ESM4_ssp585_r1i1p1f1_gr_201501-203412.rds")
7.5 Plot the output
<- st_read("data/PUs_MZ_100km2.shp") %>%
pus st_transform(crs = robin)
<- readRDS("data/tos_Omon_GFDL-ESM4_ssp585_r1i1p1f1_gr_201501-203412.rds")
sf1 <- cbind(pus, sf1) %>%
df1 st_transform(crs = robin)
<- ggplot() +
p1 geom_sf(data = df1, aes(fill = X2015.01.16.area), colour = NA) +
geom_sf(data = world_sfRob, size = 0.05, fill = "grey20") +
theme_bw() +
theme(legend.title = element_text(angle = 0, size = rel(0.7)),
plot.title = element_text(face = "plain", size = 22, hjust = 0.5),
axis.text.x = element_text(size = rel(1), angle = 0),
axis.text.y = element_text(size = rel(1), angle = 0),
axis.title = element_blank()) +
scale_fill_distiller(palette = "Spectral",
limits = c(min(df1$X2015.01.16.area), max(df1$X2015.01.16.area)),
direction = -1,
oob = scales::squish,
guide = guide_colourbar(title.position = "top", title = "Sea Surface\nTemperature"))