Yield change predictors: compute grow season predictors (accumulated precipitation and mean temperature)

In this script, we compute variables used to compute yield change based on theoretical models provided by Agnolucci. We compute:

acumulated growing season precipitation: the growing season depends of each product;
mean growing season temperature.

The outputs can be seen in Section Visualize.

Load packages, read data and source custom scripts

rm(list = ls())
library(stars)

#> Loading required package: abind

#> Loading required package: sf

#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1

path_proj <- day2day::git_path()
path_data <- file.path(path_proj, "data")
path_cleaned <- file.path(path_data, "cleaned")
path_processed <- file.path(path_data, "processed")

source(file.path(path_proj, "src", "72-yield-change.R"))
source(file.path(path_proj, "src", "34-read-sce-var.R"))
source(file.path(path_proj, "src", "60-vis-stars.R"))

speed_meta <- readr::read_csv(file.path(path_cleaned, "ukcp18-speed_rcp85_bias_corrected_01_metadata.csv"))

#> Parsed with column specification:
#> cols(
#>   file = col_character(),
#>   variable = col_character(),
#>   summary = col_character(),
#>   temp_resolution = col_character(),
#>   from = col_double(),
#>   to = col_double(),
#>   from_year = col_double(),
#>   from_month = col_double(),
#>   to_year = col_double(),
#>   to_month = col_double(),
#>   description = col_character()
#> )

yields <- readRDS(file.path(path_cleaned, "yield-params-and-season.rds"))

Compute grow season predictors

periods <- unique(subset(speed_meta, select = c("from_year", "to_year")))
seasons <- unique(yields$season)
custom_fun <- function(from_year, to_year, season) {
    yield_change_predictors(speed_meta, from_year, to_year, season,
                            vars = c("pr", "tas"), path_cleaned, path_processed)
}

for (i in seasons) {
    purrr::map2(periods$from_year, periods$to_year, ~ custom_fun(.x, .y, i))
}

Visualize

read_yield_pred <- function(var = "season_pr_accum_10mm", season = "apr-sep") {
    pattern <- paste("ukcp18-speed_rcp85_bias_corrected_01", var, "20yr", season,
                     sep = "_")
    regex <- "^.+_20yr_[a-z]+-[a-z]+_([[:digit:]]{4}).+(-[[:digit:]]{4}).+$"
    out <- read_sce_var(path_processed, pattern, regex)
    return(out)
}

seasons_label <- lapply(seasons, season_label)

for (season in seasons_label) {
    cat(paste0("\n### Accumulated precipitation (", season, ")\n" ))
    out <- read_yield_pred("season_pr_accum_10mm", season)
    plot_stars(out, nbreaks = 15, breaks = "quantile")
    cat("\n")
}

Accumulated precipitation (mar-jul)

Accumulated precipitation (apr-sep)

Accumulated precipitation (sep-jul)

for (season in seasons_label) {
    cat(paste0("\n### Mean temperature (", season, ")\n" ))
    out <- read_yield_pred("season_tas_mean", season)
    plot_stars(out, nbreaks = 15, breaks = "quantile")
    cat("\n")
}

Mean temperature (mar-jul)

Mean temperature (apr-sep)

Mean temperature (sep-jul)

Time to execute the task

Only useful when executed with Rscript.

proc.time()

#>    user  system elapsed 
#> 239.268  17.173 256.780