###############################################################################
##################### SCORECARDS MODULE FOR SUNSET SUITE ######################
###############################################################################

##### Load source functions #####
# source('modules/Scorecards/R/tmp/LoadMetrics.R')
# source('modules/Scorecards/R/tmp/WeightedMetrics.R')

## Define function
Scorecards_calculations <- function(data, skill_metrics, statistics = NULL, recipe) {
  
  ## Parameters for saving output data files
  output.path <- paste0(recipe$Run$output_dir, "/plots/Scorecards/")
  dir.create(output.path, recursive = T, showWarnings = F)
  
  system <- recipe$Analysis$Datasets$System$name
  reference <- recipe$Analysis$Datasets$Reference$name
  var <- recipe$Analysis$Variables$name
  start.year <- as.numeric(recipe$Analysis$Time$hcst_start)
  end.year <- as.numeric(recipe$Analysis$Time$hcst_end)
  forecast.months <- recipe$Analysis$Time$ftime_min : recipe$Analysis$Time$ftime_max
  start.months <- substr(recipe$Analysis$Time$sdate, 1,2)
  period <- paste0(start.year, "-", end.year)
  
  file.name.metrics <- paste0('scorecards_aggr_skill_',system,'_',reference,'_',var,'_',period,'_s',start.months,'.RDS')
  file.name.sign <- paste0('scorecards_aggr_sign_',system,'_',reference,'_',var,'_',period,'_s',start.months,'.RDS')

  ## Parameters for data aggregation
  regions <- recipe$Analysis$Workflow$Scorecards$regions  
  for (i in names(regions)){regions[[i]] <- unlist(regions[[i]])}
  
  metric.aggregation <- recipe$Analysis$Workflow$Scorecards$metric_aggregation
  metrics <- unlist(strsplit(tolower(recipe$Analysis$Workflow$Scorecards$metric), ", | |,"))
  ncores <- recipe$Analysis$ncores
  
  if(is.null(recipe$Analysis$Workflow$Scorecards$signif_alpha)){
    alpha <- 0.05
  } else {
    alpha <- recipe$Analysis$Workflow$Scorecards$signif_alpha
  }
  
  if(is.null(recipe$Analysis$remove_NAs)){
    na.rm <- FALSE
  } else {
    na.rm <- recipe$Analysis$remove_NAs 
  }

  if (is.null(recipe$Analysis$Workflow$Scorecards$inf_to_na)){
    inf.to.na <- FALSE
  } else {
    inf.to.na <- recipe$Analysis$Workflow$Scorecards$inf_to_na
  }
  
  ##### TO DO: Need to include condition for removing -INF #####
  # if (inf_to_na) {
  #   by_reference[[reference]][by_reference[[reference]]==-Inf] <- NA
  # }
  
  
  ############################# SKILL AGGREGATION #############################
  if(metric.aggregation == 'skill'){
    
    # ## Load data files
    # loaded_metrics <- LoadMetrics(input_path = skill.input.path,
    #                               system = system,
    #                               reference = reference,
    #                               var = var,
    #                               metrics =  metrics,
    #                               period = period,
    #                               start_months = start.months,
    #                               calib_method = calib.method,
    #                               inf_to_na = inf.to.na
    # )
    
    # ## Remove -Inf from crpss data if variable is precipitation ## from loadMetrics function
    # if (inf_to_na) {
    #   by_reference[[reference]][by_reference[[reference]]==-Inf] <- NA
    # }
    
    ## Spatial Aggregation of metrics
    if('region' %in% names(dim(loaded_metrics[[1]][[1]]))){
      
      ### Convert loaded metrics to array for already aggregated data
      metrics.dim <- attributes(loaded_metrics)$metrics 
      forecast.months.dim <- forecast.months 
      start.months.dim <- attributes(loaded_metrics)$start_months 
      regions.dim <- regions 
      
      aggr_metrics <- array(dim = c(system = length(loaded_metrics),
                                          reference = length(loaded_metrics[[1]]),
                                          metric = length(metrics.dim), 
                                          time = length(forecast.months.dim), 
                                          sdate = length(start.months.dim), 
                                          region = length(regions.dim)))
      
      
      for (sys in 1:length(names(loaded_metrics))){
        for (ref in 1:length(names(loaded_metrics[[sys]]))){
          aggr_metrics[sys, ref, , , , ] <- s2dv::Reorder(data = loaded_metrics[[sys]][[ref]], order = c('metric','time','sdate','region'))
        }
      }
      
      ## Add attributes
      attributes(aggr_metrics)$metrics <- metrics.load
      attributes(aggr_metrics)$start.months <- attributes(loaded_metrics)$start_months
      attributes(aggr_metrics)$forecast.months <- forecast.months
      attributes(aggr_metrics)$regions <- regions
      attributes(aggr_metrics)$system.name <- names(loaded_metrics)
      attributes(aggr_metrics)$reference.name <- names(loaded_metrics[[1]])
      
      
    } else {
      ## Calculate weighted mean of spatial aggregation
      aggr_metrics <- WeightedMetrics(loaded_metrics,
                                            regions = regions,
                                            forecast.months = forecast.months,
                                            metric.aggregation = metric.aggregation,
                                            ncores = ncores)
    } ## close if on region
    aggr_significance <- NULL
    
  } ## close if on skill
  
  ############################# SCORE AGGREGATION #############################
  if(metric.aggregation == 'score'){
    
    lon_dim <- 'longitude'
    lat_dim <- 'latitude'
    time_dim <- 'syear'
    memb_dim <- 'ensemble'
    lon <- as.numeric(data$hcst$coords$longitude)
    lat <- as.numeric(data$hcst$coords$latitude)
    
    ## Define arrays to filled with data
    aggr_metrics <- array(data = NA, 
                                dim = c(time = length(forecast.months), 
                                        region = length(regions),
                                        metric = length(metrics)))
    
    aggr_significance <- array(data = NA, 
                                  dim = c(time = length(forecast.months), 
                                          region = length(regions),
                                          metric = length(metrics)))
    
    ## Spatially aggregate data for each metric
    for (met in metrics) {   
      
      if(met == 'rpss'){

        rps_syear <- sapply(X = 1:length(regions), 
                            FUN = function(X) {
                              WeightedMean(data = skill_metrics$rps_syear,
                                           region = regions[[X]],
                                           lon = lon, londim = lon_dim,
                                           lat = lat, latdim = lat_dim,
                                           na.rm = na.rm)
                            }, simplify = 'array')
        
        rps_clim_syear <- sapply(X = 1:length(regions), 
                                 FUN = function(X) {
                                   WeightedMean(data = skill_metrics$rps_clim_syear,
                                                region = regions[[X]],
                                                lon = lon, londim = lon_dim,
                                                lat = lat, latdim = lat_dim,
                                                na.rm = na.rm)
                                 }, simplify = 'array')
        
        ## Include name of region dimension
        names(dim(rps_syear))[length(dim(rps_syear))] <- 'region'
        names(dim(rps_clim_syear))[length(dim(rps_clim_syear))] <- 'region'
        
        ## Remove 'var' dimension
        rps_syear <-Subset(rps_syear, 'var', 1, drop = 'selected')
        rps_clim_syear <-Subset(rps_clim_syear, 'var', 1, drop = 'selected')
        
        ## Calculate significance
        sign_rpss <- RandomWalkTest(rps_syear, rps_clim_syear, 
                                    time_dim = time_dim, test.type = 'two.sided',
                                    alpha = alpha, pval = FALSE, sign = TRUE, 
                                    ncores = NULL)$sign
        
        ## Average over 'syear' dimension
        rps_syear <- Apply(data = rps_syear, 
                           target_dims = time_dim, 
                           fun = 'mean', ncores = ncores)$output1
        
        rps_clim_syear <- Apply(data = rps_clim_syear, 
                                target_dims = time_dim,
                                fun = 'mean',  ncores = ncores)$output1
        
        ## Calculate RPSS from aggregated RPS and RPS_clim
        rpss <- 1 - rps_syear / rps_clim_syear
        
        ## Save metric result in arrays
        aggr_metrics[ , ,which(metrics == met)] <- s2dv::Reorder(data = rpss, order = c('time', 'region'))
        aggr_significance[ , , which(metrics == met)] <- s2dv::Reorder(data = sign_rpss, order = c('time', 'region'))
        
      } ## close if on rpss
      
      if(met == 'crpss'){

        crps_syear <- sapply(X = 1:length(regions), 
                             FUN = function(X) {
                               WeightedMean(data = skill_metrics$crps_syear,
                                            region = regions[[X]],
                                            lon = lon, londim = lon_dim,
                                            lat = lat, latdim = lat_dim,
                                            na.rm = na.rm)
                             }, simplify = 'array')
        
        crps_clim_syear <- sapply(X = 1:length(regions), 
                                  FUN = function(X) {
                                    WeightedMean(data = skill_metrics$crps_clim_syear,
                                                 region = regions[[X]],
                                                 lon = lon, londim = lon_dim,
                                                 lat = lat, latdim = lat_dim,
                                                 na.rm = na.rm)
                                  }, simplify = 'array')
        
        ## Include name of region dimension
        names(dim(crps_syear))[length(dim(crps_syear))] <- 'region'
        names(dim(crps_clim_syear))[length(dim(crps_clim_syear))] <- 'region'
        
        ## Remove 'var' dimension
        crps_syear <-Subset(crps_syear, 'var', 1, drop = 'selected')
        crps_clim_syear <-Subset(crps_clim_syear, 'var', 1, drop = 'selected')
        
        ## Calculate significance
        sign_crpss <- RandomWalkTest(crps_syear, crps_clim_syear, 
                                     time_dim = time_dim, test.type = 'two.sided',
                                     alpha = alpha, pval = FALSE, sign = TRUE, 
                                     ncores = NULL)$sign
        
        ## Average over 'syear' dimension
        crps_syear <- Apply(data = crps_syear, 
                            target_dims = time_dim, 
                            fun = 'mean', ncores = ncores)$output1
        
        crps_clim_syear <- Apply(data = crps_clim_syear, 
                                 target_dims = time_dim,
                                 fun = 'mean', ncores = ncores)$output1
        
        ## Calculate CRPSS from aggregated CRPS and CRPS_clim
        crpss <- 1 - crps_syear / crps_clim_syear
        
        ## Save metric result in arrays
        aggr_metrics[ , , which(metrics == met)] <- s2dv::Reorder(data = crpss, order = c('time', 'region'))
        aggr_significance[ , , which(metrics == met)] <- s2dv::Reorder(data = sign_crpss, order = c('time', 'region'))
        
      } ## close if on crpss
      
      if(met == 'enscorr'){

        cov <- sapply(X = 1:length(regions), 
                      FUN = function(X) {
                        WeightedMean(data = statistics$cov,
                                     region = regions[[X]],
                                     lon = lon, londim = lon_dim,
                                     lat = lat, latdim = lat_dim,
                                     na.rm = na.rm)
                      }, simplify = 'array')
        
        std_hcst <- sapply(X = 1:length(regions), 
                           FUN = function(X) {
                             WeightedMean(data = statistics$std_hcst,
                                          region = regions[[X]],
                                          lon = lon, londim = lon_dim,
                                          lat = lat, latdim = lat_dim,
                                          na.rm = na.rm)
                           }, simplify = 'array')
        
        std_obs <- sapply(X = 1:length(regions), 
                          FUN = function(X) {
                            WeightedMean(data = statistics$std_obs,
                                         region = regions[[X]],
                                         lon = lon, londim = lon_dim,
                                         lat = lat, latdim = lat_dim,
                                         na.rm = na.rm)
                          }, simplify = 'array')
        
        n_eff <- sapply(X = 1:length(regions), 
                        FUN = function(X) {
                          WeightedMean(data = statistics$n_eff,
                                       region = regions[[X]],
                                       lon = lon, londim = lon_dim,
                                       lat = lat, latdim = lat_dim,
                                       na.rm = na.rm)
                        }, simplify = 'array')
        
        ## Include name of region dimension
        names(dim(cov))[length(dim(cov))] <- 'region'
        names(dim(std_hcst))[length(dim(std_hcst))] <- 'region'
        names(dim(std_obs))[length(dim(std_obs))] <- 'region'
        names(dim(n_eff))[length(dim(n_eff))] <- 'region'
        
        ## Remove 'var' dimension
        cov <- Subset(cov, 'var', 1, drop = 'selected')
        std_hcst <- Subset(std_hcst, 'var', 1, drop = 'selected')
        std_obs <- Subset(std_obs, 'var', 1, drop = 'selected')
        n_eff <- Subset(n_eff, 'var', 1, drop = 'selected')
        
        ## Calculate correlation
        enscorr <- cov / (std_hcst * std_obs)
        
        ## Calculate significance of corr
        t_alpha2_n2 <- qt(p = alpha/2, df = n_eff-2, lower.tail = FALSE)
        t <- abs(enscorr) * sqrt(n_eff-2) / sqrt(1-enscorr^2)
        
        sign_corr<- array(data = NA, 
                          dim = c(time = length(forecast.months), 
                                  region = length(regions)))
        
        for (time in 1:dim(sign_corr)[['time']]){
            for (reg in 1:dim(sign_corr)[['region']]){
              
              if (anyNA(c(t[time, reg], t_alpha2_n2[time, reg])) == FALSE 
                  && t[time, reg] >= t_alpha2_n2[time, reg]){
                sign_corr[time, reg] <- TRUE
              } else {
                sign_corr[time, reg] <- FALSE
              }
          }
        }  
        
        ## Save metric result in arrays
        aggr_metrics[ , , which(metrics == met)] <- s2dv::Reorder(data = enscorr, order = c('time', 'region'))
        aggr_significance[ , , which(metrics == met)] <- s2dv::Reorder(data = sign_corr, order = c('time', 'region'))
        
      } ## close if on enscorr
      
      if(met == 'mean_bias'){
        
        ## Calculate ensemble mean
        hcst_data_ens <- MeanDims(data$hcst$data, dims = 'ensemble')
        obs_data_ens <- MeanDims(data$obs$data, dims = 'ensemble')
        
        ## Aggregate data over regions
        hcst_data_aggr <- sapply(X = 1:length(regions), 
                                 FUN = function(X) {
                                   WeightedMean(data = hcst_data_ens,
                                                region = regions[[X]],
                                                lon = lon, londim = lon_dim,
                                                lat = lat, latdim = lat_dim,
                                                na.rm = na.rm)
                                 }, simplify = 'array')

        obs_data_aggr <- sapply(X = 1:length(regions), 
                                FUN = function(X) {
                                  WeightedMean(data = obs_data_ens,
                                               region = regions[[X]],
                                               lon = lon, londim = lon_dim,
                                               lat = lat, latdim = lat_dim,
                                               na.rm = na.rm)
                                }, simplify = 'array')
        
        ## Include name of region dimension
        names(dim(hcst_data_aggr))[length(dim(hcst_data_aggr))] <- 'region'
        names(dim(obs_data_aggr))[length(dim(obs_data_aggr))] <- 'region'
        
        ## Remove unnecessary dimension
        hcst_data_aggr <- Subset(hcst_data_aggr, c('dat','var', 'sday','sweek'), list(1,1,1,1) , drop = 'selected')
        obs_data_aggr <- Subset(obs_data_aggr, c('dat','var', 'sday','sweek'), list(1,1,1,1) , drop = 'selected')
        
        ## Calculate significance
        pval_mean_bias <- Apply(data = list(x = hcst_data_aggr, y = obs_data_aggr),
                                target_dims = c('syear'), ncores = ncores,
                                fun = function(x,y){t.test(as.vector(x),as.vector(y))})$p.value
        
        sign_mean_bias <- pval_mean_bias <= alpha
        
        ## Calculate aggregated mean bias metric
        mean_bias <- sapply(X = 1:length(regions), 
                            FUN = function(X) {
                              WeightedMean(data = skill_metrics$mean_bias,
                                           region = regions[[X]],
                                           lon = lon, londim = lon_dim,
                                           lat = lat, latdim = lat_dim,
                                           na.rm = na.rm)
                            }, simplify = 'array')
        
        ## Include name of region dimension
        names(dim(mean_bias))[length(dim(mean_bias))] <- 'region'
        
        ## Remove 'var' dimension
        mean_bias <- Subset(mean_bias, 'var', 1, drop = 'selected')
        
        ## Save metric result in array
        aggr_metrics[ , , which(metrics == met)] <- s2dv::Reorder(data = mean_bias, order = c('time', 'region'))
        aggr_significance[ , , which(metrics == met)] <- s2dv::Reorder(data = sign_mean_bias, order = c('time', 'region'))
        
      } ## close on mean_bias
      
      if(met == 'enssprerr'){

        ## Calculate metric
        spread <- sapply(X = 1:length(regions), 
                         FUN = function(X) {
                           WeightedMean(data = statistics$spread,
                                        region = regions[[X]],
                                        lon = lon, londim = lon_dim,
                                        lat = lat, latdim = lat_dim,
                                        na.rm = na.rm)
                         }, simplify = 'array')       
        
        error <- sapply(X = 1:length(regions), 
                        FUN = function(X) {
                          WeightedMean(data = skill_metrics$rms,
                                       region = regions[[X]],
                                       lon = lon, londim = lon_dim,
                                       lat = lat, latdim = lat_dim,
                                       na.rm = na.rm)
                        }, simplify = 'array')   
        
        ## Include name of region dimension
        names(dim(spread))[length(dim(spread))] <- 'region'
        names(dim(error))[length(dim(error))] <- 'region'
        
        ## Remove 'var' dimension
        spread <- Subset(spread, 'var', 1, drop = 'selected')
        error <- Subset(error, 'var', 1, drop = 'selected')
        
        enssprerr <- spread / error

        # ## Significance calculation
        # 
        # # Effective sample size
        # # exp <- data$hcst$data
        # # ens_exp <- MeanDims(data$hcst$data, dims = 'ensemble')
        # # enospr <- sum(Eno(exp - InsertDim(ens_exp, length(dim(exp)), dim(exp)['ensemble']), "ensemble"))
        # # enodif <- .Eno(ens_exp - ens_obs, na.action = na.pass)
        # 
        # # Removing eno at the moment
        # # F <- (enospr * spread^2 / (enospr - 1)) / (enodif * error^2 / (enodif - 1))
        # F <- spread^2 / error^2
        # # if (!is.na(F) & !is.na(enospr) & !is.na(enodif) & any(enospr > 2) & enodif > 2) {
        #   # p.val <- pf(F, enospr - 1, enodif - 1)
        # 
        #   pval_enssprerr <- Apply(data = list(x = F, y = data$hcst$data),  ### DOES NOT WORK
        #                           target_dims = c('time'),
        #                           fun = function(x, y)
        #                             {pf(x, dim(y)['syear'] -1 ,dim(y)['syear'] -1)})
        # 
        #   pval_enssprerr <- pf(F,dim(data$hcst$data)['syear'] -1 ,dim(data$hcst$data)['syear'] -1)
        #   pval_enssprerr <- 2 * min(pval_enssprerr, 1 - pval_enssprerr)
        # 
        # sign_enssprerr <- pval_enssprerr <= alpha

        ## Save metric result in array
        aggr_metrics[ , , which(metrics == met)] <- s2dv::Reorder(data = enssprerr, order = c('time', 'region'))
        # aggr_significance[ , , which(metrics == met)] <- s2dv::Reorder(data = sign_corr, order = c('time', 'region'))
        
      } ## close on enssprerr
      
    } ## close loop on metric
    
    ## Set NAs to False 
    aggr_significance[is.na(aggr_significance)] <- FALSE
    
  } ## close if on score   
  
  ## Include 'var' dimension to be able to save array
  if(!'var' %in% names(dim(aggr_metrics))){
    aggr_metrics <- InsertDim(aggr_metrics, 1, 1, name = 'var')
    aggr_significance <- InsertDim(aggr_significance, 1, 1, name = 'var')
  }
  
  ## Include attributes
  attributes(aggr_metrics)$metrics <- metrics
  attributes(aggr_metrics)$forecast.months <- forecast.months
  attributes(aggr_metrics)$regions <- regions
  attributes(aggr_metrics)$system.name <- system
  attributes(aggr_metrics)$reference.name <- reference
  
  aggr_scorecards <- list(aggr_metrics = aggr_metrics, aggr_significance = aggr_significance)
  
  ## Save metric data arrays
  recipe$Run$output_dir <- paste0(recipe$Run$output_dir,
                                  "/outputs/Scorecards/")
  
  save_metrics(recipe = recipe, metrics = aggr_scorecards,
               data_cube = data$hcst, agg = 'region',
               module = "scorecard")
 }

