#'Quaintiles 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}
#'@param 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 sdate_dim a character string indicating the dimension name in which cross-validation would be applied when exp_cor is not provided. 'sdate' by default. 
#'@param memb_dim a character string indicating the dimension name where ensemble members are stored in the experimental arrays. 'member' by default.
#'@param window_dim a character string indicating the dimension name where samples has been stored. It can be NULL (default) in case all samples are used.
#'@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 na.rm logical indicating ig missing values should be removed (FALSE by default). 
#'@param ncores an integer that indicates the number of cores for parallel computations using multiApply function. The default value is NULL (1).
#'@param ... additional parameters to be used by the method choosen. See qmap package.
#'
#'@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
#'@import s2dv
#'
#'@seealso \code{\link[qmap]{fitQmap}} and \code{\link[qmap]{doQmap}}
#'@examples
#'exp <- NULL
#'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, sdate_dim = 'sdate',
                                memb_dim = 'member', window_dim = NULL, 
                                method = 'QUANT', na.rm = FALSE, 
                                ncores = NULL, ...) {
    if (!inherits(exp, 's2dv_cube') || !inherits(obs, 's2dv_cube')) {
        stop("Parameter 'exp' and 'obs' must be of the class 's2dv_cube', ",
             "as output by CSTools::CST_Load.")
    }
    if (!is.null(exp_cor)) {
      if (!inherits(exp_cor, 's2dv_cube')) {
        stop("Parameter 'exp_cor' 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$data,
                               sdate_dim = sdate_dim, memb_dim = memb_dim,
                               window_dim = window_dim, method = method,
                               na.rm = na.rm, ncores = ncores, ...)
    exp$data <- QMapped
    exp$Datasets <- c(exp$Datasets, obs$Datasets)
    exp$source_files <- c(exp$source_files, obs$source_files)
    return(exp)
}
#'Quaintiles 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 a multidimensional array with named dimensions.
#'@param obs a multidimensional array with named dimensions.
#'@param exp_cor a multidimensional array with named dimensions in which the quantile mapping correction should be applied. If it is not specified, the correction is applied in object 'exp'.
#'@param sdate_dim a character string indicating the dimension name in which cross-validation would be applied when exp_cor is not provided. 'sdate' by default. 
#'@param memb_dim a character string indicating the dimension name where ensemble members are stored in the experimental arrays. 'member' by default.
#'@param window_dim a character string indicating the dimension name where samples has been stored. It can be NULL (default) in case all samples are used.
#'@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 na.rm logical indicating ig missing values should be removed (FALSE by default). 
#'@param ncores an integer that indicates the number of cores for parallel computations using multiApply function. The default value is NULL (1).
#'@param ... additional parameters to be used by the method choosen. See qmap package.
#'
#'@return an array containing the experimental data after applyingthe quantile mapping correction. 
#') <- c(dataset = 1, member = 10, sdate = 20, ftime = 60 , 
#'@import qmap
#'@import multiApply
#'@import s2dv
#'
#'@seealso \code{\link[qmap]{fitQmap}} and \code{\link[qmap]{doQmap}}
#'@examples
#'exp <- 1 : c(1 * 10 * 20 * 60 * 6 * 7)
#'dim(exp) <- c(dataset = 1, member = 10, sdate = 20, ftime = 60 , 
#'                   lat = 6, lon = 7)
#'class(exp) <- 's2dv_cube'
#'obs <- 101 : c(100 + 1 * 1 * 20 * 60 * 6 * 7)
#'dim(obs) <- c(dataset = 1, member = 1, sdate = 20, ftime = 60 ,
#'                   lat = 6, lon = 7)
#'res <- QuantileMapping(exp, obs)
#'exp <- lonlat_data$exp$data
#'obs <- lonlat_data$obs$data
#'res <- QuantileMapping(exp, obs)
#'@export

QuantileMapping <- function(exp, obs, exp_cor = NULL, sdate_dim = 'sdate',
                            memb_dim = 'member', window_dim = NULL, 
                            method = 'QUANT',
                            na.rm = FALSE, ncores = NULL, ...) {
  obsdims <- names(dim(obs))
  expdims <- names(dim(exp))
  if (is.null(expdims)) {
    stop("Parameter 'exp' must have dimension names.")
  }
  if (is.null(obsdims)) {
    stop("Parameter 'obs' must have dimension names.")
  }
  if (!is.null(exp_cor)) {
    exp_cordims <- names(dim(exp_cor))
    if (is.null(exp_cordims)) {
      stop("Parameter 'exp_cor' must have dimension names.")
    }
  }
  if (!(method %in% c('PTF','DIST','RQUANT','QUANT','SSPLIN'))){
    stop("Parameter 'method' must be one of the following methods: ",
         "'PTF','DIST','RQUANT','QUANT','SSPLIN'.")
  }   
  if (!all(memb_dim %in% obsdims)) {
    obs <- InsertDim(obs, posdim = 1, lendim = 1,
                     name = memb_dim[!(memb_dim %in% obsdims)])
  }
  if (!is.null(window_dim)) {
    if (!(window_dim %in% obsdims)) {
      stop("Dimension 'window_dim' not found in 'obs'.")
    }
    obs <- CSTools::MergeDims(obs, c(memb_dim, window_dim))
    if (window_dim %in% expdims) {
      exp <- CSTools::MergeDims(exp, c(memb_dim, window_dim))
      warning("window_dim found in exp and it is merged to memb_dim.")
    }
  }
  sample_dims <- c(memb_dim, sdate_dim)
  if (!all(sample_dims %in% expdims)) {
    stop("Parameter 'exp' requires 'sdate_dim' and 'member_dim' dimensions.")  
  }
  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.null(exp_cor)) {
    qmaped <- Apply(list(exp, obs, exp_cor), target_dims = sample_dims, 
                    fun = .qmapcor, method = method, na.rm = na.rm, ..., 
                    ncores = ncores)$output1
  } else {
    qmaped <- Apply(list(exp, obs), target_dims = sample_dims,
                    fun = .qmapcor, exp_cor = NULL, method = method,
                    na.rm = na.rm, ...,                
                    ncores = ncores)$output1
  } 
  return(qmaped)
}
.qmapcor <- function(exp, obs, exp_cor = NULL, method = 'QUANT', na.rm = FALSE,
                    ...) {
  # exp[memb, sdate]
  # obs[window, sdate] 
  if (is.null(exp_cor)) {
    applied <- exp * NA
    for (sd in 1:dim(exp)['sdate']) {
      if (na.rm) {  
        # select start date for cross-val
        nas_pos <- which(!is.na(exp[,sd]))
        obs2 <- as.vector(obs[,-sd])
        exp2 <- as.vector(exp[,-sd])
        exp_cor2 <- as.vector(exp[,sd])
        # remove NAs
        obs2 <- obs2[!is.na(obs2)]
        exp2 <- exp2[!is.na(exp2)]   
        exp_cor2 <- exp_cor2[!is.na(exp_cor2)]
        tryCatch({
          adjust <- fitQmap(obs2, exp2, method = method, ...)
          applied[nas_pos, sd] <- doQmap(exp_cor2, adjust, ...)
          }, 
          error = function(error_message) {
            return(applied[,sd])
          })
      } else {
        # na.rm = FALSE shouldn't fail, just return NA
        if (anyNA(obs[,-sd]) | anyNA(exp[,-sd])) {
          applied[,sd] <- NA
        } else {
          adjust <- fitQmap(as.vector(obs[,-sd]), as.vector(exp[,-sd]),
                            method = method, ...)
          exp2 <- exp[,sd]
          if (sum(is.na(exp2)) >= 1) {
            app <- rep(NA, length(exp2))
            nas_pos <- which(is.na(exp2))
            exp2 <- exp2[!is.na(exp2)]
            app[-nas_pos]<- doQmap(as.vector(exp2), adjust, ...)
          } else {
            app <- doQmap(as.vector(exp2), adjust, ...)
          }
          applied[,sd] <- app
        }
      }
    }
    names(dim(applied)) <- names(dim(exp))
  } else {
   applied <- exp_cor * NA
     if (na.rm) {
        tryCatch({
          adjust <- fitQmap(obs[!is.na(obs)], exp[!is.na(exp)],
                            method = method, ...)
          applied[!is.na(exp_cor)] <- doQmap(exp_cor[!is.na(exp_cor)],
                                             adjust, ...)
          },
          error = function(error_message) {
            return(applied)
          })
     } else {
        adjust <- fitQmap(as.vector(obs), as.vector(exp), method = method, ...)
        applied <- doQmap(as.vector(exp_cor), adjust, ...)
     }
     dim(applied) <- length(applied)
     names(dim(applied)) <- names(dim(exp_cor))[1]
  }
  return(applied)
}


