
# MERGES verification dimns int single sdate dim along which the 
# verification metrics will be computed
mergedims <- function(data, indims, outdim) {

  old.dims <- names(dim(data))
  new.dims <- c(indims, old.dims[! old.dims %in% indims])
  data <- Reorder(data, new.dims)

  for (step in 1:(length(indims) - 1)) {
      if (step == 1) {
      data <- MergeDims(data, 
                        merge_dims=c(indims[step], indims[step+1]), 
                        rename_dim=outdim) 
      } else {
      data <- MergeDims(data,
                        merge_dims=c(outdim, indims[step+1]), 
                        rename_dim=outdim) 
      }
  }

  return(data)

}

## TODO: New function to split sdate dim back into 'sday', 'sweek' and 'syear'?

Compute_verif_metrics <- function(exp, obs, skill_metrics,
                                  verif.dims=c("syear", "sday", "sweek"),
				  merge.dims=F,
                                  na.rm=T, ncores=1) {

  if (merge.dims) {
    exp <- mergedims(exp, verif.dims, 'sdate')
    obs <- mergedims(obs, verif.dims, 'sdate')
    time.dim <- 'sdate'
  } else {
    time.dim <- 'syear'
  }
  ## obs already contains ensemble dimension
  # obs <- InsertDim(obs, 2, 1, name='member') 
  
  ## REMOVE VALUES IN CASE PAIR OBS-EXP IS NOT COMPLETE 
  if (na.rm) {
    nsdates <- dim(exp)[which(names(dim(exp)) == time.dim)][]
    not_missing_dates <- c() 
    for (sdate in 1:nsdates) {
      if(!all(is.na(Subset(exp, along=time.dim, list(sdate), drop=F)))) {
        not_missing_dates <- c(not_missing_dates, sdate)
      }
    }
    obs <- Subset(obs, along=time.dim, not_missing_dates, drop=F)
    exp <- Subset(exp, along=time.dim, not_missing_dates, drop=F)
  }
  
  return(.compute_metrics(exp, obs, skill_metrics, ncores=ncores, na.rm=na.rm))

}

.compute_metrics <- function(exp, obs, metrics, 
			     ncores=1, split_factor=1,
			     merge.dims=FALSE, na.rm=FALSE) {
  if (merge.dims) {
    time.dim <- 'sdate'
  } else {
    time.dim <- 'syear'
  }

  veriUnwrap <- easyVerification:::veriUnwrap

  ## SPECS VERIFICATION PARAMETERS
  # Assign function name and probability bins for each metric
  SPECSVER_METRICS <- c("frpss", "frps", "bss10", "bss90", "enscorr", "rpss")

  FUN <- list(frps="FairRps", rpss="EnsRpss", frpss="FairRpss",
      	bss10="FairRpss", bss90="FairRpss", enscorr="EnsCorr")

  PROB <- list(frps=c(1/3, 2/3), rpss=c(1/3, 2/3), frpss=c(1/3, 2/3), 
      	 bss10=c(1/10), bss90=c(9/10), enscorr=NULL)

  metrics_data <- list()
  for (metric in metrics) {

    if (metric %in% SPECSVER_METRICS) { 

      data <- Apply(data=list(exp, obs),
                    target_dims=list(c(time.dim, 'ensemble'),
      	      		             c(time.dim, 'ensemble')),
                    fun="veriApply",
                    verifun=FUN[[metric]],
                    prob=PROB[[metric]],
                    ensdim=2,
                    ncores=ncores,
                    split_factor=split_factor,
                    tdim=1,
                    na.rm=na.rm)[[1]] #* 100

      data <- Subset(data, c('ensemble'), list(1), drop='selected')
      data[!is.finite(data)] <- NaN
      metric <- paste0(metric, "_specs")
      metrics_data <- data
      # metrics_data[[ metric ]] <- data ## previously: list(data)

    } else if (metric == "corr_eno") {
      # computes ensemble mean
      data <- multiApply::Apply(data = exp, 
                                target_dims = 'ensemble',
                                fun = mean, ncores = ncores)$output1

      data <- multiApply::Apply(data = list(exp = data, 
                                            obs = Subset(obs, c('ensemble'),
      				            list(1), drop='selected')),
                                target_dims = time.dim, fun = .correlation_eno, 
                                time_dim = time.dim, ncores = ncores)

      # append both corr_r and corr_sign to metrics list
      for (i in 1:length(data)) {
        coeff <- data[[i]]
        coeff[!is.finite(coeff)] <- NaN
        if (names(data)[i] %in% c("r", "sign")){
          metrics_data[[ paste0("corr_", names(data)[i]) ]] <- coeff ## list(coeff)
        }
      }

    } else if (metric == "frpss_sign") {

      terciles_obs <- compute_quants(obs, c(1/3, 2/3), 
      			             quantile_dims=c(time.dim),
                                     ncores=ncores,
      			             split_factor=1,
      			             na.rm=na.rm)

      terciles_exp <- compute_quants(exp, c(1/3, 2/3), 
      			             quantile_dims=c(time.dim, 'ensemble'),
                                     ncores=ncores,
      			             split_factor=1,
      			             na.rm=na.rm)

      probs_obs <- compute_probs(obs, terciles_obs,
				 quantile_dims=c(time.dim),
				 ncores=ncores,
				 split_factor=1,
				 na.rm=na.rm)

      probs_exp <- compute_probs(exp, terciles_exp,
				 quantile_dims=c(time.dim),
				 ncores=ncores,
				 split_factor=1,
				 na.rm=na.rm)

      probs_clim = array(data = 1/3, dim = dim(probs_obs))

      frps <- NULL
      n_members <- dim(exp)[which(names(dim(exp)) == 'ensemble')][]
      frps$clim <- multiApply::Apply(data = list(probs_exp = probs_clim,
      				     probs_obs = probs_obs),
                                     target_dims = 'bin', 
                                     fun = .rps_from_probs, 
                                     n_categories = 3, 
                                     n_members = n_members,
                                     Fair = TRUE, 
      			             ncores = ncores)$output1

      frps$exp <- multiApply::Apply(data = list(probs_exp = probs_exp,
      			            probs_obs = probs_obs),
                                    target_dims = 'bin', 
                                    fun = .rps_from_probs, 
                                    n_categories = 3, 
                                    n_members = n_members,
                                    Fair = TRUE,
      			            ncores = ncores)$output1

      frps$clim_mean <- multiApply::Apply(data = frps$clim, target_dims=time.dim,
                                          fun=mean, ncores=ncores)$output1
      frps$exp_mean <- multiApply::Apply(data = frps$exp, target_dims=time.dim,
                                         fun=mean, ncores=ncores)$output1

      frpss_respect2clim <- NULL
      frpss_respect2clim$rpss <- 1 - frps$exp_mean/frps$clim_mean
      frpss_respect2clim$sign <- s2dv::RandomWalkTest(skill_A=frps$exp,
      						skill_B=frps$clim, 
                                                      time_dim=time.dim,
      						ncores=ncores)$signif
        
      frpss_respect2clim$rpss[!is.finite(frpss_respect2clim$rpss)] <- NaN
      frpss_respect2clim$sign[!is.finite(frpss_respect2clim$sign)] <- NaN 

      frpss_respect2clim$rpss <- Subset(frpss_respect2clim$rpss, 
      				  c('ensemble'), list(1), 
      				  drop='selected')
      frpss_respect2clim$sign <- Subset(frpss_respect2clim$sign,
      				  c('ensemble'), list(1),
      				  drop='selected')

      metrics_data[[ "frpss_values" ]] <- list(frpss_respect2clim$rpss)
      metrics_data[[ "frpss_sign" ]] <- list(frpss_respect2clim$sign)

    }

  }
  
  return(metrics_data)

}

.correlation_eno = function(exp, obs,
			    time_dim = 'syear',
			    alpha = 0.05, 
			    ncores = 1) {
  
  cor = NULL
  cor$r = cor(exp, obs) # Correlation coefficient
  
  n_eff = s2dv::Eno(data = obs, time_dim = time_dim,
		    na.action = na.pass, ncores = ncores)

  t_alpha2_n2 = qt(p=alpha/2, df = n_eff-2, lower.tail = FALSE)
  t = abs(cor$r) * sqrt(n_eff-2) / sqrt(1-cor$r^2)
  
  if (anyNA(c(t, t_alpha2_n2)) == FALSE & t >= t_alpha2_n2) {
    cor$sign = TRUE
  } else {
    cor$sign = FALSE
  }

  z_a2 = qnorm(p = alpha/2, lower.tail = FALSE)
  conf_int = c()
  conf_int[1] = tanh(atanh(cor$r) - z_a2 / sqrt(n_eff-3))
  conf_int[2] = tanh(atanh(cor$r) + z_a2 / sqrt(n_eff-3))
  cor$conf_int = conf_int
  
  cor$n_eff <- n_eff
  
  return(cor)
}


.rps_from_probs <- function(probs_exp,
			    probs_obs,
			    n_categories,
			    Fair,
			    n_members = NULL) {
  
  ## Checkings
  if (length(probs_exp) != n_categories | length(probs_obs) != n_categories){
    stop('The number of probabilities has to be the same as the number of categories')
  }
  if (!is.numeric(n_categories)){
    stop('n_categories must be an integer')
  }
  if (!is.numeric(n_members) & Fair == TRUE){
    stop('n_members must be an integer')
  }
  
  ## RPS (Wilks 2011, pp.348-350)
  rps <- NULL
  for (i in 1:n_categories) {
    rps[i] <- (cumsum(probs_exp)[i]-cumsum(probs_obs)[i])^2
  }
  rps <- sum(rps)
  
  ## FairRPS
  if (Fair == TRUE) { 
    
    ## formula of SpecsVerification::EnsRps
    ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1))
    R <- n_members
    R_new <- Inf 
    probs_cum <- cumsum(probs_exp)
    adjustment <- -1 / (R-1) * probs_cum * (1 - probs_cum)
    adjustment <- sum(adjustment)
    
    rps <- rps + adjustment
    
  }
  
  return(rps)

}
