#' @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).
#' @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 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).
#' @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 : (3 * 5 * 4 * 7)
#' 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 : (3 * 5 * 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 * 4 * 7)
#' 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')
#' str(res_CST)
#' dim(res_CST$data)
#' #time   dataset statistic    season
#' # 1         3         4         4
CST_PDFIndexFcst <- function(index_hind, index_obs, index_fcst,
                             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 (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_fcst$data)['member'] == 1 &
      !any(names(dim(index_fcst$data)) == 'statistic')){
    stop("The dimension 'statistic' must be exist in the component 'data' ",
         "of the parameter 'index_fcst' if the length of the dimension ",
          "'member' is equal to 1")
  }
  if (dim(index_fcst$data)['time'] != 1){
    stop("The dimension 'time' must be equal to 1")
  }
  if (dim(index_hind$data)['member'] == 1 &
      !any(names(dim(index_hind$data)) == 'statistic')){
    stop("The dimension 'statistic' must be exist in the component 'data' ",
         "of the parameter 'index_hind' if the length of the dimension ",
         "'member' is equal to 1")
  }
  if (dim(index_fcst$data)['member'] > 1 &
      any(names(dim(index_fcst$data)) == 'statistic')){
    stop("The length of the dimension 'member' in the component 'data' of the ",
    "parameter 'index_fcst' must be equal to 1 if the component 'data' ",
         "of the parameter 'index_fcst' has the dimension 'statistic'")
  }
  if (dim(index_hind$data)['member'] > 1 &
      any(names(dim(index_hind$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_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_fcst <- names(dim(index_fcst$data))
  dimnames_hind <- names(dim(index_hind$data))
  if(sum(dimnames_fcst == dimnames_hind) != length(dimnames_fcst)){
    stop("The dimensions of the component 'data' of the parameter ",
         "'index_fcst' must be equal to the dimensions of the component ",
         "'data' of the parameter 'index_hind'")
  }
  dimnames <- dimnames_fcst
  if (any(names(dim(index_fcst$data)) == 'member')){
    dimnames[dimnames == 'member'] <- 'statistic'
  }
  PDFstatistics <- PDFIndexFcst(index_hind$data, index_obs$data,
                                index_fcst$data, method = method, na.rm = na.rm)
  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) for a hindcast period.
#' @param index_obs Index (e.g. NAO index) array from an observational database
#' or reanalysis with dimension (time, dataset, member = 1) or (time, dataset).
#' @param index_fcst Index (e.g. NAO index) array from SFSs.
#' with dimensions (time = 1, dataset, member) for a forecast year.
#' @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, statistic = 4, dataset) for the forecast year.
#' 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)
#' index_obs<- 1 : (5 * 3)
#' dim(index_obs) <- c(time = 5, dataset = 3, member = 1)
#' index_hind <- 1 : (5 * 3 * 4)
#' dim(index_hind) <- c(time = 5, dataset = 3, member = 4)
#' res <- PDFIndexFcst(index_hind, index_obs, index_fcst)
#' dim(res)
#' # time statistic   dataset
#' #   1         4         3
#' str(res)
#' # num [1, 1:4, 1:3] 5.5 22.5 -17 0 6.5 22.5 -16 0 7.5 22.5 ...
#'
PDFIndexFcst <- function(index_hind, index_obs, index_fcst, 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_fcst)) == 'member')){
    PDFstatistics <- Apply(list(index_hind, index_obs, index_fcst),
                           target_dims = list(c('time', 'member'), 'time',
                                              c('time','member')),
                           fun = .PDFIndexFcst, method, na.rm)
  } else if (any(names(dim(index_fcst)) == 'statistic')){
    PDFstatistics <- Apply(list(index_hind, index_obs, index_fcst),
                           target_dims = list(c('time', 'statistic'), 'time',
                                              c('time','statistic')),
                           fun = .PDFIndexFcst, 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 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,
                          method = 'ME', na.rm = TRUE) {
  if (any(names(dim(index_fcst)) == '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
  } else {
    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, 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)
  if (method == 'ME') {
    pdfbc <-  MEBC(exp_hind_ens_mean, index_obs)
    pdfbc_mean  <- exp_fcst_ens_mean - pdfbc
  } else if (method == 'LMEV') {
    # linear model error-variance
    exp_fcst_ens_var <- exp_fcst_ens_sd^2
    coeff <- LMEV(index_hind, index_obs)
    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)
  data <- cbind(pdfnotbc_mean, pdfnotbc_sd, pdfbc_mean, pdfbc_sd)
  names(dim(data)) <- c(names(dim(index_obs)), 'statistic')
  return(data)
}
