#'Compute the correlation difference and its significance
#'
#'Positive values of the correlation difference indicate that the forecast is more skilful 
#'than the reference forecast, while negative values mean that the reference forecast is 
#'more skilful. The statistical significance of the correlation differences is computed with
#'a one-sided test for equality of dependent correlation coefficients (Steiger, 1980; 
#'https://content.apa.org/doi/10.1037/0033-2909.87.2.245; Siegert et al., 2017; 
#'https://doi.org/10.1175/MWR-D-16-0037.1) 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 N.eff Effective sample size to be used in the statistical significance test.
#'  If NA, it is computed with the Eno() function. The default value is NA.
#'@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 p.val Logical indicating whether to regurn the p-value. The default value is TRUE.
#'@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 correlation differences 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 correlation differences with the same 
#'  dimensions as the input arrays except "time_dim" (and "member_dim" if provided).
#'}
#'\item{$p.val}{
#'  A numeric array with the p-values 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))
#' DiffCorr(exp, ref, obs, member_dim = 'member')
#'
#'@import multiApply
#'@export
DiffCorr <- function(exp, ref, obs, N.eff = NA, time_dim = 'year', member_dim = NULL, method = 'pearson', p.val = TRUE, 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.na(N.eff) & !is.numeric(N.eff)){stop('"N.eff" must be NA or numeric.')}
  if (!is.character(time_dim)){stop('"time_dim" must be a string.')}
  if (!is.null(member_dim) & !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.logical(p.val)){stop('"p.val" must be TRUE or FALSE.')}
  if (!is.numeric(alpha) | alpha <= 0 | alpha >= 1){stop('"alpha" must be a number between 0 and 1.')}
  if (!is.null(ncores)){
    if (!is.numeric(ncores) | ncores < 1){stop('"ncores" must be either NULL or a positive integer.')}
  }
  
  ## Ensemble means
  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
  }
  
  ## Correlation difference
  output <- multiApply::Apply(data = list(exp = exp, ref = ref, obs = obs),
                              target_dims = time_dim, fun = .DiffCorr,
                              N.eff = N.eff, time_dim = time_dim, method = method,
                              p.val = p.val, alpha = alpha, ncores = ncores)
  return(output)
}

.DiffCorr <- function(exp, ref, obs, N.eff, time_dim, method, p.val, alpha) {
  
  if (!anyNA(exp) & !anyNA(ref) & !anyNA(obs)){
    
    ## Correlation difference
    cor.exp <- cor(x = exp, y = obs, method = method)
    cor.ref <- cor(x = ref, y = obs, method = method)
    output <- NULL
    output$corr.diff <- cor.exp - cor.ref
    
    ## Significance with one-sided test for equality of dependent correlation coefficients (Steiger, 1980)
    r12 <- cor.exp
    r13 <- cor.ref
    r23 <- cor(exp, ref)
    if (is.na(N.eff)){
      N.eff <- s2dv::Eno(data = obs, time_dim = time_dim, na.action = na.pass, ncores = 1) ## effective degrees of freedom
    }
    R <- (1-r12*r12-r13*r13-r23*r23) + 2*r12*r13*r23
    t <- (r12 - r13) * sqrt((N.eff-1)*(1+r23) / (2 * ((N.eff-1)/(N.eff-3)) * R + 0.25*(r12+r13)^2 * (1-r23)^3))
    p.value <- 1 - pt(t, df = N.eff-3)
    if (!is.na(p.value) & p.value <= alpha){
      output$sign <- TRUE
    } else {
      output$sign <- FALSE
    }
    if (isTRUE(p.val)){output$p.val <- p.value}
    
  } else {
    output <- list(corr.diff = NA, sign = NA)
    if (isTRUE(p.val)){output$p.val <- NA}
  }
  
  return(output)
}
