---
title: "sf Package Tutorial"
output: 
  pdf_document:
    # code_folding: hide
date: "2024-11-18"
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(message = FALSE, warning = FALSE)
```

# Introduction

The "sf" or Simple Features package allows you to work with and manipulate spatial data in R, namely .shp files. 

The package offers a range of useful features and is particularly useful for our work, as we often have to match datasets from multiple sources to a common spatial grid. 

And a lot of the data files we use are stored in shapefiles. 

However, over the years I have found issues with the package, and areas where it makes mistakes, but I still think it  is the best option. So, I have found some solutions to these issues. 

```{r load packages}
library(sf)
library(dplyr)
library(purrr)
library(readr)
library(raster)
library(ggplot2)
```

# Converting files to .shp 

"sf" works with Simple Features objects, but it can work with other file types, like rasters and netCDF files. I often convert these file types to shapefiles, as I personally prefer them. 

To convert different file types to .shp 

```{r convert to sf}
# Example 1 - Raster 
rast <- raster("gpw_v4_population_count_rev11_2020_15_min.tif")
rast <- rasterToPolygons(rast, dissolve = TRUE)
rast <- st_as_sf(rast)

# Example 2 - netCDF 
ncdf <- raster("prlr_201001.nc")
ncdf <- rasterToPolygons(ncdf, dissolve = TRUE)
ncdf <- st_as_sf(ncdf)
```

# Loading data and checking grid size 

Here, I am going to show an example of matching points to boxes using the ERA5-Land grid, .25x.25 grid, to the NUTS regions.

First of all I am going to load the shapefile 

```{r load shapefile}
nuts <- read_sf("NUTS_RG_20M_2021_4326/NUTS_RG_20M_2021_4326.shp", stringsAsFactors = FALSE)
```

Then load the ERA5-Land grid 

```{r load grid}
era5 <- read_rds("era5_grid_eu.rds")
```

If you want to know your grid cell, then you an load your file as a raster, then simple call it, and it will give you the resolution. 

```{r check grid}
prlr <- raster("prlr_201001.nc")
prlr
```

# Set up files before you try and match 

For the shapefile, I tend to flatten my shapefile from MULTIPOLYGONS to POLYGONS, this way if I want to look at the bounding boxes to troubleshoot, it's easier to see where things have gone wrong.

I also make sure the projections are set, at least so I know what they are. 

```{r set up}
# Flatten my polygons 
nuts <- nuts %>% st_cast("MULTIPOLYGON") %>% st_cast("POLYGON")
# The NUTS file here is multiple admin units, so I am just filtering to admin 3 to reduce multiple matches
nuts3 <- nuts %>% filter(LEVL_CODE == 3)
# Set projection
nuts3 <- st_transform(nuts3, crs = 4326)
```

So in theory, you have a full grid covering the whole of Europe, and a shapefile for Europe, so there should be matches for every admin unit in your shapefile. 

So that you can check this, find out how many admin units you have, and then you can check the merged file and see if you have the same number after the join. 

```{r no of units}
length(unique(nuts3$NUTS_ID))
```

So when you are done matching/joining, you should still have 1,514 unique NUTS3 codes. There are a few options to match points and polygons and here I will highlight a few. 

# Option 1: Join using st_within

st_join is the sf package's join function and operates similar to the join functions in dplyr. 

You can select your join within st_join, here I am using st_within, which is basically identifying which points fall into which polygons.  

You need to convert your dataframe of x and y coordinates to an sf object, or POINT first and make sure you match the projections to the same as the shapefile. 

```{r st_within}
# Convert coordinates to POINT with same projection and shapefile
coords_sf <- st_as_sf(era5, coords = c("x", "y"), crs = st_crs(nuts3))
# Join within st_within
coords_within <- st_join(coords_sf, nuts3, join = st_within)
```

# Option 2: Join using st_bbox

Instead of using one of the join functions within sf, it can be easier to troubleshoot issues if you convert your polygons to bounding boxes and match them using dplyr instead. 

In theory, it should be the same as the above method. 

```{r st_bbox}
# Extract the bbox for each NUTS3
bbox <- map(nuts3$geometry, st_bbox)
bbox <- bind_rows(bbox)
NUTS_ID <- nuts3$NUTS_ID
bbox <- cbind(bbox, NUTS_ID)
# As some NUTS3 had MULTIPOLYGONS, some have >1 bbox, to solve this
bbox <- bbox %>% group_by(NUTS_ID) %>% 
  mutate(xmin = min(xmin)) %>% 
  mutate(ymin = min(ymin)) %>%
  mutate(xmax = max(xmax)) %>% 
  mutate(ymax = max(ymax)) %>% 
  ungroup(NUTS_ID) %>% distinct()
# Convert my boxes to a list 
box_list <- bbox %>% group_split(NUTS_ID, .keep = T)
names <- box_list %>% map(~ .x %>% pull(NUTS_ID) %>% unique)
box_list <- box_list %>% set_names(names)
# Bind each boxes to your coordinates 
box_list <- box_list %>% map(~ .x %>% cbind(era5))
# Identify which points land in which boxes
pts_boxes <- box_list %>% 
  map(~ .x %>%
        mutate(in_box = if_else(
          x > xmin & x < xmax & y > ymin & y < ymax, 1, 0)) %>% 
        filter(in_box == 1) %>%
        dplyr::select(NUTS_ID, x , y)
)
# Bind the matched points and NUTS3 names 
coords_within2 <- bind_rows(pts_boxes, .id = "NUTS_ID")
```

# Test st_within vs st_bbox 

So from the above test, there should be 1,514 NUTS3 identification codes after the join. 

For st_within: 

```{r st_within test}
length(unique(coords_within$NUTS_ID))
```

For st_bbox: 

```{r st_bbox test}
length(unique(coords_within2$NUTS_ID))
```

There is not, there is 1,302 for st_within and 1,362 for st_bbox. So you lose a few less by doing it manually and not using the join within sf. 

# Identify missing matches 

To gain a greater understanding of why some wont join with either of the methods, lets subset the to the missing NUTS regions and learn more about those polygons. 

```{r identify missing}
# Which ones were not matched using st_within 
nuts3_complete <- data.frame(NUTS_ID = nuts3$NUTS_ID) %>% unique()
not_within <- unique(coords_within$NUTS_ID)
not_within <- nuts3_complete %>% filter(!NUTS_ID %in% not_within)
not_within$method <- "st_within"
not_within <- left_join(not_within, bbox)
# Which ones were not matched using st_bbox 
not_within2 <- purrr::discard(pts_boxes, ~nrow(.) > 0)
not_within2 <- names(not_within2)
not_within2 <- bbox %>% filter(NUTS_ID %in% not_within2)
not_within2$method <- "st_bbox"
# Merge all the missing NUTS3 together 
not_within <- rbind(not_within, not_within2)
```

# Explore the missing matches

To visualise which ones are missing, we can plot this. 

```{r plot missing}
# First lets assign a categorical code to those which are missing/matched 
plot_within <- not_within %>% arrange(NUTS_ID) %>% 
  mutate(match = if_else(
     method == "st_within" | method == "st_bbox", "no match", "match")) %>%
  dplyr::select(-method) %>% distinct()
plot_within <- na.omit(plot_within)
plot_within <- left_join(nuts3, plot_within)
plot_within$match[is.na(plot_within$match)] <- "match"

# Plot 
ggplot(plot_within) +
  geom_sf(aes(fill = match), color = "gray80", alpha = .7, size = 0.1) + 
  xlim(-23, 45) + 
  ylim(35, 70) + 
  theme_minimal() + 
  labs(fill = "Match") + 
  theme(text = element_text(face = "bold", size = 18))
```

From the map you can see: 

  1. There are no NUTS codes with are not identified only in st_bbox 
  2. Most of the missing NUTS codes are in the UK and Germany 
  
Lets get a bit more information about these codes. 

```{r explore missing}
# Lets learn more about these NUTS regions 
# Explore the area size, in km2
not_within <- left_join(not_within, nuts3) 
not_within$nuts_area <- as.numeric(st_area(not_within$geometry))/1e6
# Explore the size of the bbox 
not_within <- not_within %>% mutate(ydiff = ymax - ymin) %>% mutate(xdiff = xmax - xmin)
```

# Issue 1: Small polygons 

Most of the ones which haven't matched is due to the fact the the bounding box is smaller than the grid size, see xdiff     and ydiff, so you get no matches.  

So those which have not matched are either European territories not in Europe such as Guadeloupe and La Réunion. Or the bounding box is smaller than the grid cell, and therefore the all the centroids miss it. In Europe, this particularly happens in NUTS3 regions of Germany and London boroughs. 

To visualise this issue, here is one of the missing NUTS3 regions in Germany, with the ERA5 points around it. 

```{r visualise issue}
de261 <- nuts3 %>% filter(NUTS_ID == "DE261")
ggplot() +
  geom_sf(data = de261, fill = "lightblue", color = "black") + 
  geom_sf_text(data = de261, aes(label = "DE261"), size = 3, fontface = "bold") +
  theme_minimal() + 
  geom_point(data = era5, aes(x = x, y = y), color = "red", alpha = .5, size = 5) +  
  xlim(9, 9.5) + ylim(49.5, 50) 
```

# Issue 2: Funky shaped polygons 

Another issue which can occur, but you dont get when comparing European NUTS3 regions is when shapefiles are an odd shape. 

I am going to use Vietnam to highlight this issue. 

```{r load vnm shp}
vnm <- read_sf("gadm41_VNM_shp/gadm41_VNM_2.shp", stringsAsFactors = FALSE)
```

Lets visualise the shapefile to highlight the issue. 

```{r plot vnm}
ggplot(vnm) + geom_sf() + theme_minimal()
```

As the name suggests, bounding boxes work in boxes, so if your shapefile has a curve, like Vietnam, this can create the opposite problem as above, over-attribution of points to administrative units. 

Let zoom in to an area that could be particularly problematic and create the issue that is explained here. 

```{r plot vnm2}
# Extract the bbox of a problematic admin unit 
iffy_box <- vnm %>% filter(GID_2 == "VNM.34.1_1")
iffy_box <- st_bbox(iffy_box)

# Create a .1x.1 grid
x_coords <- seq(107.2, 108, by = 0.1)
y_coords <- seq(14.7, 15.5, by = 0.1)
grid_df <- expand.grid(x = x_coords, y = y_coords)

ggplot() +
  geom_sf(data = vnm, fill = "grey", alpha = .2) + 
  geom_sf_text(data = vnm, aes(label = GID_2), color = "dodgerblue", size = 3, fontface = "bold") + 
  geom_rect(
    aes(xmin = 107.46, xmax = 108.00, ymin = 14.86, ymax = 15.42),
    color = "black", fill = NA, linetype = "dashed", size = 0.8) +
  geom_point(data = grid_df, aes(x = x, y = y), color = "#FF6F61", size = 3) + 
  theme_minimal() + 
  coord_sf(xlim = c(107, 108), ylim = c(14.5, 15.5))
```

If we look at VMN.34.1_1 and its bounding box, sometimes st join options can get confused and assign ones in the sea, or in other admin units to in this case VMN.34.1_1. 

# Solution using st_intersect 

To solve these issues, I match in two stages. I first go for st_within, and then I use st_intersection. I use st_within first, because its less computationally heavy, and so if I have a big dataset, it runs much quicker and I get less session aborts. 

First of all I need to subset my NUTS3 shapefile to the ones which wont match. 

```{r no nuts}
not_within <- not_within %>% filter(method == "st_within")
not_within <- unique(not_within$NUTS_ID)
no_nuts <- nuts3 %>% filter(NUTS_ID %in% not_within)
```

I need to transform my centroids back into the grid. To do this I add and subtract half the resolution by the centroid. 

```{r to grid}
era5_grid <- era5 %>% 
  mutate(xmin = x-0.125) %>% 
  mutate(xmax = x+0.125) %>% 
  mutate(ymin = y-0.125) %>% 
  mutate(ymax = y+0.125)
era5_grid <- era5_grid %>% dplyr::select(-x, -y)
```

Now you have the bounding boxes from each centroid, you can transform this into POLYGONs

```{r to polys}
era5_polys <- map(1:nrow(era5_grid), function(i) {
  coords <- matrix(c(
    era5_grid$xmin[i], era5_grid$ymin[i],
    era5_grid$xmax[i], era5_grid$ymin[i],
    era5_grid$xmax[i], era5_grid$ymax[i],
    era5_grid$xmin[i], era5_grid$ymax[i],
    era5_grid$xmin[i], era5_grid$ymin[i] 
  ), ncol = 2, byrow = TRUE)
  st_polygon(list(coords))
})
# Convert the list of polygons to an 'sf' object
era5_polys <- st_sfc(era5_polys)
era5_polys <- st_sf(era5, geometry = era5_polys)
```

Double check my projections are the same for the ERA5 grid and the NUTS regions.

```{r check projections}
no_nuts <- st_set_crs(no_nuts, 4326)
era5_polys <- st_set_crs(era5_polys, 4326)
```

```{r st_area}
sf_use_s2(FALSE)
no_nuts$nuts_area <- st_area(no_nuts$geometry)
era5_polys$era5_area <- st_area(era5_polys$geometry)
```

Find the intersections between the ERA5 grid and NUTS3 polygons. 

```{r st_intersect}
sf_use_s2(FALSE)
overlaps <- st_join(no_nuts, era5_polys, join = st_intersects)

length(unique(overlaps$NUTS_ID))
```

Of course, some grid cells will overlap with multiple admin units. So to reduce this, you can then subset to the matched administrative unit with the greatest proportion of overlap. 

```{r max_overlap}
overlaps$overlap_percent <- as.numeric(overlaps$nuts_area/overlaps$era5_area*100)
overlaps <- overlaps %>% group_by(x, y) %>% filter(overlap_percent == max(overlap_percent)) %>% ungroup()
```




