From 5835d16416b67a9b089875222fc0a5e399b33a62 Mon Sep 17 00:00:00 2001 From: nperez Date: Wed, 27 Jan 2021 12:53:16 +0100 Subject: [PATCH 1/9] Fix check on PeriodAccum --- R/PeriodAccumulation.R | 2 +- tests/testthat.R | 5 +++++ tests/testthat/test-PeriodAccumulation.R | 5 +++++ 3 files changed, 11 insertions(+), 1 deletion(-) create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test-PeriodAccumulation.R diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index 083bb7f..070b1dc 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -116,7 +116,7 @@ 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 ", diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..8005d2f --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,5 @@ +library(testthat) +library(CSIndicators) + +test_check("CSIndicators") + diff --git a/tests/testthat/test-PeriodAccumulation.R b/tests/testthat/test-PeriodAccumulation.R new file mode 100644 index 0000000..1c39cf6 --- /dev/null +++ b/tests/testthat/test-PeriodAccumulation.R @@ -0,0 +1,5 @@ +context("Generic tests") +test_that("Sanity Checks", { + #source("csindicators/R/PeriodAccumulation.R") +}) + -- GitLab From bf507ad46a6f381b5da191984bc5a1267a995da3 Mon Sep 17 00:00:00 2001 From: nperez Date: Wed, 27 Jan 2021 13:16:06 +0100 Subject: [PATCH 2/9] Tests to PeriodAccumulation --- R/PeriodAccumulation.R | 20 +++++++------------- man/PeriodAccumulation.Rd | 14 +++++--------- tests/testthat/test-PeriodAccumulation.R | 11 +++++++++++ 3 files changed, 23 insertions(+), 22 deletions(-) diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index 070b1dc..6599cd8 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -89,24 +89,20 @@ 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)) #'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.") @@ -118,10 +114,7 @@ PeriodAccumulation <- function(data, dates = NULL, start = NULL, end = NULL, dim(data) <- length(data) 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 +126,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 2998170..f53b30a 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 ) @@ -41,19 +41,15 @@ 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)) 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/test-PeriodAccumulation.R b/tests/testthat/test-PeriodAccumulation.R index 1c39cf6..1c1e888 100644 --- a/tests/testthat/test-PeriodAccumulation.R +++ b/tests/testthat/test-PeriodAccumulation.R @@ -1,5 +1,16 @@ 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), + "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))) + }) -- GitLab From 9d1dc98b250dfda647f55e90ee8a54ec5f6e3f14 Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Thu, 28 Jan 2021 13:00:01 +0100 Subject: [PATCH 3/9] a test for seasonal forecasts added --- tests/testthat/test-PeriodAccumulation.R | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/tests/testthat/test-PeriodAccumulation.R b/tests/testthat/test-PeriodAccumulation.R index 1c1e888..2b677ac 100644 --- a/tests/testthat/test-PeriodAccumulation.R +++ b/tests/testthat/test-PeriodAccumulation.R @@ -14,3 +14,25 @@ test_that("Sanity Checks", { }) +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) + +}) -- GitLab From 2ea882e17f37c1147828d38481ef8456afc8fb26 Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Thu, 28 Jan 2021 16:26:14 +0100 Subject: [PATCH 4/9] typo fix --- R/PeriodAccumulation.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index 6599cd8..e646c75 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -102,7 +102,7 @@ CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, #'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 = 'time', na.rm = FALSE, + time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") -- GitLab From a234ab74f6be272f7cd560b71975b1623237130f Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Thu, 28 Jan 2021 17:19:15 +0100 Subject: [PATCH 5/9] typo fix --- R/PeriodAccumulation.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index e646c75..e9a66ca 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -91,7 +91,7 @@ CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, #'exp <- CSTools::lonlat_prec$data #'TP <- PeriodAccumulation(exp, time_dim = 'ftime') #'data <- array(rnorm(5 * 3 * 214 * 2), -#' c(memb = 5, sdate = 3, time = 214, lon = 2)) +#' c(memb = 5, sdate = 3, ftime = 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"), -- GitLab From 4eb2f62db89549a52ab41a7036e68daf7f49177b Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Fri, 29 Jan 2021 04:54:47 +0100 Subject: [PATCH 6/9] ftime tested --- R/PeriodAccumulation.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index e9a66ca..04d436e 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -92,6 +92,7 @@ CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, #'TP <- PeriodAccumulation(exp, time_dim = 'ftime') #'data <- array(rnorm(5 * 3 * 214 * 2), #' c(memb = 5, sdate = 3, ftime = 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"), -- GitLab From b5e9f00971b82bd832e824b8f5e7fb01ed6a27ec Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Thu, 4 Feb 2021 08:06:31 +0100 Subject: [PATCH 7/9] ftime revised --- R/PeriodAccumulation.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index 04d436e..4a3a289 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -103,7 +103,7 @@ CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, #'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.") -- GitLab From f110bcf3e29757e4a67a7f3451dedbe1917ebcd5 Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Thu, 4 Feb 2021 08:17:54 +0100 Subject: [PATCH 8/9] documentation revised --- R/PeriodAccumulation.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index 4a3a289..f9cdb18 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. #' @@ -91,7 +91,7 @@ CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, #'exp <- CSTools::lonlat_prec$data #'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'), -- GitLab From c744ac8026f7321e0501ad3d6f1033082b9b7d75 Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 4 Feb 2021 09:11:36 +0100 Subject: [PATCH 9/9] Minor docu fixes --- DESCRIPTION | 1 + man/PeriodAccumulation.Rd | 3 ++- tests/testthat.R | 1 + tests/testthat/test-PeriodAccumulation.R | 14 ++++++++------ 4 files changed, 12 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a60be75..acb15b9 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/man/PeriodAccumulation.Rd b/man/PeriodAccumulation.Rd index f53b30a..fbc225a 100644 --- a/man/PeriodAccumulation.Rd +++ b/man/PeriodAccumulation.Rd @@ -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).} @@ -44,6 +44,7 @@ exp <- CSTools::lonlat_prec$data TP <- PeriodAccumulation(exp, time_dim = 'ftime') data <- array(rnorm(5 * 3 * 214 * 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"), diff --git a/tests/testthat.R b/tests/testthat.R index 79cf4a7..708970c 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 index 2b677ac..0cd69a9 100644 --- a/tests/testthat/test-PeriodAccumulation.R +++ b/tests/testthat/test-PeriodAccumulation.R @@ -4,13 +4,15 @@ test_that("Sanity Checks", { 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(data = NULL), + "Parameter 'data' cannot be NULL.") expect_error(PeriodAccumulation(1, dates = '2000-01-01', end = 3, start = 4), - "Parameter 'start' and 'end' must be lists indicating the day and the month of the period start and end.") + 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))) + array(c(9, 12, 27, 30, 45, 48, 63, 66), c(sdate = 2, lon = 4))) }) @@ -31,8 +33,8 @@ test_that("seasonal", { 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) + + expect_equal(CST_PeriodAccumulation(exp, start = list(21, 4), + end = list(21, 6))$data, output$data) }) -- GitLab