#' @rdname CST_PDFIndexHind
#' @title Computing the Index PDFs for the hindcast 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 hindcast 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_exp 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 SFSs for improving.
#' The index_exp 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 dimension 'time' 
#' must be greater than 2.
#' @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_PDFIndexHind() 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, dataset, statistic = 4, season) and ii) an element
#' named \code{$statistics} 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_obs <- 1 : (5 * 3 * 1 * 4)
#' dim(index_obs) <- c(time = 5, dataset = 3, member = 1, season = 4)
#' index_exp <- 1 : (5 * 3 * 7 * 4)
#' dim(index_exp) <- c(time = 5, dataset = 3, member = 7, season = 4)
#' index_exp <- list(data = index_exp)
#' index_obs <- list(data = index_obs)
#' class(index_exp) <- 's2dv_cube'
#' class(index_obs) <- 's2dv_cube'
#' res_CST <- CST_PDFIndexHind(index_exp, index_obs)
#' dim(res_CST$data)
#' #time   dataset statistic    season
#' # 5         3         4         4
CST_PDFIndexHind <- function(index_exp, index_obs, type_exp = 'ens', method = 'ME', na.rm = FALSE) {
  if (!inherits(index_exp, 's2dv_cube') || !inherits(index_obs, 's2dv_cube')) {
    stop("Parameter 'index_exp' 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_exp$data))) || is.null(names(dim(index_obs$data)))) {
    stop("Element 'data' from parameters 'index_exp' and 'index_obs'",
         " should have dimmension names.")
  }
  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_exp$data)) == 4 ){
    if (!all(names(dim(index_exp$data)) == c('time', 'dataset', 'member', 'season'))){ 
      stop("Wrong dimensions of the component 'data' of parameter 'index_exp'")
    } 
  } else if (length(dim(index_exp$data)) == 5 ){
    if (!all(names(dim(index_exp$data)) == c('time', 'dataset', 'member', 'statistic', 'season'))){ 
      stop("Wrong dimensions of the component 'data' of parameter 'index_exp'")
    }
  } else {
    stop("Wrong dimensions of the component 'data' of parameter 'index_exp'")
  }
  if (dim(index_obs$data)['time'] != dim(index_exp$data)['time']) {
    stop("The length of the dimensions 'time' in the component 'data' ",
         "of the parameter 'index_obs' and 'index_exp' must be equals.")
  }
  if (dim(index_obs$data)['dataset'] != dim(index_exp$data)['dataset']) {
    stop("The length of the dimensions 'dataset' in the component 'data' ",
         "of the parameter 'index_obs' and 'index_exp' must be equals.")
  }
  if (dim(index_obs$data)['season'] != dim(index_exp$data)['season']) {
    stop("The length of the dimensions 'season' in the component 'data' ",
         "of the parameter 'index_obs' and 'index_exp' 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_exp' must be greater than 2.")
  }
  if (dim(index_obs$data)['member'] != 1) {
    stop("The length of the dimension 'member' in the component 'data' ",
         "of the parameter 'index_obs' must be equal to 1.")
  }
  if (dim(index_exp$data)['member'] == 1 &
      !any(names(dim(index_exp$data)) == 'statistic')){
    stop("The dimension 'statistic' must be exist in the component 'data' ",
         "of the parameter 'index_exp' if the length of the dimension ",
         "'member' is equal to 1")
  }
  if (dim(index_exp$data)['member'] > 1 &
      any(names(dim(index_exp$data)) == 'statistic')){
    stop("The length of the dimension 'member' in the component 'data' of the ",
         "parameter 'index_exp' must be equal to 1 if the component 'data' ",
         "of the parameter 'index_exp' has the dimension 'statistic'")
  }
  if (dim(index_exp$data)['member'] == 1 &
      dim(index_exp$data)['statistic'] != 2){
    stop("The length of the dimension 'statistic' in the component 'data' of the ",
         "parameter 'index_exp' must be equal to 2 if the component 'data' ",
         "of the parameter 'index_exp' has the dimension 'member' equal to 1.")
  }
  if (any(names(dim(index_exp$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_exp' exits")
  } 
  
  PDFstatistics <- PDFIndexHind(index_exp$data, index_obs$data, 
                                type_exp = type_exp, method = method,
                                na.rm = na.rm)
  if (dim(index_exp$data)['member'] == 1) {
    Dim <- dim(index_exp$data)
    dim(index_exp$data) <- Dim[-which(names(Dim) == 'member')]
  }
  dimnames <- names(dim(index_exp$data))
  if (any(names(dim(index_exp$data)) == 'member')){
    dimnames[dimnames == 'member'] <- 'statistic'
  }
  
  pos <- match(dimnames, names(dim(PDFstatistics)))
  PDFstatistics <- aperm(PDFstatistics, pos)
  names(dim(PDFstatistics)) <- dimnames
  index_exp$data <- PDFstatistics
  index_exp$Datasets <- c(index_exp$Datasets, index_obs$Datasets)
  index_exp$source_files <- c(index_exp$source_files, index_obs$source_files)
  index_exp$statistic <- c("mean_notbc","sigma_notbc","mean_bc","sigma_bc")
  return(index_exp)
}

#' @rdname PDFIndexHind
#' @title Computing the Index PDFs for a dataset of SFSs for a hindcats period.
#' @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_exp Index (e.g. NAO index) array from SFSs
#' 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 Index (e.g. NAO index) array from an observational database
#' or reanalysis with dimensions (time, dataset, member = 1, season). The 
#' dimension 'time' must be greater than 2.
#' @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 PDFIndexHind() returns an array
#' with dimensions (time, statistic = 4, dataset, season).
#' 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 PDFIndexHind function
#' # Example 1 
#' index_obs <- 1 : (5 * 3 * 1 * 1) 
#' dim(index_obs) <- c(time = 5, dataset = 3, member = 1, season = 1)
#' index_exp <- 1 : (5 * 3 * 4 * 1)
#' dim(index_exp) <- c(time = 5, dataset = 3, member = 4, season = 1)
#' res <- PDFIndexHind(index_exp, index_obs)
#' str(res)
#' # num [1:5, 1:4, 1:3, 1] 23.5 24.5 25.5 26.5 27.5 22.5 22.5 22.5 22.5 22.5 ...
#' dim(res)
#' # time statistic   dataset   season
#' #   5         4         3        1
#' # Example 2
#' index_obs <- 1 : (5 * 3 * 1 * 1) 
#' dim(index_obs) <- c(time = 5, dataset = 3, member = 1, season = 1)
#' index_exp <- 1 : (5 * 3 * 1* 2 * 1)
#' dim(index_exp) <- c(time = 5, dataset = 3, member = 1, statistic = 2, season = 1)
#' res <- PDFIndexHind(index_exp, index_obs, type_exp = 'sta')
#' str(res)
#' # num [1:5, 1:4, 1:3, 1] 1 2 3 4 5 0 0 0 0 0 ...
#' dim(res)
#' # time statistic   dataset   season
#' #   5         4         3        1
#'
PDFIndexHind <- function(index_exp, index_obs, type_exp = 'ens', method ='ME', 
                         na.rm = FALSE) {
  
  if('statistic' %in% names(dim(index_exp)) & dim(index_exp)['member'] == 1){
    Dim <- dim(index_exp)
    dim(index_exp) <- 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_exp, index_obs),
                           target_dims = list(c('time', 'member'), 'time'),
                 fun = .PDFIndexHind, type_exp, method, na.rm)
  } else if (type_exp == 'sta'){
    PDFstatistics <- Apply(list(index_exp, index_obs),
                           target_dims = list(c('time', 'statistic'), 'time'),
                           fun = .PDFIndexHind, type_exp, method, na.rm)
  }
  return(PDFstatistics$output1)
}

#' Atomic PDFIndexHind
#' @param index_exp Index (e.g. NAO index) array from a SFS with dimensions
#' (time, member) for a hindcast period. The dimension 'time' must be greater 
#' than 2.
#' @param index_obs Index (e.g. NAO index) array from an observational dataset
#' or reanalysis with dimension (time). The dimension 'time' must be greater 
#' than 2.
#' @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 .PDFIndexHind returns an array with dimensions (time, statistic = 4).
#' The firt statistic is the parameter 'mean' of the PDF with not bias corrected
#' for the hindcast period.
#' The second statistic is the parameter 'standard deviation' of the PDF
#' with not bias corrected for the hindcast period.
#' The third statistic is the parameter 'mean' of the PDF with bias corrected
#' for the hindcast period.
#' The fourth statistic is the parameter 'standard deviation' of the PDF
#' with bias corrected for the hindcast period.
#' @import multiApply
#' @importFrom verification verify
#' @examples
#' # Example for the Atomic PDFIndexHind function
#' index_obs <- 1 : 10
#' dim(index_obs) <- c(time = length(index_obs))
#' index_exp <- 1 : (10 * 3)
#' dim(index_exp) <- c(time = 10, member = 3)
#' res <- .PDFIndexHind(index_exp, index_obs)
#' str(res)
#' # num [1:10, 1:4] 11 12 13 14 15 16 17 18 19 20 ...
#' dim(res)
#' # time statistic
#' #  10         4
#' @noRd
.PDFIndexHind <- function(index_exp, index_obs, type_exp = 'ens', method = 'ME', 
                          na.rm = FALSE) {
  names(dim(index_obs)) <- c('time')
  if (type_exp == 'ens') {
    names(dim(index_exp)) <- c('time', 'member')
    exp_ens_mean <- Apply(list(index_exp), target_dims = 'member',
                          fun = mean, na.rm = na.rm)$output1
    exp_ens_sd <- Apply(list(index_exp), target_dims = 'member',
                        fun = sd, na.rm = na.rm)$output1
  } else if (type_exp == 'sta'){
    names(dim(index_exp)) <- c('time', 'statistic')
    pos <- match(c('time','statistic'), names(dim(index_exp)))
    index_exp <- aperm(index_exp,pos)
    exp_ens_mean <- index_exp[,1]
    exp_ens_sd <- index_exp[,2]
  }
  error <- exp_ens_mean - index_obs
  pdfnotbc_mean <-  exp_ens_mean
  ind <- 1 : length(index_obs)
  pdfnotbc_sd <- unlist(lapply(ind, function(x) {Sigma_notBC(exp_ens_mean[-x],
                                                             index_obs[-x], 
                                                             na.rm)}))

  if (method == 'ME') {
    pdfbc <-  unlist(lapply(ind, function(x) {MEBC(exp_ens_mean[-x],
                                                   index_obs[-x], na.rm)}))
    pdfbc_mean  <- exp_ens_mean - pdfbc
    pdfbc_sd <-  unlist(lapply(ind, function(x) {Sigma_BC(pdfbc_mean[-x],
                                                          index_obs[-x],
                                                          na.rm)}))
  } else if (method == 'LMEV') {
    # linear model error-variance
    exp_ens_var <- exp_ens_sd^2
    dim_exp <- names(dim(index_exp))
    dim_obs <- names(dim(index_obs))
    coeff <- sapply(ind, function(x) {LMEV(index_exp[-x,], index_obs[-x], 
                                           dim_exp, dim_obs, na.rm)})
    pdfbc_mean <- exp_ens_mean - (unlist(coeff['coeff1',]) +
                                    unlist(coeff['coeff2',])*exp_ens_var)
    pdfbc_sd <-  unlist(lapply(ind, function(x) {Sigma_BC(pdfbc_mean[-x],
                                                          index_obs[-x],
                                                          na.rm)}))
  } else {
    stop("Error: Parameter 'method' is wrong")
  }
  data <- cbind(pdfnotbc_mean, pdfnotbc_sd, pdfbc_mean, pdfbc_sd)
  names(dim(data)) <- c(names(dim(index_obs)), 'statistic')
  return(data)
}
