For the work, we have to load the following libraries:

packages <- c("terra", "tidyverse", "dplyr")

Method

The process requires collecting sub-district wise data on deprived population. The data is available from SECC census 2011 for the sub-districts. The data is saved in a csv format and merged to the sub-district shapefile. Since the number of deprived households are available, it is first converted to percentage using the 2011 population. The calculated percentage is rasterised.

deprv_noph <- read.csv("state/assam_sub_district_deprv_noph.csv")
districts <- vect("ASSAM_SUBDISTRICT_4326.shp")
distr_deprv_noph <- merge(districts, deprv_noph, by='OBJECTID')
var <- rast("state/pop_ind_ppp_2011_UNadj.tif")

#extract the population from the pop map using sub-district as boundary and add
#to the subdistrict shapefile
#extracting population of the subdistricts
pop_year_sd <- terra::extract(var, distr_deprv_noph , fun = sum, na.rm= T, df = T)
#change the field name
distr_deprv_noph$pop_year_sd  <- round(pop_year_sd$ind_ppp_2011_UNadj,0)
distr_deprv_noph$deprv <- as.numeric(distr_deprv_noph$deprv)
## Warning: NAs introduced by coercion
### DEPRIVED HOUSEHOLDS ###
#using the secc info for creating yearly maps
distr_deprv_noph$deprvperc <- distr_deprv_noph$deprv / distr_deprv_noph$pop_year_sd
#rasterise the secc data - deprived population data
no_ph <- rast(nrow = nrow(var), ncol = ncol(var))
ext(no_ph) <- ext(var)
res(no_ph) <- res(var)
crs(no_ph) <- crs(var)
no_ph <- rasterize(distr_deprv_noph, no_ph, 'deprvperc')
plot(no_ph, main = "Distribution of deproved population")

writeRaster(no_ph,"outputs_vulnerability/State_deprv.tif", overwrite = T)

The data on deprived population is converted to percentage in the above code. The rasterised image of the socio-economic variable multiplied with the population of a year gives the number of deprived people for the year.

#assuming there is no change in the percentage of deprived people
year <- 2015:2022
norm_map <- function(yr){
  #yr <- 2015
  var <- rast(sprintf("state/pop_ind_ppp_%s_UNadj.tif",yr))
  var <- var*no_ph
  plot(var, main = sprintf("Deprived population in %s",yr))
  return(var)
}

#calling the function
layermaps <- sapply(year, norm_map)

Finally, all the generated maps are saved.