#' Scorecards load metrics from verification suite
#' 
#'@description Scorecards function to load saved data files 
#'
#'@param system A vector of character strings defining the names of the 
#'  system names following the archive.yml format from verification suite. 
#'  Accepted system names: 'ECMWF-SEAS5', 'DWD-GFCS2.1', 'CMCC-SPS3.5',
#'  'ecmwfs5','Meteo-France-System 7', 'UK-MetOffice-GloSea600', 'NCEP-CFSv2'.
#'@param reference A vector of character strings defining the names of 
#'  the references following the archive.yml format from verification suite 
#'  Pending to be test with more than one. The accepted names are: 'era5'.
#'@param var A character string following the format from 
#'  variable-dictionary.yml from verification suite (TO DO: multiple variables). 
#'  The accepted names are: 'psl', 'tas', 'sfcWind', 'prlr'.
#'@param period A character string indicating the start and end years of the 
#'  reference period (e.g. '1993-203')
#'@param start_months A vector indicating the numbers of the start months
#'@param input_path A character string indicating the path where metrics output 
#'  files from verification suite are saved (or any other compatible files)
#'
#'@return A is a list by system and reference containing an array of with 
#'   the following dimensions: longitude, latitude, forecast months, metrics, 
#'   start dates.

#'@examples
#'\dontrun{
#'loaded_metrics <- LoadMetrics(system = c('ECMWF-SEAS5','DWD-GFCS2.1'),
#'                              reference. = 'ERA5',
#'                              var = 'tas',
#'                              period = '1993-2016'
#'                              metrics =  c('mean_bias', 'enscorr', 'rpss', 'crpss', 'enssprerr'),
#'                              start_months = sprintf("%02d", 1:12),
#'                              calib_method = 'raw',                              
#'                              input_path = '/esarchive/scratch/nmilders/scorecards_data/input_data')
#'}
#'@import easyNCDF
#'@import multiApply
#'@export 

LoadMetrics <- function(input_path, system, reference, var, period,
                        metrics, start_months, calib_method = NULL,
                        inf_to_na = FALSE) {
  
  # Initial checks
  ## system
  if (!is.character(system)) {
    stop("Parameter 'system' must be a character vector with the system names.")
  }
  ## reference
  if (!is.character(reference)) {
    stop("Parameter 'reference' must be a character vector with the reference ",
         "names.")
  }
  ## var
  if (!is.character(var)) {
    stop("Parameter 'var' must be a character vector with the var ",
         "names.")
  }
  if (length(var) > 1) {
    warning("Parameter 'var' must be of length one. Only the first value ",
            "will be used.")
    var <- var[1]
  }
  ## metrics
  if (!is.character(metrics)) {
    stop("Parameter 'metrics' cannot be NULL.")
  }
  ## start_months
  if (is.character(start_months)) {
    warning("Parameter 'start_months' must be a numeric vector indicating ",
            "the starting months.")
    start_months <- as.numeric(start_months)
  }
  if (!is.numeric(start_months)) {
    stop("Parameter 'start_months' must be a numeric vector indicating ",
         "the starting months.")
  }
  start_months <- sprintf("%02d", start_months)
  ## Check if sdates are continuous or discrete
  if (all(diff(as.numeric(start_months)) == 1)) {
    consecutive_start_months <- TRUE
  } else {
    consecutive_start_months <- FALSE
  }
  ## input_path 
  if (!is.character(input_path)) {
    stop("Parameter 'input_path must be a character string.")
  }
  if (length(input_path) > 1) {
    input_path <- input_path[1]
    warning("Parameter 'input_path' has length greater than 1 and only the ",
            "first element will be used.")
  }
  
  ## Remove . from names
  system <- gsub('.','', system, fixed = T)
  reference <- gsub('.','', reference, fixed = T)
  
  all_metrics <- sapply(system, function(x) NULL)
  names(all_metrics) <- system
  ## Load data for each system
  for (sys in 1:length(system)) {
    ## Define empty list to saved data
    by_reference <- sapply(reference, function(x) NULL)
    names(by_reference) <- reference
    ## Load data for each reference
    for (ref in 1:length(reference)) {
      ## Call function to load metrics data
      met_by_smonth <- NULL
      for (met in metrics) {
        result <- .loadmetrics(input_path = input_path,
                               system = system[sys],
                               reference = reference[ref],
                               var = var,
                               period = period,
                               start_months = start_months,
                               calib_method = calib_method,
                               metric = met)
        
        result_attr <- attributes(result)
        met_by_smonth <- abind::abind(met_by_smonth, result, along = length(dim(result)) + 1)
      }
      attributes(met_by_smonth) <- result_attr[-1]
      # names(dim(met_by_smonth)) <- c(names(result_attr$dim), 'metric')
      
      dim(met_by_smonth) <- c(dim(result), metric = length(metrics))
      ## Save metric data as array in reference list
      by_reference[[reference[ref]]] <- met_by_smonth
      ## Remove -Inf from crpss data if variable is precipitation
      if (inf_to_na) {
        by_reference[[reference]][by_reference[[reference]]==-Inf] <- NA
      }
    } ## close loop on reference
    ## Save reference data in list of system
    all_metrics[[system[sys]]] <- by_reference
  } ## close loop on system
  
  attributes(all_metrics)$metrics <- metrics
  attributes(all_metrics)$start_months <- start_months
  
  return(all_metrics)
} ## close function

###########################################################

.loadmetrics <- function(input_path, system, reference,
                         var, period, start_months, 
                         calib_method, metric) {
  
  ## Load data for each start date
  allfiles <- sapply(start_months, function(m) {
    paste0(input_path, "/", system, "/", reference, "/", calib_method, "/",
           var, "/scorecards_", system, "_", reference, "_",
           var, "_", metric, "_", period, "_s", m, # mod.pressure,
           ".nc")})
  allfiles_exist <- sapply(allfiles, file.exists)

  # Check dims
  files_exist_by_month <- seq(1:length(allfiles))[allfiles_exist]
  allfiledims <- sapply(allfiles[allfiles_exist], easyNCDF::NcReadDims)
  if (length(files_exist_by_month) == 0) {
    stop("No files are found.")
  }
  
  num_dims <- numeric(dim(allfiledims)[1])
  for (i in 1:dim(allfiledims)[1]) {
    if (length(unique(allfiledims[i,])) > 1) {
      warning(paste0("Dimensions of system ", system," with var ", var,
                     " don't match."))
    }
    num_dims[i] <- max(allfiledims[i,]) # We take the largest dimension
  }
  # dims: [metric, longitude, latitude, time, smonth]
  # or [metric, region, time, smonth] 
  
  # Loop for file
  dim(allfiles) <- c(dat = 1, sdate = length(allfiles))
  
  array_met_by_sdate <- Apply(data = allfiles, target_dims = 'dat', fun = function(x) {
    if (file.exists(x)) {
      res <- easyNCDF::NcToArray(x, vars_to_read = metric, unlist = T,
                                 drop_var_dim = T)
      names(dim(res)) <- NULL
    } else {
      res <- array(dim = c(length(metrics), allfiledims[-1,1]))
      names(dim(res)) <- NULL
    }
    res})$output1
  
  dim(array_met_by_sdate) <- c(allfiledims[-1,1],
                               sdate = length(allfiles))
  # Attributes
  # Read attributes from the first existing file
  if ("region" %in% rownames(allfiledims)) {
    file_for_att <- ncdf4::nc_open(allfiles[allfiles_exist[1]])
    region <- ncdf4::ncatt_get(file_for_att, 'region')
    ncdf4::nc_close(file_for_att)
    attributes(array_met_by_sdate)$region <- region
  } else {
    lon <- easyNCDF::NcToArray(allfiles[allfiles_exist][1], vars_to_read = 'longitude',
                               unlist = T, drop_var_dim = T)
    lat <- easyNCDF::NcToArray(allfiles[allfiles_exist][1], vars_to_read = 'latitude',
                               unlist = T, drop_var_dim = T)
    attributes(array_met_by_sdate)$lon <- lon
    attributes(array_met_by_sdate)$lat <- lat
  }

  return(array_met_by_sdate)
}

  
