From 0e181684d420d702cddab3b94a4ab6d8a84ac509 Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Thu, 28 Jan 2021 19:18:34 +0100
Subject: [PATCH 01/12] Threshold function

---
 NAMESPACE            |   3 +
 R/Threshold.R        | 143 +++++++++++++++++++++++++++++++++++++++++++
 man/CST_Threshold.Rd |  58 ++++++++++++++++++
 man/Threshold.Rd     |  55 +++++++++++++++++
 4 files changed, 259 insertions(+)
 create mode 100644 R/Threshold.R
 create mode 100644 man/CST_Threshold.Rd
 create mode 100644 man/Threshold.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 80f1ec6..66737d4 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,7 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
 export(CST_PeriodAccumulation)
+export(CST_Threshold)
 export(PeriodAccumulation)
 export(SelectPeriodOnData)
 export(SelectPeriodOnDates)
+export(Threshold)
 import(multiApply)
+importFrom(stats,quantile)
diff --git a/R/Threshold.R b/R/Threshold.R
new file mode 100644
index 0000000..7c84329
--- /dev/null
+++ b/R/Threshold.R
@@ -0,0 +1,143 @@
+#'Absolute value of a relative threshold (percentile)
+#'
+#'Frequently, thresholds are defined by a percentile that may correspond to a different absolute value depending on the variable, gridpoint and also julian day (time).
+#' This function calculates the corresponding value of a percentile given a dataset.
+#'
+#'@param data an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools.
+#'@param threshold a single scalar or vector indicating the relative threshold(s).
+#'@param start an optional parameter to defined the initial date of the period to select from the data by providing a list of two elements: the initial date of the period and the initial month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.
+#'@param end an optional parameter to defined the final date of the period to select from the data by providing a list of two elements: the final day of the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.
+#'@param time_dim a character string indicating the name of the temporal dimension. By default, it is set to 'ftime'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified. This dimension is required to subset the data in a requested period.
+#'@param memb_dim a character string indicating the name of the dimension in which the ensemble members are stored. When set it to NULL, threshold is computed for individual members.
+#'@param sdate_dim a character string indicating the name of the dimension in which the initialization dates are stored. 
+#'@param na.rm a logical value indicating whether to ignore NA values (TRUE) or  not (FALSE). 
+#'@param ncores an integer indicating the number of cores to use in parallel computation.
+#'
+#'@return A 's2dv_cube' object containing the probabilites in the element \code{data}.
+#'
+#'@import multiApply
+#'
+#'@examples
+#'threshold <- 0.9
+#'exp <- CSTools::lonlat_prec
+#'exp_probs <- CST_Threshold(exp, threshold)
+#'exp$data <- array(rnorm(5 * 3 * 214 * 2),
+#'                    c(member = 5, sdate = 3, ftime = 214, lon = 2)) 
+#'exp$Dates[[1]] <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), 
+#'                     as.Date("30-11-2000", format = "%d-%m-%Y"), by = 'day'),
+#'                 seq(as.Date("01-05-2001", format = "%d-%m-%Y"), 
+#'                     as.Date("30-11-2001", format = "%d-%m-%Y"), by = 'day'),
+#'                 seq(as.Date("01-05-2002", format = "%d-%m-%Y"), 
+#'                     as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day'))
+#'exp_probs <- CST_Threshold(exp, threshold, start = list(21, 4), end = list(21, 6))
+#'@export
+CST_Threshold <- function(data, threshold, start = NULL, end = NULL,
+                           time_dim = 'ftime', memb_dim = 'member', sdate_dim = 'sdate',
+                           na.rm = FALSE, ncores = NULL) {
+    if (!inherits(data, 's2dv_cube')) {
+    stop("Parameter 'data' must be of the class 's2dv_cube', ",
+         "as output by CSTools::CST_Load.")
+  }
+  # when subsetting is needed, dimensions are also needed:
+  if (!is.null(start) && !is.null(end)) {
+    if (is.null(dim(data$Dates$start))) {
+      if (length(data$Dates$start) != dim(data$data)[time_dim]) {
+        if (length(data$Dates$start) == 
+            prod(dim(data$data)[time_dim] * dim(data$data)['sdate'])) {
+          dim(data$Dates$start) <- c(dim(data$data)[time_dim],
+                                     dim(data$data)['sdate'])
+        }
+      } else {
+        warning("Dimensions in 'data' element 'Dates$start' are missed and",
+                "all data would be used.")
+      }
+    }
+  }
+  thres <- Threshold(data$data, threshold, data$Dates[[1]], start, end,
+                      time_dim = time_dim, memb_dim = memb_dim,
+                      sdate_dim = sdate_dim, na.rm = na.rm, ncores = ncores)
+  data$data <- thres
+  if (!is.null(start) && !is.null(end)) {
+     data$Dates <- SelectPeriodOnDates(dates = data$Dates[[1]],
+                                start = start, end = end, 
+                                time_dim = time_dim, ncores = ncores)
+  }
+  return(data)
+}
+#'Absolute value of a relative threshold (percentile)
+#'
+#'Frequently, thresholds are defined by a percentile that may correspond to a different absolute value depending on the variable, gridpoint and also julian day (time).
+#' This function calculates the corresponding value of a percentile given a dataset.
+#'
+#'@param data a multidimensional array with named dimensions.
+#'@param threshold a single scalar or vector indicating the relative threshold(s).
+#'@param dates a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data'. By default it is NULL, to select a period this parameter must be provided.
+#'@param start an optional parameter to defined the initial date of the period to select from the data by providing a list of two elements: the initial date of the period and the initial month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.
+#'@param end an optional parameter to defined the final date of the period to select from the data by providing a list of two elements: the final day of the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.
+#'@param time_dim a character string indicating the name of the temporal dimension. By default, it is set to 'ftime'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified. This dimension is required to subset the data in a requested period.
+#'@param memb_dim a character string indicating the name of the dimension in which the ensemble members are stored. When set it to NULL, threshold is computed for individual members.
+#'@param sdate_dim a character string indicating the name of the dimension in which the initialization dates are stored.
+#'@param na.rm a logical value indicating whether to ignore NA values (TRUE) or  not (FALSE). 
+#'@param ncores an integer indicating the number of cores to use in parallel computation.
+#'
+#'@return A multidimensional array with named dimensions.
+#'
+#'@import multiApply
+#'@importFrom stats quantile
+#'
+#'@examples
+#'threshold = 0.9
+#'data <- array(rnorm(25 * 3 * 214 * 2, mean = 26), 
+#'              c(member = 25, sdate = 3, time = 214, lon = 2)) 
+#'thres_q <- Threshold(data, threshold)
+#'data <- array(rnorm(1 * 3 * 214 * 2), c(member = 1, sdate = 3, time = 214, lon = 2))
+#'res <- Threshold(data, threshold)
+#'@export
+Threshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL,
+                      time_dim = 'time', memb_dim = 'member', sdate_dim = 'sdate',
+                      na.rm = FALSE, ncores = NULL) {
+  if (is.null(data)) {
+    stop("Parameter 'data' cannot be NULL.")
+  }
+  if (!is.numeric(data)) {
+    stop("Parameter 'data' must be numeric.")
+  }
+  
+  if (!is.array(data)) {
+    dim(data) <- c(length(data), 1)
+    names(dim(data)) <- c(memb_dim, sdate_dim)
+  }
+  if (is.null(threshold)) {
+      stop("Parameter 'threshold' cannot be NULL.")
+  }
+   if (!is.numeric(threshold)) {
+    stop("Parameter 'threshold' must be numeric.")
+  }
+  if (is.null(names(dim(data)))) {
+    stop("Parameter 'data' must have named dimensions.")
+  }
+  if (!is.null(dates)) {
+    if (!is.null(start) && !is.null(end)) {
+      if (!any(c(is.list(start), is.list(end)))) {
+        stop("Parameter 'start' and 'end' must be lists indicating the ",
+             "day and the month of the period start and end.")
+      }
+      data <- SelectPeriodOnData(data, dates, start, end, 
+                                 time_dim = time_dim, ncores = ncores)
+    }
+  }   
+  if (!is.null(memb_dim)) {
+    dimensions <- c(sdate_dim, memb_dim)
+  } else {
+    dimensions <- sdate_dim
+  }
+  if (length(threshold) == 1) {
+    thres <- Apply(data, target_dims = dimensions,
+             fun = function(x) {quantile(as.vector(x), threshold, na.rm)})$output1
+  } else {
+    thres <- Apply(data, target_dims = dimensions,
+             fun = function(x) {quantile(as.vector(x), threshold, na.rm)},
+             output_dims = 'probs')$output1
+  }
+  return(thres)
+}
diff --git a/man/CST_Threshold.Rd b/man/CST_Threshold.Rd
new file mode 100644
index 0000000..bff93fa
--- /dev/null
+++ b/man/CST_Threshold.Rd
@@ -0,0 +1,58 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/Threshold.R
+\name{CST_Threshold}
+\alias{CST_Threshold}
+\title{Absolute value of a relative threshold (percentile)}
+\usage{
+CST_Threshold(
+  data,
+  threshold,
+  start = NULL,
+  end = NULL,
+  time_dim = "ftime",
+  memb_dim = "member",
+  sdate_dim = "sdate",
+  na.rm = FALSE,
+  ncores = NULL
+)
+}
+\arguments{
+\item{data}{an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools.}
+
+\item{threshold}{a single scalar or vector indicating the relative threshold(s).}
+
+\item{start}{an optional parameter to defined the initial date of the period to select from the data by providing a list of two elements: the initial date of the period and the initial month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.}
+
+\item{end}{an optional parameter to defined the final date of the period to select from the data by providing a list of two elements: the final day of the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.}
+
+\item{time_dim}{a character string indicating the name of the temporal dimension. By default, it is set to 'ftime'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified. This dimension is required to subset the data in a requested period.}
+
+\item{memb_dim}{a character string indicating the name of the dimension in which the ensemble members are stored. When set it to NULL, threshold is computed for individual members.}
+
+\item{sdate_dim}{a character string indicating the name of the dimension in which the initialization dates are stored.}
+
+\item{na.rm}{a logical value indicating whether to ignore NA values (TRUE) or  not (FALSE).}
+
+\item{ncores}{an integer indicating the number of cores to use in parallel computation.}
+}
+\value{
+A 's2dv_cube' object containing the probabilites in the element \code{data}.
+}
+\description{
+Frequently, thresholds are defined by a percentile that may correspond to a different absolute value depending on the variable, gridpoint and also julian day (time).
+This function calculates the corresponding value of a percentile given a dataset.
+}
+\examples{
+threshold <- 0.9
+exp <- CSTools::lonlat_prec
+exp_probs <- CST_Threshold(exp, threshold)
+exp$data <- array(rnorm(5 * 3 * 214 * 2),
+                   c(member = 5, sdate = 3, ftime = 214, lon = 2)) 
+exp$Dates[[1]] <- c(seq(as.Date("01-05-2000", format = "\%d-\%m-\%Y"), 
+                    as.Date("30-11-2000", format = "\%d-\%m-\%Y"), by = 'day'),
+                seq(as.Date("01-05-2001", format = "\%d-\%m-\%Y"), 
+                    as.Date("30-11-2001", format = "\%d-\%m-\%Y"), by = 'day'),
+                seq(as.Date("01-05-2002", format = "\%d-\%m-\%Y"), 
+                    as.Date("30-11-2002", format = "\%d-\%m-\%Y"), by = 'day'))
+exp_probs <- CST_Threshold(exp, threshold, start = list(21, 4), end = list(21, 6))
+}
diff --git a/man/Threshold.Rd b/man/Threshold.Rd
new file mode 100644
index 0000000..119be73
--- /dev/null
+++ b/man/Threshold.Rd
@@ -0,0 +1,55 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/Threshold.R
+\name{Threshold}
+\alias{Threshold}
+\title{Absolute value of a relative threshold (percentile)}
+\usage{
+Threshold(
+  data,
+  threshold,
+  dates = NULL,
+  start = NULL,
+  end = NULL,
+  time_dim = "time",
+  memb_dim = "member",
+  sdate_dim = "sdate",
+  na.rm = FALSE,
+  ncores = NULL
+)
+}
+\arguments{
+\item{data}{a multidimensional array with named dimensions.}
+
+\item{threshold}{a single scalar or vector indicating the relative threshold(s).}
+
+\item{dates}{a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data'. By default it is NULL, to select a period this parameter must be provided.}
+
+\item{start}{an optional parameter to defined the initial date of the period to select from the data by providing a list of two elements: the initial date of the period and the initial month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.}
+
+\item{end}{an optional parameter to defined the final date of the period to select from the data by providing a list of two elements: the final day of the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.}
+
+\item{time_dim}{a character string indicating the name of the temporal dimension. By default, it is set to 'ftime'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified. This dimension is required to subset the data in a requested period.}
+
+\item{memb_dim}{a character string indicating the name of the dimension in which the ensemble members are stored. When set it to NULL, threshold is computed for individual members.}
+
+\item{sdate_dim}{a character string indicating the name of the dimension in which the initialization dates are stored.}
+
+\item{na.rm}{a logical value indicating whether to ignore NA values (TRUE) or  not (FALSE).}
+
+\item{ncores}{an integer indicating the number of cores to use in parallel computation.}
+}
+\value{
+A multidimensional array with named dimensions.
+}
+\description{
+Frequently, thresholds are defined by a percentile that may correspond to a different absolute value depending on the variable, gridpoint and also julian day (time).
+This function calculates the corresponding value of a percentile given a dataset.
+}
+\examples{
+threshold = 0.9
+data <- array(rnorm(25 * 3 * 214 * 2, mean = 26), 
+             c(member = 25, sdate = 3, time = 214, lon = 2)) 
+thres_q <- Threshold(data, threshold)
+data <- array(rnorm(1 * 3 * 214 * 2), c(member = 1, sdate = 3, time = 214, lon = 2))
+res <- Threshold(data, threshold)
+}
-- 
GitLab


From 470a800bcf87f5615d411a65017893e7cb879c27 Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Fri, 29 Jan 2021 10:34:54 +0100
Subject: [PATCH 02/12] tests Threshold

---
 R/Threshold.R                   |  2 +-
 tests/testthat.R                |  4 ++++
 tests/testthat/test-Threshold.R | 37 +++++++++++++++++++++++++++++++++
 3 files changed, 42 insertions(+), 1 deletion(-)
 create mode 100644 tests/testthat.R
 create mode 100644 tests/testthat/test-Threshold.R

diff --git a/R/Threshold.R b/R/Threshold.R
index 7c84329..c09ebe0 100644
--- a/R/Threshold.R
+++ b/R/Threshold.R
@@ -86,7 +86,7 @@ CST_Threshold <- function(data, threshold, start = NULL, end = NULL,
 #'@importFrom stats quantile
 #'
 #'@examples
-#'threshold = 0.9
+#'threshold <- 0.9
 #'data <- array(rnorm(25 * 3 * 214 * 2, mean = 26), 
 #'              c(member = 25, sdate = 3, time = 214, lon = 2)) 
 #'thres_q <- Threshold(data, threshold)
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000..79cf4a7
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(CSIndicators)
+
+test_check("CSIndicators")
diff --git a/tests/testthat/test-Threshold.R b/tests/testthat/test-Threshold.R
new file mode 100644
index 0000000..94a71aa
--- /dev/null
+++ b/tests/testthat/test-Threshold.R
@@ -0,0 +1,37 @@
+context("Generic tests")
+test_that("Sanity checks", {
+  #source("csindicators/R/Threshold.R")
+  expect_error(Threshold(NULL),
+    "Parameter 'data' cannot be NULL.")
+  expect_error(Threshold('x'),
+   "Parameter 'data' must be numeric.")
+  data <- 1:20
+  expect_error(Threshold(data, NULL),
+    "Parameter 'threshold' cannot be NULL.")
+  expect_error(Threshold(data, 'x'),
+    "Parameter 'threshold' must be numeric.")
+  threshold <- 0.9
+  expect_equal(Threshold(data, threshold), 18.1)
+  dim(data) <- c(2, 10)
+  expect_error(Threshold(data, threshold),
+    "Parameter 'data' must have named dimensions.")
+  names(dim(data)) <- c('lat', 'sdate')
+  expect_error(Threshold(data, threshold),
+    "Could not find dimension 'member' in 1th object provided in 'data'.")
+  expect_equal(Threshold(data, threshold, memb_dim = NULL),
+               array(c(17.2, 18.2), c(lat = 2)))
+  threshold <- c(0.1, 0.2)
+  expect_equal(Threshold(data, threshold, memb_dim = NULL),
+               array(c(2.8, 4.6, 3.8, 5.6), c(probs = 2, lat = 2)))
+  data <- array(1:40, c(x = 2, ftime = 20))
+  expect_error(Threshold(data, threshold),
+    "Could not find dimension 'sdate' in 1th object provided in 'data'.")
+  expect_equal(dim(Threshold(data, threshold, sdate_dim = 'ftime', memb_dim = NULL)),
+               c(probs = 2, x = 2))
+  # threshold with dimensions ?
+  dim(threshold) <- c(member = 2, ftime = 1)
+  expect_equal(dim(Threshold(data, threshold, sdate_dim = 'ftime', memb_dim = NULL)),
+               c(probs = 2, x = 2))
+  expect_equal(dim(Threshold(data, threshold, memb_dim = 'x', sdate_dim = 'ftime')),
+               c(probs = 2))
+})
-- 
GitLab


From 966151605350841fe078390ff82419386909c5cc Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Fri, 29 Jan 2021 13:08:27 +0100
Subject: [PATCH 03/12] TotalSpellTimeExceddingThreshold first version

---
 NAMESPACE                                   |   2 +
 R/TotalSpellTimeExceedingThreshold.R        | 180 ++++++++++++++++++++
 man/CST_TotalSpellTimeExceedingThreshold.Rd |  61 +++++++
 man/Threshold.Rd                            |   2 +-
 man/TotalSpellTimeExceedingThreshold.Rd     |  55 ++++++
 5 files changed, 299 insertions(+), 1 deletion(-)
 create mode 100644 R/TotalSpellTimeExceedingThreshold.R
 create mode 100644 man/CST_TotalSpellTimeExceedingThreshold.Rd
 create mode 100644 man/TotalSpellTimeExceedingThreshold.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 66737d4..c16ad03 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -2,9 +2,11 @@
 
 export(CST_PeriodAccumulation)
 export(CST_Threshold)
+export(CST_TotalSpellTimeExceedingThreshold)
 export(PeriodAccumulation)
 export(SelectPeriodOnData)
 export(SelectPeriodOnDates)
 export(Threshold)
+export(TotalSpellTimeExceedingThreshold)
 import(multiApply)
 importFrom(stats,quantile)
diff --git a/R/TotalSpellTimeExceedingThreshold.R b/R/TotalSpellTimeExceedingThreshold.R
new file mode 100644
index 0000000..438d1d5
--- /dev/null
+++ b/R/TotalSpellTimeExceedingThreshold.R
@@ -0,0 +1,180 @@
+#'Total Spell Time Exceeding Threshold
+#'
+#'The number of days (when daily data is provided) that are part of a spell (defined by its minimum length e.g. 6 consecutive days) that exceed (or not exceed) a threshold are calculated with \code{TotalSpellTimeExceedingThreshold}.
+#'This function allows to compute indicators widely used in Climate Services, such as:
+#'\itemize{
+#' \code{WSDI}{Warm Spell Duration Index that count the total number of days with at least 6 consecutive days when the daily temperature maximum exceeds its 90th percentile.}}
+#'This function requires the data and the threshold to be in the same units. The 90th percentile can be translate into absolute values given a reference dataset using function \code{Threshold} or the data can be transform into probabilites by using function \code{AbsToProbs}. See section @examples.
+#'@seealso [Threshold()] and [AbsToProbs()].
+#'
+#'@param data an 's2dv_cube' object as provided by function \code{CST_Load} in package CSTools.
+#'@param threshold an 's2dv_cube' object as output of a 'CST_' function in the same units as parameter 'data' and with the common dimensions of the element 'data' of the same length. A single scalar is also possible.
+#'@param spell a scalar indicating the minimum length of the spell.
+#'@param op a opartor '>' (by default), '<', '>=' or '<='. 
+#'@param start an optional parameter to defined the initial date of the period to select from the data by providing a list of two elements: the initial date of the period and the initial month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.
+#'@param end an optional parameter to defined the final date of the period to select from the data by providing a list of two elements: the final day of the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.
+#'@param time_dim a character string indicating the name of the function to compute the indicator. By default, it is set to 'ftime'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified.
+#'@param ncores an integer indicating the number of cores to use in parallel computation.
+#'
+#'@return A 's2dv_cube' object containing the indicator in the element \code{data}.
+#'
+#'@import multiApply
+#'@examples
+#'exp <- CSTools::lonlat_data$exp
+#'TTSET <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = 283, spell = 3)
+#'exp$data <- array(rnorm(5 * 3 * 214 * 2, mean = 25, sd = 3),
+#'                    c(memb = 5, sdate = 3, ftime = 214, lon = 2)) 
+#'exp$Dates[[1]] <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), 
+#'                     as.Date("30-11-2000", format = "%d-%m-%Y"), by = 'day'),
+#'                 seq(as.Date("01-05-2001", format = "%d-%m-%Y"), 
+#'                     as.Date("30-11-2001", format = "%d-%m-%Y"), by = 'day'),
+#'                 seq(as.Date("01-05-2002", format = "%d-%m-%Y"), 
+#'                     as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day'))
+#'#threshold <- QThreshold()
+#'WSDI <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = 35, spell = 6)
+#'@export
+CST_TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '>',
+                                            start = NULL, end = NULL,
+                                            time_dim = 'ftime',
+                                            ncores = NULL) {
+  if (!inherits(data, 's2dv_cube')) {
+    stop("Parameter 'data' must be of the class 's2dv_cube', ",
+         "as output by CSTools::CST_Load.")
+  }
+  # when subsetting is needed, dimensions are also needed:
+  if (!is.null(start) && !is.null(end)) {
+    if (is.null(dim(data$Dates$start))) {
+      if (length(data$Dates$start) != dim(data$data)[time_dim]) {
+        if (length(data$Dates$start) ==
+            prod(dim(data$data)[time_dim] * dim(data$data)['sdate'])) {
+          dim(data$Dates$start) <- c(dim(data$data)[time_dim],
+                                     dim(data$data)['sdate'])
+        }
+      } else {
+        warning("Dimensions in 'data' element 'Dates$start' are missed and",
+                "all data would be used.")
+      }
+    }
+ }
+ if (inherits(threshold, 's2dv_cube')) {
+    threshold <- threshold$data
+  }
+ total <- TotalSpellTimeExceedingThreshold(data$data, data$Dates[[1]],
+                                      threshold = threshold, spell = spell, op = op,
+                                      start = start, end = end, time_dim = time_dim,
+                                      ncores = ncores)
+  data$data <- total
+  if (!is.null(start) && !is.null(end)) {
+     data$Dates <- SelectPeriodOnDates(dates = data$Dates$start,
+                                       start = start, end = end,
+                                       time_dim = time_dim, ncores = ncores)
+  }
+  return(data)
+}
+#'Total Spell Time Exceeding Threshold
+#'
+#'The number of days (when daily data is provided) that are part of a spell (defined by its minimum length e.g. 6 consecutive days) that exceed (or not exceed) a threshold are calculated with \code{TotalSpellTimeExceedingThreshold}.
+#'This function allows to compute indicators widely used in Climate Services, such as:
+#'\itemize{
+#' \code{WSDI}{Warm Spell Duration Index that count the total number of days with at least 6 consecutive days when the daily temperature maximum exceeds its 90th percentile.}}
+#'This function requires the data and the threshold to be in the same units. The 90th percentile can be translate into absolute values given a reference dataset using function \code{Threshold} or the data can be transform into probabilites by using function \code{AbsToProbs}. See section @examples.
+#'@seealso [Threshold()] and [AbsToProbs()].
+#'
+#'@param data a multidimensional array with named dimensions.
+#'@param threshold a multidimensional array with named dimensions in the same units as parameter 'data' and with the common dimensions of the element 'data' of the same length.
+#'@param spell a scalar indicating the minimum length of the spell.
+#'@param op a opartor '>' (by default), '<', '>=' or '<='. 
+#'@param dates a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data'. By default it is NULL, to select a period this parameter must be provided.
+#'@param start an optional parameter to defined the initial date of the period to select from the data by providing a list of two elements: the initial date of the period and the initial month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.
+#'@param end an optional parameter to defined the final date of the period to select from the data by providing a list of two elements: the final day of the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.
+#'@param time_dim a character string indicating the name of the function to compute the indicator. By default, it is set to 'ftime'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified.
+#'@param ncores an integer indicating the number of cores to use in parallel computation.
+#'
+#'@return A multidimensional array with named dimensions.
+#'
+#'@import multiApply
+#'@examples
+#'data <- array(rnorm(120), c(sdate = 2, time = 20, lat = 4))
+#'threshold <- array(rnorm(4), c(lat = 4))
+#'total <- TotalSpellTimeExceedingThreshold(data, threshold, spell = 6)
+#'@export
+TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '>', dates = NULL,
+                                             start = NULL, end = NULL, time_dim = 'time',
+                                             ncores = NULL) {
+  if (is.null(data)) {
+    stop("Parameter 'data' cannot be NULL.")
+  }
+  if (!is.numeric(data)) {
+    stop("Parameter 'data' must be numeric.")
+  }
+  if (!is.array(data)) {
+    dim(data) <- length(data)
+    names(dim(data)) <- time_dim
+  }
+  if (is.null(threshold)) {
+        stop("Parameter 'threshold' cannot be NULL.")
+  }
+  if (!is.numeric(threshold)) {
+    stop("Parameter 'threshold' must be numeric.")
+  }
+  if (is.null(names(dim(data)))) {
+    stop("Parameter 'data' must have named dimensions.")
+  }
+  if (!is.null(dates)) {
+    if (!is.null(start) && !is.null(end)) {
+      if (!any(c(is.list(start), is.list(end)))) {
+        stop("Parameter 'start' and 'end' must be lists indicating the ",
+             "day and the month of the period start and end.")
+      }
+      if (time_dim %in% names(dim(threshold))) {
+        if (dim(threshold)[time_dim] == dim(data)[time_dim]) {
+            threshold <- SelectPeriodOnData(threshold, dates, start, end,
+                                           time_dim = time_dim, ncores = ncores)
+        }
+      }
+      data <- SelectPeriodOnData(data, dates, start, end, 
+                                 time_dim = time_dim, ncores = ncores)
+    }
+  }
+  if (is.null(dim(threshold))) {
+    total <- Apply(list(data), target_dims = time_dim,
+                   fun = .totalspellthres,
+                   threshold = threshold, spell = spell, op = op,
+                   ncores = ncores)$output1
+  } else {
+    total <- Apply(list(data, threshold), target_dims = list(time_dim, NULL), 
+                 fun = .totalspellthres, spell = spell, op = op)$output1
+  }
+  return(total) 
+}  
+#data <- c(1,1,3,3,3,3,1,1,3,1,1,3,3,3,3,3)
+#spell <- 3
+#threshold <- 2
+.totalspellthres <- function(data, threshold, spell, op = '>') {
+  # data a time serie, threshold single value:
+  if (op == '>') {
+    exceed <- data > threshold
+  } else if (op == '<') {
+    exceed <- data < threshold
+  } else if (op == '<=') {
+    exceed <- data <= threshold
+  } else {
+    exceed <- data >= threshold
+  }
+  spells_exceed <- sequence(rle(as.character(exceed))$lengths)
+  spells_exceed[exceed == FALSE] <- NA
+  pos_spells <- which(spells_exceed == spell)
+  total <- sum(unlist(lapply(pos_spells, function(y) {
+                        last_days <- x <- y
+                        while (!is.na(x)) {
+                          x <- spells_exceed[last_days + 1]
+                          last_days <- last_days + 1
+                        }    
+                        days <- length((y - spell + 1): (last_days - 1))
+                        return(days)
+                        })))
+  return(total)
+}
+
+
+
diff --git a/man/CST_TotalSpellTimeExceedingThreshold.Rd b/man/CST_TotalSpellTimeExceedingThreshold.Rd
new file mode 100644
index 0000000..43a6ebb
--- /dev/null
+++ b/man/CST_TotalSpellTimeExceedingThreshold.Rd
@@ -0,0 +1,61 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/TotalSpellTimeExceedingThreshold.R
+\name{CST_TotalSpellTimeExceedingThreshold}
+\alias{CST_TotalSpellTimeExceedingThreshold}
+\title{Total Spell Time Exceeding Threshold}
+\usage{
+CST_TotalSpellTimeExceedingThreshold(
+  data,
+  threshold,
+  spell,
+  op = ">",
+  start = NULL,
+  end = NULL,
+  time_dim = "ftime",
+  ncores = NULL
+)
+}
+\arguments{
+\item{data}{an 's2dv_cube' object as provided by function \code{CST_Load} in package CSTools.}
+
+\item{threshold}{an 's2dv_cube' object as output of a 'CST_' function in the same units as parameter 'data' and with the common dimensions of the element 'data' of the same length. A single scalar is also possible.}
+
+\item{spell}{a scalar indicating the minimum length of the spell.}
+
+\item{op}{a opartor '>' (by default), '<', '>=' or '<='.}
+
+\item{start}{an optional parameter to defined the initial date of the period to select from the data by providing a list of two elements: the initial date of the period and the initial month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.}
+
+\item{end}{an optional parameter to defined the final date of the period to select from the data by providing a list of two elements: the final day of the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.}
+
+\item{time_dim}{a character string indicating the name of the function to compute the indicator. By default, it is set to 'ftime'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified.}
+
+\item{ncores}{an integer indicating the number of cores to use in parallel computation.}
+}
+\value{
+A 's2dv_cube' object containing the indicator in the element \code{data}.
+}
+\description{
+The number of days (when daily data is provided) that are part of a spell (defined by its minimum length e.g. 6 consecutive days) that exceed (or not exceed) a threshold are calculated with \code{TotalSpellTimeExceedingThreshold}.
+This function allows to compute indicators widely used in Climate Services, such as:
+\itemize{
+\code{WSDI}{Warm Spell Duration Index that count the total number of days with at least 6 consecutive days when the daily temperature maximum exceeds its 90th percentile.}}
+This function requires the data and the threshold to be in the same units. The 90th percentile can be translate into absolute values given a reference dataset using function \code{Threshold} or the data can be transform into probabilites by using function \code{AbsToProbs}. See section @examples.
+}
+\examples{
+exp <- CSTools::lonlat_data$exp
+TTSET <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = 283, spell = 3)
+exp$data <- array(rnorm(5 * 3 * 214 * 2, mean = 25, sd = 3),
+                   c(memb = 5, sdate = 3, ftime = 214, lon = 2)) 
+exp$Dates[[1]] <- c(seq(as.Date("01-05-2000", format = "\%d-\%m-\%Y"), 
+                    as.Date("30-11-2000", format = "\%d-\%m-\%Y"), by = 'day'),
+                seq(as.Date("01-05-2001", format = "\%d-\%m-\%Y"), 
+                    as.Date("30-11-2001", format = "\%d-\%m-\%Y"), by = 'day'),
+                seq(as.Date("01-05-2002", format = "\%d-\%m-\%Y"), 
+                    as.Date("30-11-2002", format = "\%d-\%m-\%Y"), by = 'day'))
+#threshold <- QThreshold()
+WSDI <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = 35, spell = 6)
+}
+\seealso{
+[Threshold()] and [AbsToProbs()].
+}
diff --git a/man/Threshold.Rd b/man/Threshold.Rd
index 119be73..c2f3872 100644
--- a/man/Threshold.Rd
+++ b/man/Threshold.Rd
@@ -46,7 +46,7 @@ Frequently, thresholds are defined by a percentile that may correspond to a diff
 This function calculates the corresponding value of a percentile given a dataset.
 }
 \examples{
-threshold = 0.9
+threshold <- 0.9
 data <- array(rnorm(25 * 3 * 214 * 2, mean = 26), 
              c(member = 25, sdate = 3, time = 214, lon = 2)) 
 thres_q <- Threshold(data, threshold)
diff --git a/man/TotalSpellTimeExceedingThreshold.Rd b/man/TotalSpellTimeExceedingThreshold.Rd
new file mode 100644
index 0000000..39e4c89
--- /dev/null
+++ b/man/TotalSpellTimeExceedingThreshold.Rd
@@ -0,0 +1,55 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/TotalSpellTimeExceedingThreshold.R
+\name{TotalSpellTimeExceedingThreshold}
+\alias{TotalSpellTimeExceedingThreshold}
+\title{Total Spell Time Exceeding Threshold}
+\usage{
+TotalSpellTimeExceedingThreshold(
+  data,
+  threshold,
+  spell,
+  op = ">",
+  dates = NULL,
+  start = NULL,
+  end = NULL,
+  time_dim = "time",
+  ncores = NULL
+)
+}
+\arguments{
+\item{data}{a multidimensional array with named dimensions.}
+
+\item{threshold}{a multidimensional array with named dimensions in the same units as parameter 'data' and with the common dimensions of the element 'data' of the same length.}
+
+\item{spell}{a scalar indicating the minimum length of the spell.}
+
+\item{op}{a opartor '>' (by default), '<', '>=' or '<='.}
+
+\item{dates}{a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data'. By default it is NULL, to select a period this parameter must be provided.}
+
+\item{start}{an optional parameter to defined the initial date of the period to select from the data by providing a list of two elements: the initial date of the period and the initial month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.}
+
+\item{end}{an optional parameter to defined the final date of the period to select from the data by providing a list of two elements: the final day of the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.}
+
+\item{time_dim}{a character string indicating the name of the function to compute the indicator. By default, it is set to 'ftime'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified.}
+
+\item{ncores}{an integer indicating the number of cores to use in parallel computation.}
+}
+\value{
+A multidimensional array with named dimensions.
+}
+\description{
+The number of days (when daily data is provided) that are part of a spell (defined by its minimum length e.g. 6 consecutive days) that exceed (or not exceed) a threshold are calculated with \code{TotalSpellTimeExceedingThreshold}.
+This function allows to compute indicators widely used in Climate Services, such as:
+\itemize{
+\code{WSDI}{Warm Spell Duration Index that count the total number of days with at least 6 consecutive days when the daily temperature maximum exceeds its 90th percentile.}}
+This function requires the data and the threshold to be in the same units. The 90th percentile can be translate into absolute values given a reference dataset using function \code{Threshold} or the data can be transform into probabilites by using function \code{AbsToProbs}. See section @examples.
+}
+\examples{
+data <- array(rnorm(120), c(sdate = 2, time = 20, lat = 4))
+threshold <- array(rnorm(4), c(lat = 4))
+total <- TotalSpellTimeExceedingThreshold(data, threshold, spell = 6)
+}
+\seealso{
+[Threshold()] and [AbsToProbs()].
+}
-- 
GitLab


From bd6d3c9a5921edcb89c8bd2fcb17a055fefca0f7 Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Fri, 29 Jan 2021 13:41:10 +0100
Subject: [PATCH 04/12] tests for TotalSpellTimeExceedingThreshold

---
 R/TotalSpellTimeExceedingThreshold.R          |  3 --
 .../test-TotalSpellTimeExceedingThreshold.R   | 39 +++++++++++++++++++
 2 files changed, 39 insertions(+), 3 deletions(-)
 create mode 100644 tests/testthat/test-TotalSpellTimeExceedingThreshold.R

diff --git a/R/TotalSpellTimeExceedingThreshold.R b/R/TotalSpellTimeExceedingThreshold.R
index 438d1d5..554f18a 100644
--- a/R/TotalSpellTimeExceedingThreshold.R
+++ b/R/TotalSpellTimeExceedingThreshold.R
@@ -175,6 +175,3 @@ TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '>', d
                         })))
   return(total)
 }
-
-
-
diff --git a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
new file mode 100644
index 0000000..ded27eb
--- /dev/null
+++ b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
@@ -0,0 +1,39 @@
+context("Generic tests")
+test_that("Sanity checks", {
+  #source("csindicators/R/TotalSpellTimeExceedingThreshold.R")
+  expect_error(TotalSpellTimeExceedingThreshold(NULL), 
+    "Parameter 'data' cannot be NULL.")
+  expect_error(TotalSpellTimeExceedingThreshold('x'),
+   "Parameter 'data' must be numeric.")
+  data <- 1:20
+  expect_error(TotalSpellTimeExceedingThreshold(data, NULL),
+    "Parameter 'threshold' cannot be NULL.")
+  expect_error(TotalSpellTimeExceedingThreshold(data, 'x'),
+    "Parameter 'threshold' must be numeric.")
+  threshold <- 10
+  expect_error(TotalSpellTimeExceedingThreshold(data, threshold),
+    paste("argument", '"spell"', "is missing, with no default"))
+  dim(data) <- c(2, 10)
+  expect_error(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2),
+    "Parameter 'data' must have named dimensions.")
+  names(dim(data)) <- c('lat', 'time')
+  threshold <- array(1:2, 2)
+  expect_equal(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2),
+    array(c(9, 10, 9, 9), c(lat = 2, 2)))
+  dim(threshold) <- c(time = 2)
+  expect_equal(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2),  
+      array(c(9, 10, 9, 9), c(lat = 2, time = 2)))
+  data <- array(1:40, c(x = 2, ftime = 20))
+  expect_error(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2),
+    "Could not find dimension 'time' in 1th object provided in 'data'.")    
+  threshold <- 10
+  expect_equal(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2, time_dim = 'ftime'), 
+               array(c(15, 15), c(x = 2)))
+  dim(threshold) <- c(member = 1, ftime = 1)
+  expect_equal(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2, time_dim = 'ftime'), 
+               array(c(15, 15), c(x = 2, member = 1, ftime = 1)))
+  expect_error(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2, time_dim = 'x'),
+     paste("Found one or more margin dimensions with the same name and different",
+           "length in some of the input objects in 'data'."))
+
+})
-- 
GitLab


From 044b083ce3323236a45bd552016a4adc6cc59478 Mon Sep 17 00:00:00 2001
From: Chihchung Chou <chihchung.chou@bsc.es>
Date: Mon, 8 Feb 2021 06:47:33 +0100
Subject: [PATCH 05/12] add threshold contains time_dim and examples

---
 R/TotalSpellTimeExceedingThreshold.R | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/R/TotalSpellTimeExceedingThreshold.R b/R/TotalSpellTimeExceedingThreshold.R
index 554f18a..0dee866 100644
--- a/R/TotalSpellTimeExceedingThreshold.R
+++ b/R/TotalSpellTimeExceedingThreshold.R
@@ -8,7 +8,7 @@
 #'@seealso [Threshold()] and [AbsToProbs()].
 #'
 #'@param data an 's2dv_cube' object as provided by function \code{CST_Load} in package CSTools.
-#'@param threshold an 's2dv_cube' object as output of a 'CST_' function in the same units as parameter 'data' and with the common dimensions of the element 'data' of the same length. A single scalar is also possible.
+#'@param threshold an 's2dv_cube' object as output of a 'CST_' function in the same units as parameter 'data' and with the common dimensions of the element 'data' of the same length. A single scalar is also possible. If \code{timd_dim} is in the dimension (with the same length as \code{data}), the comparison will be done day by day. 
 #'@param spell a scalar indicating the minimum length of the spell.
 #'@param op a opartor '>' (by default), '<', '>=' or '<='. 
 #'@param start an optional parameter to defined the initial date of the period to select from the data by providing a list of two elements: the initial date of the period and the initial month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.
@@ -30,8 +30,11 @@
 #'                     as.Date("30-11-2001", format = "%d-%m-%Y"), by = 'day'),
 #'                 seq(as.Date("01-05-2002", format = "%d-%m-%Y"), 
 #'                     as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day'))
-#'#threshold <- QThreshold()
+#'# compare with the scalar fixed threshold
 #'WSDI <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = 35, spell = 6)
+#'# compare with percentile
+#'thresholdP <- Threshold(exp$data, threshold = 0.9)
+#'WSDI_P <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = thresholdP, spell = 6) 
 #'@export
 CST_TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '>',
                                             start = NULL, end = NULL,
@@ -81,7 +84,7 @@ CST_TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '>
 #'@seealso [Threshold()] and [AbsToProbs()].
 #'
 #'@param data a multidimensional array with named dimensions.
-#'@param threshold a multidimensional array with named dimensions in the same units as parameter 'data' and with the common dimensions of the element 'data' of the same length.
+#'@param threshold a multidimensional array with named dimensions in the same units as parameter 'data' and with the common dimensions of the element 'data' of the same length. If \code{timd_dim} is in the dimension (with the same length as \code{data}), the comparison will be done day by day.
 #'@param spell a scalar indicating the minimum length of the spell.
 #'@param op a opartor '>' (by default), '<', '>=' or '<='. 
 #'@param dates a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data'. By default it is NULL, to select a period this parameter must be provided.
@@ -94,9 +97,12 @@ CST_TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '>
 #'
 #'@import multiApply
 #'@examples
-#'data <- array(rnorm(120), c(sdate = 2, time = 20, lat = 4))
+#'data <- array(rnorm(120), c(member = 1, sdate = 2, time = 20, lat = 4))
 #'threshold <- array(rnorm(4), c(lat = 4))
 #'total <- TotalSpellTimeExceedingThreshold(data, threshold, spell = 6)
+#'# compare with percentile
+#'thresholdP <- Threshold(data, threshold = 0.9)
+#'total_P <- TotalSpellTimeExceedingThreshold(data, threshold = thresholdP, spell = 6)
 #'@export
 TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '>', dates = NULL,
                                              start = NULL, end = NULL, time_dim = 'time',
@@ -141,6 +147,10 @@ TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '>', d
                    fun = .totalspellthres,
                    threshold = threshold, spell = spell, op = op,
                    ncores = ncores)$output1
+  } else if (time_dim %in% names(dim(threshold))) {
+    total <- Apply(list(data, threshold), target_dims = list(time_dim, time_dim),
+                 fun = .totalspellthres, spell = spell, op = op)$output1
+
   } else {
     total <- Apply(list(data, threshold), target_dims = list(time_dim, NULL), 
                  fun = .totalspellthres, spell = spell, op = op)$output1
-- 
GitLab


From a753a00dcab25e3d4e7c8fbd2ebeeefaef069bd4 Mon Sep 17 00:00:00 2001
From: Chihchung Chou <chihchung.chou@bsc.es>
Date: Mon, 8 Feb 2021 14:44:21 +0100
Subject: [PATCH 06/12] test file revised

---
 tests/testthat/test-TotalSpellTimeExceedingThreshold.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
index ded27eb..82a5e70 100644
--- a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
+++ b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
@@ -16,13 +16,13 @@ test_that("Sanity checks", {
   dim(data) <- c(2, 10)
   expect_error(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2),
     "Parameter 'data' must have named dimensions.")
-  names(dim(data)) <- c('lat', 'time')
+  names(dim(data)) <- c('time', 'lat')
   threshold <- array(1:2, 2)
   expect_equal(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2),
     array(c(9, 10, 9, 9), c(lat = 2, 2)))
   dim(threshold) <- c(time = 2)
   expect_equal(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2),  
-      array(c(9, 10, 9, 9), c(lat = 2, time = 2)))
+    array(c(0,rep(2,19)), c(lat = 20)))
   data <- array(1:40, c(x = 2, ftime = 20))
   expect_error(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2),
     "Could not find dimension 'time' in 1th object provided in 'data'.")    
-- 
GitLab


From e0f0456a6f1d2636b02cc4cb456916fa607c900d Mon Sep 17 00:00:00 2001
From: Chihchung Chou <chihchung.chou@bsc.es>
Date: Mon, 8 Feb 2021 14:54:35 +0100
Subject: [PATCH 07/12] test revised

---
 tests/testthat/test-TotalSpellTimeExceedingThreshold.R | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

diff --git a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
index 82a5e70..800c5af 100644
--- a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
+++ b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
@@ -18,11 +18,9 @@ test_that("Sanity checks", {
     "Parameter 'data' must have named dimensions.")
   names(dim(data)) <- c('time', 'lat')
   threshold <- array(1:2, 2)
-  expect_equal(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2),
-    array(c(9, 10, 9, 9), c(lat = 2, 2)))
   dim(threshold) <- c(time = 2)
   expect_equal(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2),  
-    array(c(0,rep(2,19)), c(lat = 20)))
+    array(c(0,rep(2,9)), c(lat = 10))
   data <- array(1:40, c(x = 2, ftime = 20))
   expect_error(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2),
     "Could not find dimension 'time' in 1th object provided in 'data'.")    
@@ -33,7 +31,6 @@ test_that("Sanity checks", {
   expect_equal(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2, time_dim = 'ftime'), 
                array(c(15, 15), c(x = 2, member = 1, ftime = 1)))
   expect_error(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2, time_dim = 'x'),
-     paste("Found one or more margin dimensions with the same name and different",
-           "length in some of the input objects in 'data'."))
+     paste("Could not find dimension 'x' in 1th object provided in 'data'"))
 
 })
-- 
GitLab


From 33e133b4d1d3f95649b186524a194dc9f140c940 Mon Sep 17 00:00:00 2001
From: Chihchung Chou <chihchung.chou@bsc.es>
Date: Mon, 8 Feb 2021 15:02:24 +0100
Subject: [PATCH 08/12] typo fixed

---
 tests/testthat/test-TotalSpellTimeExceedingThreshold.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
index 800c5af..0db91d0 100644
--- a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
+++ b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
@@ -20,7 +20,7 @@ test_that("Sanity checks", {
   threshold <- array(1:2, 2)
   dim(threshold) <- c(time = 2)
   expect_equal(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2),  
-    array(c(0,rep(2,9)), c(lat = 10))
+    array(c(0,rep(2,9)), c(lat = 10)))
   data <- array(1:40, c(x = 2, ftime = 20))
   expect_error(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2),
     "Could not find dimension 'time' in 1th object provided in 'data'.")    
-- 
GitLab


From 53b87cc4406f9a871022a59b7b885d05ee8895db Mon Sep 17 00:00:00 2001
From: Chihchung Chou <chihchung.chou@bsc.es>
Date: Mon, 8 Feb 2021 15:13:18 +0100
Subject: [PATCH 09/12] typo fixed

---
 tests/testthat/test-TotalSpellTimeExceedingThreshold.R | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
index 0db91d0..4299a4c 100644
--- a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
+++ b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
@@ -27,10 +27,11 @@ test_that("Sanity checks", {
   threshold <- 10
   expect_equal(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2, time_dim = 'ftime'), 
                array(c(15, 15), c(x = 2)))
-  dim(threshold) <- c(member = 1, ftime = 1)
+  threshold <- rep(10, 20)
+  dim(threshold) <- c(member = 1, ftime = 20)
   expect_equal(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2, time_dim = 'ftime'), 
-               array(c(15, 15), c(x = 2, member = 1, ftime = 1)))
-  expect_error(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2, time_dim = 'x'),
-     paste("Could not find dimension 'x' in 1th object provided in 'data'"))
+               array(c(15, 15), c(x = 2, member = 1)))
+  expect_error(TotalSpellTimeExceedingThreshold(data, threshold, spell = 2, time_dim = 'y'),
+     paste("Could not find dimension 'y' in 1th object provided in 'data'"))
 
 })
-- 
GitLab


From e6702a47119cd8fffd568cd67fdc8312338cbfc1 Mon Sep 17 00:00:00 2001
From: Chihchung Chou <chihchung.chou@bsc.es>
Date: Tue, 9 Feb 2021 02:59:49 +0100
Subject: [PATCH 10/12] seasonal tests added

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

diff --git a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
index 4299a4c..e09fb15 100644
--- a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
+++ b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R
@@ -35,3 +35,21 @@ test_that("Sanity checks", {
      paste("Could not find dimension 'y' in 1th object provided in 'data'"))
 
 })
+
+test_that("Seasonal Forecasts", {
+
+  exp <- CSTools::lonlat_data$exp
+  exp$data <- exp$data[1,1:3,1:3,,,]
+  res <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = 260, spell = 2)
+  expect_equal(res$data[,,1,1],
+               array(c(3,3,3,3,3,3,3,3,3), c(member = 3, sdate = 3)))
+  # compare with percentile
+  thresholdP <- Threshold(exp$data, threshold = 0.9)
+  WSDI <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = thresholdP, spell = 2)
+  expect_equal(WSDI$data[3,3,3,],
+               c(rep(0, 6), rep(2, 2), 0, 2, 0, 2, rep(0, 29), 2, rep(0, 11)))
+  thresholdP1 <- thresholdP[1,,]
+  WSDI1 <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = thresholdP1, spell = 2)
+  expect_equal(WSDI1$data[3,3,3,],
+               c(rep(0, 53)))
+})
-- 
GitLab


From 070a57cab015cce1c0fa6edae1267a475d6ec6dd Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Tue, 9 Feb 2021 19:16:59 +0100
Subject: [PATCH 11/12] Fixed examples

---
 R/TotalSpellTimeExceedingThreshold.R        | 4 ++--
 man/CST_TotalSpellTimeExceedingThreshold.Rd | 9 ++++++---
 man/TotalSpellTimeExceedingThreshold.Rd     | 7 +++++--
 3 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/R/TotalSpellTimeExceedingThreshold.R b/R/TotalSpellTimeExceedingThreshold.R
index 0dee866..45c3203 100644
--- a/R/TotalSpellTimeExceedingThreshold.R
+++ b/R/TotalSpellTimeExceedingThreshold.R
@@ -23,7 +23,7 @@
 #'exp <- CSTools::lonlat_data$exp
 #'TTSET <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = 283, spell = 3)
 #'exp$data <- array(rnorm(5 * 3 * 214 * 2, mean = 25, sd = 3),
-#'                    c(memb = 5, sdate = 3, ftime = 214, lon = 2)) 
+#'                    c(member = 5, sdate = 3, ftime = 214, lon = 2)) 
 #'exp$Dates[[1]] <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), 
 #'                     as.Date("30-11-2000", format = "%d-%m-%Y"), by = 'day'),
 #'                 seq(as.Date("01-05-2001", format = "%d-%m-%Y"), 
@@ -33,7 +33,7 @@
 #'# compare with the scalar fixed threshold
 #'WSDI <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = 35, spell = 6)
 #'# compare with percentile
-#'thresholdP <- Threshold(exp$data, threshold = 0.9)
+#'thresholdP <- CST_Threshold(exp, threshold = 0.9)
 #'WSDI_P <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = thresholdP, spell = 6) 
 #'@export
 CST_TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '>',
diff --git a/man/CST_TotalSpellTimeExceedingThreshold.Rd b/man/CST_TotalSpellTimeExceedingThreshold.Rd
index 43a6ebb..0038d36 100644
--- a/man/CST_TotalSpellTimeExceedingThreshold.Rd
+++ b/man/CST_TotalSpellTimeExceedingThreshold.Rd
@@ -18,7 +18,7 @@ CST_TotalSpellTimeExceedingThreshold(
 \arguments{
 \item{data}{an 's2dv_cube' object as provided by function \code{CST_Load} in package CSTools.}
 
-\item{threshold}{an 's2dv_cube' object as output of a 'CST_' function in the same units as parameter 'data' and with the common dimensions of the element 'data' of the same length. A single scalar is also possible.}
+\item{threshold}{an 's2dv_cube' object as output of a 'CST_' function in the same units as parameter 'data' and with the common dimensions of the element 'data' of the same length. A single scalar is also possible. If \code{timd_dim} is in the dimension (with the same length as \code{data}), the comparison will be done day by day.}
 
 \item{spell}{a scalar indicating the minimum length of the spell.}
 
@@ -46,15 +46,18 @@ This function requires the data and the threshold to be in the same units. The 9
 exp <- CSTools::lonlat_data$exp
 TTSET <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = 283, spell = 3)
 exp$data <- array(rnorm(5 * 3 * 214 * 2, mean = 25, sd = 3),
-                   c(memb = 5, sdate = 3, ftime = 214, lon = 2)) 
+                   c(member = 5, sdate = 3, ftime = 214, lon = 2)) 
 exp$Dates[[1]] <- c(seq(as.Date("01-05-2000", format = "\%d-\%m-\%Y"), 
                     as.Date("30-11-2000", format = "\%d-\%m-\%Y"), by = 'day'),
                 seq(as.Date("01-05-2001", format = "\%d-\%m-\%Y"), 
                     as.Date("30-11-2001", format = "\%d-\%m-\%Y"), by = 'day'),
                 seq(as.Date("01-05-2002", format = "\%d-\%m-\%Y"), 
                     as.Date("30-11-2002", format = "\%d-\%m-\%Y"), by = 'day'))
-#threshold <- QThreshold()
+# compare with the scalar fixed threshold
 WSDI <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = 35, spell = 6)
+# compare with percentile
+thresholdP <- CST_Threshold(exp, threshold = 0.9)
+WSDI_P <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = thresholdP, spell = 6) 
 }
 \seealso{
 [Threshold()] and [AbsToProbs()].
diff --git a/man/TotalSpellTimeExceedingThreshold.Rd b/man/TotalSpellTimeExceedingThreshold.Rd
index 39e4c89..39ba110 100644
--- a/man/TotalSpellTimeExceedingThreshold.Rd
+++ b/man/TotalSpellTimeExceedingThreshold.Rd
@@ -19,7 +19,7 @@ TotalSpellTimeExceedingThreshold(
 \arguments{
 \item{data}{a multidimensional array with named dimensions.}
 
-\item{threshold}{a multidimensional array with named dimensions in the same units as parameter 'data' and with the common dimensions of the element 'data' of the same length.}
+\item{threshold}{a multidimensional array with named dimensions in the same units as parameter 'data' and with the common dimensions of the element 'data' of the same length. If \code{timd_dim} is in the dimension (with the same length as \code{data}), the comparison will be done day by day.}
 
 \item{spell}{a scalar indicating the minimum length of the spell.}
 
@@ -46,9 +46,12 @@ This function allows to compute indicators widely used in Climate Services, such
 This function requires the data and the threshold to be in the same units. The 90th percentile can be translate into absolute values given a reference dataset using function \code{Threshold} or the data can be transform into probabilites by using function \code{AbsToProbs}. See section @examples.
 }
 \examples{
-data <- array(rnorm(120), c(sdate = 2, time = 20, lat = 4))
+data <- array(rnorm(120), c(member = 1, sdate = 2, time = 20, lat = 4))
 threshold <- array(rnorm(4), c(lat = 4))
 total <- TotalSpellTimeExceedingThreshold(data, threshold, spell = 6)
+# compare with percentile
+thresholdP <- Threshold(data, threshold = 0.9)
+total_P <- TotalSpellTimeExceedingThreshold(data, threshold = thresholdP, spell = 6)
 }
 \seealso{
 [Threshold()] and [AbsToProbs()].
-- 
GitLab


From 2492c1b70aa709eb0e88f89d0c00dab727577fc2 Mon Sep 17 00:00:00 2001
From: Chihchung Chou <chihchung.chou@bsc.es>
Date: Wed, 10 Feb 2021 08:41:05 +0100
Subject: [PATCH 12/12] seasonal tests added

---
 tests/testthat/test-Threshold.R | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

diff --git a/tests/testthat/test-Threshold.R b/tests/testthat/test-Threshold.R
index 94a71aa..44f1291 100644
--- a/tests/testthat/test-Threshold.R
+++ b/tests/testthat/test-Threshold.R
@@ -35,3 +35,17 @@ test_that("Sanity checks", {
   expect_equal(dim(Threshold(data, threshold, memb_dim = 'x', sdate_dim = 'ftime')),
                c(probs = 2))
 })
+
+test_that("Seasonal forecasts", {
+
+  exp <- CSTools::lonlat_data$exp$data
+  thresholdP <- Threshold(exp, threshold = 0.9)
+  expect_equal(dim(exp)[4:6], dim(thresholdP)[2:4])
+  expect_equal(round(thresholdP[1, , 2, 2]), c(283, 281, 280))
+  exp1 <- exp[1, 1, 1, , , ] # no member
+  library(s2dv) # 1 member and 1 sdate
+  exp1 <- InsertDim(InsertDim(exp1, 1, 1, name = 'sdate'), 1, 1, name = 'member')
+  exp1_thresholdP <- Threshold(exp1, threshold = 0.9)
+  expect_equal(round(exp1_thresholdP[, 2, 2]), c(281, 279, 276))
+
+})
-- 
GitLab