diff --git a/DESCRIPTION b/DESCRIPTION index a60be7531c84dbeb3db37d7f8002994b8c9ad74d..acb15b90173c40c9411f6edd37143f704fbf9bae 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,6 +10,7 @@ Imports: multiApply (>= 2.1.1) Suggests: testthat, + s2dv, CSTools License: Apache License 2.0 URL: https://earth.bsc.es/gitlab/es/csindicators/ diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index 083bb7f35b65de4331360e9024e8a2cb02b24196..f9cdb1873bb10a2eee90e7433ac69ed1fa4a57aa 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -79,7 +79,7 @@ CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, #'@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 time_dim a character string indicating the name of the function to compute the indicator. By default, it is set to 'time'. 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. #' @@ -89,24 +89,21 @@ CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, #' #'@examples #'exp <- CSTools::lonlat_prec$data -#'TP <- PeriodAccumulation(exp) +#'TP <- PeriodAccumulation(exp, time_dim = 'ftime') #'data <- array(rnorm(5 * 3 * 214 * 2), -#' c(memb = 5, sdate = 3, ftime = 214, lon = 2)) +#' c(memb = 5, sdate = 3, time = 214, lon = 2)) +#'# ftime tested #'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')) -#'SprR <- PeriodAccumulation(exp, dates = Dates, start = list(21, 4), end = list(21, 6)) -#'dim(SprR) -#'head(SprR) -#'HarR <- PeriodAccumulation(exp, dates = Dates, start = list(21, 8), end = list(21, 10)) -#'dim(HarR) -#'head(HarR) +#'SprR <- PeriodAccumulation(data, dates = Dates, start = list(21, 4), end = list(21, 6)) +#'HarR <- PeriodAccumulation(data, dates = Dates, start = list(21, 8), end = list(21, 10)) #'@export PeriodAccumulation <- function(data, dates = NULL, start = NULL, end = NULL, - time_dim = 'ftime', na.rm = FALSE, + time_dim = 'time', na.rm = FALSE, ncores = NULL) { if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") @@ -116,12 +113,9 @@ PeriodAccumulation <- function(data, dates = NULL, start = NULL, end = NULL, } if (!is.array(data)) { dim(data) <- length(data) - names(data) <- time_dim + names(dim(data)) <- time_dim } - if (is.null(dates)) { - warning("Parameter 'dates' is NULL and the Total Accumulation of the ", - "full data provided in 'data' is computed.") - } else { + 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 ", @@ -133,5 +127,6 @@ PeriodAccumulation <- function(data, dates = NULL, start = NULL, end = NULL, } total <- Apply(list(data), target_dims = time_dim, fun = sum, na.rm = na.rm, ncores = ncores)$output1 + return(total) } diff --git a/man/PeriodAccumulation.Rd b/man/PeriodAccumulation.Rd index 2998170d2b2d12f04d6e98408082a609d1e61a6b..fbc225a1b68d2918055164d6d3b22b34a5841d07 100644 --- a/man/PeriodAccumulation.Rd +++ b/man/PeriodAccumulation.Rd @@ -9,7 +9,7 @@ PeriodAccumulation( dates = NULL, start = NULL, end = NULL, - time_dim = "ftime", + time_dim = "time", na.rm = FALSE, ncores = NULL ) @@ -23,7 +23,7 @@ PeriodAccumulation( \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{time_dim}{a character string indicating the name of the function to compute the indicator. By default, it is set to 'time'. 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).} @@ -41,19 +41,16 @@ Providing precipitation data, two agriculture indices can be obtained by using t } \examples{ exp <- CSTools::lonlat_prec$data -TP <- PeriodAccumulation(exp) +TP <- PeriodAccumulation(exp, time_dim = 'ftime') data <- array(rnorm(5 * 3 * 214 * 2), - c(memb = 5, sdate = 3, ftime = 214, lon = 2)) + c(memb = 5, sdate = 3, time = 214, lon = 2)) +# ftime tested 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')) -SprR <- PeriodAccumulation(exp, dates = Dates, start = list(21, 4), end = list(21, 6)) -dim(SprR) -head(SprR) -HarR <- PeriodAccumulation(exp, dates = Dates, start = list(21, 8), end = list(21, 10)) -dim(HarR) -head(HarR) +SprR <- PeriodAccumulation(data, dates = Dates, start = list(21, 4), end = list(21, 6)) +HarR <- PeriodAccumulation(data, dates = Dates, start = list(21, 8), end = list(21, 10)) } diff --git a/tests/testthat.R b/tests/testthat.R index 79cf4a7bcd6331048eb88561a58357cf6bda2e75..708970c762d7f9f117a5e15e08d208d15fa0d1bf 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,5 @@ library(testthat) library(CSIndicators) +library(s2dv) test_check("CSIndicators") diff --git a/tests/testthat/test-PeriodAccumulation.R b/tests/testthat/test-PeriodAccumulation.R new file mode 100644 index 0000000000000000000000000000000000000000..0cd69a9393ee65c10c058891b6e1943288eeb9c0 --- /dev/null +++ b/tests/testthat/test-PeriodAccumulation.R @@ -0,0 +1,40 @@ +context("Generic tests") +test_that("Sanity Checks", { + #source("csindicators/R/PeriodAccumulation.R") + expect_error(PeriodAccumulation('x'), "Parameter 'data' must be numeric.") + expect_equal(PeriodAccumulation(1), 1) + expect_equal(PeriodAccumulation(1, time_dim = 'x'), 1) + expect_error(PeriodAccumulation(data = NULL), + "Parameter 'data' cannot be NULL.") + expect_error(PeriodAccumulation(1, dates = '2000-01-01', end = 3, start = 4), + paste("Parameter 'start' and 'end' must be lists indicating", + "the day and the month of the period start and end.")) + expect_equal(PeriodAccumulation(1:10), 55) + data <- array(1:24, c(sdate = 2, time = 3, lon = 4)) + expect_equal(PeriodAccumulation(data), + array(c(9, 12, 27, 30, 45, 48, 63, 66), c(sdate = 2, lon = 4))) + +}) + +test_that("seasonal", { + + exp <- CSTools::lonlat_prec + exp$data <- array(1:(1 * 3 * 214 * 2), + c(memb = 1, sdate = 3, ftime = 214, lon = 2)) + exp$Dates[[1]] <- c(seq(as.Date("01-04-2000", format = "%d-%m-%Y"), + as.Date("31-10-2000", format = "%d-%m-%Y"), by = 'day'), + seq(as.Date("01-04-2001", format = "%d-%m-%Y"), + as.Date("31-10-2001", format = "%d-%m-%Y"), by = 'day'), + seq(as.Date("01-04-2002", format = "%d-%m-%Y"), + as.Date("31-10-2002", format = "%d-%m-%Y"), by = 'day')) + + output <- exp + output$data <- array(c(sum(exp$data[1,1,21:82,1]), sum(exp$data[1,2,21:82,1]), + sum(exp$data[1,3,21:82,1]), sum(exp$data[1,1,21:82,2]), + sum(exp$data[1,2,21:82,2]), sum(exp$data[1,3,21:82,2])), + c(memb = 1, sdate = 3, lon = 2)) + + expect_equal(CST_PeriodAccumulation(exp, start = list(21, 4), + end = list(21, 6))$data, output$data) + +})