#'Compute the Ranked Probability Skill Score
#'
#'The Ranked Probability Skill Score (RPSS; Wilks, 2011; https://doi.org/10.1016/B978-0-12-385022-5.00008-7)
#'is the skill score based on the Ranked Probability Score (RPS; Wilks, 2011). It can be used to assess whether
#'a forecast presents an improvement or worsening with respect to a reference forecast. The RPSS ranges between
#'minus infinite and 1. If the RPSS is positive, it indicates that the forecast has higher skill than the 
#'reference forecast, while a negative value means that it has a lower skill. Examples of reference forecasts
#'are the climatological forecast (same probabilities for all categories for all time steps), persistence, a previous model version,
#'and another model. It is computed as RPSS = 1 - RPS_exp / RPS_ref. The statistical significance is obtained based
#'on a Random Walk test at the 95% confidence level (DelSole and Tippett, 2016; https://doi.org/10.1175/MWR-D-15-0218.1)
#'
#'@param exp A numerical array with the forecast with, at least, time dimension. 
#'@param obs A numerical array with the observations with, at least, time dimension. 
#'  The length of the time dimension must be the same as for "exp".
#'@param ref NULL or a numerical array with the reference forecast with, at least, time dimension. 
#'  The length of the time dimension must be the same as for "exp". If it is NULL, the climatological forecast is
#'  used as reference forecast. The default value is NULL.
#'@param indices_for_clim A vector with the indices to be taken along "time_dim" dimension for computing the thresholds
#'  between the probabilistic categories.
#'@param n_categories An integer with the number of probabilistic categories. The default value is 3 (tercile categories).
#'@param Fair A logical indicating whether to compute the FairRPSS (the potential RPSS that the forecast would have with 
#'an infinite ensemble size). The default value is FALSE.
#'@param time_dim A character string indicating the name of the time dimension.
#'  The default value is 'year'.
#'@param member_dim A character string indicating the name of the member dimension to compute the 
#'  ensemble means of the forecast and reference forecast. If it is NULL, the ensemble means should 
#'  be provided directly to the function. 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
#'\item{$rpss}{
#'  A numerical array with the RPSS with the same dimensions as "exp" except the "time_dim" 
#'  and "member_dim" dimensions.
#'}
#'\item{$sign}{
#'  A logical array with the statistical significance of the RPSS with the same dimensions 
#'  as "exp" except the "time_dim" and "member_dim" dimensions.
#'}

#'@examples
#' exp <- array(rnorm(1000), dim = c(lat = 3, lon = 2, member = 10, year = 50))
#' obs <- array(rnorm(1000), dim = c(lat = 3, lon = 2, year = 50))
#' RPSS(exp, obs, indices_for_clim = 1:50)
#'
#'@import multiApply
#'@export
RPSS <- function(exp, obs, ref = NULL, indices_for_clim, n_categories = 3, Fair = FALSE, time_dim = 'year', member_dim = 'member', ncores = NULL){
  
  ## Checkings
  if (!is.array(exp)){stop('"exp" must be an array.')}
  if (!is.array(obs)){stop('"obs" must be an array.')}
  if (!is.null(ref)){
    if (!is.array(ref)){stop('"ref" must be an array.')}
    if (!identical(as.numeric(dim(exp)[time_dim]), as.numeric(dim(ref)[time_dim]))){stop('"time_dim" must have the same length in "exp" and "ref".')}
  }
  if (!identical(as.numeric(dim(exp)[time_dim]), as.numeric(dim(obs)[time_dim]))){stop('"time_dim" must have the same length in "exp" and "obs".')}
  if (!is.numeric(n_categories) | n_categories < 2){stop('"n_categories" must be an integer greater than 1.')}
  if (!is.logical(Fair)){stop('"Fair" must be TRUE or FALSE.')}
  if (!is.character(time_dim)){stop('"time_dim" must be a string.')}
  if (!is.character(member_dim)){stop('"member_dim" must be a string.')}
  if (!is.null(ncores)){
    if (!is.numeric(ncores) | ncores < 1){stop('"ncores" must be either NULL or a positive integer.')}
  } 
  
  if (!is.null(ref)){ ## using "ref" as reference forecast
    output <- multiApply::Apply(data = list(exp = exp, obs = obs, ref = ref), 
                                target_dims = list(exp = c(time_dim, member_dim), obs = time_dim, ref = c(time_dim, member_dim)),
                                n_categories = n_categories, indices_for_clim = indices_for_clim,
                                Fair = Fair, time_dim = time_dim, member_dim = member_dim,
                                fun = .RPSS, ncores = ncores)
  } else { ## using climatology as reference forecast
    output <- multiApply::Apply(data = list(exp = exp, obs = obs), 
                                target_dims = list(exp = c(time_dim, member_dim), obs = time_dim),
                                ref = ref, n_categories = n_categories, indices_for_clim = indices_for_clim,
                                Fair = Fair, time_dim = time_dim, member_dim = member_dim,
                                fun = .RPSS, ncores = ncores)
  }
  
  return(output)
}

.RPSS <- function(exp, obs, ref, n_categories, indices_for_clim, Fair, time_dim, member_dim){
  
  ## RPS of the forecast
  rps_exp <- .RPS(exp = exp, obs = obs, n_categories = n_categories, indices_for_clim = indices_for_clim, Fair = Fair, time_dim = time_dim, member_dim = member_dim)
  
  ## RPS of the reference forecast
  if (is.null(ref)){ ## using climatology as reference forecast
    obs_probs <- .get_probs(data = obs, type = 'obs', indices_for_quartiles = indices_for_clim, time_dim = time_dim, member_dim = NULL, n_categories = n_categories)$probs
    clim_probs <- array(data = 1 / n_categories, dim = dim(obs_probs))
    rps_ref <- multiApply::Apply(data = list(probs_exp = clim_probs, probs_obs = obs_probs), target_dims = 'bin',
                                 fun = .RPS_from_probs, n_categories = n_categories, Fair = FALSE, ncores = NULL)$output1
  } else { ## using "ref" as reference forecast
    rps_ref <- .RPS(exp = ref, obs = obs, n_categories = n_categories, indices_for_clim = indices_for_clim, Fair = Fair, time_dim = time_dim, member_dim = member_dim)
  }
  
  ## RPSS
  rpss <- 1 - mean(rps_exp) / mean(rps_ref)
  
  ## Significance
  rps_exp <- array(data = rps_exp, dim = c(time = length(rps_exp)))
  rps_ref <- array(data = rps_ref, dim = c(time = length(rps_ref)))
  sign <- s2dv::RandomWalkTest(skill_A = rps_exp, skill_B = rps_ref, time_dim = 'time', ncores = NULL)$signif
  
  return(list(rpss = rpss, sign = sign))
}
