#'@rdname DynBiasCorrection
#'@title Performing a Bias Correction conditioned by the dynamical
#'properties of the data.
#'
#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it}
#'@author Maria M. Chaves-Montero, \email{mdm.chaves-montero@cmcc.it}
#'@author Veronica Torralba, \email{veronica.torralba@cmcc.it}
#'@author Davide Faranda, \email{davide.faranda@lsce.ipsl.fr}
#'
#'@description This function perform a bias correction conditioned by the 
#'dynamical properties of the dataset. This function used the functions 
#''CST_Predictability' to divide in terciles the two dynamical proxies 
#'computed with 'CST_ProxiesAttractor'. A bias correction
#'between the model and the observations is performed using the division into
#'terciles of the local dimension 'dim' and inverse of the persistence 'theta'.
#'For instance, model values with lower 'dim' will be corrected with observed 
#'values with lower 'dim', and the same for theta. The function gives two options
#'of bias correction: one for 'dim' and/or one for 'theta'
#'
#'@references Faranda, D., Alvarez-Castro, M.C., Messori, G., Rodriguez, D., 
#'and Yiou, P. (2019). The hammam effect or how a warm ocean enhances large 
#'scale atmospheric predictability.Nature Communications, 10(1), 1316. 
#'DOI = https://doi.org/10.1038/s41467-019-09305-8 "
#'@references Faranda, D., Gabriele Messori and Pascal Yiou. (2017).
#' Dynamical proxies of North Atlantic predictability and extremes. 
#' Scientific Reports, 7-41278, 2017.
#'
#'@param obsL an s2vcube object with the observation data
#'@param expL an s2dvcube object with the experiment data 
#'@param method the method to apply bias correction among these ones:
#'"PTF","RQUANT","QUANT","SSPLIN"
#'@param proxy the proxy (local dimension 'dim' or inverse of persistence 
#''theta') to apply the dynamical conditioned bias correction method. 
#'@param quanti quantile to perform the computation of local dimension and theta
#'@param ncores The number of cores to use in parallel computation
#'
#'@return dynbias an s2dvcube object with a bias correction performed 
#'conditioned by local dimension 'dim' or inverse of persistence 'theta'
#'
#'@import multiAp∑ply
#'@import qmap
#'@import CSTools
#'
#'@examples
#'# example 1: simple data s2dvcube style
set.seed(1)
expL <- rnorm(1:2000)
dim (expL) <- c(time =100,lat = 4, lon = 5)
obsL <- c(rnorm(1:1980),expL[1,,]*1.2)
dim (obsL) <- c(time = 100,lat = 4, lon = 5)
time_obsL <- paste(rep("01", 100), rep("01", 100), 1920 : 2019, sep = "-")
time_expL <- paste(rep("01", 100), rep("01", 100), 1929 : 2019, sep = "-")
lon <- seq(-1,5,1.5)
lat <- seq(30,35,1.5)
# qm=0.98 # too high for this short dataset, it is possible that doesn't
#'# get the requirement, in that case it would be necessary select a lower qm
#'# for instance qm=0.60
quanti = 0.60
method = "QUANT"
proxy = 'dim'
ncores = NULL
library(CSTools)
library(multiApply)
source("/esarchive/scratch/nperez/git/cstools/R/CST_ProxiesAttractor.R")
source("/esarchive/scratch/nperez/git/cstools/R/Predictability.R")
expL <- s2dv_cube(data = expL, lat = lat, lon = lon,
                 Dates = list(start = time_expL, end = time_expL))
obsL <- s2dv_cube(data = obsL, lat = lat, lon = lon,
                 Dates = list(start = time_obsL, end = time_obsL))

dynbias<- CST_DynBiasCorrection(obs = obsL, exp = expL, method = method, 
                            proxy= "dim", quanti=qm, ncores=NULL)
#'
#'@export
CST_DynBiasCorrection<- function(exp, obs, method = 'QUANT', 
                             proxy = "dim", quanti, ncores = NULL) {
  if (!inherits(obs, 's2dv_cube')) {
    stop("Parameter 'obs' must be of the class 's2dv_cube', ",
         "as output by CSTools::CST_Load.")
  }
  if (!inherits(exp, 's2dv_cube')) {
    stop("Parameter 'exp' must be of the class 's2dv_cube', ",
         "as output by CSTools::CST_Load.")
  }
  exp$data <- DynBiasCorrection(exp = exp$data, obs = obs$data, method = method,
                                proxy = proxy, quanti = quanti, ncores = ncores)
  return(exp)
}
#'@importFrom ClimProjDiags Subset
#'@export
DynBiasCorrection<- function(exp, obs, method = 'QUANT',
                             proxy = "dim", quanti, ncores = NULL){
  if (is.null(obs)) {
    stop("Parameter 'obs' cannot be NULL.")
  }  
  if (is.null(expL)) {
    stop("Parameter 'exp' cannot be NULL.")
  }    
  if (is.null(method)) {
    stop("Parameter 'method' cannot be NULL.")
  }  
  if (is.null(quanti)) {
    stop("Parameter 'quanti' cannot be NULL.")
  }   
  if (is.null(proxy)) {
    stop("Parameter 'proxy' cannot be NULL.")
  } 
  dims <- dim(exp)

  attractor.obs <- ProxiesAttractor(data = obs, quanti = quanti)
  predyn.obs <- Predictability(dim = attractor.obs$dim,
                               theta = attractor.obs$theta)
  attractor.exp <- ProxiesAttractor(data = exp, quanti = quanti)
  predyn.exp <- Predictability(dim = attractor.exp$dim,
                               theta = attractor.exp$theta)
 
  fun1 <- function(data, list1, tar_dim) {
    lapply(list1, function(x) {
   return(Subset(data, indices = x, along = tar_dim))})}
  
  if (proxy == "dim") {
    obs2 = fun1(data = obsL, list1 = predyn.obs$pred.dim$pos.d, tar_dim ='time')
    exp2 = fun1(data = expL, list1 = predyn.exp$pred.dim$pos.d, tar_dim ='time')
  } else if (proxy == "theta") {
    obs2 = fun1(data = obs, list1 = predyn.obs$pred.theta$pos.t, tar_dim = 'time')
    exp2 = fun1(data = exp, list1 = predyn.exp$pred.theta$pos.t, tar_dim =' time')
  } else {
    stop ("Parameter 'proxy' must be set as 'dim' or 'theta'.")
  }
 
  biascorrection <- function(obsV, expV, method){
# print(expV)
  ## functions fitQmap and doQmap
  if (method == "PTF") {
    qm.fit <- fitQmap(obs, exp, method = "PTF", transfun = "expasympt",
                      cost = "RSS", wett.day = TRUE)
    qmap <- doQmap(exp, qm.fit)
  } else if (method == "QUANT") {
    qm.fit <- fitQmap(obsV, expV, method = "QUANT", qstep = 0.01)
    qmap <- doQmap(expV, qm.fit, type = "tricub")
print(expV)
print(obsV)
print(qmap)
stop("HERE")
  } else if (method == "RQUANT") {
    qm.fit <- fitQmap(obs, exp, method = "RQUANT", qstep = 0.01)
    qmap <- doQmap(exp, qm.fit, type = "linear")
  } else if (method == "SSPLIN") { 
    qm.fit <- fitQmap(obs, exp, qstep = 0.01, method = "SSPLIN")
    qmap <- doQmap(exp, qm.fit)
  } else {
    stop ("Parameter 'method' doesn't match any of the available methods.")
  }  
  return(qmap)
  }
  ## functions bias correction CSTools
  # ?
  latlonApply <- function(obsV, expV, method) {
# print(dim(obsV))
# print(dim(expV))
# print(expV[,1,1])
    Apply(list(expV = expV, obsV = obsV), target_dims = 'time',
          fun = biascorrection, method = method)$output1} 
  qmap <- mapply(latlonApply, obs2, exp2, method)
  expAdjust = array(dim = dims)
  
  if (proxy == "dim") {
    expAdjust[predyn.exp$pred.dim$pos.d$d1,,] = qmap$d1.output1
    expAdjust[predyn.exp$pred.dim$pos.d$d2,,] = qmap$d2.output1
    expAdjust[predyn.exp$pred.dim$pos.d$d3,,] = qmap$d3.output1
  } else if(proxy == "theta") {
    expAdjust[predyn.exp$pred.theta$pos.t$th1,,] = qmap$th1.output1
    expAdjust[predyn.exp$pred.theta$pos.t$th2,,] = qmap$th2.output1
    expAdjust[predyn.exp$pred.theta$pos.t$th3,,] = qmap$th3.output1
  }
  
  return(list(expAdjust=expAdjust))
}


exp <- expL
obs <- obsL
time_dim = 'time'
res <- Apply(list(exp, obs), target_dims = time_dim,
      fun = .dynbias, proxy, method, predyn.exp = predyn.exp$pred.dim$pos.d, 
      predyn.obs = predyn.obs$pred.dim$pos.d)#$output1
.dynbias <- function(exp, obs, proxy, method, predyn.exp, predyn.obs) {
   result <- array(rep(NA, length(exp)))
   res <- lapply(1, function(x) {
     exp_sub <- exp[predyn.exp[[x]]]
     obs_sub <- obs[predyn.obs[[x]]]
     adjust <- .qbiascorrection(obs_sub, exp_sub, method)
     result[predyn.exp[[x]]] <<- adjust
     return(list(predyn.exp[[x]], exp_sub, obs_sub, adjust))
   })
   #return(result)
print(str(res))
return(res[[1]])
}   

.qbiascorrection <- function(obsX, expX, method){
  ## functions fitQmap and doQmap
  if (method == "PTF") {
    qm.fit <- fitQmap(obsX, expX, method = "PTF", transfun = "expasympt",
                      cost = "RSS", wett.day = TRUE)
    qmap <- doQmap(expX, qm.fit)
  } else if (method == "QUANT") {
    qm.fit <- fitQmap(obsX, expX, method = "QUANT", qstep = 0.01)
    qmap <- doQmap(expX, qm.fit, type = "tricub")
print(obsX)
print(expX)
print(qmap)
stop("HERE2")
  } else if (method == "RQUANT") {
    qm.fit <- fitQmap(obsX, expX, method = "RQUANT", qstep = 0.01)
    qmap <- doQmap(expX, qm.fit, type = "linear")
  } else if (method == "SSPLIN") {
    qm.fit <- fitQmap(obsX, expX, qstep = 0.01, method = "SSPLIN")
    qmap <- doQmap(expX, qm.fit)
  } else {
    stop ("Parameter 'method' doesn't match any of the available methods.")
  }
  return(qmap)
}

