Search code examples
rrasterterra

Normalise raster for individual polygons


library(raster)
library(rnaturalearth)
library(terra)

r <- raster::getData('CMIP5', var='tmin', res=10, rcp=45, model='HE', year=70)
r <- r[[1]]    
shp <- rnaturalearth::ne_countries()

newcrs <- "+proj=robin +datum=WGS84"

r <- rast(r)
shp <- vect(shp)
r_pr <- terra::project(r, newcrs)            
shp_pr <- terra::project(shp, newcrs)            

For every country in shp_pr, I want to normalise the underlying raster on a scale of 0-1. This means dividing a cell by the sum of all the cells within a country boundary and repeating it for all the countries. I am doing this as follows:

country_vec <- shp$sovereignt

temp_ls <- list()

for(c in seq_along(country_vec)){
  
  country_ref <- country_vec[c]
  
  if(country_ref == "Antarctica") { next }      
  
  shp_ct <- shp[shp$sovereignt == country_ref]

  r_country <- terra::crop(r, shp_ct) # crops to the extent of boundary 
  r_country <- terra::extract(r_country, shp_ct, xy=T) 
  r_country$score_norm <- r_country$he45tn701/sum(na.omit(r_country$he45tn701))
  r_country_norm_rast <- rasterFromXYZ(r_country[ , c("x","y","score_norm")])
  
  temp_ls[[c]] <- r_country_norm_rast
  
  rm(shp_ct, r_country, r_country_norm_rast)
  }    

m <- do.call(merge, temp_ls)

I wondered if this is the most efficient/right way to do this i.e. without any for loop and anyone has any suggestions?


Solution

  • Somewhat updated and simplified example data (there is no need for projection the data)

    library(terra)
    library(geodata)
    r <- geodata::cmip6_world("HadGEM3-GC31-LL", "585", "2061-2080", "tmin", 10, ".")[[1]]
    v <- world(path=".")
    v$ID <- 1:nrow(v)
    

    Solution

    z <- rasterize(v, r, "ID", touches=TRUE)    
    zmin <- zonal(r, z, min, na.rm=TRUE, as.raster=TRUE)
    zmax <- zonal(r, z, max, na.rm=TRUE, as.raster=TRUE)
    x <- (r - zmin) / (zmax - zmin)
    

    Note that the above normalizes the cell values for each country between 0 and 1.

    To transform the data such that the values add up to 1 (by country), you can do:

    z <- rasterize(v, r, "ID", touches=TRUE)    
    zsum <- zonal(r, z, sum, na.rm=TRUE, as.raster=TRUE)
    x <- r / zsum