## ############################################################################
##
## The 2024 Lancet Countdown in Europe report
## Indicator 1.3.6: Climatic Suitability for Ticks
##
## Script 05: Compute suitability for I. ricinus activity
## 
## Authors: 
## - Martín Lotto Batista, ORCID: 0000-0002-9437-5270
## - Prof. Rachel Lowe, ORCID: 0000-0003-3939-7343
##
## Contact: martin.lotto@bsc.es
## 
## ############################################################################

# Packages
pacman::p_load(raster, sf, exactextractr, openxlsx, tidyverse)

# Climatic suitability
clim <- brick("data/data_in/era5_land_EUR_1951_2022/final_out/ixodes_suit_1951_2022.nc")

# Environmental suitability
env <- raster("data/data_in/land_use/weigths.tif") %>% 
  projectRaster(clim[[1]], method="ngb")
env[is.na(env)] <- 0

# Maps
fls <- list.files("data/data_in/maps", pattern=".shp", full.names=TRUE)
fls <- fls[!grepl("WHO", fls)]
shps <- lapply(fls, st_read, quiet=TRUE)

# Function to arrange data after extraction
mk.data <- function(data, ids){
  data %>% 
    bind_cols(id=ids) %>% 
    pivot_longer(cols=c(1:72), names_to="year", values_to="n.months") %>% 
    mutate(year=as.numeric(str_replace_all(year, c("weighted_mean\\.X"="", 
                                                   "\\.06\\.16"="",
                                                   "\\.06\\.01"=""))),
           n.months=round(n.months, 2))
}

## Extract summaries by different classification levels
lbs <- c("deprivation", "country", "EEA", "HDI", "NUTS2", "NUTS3", 
          "sev_depriv", "UN", "urb_rural", "Income")

final <- vector(10, mode="list")
for(i in 1:10){
  full <- exact_extract(clim, shps[[i]], 'weighted_mean', 
                        weights=env, progress=FALSE)
  full.dt <- mk.data(full, st_drop_geometry(shps[[i]])) %>% 
    rename(Suit=n.months)

  final[[i]] <- full.dt
}

# Save outputs in an Excel file
wb <- createWorkbook()
lapply(seq_along(final), function(i){
  addWorksheet(wb=wb, sheetName=lbs[i])
  writeData(wb, sheet=i, final[[i]])
})

saveWorkbook(wb, "data/data_out/suitability.xlsx", overwrite = TRUE)

# END