
library(multiApply)
library(easyVerification)
library(s2dv)

RPSS <- function(exp, obs, ref = NULL, n_categories, indices_for_clim, 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 <- .RPS_from_probs(probs_exp = clim_probs, probs_obs = obs_probs, n_categories = n_categories, Fair = FALSE)
  } 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))
}
