#'Compute the Relative Operating Characteristic Skill Score
#'
#'The Relative Operating Characteristic Skill Score (ROCSS; Kharin and Zwiers, 
#'2003) is based on the ROC curve, which gives information about the hit rates 
#'against the false-alarm rates for a particular category or event. The ROC curve
#'can be summarized with the area under the ROC curve, known as the ROC score,
#'to provide a skill value for each category. The ROCSS ranges between minus 
#'infinite and 1. A positive ROCSS value indicates that the forecast has higher 
#'skill than the reference forecasts, meaning the contrary otherwise.
#'@param exp A named numerical array of the forecast with at least time and
#'  member dimension.
#'@param obs A named numerical array of the observation with at least time 
#'  dimension. The dimensions must be the same as 'exp' except 'memb_dim' and
#'  'dat_dim'. 
#'@param ref A named numerical array of the reference forecast data with at 
#'  least time and member dimension. The dimensions must be the same as 'exp' 
#'  except 'memb_dim'. If 'ref' is NULL, the random forecast is used as reference 
#'  forecast. The default value is NULL.
#'@param prob_thresholds A numeric vector of the relative thresholds (from 0 to
#'  1) between the categories. The default value is c(1/3, 2/3), which 
#'  corresponds to tercile equiprobable categories.
#'@param indices_for_clim A vector of the indices to be taken along 'time_dim' 
#'  for computing the thresholds between the probabilistic categories. If NULL,
#'  the whole period is used. The default value is NULL.
#'@param time_dim A character string indicating the name of the time dimension.
#'  The default value is 'sdate'.
#'@param memb_dim A character string indicating the name of the member dimension
#'  to compute the probabilities of the forecast and the reference forecast. The
#'  default value is 'member'.
#'@param ncores An integer indicating the number of cores to use for parallel 
#'  computation. The default value is NULL.
#'
#'@return
#'#'A list with numerical arrays of ROCSS with the same dimensions as 'exp' except 
#''time_dim' and 'memb_dim' dimensions. The number of elements of the list corresponds 
#'to the number of probabilistic categories, i.e., 1+length(prob_thresholds)
#'
#'@references 
#'Kharin, V. V. and Zwiers, F. W. (2003): https://doi.org/10.1175/1520-0442(2003)016%3C4145:OTRSOP%3E2.0.CO;2
#'
#'@examples
#'exp <- array(rnorm(1000), dim = c(lon = 3, lat = 2, sdate = 60, member = 10))
#'ref <- array(rnorm(1000), dim = c(lon = 3, lat = 2, sdate = 60, member = 10))
#'obs <- array(rnorm(1000), dim = c(lon = 3, lat = 2, sdate = 60))
#'ROCSS(exp = exp, obs = obs) ## random forecast as reference forecast
#'ROCSS(exp = exp, obs = obs, ref = ref) ## ref as reference forecast
#'
#'@import multiApply
#'@importFrom easyVerification convert2prob EnsRoca
#'@export
ROCSS <- function(exp, obs, ref = NULL, prob_thresholds = c(1/3, 2/3), indices_for_clim = NULL, 
                  time_dim = 'sdate', memb_dim = 'member', ncores = NULL){
  
  # Check inputs
  ## exp, obs, and ref (1)
  if (!is.array(exp) | !is.numeric(exp)) {
    stop("Parameter 'exp' must be a numeric array.")
  }
  if (!is.array(obs) | !is.numeric(obs)) {
    stop("Parameter 'obs' must be a numeric array.")
  }
  if (any(is.null(names(dim(exp))))| any(nchar(names(dim(exp))) == 0) |
      any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) {
    stop("Parameter 'exp' and 'obs' must have dimension names.")
  }
  if (!is.null(ref)) {
    if (!is.array(ref) | !is.numeric(ref))
      stop("Parameter 'ref' must be a numeric array.")
    if (any(is.null(names(dim(ref))))| any(nchar(names(dim(ref))) == 0)) {
      stop("Parameter 'ref' must have dimension names.")
    }
  }
  ## 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(exp)) | !time_dim %in% names(dim(obs))) {
    stop("Parameter 'time_dim' is not found in 'exp' or 'obs' dimension.")
  }
  if (!is.null(ref) & !time_dim %in% names(dim(ref))) {
    stop("Parameter 'time_dim' is not found in 'ref' 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(exp))) {
    stop("Parameter 'memb_dim' is not found in 'exp' dimension.")
  }
  if (!is.null(ref) & !memb_dim %in% names(dim(ref))) {
    stop("Parameter 'memb_dim' is not found in 'ref' dimension.")
  }
  ## dat_dim
  # if (!is.null(dat_dim)) {
  #   if (!is.character(dat_dim) | length(dat_dim) > 1) {
  #     stop("Parameter 'dat_dim' must be a character string.")
  #   }
  #   if (!dat_dim %in% names(dim(exp)) | !dat_dim %in% names(dim(obs))) {
  #     stop("Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension.",
  #          " Set it as NULL if there is no dataset dimension.")
  #   }
  # }
  ## exp, obs, and ref (2)
  name_exp <- sort(names(dim(exp)))
  name_obs <- sort(names(dim(obs)))
  name_exp <- name_exp[-which(name_exp == memb_dim)]
  if (memb_dim %in% name_obs) {
    name_obs <- name_obs[-which(name_obs == memb_dim)]
  }
  # if (!is.null(dat_dim)) {
  #   name_exp <- name_exp[-which(name_exp == dat_dim)]
  #   name_obs <- name_obs[-which(name_obs == dat_dim)]
  # }
  if (!identical(length(name_exp), length(name_obs)) |
      !identical(dim(exp)[name_exp], dim(obs)[name_obs])) {
    stop(paste0("Parameter 'exp' and 'obs' must have same length of ",
                "all dimensions except 'memb_dim'")) # and 'dat_dim'."))
  }
  if (!is.null(ref)) {
    name_ref <- sort(names(dim(ref)))
    name_ref <- name_ref[-which(name_ref == memb_dim)]
    # if (!is.null(dat_dim)) {
    #   if (dat_dim %in% name_ref) {
    #     if (!identical(dim(exp)[dat_dim], dim(ref)[dat_dim])) {
    #       stop(paste0("If parameter 'ref' has dataset dimension, it must be", 
    #                   " equal to dataset dimension of 'exp'."))
    #     }
    #     name_ref <- name_ref[-which(name_ref == dat_dim)]
    #   }
    # }
    if (!identical(length(name_exp), length(name_ref)) |
        !identical(dim(exp)[name_exp], dim(ref)[name_ref])) {
      stop(paste0("Parameter 'exp' and 'ref' must have the same length of ",
                  "all dimensions except 'memb_dim'", # and 'dat_dim'",
                  " if there is only one reference dataset."))
    }
  }
  ## prob_thresholds
  if (!is.numeric(prob_thresholds) | !is.vector(prob_thresholds) |
      any(prob_thresholds <= 0) | any(prob_thresholds >= 1)) {
    stop("Parameter 'prob_thresholds' must be a numeric vector between 0 and 1.")
  }
  ## indices_for_clim
  if (is.null(indices_for_clim)) {
    indices_for_clim <- 1:dim(obs)[time_dim]
  } else {
    if (!is.numeric(indices_for_clim) | !is.vector(indices_for_clim)) {
      stop("Parameter 'indices_for_clim' must be NULL or a numeric vector.")
    } else if (length(indices_for_clim) > dim(obs)[time_dim] |
               max(indices_for_clim) > dim(obs)[time_dim] |
               any(indices_for_clim) < 1) {
      stop("Parameter 'indices_for_clim' should be the indices of 'time_dim'.")
    }
  }
  ## ncores
  if (!is.null(ncores)) {
    if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 |
        length(ncores) > 1) {
      stop("Parameter 'ncores' must be either NULL or a positive integer.")
    }
  }
  
  ###############################
  
  ## Compute ROCSS
  if (!is.null(ref)){ ## reference forecast is provided
    
    ref <- Reorder(data = ref, order = c(names(dim(ref))[-(which(names(dim(ref)) %in% c(time_dim,memb_dim)))], time_dim, memb_dim))
    
    res <- multiApply::Apply(data = list(exp = exp, obs = obs, ref = ref),
                             target_dims = list(exp = c(time_dim, memb_dim),
                                                obs = time_dim,
                                                ref = c(time_dim, memb_dim)),
                             fun = .ROCSS,
                             prob_thresholds = prob_thresholds, 
                             indices_for_clim = indices_for_clim,
                             time_dim = time_dim,
                             ncores = ncores)
    
  } else { ## Random forecast as reference forecast
    
    res <- multiApply::Apply(data = list(exp = exp, obs = obs),
                             target_dims = list(exp = c(time_dim, memb_dim),
                                                obs = time_dim),
                             fun = .ROCSS,
                             ref = ref,
                             prob_thresholds = prob_thresholds, 
                             indices_for_clim = indices_for_clim,
                             time_dim = time_dim,
                             ncores = ncores)    
  }
  
  return(res)
}

.ROCSS <- function(exp, obs, ref = NULL, prob_thresholds = c(1/3, 2/3), indices_for_clim = NULL, time_dim = 'sdate'){
  
  # exp: [sdate, memb]
  # obs: [sdate]
  # ref: [sdate, memb]
  
  exp_probs <- .get_probs(data = exp, indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds)
  obs_probs <- .get_probs(data = obs, indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds)
  
  ## ROCS (exp)
  rocs_exp <- EnsRoca(ens = Reorder(exp_probs, c(time_dim,'bin')), 
                      obs = Reorder(obs_probs, c(time_dim,'bin')))
  
  ## ROCSS
  n_cats <- 1 + length(prob_thresholds)
  rocss <- list()
  if (is.null(ref)){ ## Random forecast as reference forecast
    for (cat in paste0('cat',1:n_cats)){
      rocss[[cat]] <- 2 * rocs_exp[[cat]] - 1
    }
  } else { ## Reference forecast is provided
    ## ROCS (ref)
    ref_probs <- .get_probs(data = ref, indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds)
    rocs_ref <- EnsRoca(ens = Reorder(ref_probs, c(time_dim,'bin')), 
                        obs = Reorder(obs_probs, c(time_dim,'bin')))
    for (cat in paste0('cat',1:n_cats)){
      rocss[[cat]] <- (rocs_exp[[cat]] - rocs_ref[[cat]]) / (1 - rocs_ref[[cat]])
    }
  }
  
  return(rocss)
}
