#'Compute the Continuous Ranked Probability Skill Score
#'
#'The Continuous Ranked Probability Skill Score (CRPSS; Wilks, 2011) is the skill score 
#'based on the Continuous Ranked Probability Score (CRPS; Wilks, 2011). It can be used to 
#'assess whether a forecast presents an improvement or worsening with respect to
#'a reference forecast. The CRPSS ranges between minus infinite and 1. If the 
#'CRPSS 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 CRPSS = 1 - CRPS_exp / CRPS_ref.
#'The statistical significance is obtained based on a Random Walk test at the 
#'95% confidence level (DelSole and Tippett, 2016).
#'
#'@param exp A named numerical array of the forecast with at least time 
#'  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'. 
#'@param ref A named numerical array of the reference forecast data with at 
#'  least time dimension. The dimensions must be the same as 'exp' except 
#'  'memb_dim'. If it is NULL, the climatological forecast is used as reference
#'  forecast. 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 Fair A logical indicating whether to compute the FairCRPSS (the 
#'  potential CRPSS that the forecast would have with an infinite ensemble size).
#'  The default value is FALSE.
#'@param ncores An integer indicating the number of cores to use for parallel 
#'  computation. The default value is NULL.
#'
#'@return
#'\item{$crpss}{
#'  A numerical array of the CRPSS with the same dimensions as "exp" except the
#'  'time_dim' and 'memb_dim' dimensions.
#'}
#'\item{$sign}{
#'  A logical array of the statistical significance of the CRPSS with the same
#'  dimensions as 'exp' except the 'time_dim' and 'memb_dim' dimensions.
#'}
#'
#'@references 
#'Wilks, 2011; https://doi.org/10.1016/B978-0-12-385022-5.00008-7
#'DelSole and Tippett, 2016; https://doi.org/10.1175/MWR-D-15-0218.1
#'
#'@examples
#'exp <- array(rnorm(1000), dim = c(lat = 3, lon = 2, member = 10, sdate = 50))
#'obs <- array(rnorm(1000), dim = c(lat = 3, lon = 2, sdate = 50))
#'ref <- array(rnorm(1000), dim = c(lat = 3, lon = 2, member = 10, sdate = 50))
#'res <- CRPSS(exp = exp, obs = obs) ## climatology as reference forecast
#'res <- CRPSS(exp = exp, obs = obs, ref = ref) ## ref as reference forecast
#'
#'@import multiApply
#'@importFrom ClimProjDiags Subset
#'@export
CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member',
                  Fair = FALSE, 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 (!is.null(ref)) {
    if (!is.array(ref) | !is.numeric(ref))
      stop('Parameter "ref" must be a numeric array.')
  }
  ## 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.")
  }
  ## exp and obs (2)
  if (memb_dim %in% names(dim(obs))) {
    if (identical(as.numeric(dim(obs)[memb_dim]),1)){
      obs <- ClimProjDiags::Subset(x = obs, along = memb_dim, indices = 1, drop = 'selected')
    } else {stop("Not implemented for observations with members ('obs' can have 'memb_dim', but it should be of length=1).")}
  }
  name_exp <- sort(names(dim(exp)))
  name_obs <- sort(names(dim(obs)))
  name_exp <- name_exp[-which(name_exp == memb_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 expect 'memb_dim'."))
  }
  if (!is.null(ref)) {
    name_ref <- sort(names(dim(ref)))
    name_ref <- name_ref[-which(name_ref == memb_dim)]
    if (!identical(length(name_exp), length(name_ref)) |
        !identical(dim(exp)[name_exp], dim(ref)[name_ref])) {
      stop(paste0("Parameter 'exp' and 'obs' must have same length of ",
                  "all dimensions expect 'memb_dim'."))
    }
  }
  ## Fair
  if (!is.logical(Fair)  | length(Fair) > 1) {
    stop("Parameter 'Fair' must be either TRUE or FALSE.")
  }
  ## 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 CRPSS
  if (!is.null(ref)) { # use "ref" as reference forecast
    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))
  } else {
    data <- list(exp = exp, obs = obs)
    target_dims = list(exp = c(time_dim, memb_dim),
                       obs = time_dim)
  }
  output <- Apply(data,
                  target_dims = target_dims,
                  fun = .CRPSS,
                  Fair = Fair,
                  ncores = ncores)
  
  return(output)
}

.CRPSS <- function(exp, obs, ref = NULL, Fair = FALSE) {
  # exp: [sdate, memb]
  # obs: [sdate]
  # ref: [sdate, memb] or NULL
  
  # CRPS of the forecast
  crps_exp <- .CRPS(exp = exp, obs = obs, Fair = Fair)
  
  # CRPS of the reference forecast
  if (is.null(ref)){ 
    ## using climatology as reference forecast
    ## all the time steps are used as if they were members
    ## then, ref dimensions are [sdate, memb], both with length(sdate)
    ref <- array(data = obs, dim = c(member = length(obs)))
    ref <- InsertDim(data = ref, posdim = 1, lendim = length(obs), name = 'sdate')
  }
  crps_ref <- .CRPS(exp = ref, obs = obs, Fair = Fair)
  
  # CRPSS
  crpss <- 1 - mean(crps_exp) / mean(crps_ref)
  
  # Significance
  sign <- .RandomWalkTest(skill_A = crps_exp, skill_B = crps_ref)$signif
  
  return(list(crpss = crpss, sign = sign))
}
