#' @rdname CST_PDFIndexFcst
#' @title Computing the Index PDFs for a forecast year of a SFSs dataset
#' of a CSTools object.
#' @author Eroteida Sanchez-Garcia - AEMET, \email{esanchezg@aemet.es}
#' @description This function implements the computation to obtain the index PDFs
#' (e.g. NAO index) to improve the index estimate from the forecast of SFSs
#' and accepts a CSTools object (an object of the class 's2dv_cube') as input.
#' @references Regionally improved seasonal forecast of precipitation through
#' Best estimation of winter NAO, Sanchez-Garcia, E. et al.,
#' Adv. Sci. Res., 16, 165174, 2019, https://doi.org/10.5194/asr-16-165-2019
#' @param index_hind An object of the class 's2dv_cube'
#' containing the indices or drivers of climate variability (as e.g.,
#' the North Atlantic Oscillation (NAO)) estimate for a hindcast period
#' from SFSs for improving.
#' The index_hind object is expected to have an element named \code{$data}
#' with dimensions (time, dataset, member, season) or 
#' (time, dataset, member=1, statistic=2, season). The dimensions 'time' must 
#' be greater than 2. When dimension 'statistic' doesn't exist, the dimension 
#' 'member' must be greater than 1.
#' @param index_obs An object of the class 's2dv_cube'
#' containing the indices or drivers of climate variability (as e.g.,
#' the North Atlantic Oscillation (NAO)) estimate from observations or
#' reanalysis.
#' The index_obs object is expected to have an element named \code{$data}
#' with dimensions (time, dataset, member = 1, season). The dimensions 'time' 
#' must be greater than 2.
#' @param index_fcst An object of the class 's2dv_cube'
#' containing the indices or drivers of climate variability (as e.g.,
#' the North Atlantic Oscillation (NAO)) estimate for a forecast year
#' from SFSs for improving.
#' The index_fcst object is expected to have an element named \code{$data}
#' with dimensions (time = 1, dataset, member, season) or 
#' (time = 1, dataset, member = 1, statistic = 2, season). When dimension 
#' 'statistic' doesn't exist, the dimension 'member' must be greater than 1.
#' @param type_exp A character string ('ens' or 'sta') to identify if the 
#' experiment output is an ensemble members or statistics.
#' @param method A character string indicating which methodology is applied
#' to compute the PDFs. One of "ME" (default) or "LMEV".
#' @param na.rm Logical (default = FALSE). Should missing values be removed?
#' @return CST_PDFIndexFcst() returns a CSTools object (i.e., of the
#' class 's2dv_cube').
#' This object has at least two elements: i) an element named \code{$data}
#' with dimensions (time = 1, dataset, statistic = 4, season) and ii) an element
#' named \code{$statistic} with the names of 'statistic' dimension
#' of the first element ("mean_notbc", "sigma_notbc", "mean_bc", "sigma_bc")
#' The firt statistic is the parameter 'mean' of the PDF with not bias corrected
#' The second statistic is the parameter 'standard deviation' of the PDF
#' with not bias corrected
#' The third statistic is the parameter 'mean' of the PDF with bias corrected
#' The fourth statistic is the parameter 'standard deviation' of the PDF
#' with bias corrected
#' @export
#' @examples
#' index_hind <- 1 : (5 * 3 * 7 * 4)
#' dim(index_hind) <- c(time = 5, dataset = 3, member = 7, season = 4)
#' index_hind <- list(data = index_hind)
#' class(index_hind) <- 's2dv_cube'
#' index_obs <- 1 : (5 * 3 * 4)
#' dim(index_obs) <- c(time = 5, dataset = 3, member = 1, season = 4)
#' index_obs <- list(data = index_obs)
#' class(index_obs) <- 's2dv_cube'
#' index_fcst <- 1 : (3 * 7 * 4)
#' dim(index_fcst) <- c(time = 1, dataset = 3, member = 7, season = 4)
#' index_fcst <- list(data = index_fcst)
#' class(index_fcst) <- 's2dv_cube'
#' res_CST <- CST_PDFIndexFcst(index_hind, index_obs, index_fcst, method = 'LMEV')
#' dim(res_CST$data)
#' #time   dataset statistic    season
#' # 1         3         4         4
CST_PDFIndexFcst <- function(index_hind, index_obs, index_fcst, 
                             type_exp = 'ens', method = 'ME', na.rm = FALSE) {
  if (!inherits(index_hind, 's2dv_cube') ||
      !inherits(index_obs, 's2dv_cube') ||
      !inherits(index_fcst, 's2dv_cube')) {
    stop("Parameter 'index_fcst', 'index_hind' ",
         "and 'index_obs' must be of the class 's2dv_cube', ",
         "as output by CSTools::CST_Load.")
  }
  if(!(method %in% c('ME', 'LMEV'))){
    stop("The parameter 'method' must be equal to 'ME' or 'LMEV'")
  }
  if (!is.logical(na.rm)) {
    stop("The parameter 'na.rm' must be a logical value.")
  }
  if(!(type_exp %in% c('ens', 'sta'))){
    stop("The parameter 'type_exp' must be equal to 'ens' or 'sta'")
  }
  if (is.null(names(dim(index_hind$data))) 
      || is.null(names(dim(index_obs$data)))
      || is.null(names(dim(index_fcst$data)))) {
    stop("Element 'data' from parameters 'index_hind', 'index_obs' and 'index_fcst'",
         " should have dimmension names.")
  }
  if((length(names(dim(index_hind$data))) != length(names(dim(index_fcst$data)))) 
     || (!all(names(dim(index_hind$data)) == names(dim(index_fcst$data))))){
    stop("The dimension names of the component 'data' of the parameter 'index_hind' ",
         "and 'index_fcst' must be equals.")
  }
  if(length(dim(index_hind$data)) == 4 ){
    if (!all(names(dim(index_hind$data)) == c('time', 'dataset', 'member', 'season'))){ 
      stop("Wrong dimensions of the component 'data' of parameter 'index_hind'")
    } 
  } else if (length(dim(index_hind$data)) == 5 ){
    if (!all(names(dim(index_hind$data)) == c('time', 'dataset', 'member', 'statistic', 'season'))){ 
      stop("Wrong dimensions of the component 'data' of parameter 'index_hind'")
    }
  } else {
    stop("Wrong dimensions of the component 'data' of parameter 'index_hind'")
  }
  if(length(dim(index_obs$data)) != 4){
    stop("Wrong dimensions of the component 'data' of parameter 'index_obs'")
  }else if (!all(names(dim(index_obs$data)) == c('time', 'dataset', 'member', 'season'))) {
    stop("Wrong dimensions of the component 'data' of parameter 'index_obs'")
  }
  if(length(dim(index_fcst$data)) == 4 ){
    if (!all(names(dim(index_fcst$data)) == c('time', 'dataset', 'member', 'season'))){ 
      stop("Wrong dimensions of the component 'data' of parameter 'index_fcst'")
    } 
  } else if (length(dim(index_fcst$data)) == 5 ){
    if (!all(names(dim(index_fcst$data)) == c('time', 'dataset', 'member', 'statistic', 'season'))){ 
      stop("Wrong dimensions of the component 'data' of parameter 'index_fcst'")
    }
  } else {
    stop("Wrong dimensions of the component 'data' of parameter 'index_fcst'")
  }
  if (dim(index_hind$data)['time'] != dim(index_obs$data)['time']) {
    stop("The length of the dimensions 'time' in the component 'data' ",
         "of the parameter 'index_obs' and 'index_hind' must be equals.")
  }
  if ((dim(index_hind$data)['dataset'] != dim(index_obs$data)['dataset'])
      | (dim(index_hind$data)['dataset'] != dim(index_fcst$data)['dataset'])) {
    stop("The length of the dimensions 'dataset' in the component 'data' ",
         "of the parameter 'index_hind', 'index_obs' and 'index_fcst' must be ",
         "equals.")
  }
  if ((dim(index_hind$data)['season'] != dim(index_obs$data)['season'])
      | (dim(index_hind$data)['season'] != dim(index_fcst$data)['season'])) {
    stop("The length of the dimensions 'season' in the component 'data' ",
         "of the parameter 'index_hind', 'index_obs' and 'index_fcst' must be ",
         "equals.")
  }
  if (dim(index_obs$data)['time'] <= 2) {
    stop("The length of the dimension 'time' in the component 'data' ",
         "of the parameter 'index_obs' and 'index_hind' must be greater than 2.")
  }
  if (dim(index_fcst$data)['time'] != 1) {
    stop("The length of the dimension 'time' in the component 'data' ",
         "of the parameter 'index_fcst' must be equal to 1.")
  }
  if (dim(index_hind$data)['member'] == 1 &
      dim(index_hind$data)['statistic'] != 2){
    stop("The dimension 'statistic' must be equal to 2 in the component 'data' ",
         "of the parameter 'index_hind' and 'index_fcst' if the length of the ",
         "dimension 'member' is equal to 1")
  }
  if (dim(index_obs$data)['member'] != 1){
    stop("The dimension 'member' must be equal to 1 in the component 'data' ",
         "of the parameter 'index_obs'.")
  }
  if (any(names(dim(index_fcst$data)) == 'statistic') & type_exp != 'sta'){
    stop("The parameter 'type_exp' must be equal to 'sta' because the ",
         "dimension 'statistic' in the component 'data' of the ",
         "parameter 'index_fcst' exits")
  }
  if (!any(names(dim(index_fcst$data)) == 'statistic') & type_exp == 'sta'){
    stop("The parameter 'type_exp' can't be equal to 'sta' because the ",
         "dimension 'statistic' in the component 'data' of the ",
         "parameter 'index_fcst' doesn't exit.")
  }
  
  PDFstatistics <- PDFIndexFcst(index_hind$data, index_obs$data,
                                index_fcst$data, type_exp = type_exp, 
                                method = method, na.rm = na.rm)
  
  if (dim(index_fcst$data)['member'] == 1) {
    Dim <- dim(index_fcst$data)
    dim(index_fcst$data) <- Dim[-which(names(Dim) == 'member')]
  }
  if (dim(index_hind$data)['member'] == 1) {
    Dim <- dim(index_hind$data)
    dim(index_hind$data) <- Dim[-which(names(Dim) == 'member')]
  }
  
  dimnames <- names(dim(index_fcst$data))
  if (any(names(dim(index_fcst$data)) == 'member')){
    dimnames[dimnames == 'member'] <- 'statistic'
  }
  
  pos <- match(dimnames, names(dim(PDFstatistics)))
  PDFstatistics <- aperm(PDFstatistics, pos)
  names(dim(PDFstatistics)) <- dimnames
  index_fcst$data <- PDFstatistics
  index_fcst$Datasets <- c(index_hind$Datasets, index_obs$Datasets, index_fcst$Datasets)
  index_fcst$source_files <- c(index_hind$source_files, index_obs$source_files,
                               index_fcst$source_files)
  index_fcst$statistic <- c("mean_notbc","sigma_notbc","mean_bc","sigma_bc")
  return(index_fcst)
}

#' @rdname PDFIndexFcst
#' @title Computing the Index PDFs for a dataset of SFSs for a forecast year.
#' @author Eroteida Sanchez-Garcia - AEMET, \email{esanchezg@aemet.es}
#' @description This function implements the computation to obtain the index PDFs
#' (e.g. NAO index) to improve the index estimate from a dataset of SFSs
#' @references Regionally improved seasonal forecast of precipitation through Best
#' estimation of winter NAO, Sanchez-Garcia, E. et al.,
#' Adv. Sci. Res., 16, 165174, 2019, https://doi.org/10.5194/asr-16-165-2019
#' @param index_hind Index (e.g. NAO index) array from SFSs with dimensions
#' (time, dataset, member, season) or 
#' (time, dataset, member=1, statistic=2, season) for a hindcast period.
#' The dimensions 'time' must be greater than 2. When dimension 'statistic' 
#' doesn't exist, the dimension member' must be greater than 1. 
#' @param index_obs Index (e.g. NAO index) array from an observational database
#' or reanalysis with dimension (time, dataset, member = 1, season). 
#' The dimensions 'time' must be greater than 2.
#' @param index_fcst Index (e.g. NAO index) array from SFSs.
#' with dimensions (time = 1, dataset, member) for a forecast year.
#' @param type_exp A character string ('ens' or 'sta') to identify if the 
#' experiment output is an ensemble members or statistics.
#' @param method A character string indicating which methodology is applied
#' to compute the PDF. One of "ME" (default) or "LMEV".
#' @param na.rm Logical (default = FALSE). Should missing values be removed?
#' @return PDFIndexFcst() returns an array with dimensions 
#' (time = 1, dataset, member, season) or 
#' (time = 1, dataset, member = 1, statistic = 2, season) for the forecast year.
#' When dimension statistic' doesn't exist, the dimension 'member' must be 
#' greater than 1.
#' The firt statistic is the parameter 'mean' of the PDF with not bias corrected
#' The second statistic is the parameter 'standard deviation' of the PDF
#' with not bias corrected
#' The third statistic is the parameter 'mean' of the PDF with bias corrected
#' The fourth statistic is the parameter 'standard deviation' of the PDF
#' with bias corrected
#' @import multiApply
#' @export
#' @examples
#' # Example for the PDFIndexFcst function
#' index_fcst <- 1 : (3 * 4)
#' dim(index_fcst) <- c(time = 1, dataset = 3, member = 4, season = 1)
#' index_obs<- 1 : (5 * 3)
#' dim(index_obs) <- c(time = 5, dataset = 3, member = 1, season = 1)
#' index_hind <- 1 : (5 * 3 * 4)
#' dim(index_hind) <- c(time = 5, dataset = 3, member = 4, season = 1)
#' res <- PDFIndexFcst(index_hind, index_obs, index_fcst)
#' dim(res)
#' # time statistic   dataset season 
#' #   1         4         3      1
#' str(res)
#' # num [1, 1:4, 1:3, 1] 5.5 22.5 -17 0 6.5 22.5 -16 0 7.5 22.5 ...
#'
PDFIndexFcst <- function(index_hind, index_obs, index_fcst, type_exp = 'ens', 
                         method ='ME', na.rm = FALSE) {
  
  if('statistic' %in% names(dim(index_hind)) & dim(index_hind)['member'] == 1){
    Dim <- dim(index_hind)
    dim(index_hind) <- Dim[-which(names(Dim) == 'member')]
  }
  if('statistic' %in% names(dim(index_fcst)) & dim(index_fcst)['member'] == 1){
    Dim <- dim(index_fcst)
    dim(index_fcst) <- Dim[-which(names(Dim) == 'member')]
  }
  Dim <- dim(index_obs)
  dim(index_obs) <- Dim[-which(names(Dim) == 'member')]
  
  if (type_exp == 'ens'){
    PDFstatistics <- Apply(list(index_hind, index_obs, index_fcst),
                           target_dims = list(c('time', 'member'), 'time',
                                              c('time','member')),
                           fun = .PDFIndexFcst, type_exp, method, na.rm)
  } else if (type_exp == 'sta'){
    PDFstatistics <- Apply(list(index_hind, index_obs, index_fcst),
                           target_dims = list(c('time', 'statistic'), 'time',
                                              c('time','statistic')),
                           fun = .PDFIndexFcst, type_exp, method, na.rm)
  }
  return(PDFstatistics$output1)
}

#' Atomic PDFIndexFcst
#' @param index_hind Index (e.g. NAO index) array from a SFS with dimensions
#' (time, member) for a hindcast period.
#' @param index_obs Index (e.g. NAO index) array from an observational database
#' or reanalysis with dimension (time).
#' @param index_fcst Index (e.g. NAO index) array from a SFS
#' with dimensions (time = 1, member) for a forecast year.
#' @param type_exp A character string ('ens' or 'sta') to identify if the 
#' experiment output is an ensemble members or statistics.
#' @param method A character string indicating which methodology is applied
#' to compute the PDF. One of "ME" (default) or "LMEV".
#' @param na.rm Logical. Should missing values be removed?
#' @return .PDFIndexFcst returns an array with dimensions (time=1, statistic=4).
#' The firt statistic is the parameter 'mean' of the PDF with not bias corrected
#'  for the forecast year.
#' The second statistic is the parameter 'standard deviation' of the PDF
#' with not bias corrected for the forecast year.
#' The third statistic is the parameter 'mean' of the PDF with bias corrected
#' for the forecast year.
#' The fourth statistic is the parameter 'standard deviation' of the PDF
#' with bias corrected for the forecast year.
#' @import multiApply
#' @importFrom verification verify
#' @examples
#' # Example for the Atomic PDFIndexFcst function
#' index_fcst <- 1 : 3
#' dim(index_fcst) <- c(time = 1, member = 3)
#' index_obs <- 1 : 10
#' dim(index_obs) <- c(time = length(index_obs))
#' index_hind <- 1 : (10 * 3)
#' dim(index_hind) <- c(time = 10, member = 3)
#' res <- .PDFIndexFcst(index_hind, index_obs, index_fcst)
#' str(res)
#' # num [1, 1:4] 2 10 -8 0
#' dim(res)
#' # time statistic
#' #  1         4
#' @noRd
.PDFIndexFcst <- function(index_hind, index_obs, index_fcst, type_exp = 'ens',
                          method = 'ME', na.rm = FALSE) {
  names(dim(index_obs)) <- c('time')
  if (type_exp == 'ens') {
    names(dim(index_hind)) <- c('time', 'member')
    names(dim(index_fcst)) <- c('time', 'member')
    exp_fcst_ens_mean <- Apply(list(index_fcst), target_dims = 'member',
                          fun = mean)$output1
    exp_fcst_ens_sd <- Apply(list(index_fcst), target_dims = 'member',
                        fun = sd)$output1
    data_hind <- .PDFIndexHind(index_hind, index_obs, type_exp, method, na.rm)
  } else {
    names(dim(index_hind)) <- c('time', 'statistic')
    names(dim(index_fcst)) <- c('time', 'statistic')
    pos <- match(c('time','statistic'), names(dim(index_fcst)))
    index_fcst <- aperm(index_fcst,pos)
    exp_fcst_ens_mean <- index_fcst[,1]
    exp_fcst_ens_sd <- index_fcst[,2]
    data_hind <- .PDFIndexHind(index_hind, index_obs, type_exp, method, na.rm)
  }
  
  exp_hind_ens_mean <- data_hind[,1]
  pdfnotbc_mean <-  exp_fcst_ens_mean
  pdfnotbc_sd <- Sigma_notBC(exp_hind_ens_mean, index_obs, na.rm)
  if (method == 'ME') {
    pdfbc <-  MEBC(exp_hind_ens_mean, index_obs, na.rm)
    pdfbc_mean  <- exp_fcst_ens_mean - pdfbc
  } else if (method == 'LMEV') {
    # linear model error-variance
    exp_fcst_ens_var <- exp_fcst_ens_sd^2
    dim_hind <- names(dim(index_hind))
    dim_obs <- names(dim(index_obs))
    coeff <- LMEV(index_hind, index_obs, dim_hind, dim_obs, na.rm)
    pdfbc_mean <- exp_fcst_ens_mean - (coeff$coeff1 + coeff$coeff2*exp_fcst_ens_var)
  } else {
    stop("Error: Parameter 'method' is wrong")
  }
  pdfbc_sd <-  Sigma_BC(data_hind[,3], index_obs, na.rm)
  data <- cbind(pdfnotbc_mean, pdfnotbc_sd, pdfbc_mean, pdfbc_sd)
  names(dim(data)) <- c(names(dim(index_obs)), 'statistic')
  return(data)
}
