# 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
multimodel_metrics <- function(recipe,
                               datos = NULL,
                               probs = 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(datos$hcst[[1]]$data)['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
  }

  requested_metrics <- strsplit(recipe$Analysis$Workflow$Skill$metric,
                                ", | |,")[[1]]
  skill_metrics <- list()
  if (!is.null(datos)) {
    # conver $data elements to list to use multiApply:
    datos <- append(list(obs = datos$obs$data),
                         lapply(datos$hcst, function(x) x$data))
    ## CRPS metrics only make sense in pool method:
    if (any(c('crps', 'crpss') %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')
                      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')
                           s2dv:::.CRPS(exp = ref, obs = obs, dat_dim = NULL,
                           time_dim = 'syear', memb_dim = 'ensemble')},
                         ncores = ncores)$output1
      skill_metrics$crps_clim <- crps_clim


      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'),
                         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 ('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
    }
    if (any(c('std', 'standard_deviation') %in% requested_metrics)) {
      # This are used to compute correlation for the scorecards
      # It's the temporal standard deviation of the ensmean
      std_hcst <- Apply(datos[-1], target_dims = c('syear', 'ensemble'),
                        function(...) {
                          res <- abind(..., along = 2)
                          names(dim(res)) <- c('syear', 'ensemble')
                          res <- MeanDims(res, 'ensemble')
                          sd(as.vector(res))},
                        ncores = ncores)$output1
      
      std_obs <- Apply(datos[1], target_dims = c('syear', 'ensemble'), 
                       fun = 'sd')$output1
      skill_metrics[['std_hcst']] <- std_hcst
      skill_metrics[['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
      skill_metrics[['var_hcst']] <- var_hcst
      skill_metrics[['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)
      skill_metrics[['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
      skill_metrics$covariance <- covariance
    }
  }
  # Probabilistic metrics for categories
  categories <- recipe$Analysis$Workflow$Probabilities$percentiles
  categories <- lapply(categories, function (x) { 
                       sapply(x, function(y) {
                              eval(parse(text = y))})})
  # For the pool method:
  if (is.null(probs)) {
    # calculate probs from the ensemble distribution
    # Firs compure tercile limits in crossval
    lims <- list()
    syears_ind <- list(t = tmp)
    lims$hcst <- Apply(append(syears_ind, datos[-1]),
                       target_dims = append(list(NULL),
                         lapply(1:length(datos[-1]),
                                function(x){c('syear', 'ensemble')})),
                       fun = function(t, ..., crossin, prob_lims) {
                         res <- abind(..., along = 2)
                         names(dim(res)) <- c('syear', 'ensemble')
                         res <- Subset(res, along = 'syear',
                         indices = crossin[[t]]$train.dexes, drop =T)
                         lapply(prob_lims, function(ps) {
                                limits <- quantile(as.vector(res), 
                                                   ps, na.rm = na.rm)
                                limits <- array(limits, c(cat = length(limits)))
                         })
                       }, prob_lims = categories,
                        crossin = cross, ncores = ncores)
    lims$obs <- Apply(append(syears_ind, datos[1]),
                      target_dims = list(NULL, c('syear', 'ensemble')),
                      fun = function(t, obs, crossin, prob_lims) {
                        res <- Subset(obs, along = 'syear',
                            indices = crossin[[t]]$train.dexes, drop =T)
                        lapply(prob_lims, function(ps) {
                               limits <- quantile(as.vector(res), 
                                                  ps, na.rm = na.rm)
                               limits <- array(limits, c(cat = length(limits)))
                        })
                      }, prob_lims = categories,
                      crossin = cross, ncores = ncores)
    probs <- list()
    probs$hcst <- list()
    probs$fcst <- list()
    probs$obs <- list()
    for (ps in 1:length(categories)) {
      lim <- lims$hcst[ps]
      probs$hcst <- append(probs$hcst,
                    list(Apply(append(lim, datos[-1]),
                          target_dims = append(list(c('syear', 'cat')), 
                                        lapply(1:length(datos[-1]),
                                     function(x){c('syear', 'ensemble')})),
                          fun = function(lim, ...) {
                            res <- abind(..., along = 2)
                            names(dim(res)) <- c('syear', 'ensemble')
                            GetProbs(data = res, time_dim = 'syear', 
                                     memb_dim = 'ensemble',
                                     indices_for_quantiles = NULL, 
                                     prob_thresholds = NULL,
                                     abs_thresholds = lim,
                                     bin_dim_abs = 'cat',
                                     weights = NULL, cross.val = FALSE)},
                          ncores = ncores)$output1))
      lim <- lims$obs[ps]
      probs$obs <- append(probs$obs,
                    list(Apply(append(lim, datos[1]),
                          target_dims = list(c('syear', 'cat'),
                                        c('syear', 'ensemble')),
                          fun = function(lim, obs) {
                            GetProbs(data = obs, time_dim = 'syear',
                                     memb_dim = 'ensemble',
                                     indices_for_quantiles = NULL,
                                     prob_thresholds = NULL,
                                     abs_thresholds = lim,
                                     bin_dim_abs = 'cat',
                                     weights = NULL, cross.val = FALSE)},
                          ncores = ncores)$output1))

      if (!is.null(datos$fcst)) {
      ## NEEDS TO COMPUTE LIMS FOR THE FULL HINDCAST PERIOD
        lims$fcst[ps] <- Apply(datos[-1],
                       target_dims = c('syear', 'ensemble'),
                       fun = function(..., prob_lims) {
                         res <- abind(..., along = 2)
                         names(dim(res)) <- c('syear', 'ensemble')
                         lapply(prob_lims, function(ps) {
                                limits <- quantile(as.vector(res),
                                                   ps, na.rm = na.rm)
                                limits <- array(limits, c(cat = length(limits)))
                         })
                       }, prob_lims = categories,
                       ncores = ncores)

        probs$fcst <- append(probs$fcst,
                    list(Apply(append(lims$fcst[ps], datos[-1]),
                          target_dims = append(list('cat'),
                                        lapply(1:length(datos[-1]),
                                     function(x){c('syear', 'ensemble')})),
                          fun = function(lim, ...) {
                            res <- abind(..., along = 2)
                            names(dim(res)) <- c('syear', 'ensemble')
                            GetProbs(data = res, time_dim = 'syear',
                                     memb_dim = 'ensemble',
                                     indices_for_quantiles = NULL,
                                     prob_thresholds = NULL,
                                     abs_thresholds = lim,
                                     bin_dim_abs = 'cat',
                                     weights = NULL, cross.val = FALSE)},
                          ncores = ncores)$output1))
      }
    }
    # At this point all method can have probs calculated
  }              
  # 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 = probs$hcst[[ps]],
                 obs = probs$obs[[ps]], memb_dim = NULL,
                 cat_dim = 'cat', cross.val = FALSE, time_dim = 'syear',
       	         Fair = Fair, nmemb = nmemb,
                 ncores = ncores)
      rps_clim <- Apply(list(probs$obs[[ps]]),
                        target_dims = c('cat', 'syear'),
                        RPS_clim, bin_dim_abs = 'cat', 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 ('rpss' %in% requested_metrics) {
      rpss <- RPSS(exp = probs$hcst[[ps]],
                   obs = probs$obs[[ps]],
                   ref = NULL, # ref is 1/3 by default if terciles
                   time_dim = 'syear', memb_dim = NULL,
                   cat_dim = 'cat', 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
    }
  }
  return(skill_metrics)
}
