# take the output of Flor/s2s/subseasonal_loading.R

source("../git/sunset/modules/Crossval/R/tmp/GetProbs.R")

Crossval_calibration <- function(recipe, data) { 

  cross.method <- recipe$Analysis$cross.method
  # TODO move check
  if (is.null(cross.method)) {
    cross.method <- 'leave-one-out'
  }
  categories <- recipe$Analysis$Workflow$Probabilities$percentiles
  categories <- lapply(categories, function (x) { 
                       sapply(x, function(y) {
                              eval(parse(text = y))})})
  ncores <- recipe$Analysis$ncores
  na.rm <- recipe$Analysis$remove_NAs 
  ## data dimensions 
  sdate_dim <- dim(data$hcst$data)['syear']
  orig_dims <- names(dim(data$hcst$data))
  # spatial dims
  if ('latitude' %in% names(dim(data$hcst$data))) {
    nlats <- dim(data$hcst$data)['latitude']
    nlons <- dim(data$hcst$data)['longitude']
    agg = 'global'
  } else if  ('region' %in% names(dim(data$hcst$data))) {
    agg = 'region'
    nregions <- dim(data$hcst$data)['region']
  }

 
  cross <- CSTools:::.make.eval.train.dexes(eval.method = cross.method,
                                            amt.points = sdate_dim,
                                            amt.points_cor = NULL) # k = ?

  cal_hcst_ev_res <- NULL
  cal_obs_ev_res <- NULL
  cal_obs_tr_res <- NULL
  # as long as probs requested in recipe:
  lims_cal_hcst_tr_res <- lapply(categories, function(X) {NULL})
  lims_cal_obs_tr_res <- lapply(categories, function(X) {NULL})

  fcst_probs <- lapply(categories, function(x){NULL})
  hcst_probs_ev <- lapply(categories, function(x){NULL})
  obs_probs_ev <- lapply(categories, function(x){NULL})

  for (t in 1:length(cross)) {
    info(recipe$Run$logger, paste("crossval:", t))

    # subset years: Subset works at BSC not at Athos
    ## training indices
    obs_tr <- CST_Subset(data$obs, along = 'syear',
   		     indices = cross[[t]]$train.dexes)
    hcst_tr <- CST_Subset(data$hcst, along = 'syear', 
  		      indices = cross[[t]]$train.dexes)
    ## evaluation indices
    hcst_ev <- CST_Subset(data$hcst, along = 'syear',
  		      indices = cross[[t]]$eval.dexes)
    obs_ev <- CST_Subset(data$obs, along = 'syear',
  		     indices = cross[[t]]$eval.dexes)
    
    if (tolower(recipe$Analysis$Horizon) == 'subseasonal') {
source("https://earth.bsc.es/gitlab/external/cstools/-/raw/d6914a40c11d09168b9b4a191e9a0362b56a5f0c/R/CST_MergeDims.R")

      hcst_tr <- CST_MergeDims(hcst_tr, merge_dims = c('sday', 'syear'), 
                          rename_dim = 'syear', na.rm = FALSE) 
      obs_tr <- CST_MergeDims(obs_tr, merge_dims = c('sday', 'syear'),
                          rename_dim = 'syear', na.rm = FALSE)
      hcst_ev <- CST_MergeDims(hcst_ev, merge_dims = c('sday', 'syear'),
                          rename_dim = 'syear', na.rm = FALSE)
    }
    cal_hcst_tr <- CST_Calibration(exp = hcst_tr, obs = obs_tr,
                                   memb_dim = 'ensemble', sdate_dim = 'syear',
				   eval.method = 'in-sample',
                                   ncores = ncores) 
    cal_hcst_ev <- CST_Calibration(exp = hcst_tr, obs = obs_tr, exp_cor = hcst_ev,
                                   memb_dim = 'ensemble', sdate_dim = 'syear',
				   eval.method = 'in-sample',
                                   ncores = ncores)

   lims_cal_hcst_tr <- Apply(cal_hcst_tr$data, target_dims = c('syear', 'ensemble'),
                              fun = function(x, prob_lims) {
                                lapply(prob_lims, function(ps) {
                                  quantile(as.vector(x), ps, na.rm = na.rm)})},
                              output_dims = lapply(categories, function(x) {'cat'}), 
                              prob_lims = categories,
                              ncores = ncores)
    lims_cal_obs_tr <- Apply(obs_tr$data, target_dims = c('syear'),#, 'ensemble'),
                             fun = function(x, prob_lims) {
                               lapply(prob_lims, function(ps) {
                                 quantile(as.vector(x), ps, na.rm = na.rm)})},
                             output_dims = lapply(categories, function(x){'cat'}),
                             prob_lims = categories,
                             ncores = ncores)




}
