#' @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
#' three dimensions (time, dataset, member) for a zonal variable 
#' or five dimensions (time, dataset, member, lat, lon) for a spatial variable.
#' @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 dimensions (time, dataset, member, season).
#' @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 first 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 * 3 * 2)
#' dim(var_exp) <- c(time = 4, dataset = 2, member = 3, 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 'var_exp' and 'weights_index_exp' must be of the class 's2dv_cube', ",
         "as output by CSTools::CST_Load.")
  }
  if (is.null(names(dim(var_exp$data))) 
      || is.null(names(dim(weights_index_exp$data)))) {
    stop("Element 'data' from parameters 'var_exp' and 'weights_index_exp'",
         " should have dimmension names.")
  }
  if(length(dim(var_exp$data)) == 3 ){
    if (!all(names(dim(var_exp$data)) == c('time', 'dataset', 'member'))){ 
      stop("Wrong dimensions of the component 'data' of parameter 'var_exp'")
    } 
  } else if (length(dim(var_exp$data)) == 5 ){
    if (!all(names(dim(var_exp$data)) == c('time', 'dataset', 'member', 
                                           'lat', 'lon'))){ 
      stop("Wrong dimensions of the component 'data' of parameter 'var_exp'")
    }
  } else {
    stop("Wrong dimensions of the component 'data' of parameter 'var_exp'")
  }
  if(length(dim(weights_index_exp$data)) == 4 ){
    if (!all(names(dim(weights_index_exp$data)) == c('time', 'dataset', 
                                                     'member', 'season'))){ 
      stop("Wrong dimensions of the component 'data' of parameter 'weights_index_exp'")
    } 
  } else {
    stop("Wrong dimensions of the component 'data' of parameter 'weights_index_exp'")
  }
  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)['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'")
  }
  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 (sum(!is.na(as.vector(var_exp$data)))
      != length(as.vector(var_exp$data))){
    stop("There are one or more elements of the component 'data' of the ",
         "parameter 'var_exp' equal to NA.")
  }
  
  if (sum(!is.na(as.vector(weights_index_exp$data)))
      != length(as.vector(weights_index_exp$data))){
    stop("There are one or more elements of the component 'data' of the ",
          "parameter 'weights_index_exp' equal to NA.")
  }
  
  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 three dimensions (time, dataset, member) for a zonal 
#' variable or dimensions (time, dataset, member, lat, lon) for a spatial 
#' variable.
#' @param weights_index_exp Normalized weights array with dimensions 
#' (time, dataset, member, season).
#' @return ProbBestIndexWeighting() returns an array 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 first 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, season = 1)
#' res <- ProbBestIndexWeighting(var_exp, weights_index_exp)
#' dim(res)
#' # time tercil dataset season
#' #    2      3       3      1
#' # 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, season = 1)
#' res <- ProbBestIndexWeighting(var_exp, weights_index_exp)
#' dim(res)
#' # time  tercil dataset   season  lat     lon
#' #    2       3       3        1    2       3
#'
ProbBestIndexWeighting <- function(var_exp, weights_index_exp) {
  res <- Apply(list(var_exp, weights_index_exp),
               target_dims = list(c('time','member'), c('time','member')),
               fun = .ProbBestIndexWeighting)$output1
  if (length(dim(var_exp)) == 5){
    Dim <- c('time', 'tercil', 'dataset', 'season', 'lat', 'lon')   
  } else if(length(dim(var_exp)) == 3){
    Dim <- c('time', 'tercil', 'dataset', 'season')
  } else {
    stop("Wrong dimension")
  }
  pos <- match(Dim, names(dim(res)))
  res <- aperm(res, pos)                                        
  names(dim(res)) <- Dim
  return(res)
}

#' 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
  names(dim(var_exp)) <- c('time','member')
  names(dim(weights_index_exp)) <- c('time','member')
  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)
  names(dim(aTerciles)) <- c('time','member')

  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 > rep(lt,length(x))) & (x < rep(ut,length(x)))] <- 2
  dim(y) <- c(member = length(x))
  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))
}

