# One function to compute all the possible metrics or statistics
# datos is a list returned by load_multimodel or load_multimodel_mean
  ## this reduce memory and it can be used to compute several metrics
  ## in the mean the ensemble dim is length 1 for each model
# probs is a list returned by load_multimodel_probs
  ## this is needed to compute rps/rpss
source("modules/Saving/Saving.R")
source("modules/Crossval/R/tmp/RPS.R")
source("modules/Crossval/R/RPS_clim.R")
source("modules/Crossval/R/CRPS_clim.R")
source("modules/Crossval/R/tmp/RPSS.R")
source("modules/Crossval/R/tmp/RandomWalkTest.R")
source("modules/Crossval/R/tmp/Corr.R")
source("modules/Crossval/R/tmp/Bias.R")
source("modules/Crossval/R/tmp/SprErr.R")
source("modules/Crossval/R/tmp/Eno.R")
source("modules/Crossval/R/tmp/GetProbs.R")
source("modules/Visualization/Visualization.R") # to load .warning from utils
Crossval_multimodel_metrics <- function(recipe,
                               data = NULL,
                               Fair = FALSE) {
  ncores <- recipe$Analysis$ncores
  na.rm <- recipe$Analysis$remove_NAs
  cross.method <- recipe$Analysis$cross.method
  if (is.null(cross.method)) {
    cross.method <- 'leave-one-out'
  }
  # Prepare indices for crossval
  sdate_dim <- dim(data$hcst[[1]])['syear']
  cross <- CSTools:::.make.eval.train.dexes(eval.method = cross.method,
                                            amt.points = sdate_dim,
                                            amt.points_cor = NULL)
  tmp <- array(1:length(cross), c(syear = length(cross)))
  alpha <- recipe$Analysis$alpha
  if (is.null(alpha)) {
    alpha <- 0.05
  }
  
  all_metrics <- paste0(recipe$Analysis$Workflow$Skill$metric,' ',
                        recipe$Analysis$Workflow$Statistics$metric)

  requested_metrics <- strsplit(all_metrics, ", | |,")[[1]]
  
  skill_metrics <- list()
  statistics <- list()
  
  if (!is.null(data)) {
    # convert $data elements to list to use multiApply:
    datos <- append(list(obs = data$obs), data$hcst)
    ## CRPS metrics only make sense in pool method:
    if ('crps' %in% requested_metrics) {
      crps <- Apply(datos, target_dims = c('syear', 'ensemble'),
                    fun = function(obs, ...) {
                      res <- abind(..., along = 2)
                      names(dim(res)) <- names(dim(obs))
                      obs <- Subset(obs, along = 'ensemble',
                                    indices = 1, drop = 'selected')
                      mean(s2dv:::.CRPS(exp = res, obs = obs, dat_dim = NULL,
                                   time_dim = 'syear',
                                   memb_dim = 'ensemble'))},
                    ncores = ncores)$output1
      skill_metrics$crps <- crps
      # Build the reference forecast:
      ref_clim <- Apply(list(datos$obs, tmp),
                        target_dims = list(c('ensemble', 'syear'), NULL),
                        function(x, y) {
                          Subset(x, along = 'syear',
                                 indices = cross[[y]]$train.dexes, drop = T)},
                        ncores = ncores, output_dims = 'ensemble')$output1
      datos <- append(list(ref = ref_clim), datos)
      crps_clim <- Apply(datos[1:2], target_dims = c('syear', 'ensemble'),
                         fun = function(ref, obs) {
                           obs <- Subset(obs, along = 'ensemble',
                                         indices = 1, drop = 'selected')
                           mean(s2dv:::.CRPS(exp = ref, obs = obs,
                                             dat_dim = NULL,
                           time_dim = 'syear', memb_dim = 'ensemble'))},
                         ncores = ncores)$output1
      skill_metrics$crps_clim <- crps_clim
    }
    if ('crps_syear' %in% requested_metrics) {
      crps_syear <- Apply(datos, target_dims = c('syear', 'ensemble'),
                    fun = function(obs, ...) {
                      res <- abind(..., along = 2)
                      names(dim(res)) <- names(dim(obs))
                      obs <- Subset(obs, along = 'ensemble',
                                    indices = 1, drop = 'selected')
                           s2dv:::.CRPS(exp = res, obs = obs, dat_dim = NULL,
                                        time_dim = 'syear',
                                        memb_dim = 'ensemble')},
                    ncores = ncores)$output1
      skill_metrics$crps_syear <- crps_syear
      # Build the reference forecast:
      ref_clim <- Apply(list(datos$obs, tmp),
                        target_dims = list(c('ensemble', 'syear'), NULL),
                        function(x, y) {
                          Subset(x, along = 'syear',
                                 indices = cross[[y]]$train.dexes, drop = T)},
                        ncores = ncores, output_dims = 'ensemble')$output1
      datos <- append(list(ref = ref_clim), datos)
      crps_clim_syear <- Apply(datos[1:2], target_dims = c('syear', 'ensemble'),
                         fun = function(ref, obs) {
                           obs <- Subset(obs, along = 'ensemble',
                                         indices = 1, drop = 'selected')
                                s2dv:::.CRPS(exp = ref, obs = obs,
                                             dat_dim = NULL,
                                             time_dim = 'syear',
                                             memb_dim = 'ensemble')},
                         ncores = ncores)$output1
      skill_metrics$crps_clim_syear <- crps_clim_syear
    }
     if ('crpss' %in% requested_metrics) {
      crpss <- Apply(datos, target_dims = c('syear', 'ensemble'),
                     fun = function(ref, obs, ...) {
                       res <-  abind(..., along = 2)
                       names(dim(res)) <- names(dim(obs))
                       obs <- Subset(obs, along = 'ensemble',
                                     indices = 1, drop = 'selected')
                       CRPSS(exp = res, obs = obs, ref = ref,
                            memb_dim = 'ensemble', Fair = FALSE,
                            time_dim = 'syear', clim.cross.val = FALSE)},
                     ncores = ncores)
      skill_metrics$crpss <- crpss$crpss
      skill_metrics$crpss_significance <- crpss$sign
      datos <- datos[-1]
    }
    ## Deterministic metrics using ensemble mean:
    if ('enscorr' %in% requested_metrics) { 
      enscorr <- Apply(datos, target_dims = c('syear', 'ensemble'),
                       function(obs, ...) {
                       res <- abind(..., along = 2)
                       names(dim(res)) <- c('syear', 'ensemble')
                       Corr(exp = res,
                            obs = obs,
                            dat_dim = NULL,
                            time_dim = 'syear',
                            method = 'pearson',
                            memb_dim = 'ensemble',
                            memb = F,
                            conf = F,
                            pval = F,
                            sign = T,
                            alpha = alpha)}, ncores = ncores)
      skill_metrics$enscorr <- enscorr$corr
      skill_metrics$enscorr_significance <- enscorr$sign
    }
    if ('mean_bias' %in% requested_metrics) {
      ## Mean Bias can make sense for non-anomalies (e.g. calibrated data)
      mean_bias <- Apply(datos, target_dims = c('syear', 'ensemble'), ## Need to use full field values?
                         function(obs, ...) {
                         res <- abind(..., along = 2)
                         names(dim(res)) <- c('syear', 'ensemble')
                         Bias(exp = res,
                              obs = obs,
                              time_dim = 'syear',
                              memb_dim = 'ensemble',
                              alpha = alpha)},
                         ncores = ncores)
      skill_metrics$mean_bias <- mean_bias$bias
      skill_metrics$mean_bias_significance <- mean_bias$sig
    }
    if ('enssprerr' %in% requested_metrics) { 
       enssprerr <- Apply(datos, target_dims = c('syear', 'ensemble'),
                       fun = function(obs, ...) {
                         res <- abind(..., along = 2)
                         names(dim(res)) <- c('syear', 'ensemble')
                         SprErr(exp = res,
                                obs = obs,
                                memb_dim = 'ensemble',
                                dat_dim = NULL,
                                time_dim = 'syear',
                                pval = F,
                                sign = T,
                                alpha = alpha)
                       },
                       ncores = ncores)
    skill_metrics$enssprerr <- enssprerr$ratio
    skill_metrics$enssprerr_significance <- enssprerr$sign ## Significance giving all NA
    }
    if ('rms' %in% requested_metrics) {
      rms <- Apply(datos, target_dims = c('syear', 'ensemble'),
                   function(obs, ...) {
                     res <- abind(..., along = 2)
                     names(dim(res)) <- c('syear', 'ensemble')
                     RMS(exp = res,
                         obs = obs,
                         memb_dim = 'ensemble', dat_dim = NULL,
                         time_dim = 'syear', alpha = alpha)},
                     ncores = ncores)
      skill_metrics$rms <- rms$rms
    }
    ####### Do we need reference fcst to compute rmss??
    if ('rmss' %in% requested_metrics) {
    #  if (is.null(res$ref_obs_tr)) {
    #  }
      rmss <- Apply(datos, target_dims = c('syear','ensemble'),
                    function(obs, ...) {
                      res <- abind(..., along = 2)
                      names(dim(res)) <- c('syear', 'ensemble')
                      RMSSS(exp = res,
                            obs = obs,
                            #ref = res$ref_obs_tr,
                            memb_dim = 'ensemble', dat_dim = NULL,
                            time_dim = 'syear', alpha = alpha, sign = TRUE)},
                    ncores = ncores)
      skill_metrics$rmss <- rmss$rmss
      skill_metrics$rmss_significance <- rmss$sign
    }
    
    ### Calculate ensemble mean for use in statistic metrics
    if (any(c('std', 'standard_deviation') %in% requested_metrics)) {
      std_hcst <- Apply(datos[-1], target_dims = c('syear', 'ensemble'), ## returning all zeros
                        function(...) {
                          res <- abind(..., along = 2)
                          names(dim(res)) <- c('syear', 'ensemble')
                          res <- MeanDims(res, 'ensemble') ## all values the same so no standard deviation
                          sd(as.vector(res))},
                        ncores = ncores)$output1

      std_obs <- Apply(datos[1], target_dims = c('syear', 'ensemble'), 
                       fun = 'sd')$output1
      statistics[['std_hcst']] <- std_hcst
      statistics[['std_obs']] <- std_obs
    }

    if (any(c('var', 'variance') %in% requested_metrics)) {
      ## Calculate variance
      var_hcst <- Apply(datos[-1], target_dims = c('syear', 'ensemble'),
                        fun = function(...) {
                          res <- abind(..., along = 2)
                          names(dim(res)) <- c('syear', 'ensemble')
                          res <- MeanDims(res, 'ensemble')
                          variance <- var(as.vector(res))
                          },
                        ncores = ncores)$output1
      
      var_obs <- Apply(datos[1], target_dims = c('syear', 'ensemble'), 
                       fun = function(x) {var(as.vector(x))},
                       ncores = ncores)$output1
      statistics[['var_hcst']] <- var_hcst
      statistics[['var_obs']] <- var_obs
    }
    if ('n_eff' %in% requested_metrics) {   
      ## Calculate degrees of freedom
      n_eff <- s2dv::Eno(datos[[1]], time_dim = 'syear',
                         na.action = na.pass,
                         ncores = ncores)
      statistics[['n_eff']] <- n_eff
    } 
    if (any(c('cov', 'covariance') %in% requested_metrics)) { 
      # The covariance of the ensemble mean
      covariance <- Apply(datos, target_dims = c('syear', 'ensemble'),
                          fun = function(obs, ...) {
                            res <- abind(..., along = 2)
                            names(dim(res)) <- c('syear', 'ensemble')
                            res <- MeanDims(res, 'ensemble')
                            cov(as.vector(obs), as.vector(res),
                                use = "everything", 
                                method = "pearson")},
                          ncores = ncores)$output1

      statistics$cov <- covariance
    }
  
    if ('spread' %in% requested_metrics) {   
      ## Calculate spread of the ensemble
      # C_cov <- stats:::C_cov
      spread <- Apply(datos[-1], target_dims = c('syear', 'ensemble'),
                      fun = function(...) {
                        # Combine the ensemble data along the ensemble dimension
                        res <- abind(..., along = 2)
                        names(dim(res)) <- c('syear', 'ensemble')
                        # Calculate the standard deviation across the ensemble dimension
                        spread <- Apply(res, target_dims = 'ensemble', fun = sd)$output1
                        # Average over the 'syear' dimension
                        spread <- MeanDims(spread, 'syear')
                        return(spread)
                      },
                      ncores = ncores)$output1
      statistics$spread <- spread
    } 
  }

    
  # Probabilistic metrics for categories
  categories <- recipe$Analysis$Workflow$Probabilities$percentiles
  categories <- lapply(categories, function (x) { 
                       sapply(x, function(y) {
                              eval(parse(text = y))})})
  # TODO: distinguish between rpss and bss 
  # if 1 percentile -> bss
  # if more than 1 -> rpss 
  exe_rps <- unlist(lapply(categories, function(x) {
                    if (length(x) > 1) {
                      x <- x[1] *100
                      }
                      return(x)}))
  if (!is.null(datos)) {
    if (Fair) {
      nmemb <- sum(unlist(lapply(datos[-1], function(x) dim(x)['ensemble'])))
    } else {
      nmemb <- NULL
    }
  } else {
    nmemb <- NULL
  }
  
  # Compute rps
  for  (ps in 1:length(exe_rps)) {
    if ('rps' %in% requested_metrics) {
      rps <- RPS(exp = data$probs$hcst[[ps]],
                 obs = data$probs$obs[[ps]], memb_dim = NULL,
                 cat_dim = 'bin', cross.val = FALSE, time_dim = 'syear',
       	         Fair = Fair, nmemb = nmemb,
                 ncores = ncores)
      rps_clim <- Apply(list(data$probs$obs[[ps]]),
                        target_dims = c('bin', 'syear'),
                        RPS_clim, bin_dim_abs = 'bin', Fair = Fair,
      	  	            cross.val = FALSE, ncores = ncores)$output1
      skill_metrics$rps <- rps
      skill_metrics$rps_clim <- rps_clim
      # names based on the categories:
      # To use it when visualization works for more rps
      #skill_metrics[[paste0('rps', exe_rps[ps])]] <- rps
      #skill_metrics[[paste0('rps_clim',
      #                      exe_rps[ps])]] <- rps_clim 
    }
    
    if ('rps_syear' %in% requested_metrics) {
      rps_syear <- RPS(exp = data$probs$hcst[[ps]],
                       obs = data$probs$obs[[ps]], memb_dim = NULL,
                       cat_dim = 'bin', cross.val = FALSE, time_dim = 'syear',
                       Fair = Fair, nmemb = nmemb, return_mean = FALSE,
                       ncores = ncores)
      rps_clim_syear <- Apply(list(data$probs$obs[[ps]]),
                              target_dims = c('bin', 'syear'),
                              RPS_clim, bin_dim_abs = 'bin', Fair = Fair,
                              cross.val = FALSE, return_mean = FALSE,
                              output_dims = 'syear', ncores = ncores)$output1
      skill_metrics$rps_syear <- rps_syear
      skill_metrics$rps_clim_syear <- rps_clim_syear
    }
    
    if ('rpss' %in% requested_metrics) {
      rpss <- RPSS(exp = data$probs$hcst[[ps]],
                   obs = data$probs$obs[[ps]],
                   ref = NULL, # ref is 1/3 by default if terciles
                   time_dim = 'syear', memb_dim = NULL,
                   cat_dim = 'bin', nmemb = nmemb,
                   dat_dim = NULL,
                   prob_thresholds = categories[[ps]], # un use param when providing probs
                   indices_for_clim = NULL,
                   Fair = Fair, weights_exp = NULL, weights_ref = NULL, 
                   cross.val = FALSE, na.rm = na.rm, 
                   sig_method.type = 'two.sided.approx', alpha = alpha,
                   ncores = ncores)
      skill_metrics$rpss <- rpss$rpss
      skill_metrics$rpss_significance <- rpss$sign
    }
  }
  skill_metrics <- lapply(skill_metrics, function(x) {drop(x)})
  skill_metrics <- lapply(skill_metrics, function(x){
                          InsertDim(x, pos = 1, len = 1, name = 'var')})
  
  statistics <- lapply(statistics, function(x) {drop(x)})
  statistics <- lapply(statistics, function(x){
    InsertDim(x, pos = 1, len = 1, name = 'var')})
  
  return(list(skill_metrics, statistics))
}
