From 04ef77a8119b50ae4b9e5774102fd77332f53eb6 Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Wed, 9 Oct 2019 20:04:41 +0200
Subject: [PATCH 01/26] QuantileMapping function needs dim correction

---
 R/CST_QuantileMapping.R | 123 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 123 insertions(+)
 create mode 100644 R/CST_QuantileMapping.R

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
new file mode 100644
index 00000000..683da9a7
--- /dev/null
+++ b/R/CST_QuantileMapping.R
@@ -0,0 +1,123 @@
+#'Quantiles Mapping for seasonal or decadal forecast data
+#'
+#'@description This function is a wrapper from fitQmapQUANT and doQmapQUANT 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
+#'@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]{fitQmapQUANT}} and \code{\link[qmap]{doQmapQUANT}}
+#'@examples
+#'exp$data <- runif(n = 1 * 10 * 20 * 60 * 6 * 7, min = 0, max = 5)
+#'dim(exp$data) <- c(dataset = 1, member = 10, sdate = 20, ftime = 60 , 
+#'                   lat = 6, lon = 7)
+#'class(exp) <- 's2dv_cube'
+#'obs$data <- runif(n = 1 * 1 * 20 * 60 * 6 * 7, min = 0, max = 5)
+#'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, wetday = TRUE, qstep = 0.1,
+                                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 <- QuantileMappingCor(exp = exp$data, obs = obs$data, 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)
+}
+exp <- 1:20
+dim(exp) <- c(lat = 2, lon = 10)
+obs <- 101:120
+dim(obs) <- c(lat = 2, lon = 10)
+QuantileMappingCor(exp, obs)
+exp <- 1:20
+dim(exp) <- c(lat = 2, lon = 5, member = 2)
+obs <- 101:120
+dim(obs) <- c(lat = 2, lon = 5, member = 2)
+QuantileMappingCor(exp, obs)
+QuantileMappingCor <- function(exp, obs, wetday = TRUE, qstep = 0.1,
+                               type = 'linear') {
+  if (!all(c('lat', 'lon') %in% names(dim(exp)))) {
+    stop("Parameter 'exp' must have the dimensions 'lat' and 'lon'.")
+  }
+
+  if (!all(c('lat', 'lon') %in% names(dim(obs)))) {
+    stop("Parameter 'obs' must have the dimension 'lat' and 'lon.")
+  }
+  if (any(is.na(exp)))  {
+    warning("Parameter 'exp' contains NA values.")
+  }  
+  if (any(is.na(obs))) {
+    warning("Parameter 'obs' contains NA values.")
+  }
+  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 = c('lat', 'lon'), 
+                  fun = qmapcor, wetday = wetday, qstep = qstep,
+                  type = type)$output1
+  return(qmaped)
+}
+#exp <- 1:10
+#obs <- 1:20
+qmapcor <- function(exp, obs, wetday = TRUE, qstep = 0.1, type = 'linear') {
+  adjust <- fitQmapQUANT(obs, exp, wetday = wetday, qstep = qstep, type = type) 
+  applied <- doQmapQUANT(exp, adjust, type = type)	
+  return(applied)
+}
+
+
+
+
-- 
GitLab


From c058dce333ac7431299f6e528c79ee9fcfcbd835 Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Fri, 11 Oct 2019 16:06:20 +0200
Subject: [PATCH 02/26] multiple methods added

---
 R/CST_QuantileMapping.R | 102 +++++++++++++++++++++++++---------------
 1 file changed, 64 insertions(+), 38 deletions(-)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index 683da9a7..c2ac935f 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -1,10 +1,13 @@
 #'Quantiles Mapping for seasonal or decadal forecast data
 #'
-#'@description This function is a wrapper from fitQmapQUANT and doQmapQUANT from package 'qmap'to be applied in CSTools objects of class 's2dv_cube'.
+#'@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
+#'@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 sampledims a character vector indicating the dimensions that can be used as sample for the probabilit
+#'@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.
@@ -14,13 +17,13 @@
 #'@import qmap
 #'@import multiApply
 #'
-#'@seealso \code{\link[qmap]{fitQmapQUANT}} and \code{\link[qmap]{doQmapQUANT}}
+#'@seealso \code{\link[qmap]{fitQmap}} and \code{\link[qmap]{doQmap}}
 #'@examples
-#'exp$data <- runif(n = 1 * 10 * 20 * 60 * 6 * 7, min = 0, max = 5)
+#'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 <- runif(n = 1 * 1 * 20 * 60 * 6 * 7, min = 0, max = 5)
+#'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'
@@ -29,15 +32,17 @@
 #'obs <- lonlat_data$obs
 #'res <- CST_QuantileMapping(exp, obs)
 #'@export
-CST_QuantileMapping <- function(exp, obs, wetday = TRUE, qstep = 0.1,
+CST_QuantileMapping <- function(exp, obs, exp_cor = NULL, sampledims = c('member', 'ftime'), 
+                                method = 'QUANT', wetday = TRUE, qstep = 0.1,
                                 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 <- QuantileMappingCor(exp = exp$data, obs = obs$data, wetday = wetday,
-                                  qstep = qstep, type = type)
+    QMapped <- QuantileMapping(exp = exp$data, obs = obs$data, exp_cor = exp_cor,
+                               sampledims = sampledims, wetday = wetday,
+                               qstep = qstep, type = type)
     pos <- match(dimnames, names(dim(QMapped)))
 
     QMapped <- aperm(QMapped, pos)
@@ -47,24 +52,16 @@ CST_QuantileMapping <- function(exp, obs, wetday = TRUE, qstep = 0.1,
     exp$source_files <- c(exp$source_files, obs$source_files)
     return(exp)
 }
-exp <- 1:20
-dim(exp) <- c(lat = 2, lon = 10)
-obs <- 101:120
-dim(obs) <- c(lat = 2, lon = 10)
-QuantileMappingCor(exp, obs)
-exp <- 1:20
-dim(exp) <- c(lat = 2, lon = 5, member = 2)
-obs <- 101:120
-dim(obs) <- c(lat = 2, lon = 5, member = 2)
-QuantileMappingCor(exp, obs)
-QuantileMappingCor <- function(exp, obs, wetday = TRUE, qstep = 0.1,
-                               type = 'linear') {
-  if (!all(c('lat', 'lon') %in% names(dim(exp)))) {
-    stop("Parameter 'exp' must have the dimensions 'lat' and 'lon'.")
+QuantileMapping <- function(exp, obs, exp_cor = NULL, sampledims = 'time', 
+                            method = 'QUANT', wetday = TRUE, qstep = 0.1,
+                            type = 'linear') {
+  obsdims <- names(dim(obs))
+  expdims <- names(dim(exp))
+  if (is.null(expdims)) {
+    stop("Parameter 'exp' musth have dimension names.")
   }
-
-  if (!all(c('lat', 'lon') %in% names(dim(obs)))) {
-    stop("Parameter 'obs' must have the dimension 'lat' and 'lon.")
+  if (is.null(obsdims)) {
+    stop("Parameter 'obs' musth have dimension names.")
   }
   if (any(is.na(exp)))  {
     warning("Parameter 'exp' contains NA values.")
@@ -72,6 +69,32 @@ QuantileMappingCor <- function(exp, obs, wetday = TRUE, qstep = 0.1,
   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(sampledims %in% expdims)) {
+    stop("Parameter 'sampledims' must be a vector of string character ",
+         "indicating names of exiting dimension in parameter 'exp'.")
+  }
+  if (!all(sampledims %in% obsdims)) {
+    newobsdims <- sampledims[!sampledims %in% obsdims]
+    dim(obs) <- c(dim(obs), 1 : length(newobsdims))
+    names(dim(obs))[-c(1:length(obsdims))] <- newobsdims
+  } 
+  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.")
   } 
@@ -104,20 +127,23 @@ QuantileMappingCor <- function(exp, obs, wetday = TRUE, qstep = 0.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 = c('lat', 'lon'), 
-                  fun = qmapcor, wetday = wetday, qstep = qstep,
+  }
+  qmaped <- Apply(list(exp, obs), target_dims = sampledims, 
+                  fun = qmapcor, exp_cor = exp_cor, 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)
 }
-#exp <- 1:10
-#obs <- 1:20
-qmapcor <- function(exp, obs, wetday = TRUE, qstep = 0.1, type = 'linear') {
-  adjust <- fitQmapQUANT(obs, exp, wetday = wetday, qstep = qstep, type = type) 
-  applied <- doQmapQUANT(exp, adjust, type = type)	
-  return(applied)
+qmapcor <- function(exp, obs, exp_cor = NULL, method = 'QUAN',
+                    wetday = TRUE, qstep = 0.1, type = 'linear') {
+    if (is.null(exp_cor)) {
+        exp_cor <- exp
+    }
+    adjust <- fitQmap(as.vector(obs), as.vector(exp), method = method,
+                      wetday = wetday, qstep = qstep, type = type)
+    applied <- doQmap(as.vector(exp_cor), adjust, type = type)	
+    dim(applied) <- dim(exp_cor)   
+    return(applied)
 }
-
-
-
-
-- 
GitLab


From e496a74fb2bfe4721519fe16b415af552d75846f Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Fri, 11 Oct 2019 18:11:34 +0200
Subject: [PATCH 03/26] adding sample_length parameter

---
 R/CST_QuantileMapping.R | 69 +++++++++++++++++++++++++++++------------
 1 file changed, 50 insertions(+), 19 deletions(-)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index c2ac935f..6d002b97 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -6,7 +6,8 @@
 #'@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 sampledims a character vector indicating the dimensions that can be used as sample for the probabilit
+#'@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).
@@ -32,19 +33,18 @@
 #'obs <- lonlat_data$obs
 #'res <- CST_QuantileMapping(exp, obs)
 #'@export
-CST_QuantileMapping <- function(exp, obs, exp_cor = NULL, sampledims = c('member', 'ftime'), 
-                                method = 'QUANT', wetday = TRUE, qstep = 0.1,
-                                type = 'linear') {
+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,
-                               sampledims = sampledims, wetday = wetday,
-                               qstep = qstep, type = type)
+                               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
@@ -52,9 +52,9 @@ CST_QuantileMapping <- function(exp, obs, exp_cor = NULL, sampledims = c('member
     exp$source_files <- c(exp$source_files, obs$source_files)
     return(exp)
 }
-QuantileMapping <- function(exp, obs, exp_cor = NULL, sampledims = 'time', 
-                            method = 'QUANT', wetday = TRUE, qstep = 0.1,
-                            type = 'linear') {
+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)) {
@@ -75,15 +75,25 @@ QuantileMapping <- function(exp, obs, exp_cor = NULL, sampledims = 'time',
       stop("Parameter 'exp_cor' musth have dimension names.")
     }
   }
-  if (!all(sampledims %in% expdims)) {
-    stop("Parameter 'sampledims' must be a vector of string character ",
+  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(sampledims %in% obsdims)) {
-    newobsdims <- sampledims[!sampledims %in% obsdims]
+  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', 
@@ -128,21 +138,42 @@ QuantileMapping <- function(exp, obs, exp_cor = NULL, sampledims = 'time',
     stop("Parameter 'type' is incorrectly defined and 'linear' method will",
           " be used.")
   }
-  qmaped <- Apply(list(exp, obs), target_dims = sampledims, 
-                  fun = qmapcor, exp_cor = exp_cor, method = method, wetday = wetday, qstep = qstep,
-                  type = type)$output1
+  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, method = 'QUAN',
-                    wetday = TRUE, qstep = 0.1, type = 'linear') {
+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)
-- 
GitLab


From e1f44fd47114ddc8f4f661428ab2ce1aa332a5ae Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Wed, 16 Oct 2019 19:53:34 +0200
Subject: [PATCH 04/26] Parameter sample_length added

---
 NAMESPACE                  |   3 +
 R/CST_QuantileMapping.R    | 193 +++++++++++++++++++++++--------------
 man/CST_QuantileMapping.Rd |  63 ++++++++++++
 3 files changed, 188 insertions(+), 71 deletions(-)
 create mode 100644 man/CST_QuantileMapping.Rd

diff --git a/NAMESPACE b/NAMESPACE
index ef0bfd71..cbaa0d3c 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -6,6 +6,7 @@ export(CST_Calibration)
 export(CST_Load)
 export(CST_MultiMetric)
 export(CST_MultivarRMSE)
+export(CST_QuantileMapping)
 export(CST_RFSlope)
 export(CST_RFWeights)
 export(CST_RainFARM)
@@ -14,9 +15,11 @@ export(PlotForecastPDF)
 export(PlotMostLikelyQuantileMap)
 export(RFSlope)
 export(RainFARM)
+import(abind)
 import(ggplot2)
 import(multiApply)
 import(ncdf4)
+import(qmap)
 import(rainfarmr)
 import(s2dverification)
 import(stats)
diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index 6d002b97..a91ebb32 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -1,22 +1,30 @@
 #'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'.
+#'@description This function is a wrapper from fitQmap and doQmap from package 'qmap'to be applied in CSTools objects of class 's2dv_cube'. The quantile mapping adjustment between an experiment, tipically a hindcast, and observations is applied to the experiment itself or to a provided forecast.
 #'
 #'@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 exp_cor an object of class \code{s2dv_cube} in which the quantile mapping correction will 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.
+#'@param ... additional arguments passed to the method specified by method.
 #'
+#'@details The different methods are: 
+#'\item{'PTF'} {fits a parametric transformations to the quantile-quantile relation of observed and modelled values. See \code{\link[qmap]{fitQmapPTF}}}
+#' \item{'DIST'} {fits a theoretical distribution to observed and to modelled time series. See \code{\link[qmap]{fitQmapDIST}}}
+#'\item{'RQUANT'} {estimates the values of the quantile-quantile relation of observed and modelled time series for regularly spaced quantiles using local linear least square regression. See \code{\link[qmap]{fitQmapRQUANT}}}
+#'\item{'QUANT'} {estimates values of the empirical cumulative distribution function of observed and modelled time series for regularly spaced quantiles. See \code{\link[qmap]{fitQmapQUANT}}}
+#'\item{'SSPLIN'} {fits a smoothing spline to the quantile-quantile plot of observed and modelled time series. See \code{\link[qmap]{fitQmapSSPLIN}}}
+#'All methods accepts some common arguments:
+#'\item{wet.day} {logical indicating whether to perform wet day correction or not.(Not available in 'DIS' method)}
+#'\item{qstep} {NULL or a numeric value between 0 and 1.}
 #'@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 abind
 #'
 #'@seealso \code{\link[qmap]{fitQmap}} and \code{\link[qmap]{doQmap}}
 #'@examples
@@ -33,9 +41,9 @@
 #'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') {
+CST_QuantileMapping <- function(exp, obs, exp_cor = NULL,
+                                sample_dims = c('sdate', 'ftime', 'member'), 
+                                sample_length = NULL, method = 'QUANT', ...  ) {
     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.")
@@ -43,7 +51,7 @@ CST_QuantileMapping <- function(exp, obs, exp_cor = NULL, sample_dims = 'ftime',
     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 
@@ -53,8 +61,7 @@ CST_QuantileMapping <- function(exp, obs, exp_cor = NULL, sample_dims = 'ftime',
     return(exp)
 }
 QuantileMapping <- function(exp, obs, exp_cor = NULL, sample_dims = 'ftime', 
-                            sample_length = NULL, method = 'QUANT',
-                            wetday = TRUE, qstep = NULL, type = 'linear') {
+                            sample_length = NULL, method = 'QUANT', ...) {
   obsdims <- names(dim(obs))
   expdims <- names(dim(exp))
   if (is.null(expdims)) {
@@ -89,7 +96,7 @@ QuantileMapping <- function(exp, obs, exp_cor = NULL, sample_dims = 'ftime',
             "the whole length of the timeseries will be used.")
     sample_length <- NULL
   }
-  if(length(sample_length) > 1)) {
+  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]
@@ -104,77 +111,121 @@ QuantileMapping <- function(exp, obs, exp_cor = NULL, sample_dims = 'ftime',
     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
+  qmaped <- Apply(list(exp, obs), target_dims = sample_dims, fun = qmapcor, ...,  
+                  exp_cor = exp_cor, sample_length = sample_length, method = method)$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
+qmapcor <- function(exp, obs, exp_cor = NULL, sample_length = NULL, method = 'QUANT',
+                    ...) {
+    dimnames_exp <- names(dim(exp))
+    dimnames_obs <- names(dim(obs))
+    if (length(dimnames_exp) != length(dimnames_obs)) {
+        stop("Parameters 'exp' and 'obs' must have the same number of dimensions.")
     }
-    if (is.null(sample_length)) {
-        sample_length <- length(exp)
+    if (!all(dimnames_exp %in% dimnames_obs)) {
+        stop("Parameters 'exp' and 'obs' musht have the same dimension names.")
+    } 
+    if (!(any(names(dim(exp)) %in% 'ftime') | any(names(dim(exp)) %in% 'time'))) {
+        stop("Parameters 'exp' and 'obs' must have a time dimension named ",
+             "'time' or 'ftime'.")
     }
-    if ((is.null(sample_length) & (names(dim(exp)) %in% 'ftime' | names(dim(exp)) %in% 'time')) {
+    
+    dimensions <- dim(exp)
+    if(!is.null(exp_cor)) {
+        dimensions <- dim(exp_cor)
+    }        
+    if (is.null(sample_length)) {
         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 <- which(names(dim(exp)) == 'ftime' | names(dim(exp)) %in% 'time')
+    nsamples <- 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 (nsamples %% 1 != 0) { 
+        # add NA to complete the last sample
+        nsamples <- ceiling(nsamples)
+        fillsample1D <- rep(NA, nsamples * sample_length -  dim(exp)[time_dim])
+        if (length(dim(exp)) > 1) {
+            fillsample <- rep(fillsample1D, prod(dim(exp)[-time_dim]))
+            dims <- dim(exp)
+            exp <- c(exp, fillsample)
+            dim(exp) <- c(dims[-time_dim], sample = sample_length, 
+                          ceiling(dims[time_dim]/sample_length))
+            fillsample <- rep(fillsample1D, prod(dim(obs)[-time_dim_obs]))
+            dims <- dim(obs)
+            obs <- c(obs, fillsample)
+            dim(obs) <- c(dims[-time_dim_obs], sample = sample_length,
+                          ceiling(dims[time_dim_obs]/sample_length))
+         } else {
+            exp <- abind(exp, fillsample1D, along = time_dim)
+            names(dim(exp)) <- dimnames_exp
+            obs <- abind(obs, fillsample1D, along = time_dim_obs)
+            names(dim(obs)) <- dimnames_obs
+            dim(exp) <- c(dim(exp)[-time_dim], sample = sample_length,
+                          dim(exp)[time_dim]/sample_length)
+            dim(obs) <- c(dim(obs)[-time_dim_obs], sample = sample_length,
+                          dim(obs)[time_dim_obs]/sample_length)
+         }
+    } else {
+            dim(exp) <- c(dim(exp)[-time_dim], sample = sample_length,
+                          dim(exp)[time_dim]/sample_length)
+            dim(obs) <- c(dim(obs)[-time_dim_obs], sample = sample_length,
+                          dim(obs)[time_dim_obs]/sample_length)          
     }
-    # if it is null no null to do
-    if (is.null(exp_cor)) {
+    new_time_dim_obs <- which(names(dim(obs)) == 'ftime' | names(dim(obs)) %in% 'time')
+    new_time_dim_exp <- which(names(dim(exp)) == 'ftime' | names(dim(exp)) %in% 'time')
+    if (!is.null(exp_cor)) {
+        time_dim_cor <- which(names(dim(exp_cor)) == 'ftime' | names(dim(exp_cor)) %in% 'time')
+        nsamples <- dimensions[time_dim_cor]/sample_length
+        if (nsamples %% 1 != 0) {
+        nsamples <- ceiling(nsamples)
+        fillsample1D <- rep(NA, nsamples * sample_length -  dimensions[time_dim_cor])
+            if (length(dimensions) > 1) {
+                fillsample <- rep(fillsample1D, prod(dimensions[-time_dim_cor]))
+                 exp_cor <- c(exp_cor, fillsample)
+                 dim(exp_cor) <- c(dim(exp_cor)[-time_dim_cor], sample = sample_length,
+                               ceiling(dim(exp_cor)[time_dim_cor]/sample_length))
+             } else {
+                exp_cor <- abind(exp_cor, fillsample1D, along = time_dim_cor)
+                names(dim(exp_cor)) <- names(dimensions)
+             }
+        }  
+        dim(exp_cor) <- c(dim(exp_cor)[-time_dim_cor], sample = sample_length,
+                          dim(exp_cor)[time_dim_cor]/sample_length)
+        new_time_dim_cor <- which(names(dim(exp_cor)) == 'ftime' | 
+                                  names(dim(exp_cor)) %in% 'time')
+    } else {
+        time_dim_cor <- time_dim
         exp_cor <- exp
+        new_time_dim_cor  <- new_time_dim_exp
+    }
+    applied <- NULL
+    for (i in 1 : nsamples) {
+        if (i <= dim(obs)[new_time_dim_obs]) {
+            sample_obs <- as.vector(asub(obs, idx = i, dims = new_time_dim_obs))
+            sample_exp <- as.vector(asub(exp, idx = i, dims = new_time_dim_exp))
+        } else {
+            sample_obs <- as.vector(asub(obs, idx = dim(obs)[new_time_dim_obs],
+                                    dims = new_time_dim_obs))
+            sample_exp <- as.vector(asub(exp, idx = dim(exp)[new_time_dim_exp],
+                                    dims = new_time_dim_exp))
+        }
+        if (i >= dim(obs)[new_time_dim_obs]) {
+            sample_obs <- sample_obs[!is.na(sample_obs)]
+            sample_exp <- sample_exp[!is.na(sample_exp)]
+        }
+        adjust <- fitQmap(sample_obs, sample_exp, method = method,
+                          ...)
+        sample_cor <- as.vector(asub(exp_cor, idx = i, dims = new_time_dim_cor))
+        if (i == nsamples) {
+            sample_cor <- sample_cor[!is.na(sample_cor)]
+        }
+        applied <- c(applied, doQmap(sample_cor, adjust, ...))
     }
-
-    applied <- doQmap(as.vector(exp_cor), adjust, type = type)	
-    dim(applied) <- dim(exp_cor)   
-    return(applied)
+    dim(applied) <- dimensions
+    return(applied) 
 }
diff --git a/man/CST_QuantileMapping.Rd b/man/CST_QuantileMapping.Rd
new file mode 100644
index 00000000..fb6314d6
--- /dev/null
+++ b/man/CST_QuantileMapping.Rd
@@ -0,0 +1,63 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/CST_QuantileMapping.R
+\name{CST_QuantileMapping}
+\alias{CST_QuantileMapping}
+\title{Quantiles Mapping for seasonal or decadal forecast data}
+\usage{
+CST_QuantileMapping(exp, obs, exp_cor = NULL, sample_dims = c("sdate",
+  "ftime", "member"), sample_length = NULL, method = "QUANT", ...)
+}
+\arguments{
+\item{exp}{an object of class \code{s2dv_cube}}
+
+\item{obs}{an object of class \code{s2dv_cube}}
+
+\item{exp_cor}{an object of class \code{s2dv_cube} in which the quantile mapping correction will be applied. If it is not specified, the correction is applied in object 'exp'.}
+
+\item{sample_dims}{a character vector indicating the dimensions that can be used as sample for the same distribution}
+
+\item{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.}
+
+\item{method}{a character string indicating the method to be used: 'PTF','DIST','RQUANT','QUANT','SSPLIN'. By default, the empirical quantile mapping 'QUANT' is used.}
+
+\item{...}{additional arguments passed to the method specified by method.}
+}
+\value{
+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 ,
+}
+\description{
+This function is a wrapper from fitQmap and doQmap from package 'qmap'to be applied in CSTools objects of class 's2dv_cube'. The quantile mapping adjustment between an experiment, tipically a hindcast, and observations is applied to the experiment itself or to a provided forecast.
+}
+\details{
+The different methods are: 
+\item{'PTF'} {fits a parametric transformations to the quantile-quantile relation of observed and modelled values. See \code{\link[qmap]{fitQmapPTF}}}
+\item{'DIST'} {fits a theoretical distribution to observed and to modelled time series. See \code{\link[qmap]{fitQmapDIST}}}
+\item{'RQUANT'} {estimates the values of the quantile-quantile relation of observed and modelled time series for regularly spaced quantiles using local linear least square regression. See \code{\link[qmap]{fitQmapRQUANT}}}
+\item{'QUANT'} {estimates values of the empirical cumulative distribution function of observed and modelled time series for regularly spaced quantiles. See \code{\link[qmap]{fitQmapQUANT}}}
+\item{'SSPLIN'} {fits a smoothing spline to the quantile-quantile plot of observed and modelled time series. See \code{\link[qmap]{fitQmapSSPLIN}}}
+All methods accepts some common arguments:
+\item{wet.day} {logical indicating whether to perform wet day correction or not.(Not available in 'DIS' method)}
+\item{qstep} {NULL or a numeric value between 0 and 1.}
+}
+\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)
+}
+\author{
+Nuria Perez-Zanon, \email{nuria.perez@bsc.es}
+}
+\seealso{
+\code{\link[qmap]{fitQmap}} and \code{\link[qmap]{doQmap}}
+}
+
-- 
GitLab


From fc9bc29ff3b05ca957075370eb96d87dc11bf1ec Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Wed, 16 Oct 2019 20:28:03 +0200
Subject: [PATCH 05/26] qmap dependency added and formatting

---
 DESCRIPTION                |  1 +
 R/CST_QuantileMapping.R    | 22 ++++++++++++----------
 man/CST_QuantileMapping.Rd | 22 ++++++++++++----------
 3 files changed, 25 insertions(+), 20 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 23fafc4c..81dba42d 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -34,6 +34,7 @@ Imports:
     s2dverification,
     rainfarmr,
     multiApply,
+    qmap,
     ncdf4,
     plyr,
     abind,
diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index a91ebb32..f3d923ef 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -5,21 +5,23 @@
 #'@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 will be applied. If it is not specified, the correction is applied in object 'exp'.
+#'@param exp_cor an object of class \code{s2dv_cube} in which the quantile mapping correction will be applied. If it is not specified, the correction is applied in object \code{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 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, the total length of the timeseries will be 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 ... additional arguments passed to the method specified by method.
+#'@param ... additional arguments passed to the method specified by \code{method}.
 #'
-#'@details The different methods are: 
-#'\item{'PTF'} {fits a parametric transformations to the quantile-quantile relation of observed and modelled values. See \code{\link[qmap]{fitQmapPTF}}}
-#' \item{'DIST'} {fits a theoretical distribution to observed and to modelled time series. See \code{\link[qmap]{fitQmapDIST}}}
-#'\item{'RQUANT'} {estimates the values of the quantile-quantile relation of observed and modelled time series for regularly spaced quantiles using local linear least square regression. See \code{\link[qmap]{fitQmapRQUANT}}}
-#'\item{'QUANT'} {estimates values of the empirical cumulative distribution function of observed and modelled time series for regularly spaced quantiles. See \code{\link[qmap]{fitQmapQUANT}}}
-#'\item{'SSPLIN'} {fits a smoothing spline to the quantile-quantile plot of observed and modelled time series. See \code{\link[qmap]{fitQmapSSPLIN}}}
+#'@details The different methods are:
+#'\itemize{ 
+#'\item{'PTF'} {fits a parametric transformations to the quantile-quantile relation of observed and modelled values. See \code{\link[qmap]{fitQmapPTF}}.}
+#' \item{'DIST'} {fits a theoretical distribution to observed and to modelled time series. See \code{\link[qmap]{fitQmapDIST}}.}
+#'\item{'RQUANT'} {estimates the values of the quantile-quantile relation of observed and modelled time series for regularly spaced quantiles using local linear least square regression. See \code{\link[qmap]{fitQmapRQUANT}}.}
+#'\item{'QUANT'} {estimates values of the empirical cumulative distribution function of observed and modelled time series for regularly spaced quantiles. See \code{\link[qmap]{fitQmapQUANT}}.}
+#'\item{'SSPLIN'} {fits a smoothing spline to the quantile-quantile plot of observed and modelled time series. See \code{\link[qmap]{fitQmapSSPLIN}}}.}
 #'All methods accepts some common arguments:
+#'\itemize{
 #'\item{wet.day} {logical indicating whether to perform wet day correction or not.(Not available in 'DIS' method)}
-#'\item{qstep} {NULL or a numeric value between 0 and 1.}
+#'\item{qstep} {NULL or a numeric value between 0 and 1.}}
 #'@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
diff --git a/man/CST_QuantileMapping.Rd b/man/CST_QuantileMapping.Rd
index fb6314d6..b2899dd1 100644
--- a/man/CST_QuantileMapping.Rd
+++ b/man/CST_QuantileMapping.Rd
@@ -12,15 +12,15 @@ CST_QuantileMapping(exp, obs, exp_cor = NULL, sample_dims = c("sdate",
 
 \item{obs}{an object of class \code{s2dv_cube}}
 
-\item{exp_cor}{an object of class \code{s2dv_cube} in which the quantile mapping correction will be applied. If it is not specified, the correction is applied in object 'exp'.}
+\item{exp_cor}{an object of class \code{s2dv_cube} in which the quantile mapping correction will be applied. If it is not specified, the correction is applied in object \code{exp}.}
 
 \item{sample_dims}{a character vector indicating the dimensions that can be used as sample for the same distribution}
 
-\item{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.}
+\item{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, the total length of the timeseries will be used.}
 
 \item{method}{a character string indicating the method to be used: 'PTF','DIST','RQUANT','QUANT','SSPLIN'. By default, the empirical quantile mapping 'QUANT' is used.}
 
-\item{...}{additional arguments passed to the method specified by method.}
+\item{...}{additional arguments passed to the method specified by \code{method}.}
 }
 \value{
 an oject of class \code{s2dv_cube} containing the experimental data after applyingthe quantile mapping correction. 
@@ -30,15 +30,17 @@ an oject of class \code{s2dv_cube} containing the experimental data after applyi
 This function is a wrapper from fitQmap and doQmap from package 'qmap'to be applied in CSTools objects of class 's2dv_cube'. The quantile mapping adjustment between an experiment, tipically a hindcast, and observations is applied to the experiment itself or to a provided forecast.
 }
 \details{
-The different methods are: 
-\item{'PTF'} {fits a parametric transformations to the quantile-quantile relation of observed and modelled values. See \code{\link[qmap]{fitQmapPTF}}}
-\item{'DIST'} {fits a theoretical distribution to observed and to modelled time series. See \code{\link[qmap]{fitQmapDIST}}}
-\item{'RQUANT'} {estimates the values of the quantile-quantile relation of observed and modelled time series for regularly spaced quantiles using local linear least square regression. See \code{\link[qmap]{fitQmapRQUANT}}}
-\item{'QUANT'} {estimates values of the empirical cumulative distribution function of observed and modelled time series for regularly spaced quantiles. See \code{\link[qmap]{fitQmapQUANT}}}
-\item{'SSPLIN'} {fits a smoothing spline to the quantile-quantile plot of observed and modelled time series. See \code{\link[qmap]{fitQmapSSPLIN}}}
+The different methods are:
+\itemize{ 
+\item{'PTF'} {fits a parametric transformations to the quantile-quantile relation of observed and modelled values. See \code{\link[qmap]{fitQmapPTF}}.}
+\item{'DIST'} {fits a theoretical distribution to observed and to modelled time series. See \code{\link[qmap]{fitQmapDIST}}.}
+\item{'RQUANT'} {estimates the values of the quantile-quantile relation of observed and modelled time series for regularly spaced quantiles using local linear least square regression. See \code{\link[qmap]{fitQmapRQUANT}}.}
+\item{'QUANT'} {estimates values of the empirical cumulative distribution function of observed and modelled time series for regularly spaced quantiles. See \code{\link[qmap]{fitQmapQUANT}}.}
+\item{'SSPLIN'} {fits a smoothing spline to the quantile-quantile plot of observed and modelled time series. See \code{\link[qmap]{fitQmapSSPLIN}}}.}
 All methods accepts some common arguments:
+\itemize{
 \item{wet.day} {logical indicating whether to perform wet day correction or not.(Not available in 'DIS' method)}
-\item{qstep} {NULL or a numeric value between 0 and 1.}
+\item{qstep} {NULL or a numeric value between 0 and 1.}}
 }
 \examples{
 exp$data <- 1 : c(1 * 10 * 20 * 60 * 6 * 7)
-- 
GitLab


From 21d297439a7617239143ddc181ee5c40a4b6caa7 Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Wed, 16 Oct 2019 20:41:20 +0200
Subject: [PATCH 06/26] example corrected

---
 R/CST_QuantileMapping.R    | 14 ++++++++------
 man/CST_QuantileMapping.Rd | 14 ++++++++------
 2 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index f3d923ef..a90adc54 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -30,13 +30,15 @@
 #'
 #'@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)
+#'exp <- 1 : (1 * 10 * 20 * 60 * 6 * 7)
+#'dim(exp) <- c(dataset = 1, member = 10, sdate = 20, ftime = 60 , 
+#'              lat = 6, lon = 7)
+#'exp <- list(data = exp)
 #'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)
+#'obs <- 101 : (100 + 1 * 1 * 20 * 60 * 6 * 7)
+#'dim(obs) <- c(dataset = 1, member = 1, sdate = 20, ftime = 60 ,
+#'              lat = 6, lon = 7)
+#'obs <- list(data = obs) 
 #'class(obs) <- 's2dv_cube'
 #'res <- CST_QuantileMapping(exp, obs)
 #'exp <- lonlat_data$exp
diff --git a/man/CST_QuantileMapping.Rd b/man/CST_QuantileMapping.Rd
index b2899dd1..8b4f64fa 100644
--- a/man/CST_QuantileMapping.Rd
+++ b/man/CST_QuantileMapping.Rd
@@ -43,13 +43,15 @@ All methods accepts some common arguments:
 \item{qstep} {NULL or a numeric value between 0 and 1.}}
 }
 \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)
+exp <- 1 : (1 * 10 * 20 * 60 * 6 * 7)
+dim(exp) <- c(dataset = 1, member = 10, sdate = 20, ftime = 60 , 
+             lat = 6, lon = 7)
+exp <- list(data = exp)
 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)
+obs <- 101 : (100 + 1 * 1 * 20 * 60 * 6 * 7)
+dim(obs) <- c(dataset = 1, member = 1, sdate = 20, ftime = 60 ,
+             lat = 6, lon = 7)
+obs <- list(data = obs) 
 class(obs) <- 's2dv_cube'
 res <- CST_QuantileMapping(exp, obs)
 exp <- lonlat_data$exp
-- 
GitLab


From 51092d4b3526e8af58c2cbe54e1c24dcadf929a7 Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Thu, 17 Oct 2019 11:14:22 +0200
Subject: [PATCH 07/26] Example needs to load libray qmap to find the function
 doQmap

---
 R/CST_QuantileMapping.R    | 7 ++++---
 man/CST_QuantileMapping.Rd | 3 ++-
 2 files changed, 6 insertions(+), 4 deletions(-)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index a90adc54..20ebd9d3 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -30,6 +30,7 @@
 #'
 #'@seealso \code{\link[qmap]{fitQmap}} and \code{\link[qmap]{doQmap}}
 #'@examples
+#'library(qmap)
 #'exp <- 1 : (1 * 10 * 20 * 60 * 6 * 7)
 #'dim(exp) <- c(dataset = 1, member = 10, sdate = 20, ftime = 60 , 
 #'              lat = 6, lon = 7)
@@ -40,7 +41,7 @@
 #'              lat = 6, lon = 7)
 #'obs <- list(data = obs) 
 #'class(obs) <- 's2dv_cube'
-#'res <- CST_QuantileMapping(exp, obs)
+#'res <- CST_QuantileMapping(exp, obs, method = 'RQUANT')
 #'exp <- lonlat_data$exp
 #'obs <- lonlat_data$obs
 #'res <- CST_QuantileMapping(exp, obs)
@@ -55,7 +56,7 @@ CST_QuantileMapping <- function(exp, obs, exp_cor = NULL,
     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,
-                               ...)
+                               method = method, ...)
     pos <- match(dimnames, names(dim(QMapped)))
     QMapped <- aperm(QMapped, pos)
     names(dim(QMapped)) <- dimnames 
@@ -228,7 +229,7 @@ qmapcor <- function(exp, obs, exp_cor = NULL, sample_length = NULL, method = 'QU
         if (i == nsamples) {
             sample_cor <- sample_cor[!is.na(sample_cor)]
         }
-        applied <- c(applied, doQmap(sample_cor, adjust, ...))
+        applied <- c(applied, doQmap(x = sample_cor, fobj = adjust, ...))
     }
     dim(applied) <- dimensions
     return(applied) 
diff --git a/man/CST_QuantileMapping.Rd b/man/CST_QuantileMapping.Rd
index 8b4f64fa..7bf0b77e 100644
--- a/man/CST_QuantileMapping.Rd
+++ b/man/CST_QuantileMapping.Rd
@@ -43,6 +43,7 @@ All methods accepts some common arguments:
 \item{qstep} {NULL or a numeric value between 0 and 1.}}
 }
 \examples{
+library(qmap)
 exp <- 1 : (1 * 10 * 20 * 60 * 6 * 7)
 dim(exp) <- c(dataset = 1, member = 10, sdate = 20, ftime = 60 , 
              lat = 6, lon = 7)
@@ -53,7 +54,7 @@ dim(obs) <- c(dataset = 1, member = 1, sdate = 20, ftime = 60 ,
              lat = 6, lon = 7)
 obs <- list(data = obs) 
 class(obs) <- 's2dv_cube'
-res <- CST_QuantileMapping(exp, obs)
+res <- CST_QuantileMapping(exp, obs, method = 'RQUANT')
 exp <- lonlat_data$exp
 obs <- lonlat_data$obs
 res <- CST_QuantileMapping(exp, obs)
-- 
GitLab


From 48f154d079610e9900d3f567b06141749721e23a Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Fri, 18 Oct 2019 13:00:34 +0200
Subject: [PATCH 08/26] CST_QuantileMapping tests

---
 R/CST_QuantileMapping.R                   | 16 ++++-
 tests/testthat/test-CST_QuantileMapping.R | 87 +++++++++++++++++++++++
 2 files changed, 100 insertions(+), 3 deletions(-)
 create mode 100644 tests/testthat/test-CST_QuantileMapping.R

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index 20ebd9d3..cdf5d182 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -49,10 +49,20 @@
 CST_QuantileMapping <- function(exp, obs, exp_cor = NULL,
                                 sample_dims = c('sdate', 'ftime', 'member'), 
                                 sample_length = NULL, method = 'QUANT', ...  ) {
-    if (!inherits(exp, 's2dv_cube') || !inherits(exp, 's2dv_cube')) {
+    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.")
+        }
+    }
+    if (!(method %in% c('PTF','DIST','RQUANT','QUANT','SSPLIN'))) {
+        stop("Parameter 'method' must be one of the following methods: ",
+             "'PTF','DIST','RQUANT','QUANT','SSPLIN'.")
+    }
     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,
@@ -76,10 +86,10 @@ QuantileMapping <- function(exp, obs, exp_cor = NULL, sample_dims = 'ftime',
     stop("Parameter 'obs' musth have dimension names.")
   }
   if (any(is.na(exp)))  {
-    warning("Parameter 'exp' contains NA values.")
+    stop("Parameter 'exp' contains NA values.")
   }  
   if (any(is.na(obs))) {
-    warning("Parameter 'obs' contains NA values.")
+    stop("Parameter 'obs' contains NA values.")
   }
   if (!is.null(exp_cor)) {
     exp_cordims <- names(dim(exp_cor))
diff --git a/tests/testthat/test-CST_QuantileMapping.R b/tests/testthat/test-CST_QuantileMapping.R
new file mode 100644
index 00000000..e7f88320
--- /dev/null
+++ b/tests/testthat/test-CST_QuantileMapping.R
@@ -0,0 +1,87 @@
+context("Generic tests")
+test_that("Sanity checks", {
+library(qmap)
+  expect_error(
+    CST_QuantileMapping(exp = 1),
+    "Parameter 'exp' and 'obs' must be of the class 's2dv_cube', as output by ",
+    "CSTools::CST_Load.")
+
+  exp <- 1 : 20
+  dim(exp) <- c(time = 20)
+  exp <- list(data = exp)
+  class(exp) <- 's2dv_cube'
+  expect_error(
+    CST_QuantileMapping(exp = exp),
+    'argument "obs" is missing, with no default')
+  expect_error(
+    CST_QuantileMapping(exp = exp, obs = 1),
+    "Parameter 'exp' and 'obs' must be of the class 's2dv_cube', as output by ",
+    "CSTools::CST_Load.")
+
+  obs <- 1 : 20
+  dim(obs) <- c(time = 20)
+  obs <- list(data = obs)
+  class(obs) <- 's2dv_cube'
+  expect_error(
+    CST_QuantileMapping(exp = exp, obs = obs, exp_cor = 1),
+    "Parameter 'exp_cor' must be of the class 's2dv_cube', as output ",
+    "by CSTools::CST_Load.")
+  
+  exp <- 1 : 20
+  dim(exp) <- 20
+  exp <- list(data = exp)
+  class(exp) <- 's2dv_cube'
+  expect_error(
+    CST_QuantileMapping(exp = exp, obs = obs),
+    "Parameter 'exp' musth have dimension names.")
+  
+  exp <- 1 : 20
+  dim(exp) <- c(time = 20)
+  exp <- list(data = exp)
+  class(exp) <- 's2dv_cube'
+  obs <- 1 : 20
+  dim(obs) <- 20
+  obs <- list(data = obs)
+  class(obs) <- 's2dv_cube'
+  expect_error(
+    CST_QuantileMapping(exp = exp, obs = obs),
+    "Parameter 'obs' musth have dimension names.")
+
+  obs <- 1 : 20
+  dim(obs) <- c(time = 20)
+  obs <- list(data = obs)
+  class(obs) <- 's2dv_cube'
+  exp_cor <- 1 : 20
+  dim(exp_cor) <- 20
+  exp_cor <- list(data = exp_cor)
+  class(exp_cor) <- 's2dv_cube'
+  expect_error(
+    CST_QuantileMapping(exp = exp, obs = obs, exp_cor = exp_cor),
+    "Parameter 'exp_cor' musth have dimension names.")
+  expect_error(
+    CST_QuantileMapping(exp = exp, obs = obs),
+    "Parameter 'sample_dims' must be a vector of string character indicating ",
+    "names of exiting dimension in parameter 'exp'.")
+  expect_error(
+    CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time', method = 'x'),
+    "Parameter 'method' must be one of the following methods: 'PTF','DIST',",
+    "'RQUANT','QUANT','SSPLIN'.")
+  expect_warning(
+    CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time', sample_length = "month"),
+    "Parameter 'sample_length' has not been correctly defined and the whole ",
+    "length of the timeseries will be used.")
+
+  exp$data[1] <- NA
+  expect_error(
+    CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time'),
+    "Parameter 'exp' contains NA values.")
+
+  exp$data[1] <- 1
+  obs$data[1] <- NA
+    expect_error(
+    CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time'),
+    "Parameter 'obs' contains NA values.")
+  obs$data[1] <- 1
+  expect_equal(CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time'), exp)
+
+})
-- 
GitLab


From 17831a8ebc32c69530cd1e704dc348cb620bce24 Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Fri, 18 Oct 2019 14:48:37 +0200
Subject: [PATCH 09/26] Example with DIST method.

---
 R/CST_QuantileMapping.R                   | 20 +++++++++++++++++++-
 man/CST_QuantileMapping.Rd                | 18 ++++++++++++++++++
 tests/testthat/test-CST_QuantileMapping.R |  6 +++++-
 3 files changed, 42 insertions(+), 2 deletions(-)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index cdf5d182..9a0031ef 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -42,13 +42,31 @@
 #'obs <- list(data = obs) 
 #'class(obs) <- 's2dv_cube'
 #'res <- CST_QuantileMapping(exp, obs, method = 'RQUANT')
+#'
 #'exp <- lonlat_data$exp
 #'obs <- lonlat_data$obs
 #'res <- CST_QuantileMapping(exp, obs)
+#'
+#'#/dontrun{/donttest{
+#'/donttest{
+#'data(obsprecip)
+#'data(modprecip)
+#'exp <- modprecip$MOSS[1:10000]
+#'dim(exp) <- c(time = length(exp))
+#'exp <- list(data = exp)
+#'class(exp) <- 's2dv_cube'
+#'obs <- obsprecip$MOSS[1:10000]
+#'dim(obs) <- c(time = length(obs))
+#'obs <- list(data = obs)
+#'class(obs) <- 's2dv_cube'
+#'res <- CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time',
+#'                           method = 'DIST')
+#'}
+#'#}}
 #'@export
 CST_QuantileMapping <- function(exp, obs, exp_cor = NULL,
                                 sample_dims = c('sdate', 'ftime', 'member'), 
-                                sample_length = NULL, method = 'QUANT', ...  ) {
+                                sample_length = NULL, method = 'QUANT', ...) {
     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.")
diff --git a/man/CST_QuantileMapping.Rd b/man/CST_QuantileMapping.Rd
index 7bf0b77e..4b3ae0e8 100644
--- a/man/CST_QuantileMapping.Rd
+++ b/man/CST_QuantileMapping.Rd
@@ -55,9 +55,27 @@ dim(obs) <- c(dataset = 1, member = 1, sdate = 20, ftime = 60 ,
 obs <- list(data = obs) 
 class(obs) <- 's2dv_cube'
 res <- CST_QuantileMapping(exp, obs, method = 'RQUANT')
+
 exp <- lonlat_data$exp
 obs <- lonlat_data$obs
 res <- CST_QuantileMapping(exp, obs)
+
+#/dontrun{/donttest{
+/donttest{
+data(obsprecip)
+data(modprecip)
+exp <- modprecip$MOSS[1:10000]
+dim(exp) <- c(time = length(exp))
+exp <- list(data = exp)
+class(exp) <- 's2dv_cube'
+obs <- obsprecip$MOSS[1:10000]
+dim(obs) <- c(time = length(obs))
+obs <- list(data = obs)
+class(obs) <- 's2dv_cube'
+res <- CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time',
+                          method = 'DIST')
+}
+#}}
 }
 \author{
 Nuria Perez-Zanon, \email{nuria.perez@bsc.es}
diff --git a/tests/testthat/test-CST_QuantileMapping.R b/tests/testthat/test-CST_QuantileMapping.R
index e7f88320..6ba80294 100644
--- a/tests/testthat/test-CST_QuantileMapping.R
+++ b/tests/testthat/test-CST_QuantileMapping.R
@@ -83,5 +83,9 @@ library(qmap)
     "Parameter 'obs' contains NA values.")
   obs$data[1] <- 1
   expect_equal(CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time'), exp)
-
+  expect_equal(CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time', 
+                                   method = 'PTF'), exp)
+  expect_equal(CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time', 
+                                   method = 'RQUANT'), exp)
+  expect_equal(CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time', 
 })
-- 
GitLab


From d5106344523d299d305ba423a72938cf92bdd182 Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Fri, 18 Oct 2019 14:58:10 +0200
Subject: [PATCH 10/26] Change to donttest example

---
 R/CST_QuantileMapping.R                   | 2 --
 man/CST_QuantileMapping.Rd                | 2 --
 tests/testthat/test-CST_QuantileMapping.R | 2 ++
 3 files changed, 2 insertions(+), 4 deletions(-)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index 9a0031ef..b7c392de 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -47,7 +47,6 @@
 #'obs <- lonlat_data$obs
 #'res <- CST_QuantileMapping(exp, obs)
 #'
-#'#/dontrun{/donttest{
 #'/donttest{
 #'data(obsprecip)
 #'data(modprecip)
@@ -62,7 +61,6 @@
 #'res <- CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time',
 #'                           method = 'DIST')
 #'}
-#'#}}
 #'@export
 CST_QuantileMapping <- function(exp, obs, exp_cor = NULL,
                                 sample_dims = c('sdate', 'ftime', 'member'), 
diff --git a/man/CST_QuantileMapping.Rd b/man/CST_QuantileMapping.Rd
index 4b3ae0e8..a1eabebe 100644
--- a/man/CST_QuantileMapping.Rd
+++ b/man/CST_QuantileMapping.Rd
@@ -60,7 +60,6 @@ exp <- lonlat_data$exp
 obs <- lonlat_data$obs
 res <- CST_QuantileMapping(exp, obs)
 
-#/dontrun{/donttest{
 /donttest{
 data(obsprecip)
 data(modprecip)
@@ -75,7 +74,6 @@ class(obs) <- 's2dv_cube'
 res <- CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time',
                           method = 'DIST')
 }
-#}}
 }
 \author{
 Nuria Perez-Zanon, \email{nuria.perez@bsc.es}
diff --git a/tests/testthat/test-CST_QuantileMapping.R b/tests/testthat/test-CST_QuantileMapping.R
index 6ba80294..944b489b 100644
--- a/tests/testthat/test-CST_QuantileMapping.R
+++ b/tests/testthat/test-CST_QuantileMapping.R
@@ -88,4 +88,6 @@ library(qmap)
   expect_equal(CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time', 
                                    method = 'RQUANT'), exp)
   expect_equal(CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time', 
+                                   method = 'SSPLIN'), exp)
+
 })
-- 
GitLab


From a20dfa054a4ba40b7249745357eaebb2e4b9afb5 Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Fri, 18 Oct 2019 15:11:32 +0200
Subject: [PATCH 11/26] slash replaced with backslash

---
 R/CST_QuantileMapping.R    | 2 +-
 man/CST_QuantileMapping.Rd | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index b7c392de..3eecf0f0 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -47,7 +47,7 @@
 #'obs <- lonlat_data$obs
 #'res <- CST_QuantileMapping(exp, obs)
 #'
-#'/donttest{
+#'\donttest{
 #'data(obsprecip)
 #'data(modprecip)
 #'exp <- modprecip$MOSS[1:10000]
diff --git a/man/CST_QuantileMapping.Rd b/man/CST_QuantileMapping.Rd
index a1eabebe..e9994ae9 100644
--- a/man/CST_QuantileMapping.Rd
+++ b/man/CST_QuantileMapping.Rd
@@ -60,7 +60,7 @@ exp <- lonlat_data$exp
 obs <- lonlat_data$obs
 res <- CST_QuantileMapping(exp, obs)
 
-/donttest{
+\donttest{
 data(obsprecip)
 data(modprecip)
 exp <- modprecip$MOSS[1:10000]
-- 
GitLab


From 95b32477daa358683ab0684d6e2f421725de7709 Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Fri, 18 Oct 2019 16:29:00 +0200
Subject: [PATCH 12/26] drop repeated dimensions

---
 R/CST_QuantileMapping.R | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index 3eecf0f0..acc644d6 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -117,6 +117,24 @@ QuantileMapping <- function(exp, obs, exp_cor = NULL, sample_dims = 'ftime',
     stop("Parameter 'sample_dims' must be a vector of string character ",
          "indicating names of exiting dimension in parameter 'exp'.")
   }
+  ## The sample_dims could be of any length (even different between exp and obs)
+  ## but the repeated dims that aren't in sample_dims should be drop:
+  commondims <- obsdims[obsdims %in% expdims]
+  commondims <- names(which(unlist(lapply(commondims, function(x) {
+                             dim(obs)[obsdims == x] != dim(exp)[expdims == x]}))))
+  if (any(!(commondims %in% sample_dims))) {
+      todrop <- commondims[!(commondims %in% sample_dims)]
+      todrop <- match(todrop, obsdims)
+        if (all(dim(obs)[todrop] != 1)) {
+            stop("Review parameter 'sample_dims' or the data dimensions",
+                 "since multiple dimensions with different length have ",
+                 "being found in the data inputs that don't match with ",
+                 "'sample_dims' parameter.")
+         } else {
+             obs <- adrop(obs, drop = todrop)
+         }
+  }
+
   if (!all(sample_dims %in% obsdims)) {
     newobsdims <- sample_dims[!sample_dims %in% obsdims]
     dim(obs) <- c(dim(obs), 1 : length(newobsdims))
-- 
GitLab


From 774c5554e2456aea7682675643b3b34ebb191fef Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Mon, 11 Nov 2019 10:27:55 +0100
Subject: [PATCH 13/26] fix exp_cor in QuantileMapping should use element

---
 R/CST_QuantileMapping.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index acc644d6..d052ed44 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -80,7 +80,7 @@ CST_QuantileMapping <- function(exp, obs, exp_cor = NULL,
              "'PTF','DIST','RQUANT','QUANT','SSPLIN'.")
     }
     dimnames <- names(dim(exp$data))
-    QMapped <- QuantileMapping(exp = exp$data, obs = obs$data, exp_cor = exp_cor,
+    QMapped <- QuantileMapping(exp = exp$data, obs = obs$data, exp_cor = exp_cor$data,
                                sample_dims = sample_dims, sample_length = sample_length,
                                method = method, ...)
     pos <- match(dimnames, names(dim(QMapped)))
-- 
GitLab


From 8e3c08c2a8c677161a55669cf5a92d401e704a1d Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Mon, 11 Nov 2019 10:31:20 +0100
Subject: [PATCH 14/26] correct misspelling 'musth' to 'must'

---
 R/CST_QuantileMapping.R | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index d052ed44..bb641d25 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -96,10 +96,10 @@ QuantileMapping <- function(exp, obs, exp_cor = NULL, sample_dims = 'ftime',
   obsdims <- names(dim(obs))
   expdims <- names(dim(exp))
   if (is.null(expdims)) {
-    stop("Parameter 'exp' musth have dimension names.")
+    stop("Parameter 'exp' must have dimension names.")
   }
   if (is.null(obsdims)) {
-    stop("Parameter 'obs' musth have dimension names.")
+    stop("Parameter 'obs' must have dimension names.")
   }
   if (any(is.na(exp)))  {
     stop("Parameter 'exp' contains NA values.")
@@ -110,7 +110,7 @@ QuantileMapping <- function(exp, obs, exp_cor = NULL, sample_dims = 'ftime',
   if (!is.null(exp_cor)) {
     exp_cordims <- names(dim(exp_cor))
     if (is.null(exp_cordims)) {
-      stop("Parameter 'exp_cor' musth have dimension names.")
+      stop("Parameter 'exp_cor' must have dimension names.")
     }
   }
   if (!all(sample_dims %in% expdims)) {
@@ -176,7 +176,7 @@ qmapcor <- function(exp, obs, exp_cor = NULL, sample_length = NULL, method = 'QU
         stop("Parameters 'exp' and 'obs' must have the same number of dimensions.")
     }
     if (!all(dimnames_exp %in% dimnames_obs)) {
-        stop("Parameters 'exp' and 'obs' musht have the same dimension names.")
+        stop("Parameters 'exp' and 'obs' must have the same dimension names.")
     } 
     if (!(any(names(dim(exp)) %in% 'ftime') | any(names(dim(exp)) %in% 'time'))) {
         stop("Parameters 'exp' and 'obs' must have a time dimension named ",
-- 
GitLab


From f5c58f291f5e4845e5e91746269bd4ff82b65bdc Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Mon, 11 Nov 2019 14:59:15 +0100
Subject: [PATCH 15/26] add ncores parameter

---
 R/CST_QuantileMapping.R                   | 11 +++++++----
 man/CST_QuantileMapping.Rd                |  5 ++++-
 tests/testthat/test-CST_QuantileMapping.R |  6 +++---
 3 files changed, 14 insertions(+), 8 deletions(-)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index bb641d25..b73fdca8 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -9,6 +9,7 @@
 #'@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, the total length of the timeseries will be 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 ncores an integer indicating the number of parallel processes to spawn for the use for parallel computation in multiple cores.
 #'@param ... additional arguments passed to the method specified by \code{method}.
 #'
 #'@details The different methods are:
@@ -64,7 +65,7 @@
 #'@export
 CST_QuantileMapping <- function(exp, obs, exp_cor = NULL,
                                 sample_dims = c('sdate', 'ftime', 'member'), 
-                                sample_length = NULL, method = 'QUANT', ...) {
+                                sample_length = NULL, method = 'QUANT', 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.")
@@ -82,7 +83,7 @@ CST_QuantileMapping <- function(exp, obs, exp_cor = NULL,
     dimnames <- names(dim(exp$data))
     QMapped <- QuantileMapping(exp = exp$data, obs = obs$data, exp_cor = exp_cor$data,
                                sample_dims = sample_dims, sample_length = sample_length,
-                               method = method, ...)
+                               method = method, ncores = ncores, ...)
     pos <- match(dimnames, names(dim(QMapped)))
     QMapped <- aperm(QMapped, pos)
     names(dim(QMapped)) <- dimnames 
@@ -92,7 +93,7 @@ CST_QuantileMapping <- function(exp, obs, exp_cor = NULL,
     return(exp)
 }
 QuantileMapping <- function(exp, obs, exp_cor = NULL, sample_dims = 'ftime', 
-                            sample_length = NULL, method = 'QUANT', ...) {
+                            sample_length = NULL, method = 'QUANT', ncores = NULL, ...) {
   obsdims <- names(dim(obs))
   expdims <- names(dim(exp))
   if (is.null(expdims)) {
@@ -161,8 +162,10 @@ QuantileMapping <- function(exp, obs, exp_cor = NULL, sample_dims = 'ftime',
             " is used.")
     method <- method[1]
   }
+
   qmaped <- Apply(list(exp, obs), target_dims = sample_dims, fun = qmapcor, ...,  
-                  exp_cor = exp_cor, sample_length = sample_length, method = method)$output1
+                  exp_cor = exp_cor, sample_length = sample_length,
+                  method = method, ncores = ncores)$output1
   pos <- match(expdims, names(dim(qmaped)))
   qmaped <- aperm(qmaped, pos)
   dim(qmaped) <- dim(exp)
diff --git a/man/CST_QuantileMapping.Rd b/man/CST_QuantileMapping.Rd
index e9994ae9..57af23d8 100644
--- a/man/CST_QuantileMapping.Rd
+++ b/man/CST_QuantileMapping.Rd
@@ -5,7 +5,8 @@
 \title{Quantiles Mapping for seasonal or decadal forecast data}
 \usage{
 CST_QuantileMapping(exp, obs, exp_cor = NULL, sample_dims = c("sdate",
-  "ftime", "member"), sample_length = NULL, method = "QUANT", ...)
+  "ftime", "member"), sample_length = NULL, method = "QUANT",
+  ncores = NULL, ...)
 }
 \arguments{
 \item{exp}{an object of class \code{s2dv_cube}}
@@ -20,6 +21,8 @@ CST_QuantileMapping(exp, obs, exp_cor = NULL, sample_dims = c("sdate",
 
 \item{method}{a character string indicating the method to be used: 'PTF','DIST','RQUANT','QUANT','SSPLIN'. By default, the empirical quantile mapping 'QUANT' is used.}
 
+\item{ncores}{an integer indicating the number of parallel processes to spawn for the use for parallel computation in multiple cores.}
+
 \item{...}{additional arguments passed to the method specified by \code{method}.}
 }
 \value{
diff --git a/tests/testthat/test-CST_QuantileMapping.R b/tests/testthat/test-CST_QuantileMapping.R
index 944b489b..8adfce45 100644
--- a/tests/testthat/test-CST_QuantileMapping.R
+++ b/tests/testthat/test-CST_QuantileMapping.R
@@ -33,7 +33,7 @@ library(qmap)
   class(exp) <- 's2dv_cube'
   expect_error(
     CST_QuantileMapping(exp = exp, obs = obs),
-    "Parameter 'exp' musth have dimension names.")
+    "Parameter 'exp' must have dimension names.")
   
   exp <- 1 : 20
   dim(exp) <- c(time = 20)
@@ -45,7 +45,7 @@ library(qmap)
   class(obs) <- 's2dv_cube'
   expect_error(
     CST_QuantileMapping(exp = exp, obs = obs),
-    "Parameter 'obs' musth have dimension names.")
+    "Parameter 'obs' must have dimension names.")
 
   obs <- 1 : 20
   dim(obs) <- c(time = 20)
@@ -57,7 +57,7 @@ library(qmap)
   class(exp_cor) <- 's2dv_cube'
   expect_error(
     CST_QuantileMapping(exp = exp, obs = obs, exp_cor = exp_cor),
-    "Parameter 'exp_cor' musth have dimension names.")
+    "Parameter 'exp_cor' must have dimension names.")
   expect_error(
     CST_QuantileMapping(exp = exp, obs = obs),
     "Parameter 'sample_dims' must be a vector of string character indicating ",
-- 
GitLab


From fdc9e90cc584143e888b92d5d15f06302d9cf18a Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Mon, 11 Nov 2019 17:22:56 +0100
Subject: [PATCH 16/26] accepts 'sdate' as temporal dimension

---
 R/CST_QuantileMapping.R | 53 +++++++++++++++++++++++++++++++----------
 1 file changed, 40 insertions(+), 13 deletions(-)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index b73fdca8..a372f1e5 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -181,22 +181,30 @@ qmapcor <- function(exp, obs, exp_cor = NULL, sample_length = NULL, method = 'QU
     if (!all(dimnames_exp %in% dimnames_obs)) {
         stop("Parameters 'exp' and 'obs' must have the same dimension names.")
     } 
-    if (!(any(names(dim(exp)) %in% 'ftime') | any(names(dim(exp)) %in% 'time'))) {
-        stop("Parameters 'exp' and 'obs' must have a time dimension named ",
-             "'time' or 'ftime'.")
+    if (!(any(names(dim(exp)) %in% 'ftime') | any(names(dim(exp)) %in% 'time') | 
+          any(names(dim(exp)) %in% 'sdate'))) {
+        stop("Parameters 'exp' and 'obs' must have a temporal dimension named ",
+             "'time', 'ftime' or 'sdate'.")
     }
-    
+        
     dimensions <- dim(exp)
-    if(!is.null(exp_cor)) {
+    if (!is.null(exp_cor)) {
         dimensions <- dim(exp_cor)
     }        
-    if (is.null(sample_length)) {
+    if (any(names(dim(exp)) %in% 'ftime') | any(names(dim(exp)) %in% 'time')) {
         time_dim <- which(names(dim(exp)) == 'ftime' | names(dim(exp)) %in% 'time')
+    } else {
+        time_dim <- which(names(dim(exp)) == 'sdate')
+    }
+    if (any(names(dim(obs)) %in% 'ftime') | any(names(dim(obs)) %in% 'time')) {
+        time_dim_obs <- which(names(dim(obs)) == 'ftime' | names(dim(obs)) %in% 'time')
+    } else {
+        time_dim_obs <- which(names(dim(obs)) == 'sdate')
+    }
+    if (is.null(sample_length)) {
         sample_length <- dim(exp)[time_dim]
     }
-    time_dim <- which(names(dim(exp)) == 'ftime' | names(dim(exp)) %in% 'time')
     nsamples <- dim(exp)[time_dim]/sample_length
-    time_dim_obs <- which(names(dim(obs)) == 'ftime' | names(dim(obs)) %in% 'time')
     if (nsamples %% 1 != 0) { 
         # add NA to complete the last sample
         nsamples <- ceiling(nsamples)
@@ -228,10 +236,24 @@ qmapcor <- function(exp, obs, exp_cor = NULL, sample_length = NULL, method = 'QU
             dim(obs) <- c(dim(obs)[-time_dim_obs], sample = sample_length,
                           dim(obs)[time_dim_obs]/sample_length)          
     }
-    new_time_dim_obs <- which(names(dim(obs)) == 'ftime' | names(dim(obs)) %in% 'time')
-    new_time_dim_exp <- which(names(dim(exp)) == 'ftime' | names(dim(exp)) %in% 'time')
+    if (any(names(dim(exp)) %in% 'ftime') | any(names(dim(exp)) %in% 'time')) {
+        new_time_dim_exp <- which(names(dim(exp)) == 'ftime' | names(dim(exp)) %in% 'time')
+    } else {
+        new_time_dim_exp <- which(names(dim(exp)) == 'sdate')
+    }
+    if (any(names(dim(obs)) %in% 'ftime') | any(names(dim(obs)) %in% 'time')) {
+        new_time_dim_obs <- which(names(dim(obs)) == 'ftime' | names(dim(obs)) %in% 'time')
+    } else {
+        new_time_dim_obs <- which(names(dim(obs)) == 'sdate')
+    }
+
     if (!is.null(exp_cor)) {
-        time_dim_cor <- which(names(dim(exp_cor)) == 'ftime' | names(dim(exp_cor)) %in% 'time')
+        if (any(names(dim(exp_cor)) %in% 'ftime') | any(names(dim(exp_cor)) %in% 'time')) {
+            time_dim_cor <- which(names(dim(exp_cor)) == 'ftime' | names(dim(exp_cor)) %in% 'time')
+        } else {
+            time_dim_cor <- which(names(dim(exp_cor)) == 'sdate')
+        }
+
         nsamples <- dimensions[time_dim_cor]/sample_length
         if (nsamples %% 1 != 0) {
         nsamples <- ceiling(nsamples)
@@ -248,8 +270,13 @@ qmapcor <- function(exp, obs, exp_cor = NULL, sample_length = NULL, method = 'QU
         }  
         dim(exp_cor) <- c(dim(exp_cor)[-time_dim_cor], sample = sample_length,
                           dim(exp_cor)[time_dim_cor]/sample_length)
-        new_time_dim_cor <- which(names(dim(exp_cor)) == 'ftime' | 
-                                  names(dim(exp_cor)) %in% 'time')
+        if (any(names(dim(exp_cor)) %in% 'ftime') | any(names(dim(exp_cor)) %in% 'time')) {
+            new_time_dim_cor <- which(names(dim(exp_cor)) == 'ftime' |
+                                      names(dim(exp_cor)) %in% 'time')
+        } else {
+            new_time_dim_cor <- which(names(dim(exp_cor)) == 'sdate')
+        }
+
     } else {
         time_dim_cor <- time_dim
         exp_cor <- exp
-- 
GitLab


From 14960675c41ad0543a680247f0767ac3b9131c2b Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Mon, 18 Nov 2019 14:48:39 +0100
Subject: [PATCH 17/26] Parameters Apply depends on exp_cor

---
 R/CST_QuantileMapping.R                   | 12 ++++++++++--
 tests/testthat/test-CST_QuantileMapping.R |  4 ++++
 2 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index a372f1e5..8c39a2cb 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -163,9 +163,17 @@ QuantileMapping <- function(exp, obs, exp_cor = NULL, sample_dims = 'ftime',
     method <- method[1]
   }
 
-  qmaped <- Apply(list(exp, obs), target_dims = sample_dims, fun = qmapcor, ...,  
-                  exp_cor = exp_cor, sample_length = sample_length,
+#  qmaped <- Apply(list(exp, obs), target_dims = sample_dims, fun = qmapcor, ...,  
+#                  exp_cor = exp_cor, sample_length = sample_length,
+  if (is.null(exp_cor)) {
+    qmaped <- Apply(list(exp, obs), target_dims = sample_dims,
+                  fun = qmapcor, ..., sample_length = sample_length,
                   method = method, ncores = ncores)$output1
+  } else {
+    qmaped <- Apply(list(exp, obs, exp_cor), target_dims = sample_dims, 
+                    fun = qmapcor, ..., sample_length = sample_length,
+                    method = method, ncores = ncores)$output1
+  }
   pos <- match(expdims, names(dim(qmaped)))
   qmaped <- aperm(qmaped, pos)
   dim(qmaped) <- dim(exp)
diff --git a/tests/testthat/test-CST_QuantileMapping.R b/tests/testthat/test-CST_QuantileMapping.R
index 8adfce45..4a317b5a 100644
--- a/tests/testthat/test-CST_QuantileMapping.R
+++ b/tests/testthat/test-CST_QuantileMapping.R
@@ -89,5 +89,9 @@ library(qmap)
                                    method = 'RQUANT'), exp)
   expect_equal(CST_QuantileMapping(exp = exp, obs = obs, sample_dims = 'time', 
                                    method = 'SSPLIN'), exp)
+  library(CSTools)
+  expect_equal(CST_QuantileMapping(exp = lonlat_data$exp, obs = lonlat_data$obs),
+               CST_QuantileMapping(exp = lonlat_data$exp, obs = lonlat_data$obs,
+                                   exp_cor = lonlat_data$exp))
 
 })
-- 
GitLab


From c23876627f76e5c6b1ee079a4546b418c3944585 Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Wed, 20 Nov 2019 18:16:28 +0100
Subject: [PATCH 18/26] warning messages for zero precipitation and sample
 lenght

---
 R/CST_QuantileMapping.R | 13 +++++++++++++
 1 file changed, 13 insertions(+)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index 8c39a2cb..dbceb74a 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -305,6 +305,19 @@ qmapcor <- function(exp, obs, exp_cor = NULL, sample_length = NULL, method = 'QU
             sample_obs <- sample_obs[!is.na(sample_obs)]
             sample_exp <- sample_exp[!is.na(sample_exp)]
         }
+        if (sum(sample_obs) == 0) {
+            warning("The total sum of observed data sample in the sample number ",
+                    i, ", is zero and the function may crash.")
+        }
+        if (sum(sample_exp) == 0) {
+            warning("The total sum of experimental data sample in the sample number ",
+                    i, ", is zero and the function may crash.")
+        }
+        if (length(sample_exp) < sample_length) {
+            warning("The length of the sample used, ", length(sample_exp),
+                    ", in the sample number ", i,
+                    ", is smaller than the defined in parameter 'sample_length'.")
+        }
         adjust <- fitQmap(sample_obs, sample_exp, method = method,
                           ...)
         sample_cor <- as.vector(asub(exp_cor, idx = i, dims = new_time_dim_cor))
-- 
GitLab


From 3d895052e33838e561ae279b6b8427a68afcbef8 Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Thu, 21 Nov 2019 15:38:26 +0100
Subject: [PATCH 19/26] correcting example

---
 R/CST_QuantileMapping.R    | 14 +++++++-------
 man/CST_QuantileMapping.Rd | 14 +++++++-------
 2 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R
index dbceb74a..6682e7aa 100644
--- a/R/CST_QuantileMapping.R
+++ b/R/CST_QuantileMapping.R
@@ -32,15 +32,15 @@
 #'@seealso \code{\link[qmap]{fitQmap}} and \code{\link[qmap]{doQmap}}
 #'@examples
 #'library(qmap)
-#'exp <- 1 : (1 * 10 * 20 * 60 * 6 * 7)
-#'dim(exp) <- c(dataset = 1, member = 10, sdate = 20, ftime = 60 , 
-#'              lat = 6, lon = 7)
+#'exp <- 1 : (1 * 5 * 10 * 6 * 2 * 3)
+#'dim(exp) <- c(dataset = 1, member = 10, sdate = 5, ftime = 6 , 
+#'              lat = 2, lon = 3)
 #'exp <- list(data = exp)
 #'class(exp) <- 's2dv_cube'
-#'obs <- 101 : (100 + 1 * 1 * 20 * 60 * 6 * 7)
-#'dim(obs) <- c(dataset = 1, member = 1, sdate = 20, ftime = 60 ,
-#'              lat = 6, lon = 7)
-#'obs <- list(data = obs) 
+#'obs <- 101 : (100 + 1 * 1 * 5 * 6 * 2 * 3)
+#'dim(obs) <- c(dataset = 1, member = 1, sdate = 5, ftime = 6 ,
+#'              lat = 2, lon = 3)
+#'obs <- list(data = obs)
 #'class(obs) <- 's2dv_cube'
 #'res <- CST_QuantileMapping(exp, obs, method = 'RQUANT')
 #'
diff --git a/man/CST_QuantileMapping.Rd b/man/CST_QuantileMapping.Rd
index 57af23d8..577ff542 100644
--- a/man/CST_QuantileMapping.Rd
+++ b/man/CST_QuantileMapping.Rd
@@ -47,15 +47,15 @@ All methods accepts some common arguments:
 }
 \examples{
 library(qmap)
-exp <- 1 : (1 * 10 * 20 * 60 * 6 * 7)
-dim(exp) <- c(dataset = 1, member = 10, sdate = 20, ftime = 60 , 
-             lat = 6, lon = 7)
+exp <- 1 : (1 * 5 * 10 * 6 * 2 * 3)
+dim(exp) <- c(dataset = 1, member = 10, sdate = 5, ftime = 6 , 
+             lat = 2, lon = 3)
 exp <- list(data = exp)
 class(exp) <- 's2dv_cube'
-obs <- 101 : (100 + 1 * 1 * 20 * 60 * 6 * 7)
-dim(obs) <- c(dataset = 1, member = 1, sdate = 20, ftime = 60 ,
-             lat = 6, lon = 7)
-obs <- list(data = obs) 
+obs <- 101 : (100 + 1 * 1 * 5 * 6 * 2 * 3)
+dim(obs) <- c(dataset = 1, member = 1, sdate = 5, ftime = 6 ,
+             lat = 2, lon = 3)
+obs <- list(data = obs)
 class(obs) <- 's2dv_cube'
 res <- CST_QuantileMapping(exp, obs, method = 'RQUANT')
 
-- 
GitLab


From 900f1fa6f20b3597c45417138c63b22c87da8999 Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Fri, 22 Nov 2019 16:33:39 +0100
Subject: [PATCH 20/26] Function SplitDim

---
 NAMESPACE           |   2 +
 R/CST_SplitDim.R    | 189 ++++++++++++++++++++++++++++++++++++++++++++
 man/CST_SplitDim.Rd |  46 +++++++++++
 man/SplitDim.Rd     |  38 +++++++++
 4 files changed, 275 insertions(+)
 create mode 100644 R/CST_SplitDim.R
 create mode 100644 man/CST_SplitDim.Rd
 create mode 100644 man/SplitDim.Rd

diff --git a/NAMESPACE b/NAMESPACE
index cbaa0d3c..c9fd90ed 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -10,11 +10,13 @@ export(CST_QuantileMapping)
 export(CST_RFSlope)
 export(CST_RFWeights)
 export(CST_RainFARM)
+export(CST_SplitDim)
 export(PlotCombinedMap)
 export(PlotForecastPDF)
 export(PlotMostLikelyQuantileMap)
 export(RFSlope)
 export(RainFARM)
+export(SplitDim)
 import(abind)
 import(ggplot2)
 import(multiApply)
diff --git a/R/CST_SplitDim.R b/R/CST_SplitDim.R
new file mode 100644
index 00000000..6d9dd04c
--- /dev/null
+++ b/R/CST_SplitDim.R
@@ -0,0 +1,189 @@
+#'Function to Split Dimension
+#'
+#'@author Nuria Perez-Zanon, \email{nuria.perez@bsc.es}
+#'
+#'@description This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, moth and year). The user can also provide a numeric frequency indicating the length of each division.
+#'
+#'@param data a 's2dv_cube' object
+#'@param dimname a character string indicating the name of the dimension to split
+#'@param indices a vector of numeric indices or dates
+#'@param freq a character string indicating the frequency given parameter indices as dates.
+#'
+#'@import abind
+#'@import s2dverification
+#'@examples
+#'
+#'data <- 1 : 20
+#'dim(data) <- c(time = 10, lat = 2)
+#'data <-list(data = data)
+#'class(data) <- 's2dv_cube'
+#'indices <- c(rep(1,5), rep(2,5))
+#'new_data <- CST_SplitDim(data, indices = indices)
+#'time <- c(seq(ISOdate(1903, 1, 1), ISOdate(1903, 1, 4), "days"),
+#'          seq(ISOdate(1903, 2, 1), ISOdate(1903, 2, 4), "days"),
+#'          seq(ISOdate(1904, 1, 1), ISOdate(1904, 1, 2), "days"))
+#'data <- list(data = data$data, Dates = time)
+#'class(data) <- 's2dv_cube'
+#'new_data <- CST_SplitDim(data, indices = time)
+#'dim(new_data$data)
+#'new_data <- CST_SplitDim(data, indices = time, freq = 'day')
+#'dim(new_data$data)
+#'new_data <- CST_SplitDim(data, indices = time, freq = 'month')
+#'dim(new_data$data)
+#'new_data <- CST_SplitDim(data, indices = time, freq = 'year')
+#'dim(new_data$data)
+#'@export
+CST_SplitDim <- function(data, split_dim = 'time', indices = NULL,
+                         freq = 'monthly') {
+    if (!inherits(data, 's2dv_cube')) {
+    stop("Parameter 'data' must be of the class 's2dv_cube', ",
+         "as output by CSTools::CST_Load.")
+    }
+    if (is.null(indices)) {
+        indices = data$Dates[[1]]
+    }
+    data$data <- SplitDim(data$data, split_dim = split_dim, indices = indices,
+                        freq = freq)
+    return(data)
+}
+#'Function to Split Dimension
+#'
+#'@author Nuria Perez-Zanon, \email{nuria.perez@bsc.es}
+#'
+#'@description This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, moth and year). The user can also provide a numeric frequency indicating the length of each division.
+#'
+#'@param data an n-dimensional array with named dimensions
+#'@param dimname a character string indicating the name of the dimension to split
+#'@param indices a vector of numeric indices or dates
+#'@param freq a character string indicating the frequency given parameter indices as dates.
+#'
+#'@import abind
+#'@import s2dverification
+#'@examples
+#'
+#'data <- 1 : 20
+#'dim(data) <- c(time = 10, lat = 2)
+#'indices <- c(rep(1,5), rep(2,5))
+#'new_data <- SplitDim(data, indices = indices)
+#'time <- c(seq(ISOdate(1903, 1, 1), ISOdate(1903, 1, 4), "days"),
+#'          seq(ISOdate(1903, 2, 1), ISOdate(1903, 2, 4), "days"),
+#'          seq(ISOdate(1904, 1, 1), ISOdate(1904, 1, 2), "days"))
+#'new_data <- SplitDim(data, indices = time)
+#'new_data <- SplitDim(data, indices = time, freq = 'day')
+#'new_data <- SplitDim(data, indices = time, freq = 'month')
+#'new_data <- SplitDim(data, indices = time, freq = 'year')
+#'@export
+SplitDim <- function(data, split_dim = 'time', indices, freq = 'monthly') {
+    # check data
+    if (is.null(data)) {
+        stop("Parameter 'data' cannot be NULL.")
+    }
+    if (is.null(dim(data))) {
+        dim(data) = c(time = length(data))
+    }
+    if (is.null(names(dim(data)))) {
+        stop("Parameter 'data' must have dimension names.")
+    }
+    dims <- dim(data)
+    # check split_dim
+    if (!is.character(split_dim)) {
+        stop("Parameter 'split_dim' must be a character.")
+    }
+    if (length(split_dim) > 1) {
+        split_dim <- split_dim[1]
+        warning("Parameter 'split_dim' has length greater than ",
+                "one and only the first element will be used.")
+    }
+    if (!any(names(dims) %in% split_dim)) {
+        stop("Parameter 'split_dims' must be one of the dimension ",
+             "names in parameter 'data'.")
+    }
+   pos_split <- which(names(dims) == split_dim)
+    # check indices and freq
+    if (is.null(indices)) {
+        if (!is.numeric(freq)) {
+            stop("Parameter 'freq' must be a integer number indicating ",
+                 " the length of each chunk.")
+        } else {
+            if (!((dims[pos_split] / freq) %% 1 == 0)) {
+                stop("Parameter 'freq' must be proportional to the ",
+                     "length of the 'split_dim' in parameter 'data'.")
+            }
+            indices <- rep(1 : (dims[pos_split] / freq), freq)
+            indices <- sort(indices)
+        }
+    } else if (is.numeric(indices)) {
+        if (!is.null(freq)) {
+           if (freq != 'monthly') {
+                warning("Parameter 'freq' is not being used since ",
+                        "parameter 'indices' is numeric.")
+           }
+        }
+    } else {
+        # Indices should be Dates and freq character
+        if (!is.character(freq)) {
+            stop("Parameter 'freq' must be a character indicating ",
+                 "how to divide the dates provided in parameter 'indices'",
+                 ", 'monthly', 'anually' or 'daily'.")
+         }
+         if (!(any(class(indices) %in% c('POSIXct')))) {
+             indices <- try( {
+                 if (is.character(indices)) {
+                     as.POSIXct(indices)
+                 } else {
+                      as.POSIXct(indices)
+                 }
+             })
+             if ('try-error' %in% class(indices) | 
+                 sum(is.na(indices)) == length(indices)) {
+                 stop("Dates provided in parameter 'indices' must be of class",
+                      " 'POSIXct' or convertable to 'POSIXct'.")
+             } 
+         }
+    }
+    if (length(indices) != dims[pos_split]) {
+        stop("Parameter 'indices' has different length of parameter ",
+             "data in the dimension supplied in 'split_dim'.")
+    }
+    # check indices as dates:
+    if (!is.numeric(indices)) {
+        if (freq == 'day') {
+            indices <- as.numeric(strftime(indices, format = "%d"))
+        } else if (freq == 'month') {
+            indices <- as.numeric(strftime(indices, format = "%m"))
+        } else if (freq == 'year') {
+            indices <- as.numeric(strftime(indices, format = "%Y"))
+        } else if (freq == 'monthly' ) {
+            indices <- as.numeric(strftime(indices, format = "%m%Y"))
+        } else {
+            stop("Parameter 'freq' must be numeric or a character: ",
+             "by 'day', 'month', 'year' or 'monthly' (for distingible month).")
+       }
+    }
+    repited <- unique(indices)
+    max_times <- max(unlist(lapply(repited, 
+                             function(x){sum(indices == x)})))
+    data <- lapply(repited, function(x) {rebuild(x, data, along = split_dim,
+                        indices = indices, max_times)})
+    data <- abind(data, along = length(dims) + 1)
+    if (is.character(freq)) {
+        names(dim(data)) <- c(names(dims), freq)
+    } else {
+        names(dim(data)) <- c(names(dims), 'index')
+    }
+return(data)
+}
+
+rebuild <- function(x, data, along, indices, max_times) {
+    a <- Subset(data, along = along, indices = which(indices == x))
+    pos_dim <- which(names(dim(a)) == along)
+    if (dim(a)[pos_dim] != max_times) {
+        adding <- max_times - dim(a)[pos_dim]
+        new_dims <- dim(a)
+        new_dims[pos_dim] <- adding
+        extra <- array(NA, dim = new_dims)
+        a <- abind(a, extra, along = pos_dim)
+        names(dim(a)) <- names(dim(data))
+    }
+    return(a)
+}
diff --git a/man/CST_SplitDim.Rd b/man/CST_SplitDim.Rd
new file mode 100644
index 00000000..d10ccf6b
--- /dev/null
+++ b/man/CST_SplitDim.Rd
@@ -0,0 +1,46 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/CST_SplitDim.R
+\name{CST_SplitDim}
+\alias{CST_SplitDim}
+\title{Function to Split Dimension}
+\usage{
+CST_SplitDim(data, split_dim = "time", indices = NULL, freq = "monthly")
+}
+\arguments{
+\item{data}{a 's2dv_cube' object}
+
+\item{indices}{a vector of numeric indices or dates}
+
+\item{freq}{a character string indicating the frequency given parameter indices as dates.}
+
+\item{dimname}{a character string indicating the name of the dimension to split}
+}
+\description{
+This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, moth and year). The user can also provide a numeric frequency indicating the length of each division.
+}
+\examples{
+
+data <- 1 : 20
+dim(data) <- c(time = 10, lat = 2)
+data <-list(data = data)
+class(data) <- 's2dv_cube'
+indices <- c(rep(1,5), rep(2,5))
+new_data <- CST_SplitDim(data, indices = indices)
+time <- c(seq(ISOdate(1903, 1, 1), ISOdate(1903, 1, 4), "days"),
+         seq(ISOdate(1903, 2, 1), ISOdate(1903, 2, 4), "days"),
+         seq(ISOdate(1904, 1, 1), ISOdate(1904, 1, 2), "days"))
+data <- list(data = data$data, Dates = time)
+class(data) <- 's2dv_cube'
+new_data <- CST_SplitDim(data, indices = time)
+dim(new_data$data)
+new_data <- CST_SplitDim(data, indices = time, freq = 'day')
+dim(new_data$data)
+new_data <- CST_SplitDim(data, indices = time, freq = 'month')
+dim(new_data$data)
+new_data <- CST_SplitDim(data, indices = time, freq = 'year')
+dim(new_data$data)
+}
+\author{
+Nuria Perez-Zanon, \email{nuria.perez@bsc.es}
+}
+
diff --git a/man/SplitDim.Rd b/man/SplitDim.Rd
new file mode 100644
index 00000000..4048fc0d
--- /dev/null
+++ b/man/SplitDim.Rd
@@ -0,0 +1,38 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/CST_SplitDim.R
+\name{SplitDim}
+\alias{SplitDim}
+\title{Function to Split Dimension}
+\usage{
+SplitDim(data, split_dim = "time", indices, freq = "monthly")
+}
+\arguments{
+\item{data}{an n-dimensional array with named dimensions}
+
+\item{indices}{a vector of numeric indices or dates}
+
+\item{freq}{a character string indicating the frequency given parameter indices as dates.}
+
+\item{dimname}{a character string indicating the name of the dimension to split}
+}
+\description{
+This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, moth and year). The user can also provide a numeric frequency indicating the length of each division.
+}
+\examples{
+
+data <- 1 : 20
+dim(data) <- c(time = 10, lat = 2)
+indices <- c(rep(1,5), rep(2,5))
+new_data <- SplitDim(data, indices = indices)
+time <- c(seq(ISOdate(1903, 1, 1), ISOdate(1903, 1, 4), "days"),
+         seq(ISOdate(1903, 2, 1), ISOdate(1903, 2, 4), "days"),
+         seq(ISOdate(1904, 1, 1), ISOdate(1904, 1, 2), "days"))
+new_data <- SplitDim(data, indices = time)
+new_data <- SplitDim(data, indices = time, freq = 'day')
+new_data <- SplitDim(data, indices = time, freq = 'month')
+new_data <- SplitDim(data, indices = time, freq = 'year')
+}
+\author{
+Nuria Perez-Zanon, \email{nuria.perez@bsc.es}
+}
+
-- 
GitLab


From 0e348392ac3e291dd0c4ccfcfbc10d098b4e80df Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Fri, 22 Nov 2019 16:49:32 +0100
Subject: [PATCH 21/26] correcting parameter name

---
 R/CST_SplitDim.R    | 4 ++--
 man/CST_SplitDim.Rd | 4 ++--
 man/SplitDim.Rd     | 4 ++--
 3 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/R/CST_SplitDim.R b/R/CST_SplitDim.R
index 6d9dd04c..b9e95db6 100644
--- a/R/CST_SplitDim.R
+++ b/R/CST_SplitDim.R
@@ -5,7 +5,7 @@
 #'@description This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, moth and year). The user can also provide a numeric frequency indicating the length of each division.
 #'
 #'@param data a 's2dv_cube' object
-#'@param dimname a character string indicating the name of the dimension to split
+#'@param split_dim a character string indicating the name of the dimension to split
 #'@param indices a vector of numeric indices or dates
 #'@param freq a character string indicating the frequency given parameter indices as dates.
 #'
@@ -53,7 +53,7 @@ CST_SplitDim <- function(data, split_dim = 'time', indices = NULL,
 #'@description This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, moth and year). The user can also provide a numeric frequency indicating the length of each division.
 #'
 #'@param data an n-dimensional array with named dimensions
-#'@param dimname a character string indicating the name of the dimension to split
+#'@param split_dim a character string indicating the name of the dimension to split
 #'@param indices a vector of numeric indices or dates
 #'@param freq a character string indicating the frequency given parameter indices as dates.
 #'
diff --git a/man/CST_SplitDim.Rd b/man/CST_SplitDim.Rd
index d10ccf6b..f8220ce9 100644
--- a/man/CST_SplitDim.Rd
+++ b/man/CST_SplitDim.Rd
@@ -9,11 +9,11 @@ CST_SplitDim(data, split_dim = "time", indices = NULL, freq = "monthly")
 \arguments{
 \item{data}{a 's2dv_cube' object}
 
+\item{split_dim}{a character string indicating the name of the dimension to split}
+
 \item{indices}{a vector of numeric indices or dates}
 
 \item{freq}{a character string indicating the frequency given parameter indices as dates.}
-
-\item{dimname}{a character string indicating the name of the dimension to split}
 }
 \description{
 This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, moth and year). The user can also provide a numeric frequency indicating the length of each division.
diff --git a/man/SplitDim.Rd b/man/SplitDim.Rd
index 4048fc0d..3812224b 100644
--- a/man/SplitDim.Rd
+++ b/man/SplitDim.Rd
@@ -9,11 +9,11 @@ SplitDim(data, split_dim = "time", indices, freq = "monthly")
 \arguments{
 \item{data}{an n-dimensional array with named dimensions}
 
+\item{split_dim}{a character string indicating the name of the dimension to split}
+
 \item{indices}{a vector of numeric indices or dates}
 
 \item{freq}{a character string indicating the frequency given parameter indices as dates.}
-
-\item{dimname}{a character string indicating the name of the dimension to split}
 }
 \description{
 This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, moth and year). The user can also provide a numeric frequency indicating the length of each division.
-- 
GitLab


From 03152005d25e38b37d08b6c71330028dfeca1f7c Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Fri, 22 Nov 2019 18:26:51 +0100
Subject: [PATCH 22/26] adding tests and corresponding fixes

---
 R/CST_SplitDim.R                   | 14 +++++-
 tests/testthat/test-CST_SplitDim.R | 76 ++++++++++++++++++++++++++++++
 2 files changed, 89 insertions(+), 1 deletion(-)
 create mode 100644 tests/testthat/test-CST_SplitDim.R

diff --git a/R/CST_SplitDim.R b/R/CST_SplitDim.R
index b9e95db6..0c79bc4a 100644
--- a/R/CST_SplitDim.R
+++ b/R/CST_SplitDim.R
@@ -40,7 +40,19 @@ CST_SplitDim <- function(data, split_dim = 'time', indices = NULL,
          "as output by CSTools::CST_Load.")
     }
     if (is.null(indices)) {
-        indices = data$Dates[[1]]
+        if (is.list(data$Dates)) {
+            indices <- data$Dates[[1]]
+        } else {
+            indices <- data$Dates
+        }
+        if (any(names(dim(data$data)) %in% 'sdate')) {
+            if (!any(names(dim(data$data)) %in% split_dim)) {
+                stop("Parameter 'split_dims' must be one of the dimension ",
+                     "names in parameter 'data'.")
+            }   
+            indices <- indices[1 : dim(data$data)[which(names(dim(data$data)) == 
+                                                        split_dim)]]     
+        }
     }
     data$data <- SplitDim(data$data, split_dim = split_dim, indices = indices,
                         freq = freq)
diff --git a/tests/testthat/test-CST_SplitDim.R b/tests/testthat/test-CST_SplitDim.R
new file mode 100644
index 00000000..25d9f7e8
--- /dev/null
+++ b/tests/testthat/test-CST_SplitDim.R
@@ -0,0 +1,76 @@
+context("Generic tests")
+test_that("Sanity checks", {
+  expect_error(
+    CST_SplitDim(data = 1),
+    "Parameter 'data' must be of the class 's2dv_cube', as output by ",
+    "CSTools::CST_Load.")
+
+  data <- 1 : 20
+  dim(data) <- c(time = 20)
+  data <- list(data = data)
+  class(data) <- 's2dv_cube'
+  expect_error(
+    CST_SplitDim(data = data),
+    "Parameter 'freq' must be a integer number indicating ", 
+    " the length of each chunk.")
+indices <- c(rep(1,5), rep(2,5), rep (3, 5), rep(4, 5))
+output = matrix(data$data, nrow = 5, ncol = 4)
+names(dim(output)) <- c('time', 'monthly')
+output <- list(data = output) 
+class(output) <- 's2dv_cube'
+  expect_equal(
+    CST_SplitDim(data = data, indices = indices), output)
+output = matrix(data$data, nrow = 5, ncol = 4)
+names(dim(output)) <- c('time', 'index')
+output <- list(data = output)
+class(output) <- 's2dv_cube'
+  expect_equal(
+    CST_SplitDim(data = data, freq = 5), output)
+
+time <- c(seq(ISOdate(1903, 1, 1), ISOdate(1903, 1, 4), "days"),
+          seq(ISOdate(1903, 2, 1), ISOdate(1903, 2, 4), "days"),
+          seq(ISOdate(1904, 1, 1), ISOdate(1904, 1, 2), "days"))
+data <- list(data = data$data, Dates = time)
+class(data) <- 's2dv_cube' 
+  expect_error(
+    CST_SplitDim(data = data),
+    "Parameter 'indices' has different length of parameter data ",
+    "in the dimension supplied in 'split_dim'.")
+time <- c(seq(ISOdate(1903, 1, 1), ISOdate(1903, 1, 8), "days"),
+          seq(ISOdate(1903, 2, 1), ISOdate(1903, 2, 8), "days"),
+          seq(ISOdate(1904, 1, 1), ISOdate(1904, 1, 4), "days"))
+data <- list(data = data$data, Dates = time)
+class(data) <- 's2dv_cube'
+output <- c(data$data, rep(NA, 4))
+dim(output) <- c(time = 8, monthly = 3)
+result <- data
+result$data <- output
+
+  expect_equal(
+    CST_SplitDim(data = data), result)
+
+  exp_cor <- 1 : 20
+  dim(exp_cor) <- 20
+  exp_cor <- list(data = exp_cor)
+  class(exp_cor) <- 's2dv_cube'
+  expect_error(
+    CST_SplitDim(data = exp_cor, freq = 5),
+    "Parameter 'data' must have dimension names.")
+  expect_error(
+    CST_SplitDim(data, freq = 'x'),
+    "Parameter 'freq' must be numeric or a character: by 'day', ",
+    "'month', 'year' or 'monthly' (for distingible month).")
+
+  library(CSTools)
+  expect_error(
+    CST_SplitDim(data = lonlat_data$exp),
+    "Parameter 'split_dims' must be one of the dimension names in parameter 'data'.")           
+  output <- lonlat_data$exp$data
+  output <- abind(output[, , , 1, ,], output[, , , 2, ,], output[, , , 3, ,], along = 5)
+  dim(output) <- c(dataset = 1, member = 15, sdate = 6, ftime = 1, 
+                   lat = 22, lon = 53, monthly = 3)
+  result <- lonlat_data$exp
+  result$data <- output
+  expect_equal(CST_SplitDim(data = lonlat_data$exp, split_dim = 'ftime'),
+               result)
+})
-- 
GitLab


From 8f4610230179e1b299932dacb352f35e2686ad87 Mon Sep 17 00:00:00 2001
From: jhardenberg <hardenberg@gmail.com>
Date: Fri, 22 Nov 2019 20:54:01 +0100
Subject: [PATCH 23/26] typos

---
 R/CST_SplitDim.R | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/R/CST_SplitDim.R b/R/CST_SplitDim.R
index 0c79bc4a..1987feaa 100644
--- a/R/CST_SplitDim.R
+++ b/R/CST_SplitDim.R
@@ -2,7 +2,7 @@
 #'
 #'@author Nuria Perez-Zanon, \email{nuria.perez@bsc.es}
 #'
-#'@description This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, moth and year). The user can also provide a numeric frequency indicating the length of each division.
+#'@description This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, month and year). The user can also provide a numeric frequency indicating the length of each division.
 #'
 #'@param data a 's2dv_cube' object
 #'@param split_dim a character string indicating the name of the dimension to split
@@ -62,7 +62,7 @@ CST_SplitDim <- function(data, split_dim = 'time', indices = NULL,
 #'
 #'@author Nuria Perez-Zanon, \email{nuria.perez@bsc.es}
 #'
-#'@description This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, moth and year). The user can also provide a numeric frequency indicating the length of each division.
+#'@description This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, month and year). The user can also provide a numeric frequency indicating the length of each division.
 #'
 #'@param data an n-dimensional array with named dimensions
 #'@param split_dim a character string indicating the name of the dimension to split
@@ -169,7 +169,7 @@ SplitDim <- function(data, split_dim = 'time', indices, freq = 'monthly') {
             indices <- as.numeric(strftime(indices, format = "%m%Y"))
         } else {
             stop("Parameter 'freq' must be numeric or a character: ",
-             "by 'day', 'month', 'year' or 'monthly' (for distingible month).")
+             "by 'day', 'month', 'year' or 'monthly' (for distinguable month).")
        }
     }
     repited <- unique(indices)
-- 
GitLab


From 0f79e302e5cfe688253c6d6504598b060dbfccfe Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Mon, 25 Nov 2019 11:04:21 +0100
Subject: [PATCH 24/26] doc freq parameter improved

---
 R/CST_SplitDim.R    | 9 +++++----
 man/CST_SplitDim.Rd | 6 +++---
 man/SplitDim.Rd     | 4 ++--
 3 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/R/CST_SplitDim.R b/R/CST_SplitDim.R
index 1987feaa..d856bdb2 100644
--- a/R/CST_SplitDim.R
+++ b/R/CST_SplitDim.R
@@ -6,8 +6,8 @@
 #'
 #'@param data a 's2dv_cube' object
 #'@param split_dim a character string indicating the name of the dimension to split
-#'@param indices a vector of numeric indices or dates
-#'@param freq a character string indicating the frequency given parameter indices as dates.
+#'@param indices a vector of numeric indices or dates, however dates provided along with parameter data (element 'Dates' of the 's2dvube' object) will be used if inidices are NULL.
+#'@param freq a character string indicating the frequency: by 'day', 'month' and 'year' or 'monthly' (by default). 'month' identify months between 1 and 12 independetly of the year they belong, while 'monthly' differentciate months from different years.
 #'
 #'@import abind
 #'@import s2dverification
@@ -67,7 +67,7 @@ CST_SplitDim <- function(data, split_dim = 'time', indices = NULL,
 #'@param data an n-dimensional array with named dimensions
 #'@param split_dim a character string indicating the name of the dimension to split
 #'@param indices a vector of numeric indices or dates
-#'@param freq a character string indicating the frequency given parameter indices as dates.
+#'@param freq a character string indicating the frequency: by 'day', 'month' and 'year' or 'monthly' (by default). 'month' identify months between 1 and 12 independetly of the year they belong, while 'monthly' differentciate months from different years. Parameter 'freq' can also be numeric indicating the length in which to subset the dimension
 #'
 #'@import abind
 #'@import s2dverification
@@ -169,7 +169,8 @@ SplitDim <- function(data, split_dim = 'time', indices, freq = 'monthly') {
             indices <- as.numeric(strftime(indices, format = "%m%Y"))
         } else {
             stop("Parameter 'freq' must be numeric or a character: ",
-             "by 'day', 'month', 'year' or 'monthly' (for distinguable month).")
+             "by 'day', 'month', 'year' or 'monthly' (for ",
+             "distinguishable month).")
        }
     }
     repited <- unique(indices)
diff --git a/man/CST_SplitDim.Rd b/man/CST_SplitDim.Rd
index f8220ce9..f5ac908a 100644
--- a/man/CST_SplitDim.Rd
+++ b/man/CST_SplitDim.Rd
@@ -11,12 +11,12 @@ CST_SplitDim(data, split_dim = "time", indices = NULL, freq = "monthly")
 
 \item{split_dim}{a character string indicating the name of the dimension to split}
 
-\item{indices}{a vector of numeric indices or dates}
+\item{indices}{a vector of numeric indices or dates, however dates provided along with parameter data (element 'Dates' of the 's2dvube' object) will be used if inidices are NULL.}
 
-\item{freq}{a character string indicating the frequency given parameter indices as dates.}
+\item{freq}{a character string indicating the frequency: by 'day', 'month' and 'year' or 'monthly' (by default). 'month' identify months between 1 and 12 independetly of the year they belong, while 'monthly' differentciate months from different years.}
 }
 \description{
-This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, moth and year). The user can also provide a numeric frequency indicating the length of each division.
+This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, month and year). The user can also provide a numeric frequency indicating the length of each division.
 }
 \examples{
 
diff --git a/man/SplitDim.Rd b/man/SplitDim.Rd
index 3812224b..6c7aac09 100644
--- a/man/SplitDim.Rd
+++ b/man/SplitDim.Rd
@@ -13,10 +13,10 @@ SplitDim(data, split_dim = "time", indices, freq = "monthly")
 
 \item{indices}{a vector of numeric indices or dates}
 
-\item{freq}{a character string indicating the frequency given parameter indices as dates.}
+\item{freq}{a character string indicating the frequency: by 'day', 'month' and 'year' or 'monthly' (by default). 'month' identify months between 1 and 12 independetly of the year they belong, while 'monthly' differentciate months from different years. Parameter 'freq' can also be numeric indicating the length in which to subset the dimension}
 }
 \description{
-This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, moth and year). The user can also provide a numeric frequency indicating the length of each division.
+This function split a dimension in two. The user can select the dimension to split and provide indices indicating how to split that dimension or dates and the frequency expected (monthly or by day, month and year). The user can also provide a numeric frequency indicating the length of each division.
 }
 \examples{
 
-- 
GitLab


From a22c2fec67541d23e27f1bbd60d4be3094d6ef8c Mon Sep 17 00:00:00 2001
From: jhardenberg <hardenberg@gmail.com>
Date: Mon, 25 Nov 2019 14:28:09 +0100
Subject: [PATCH 25/26] fixed typos

---
 R/CST_SplitDim.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/CST_SplitDim.R b/R/CST_SplitDim.R
index d856bdb2..e0b50eb4 100644
--- a/R/CST_SplitDim.R
+++ b/R/CST_SplitDim.R
@@ -6,8 +6,8 @@
 #'
 #'@param data a 's2dv_cube' object
 #'@param split_dim a character string indicating the name of the dimension to split
-#'@param indices a vector of numeric indices or dates, however dates provided along with parameter data (element 'Dates' of the 's2dvube' object) will be used if inidices are NULL.
-#'@param freq a character string indicating the frequency: by 'day', 'month' and 'year' or 'monthly' (by default). 'month' identify months between 1 and 12 independetly of the year they belong, while 'monthly' differentciate months from different years.
+#'@param indices a vector of numeric indices or dates, however dates provided along with parameter data (element 'Dates' of the 's2dvube' object) will be used if indices are NULL.
+#'@param freq a character string indicating the frequency: by 'day', 'month' and 'year' or 'monthly' (by default). 'month' identifies months between 1 and 12 independently of the year they belong to, while 'monthly' differenciates months from different years.
 #'
 #'@import abind
 #'@import s2dverification
-- 
GitLab


From 1166faa128edb7afd5bd6111b6ae5b69141d0cbe Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Mon, 25 Nov 2019 15:02:38 +0100
Subject: [PATCH 26/26] indices description improved

---
 R/CST_SplitDim.R    | 2 +-
 man/CST_SplitDim.Rd | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/CST_SplitDim.R b/R/CST_SplitDim.R
index 5e94159d..ce65e07f 100644
--- a/R/CST_SplitDim.R
+++ b/R/CST_SplitDim.R
@@ -6,7 +6,7 @@
 #'
 #'@param data a 's2dv_cube' object
 #'@param split_dim a character string indicating the name of the dimension to split
-#'@param indices a vector of numeric indices or dates, however dates provided along with parameter data (element 'Dates' of the 's2dvube' object) will be used if indices are NULL.
+#'@param indices a vector of numeric indices or dates. If left at NULL, the dates provided in the s2dv_cube object (element Dates) will be used.
 #'@param freq a character string indicating the frequency: by 'day', 'month' and 'year' or 'monthly' (by default). 'month' identifies months between 1 and 12 independently of the year they belong to, while 'monthly' differenciates months from different years.
 #'
 #'@import abind
diff --git a/man/CST_SplitDim.Rd b/man/CST_SplitDim.Rd
index 54a26c26..2019ea7b 100644
--- a/man/CST_SplitDim.Rd
+++ b/man/CST_SplitDim.Rd
@@ -11,7 +11,7 @@ CST_SplitDim(data, split_dim = "time", indices = NULL, freq = "monthly")
 
 \item{split_dim}{a character string indicating the name of the dimension to split}
 
-\item{indices}{a vector of numeric indices or dates, however dates provided along with parameter data (element 'Dates' of the 's2dvube' object) will be used if indices are NULL.}
+\item{indices}{a vector of numeric indices or dates. If left at NULL, the dates provided in the s2dv_cube object (element Dates) will be used.}
 
 \item{freq}{a character string indicating the frequency: by 'day', 'month' and 'year' or 'monthly' (by default). 'month' identifies months between 1 and 12 independently of the year they belong to, while 'monthly' differenciates months from different years.}
 }
-- 
GitLab