#'Compute probabilistic information of a forecast relative to a threshold or a quantile
#'
#'Compute probabilistic bins of a set of forecast years ('fcyr') relative to 
#'the forecast climatology over the whole period of anomalies, optionally excluding 
#'the selected forecast years ('fcyr') or the forecast year for which the 
#'probabilistic bins are being computed (see 'compPeriod').
#'
#'@param data An numeric array of anomalies with the dimensions 'time_dim' and
#'  'memb_dim' at least. It can be generated by \code{Ano()}.
#'@param thr A numeric vector used as the quantiles (if 'quantile' is TRUE) or 
#'  thresholds (if 'quantile' is FALSE) to bin the anomalies. If it is quantile,
#'  it must be within [0, 1].
#'@param fcyr A numeric vector of the indices of the forecast years (i.e., 
#'  time_dim) to compute the probabilistic bins for, or 'all' to compute the 
#'  bins for all the years. E.g., c(1:5), c(1, 4), 4, or 'all'. The default 
#'  value is 'all'.
#'@param time_dim A character string indicating the dimension along which to 
#'  compute the probabilistic bins. The default value is 'sdate'.
#'@param memb_dim A character string indicating the name of the member 
#'  dimension or the dimension to be merged with 'time_dim' for probabilistic
#'  calculation. The default value is 'member'.
#'@param quantile A logical value indicating if the thresholds ('thr') are 
#'  quantiles (TRUE) or the absolute thresholds of the bins (FALSE). The 
#'  default value is TRUE.
#'@param compPeriod A character string referring to three computation options:\cr
#'  "Full period": The probabilities are computed based on 'data';\cr
#'  "Without fcyr": The probabilities are computed based on 'data' with all 
#'  'fcyr' removed;\cr
#'  "Cross-validation": The probabilities are computed based on leave-one-out
#'  cross-validation.\cr
#'  The default value is "Full period".
#'@param ncores An integer indicating the number of cores to use for parallel 
#'  computation. The default value is NULL.
#'
#'@return A numeric array of probabilistic information with dimensions:\cr
#'  c(bin = length of 'thr' + 1, time_dim = length of 'fcyr', memb_dim, the  
#'  rest of dimensions of 'data')\cr
#'  The values along the 'bin' dimension take values 0 or 1 depending on which 
#'  of the 'thr' + 1 cathegories the forecast or observation at the corresponding 
#'  grid point, time step, member and start date belongs to.
#'
#'@examples
#'\dontshow{
#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101')
#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'),
#'                                     c('observation'), startDates,
#'                                     output = 'lonlat',
#'                                     latmin = 27, latmax = 48,
#'                                     lonmin = -12, lonmax = 40)
#'}
#'clim <- Clim(sampleMap$mod, sampleMap$obs)
#'ano_exp <- Ano(sampleMap$mod, clim$clim_exp)
#'PB <- ProbBins(ano_exp, fcyr = 3, thr = c(1/3, 2/3), quantile = TRUE)
#'
#'@import multiApply
#'@importFrom abind abind
#'@export
ProbBins <- function(data, thr, fcyr = 'all', time_dim = 'sdate', memb_dim = 'member',
                     quantile = TRUE, compPeriod = "Full period",
                     ncores = NULL) {

  # Check inputs
  ## data
  if (is.null(data)) {
    stop("Parameter 'data' cannot be NULL.")
  }
  if (!is.numeric(data)) {
    stop("Parameter 'data' must be a numeric array.")
  }
#  if (is.null(dim(data))) {  #is vector
#    dim(data) <- c(length(data))
#    names(dim(data)) <- time_dim
#  }
  if (any(is.null(names(dim(data)))) | any(nchar(names(dim(data))) == 0)) {
    stop("Parameter 'data' must have dimension names.")
  }
  ## thr
  if (is.null(thr)) {
    stop("Parameter 'thr' cannot be NULL.")
  }
  if (!is.numeric(thr) | !is.vector(thr)) {
    stop("Parameter 'thr' must be a numeric vector.")
  } else if (quantile) {
    if (!all(thr <= 1 & thr >= 0)) {
      stop("Parameter 'thr' must be within the range [0, 1] if 'quantile' is TRUE.")
    }
  }
  ## time_dim
  if (!is.character(time_dim) | length(time_dim) > 1) {
    stop("Parameter 'time_dim' must be a character string.")
  }
  if (!time_dim %in% names(dim(data))) {
    stop("Parameter 'time_dim' is not found in 'data' dimension.")
  }
  ## memb_dim
  if (!is.character(memb_dim) | length(memb_dim) > 1) {
    stop("Parameter 'memb_dim' must be a character string.")
  }
  if (!memb_dim %in% names(dim(data))) {
    stop("Parameter 'memb_dim' is not found in 'data' dimension.")
  }
  ## fcyr
  if (!identical(fcyr, 'all')) {
    if (!is.numeric(fcyr) | !is.vector(fcyr)) {
      stop("Parameter 'fcyr' must be a numeric vector or 'all'.")
    } else if (any(fcyr %% 1 != 0) | min(fcyr) < 1 | max(fcyr) > dim(data)[time_dim]) {
      stop("Parameter 'fcyr' must be the indices of 'time_dim' within ",
           "the range [1, ", dim(data)[time_dim], "].")
    }
  } else {
    fcyr <- seq_len(dim(data)[time_dim])
  }
  ## quantile 
  if (!is.logical(quantile) | length(quantile) > 1) {
    stop("Parameter 'quantile' must be one logical value.")
  }
  ## compPeriod
  if (length(compPeriod) != 1 | 
      !all(compPeriod %in% c('Full period', 'Without fcyr', 'Cross-validation'))) {
    stop("Parameter 'compPeriod' must be either 'Full period', 'Without fcyr', ",
         "or 'Cross-validation'.")
  }
  ## ncores
  if (!is.null(ncores)) {
    if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 |
      length(ncores) > 1) {
      stop("Parameter 'ncores' must be a positive integer.")
    }
  }

  ###############################
  # Calculate ProbBins

  res <- Apply(list(data),
               target_dims = list(c(time_dim, memb_dim)),
               output_dims = list(c('bin', time_dim, memb_dim)),
               fun = .ProbBins,
               thr = thr, fcyr = fcyr, quantile = quantile, 
               compPeriod = compPeriod,
               ncores = ncores)$output1

 return(res)
}

.ProbBins <- function(data, thr, fcyr = 'all', quantile = TRUE, 
                      compPeriod = "Full period") {

  # data: [sdate, member]

  if (compPeriod != 'Cross-validation') {
    # forecast
    fore <- data[fcyr, ]
    sample_fore <- as.vector(fore)  # vector: [fcyr + member]
    # hindcast
    if (compPeriod == "Full period") {
      hind <- data
      sample <- as.vector(hind)  # vector: [sdate + member]
    } else if (compPeriod == "Without fcyr") {
      hind <- data[-fcyr, ]
      sample <- as.vector(hind)  # vector: [sdate - fcyr + member]
    }

    # quantiles
    if (quantile) {
      qum <- quantile(sample, probs = thr, na.rm = TRUE, names = FALSE,
                      type = 8)  # vector: [length(thr)]
    } else {
      qum <- thr
    }

    # PBF: Probabilistic bins of a forecast
    # This array contains 0s and 1s that indicate the category where the forecast is.
    PBF <- array(counts(c(qum, sample_fore), nbthr = length(thr)),
                 dim = c(length(thr) + 1, length(fcyr), dim(data)[2]))   
#    names(dim(PBF)) <- c('bin', 'sdate', 'member')

    return(invisible(PBF))


  } else {  # Cross-Validation

    result <- NULL
    for (iyr in fcyr) {
      if (is.null(result)) {
        result <- .ProbBins(data, fcyr = iyr, thr = thr, quantile = quantile, 
                            compPeriod = "Without fcyr") # [bin, sdate, member]
      } else {
        result <- abind::abind(result, .ProbBins(data, fcyr = iyr, thr = thr, 
                                                 quantile = quantile, 
                                                 compPeriod = "Without fcyr"), 
                               along = 2) # along sdate
      }
    }
    
    return(result)

  }

}

# This function assign the values to a category which is limited by the thresholds
# It provides binary information    
counts <- function (dat, nbthr) {
  thr <- dat[1:nbthr]
  data <-  dat[nbthr + 1:(length(dat) - nbthr)]
  prob <- array(NA, dim = c(nbthr + 1, length(dat) - nbthr))
  prob[1, ] <- 1 * (data <= thr[1])
  if (nbthr != 1) {
    for (ithr in 2:(nbthr)) {
      prob[ithr, ] <- 1 * ((data > thr[ithr - 1]) & (data <= thr[ithr]))
    }
  }
  prob[nbthr + 1, ] <- 1 * (data > thr[nbthr])
  return(prob) 
}
  
