#'Compute the residual correlation and its significance
#'
#'The residual correlation assesses whether a forecast captures any of the observed variability that is not 
#'already captured by a reference forecast (Smith et al., 2019; https://doi.org/10.1038/s41612-019-0071-y.).
#'The procedure is as follows: the residuals of the forecasts and observations are computed by linearly regressing out 
#'the reference forecast's ensemble mean from the forecasts’ ensemble mean and observations, respectively. Then, the 
#'residual correlation is computed as the correlation between both residuals. Positive values of the residual correlation
#'indicate that the forecast capture more observed variability than the reference forecast, while negative values mean 
#'that the reference forecast capture more. The significance of the residual correlation is computed with a two-sided t-test
#'(Wilks, 2011; https://doi.org/10.1016/B978-0-12-385022-5.00008-7) using a effective degrees of freedom to account for 
#'the time series' autocorrelation (von Storch and Zwiers, 1999; https://doi.org/10.1017/CBO9780511612336).
#'
#'@param exp A numerical array with the forecast with, at least, time dimension. 
#'@param ref A numerical array with the reference forecast data with, at least, time dimension.
#'  The length of the time dimension must be the same as for "exp".
#'@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 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 NULL.
#'@param method A character string indicating the correlation coefficient to be computed ("pearson", 
#'  "kendall", or "spearman"). The default value is "pearson".
#'@param alpha Significance level to be used in the statistical significance test. The default value
#'  is 0.05.
#'@param ncores An integer indicating the number of cores to use for parallel 
#'  computation. The default value is NULL.
#'
#'@return A list of 2:
#'\item{$r}{
#'  A numerical array with the residual correlation with the same dimensions as the input arrays 
#'  except "time_dim" (and "member_dim" if provided).
#'}
#'\item{$sign}{
#'  A logical array with the statistical significance of the residual correlation with the same 
#'  dimensions as the input arrays except "time_dim" (and "member_dim" if provided).
#'}
#'
#'@examples
#' exp <- array(rnorm(1000), dim = c(lat = 3, lon = 2, member = 10, year = 50))
#' ref <- 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))
#' ResidualCorr(exp, ref, obs, member_dim = 'member')
#'
#'@import multiApply
#'@export
ResidualCorr <- function(exp, ref, obs, time_dim = 'year', member_dim = NULL, method = 'pearson', alpha = 0.05, 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.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(alpha) | alpha <= 0 | alpha >= 1){stop('"alpha" must be a number between 0 and 1.')}
  if (!is.character(time_dim)){stop('"time_dim" must be a string.')}
  if (!is.null(member_dim)){
    if (!is.character(member_dim)){stop('"member_dim" must be either NULL or a string.')}
  }
  if (!method %in% c("pearson","kendall","spearman")){stop('"method" must be "pearson", "kendall", or "spearman".')}
  if (!is.null(ncores)){
    if (!is.numeric(ncores) | ncores < 1){stop('"ncores" must be either NULL or a positive integer.')}
  }
  
  ## Ensemble mean
  if (!is.null(member_dim)){
    exp <- multiApply::Apply(data = exp, target_dims = member_dim, fun = mean, na.rm = FALSE, ncores = ncores)$output1
    ref <- multiApply::Apply(data = ref, target_dims = member_dim, fun = mean, na.rm = FALSE, ncores = ncores)$output1
  }
  
  ## Residual correlation and its significance
  output <- multiApply::Apply(data = list(exp = exp, ref = ref, obs = obs),
                              target_dims = time_dim, fun = .ResidualCorr,
                              time_dim = time_dim, method = method, 
                              alpha = alpha, ncores = ncores)
  return(output)
}

.ResidualCorr <- function(exp, ref, obs, time_dim, method, alpha){
  
  if (!anyNA(exp) & !anyNA(ref) & !anyNA(obs)){
    
    ## Residuals of 'exp' and 'obs' (regressing 'ref' out in both 'exp' and 'obs')
    exp_res <- lm(formula = y ~ x, data = list(y = exp, x = ref), na.action = NULL)$residuals
    obs_res <- lm(formula = y ~ x, data = list(y = obs, x = ref), na.action = NULL)$residuals
    
    ## Residual correlation (and significance)
    residual_cor <- NULL
    residual_cor$r <- cor(x = exp_res, y = obs_res, method = method)
    
    ## Significance
    n_eff <- s2dv::Eno(data = obs_res, time_dim = time_dim, na.action = na.pass, ncores = 1)
    t_alpha2_n2 <- qt(p = alpha/2, df = n_eff-2, lower.tail = FALSE)
    t <- abs(residual_cor$r) * sqrt(n_eff-2) / sqrt(1-residual_cor$r^2)
    if (anyNA(c(t,t_alpha2_n2)) == FALSE & t >= t_alpha2_n2){
      residual_cor$sign <- TRUE
    } else {
      residual_cor$sign <- FALSE
    }
    
  } else {
    residual_cor <- list(r = NA, sign = NA)
  }
  
  return(residual_cor)
}
