From f1599b6389ee3d16e94e92e08723f82579d3d731 Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 4 Feb 2021 12:38:20 +0100 Subject: [PATCH 1/6] AccumulationExceedingThreshold first version --- NAMESPACE | 2 + R/AccumulationExceedingThreshold.R | 199 ++++++++++++++++++++++ man/AccumulationExceedingThreshold.Rd | 61 +++++++ man/CST_AccumulationExceedingThreshold.Rd | 60 +++++++ 4 files changed, 322 insertions(+) create mode 100644 R/AccumulationExceedingThreshold.R create mode 100644 man/AccumulationExceedingThreshold.Rd create mode 100644 man/CST_AccumulationExceedingThreshold.Rd diff --git a/NAMESPACE b/NAMESPACE index 7bee168..bafe27b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,7 @@ # Generated by roxygen2: do not edit by hand +export(AccumulationExceedingThreshold) +export(CST_AccumulationExceedingThreshold) export(CST_PeriodAccumulation) export(CST_PeriodMean) export(CST_SelectPeriodOnData) diff --git a/R/AccumulationExceedingThreshold.R b/R/AccumulationExceedingThreshold.R new file mode 100644 index 0000000..ce33449 --- /dev/null +++ b/R/AccumulationExceedingThreshold.R @@ -0,0 +1,199 @@ +#'Accumulation of a variable when Exceeding (not exceeding) a Threshold +#' +#'The accumulation (sum) of a variable in the days (or time steps) that the variable is exceeding (or not exceeding) a threshold during a period. The threshold provided must be +#'in the same units than the variable units, i.e. to use a percentile as a scalar, +#'the function \code{Threshold} or \code{QThreshold} may be needed. +#'Providing mean daily temperature data, the following agriculture indices for heat stress can be obtained by using this function: +#'\itemize{ +#' \item\code{GDD}{Summation of daily differences between daily average temperatures and 10°C between April 1st and October 31st}} +#' +#'@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 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 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 indicator in the element \code{data}. +#' +#'@import multiApply +#'@examples +#'exp <- CSTools::lonlat_data$exp +#'DOT <- CST_AccumulationExceedingThreshold(exp, threshold = 280) +#'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')) +#'GDD <- CST_AccumulationExceedingThreshold(exp, threshold = 10, +#' start = list(1, 4), end = list(31, 10)) +#' +#'@export +CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', + start = NULL, end = NULL, + time_dim = 'ftime', + 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.") + } + } + } + if (inherits(threshold, 's2dv_cube')) { + threshold <- threshold$data + } + total <- AccumulationExceedingThreshold(data$data, data$Dates[[1]], + threshold = threshold, op = op, + start = start, end = end, time_dim = time_dim, + na.rm = na.rm, 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) +} +#'Accumulation of a variable when Exceeding (not exceeding) a Threshold +#' +#'The accumulation (sum) of a variable in the days (or time steps) that the variable is exceeding (or not exceeding) a threshold during a period. The threshold provided must be +#'in the same units than the variable units, i.e. to use a percentile as a scalar, +#'the function \code{Threshold} or \code{QThreshold} may be needed. +#'Providing mean daily temperature data, the following agriculture indices for heat stress can be obtained by using this function: +#'\itemize{ +#' \item\code{GDD}{Summation of daily differences between daily average temperatures and 10°C between April 1st and October 31st}} +#' +#'@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 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 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 +#'@examples +#'exp <- CSTools::lonlat_data$exp$data +#'AET <- AccumulationExceedingThreshold(exp, threshold = 280, time_dim = 'ftime') +#'data <- array(rnorm(5 * 3 * 214 * 2, mean = 25, sd = 3), +#' c(memb = 5, sdate = 3, time = 214, lon = 2)) +#'Dates <- 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')) +#'GDD <- AccumulationExceedingThreshold(data, threshold = 10, start = list(1, 4), end = list(31, 10)) +#'@export +AccumulationExceedingThreshold <- function(data, threshold, op = '>', + dates = NULL, start = NULL, end = NULL, + time_dim = 'time', 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) <- 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.array(threshold) && length(threshold) > 1) { + dim(threshold) <- length(threshold) + names(dim(threshold)) <- time_dim + } else if (length(threshold) == 1) { + dim(threshold) <- NULL + } + if (is.null(names(dim(data)))) { + stop("Parameter 'data' must have named dimensions.") + } + if (is.null(names(dim(threshold))) && length(threshold) > 1) { + stop("Parameter 'threshold' must have named dimensions.") + } + common_dims <- which(names(dim(data)) %in% names(dim(threshold))) + if (length(threshold) > 1) { + if (any(dim(data)[common_dims] != + dim(threshold)[which(names(dim(threshold)) %in% names(dim(data)))])) { + stop("Parameter 'data' and 'threshold' must have the same length on common 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 = .sumexceedthreshold, + y = threshold, op = op, na.rm = na.rm, + ncores = ncores)$output1 + } else if (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, + ncores = ncores)$output1 + } else { + total <- Apply(list(data, threshold), + target_dims = list(time_dim, NULL), + fun = .sumexceedthreshold, op = op, na.rm = na.rm, + ncores = ncores)$output1 + } + return(total) +} + +#x <- 1:10 +#y <- 3 +#.sumexceedthreshold(x, y, '>', T) +.sumexceedthreshold <- function(x, y, op, na.rm) { + if (op == '>') { + res <- sum(x[x > y], na.rm = na.rm) + } else if (op == '<') { + res <- sum(x[x < y], na.rm = na.rm) + } else if (op == '<=') { + res <- sum(x[x <= y], na.rm = na.rm) + } else { + res <- sum(x[x >= y], na.rm = na.rm) + } + return(res) +} + diff --git a/man/AccumulationExceedingThreshold.Rd b/man/AccumulationExceedingThreshold.Rd new file mode 100644 index 0000000..3b68dab --- /dev/null +++ b/man/AccumulationExceedingThreshold.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AccumulationExceedingThreshold.R +\name{AccumulationExceedingThreshold} +\alias{AccumulationExceedingThreshold} +\title{Accumulation of a variable when Exceeding (not exceeding) a Threshold} +\usage{ +AccumulationExceedingThreshold( + data, + threshold, + op = ">", + dates = NULL, + start = NULL, + end = NULL, + time_dim = "time", + na.rm = FALSE, + 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{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{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{ +The accumulation (sum) of a variable in the days (or time steps) that the variable is exceeding (or not exceeding) a threshold during a period. The threshold provided must be +in the same units than the variable units, i.e. to use a percentile as a scalar, +the function \code{Threshold} or \code{QThreshold} may be needed. +Providing mean daily temperature data, the following agriculture indices for heat stress can be obtained by using this function: +\itemize{ + \item\code{GDD}{Summation of daily differences between daily average temperatures and 10°C between April 1st and October 31st}} +} +\examples{ +exp <- CSTools::lonlat_data$exp$data +AET <- AccumulationExceedingThreshold(exp, threshold = 280, time_dim = 'ftime') +data <- array(rnorm(5 * 3 * 214 * 2, mean = 25, sd = 3), + c(memb = 5, sdate = 3, time = 214, lon = 2)) +Dates <- 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')) +GDD <- AccumulationExceedingThreshold(data, threshold = 10, start = list(1, 4), end = list(31, 10)) +} diff --git a/man/CST_AccumulationExceedingThreshold.Rd b/man/CST_AccumulationExceedingThreshold.Rd new file mode 100644 index 0000000..f23b858 --- /dev/null +++ b/man/CST_AccumulationExceedingThreshold.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AccumulationExceedingThreshold.R +\name{CST_AccumulationExceedingThreshold} +\alias{CST_AccumulationExceedingThreshold} +\title{Accumulation of a variable when Exceeding (not exceeding) a Threshold} +\usage{ +CST_AccumulationExceedingThreshold( + data, + threshold, + op = ">", + start = NULL, + end = NULL, + time_dim = "ftime", + na.rm = FALSE, + ncores = NULL +) +} +\arguments{ +\item{data}{a 's2dv_cube' object as provided by function \code{CST_Load} in package CSTools.} + +\item{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.} + +\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{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 indicator in the element \code{data}. +} +\description{ +The accumulation (sum) of a variable in the days (or time steps) that the variable is exceeding (or not exceeding) a threshold during a period. The threshold provided must be +in the same units than the variable units, i.e. to use a percentile as a scalar, +the function \code{Threshold} or \code{QThreshold} may be needed. +Providing mean daily temperature data, the following agriculture indices for heat stress can be obtained by using this function: +\itemize{ + \item\code{GDD}{Summation of daily differences between daily average temperatures and 10°C between April 1st and October 31st}} +} +\examples{ +exp <- CSTools::lonlat_data$exp +DOT <- CST_AccumulationExceedingThreshold(exp, threshold = 280) +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')) +GDD <- CST_AccumulationExceedingThreshold(exp, threshold = 10, + start = list(1, 4), end = list(31, 10)) + +} -- GitLab From 043dfa1d6bbe799f447930a31ca5223910f4df3f Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 4 Feb 2021 12:56:09 +0100 Subject: [PATCH 2/6] Generic tests for AccumulationExceedingThreshold --- R/AccumulationExceedingThreshold.R | 19 ++++--- .../test-AccumulationExceedingThreshold.R | 55 +++++++++++++++++++ 2 files changed, 65 insertions(+), 9 deletions(-) create mode 100644 tests/testthat/test-AccumulationExceedingThreshold.R diff --git a/R/AccumulationExceedingThreshold.R b/R/AccumulationExceedingThreshold.R index ce33449..cbb35f5 100644 --- a/R/AccumulationExceedingThreshold.R +++ b/R/AccumulationExceedingThreshold.R @@ -139,20 +139,21 @@ AccumulationExceedingThreshold <- function(data, threshold, op = '>', if (is.null(names(dim(threshold))) && length(threshold) > 1) { stop("Parameter 'threshold' must have named dimensions.") } - common_dims <- which(names(dim(data)) %in% names(dim(threshold))) - if (length(threshold) > 1) { - if (any(dim(data)[common_dims] != - dim(threshold)[which(names(dim(threshold)) %in% names(dim(data)))])) { - stop("Parameter 'data' and 'threshold' must have the same length on common dimensions.") - } - } + # This check doen't seem necessary. It limits flexibility. + #common_dims <- which(names(dim(data)) %in% names(dim(threshold))) + #if (length(threshold) > 1) { + # if (any(dim(data)[common_dims] != + # dim(threshold)[which(names(dim(threshold)) %in% names(dim(data)))])) { + # stop("Parameter 'data' and 'threshold' must have the same length on common 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 (all(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) @@ -167,7 +168,7 @@ AccumulationExceedingThreshold <- function(data, threshold, op = '>', fun = .sumexceedthreshold, y = threshold, op = op, na.rm = na.rm, ncores = ncores)$output1 - } else if (time_dim %in% names(dim(threshold))) { + } 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, diff --git a/tests/testthat/test-AccumulationExceedingThreshold.R b/tests/testthat/test-AccumulationExceedingThreshold.R new file mode 100644 index 0000000..6d7702a --- /dev/null +++ b/tests/testthat/test-AccumulationExceedingThreshold.R @@ -0,0 +1,55 @@ +context("Generic tests") +test_that("Sanity checks", { + #source("csindicators/R/AccumulationExceedingThreshold.R") + expect_error(AccumulationExceedingThreshold(NULL), + "Parameter 'data' cannot be NULL.") + expect_error(AccumulationExceedingThreshold('x'), + "Parameter 'data' must be numeric.") + data <- 1:20 + expect_error(AccumulationExceedingThreshold(data, NULL), + "Parameter 'threshold' cannot be NULL.") + expect_error(AccumulationExceedingThreshold(data, 'x'), + "Parameter 'threshold' must be numeric.") + threshold <- 10 + expect_equal(AccumulationExceedingThreshold(data, threshold), 155) + dim(data) <- c(2, 10) + expect_error(AccumulationExceedingThreshold(data, threshold), + "Parameter 'data' must have named dimensions.") + names(dim(data)) <- c('lat', 'time') + threshold <- array(1:2, 2) + expect_error(AccumulationExceedingThreshold(data, threshold), + "Parameter 'threshold' must have named dimensions.") + dim(threshold) <- c(time = 2) + data <- array(1:40, c(x = 2, ftime = 20)) + expect_error(AccumulationExceedingThreshold(data, threshold), + "Could not find dimension 'time' in 1th object provided in 'data'.") + threshold <- 10 + expect_equal(AccumulationExceedingThreshold(data, threshold, time_dim = 'ftime'), + array(c(375, 390), c(x = 2))) + dim(threshold) <- c(member = 1, ftime = 1) + expect_equal(AccumulationExceedingThreshold(data, threshold, time_dim = 'ftime'), + array(c(375, 390), c(x = 2))) + expect_equal(AccumulationExceedingThreshold(data, threshold, time_dim = 'x'), + array(c(rep(0,5), seq(23, 79, 4)), c(ftime = 20))) + expect_error(AccumulationExceedingThreshold(data, threshold, + time_dim = 'x', ncores = 'Z'), + "Parameter 'ncores' must be numeric") + + expect_equal(AccumulationExceedingThreshold(data, threshold, time_dim = 2), + array(c(375, 390), c(x = 2))) + # dimensions: + data <- array(1:20, c(time = 5, sdate = 2, lat = 2)) + # does this case made sense? + threshold <- array(1:5, c(time = 5)) + expect_equal(dim(AccumulationExceedingThreshold(data, threshold)), + c(sdate = 2, lat = 2)) + threshold <- array(1:2, c(lat = 2)) + expect_equal(dim(AccumulationExceedingThreshold(data, threshold)), + c(sdate = 2, lat = 2)) + data <- array(1:60, c(time = 5, fyear = 3, sdate = 2, lat = 2)) + expect_equal(dim(AccumulationExceedingThreshold(data, threshold, + time_dim = c('time', 'fyear'))), + c(sdate = 2, lat = 2)) + +}) + -- GitLab From 73616fb4da70fd14e4a4bcf3702a3c809caaf080 Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Mon, 8 Feb 2021 09:00:25 +0100 Subject: [PATCH 3/6] examples revised --- R/AccumulationExceedingThreshold.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/AccumulationExceedingThreshold.R b/R/AccumulationExceedingThreshold.R index cbb35f5..3782d3b 100644 --- a/R/AccumulationExceedingThreshold.R +++ b/R/AccumulationExceedingThreshold.R @@ -22,6 +22,7 @@ #'@examples #'exp <- CSTools::lonlat_data$exp #'DOT <- CST_AccumulationExceedingThreshold(exp, threshold = 280) +#'# Assuming exp$data is already (tasmax + tasmin)/2 - 10 #'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"), @@ -30,7 +31,7 @@ #' 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')) -#'GDD <- CST_AccumulationExceedingThreshold(exp, threshold = 10, +#'GDD <- CST_AccumulationExceedingThreshold(exp, threshold = 0, #' start = list(1, 4), end = list(31, 10)) #' #'@export @@ -97,6 +98,7 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', #'@examples #'exp <- CSTools::lonlat_data$exp$data #'AET <- AccumulationExceedingThreshold(exp, threshold = 280, time_dim = 'ftime') +#'# Assuming data is already (tasmax + tasmin)/2 - 10 #'data <- array(rnorm(5 * 3 * 214 * 2, mean = 25, sd = 3), #' c(memb = 5, sdate = 3, time = 214, lon = 2)) #'Dates <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), @@ -105,7 +107,7 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', #' 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')) -#'GDD <- AccumulationExceedingThreshold(data, threshold = 10, start = list(1, 4), end = list(31, 10)) +#'GDD <- AccumulationExceedingThreshold(data, threshold = 0, start = list(1, 4), end = list(31, 10)) #'@export AccumulationExceedingThreshold <- function(data, threshold, op = '>', dates = NULL, start = NULL, end = NULL, -- GitLab From 8153240f506393708a65aff05161e7eaab933e45 Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Tue, 9 Feb 2021 04:10:04 +0100 Subject: [PATCH 4/6] seasonal tests added --- .../test-AccumulationExceedingThreshold.R | 31 +++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/tests/testthat/test-AccumulationExceedingThreshold.R b/tests/testthat/test-AccumulationExceedingThreshold.R index 6d7702a..a0f0905 100644 --- a/tests/testthat/test-AccumulationExceedingThreshold.R +++ b/tests/testthat/test-AccumulationExceedingThreshold.R @@ -53,3 +53,34 @@ test_that("Sanity checks", { }) +test_that("Seasonal forecasts", { + + exp <- CSTools::lonlat_data$exp + exp$data <- exp$data[,1:4,1:2,,,] + res <- CST_AccumulationExceedingThreshold(exp, threshold = 280) + expect_equal(round(res$data[,2,2,2]), + c(0, 280, 281, 281)) + # GDD + exp <- array(NA, dim = c(member = 6, sdate = 3, ftime = 214, lat =4, lon = 4)) + exp1 <- drop(CSTools::lonlat_prec$data) * 86400000 + exp[,,1:31,,] <- exp1 + 10; exp[,,32:62,,] <- exp1 + 11 + exp[,,63:93,,] <- exp1 + 12; exp[,,94:124,,] <- exp1 + 13 + exp[,,125:155,,] <- exp1 + 14; exp[,,156:186,,] <- exp1 + 15 + exp[,,187:214,,] <- exp1[,,1:28,,] + 16 + Dates <- 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')) + GDD <- AccumulationExceedingThreshold(exp - 17, threshold = 0, dates = Dates, time_dim = 'ftime', + start = list(1, 4), end = list(31, 10), na.rm = TRUE) + expect.equal(round(GDD[,1,1,1]), + c(538, 372, 116, 525, 220, 330)) + expect.equal(dim(GDD), + c(member = 6, sdate = 3, lat =4, lon = 4)) + expect.error(AccumulationExceedingThreshold(exp - 17, threshold = 0, dates = Dates, start = list(1, 4), end = list(31, 10)), + "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)))) +}) -- GitLab From c4e5d391301ad873037cf4f3678e682164183cfe Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Tue, 9 Feb 2021 04:19:39 +0100 Subject: [PATCH 5/6] typo fixed --- tests/testthat/test-AccumulationExceedingThreshold.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-AccumulationExceedingThreshold.R b/tests/testthat/test-AccumulationExceedingThreshold.R index a0f0905..03367fa 100644 --- a/tests/testthat/test-AccumulationExceedingThreshold.R +++ b/tests/testthat/test-AccumulationExceedingThreshold.R @@ -75,12 +75,12 @@ test_that("Seasonal forecasts", { as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day')) GDD <- AccumulationExceedingThreshold(exp - 17, threshold = 0, dates = Dates, time_dim = 'ftime', start = list(1, 4), end = list(31, 10), na.rm = TRUE) - expect.equal(round(GDD[,1,1,1]), + expect_equal(round(GDD[,1,1,1]), c(538, 372, 116, 525, 220, 330)) - expect.equal(dim(GDD), - c(member = 6, sdate = 3, lat =4, lon = 4)) - expect.error(AccumulationExceedingThreshold(exp - 17, threshold = 0, dates = Dates, start = list(1, 4), end = list(31, 10)), + expect_equal(dim(GDD), + c(member = 6, sdate = 3, lat =4, lon = 4)) + expect_error(AccumulationExceedingThreshold(exp - 17, threshold = 0, dates = Dates, start = list(1, 4), end = list(31, 10)), "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)))), + 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)))) }) -- GitLab From 790872112073c753ca9c822a2596be9a8a290507 Mon Sep 17 00:00:00 2001 From: nperez Date: Tue, 9 Feb 2021 19:30:20 +0100 Subject: [PATCH 6/6] examples updated --- man/AccumulationExceedingThreshold.Rd | 3 ++- man/CST_AccumulationExceedingThreshold.Rd | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/man/AccumulationExceedingThreshold.Rd b/man/AccumulationExceedingThreshold.Rd index 3b68dab..3e1218d 100644 --- a/man/AccumulationExceedingThreshold.Rd +++ b/man/AccumulationExceedingThreshold.Rd @@ -49,6 +49,7 @@ Providing mean daily temperature data, the following agriculture indices for hea \examples{ exp <- CSTools::lonlat_data$exp$data AET <- AccumulationExceedingThreshold(exp, threshold = 280, time_dim = 'ftime') +# Assuming data is already (tasmax + tasmin)/2 - 10 data <- array(rnorm(5 * 3 * 214 * 2, mean = 25, sd = 3), c(memb = 5, sdate = 3, time = 214, lon = 2)) Dates <- c(seq(as.Date("01-05-2000", format = "\%d-\%m-\%Y"), @@ -57,5 +58,5 @@ Dates <- c(seq(as.Date("01-05-2000", 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')) -GDD <- AccumulationExceedingThreshold(data, threshold = 10, start = list(1, 4), end = list(31, 10)) +GDD <- AccumulationExceedingThreshold(data, threshold = 0, start = list(1, 4), end = list(31, 10)) } diff --git a/man/CST_AccumulationExceedingThreshold.Rd b/man/CST_AccumulationExceedingThreshold.Rd index f23b858..00eaef4 100644 --- a/man/CST_AccumulationExceedingThreshold.Rd +++ b/man/CST_AccumulationExceedingThreshold.Rd @@ -46,6 +46,7 @@ Providing mean daily temperature data, the following agriculture indices for hea \examples{ exp <- CSTools::lonlat_data$exp DOT <- CST_AccumulationExceedingThreshold(exp, threshold = 280) +# Assuming exp$data is already (tasmax + tasmin)/2 - 10 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"), @@ -54,7 +55,7 @@ exp$Dates[[1]] <- c(seq(as.Date("01-05-2000", 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')) -GDD <- CST_AccumulationExceedingThreshold(exp, threshold = 10, +GDD <- CST_AccumulationExceedingThreshold(exp, threshold = 0, start = list(1, 4), end = list(31, 10)) } -- GitLab