From 5dd4f55014a3086dfa69f9f68e8c826a08555201 Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Wed, 10 Feb 2021 10:54:08 +0100 Subject: [PATCH 1/6] dif for GDD added --- R/AccumulationExceedingThreshold.R | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/R/AccumulationExceedingThreshold.R b/R/AccumulationExceedingThreshold.R index 3782d3b..09b110e 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 dif 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,7 @@ #' start = list(1, 4), end = list(31, 10)) #' #'@export -CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', +CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', dif = FALSE, start = NULL, end = NULL, time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { @@ -84,7 +85,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 dif 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}. @@ -109,7 +111,7 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', #' as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day')) #'GDD <- AccumulationExceedingThreshold(data, threshold = 0, start = list(1, 4), end = list(31, 10)) #'@export -AccumulationExceedingThreshold <- function(data, threshold, op = '>', +AccumulationExceedingThreshold <- function(data, threshold, op = '>', dif = FALSE, dates = NULL, start = NULL, end = NULL, time_dim = 'time', na.rm = FALSE, ncores = NULL) { @@ -187,9 +189,12 @@ AccumulationExceedingThreshold <- function(data, threshold, op = '>', #x <- 1:10 #y <- 3 #.sumexceedthreshold(x, y, '>', T) -.sumexceedthreshold <- function(x, y, op, na.rm) { - if (op == '>') { +.sumexceedthreshold <- function(x, y, op, dif, na.rm) { + if (op == '>' && dif == FALSE) { res <- sum(x[x > y], na.rm = na.rm) + } else if (op == '>' && dif == TRUE) { + z <- x - y + res <- sum(z[z > 0], na.rm = na.rm) } else if (op == '<') { res <- sum(x[x < y], na.rm = na.rm) } else if (op == '<=') { -- GitLab From b1e1832611a70c309786bc2d4112b2cb4fef826e Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Wed, 10 Feb 2021 11:07:05 +0100 Subject: [PATCH 2/6] fix dif --- R/AccumulationExceedingThreshold.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/AccumulationExceedingThreshold.R b/R/AccumulationExceedingThreshold.R index 09b110e..3817f24 100644 --- a/R/AccumulationExceedingThreshold.R +++ b/R/AccumulationExceedingThreshold.R @@ -63,7 +63,7 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', dif = threshold <- threshold$data } total <- AccumulationExceedingThreshold(data$data, data$Dates[[1]], - threshold = threshold, op = op, + threshold = threshold, op = op, dif = dif, start = start, end = end, time_dim = time_dim, na.rm = na.rm, ncores = ncores) data$data <- total @@ -170,17 +170,17 @@ AccumulationExceedingThreshold <- function(data, threshold, op = '>', dif = FALS if (is.null(dim(threshold))) { total <- Apply(list(data), target_dims = time_dim, fun = .sumexceedthreshold, - y = threshold, op = op, na.rm = na.rm, + y = threshold, op = op, dif = dif, na.rm = na.rm, ncores = ncores)$output1 } else if (all(time_dim %in% names(dim(threshold)))) { total <- Apply(list(data, threshold), target_dims = list(time_dim, time_dim), - fun = .sumexceedthreshold, op = op, na.rm = na.rm, + fun = .sumexceedthreshold, op = op, dif = dif, na.rm = na.rm, ncores = ncores)$output1 } else { total <- Apply(list(data, threshold), target_dims = list(time_dim, NULL), - fun = .sumexceedthreshold, op = op, na.rm = na.rm, + fun = .sumexceedthreshold, op = op, dif = dif, na.rm = na.rm, ncores = ncores)$output1 } return(total) -- GitLab From 77ff132276af9c649a75fa709bdb54aac3a23c2f Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Tue, 16 Feb 2021 10:47:36 +0100 Subject: [PATCH 3/6] revise diff --- R/AccumulationExceedingThreshold.R | 29 +++++++++++-------- .../test-AccumulationExceedingThreshold.R | 14 +++++++++ 2 files changed, 31 insertions(+), 12 deletions(-) diff --git a/R/AccumulationExceedingThreshold.R b/R/AccumulationExceedingThreshold.R index 3817f24..1bcad3a 100644 --- a/R/AccumulationExceedingThreshold.R +++ b/R/AccumulationExceedingThreshold.R @@ -10,7 +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 dif a logical value indicating whether to accumulate the difference between data and threshold (TRUE) or not (FALSE by default). +#'@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. @@ -36,7 +36,7 @@ #' start = list(1, 4), end = list(31, 10)) #' #'@export -CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', dif = FALSE, +CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = FALSE, start = NULL, end = NULL, time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { @@ -86,7 +86,7 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', dif = #'@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 dif a logical value indicating whether to accumulate the difference between data and threshold (TRUE) or not (FALSE by default). +#'@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}. @@ -111,7 +111,7 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', dif = #' as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day')) #'GDD <- AccumulationExceedingThreshold(data, threshold = 0, start = list(1, 4), end = list(31, 10)) #'@export -AccumulationExceedingThreshold <- function(data, threshold, op = '>', dif = FALSE, +AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = FALSE, dates = NULL, start = NULL, end = NULL, time_dim = 'time', na.rm = FALSE, ncores = NULL) { @@ -167,20 +167,28 @@ AccumulationExceedingThreshold <- function(data, threshold, op = '>', dif = FALS 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, - y = threshold, op = op, dif = dif, na.rm = na.rm, + y = threshold, op = op, na.rm = na.rm, ncores = ncores)$output1 } else if (all(time_dim %in% names(dim(threshold)))) { total <- Apply(list(data, threshold), target_dims = list(time_dim, time_dim), - fun = .sumexceedthreshold, op = op, dif = dif, na.rm = na.rm, + fun = .sumexceedthreshold, op = op, na.rm = na.rm, ncores = ncores)$output1 } else { total <- Apply(list(data, threshold), target_dims = list(time_dim, NULL), - fun = .sumexceedthreshold, op = op, dif = dif, na.rm = na.rm, + fun = .sumexceedthreshold, op = op, na.rm = na.rm, ncores = ncores)$output1 } return(total) @@ -189,12 +197,9 @@ AccumulationExceedingThreshold <- function(data, threshold, op = '>', dif = FALS #x <- 1:10 #y <- 3 #.sumexceedthreshold(x, y, '>', T) -.sumexceedthreshold <- function(x, y, op, dif, na.rm) { - if (op == '>' && dif == FALSE) { +.sumexceedthreshold <- function(x, y, op, na.rm) { + if (op == '>') { res <- sum(x[x > y], na.rm = na.rm) - } else if (op == '>' && dif == TRUE) { - z <- x - y - res <- sum(z[z > 0], na.rm = na.rm) } else if (op == '<') { res <- sum(x[x < y], na.rm = na.rm) } else if (op == '<=') { diff --git a/tests/testthat/test-AccumulationExceedingThreshold.R b/tests/testthat/test-AccumulationExceedingThreshold.R index 03367fa..90056b9 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) }) -- GitLab From 6d8c1ea8d26ea7bf99c4c602cd5847e935a29a47 Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Tue, 16 Feb 2021 12:30:13 +0100 Subject: [PATCH 4/6] update doc --- man/AccumulationExceedingThreshold.Rd | 3 +++ man/CST_AccumulationExceedingThreshold.Rd | 3 +++ 2 files changed, 6 insertions(+) diff --git a/man/AccumulationExceedingThreshold.Rd b/man/AccumulationExceedingThreshold.Rd index 3e1218d..2598780 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 00eaef4..7aa58e0 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}.} -- GitLab From 0ee9b45bb51bcc887c30a16cdc9cab85331c667c Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Tue, 16 Feb 2021 12:33:09 +0100 Subject: [PATCH 5/6] fix diff --- R/AccumulationExceedingThreshold.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/AccumulationExceedingThreshold.R b/R/AccumulationExceedingThreshold.R index 1bcad3a..7cfbe0f 100644 --- a/R/AccumulationExceedingThreshold.R +++ b/R/AccumulationExceedingThreshold.R @@ -63,7 +63,7 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = threshold <- threshold$data } total <- AccumulationExceedingThreshold(data$data, data$Dates[[1]], - threshold = threshold, op = op, dif = dif, + threshold = threshold, op = op, diff = diff, start = start, end = end, time_dim = time_dim, na.rm = na.rm, ncores = ncores) data$data <- total -- GitLab From 55ee808389d4a558ad6ece441d8a87b41561ce13 Mon Sep 17 00:00:00 2001 From: nperez Date: Tue, 16 Feb 2021 19:01:27 +0100 Subject: [PATCH 6/6] length lines --- R/AccumulationExceedingThreshold.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/AccumulationExceedingThreshold.R b/R/AccumulationExceedingThreshold.R index 7cfbe0f..a7cf94d 100644 --- a/R/AccumulationExceedingThreshold.R +++ b/R/AccumulationExceedingThreshold.R @@ -36,7 +36,8 @@ #' start = list(1, 4), end = list(31, 10)) #' #'@export -CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = FALSE, +CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', + diff = FALSE, start = NULL, end = NULL, time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { @@ -111,7 +112,8 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = #' as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day')) #'GDD <- AccumulationExceedingThreshold(data, threshold = 0, start = list(1, 4), end = list(31, 10)) #'@export -AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = FALSE, +AccumulationExceedingThreshold <- function(data, threshold, op = '>', + diff = FALSE, dates = NULL, start = NULL, end = NULL, time_dim = 'time', na.rm = FALSE, ncores = NULL) { -- GitLab