#' @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).
#' @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 at least three dimensions (time, dataset, season).
#' It could have one more dimension (member) equal to 1.
#' @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 : (3 * 5 * 4)
#' dim(index_obs) <- c(time = 5, dataset = 3, member = 1, season = 4)
#' index_exp <- 1 : (3 * 5 * 4 * 7)
#' 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, 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 (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_hind' must be equal to 1 if the component 'data' ",
         "of the parameter 'index_hind' has the dimension 'statistic'")
  }

  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'
  }
  PDFstatistics <- PDFIndexHind(index_exp$data, index_obs$data, method = method,
                                na.rm = na.rm)
  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).
#' @param index_obs Index (e.g. NAO index) array from an observational database
#' or reanalysis with dimensions (time, dataset, member = 1) or (time, dataset).
#' @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).
#' 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
#' index_obs <- 1 : (3 * 5)
#' dim(index_obs) <- c(time = 5, dataset = 3, member = 1)
#' index_exp <- 1 : (3 * 5 * 4)
#' dim(index_exp) <- c(time = 5, dataset = 3, member = 4)
#' res <- PDFIndexHind(index_exp, index_obs)
#' str(res)
#' # num [1:5, 1:4, 1:3] 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
#' #   5         4         3
#'

PDFIndexHind <- function(index_exp, index_obs, method ='ME', na.rm = FALSE) {
  if (any(names(dim(index_obs)) == 'member')) {
    Dim <- dim(index_obs)
    dim(index_obs) <- Dim[-which(names(Dim) == 'member')]
  }
  if (any(names(dim(index_exp)) == 'member')){
    PDFstatistics <- Apply(list(index_exp, index_obs),
                           target_dims = list(c('time', 'member'), 'time'),
                 fun = .PDFIndexHind, method, na.rm)
  } else if (any(names(dim(index_exp)) == 'statistic')){
    PDFstatistics <- Apply(list(index_exp, index_obs),
                           target_dims = list(c('time', 'statistic'), 'time'),
                           fun = .PDFIndexHind, 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.
#' @param index_obs Index (e.g. NAO index) array from an observational dataset
#' or reanalysis with dimension (time).
#' @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, method = 'ME', na.rm = FALSE) {
  if (any(names(dim(index_exp)) == '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 {
    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])}))

  if (method == 'ME') {
    pdfbc <-  unlist(lapply(ind, function(x) {MEBC(exp_ens_mean[-x],
                                                   index_obs[-x])}))
    pdfbc_mean  <- exp_ens_mean - pdfbc
    pdfbc_sd <-  unlist(lapply(ind, function(x) {Sigma_BC(pdfbc_mean[-x],
                                                          index_obs[-x])}))
  } else if (method == 'LMEV') {
    # linear model error-variance
    exp_ens_var <- exp_ens_sd^2
    coeff <- sapply(ind, function(x) {LMEV(index_exp[-x,], index_obs[-x])})
    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])}))
  } 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)
}
