#' @rdname CST_ProbBestIndexWeighting
#' @title Computing the weighted tercile probabilities for SFSs of a CSTools
#' object.
#' @author Eroteida Sanchez-Garcia - AEMET, \email{esanchezg@aemet.es}
#' @description This function implements the computation to obtain the tercile
#' probabilities for a weighted variable from SFSs through Best estimation of
#' one index or driver of climate variability (as e.g., the North Atlantic
#' Oscillation (NAO)) 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 var_exp An object of the class 's2dv_cube' containing the variable
#' (e.g. precipitation, temperature, NAO index) array.
#' The var_exp object is expected to have an element named \code{$data} with
#' at least two dimensions (time, member).
#' If the variable is spatial the dimensions would be (time, member, lat, lon).
#' If we want to compute for several SFSs, the array could have another
#' dimension (time, dataset, member, lat, lon).
#' @param weights_index_exp An object of the class 's2dv_cube' containing
#' the normalized weights array.
#' The weights_index_exp object is expected to have an element named
#' \code{$data} with at least two dimensions (time, member).
#' If we want to compute for several SFSs, the array could have another
#' dimension (time, dataset, member).
#' @return CST_ProbBestIndexWeighting() returns a CSTools object (i.e., of the
#' class 's2dv_cube').
#' This object has at least an element named \code{$data}
#' with four or six dimensions depending if the variable is zonal
#' (as e.g. NAO index)(time, tercil, dataset, season) or it is spatial variable
#' (as e.g. precipitation or temperature)
#' (time, tercil, dataset, season, lat, lon),
#' containing the terciles probabilities computing with weighted members.
#' The firt tercil is the lower tercile, the second is the normal tercile and
#' the third is the upper tercile.
#' @export
#' @examples
#' var_exp <- 1 : (4 * 2 * 3 * 2 * 3 * 2)
#' dim(var_exp) <- c(time = 4, dataset = 2, member = 3, season = 2, lat = 3, lon = 2)
#' weights_index_exp <- runif(4 * 2 * 3 * 2, 0.0001, 0.9999)
#' dim(weights_index_exp) <- c(time = 4, dataset = 2, member = 3, season = 2)
#' var_exp <- list(data = var_exp)
#' weights_index_exp <- list(data = weights_index_exp)
#' class(var_exp) <- 's2dv_cube'
#' class(weights_index_exp) <- 's2dv_cube'
#' res_CST <- CST_ProbBestIndexWeighting(var_exp, weights_index_exp)
#' dim(res_CST$data)
#' # time  tercil dataset  season     lat     lon
#' #    4       3       2       2       3       2
CST_ProbBestIndexWeighting <- function(var_exp, weights_index_exp) {
  if (!inherits(var_exp, 's2dv_cube') || !inherits(weights_index_exp, 's2dv_cube')) {
    stop("Parameter 'index_exp' and 'pdf_exp' must be of the class 's2dv_cube', ",
         "as output by CSTools::CST_Load.")
  }
  if (!any(names(dim(var_exp$data)) == 'time')){
    stop("The component 'data' of the parameter 'var_exp' must have the ",
         "dimension 'time'")
  }
  if (!any(names(dim(weights_index_exp$data)) == 'time')){
    stop("The component 'data' of the parameter 'weights_index_exp' must have ",
         "the dimension 'time'")
  }
  if (!any(names(dim(var_exp$data)) == 'member')){
    stop("The component 'data' of the parameter 'var_exp' must have the ",
         "dimension 'member'")
  }
  if (!any(names(dim(weights_index_exp$data)) == 'member')){
    stop("The component 'data' of the parameter 'weights_index_exp' must have ",
         "the dimension 'member'")
  }
  if (dim(var_exp$data)['time'] != dim(weights_index_exp$data)['time']){
    stop("The length of the dimension 'time' of the parameter 'var_exp' ",
         "in the component 'data' must be equal to the length of the dimension",
         " 'time' of the parameter 'weights_index_exp' in the component 'data'")
  }
  if (dim(var_exp$data)['member'] != dim(weights_index_exp$data)['member']){
    stop("The length of the dimension 'member' of the parameter 'var_exp' ",
         "in the component 'data' must be equal to the length of the dimension",
         " 'member' of the parameter 'weights_index_exp' in the component 'data'")
  }
  if (any(names(dim(weights_index_exp$data)) == 'lat') &
      dim(weights_index_exp$data)['lat'] != 1) {
    stop("The length of the dimension 'lat' of the parameter 'weights_index_exp'",
         " in the component 'data' must be equal to 1")
  }
  if (any(names(dim(weights_index_exp$data)) == 'lon') &
      dim(weights_index_exp$data)['lon'] != 1) {
    stop("The length of the dimension 'lon' of the parameter 'weights_index_exp'",
         " in the component 'data' must be equal to 1")
  }
  if (any(names(dim(weights_index_exp$data)) == 'lon')) {
    Dim <- dim(weights_index_exp$data)
    dim(weights_index_exp$data) <- Dim[-which(names(Dim) == 'lon')]
  }
  if (any(names(dim(weights_index_exp$data)) == 'lat')) {
    Dim <- dim(weights_index_exp$data)
    dim(weights_index_exp$data) <- Dim[-which(names(Dim) == 'lat')]
  }
  if (any(names(dim(weights_index_exp$data)) == 'lon')) {
    Dim <- dim(weights_index_exp$data)
    dim(weights_index_exp$data) <- Dim[-which(names(Dim) == 'lon')]
  }
  if (any(names(dim(var_exp$data)) == 'dataset') &
      !any(names(dim(weights_index_exp$data)) == 'dataset')) {
    stop("The component 'data' of the parameter 'weights_index_exp' must have'",
         " the dimension 'dataset'")
  }
  if (!any(names(dim(var_exp$data)) == 'dataset') &
      any(names(dim(weights_index_exp$data)) == 'dataset')) {
    stop("The component 'data' of the parameter 'var_exp' must have'",
         " the dimension 'dataset'")
  }
  if (any(names(dim(var_exp$data)) == 'dataset') &
      any(names(dim(weights_index_exp$data)) == 'dataset') &
      dim(var_exp$data)['dataset'] != dim(weights_index_exp$data)['dataset']) {
    stop("The length of the dimension 'dataset' of the parameter 'var_exp' ",
         "in the component 'data' must be equal to the length of the dimension",
         " 'dataset' of the parameter 'weights_index_exp' in the component 'data'")
  }

  prob <- ProbBestIndexWeighting(var_exp$data, weights_index_exp$data)
  prob_var_exp <- list()
  prob_var_exp$data <- prob
  prob_var_exp$Datasets <- var_exp$Datasets
  prob_var_exp$source_files <- var_exp$source_files
  prob_var_exp$Dates <- var_exp$Dates
  return(prob_var_exp)
}

#' @rdname ProbBestIndexWeighting
#' @title Computing the weighted tercile probabilities for SFSs.
#' @author Eroteida Sanchez-Garcia - AEMET, \email{esanchezg@aemet.es}
#' @description This function implements the computation to obtain the tercile
#' probabilities for a weighted variable from SFSs through Best estimation of
#' one index or driver of climate variability (as e.g., the North Atlantic
#' Oscillation (NAO)).
#' @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 var_exp Variable (e.g. precipitation, temperature, NAO index)
#' array from a SFS with at least two dimensions (time, member).
#' If the variable is spatial the dimensions would be (time, member, lat, lon).
#' If we want to compute for several SFSs, the array could have another
#' dimension (time, dataset, member, lat, lon).
#' @param weights_index_exp Normalized weights array with at least two
#' dimensions (time, member). If we want to compute for several SFSs,
#' the array could have another dimension (time, dataset, member).
#' @return ProbBestIndexWeighting() returns an array with three or five dimensions
#' depending if the variable is zonal (as e.g. NAO index)(time, tercil, dataset)
#' or it is spatial variable (as e.g. precipitation or temperature)
#' (time, tercil, dataset, lat, lon), containing the terciles probabilities
#' computing with weighted members.
#' The firt tercil is the lower tercile, the second is the normal tercile and
#' the third is the upper tercile.
#' @import multiApply
#' @export
#' @examples
#' # Example 1 for the ProbBestIndexWeighting function
#' var_exp <- 1 : (2 * 3 * 4)
#' dim(var_exp) <- c(time = 2, dataset = 3, member = 4)
#' weights_index_exp<- runif(24, min=0.001, max=0.999)
#' dim(weights_index_exp) <- c(time = 2, dataset = 3, member = 4)
#' res <- ProbBestIndexWeighting(var_exp, weights_index_exp)
#' dim(res)
#' # time tercil dataset
#' #    2      3       3
#' str(res)
#' # num [1:2, 1:3, 1:3] 0.6773 0 0 0.0413 1.8419 ...
#' # Example 2 for the ProbBestIndexWeighting function
#' var_exp <- 1 : (2 * 3 * 4 * 2 * 3)
#' dim(var_exp) <- c(time = 2, dataset = 3, member = 4, lat = 2, lon = 3)
#' weights_index_exp<- runif(24, min=0.001, max=0.999)
#' dim(weights_index_exp) <- c(time = 2, dataset = 3, member = 4)
#' res <- ProbBestIndexWeighting(var_exp, weights_index_exp)
#' dim(res)
#' # time  tercil dataset     lat     lon
#' #    2       3       3       2       3
#' str(res)
#' # num [1:2, 1:3, 1:3, 1:2, 1:3] 0.703 0 0 0.236 1.87 ...
#'
ProbBestIndexWeighting <- function(var_exp, weights_index_exp) {
  return(Apply(list(var_exp, weights_index_exp),
               target_dims = list(c('time','member'), c('time','member')),
               fun = .ProbBestIndexWeighting)$output1)
}

#' Atomic ProbBestIndexWeighting
#' @param var_exp Variable (e.g. precipitation, temperature, NAO index)
#' array from a SFS with dimensions (time, member).
#' @param weights_index_exp Normalized weights array with dimensions
#' (time, member).
#' @return .ProbBestIndexWeighting returns an array of with dimensions
#' (time, tercil = 3), the terciles probabilities computing with weighted
#' members.
#' The firt tercil is the lower tercile, the second is the normal tercile and
#' the third is the upper tercile.
#' @examples
#' # Example for the Atomic EMBestIndexWeighting function
#' var_exp <- 1 : 8
#' dim(var_exp) <- c(time = 2, member = 4)
#' weights_index_exp <- c(0.28, 0.15, 0.69, 0.64, 0.42, 0.17, 0.14, 0.22)
#' dim(weights_index_exp) <- c(time = 2, member = 4)
#' res <- .ProbBestIndexWeighting(var_exp, weights_index_exp)
#' str(res)
#' # num [1:2, 1:3] 0.28 0.15 0.69 0 0.56 1.03
#' dim(res)
#' # time tercil
#' #    2      3
#' @noRd
.ProbBestIndexWeighting <- function(var_exp, weights_index_exp) {
  # computing terciles
  terciles_exp <- WeightTerciles(var_exp, weights_index_exp)
  lowerTercile <- terciles_exp$lowerTercile
  upperTercile <- terciles_exp$upperTercile

  # Probabilities
  aTerciles <- Apply(list(var_exp), target_dims = list('member'),
                     fun = Data2Tercil, lowerTercile, upperTercile)$output1

  pos <- match(names(dim(aTerciles)), c('time','member'))
  aTerciles <- aperm(aTerciles,pos)

  pos <- match(names(dim(weights_index_exp)), c('time','member'))
  weights_index_exp <- aperm(weights_index_exp, pos)

  probTercile <- array(NA, dim = c(dim(var_exp)['time'], tercil = 3))
  for (idTercil in 1:3){
    probTercile[,idTercil] <- Apply(list(aTerciles, weights_index_exp),
                                    target_dims = list('member','member'),
                                    fun = WeightTercil2Prob, idTercil)$output1
  }
  return(probTercile)
}

# Auxiliar function to compute in which tercile is a data value
Data2Tercil <- function(x,lt,ut) {
  y <- x
  y[x <= lt] <- 1
  y[x >= ut] <-3
  y[(x > lt) & (x < ut)] <- 2
  return (y)
}

# Auxiliar function to convers weighted terciles to probabilities
WeightTercil2Prob <- function(aTerciles, aWeights, idTercil) {
  return(sum(aWeights[which(aTerciles == idTercil)]))
}

# Auxiliar function to compute weighted terciles
WeightTerciles <- function(data, weights) {
  vectorData <- as.vector(data)
  vectorWeights <- as.vector(weights/dim(weights)['time']) # normalized
  lSortData <- sort(vectorData,index.return=TRUE)
  indSort <- lSortData$ix # index asociated to weight
  # corresponding for this data
  dataSort <- lSortData$x
  # Adding normalized weights. When 1/3 is reached, the data value
  # is lower tercile and when 2/3 is reached, it is the upper tercile.
  sumWeights <- 0
  ilowerTercile <- 0
  while ((sumWeights < 1/3) & (ilowerTercile < (dim(weights)['member'] *
                                                dim(weights)['time']))){
    ilowerTercile<- ilowerTercile +1
    sumWeights <- sumWeights + vectorWeights[indSort[ilowerTercile]]
  }
  lowerTercile <- (dataSort[ilowerTercile]+
                     dataSort[ilowerTercile-1])/2
  sumWeights <- 0
  iupperTercile <- 0
  while ((sumWeights < 2/3) & (iupperTercile < (dim(weights)['member'] *
                                                dim(weights)['time']))){
    iupperTercile<- iupperTercile +1
    sumWeights <- sumWeights + vectorWeights[indSort[iupperTercile]]
  }
  upperTercile <- (dataSort[iupperTercile]+
                     dataSort[iupperTercile-1])/2
  return(list(lowerTercile = lowerTercile, upperTercile = upperTercile))
}

