Checking on the tas-psl-pr girdded products

1 Set Up

library(data.table)
library(dplyr)
library(tidyr)
library(ggplot2)

BASE_DIR <- here::here()

theme_set(theme_bw())

1.1 Objective

Here we are taking a look at the files that ACS created on 3-30-2022 for the stitches manuscript, results from the grided tas-psl-pr experiment. She did not share the grided nc files but did the share the recopies & the gsat results. Here we will take a look at the gsat results as a form of quality control.

2 Checking out the recpies

here::here(BASE_DIR, "data") %>% 
    list.files(pattern = "rp", full.names = TRUE) %>% 
    lapply(function(f){
        rp <- read.csv(f, stringsAsFactors = FALSE)
    }) %>% 
    do.call(what = "rbind") ->
    rps

Start by checking on the archive experiments. There should only be three experiments historical & the two bracketing experiments.

unique(rps$archive_experiment)

[1] "historical" "ssp126"     "ssp585"    

Also let’s take a look at the ensembles used in the stitching process per model. Ideally there is going to be one that has a small ensmeble count and one with a larger one.

rps %>% 
    group_by(archive_model) %>% 
    summarise(ensemble_count = n_distinct(archive_ensemble)) %>% 
    ungroup 

Now let’s check to see if the same time slice & ensmble realization were used.

rps %>% 
    apply(MARGIN = 1, function(r){
        !grepl(pattern = r[["archive_ensemble"]], x = r[["stitching_id"]])
    }, simplify = TRUE) -> 
    diff_ensemble 

rps$diff_ensemble <- diff_ensemble

rps %>% 
    mutate(diff_period = target_start_yr - archive_start_yr) %>%
    mutate(diff_ensemble = diff_ensemble) %>% 
    select(archive_model, archive_ensemble, archive_experiment, stitching_id, 
           diff_ensemble, diff_period, target_start_yr) ->
    rp_status

For the most part this is happening in the historical period, should check to make sure that this is okay.

rp_status %>% 
    select(archive_model, archive_experiment,  
           diff_ensemble, diff_period, target_start_yr)  %>% 
    filter(diff_period == 0 & diff_ensemble == FALSE)

3 GSAT time series

here::here(BASE_DIR, "data") %>% 
    list.files(pattern = "stitched_", full.names = TRUE) %>% 
    lapply(function(f){
        data <- read.csv(f, stringsAsFactors = FALSE)
        model <- gsub(pattern = "stitched_GSAT_data_ssp245_|stitched_GSAT_data_ssp370_|.csv", 
                      x = basename(f), replacement = "")
        data$model <- model
        return(data)
    }) %>% 
    do.call(what = "rbind") -> 
    out

here::here(BASE_DIR, "data") %>% 
    list.files(pattern = "comparison_", full.names = TRUE) %>% 
    lapply(function(f){
        data <- read.csv(f, stringsAsFactors = FALSE)
        return(data)
    }) %>% 
    do.call(what = "rbind") -> 
    comp_data

out %>%
    apply(MARGIN = 1, function(r){
        info <- unlist(strsplit(x = r[["stitching_id"]], split = "~"))
        data.frame(experiment = info[[1]], 
                   ensemble = info[[2]],
                   realization = info[[3]])
    }) %>% 
    do.call(what = "rbind") -> 
    info

out %>% 
    cbind(info) -> 
    stitched_to_plot 

ggplot() +
    geom_line(data = stitched_to_plot, aes(year, value, color = ensemble), alpha = 0.4, size = 1) + 
    # geom_line(data = comp_data, aes(year, value, group = ensemble), color = "black") + 
    facet_grid(model~experiment) + 
    labs(y = NULL, x = NULL, title = "Stitched Outputs") + 
    theme(legend.position = "none")

ggplot() +
    geom_line(data = stitched_to_plot, aes(year, value, color = ensemble), alpha = 0.4, size = 1) +
    geom_line(data = comp_data, aes(year, value, group = ensemble), color = "black", size = 0.25) + 
    facet_grid(model~experiment) + 
    labs(y = NULL, x = NULL, title = "Stitched Outputs vs. Comparison") + 
    theme(legend.position = "none")