diff --git a/R/AccumulationExceedingThreshold.R b/R/AccumulationExceedingThreshold.R index 3782d3b6d211dd3dd6f43dda84c28fac6354e6d5..a7cf94d1927d09dd982bd12a29018fc57815528a 100644 --- a/R/AccumulationExceedingThreshold.R +++ b/R/AccumulationExceedingThreshold.R @@ -10,6 +10,7 @@ #'@param data a 's2dv_cube' object as provided by function \code{CST_Load} in package CSTools. #'@param threshold a '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 op a opartor '>' (by default), '<', '>=' or '<='. +#'@param diff a logical value indicating whether to accumulate the difference between data and threshold (TRUE) or not (FALSE by default). #'@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. @@ -35,7 +36,8 @@ #' start = list(1, 4), end = list(31, 10)) #' #'@export -CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', +CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', + diff = FALSE, start = NULL, end = NULL, time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { @@ -62,7 +64,7 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', threshold <- threshold$data } total <- AccumulationExceedingThreshold(data$data, data$Dates[[1]], - threshold = threshold, op = op, + threshold = threshold, op = op, diff = diff, start = start, end = end, time_dim = time_dim, na.rm = na.rm, ncores = ncores) data$data <- total @@ -84,7 +86,8 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', #' #'@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 op a opartor '>' (by default), '<', '>=' or '<='. +#'@param op a opartor '>' (by default), '<', '>=' or '<='. +#'@param diff a logical value indicating whether to accumulate the difference between data and threshold (TRUE) or not (FALSE by default). #'@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}. @@ -110,6 +113,7 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', #'GDD <- AccumulationExceedingThreshold(data, threshold = 0, start = list(1, 4), end = list(31, 10)) #'@export AccumulationExceedingThreshold <- function(data, threshold, op = '>', + diff = FALSE, dates = NULL, start = NULL, end = NULL, time_dim = 'time', na.rm = FALSE, ncores = NULL) { @@ -165,6 +169,14 @@ AccumulationExceedingThreshold <- function(data, threshold, op = '>', time_dim = time_dim, ncores = ncores) } } + if (diff == TRUE) { + dims <- dim(data) + data <- Apply(list(data, threshold), + target_dims = list(time_dim, NULL), + fun = function(x, y) {x - y}, ncores = ncores)$output1 + dim(data) <- dims + threshold <- 0 + } if (is.null(dim(threshold))) { total <- Apply(list(data), target_dims = time_dim, fun = .sumexceedthreshold, diff --git a/man/AccumulationExceedingThreshold.Rd b/man/AccumulationExceedingThreshold.Rd index 3e1218df3a8d5442a06658dee8f7459c133a2315..25987809784fee76f624a20884aec708de17eadc 100644 --- a/man/AccumulationExceedingThreshold.Rd +++ b/man/AccumulationExceedingThreshold.Rd @@ -8,6 +8,7 @@ AccumulationExceedingThreshold( data, threshold, op = ">", + diff = FALSE, dates = NULL, start = NULL, end = NULL, @@ -23,6 +24,8 @@ AccumulationExceedingThreshold( \item{op}{a opartor '>' (by default), '<', '>=' or '<='.} +\item{diff}{a logical value indicating whether to accumulate the difference between data and threshold (TRUE) or not (FALSE by default).} + \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}.} diff --git a/man/CST_AccumulationExceedingThreshold.Rd b/man/CST_AccumulationExceedingThreshold.Rd index 00eaef4ec438a7a97171ec5ef6fcc09ba7909507..7aa58e060172ceab4a1f03585226c99e9694672f 100644 --- a/man/CST_AccumulationExceedingThreshold.Rd +++ b/man/CST_AccumulationExceedingThreshold.Rd @@ -8,6 +8,7 @@ CST_AccumulationExceedingThreshold( data, threshold, op = ">", + diff = FALSE, start = NULL, end = NULL, time_dim = "ftime", @@ -22,6 +23,8 @@ CST_AccumulationExceedingThreshold( \item{op}{a opartor '>' (by default), '<', '>=' or '<='.} +\item{diff}{a logical value indicating whether to accumulate the difference between data and threshold (TRUE) or not (FALSE by default).} + \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}.} diff --git a/tests/testthat/test-AccumulationExceedingThreshold.R b/tests/testthat/test-AccumulationExceedingThreshold.R index 03367fa0bb41c08328018a44885ccccbbf5f1461..90056b90a3ade8f50a1b3ca9a0a035adbbe461d7 100644 --- a/tests/testthat/test-AccumulationExceedingThreshold.R +++ b/tests/testthat/test-AccumulationExceedingThreshold.R @@ -83,4 +83,18 @@ test_that("Seasonal forecasts", { "Could not find dimension 'time' in 1th object provided in 'data'.") expect_equal(all(is.na(AccumulationExceedingThreshold(exp - 17, threshold = 0, dates = Dates, time_dim = 'ftime',start = list(1, 4), end = list(31, 10)))), all(is.na(c(NA, NA)))) + + # test the 'diff' + input <- c(1:20) + threshold <- 3 + expect_equal(AccumulationExceedingThreshold(input, threshold, diff = TRUE), + 153) + expect_equal(AccumulationExceedingThreshold(input, threshold), + 204) + input1 <- -input[1:15] + threshold <- -5 + expect_equal(AccumulationExceedingThreshold(input1, threshold, op = '<'), + -105) + expect_equal(AccumulationExceedingThreshold(input1, threshold, op = '<', diff = TRUE), + -55) })