#'Quantiles Mapping for seasonal or decadal forecast data
#'
#'@description This function is a wrapper from fitQmap and doQmap from package 'qmap'to be applied in CSTools objects of class 's2dv_cube'.
#'
#'@author Nuria Perez-Zanon, \email{nuria.perez@bsc.es}
#'@param exp an object of class \code{s2dv_cube}
#'@param obs an object of class \code{s2dv_cube}
#'@parma exp_cor an object of class \code{s2dv_cube} in which the quantile mapping correction should be applied. If it is not specified, the correction is applied in object 'exp'.
#'@param sample_dims a character vector indicating the dimensions that can be used as sample for the same distribution
#'@param sample_length a numeric value indicating the length of the timeseries window to be used as sample for the sample distribution and correction. By default, NULL, all the timeseries length will be used. To apply Quantile Mapping in a set of dimension that doesn't contain a time dimension, set samplelength as NULL.
#'@param method a character string indicating the method to be used: 'PTF','DIST','RQUANT','QUANT','SSPLIN'. By default, the empirical quantile mapping 'QUANT' is used.
#'@param wetday logical indicating whether to perform wet day correction or not. OR a numeric
#'@param qstep a numeric value between 0 and 1. The quantile mapping is fitted only for the quantiles defined by quantile(0,1,probs=seq(0,1,by=qstep).
#'@param type type of interpolation between the fitted transformed values. See details.
#'
#'@return an oject of class \code{s2dv_cube} containing the experimental data after applyingthe quantile mapping correction. 
#') <- c(dataset = 1, member = 10, sdate = 20, ftime = 60 , 
#'@import qmap
#'@import multiApply
#'
#'@seealso \code{\link[qmap]{fitQmap}} and \code{\link[qmap]{doQmap}}
#'@examples
#'exp$data <- 1 : c(1 * 10 * 20 * 60 * 6 * 7)
#'dim(exp$data) <- c(dataset = 1, member = 10, sdate = 20, ftime = 60 , 
#'                   lat = 6, lon = 7)
#'class(exp) <- 's2dv_cube'
#'obs$data <- 101 : c(100 + 1 * 1 * 20 * 60 * 6 * 7)
#'dim(obs$data) <- c(dataset = 1, member = 1, sdate = 20, ftime = 60 ,
#'                   lat = 6, lon = 7)
#'class(obs) <- 's2dv_cube'
#'res <- CST_QuantileMapping(exp, obs)
#'exp <- lonlat_data$exp
#'obs <- lonlat_data$obs
#'res <- CST_QuantileMapping(exp, obs)
#'@export
CST_QuantileMapping <- function(exp, obs, exp_cor = NULL, sample_dims = 'ftime', 
                                sample_length = NULL, method = 'QUANT', wetday = TRUE,
                                qstep = NULL, type = 'linear') {
    if (!inherits(exp, 's2dv_cube') || !inherits(exp, 's2dv_cube')) {
        stop("Parameter 'exp' and 'obs' must be of the class 's2dv_cube', ",
             "as output by CSTools::CST_Load.")
    }
    dimnames <- names(dim(exp$data))
    QMapped <- QuantileMapping(exp = exp$data, obs = obs$data, exp_cor = exp_cor,
                               sample_dims = sample_dims, sample_length = sample_length,
                               wetday = wetday, qstep = qstep, type = type)
    pos <- match(dimnames, names(dim(QMapped)))
    QMapped <- aperm(QMapped, pos)
    names(dim(QMapped)) <- dimnames 
    exp$data <- QMapped
    exp$Datasets <- c(exp$Datasets, obs$Datasets)
    exp$source_files <- c(exp$source_files, obs$source_files)
    return(exp)
}
QuantileMapping <- function(exp, obs, exp_cor = NULL, sample_dims = 'ftime', 
                            sample_length = NULL, method = 'QUANT',
                            wetday = TRUE, qstep = NULL, type = 'linear') {
  obsdims <- names(dim(obs))
  expdims <- names(dim(exp))
  if (is.null(expdims)) {
    stop("Parameter 'exp' musth have dimension names.")
  }
  if (is.null(obsdims)) {
    stop("Parameter 'obs' musth have dimension names.")
  }
  if (any(is.na(exp)))  {
    warning("Parameter 'exp' contains NA values.")
  }  
  if (any(is.na(obs))) {
    warning("Parameter 'obs' contains NA values.")
  }
  if (!is.null(exp_cor)) {
    exp_cordims <- names(dim(exp_cor))
    if (is.null(exp_cordims)) {
      stop("Parameter 'exp_cor' musth have dimension names.")
    }
  }
  if (!all(sample_dims %in% expdims)) {
    stop("Parameter 'sample_dims' must be a vector of string character ",
         "indicating names of exiting dimension in parameter 'exp'.")
  }
  if (!all(sample_dims %in% obsdims)) {
    newobsdims <- sample_dims[!sample_dims %in% obsdims]
    dim(obs) <- c(dim(obs), 1 : length(newobsdims))
    names(dim(obs))[-c(1:length(obsdims))] <- newobsdims
  } 
  if (!is.null(sample_length) & !is.numeric(sample_length)) {
    warning("Parameter 'sample_length' has not been correctly defined and ",
            "the whole length of the timeseries will be used.")
    sample_length <- NULL
  }
  if(length(sample_length) > 1)) {
    warning("Parameter 'sample_length' has length > 1 and only the first ",
            "element will be used.")
    sample_length <- sample_length[1]
  }
  if (!is.character(method)) {
    warning("Parameter 'method' must be a character string indicating ",
         "one of the following methods: 'PTF', 'DIST', 'RQUANT', 
         'QUANT', 'SSPLIN'. Method 'QUANT' is being used.")
    method = 'QUANT'
  }
  if (length(method) > 1) {
    warning("Parameter 'method' has length > 1 and only the first element",
            " is used.")
    method <- method[1]
  } 
  if (!is.logical(wetday)) { 
    stop("Parameter 'wetday' must be logical.")
  } 
  if (length(wetday) > 1) {
    warning("Parameter 'wetday' has length > 1 and only the first element",
            " is used.")
    wetday <- wetday[1]
  } 
  if (!is.numeric(qstep)) {
    stop("Parameter 'qstep' must be numeric.")
  }
  if (qstep > 1 | qstep < 0) {
    stop("Parameter 'qstep' must be a numeric value between 0 and 1.")
  }
  if (length(qstep) > 1) {
    warning("Parameter 'qstep' has length > 1 and oly the first element",
            " is used")
    qstep <- qstep[1]
  }
  if (!is.character(type)) {
     warning("Parameter 'type' must be a character indicating the interpolation",
             "method, 'linear' method will be used.")
     type <- 'linear'
  }
  if (length(type) > 1) {
    warning("Parameter 'type' has length > 1 and oly the first element",
            " is used")
    qstep <- type[1]
  }
  if (!any(type  %in% c('linear', 'tricube'))) {
    stop("Parameter 'type' is incorrectly defined and 'linear' method will",
          " be used.")
  }
  qmaped <- Apply(list(exp, obs), target_dims = sample_dims, fun = qmapcor,
                  exp_cor = exp_cor, sample_length = sample_length, method = method,
                  wetday = wetday, qstep = qstep, type = type)$output1
  pos <- match(expdims, names(dim(qmaped)))
  qmaped <- aperm(qmaped, pos)
  dim(qmaped) <- dim(exp)
  return(qmaped)
}
qmapcor <- function(exp, obs, exp_cor = NULL, sample_length = NULL, method = 'QUAN',
                    wetday = TRUE, qstep = NULL, type = 'linear') {
    if (is.null(exp_cor)) {
        exp_cor <- exp
    }
    if (is.null(sample_length)) {
        sample_length <- length(exp)
    }
    if ((is.null(sample_length) & (names(dim(exp)) %in% 'ftime' | names(dim(exp)) %in% 'time')) {
        time_dim <- which(names(dim(exp)) == 'ftime' | names(dim(exp)) %in% 'time')
        sample_length <- dim(exp)[time_dim]
    dim(exp) <- c(dim(exp)[-time_dim], sample = sample_length, 
                  periods = dim(exp)[time_dim]/sample_length)
    time_dim_obs <- which(names(dim(obs)) == 'ftime' | names(dim(obs)) %in% 'time')
    dim(obs) <- c(dim(obs)[-time_dim_obs], sample = sample_length, 
                  periods = dim(obs)[time_dim_obs]/sample_length)
    dajust <- Apply(list(obs, exp), ... by samples....
    adjust <- fitQmap(as.vector(obs), as.vector(exp), method = method,
                      wetday = wetday, qstep = qstep, type = type)
    # if it is null the dimensions can be different than time:
    } else if (is.null(sample_length)) {
        sample_length <- length(exp)
    }
    # if it is null no null to do
    if (is.null(exp_cor)) {
        exp_cor <- exp
    }

    applied <- doQmap(as.vector(exp_cor), adjust, type = type)	
    dim(applied) <- dim(exp_cor)   
    return(applied)
}
