From b5dde53a71224afbda3c61b5d4fc0eb6e4f4728d Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Thu, 1 Jun 2023 17:26:56 +0200 Subject: [PATCH 01/10] Develop original_dates and correct Dates --- R/PeriodMean.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/PeriodMean.R b/R/PeriodMean.R index 85a12a7..303b38e 100644 --- a/R/PeriodMean.R +++ b/R/PeriodMean.R @@ -65,12 +65,19 @@ CST_PeriodMean <- function(data, start = NULL, end = NULL, total <- PeriodMean(data = data$data, dates = data$attrs$Dates, start, end, time_dim = time_dim, na.rm = na.rm, ncores = ncores) data$data <- total + original_dates <- data$attrs$Dates if (!is.null(start) && !is.null(end)) { data$attrs$Dates <- SelectPeriodOnDates(dates = data$attrs$Dates, start = start, end = end, time_dim = time_dim, ncores = ncores) } + data$attrs$Dates <- ClimProjDiags::Subset(data$attrs$Dates, time_dim, 1, + drop = 'selected') + # Option (1) + # attr(data$attrs$Dates, 'original_dates') <- original_dates + # Option (2) + data$attrs$original_dates <- original_dates return(data) } -- GitLab From e5eff31bca61b2fae01030e0ec709030425e6d2d Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Fri, 16 Jun 2023 18:01:06 +0200 Subject: [PATCH 02/10] Develop new element time_bounds with start and end elements containing the start and end dates of the aggregation for PeriodMean and PeriodAggregation; updated documentation; added tests --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/PeriodAccumulation.R | 74 +++++++++++++++------- R/PeriodMean.R | 69 ++++++++++++++------- man/CST_PeriodAccumulation.Rd | 23 ++++--- man/CST_PeriodMean.Rd | 22 +++++-- man/PeriodAccumulation.Rd | 15 +++-- tests/testthat/test-PeriodAccumulation.R | 78 ++++++++++++++++++++++-- tests/testthat/test-PeriodMean.R | 63 +++++++++++++++++-- 9 files changed, 270 insertions(+), 77 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4151ba4..4e20983 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,4 +40,4 @@ URL: https://earth.bsc.es/gitlab/es/csindicators/ BugReports: https://earth.bsc.es/gitlab/es/csindicators/-/issues Encoding: UTF-8 RoxygenNote: 7.2.0 -Config/testthat/edition: 3 \ No newline at end of file +Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index d80accb..0a16d4d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,6 +26,7 @@ export(TotalTimeExceedingThreshold) export(WindCapacityFactor) export(WindPowerDensity) import(multiApply) +importFrom(ClimProjDiags,Subset) importFrom(stats,approxfun) importFrom(stats,ecdf) importFrom(stats,quantile) diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index d181d8e..2ef738f 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -31,7 +31,10 @@ #' computation. #' #'@return A 's2dv_cube' object containing the indicator in the element -#'\code{data}. +#'\code{data}. A new element called 'time_bounds' will be added into +#' the 'attrs' element in the 's2dv_cube' object. It consists of a list +#' containing two elements, the start and end dates of the aggregated period +#' with the same dimensions of 'Dates' element. #' #'@examples #'exp <- NULL @@ -39,14 +42,16 @@ #' ftime = 9, lat = 2, lon = 2)) #'class(exp) <- 's2dv_cube' #'TP <- CST_PeriodAccumulation(exp) -#'exp$data <- array(rnorm(5 * 3 * 214 * 2), -#' c(memb = 5, sdate = 3, ftime = 214, lon = 2)) -#'exp$attrs$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')) +#'exp$data <- array(rnorm(5 * 3 * 214 * 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"), +#' 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')) +#'dim(Dates) <- c(sdate = 3, ftime = 214) +#'exp$attrs$Dates <- Dates #'SprR <- CST_PeriodAccumulation(exp, start = list(21, 4), end = list(21, 6)) #'dim(SprR$data) #'head(SprR$attrs$Dates) @@ -55,6 +60,7 @@ #'head(HarR$attrs$Dates) #' #'@import multiApply +#'@importFrom ClimProjDiags Subset #'@export CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, time_dim = 'ftime', na.rm = FALSE, @@ -73,15 +79,29 @@ CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, } } - total <- PeriodAccumulation(data$data, dates = data$attrs$Dates, start, end, + Dates <- data$attrs$Dates + + total <- PeriodAccumulation(data$data, dates = Dates, start, end, time_dim = time_dim, na.rm = na.rm, ncores = ncores) data$data <- total - if (!is.null(start) && !is.null(end)) { - data$attrs$Dates <- SelectPeriodOnDates(dates = data$attrs$Dates, - start = start, end = end, - time_dim = time_dim, - ncores = ncores) + data$dims <- dim(total) + + if (!is.null(Dates)) { + if (!is.null(start) && !is.null(end)) { + Dates <- SelectPeriodOnDates(dates = Dates, start = start, end = end, + time_dim = time_dim, ncores = ncores) + } + + # Create time_bounds + time_bounds <- NULL + time_bounds$start <- ClimProjDiags::Subset(Dates, time_dim, 1, drop = 'selected') + time_bounds$end <- ClimProjDiags::Subset(Dates, time_dim, dim(Dates)[time_dim], drop = 'selected') + + # Add Dates in attrs + data$attrs$Dates <- time_bounds$start + data$attrs$time_bounds <- time_bounds } + return(data) } @@ -98,9 +118,10 @@ CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, #'} #' #'@param data A multidimensional array with named dimensions. -#'@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 dates A multidimensional array of datesW with named dimensions matching +#' the dimensions on parameter 'data'. By default it is NULL, to select a +#' period this parameter must be provided and it needs to have temporal +#' dimensions. #'@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 @@ -128,15 +149,17 @@ 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, 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(data, dates = Dates, start = list(21, 4), end = list(21, 6)) -#'HarR <- PeriodAccumulation(data, dates = Dates, start = list(21, 8), end = list(21, 10)) +#'dim(Dates) <- c(sdate = 3, time = 214) +#'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)) #' #'@import multiApply #'@export @@ -159,8 +182,13 @@ PeriodAccumulation <- function(data, dates = NULL, start = NULL, end = NULL, stop("Parameter 'start' and 'end' must be lists indicating the ", "day and the month of the period start and end.") } - data <- SelectPeriodOnData(data, dates, start, end, - time_dim = time_dim, ncores = ncores) + if (!is.null(dim(dates))) { + data <- SelectPeriodOnData(data, dates, start, end, + time_dim = time_dim, ncores = ncores) + } else { + warning("Parameter 'dates' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + } } } total <- Apply(list(data), target_dims = time_dim, fun = sum, diff --git a/R/PeriodMean.R b/R/PeriodMean.R index 303b38e..e12cd09 100644 --- a/R/PeriodMean.R +++ b/R/PeriodMean.R @@ -31,19 +31,30 @@ #' computation. #' #'@return An 's2dv_cube' object containing the indicator in the element -#' \code{data}. +#' \code{data}. A new element called 'time_bounds' will be added into +#' the 'attrs' element in the 's2dv_cube' object. It consists of a list +#' containing two elements, the start and end dates of the aggregated period +#' with the same dimensions of 'Dates' element. #' #'@examples #'exp <- NULL -#'exp$data <- array(rnorm(45), dim = c(member = 7, ftime = 8)) +#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 6, ftime = 3)) +#'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2002-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2002-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) +#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'exp$attrs$Dates <- Dates #'class(exp) <- 's2dv_cube' -#'exp$attrs$Dates <- c(seq(as.Date("01-07-1993", "%d-%m-%Y", tz = 'UTC'), -#' as.Date("01-08-1993","%d-%m-%Y", tz = 'UTC'), "day"), -#' seq(as.Date("01-07-1994", "%d-%m-%Y", tz = 'UTC'), -#' as.Date("01-08-1994","%d-%m-%Y", tz = 'UTC'), "day")) +#' #'SA <- CST_PeriodMean(exp) #' #'@import multiApply +#'@importFrom ClimProjDiags Subset #'@export CST_PeriodMean <- function(data, start = NULL, end = NULL, time_dim = 'ftime', na.rm = FALSE, @@ -62,22 +73,29 @@ CST_PeriodMean <- function(data, start = NULL, end = NULL, } } - total <- PeriodMean(data = data$data, dates = data$attrs$Dates, start, end, + Dates <- data$attrs$Dates + + total <- PeriodMean(data = data$data, dates = Dates, start, end, time_dim = time_dim, na.rm = na.rm, ncores = ncores) data$data <- total - original_dates <- data$attrs$Dates - if (!is.null(start) && !is.null(end)) { - data$attrs$Dates <- SelectPeriodOnDates(dates = data$attrs$Dates, - start = start, end = end, - time_dim = time_dim, - ncores = ncores) + data$dims <- dim(total) + + if (!is.null(Dates)) { + if (!is.null(start) && !is.null(end)) { + Dates <- SelectPeriodOnDates(dates = Dates, start = start, end = end, + time_dim = time_dim, ncores = ncores) + } + + # Create time_bounds + time_bounds <- NULL + time_bounds$start <- ClimProjDiags::Subset(Dates, time_dim, 1, drop = 'selected') + time_bounds$end <- ClimProjDiags::Subset(Dates, time_dim, dim(Dates)[time_dim], drop = 'selected') + + # Add Dates in attrs + data$attrs$Dates <- time_bounds$start + data$attrs$time_bounds <- time_bounds } - data$attrs$Dates <- ClimProjDiags::Subset(data$attrs$Dates, time_dim, 1, - drop = 'selected') - # Option (1) - # attr(data$attrs$Dates, 'original_dates') <- original_dates - # Option (2) - data$attrs$original_dates <- original_dates + return(data) } @@ -139,15 +157,20 @@ PeriodMean <- function(data, dates = NULL, start = NULL, end = NULL, } if (is.null(dates)) { warning("Parameter 'dates' is NULL and the Average of the ", - "full data provided in 'data' is computed.") + "full data provided in 'data' is computed.") } else { 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.") + "day and the month of the period start and end.") + } + if (!is.null(dim(dates))) { + data <- SelectPeriodOnData(data, dates, start, end, + time_dim = time_dim, ncores = ncores) + } else { + warning("Parameter 'dates' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") } - data <- SelectPeriodOnData(data, dates, start, end, - time_dim = time_dim, ncores = ncores) } } total <- Apply(list(data), target_dims = time_dim, fun = mean, diff --git a/man/CST_PeriodAccumulation.Rd b/man/CST_PeriodAccumulation.Rd index 3928705..71122d6 100644 --- a/man/CST_PeriodAccumulation.Rd +++ b/man/CST_PeriodAccumulation.Rd @@ -41,7 +41,10 @@ computation.} } \value{ A 's2dv_cube' object containing the indicator in the element -\code{data}. +\code{data}. A new element called 'time_bounds' will be added into + the 'attrs' element in the 's2dv_cube' object. It consists of a list + containing two elements, the start and end dates of the aggregated period + with the same dimensions of 'Dates' element. } \description{ Period Accumulation computes the sum (accumulation) of a given variable in a @@ -60,14 +63,16 @@ exp$data <- array(rnorm(216)*200, dim = c(dataset = 1, member = 2, sdate = 3, ftime = 9, lat = 2, lon = 2)) class(exp) <- 's2dv_cube' TP <- CST_PeriodAccumulation(exp) -exp$data <- array(rnorm(5 * 3 * 214 * 2), - c(memb = 5, sdate = 3, ftime = 214, lon = 2)) -exp$attrs$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')) +exp$data <- array(rnorm(5 * 3 * 214 * 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"), + 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')) +dim(Dates) <- c(sdate = 3, ftime = 214) +exp$attrs$Dates <- Dates SprR <- CST_PeriodAccumulation(exp, start = list(21, 4), end = list(21, 6)) dim(SprR$data) head(SprR$attrs$Dates) diff --git a/man/CST_PeriodMean.Rd b/man/CST_PeriodMean.Rd index b1004ad..f9db984 100644 --- a/man/CST_PeriodMean.Rd +++ b/man/CST_PeriodMean.Rd @@ -41,7 +41,10 @@ computation.} } \value{ An 's2dv_cube' object containing the indicator in the element - \code{data}. + \code{data}. A new element called 'time_bounds' will be added into + the 'attrs' element in the 's2dv_cube' object. It consists of a list + containing two elements, the start and end dates of the aggregated period + with the same dimensions of 'Dates' element. } \description{ Period Mean computes the average (mean) of a given variable in a period. @@ -56,12 +59,19 @@ this function: } \examples{ exp <- NULL -exp$data <- array(rnorm(45), dim = c(member = 7, ftime = 8)) +exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 6, ftime = 3)) +Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2002-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2002-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) +dim(Dates) <- c(sdate = 4, ftime = 3) +exp$attrs$Dates <- Dates class(exp) <- 's2dv_cube' -exp$attrs$Dates <- c(seq(as.Date("01-07-1993", "\%d-\%m-\%Y", tz = 'UTC'), - as.Date("01-08-1993","\%d-\%m-\%Y", tz = 'UTC'), "day"), - seq(as.Date("01-07-1994", "\%d-\%m-\%Y", tz = 'UTC'), - as.Date("01-08-1994","\%d-\%m-\%Y", tz = 'UTC'), "day")) + SA <- CST_PeriodMean(exp) } diff --git a/man/PeriodAccumulation.Rd b/man/PeriodAccumulation.Rd index 9903321..0f55937 100644 --- a/man/PeriodAccumulation.Rd +++ b/man/PeriodAccumulation.Rd @@ -17,9 +17,10 @@ PeriodAccumulation( \arguments{ \item{data}{A multidimensional array with named dimensions.} -\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{dates}{A multidimensional array of datesW with named dimensions matching +the dimensions on parameter 'data'. By default it is NULL, to select a +period this parameter must be provided and it needs to have temporal +dimensions.} \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 @@ -64,14 +65,16 @@ exp <- array(rnorm(216)*200, dim = c(dataset = 1, member = 2, sdate = 3, 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"), 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(data, dates = Dates, start = list(21, 4), end = list(21, 6)) -HarR <- PeriodAccumulation(data, dates = Dates, start = list(21, 8), end = list(21, 10)) +dim(Dates) <- c(sdate = 3, time = 214) +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 81718f5..74bb45d 100644 --- a/tests/testthat/test-PeriodAccumulation.R +++ b/tests/testthat/test-PeriodAccumulation.R @@ -1,5 +1,7 @@ +library(CSTools) + ############################################## -test_that("Sanity Checks", { +test_that("1. Sanity Checks", { expect_error( PeriodAccumulation('x'), "Parameter 'data' must be numeric." @@ -30,13 +32,21 @@ test_that("Sanity Checks", { PeriodAccumulation(data), array(c(9, 12, 27, 30, 45, 48, 63, 66), c(sdate = 2, lon = 4)) ) - + # Test dates warning + expect_warning( + PeriodAccumulation(array(1:10, c(time = 10)), + dates = seq(as.Date("01-05-2000", format = "%d-%m-%Y"), + as.Date("10-05-2000", format = "%d-%m-%Y"), by = 'day'), + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' must have named dimensions if 'start' and 'end' ", + "are not NULL. All data will be used.") + ) }) + ############################################## -library(CSTools) -test_that("seasonal", { - exp <- CSTools::lonlat_prec +test_that("2. Seasonal", { + exp <- NULL exp$data <- array(1:(1 * 3 * 214 * 2), c(memb = 1, sdate = 3, ftime = 214, lon = 2)) exp$dims <- dim(exp$data) @@ -47,6 +57,7 @@ test_that("seasonal", { seq(as.Date("01-04-2002", format = "%d-%m-%Y"), as.Date("31-10-2002", format = "%d-%m-%Y"), by = 'day')) dim(exp$attrs$Dates) <- c(ftime = 214, sdate = 3) + class(exp) <- 's2dv_cube' 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]), @@ -58,3 +69,60 @@ test_that("seasonal", { output$data ) }) + +############################################## + +test_that("3. Subset Dates and check time_bounds", { + exp <- CSTools::lonlat_prec + res <- CST_PeriodAccumulation(data = CSTools::lonlat_prec, time_dim = 'ftime', + start = list(10, 03), end = list(20, 03)) + res2 <- CST_PeriodAccumulation(data = CSTools::lonlat_prec, time_dim = 'ftime') + # Check dims + expect_equal( + dim(res$data), + res$dims + ) + expect_equal( + dim(res2$data), + dim(exp$data)[-which(names(dim(exp$data)) == 'ftime')] + ) + # Check Dates + expect_equal( + dim(res$data)['sdate'], + dim(res$attrs$Dates) + ) + expect_equal( + dim(res2$data)['sdate'], + dim(res2$attrs$Dates) + ) + # Check time_bounds + expect_equal( + res$attrs$Dates, + res$attrs$time_bounds$start + ) + expect_equal( + dim(res$attrs$time_bounds$start), + dim(res$attrs$time_bounds$end) + ) + expect_equal( + res2$attrs$Dates, + res2$attrs$time_bounds$start + ) + # Check 'sdates' + expect_equal( + all(lubridate::month(res$attrs$time_bounds$start) == 3), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$start) == 10), + TRUE + ) + expect_equal( + all(lubridate::month(res$attrs$time_bounds$end) == 03), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$end) == 20), + TRUE + ) +}) \ No newline at end of file diff --git a/tests/testthat/test-PeriodMean.R b/tests/testthat/test-PeriodMean.R index 4186639..18b5995 100644 --- a/tests/testthat/test-PeriodMean.R +++ b/tests/testthat/test-PeriodMean.R @@ -1,5 +1,7 @@ +library(CSTools) + ############################################## -test_that("Sanity Checks", { +test_that("1. Sanity Checks", { expect_error( PeriodMean('x'), "Parameter 'data' must be numeric." @@ -31,13 +33,21 @@ test_that("Sanity Checks", { c(sdate = 2, lon = 4)) ) ) + # Test dates warning + expect_warning( + PeriodMean(array(1:10, c(time = 10)), + dates = seq(as.Date("01-05-2000", format = "%d-%m-%Y"), + as.Date("10-05-2000", format = "%d-%m-%Y"), by = 'day'), + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' must have named dimensions if 'start' and 'end' ", + "are not NULL. All data will be used.") + ) }) ############################################## -library(CSTools) -test_that("seasonal", { - exp <- CSTools::lonlat_prec +test_that("2. Seasonal", { + exp <- NULL exp$data <- array(1:(1 * 3 * 214 * 2), c(memb = 1, sdate = 3, ftime = 214, lon = 2)) exp$dims <- dim(exp$data) @@ -48,6 +58,7 @@ test_that("seasonal", { seq(as.Date("01-04-2002", format = "%d-%m-%Y"), as.Date("31-10-2002", format = "%d-%m-%Y"), by = 'day')) dim(exp$attrs$Dates) <- c(ftime = 214, sdate = 3) + class(exp) <- 's2dv_cube' output <- exp output$data <- array(c(mean(exp$data[1,1,21:82,1]), mean(exp$data[1,2,21:82,1]), mean(exp$data[1,3,21:82,1]), mean(exp$data[1,1,21:82,2]), @@ -58,3 +69,47 @@ test_that("seasonal", { output$data ) }) + +############################################## +test_that("3. Subset Dates and check time_bounds", { + exp <- CSTools::lonlat_prec + res <- CST_PeriodMean(data = CSTools::lonlat_prec, time_dim = 'ftime', + start = list(10, 03), end = list(20, 03)) + # Check dims + expect_equal( + dim(res$data), + res$dims + ) + # Check Dates + expect_equal( + dim(res$data)['sdate'], + dim(res$attrs$Dates) + ) + # Check time_bounds + expect_equal( + res$attrs$Dates, + res$attrs$time_bounds$start + ) + expect_equal( + dim(res$attrs$time_bounds$start), + dim(res$attrs$time_bounds$end) + ) + # Check 'sdates' + expect_equal( + all(lubridate::month(res$attrs$time_bounds$start) == 3), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$start) == 10), + TRUE + ) + expect_equal( + all(lubridate::month(res$attrs$time_bounds$end) == 03), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$end) == 20), + TRUE + ) +}) + -- GitLab From 50f9c6ef7e7c09729a18ddf6718f4dbba03c1bd5 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Mon, 19 Jun 2023 17:25:03 +0200 Subject: [PATCH 03/10] Add time_bounds in functions that reduce time dimensions ; Add element; Add checks if dates have dimensions; add tests for this development --- R/AccumulationExceedingThreshold.R | 121 ++++++++++++------ R/PeriodAccumulation.R | 30 +++-- R/PeriodMean.R | 60 +++++---- R/QThreshold.R | 44 +++++-- R/Threshold.R | 28 ++-- R/TotalSpellTimeExceedingThreshold.R | 77 +++++++++-- R/TotalTimeExceedingThreshold.R | 78 ++++++++--- R/WindCapacityFactor.R | 48 +++++-- R/WindPowerDensity.R | 49 +++++-- man/AccumulationExceedingThreshold.Rd | 12 +- man/CST_AccumulationExceedingThreshold.Rd | 21 ++- man/CST_PeriodMean.Rd | 20 +-- man/CST_QThreshold.Rd | 10 +- man/CST_Threshold.Rd | 5 +- man/CST_TotalSpellTimeExceedingThreshold.Rd | 12 +- man/CST_TotalTimeExceedingThreshold.Rd | 11 +- man/CST_WindCapacityFactor.Rd | 13 +- man/CST_WindPowerDensity.Rd | 17 ++- man/PeriodAccumulation.Rd | 7 +- man/PeriodMean.Rd | 6 +- man/QThreshold.Rd | 22 +++- man/Threshold.Rd | 10 +- man/TotalSpellTimeExceedingThreshold.Rd | 22 +++- man/TotalTimeExceedingThreshold.Rd | 23 +++- man/WindCapacityFactor.Rd | 23 +++- man/WindPowerDensity.Rd | 21 ++- .../test-AccumulationExceedingThreshold.R | 58 ++++++++- tests/testthat/test-QThreshold.R | 36 +++++- tests/testthat/test-Threshold.R | 34 ++++- .../test-TotalSpellTimeExceedingThreshold.R | 46 ++++++- .../test-TotalTimeExceedingThreshold.R | 50 +++++++- tests/testthat/test-WindCapacityFactor.R | 28 +++- tests/testthat/test-WindPowerDensity.R | 24 ++++ 33 files changed, 811 insertions(+), 255 deletions(-) diff --git a/R/AccumulationExceedingThreshold.R b/R/AccumulationExceedingThreshold.R index e346b53..d3c7147 100644 --- a/R/AccumulationExceedingThreshold.R +++ b/R/AccumulationExceedingThreshold.R @@ -49,15 +49,29 @@ #' #'@return An 's2dv_cube' object containing the aggregated values in the element #'\code{data} with dimensions of the input parameter 'data' except the dimension -#'where the indicator has been computed. +#'where the indicator has been computed. A new element called 'time_bounds' will +#'be added into the 'attrs' element in the 's2dv_cube' object. It consists of a +#'list containing two elements, the start and end dates of the aggregated period +#'with the same dimensions of 'Dates' element. #'@examples #'exp <- NULL -#'exp$data <- array(rnorm(216)*200, dim = c(dataset = 1, member = 2, sdate = 3, -#' ftime = 9, lat = 2, lon = 2)) +#'exp$data <- array(abs(rnorm(5 * 3 * 214 * 2)*100), +#' c(memb = 5, sdate = 3, ftime = 214, lon = 2)) #'class(exp) <- 's2dv_cube' -#'DOT <- CST_AccumulationExceedingThreshold(exp, threshold = 280) +#'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')) +#'dim(Dates) <- c(sdate = 3, ftime = 214) +#'exp$attrs$Dates <- Dates +#'AT <- CST_AccumulationExceedingThreshold(data = exp, threshold = 100, +#' start = list(21, 4), +#' end = list(21, 6)) #' #'@import multiApply +#'@importFrom ClimProjDiags Subset #'@export CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = FALSE, start = NULL, end = NULL, time_dim = 'ftime', @@ -78,7 +92,7 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = if (length(op) == 1) { if (inherits(threshold, 's2dv_cube')) { - threshold <- threshold$data + threshold <- threshold$data } } else if (length(op) == 2) { if (inherits(threshold[[1]], 's2dv_cube')) { @@ -89,17 +103,38 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = } } - total <- AccumulationExceedingThreshold(data$data, dates = data$attrs$Dates, + Dates <- data$attrs$Dates + total <- AccumulationExceedingThreshold(data = data$data, dates = Dates, threshold = threshold, op = op, diff = diff, 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$attrs$Dates <- SelectPeriodOnDates(dates = data$attrs$Dates, - start = start, end = end, - time_dim = time_dim, - ncores = ncores) + data$dims <- dim(total) + + if (!is.null(Dates)) { + if (!is.null(start) && !is.null(end)) { + Dates <- SelectPeriodOnDates(dates = Dates, start = start, end = end, + time_dim = time_dim, ncores = ncores) + } + if (is.null(dim(Dates))) { + warning("Element 'Dates' has NULL dimensions. They will not be ", + "subset and 'time_bounds' will be missed.") + data$attrs$Dates <- Dates + } else { + # Create time_bounds + time_bounds <- NULL + time_bounds$start <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = 1, drop = 'selected') + time_bounds$end <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = dim(Dates)[time_dim], + drop = 'selected') + + # Add Dates in attrs + data$attrs$Dates <- time_bounds$start + data$attrs$time_bounds <- time_bounds + } } + return(data) } #'Accumulation of a variable when Exceeding (not exceeding) a Threshold @@ -133,9 +168,9 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = #'@param diff A logical value indicating whether to accumulate the difference #' between data and threshold (TRUE) or not (FALSE by default). It can only be #' TRUE if a unique threshold is used. -#'@param dates A vector of dates or a multidimensional array with 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 dates A multidimensional array of dates with named dimensions matching +#' the temporal dimensions on parameter 'data'. By default it is NULL, to +#' select aperiod this parameter must be provided. #'@param start An optional parameter to define 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 @@ -161,12 +196,6 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = #'# Assuming data is already (tasmax + tasmin)/2 - 10 #'data <- array(rnorm(5 * 3 * 214 * 2, mean = 25, sd = 3), #' 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"), -#' 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 = 0, start = list(1, 4), #' end = list(31, 10)) #'@import multiApply @@ -228,8 +257,8 @@ AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = FAL } if (length(op) == 2) { if (length(op) != length(threshold)) { - stop(paste0("If 'op' is a pair of logical operators parameter 'threshold' ", - "also has to be a pair of values.")) + stop("If 'op' is a pair of logical operators parameter 'threshold' ", + "also has to be a pair of values.") } if (!is.numeric(threshold[[1]]) | !is.numeric(threshold[[2]])) { stop("Parameter 'threshold' must be numeric.") @@ -240,7 +269,8 @@ AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = FAL if (!is.array(threshold[[1]]) && length(threshold[[1]]) > 1) { if (dim(data)[time_dim] != length(threshold[[1]])) { - stop("If parameter 'threshold' is a vector it must have the same length as data any time dimension.") + stop("If parameter 'threshold' is a vector it must have the same ", + "length as data any time dimension.") } else { dim(threshold[[1]]) <- length(threshold[[1]]) dim(threshold[[2]]) <- length(threshold[[2]]) @@ -265,8 +295,8 @@ AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = FAL if (any(names(dim(threshold[[1]])) %in% names(dim(data)))) { common_dims <- dim(threshold[[1]])[names(dim(threshold[[1]])) %in% names(dim(data))] if (!all(common_dims == dim(data)[names(common_dims)])) { - stop(paste0("Parameter 'data' and 'threshold' must have same length of ", - "all common dimensions.")) + stop("Parameter 'data' and 'threshold' must have same length of ", + "all common dimensions.") } } } else if (length(threshold[[1]]) == 1) { @@ -276,7 +306,8 @@ AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = FAL } else { if (!is.array(threshold) && length(threshold) > 1) { if (dim(data)[time_dim] != length(threshold)) { - stop("If parameter 'threshold' is a vector it must have the same length as data time dimension.") + stop("If parameter 'threshold' is a vector it must have the same ", + "length as data time dimension.") } else { dim(threshold) <- length(threshold) names(dim(threshold)) <- time_dim @@ -288,8 +319,8 @@ AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = FAL if (any(names(dim(threshold)) %in% names(dim(data)))) { common_dims <- dim(threshold)[names(dim(threshold)) %in% names(dim(data))] if (!all(common_dims == dim(data)[names(common_dims)])) { - stop(paste0("Parameter 'data' and 'threshold' must have same length of ", - "all common dimensions.")) + stop("Parameter 'data' and 'threshold' must have same length of ", + "all common dimensions.") } } } else if (length(threshold) == 1) { @@ -313,27 +344,41 @@ AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = FAL if (length(op) == 1) { 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) + threshold <- SelectPeriodOnData(data = threshold, dates = dates, + start = start, end = end, + time_dim = time_dim, + ncores = ncores) } } } else if (length(op) == 2) { if (time_dim %in% names(dim(threshold[[1]]))) { if (dim(threshold[[1]])[time_dim] == dim(data)[time_dim]) { - threshold[[1]] <- SelectPeriodOnData(threshold[[1]], dates, start, end, - time_dim = time_dim, ncores = ncores) - threshold[[2]] <- SelectPeriodOnData(threshold[[2]], dates, start, end, - time_dim = time_dim, ncores = ncores) + threshold[[1]] <- SelectPeriodOnData(data = threshold[[1]], + dates = dates, start = start, + end = end, time_dim = time_dim, + ncores = ncores) + threshold[[2]] <- SelectPeriodOnData(data = threshold[[2]], dates = dates, + start = start, end = end, + time_dim = time_dim, + ncores = ncores) } } } - data <- SelectPeriodOnData(data, dates, start, end, - time_dim = time_dim, ncores = ncores) + if (!is.null(dim(dates))) { + data <- SelectPeriodOnData(data = data, dates = dates, start = start, + end = end, time_dim = time_dim, + ncores = ncores) + } else { + warning("Parameter 'dates' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + } + } } # diff if (length(op) == 2 & diff == TRUE) { - stop("Parameter 'diff' can't be TRUE if the parameter 'threshold' is a range of values.") + stop("Parameter 'diff' can't be TRUE if the parameter 'threshold' is a ", + "range of values.") } else if (diff == TRUE) { if (length(threshold) != 1) { stop("Parameter 'diff' can't be TRUE if the parameter 'threshold' is not a scalar.") @@ -345,8 +390,6 @@ AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = FAL threshold <- 0 } - ### - if (length(op) > 1) { thres1 <- threshold[[1]] thres2 <- threshold[[2]] diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index 2ef738f..c8e976e 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -80,7 +80,6 @@ CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, } Dates <- data$attrs$Dates - total <- PeriodAccumulation(data$data, dates = Dates, start, end, time_dim = time_dim, na.rm = na.rm, ncores = ncores) data$data <- total @@ -91,17 +90,21 @@ CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, Dates <- SelectPeriodOnDates(dates = Dates, start = start, end = end, time_dim = time_dim, ncores = ncores) } + if (is.null(dim(Dates))) { + warning("Element 'Dates' has NULL dimensions. They will not be ", + "subset and 'time_bounds' will be missed.") + data$attrs$Dates <- Dates + } else { + # Create time_bounds + time_bounds <- NULL + time_bounds$start <- ClimProjDiags::Subset(Dates, time_dim, 1, drop = 'selected') + time_bounds$end <- ClimProjDiags::Subset(Dates, time_dim, dim(Dates)[time_dim], drop = 'selected') - # Create time_bounds - time_bounds <- NULL - time_bounds$start <- ClimProjDiags::Subset(Dates, time_dim, 1, drop = 'selected') - time_bounds$end <- ClimProjDiags::Subset(Dates, time_dim, dim(Dates)[time_dim], drop = 'selected') - - # Add Dates in attrs - data$attrs$Dates <- time_bounds$start - data$attrs$time_bounds <- time_bounds + # Add Dates in attrs + data$attrs$Dates <- time_bounds$start + data$attrs$time_bounds <- time_bounds + } } - return(data) } @@ -118,10 +121,9 @@ CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, #'} #' #'@param data A multidimensional array with named dimensions. -#'@param dates A multidimensional array of datesW with named dimensions matching -#' the dimensions on parameter 'data'. By default it is NULL, to select a -#' period this parameter must be provided and it needs to have temporal -#' dimensions. +#'@param dates A multidimensional array of dates with named dimensions matching +#' the temporal dimensions on parameter 'data'. By default it is NULL, to +#' select aperiod 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 diff --git a/R/PeriodMean.R b/R/PeriodMean.R index e12cd09..6acea60 100644 --- a/R/PeriodMean.R +++ b/R/PeriodMean.R @@ -38,20 +38,20 @@ #' #'@examples #'exp <- NULL -#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 6, ftime = 3)) -#'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), -#' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), -#' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), -#' as.Date("2002-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), -#' seq(as.Date("2002-11-01", "%Y-%m-%d", tz = "UTC"), -#' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), -#' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), -#' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) +#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2002-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2002-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) #'dim(Dates) <- c(sdate = 4, ftime = 3) #'exp$attrs$Dates <- Dates #'class(exp) <- 's2dv_cube' #' -#'SA <- CST_PeriodMean(exp) +#'SA <- CST_PeriodMean(exp, start = list(01, 12), end = list(01, 01)) #' #'@import multiApply #'@importFrom ClimProjDiags Subset @@ -74,9 +74,9 @@ CST_PeriodMean <- function(data, start = NULL, end = NULL, } Dates <- data$attrs$Dates - - total <- PeriodMean(data = data$data, dates = Dates, start, end, + total <- PeriodMean(data = data$data, dates = Dates, start = start, end = end, time_dim = time_dim, na.rm = na.rm, ncores = ncores) + data$data <- total data$dims <- dim(total) @@ -85,17 +85,24 @@ CST_PeriodMean <- function(data, start = NULL, end = NULL, Dates <- SelectPeriodOnDates(dates = Dates, start = start, end = end, time_dim = time_dim, ncores = ncores) } - - # Create time_bounds - time_bounds <- NULL - time_bounds$start <- ClimProjDiags::Subset(Dates, time_dim, 1, drop = 'selected') - time_bounds$end <- ClimProjDiags::Subset(Dates, time_dim, dim(Dates)[time_dim], drop = 'selected') + if (is.null(dim(Dates))) { + warning("Element 'Dates' has NULL dimensions. They will not be ", + "subset and 'time_bounds' will be missed.") + data$attrs$Dates <- Dates + } else { + # Create time_bounds + time_bounds <- NULL + time_bounds$start <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = 1, drop = 'selected') + time_bounds$end <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = dim(Dates)[time_dim], + drop = 'selected') - # Add Dates in attrs - data$attrs$Dates <- time_bounds$start - data$attrs$time_bounds <- time_bounds + # Add Dates in attrs + data$attrs$Dates <- time_bounds$start + data$attrs$time_bounds <- time_bounds + } } - return(data) } @@ -112,9 +119,9 @@ CST_PeriodMean <- function(data, start = NULL, end = NULL, #'} #' #'@param data A multidimensional array with named dimensions. -#'@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 dates A multidimensional array of dates with named dimensions matching +#' the temporal dimensions on parameter 'data'. By default it is NULL, to +#' select aperiod 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 @@ -165,8 +172,9 @@ PeriodMean <- function(data, dates = NULL, start = NULL, end = NULL, "day and the month of the period start and end.") } if (!is.null(dim(dates))) { - data <- SelectPeriodOnData(data, dates, start, end, - time_dim = time_dim, ncores = ncores) + data <- SelectPeriodOnData(data = data, dates = dates, start = start, + end = end, time_dim = time_dim, + ncores = ncores) } else { warning("Parameter 'dates' must have named dimensions if 'start' and ", "'end' are not NULL. All data will be used.") diff --git a/R/QThreshold.R b/R/QThreshold.R index 49217dd..0d069bb 100644 --- a/R/QThreshold.R +++ b/R/QThreshold.R @@ -57,15 +57,19 @@ #'exp$data <- array(abs(rnorm(112)*26), dim = c(member = 7, sdate = 8, ftime = 2)) #'class(exp) <- 's2dv_cube' #'exp_probs <- CST_QThreshold(exp, threshold) -#'exp$data <- array(rnorm(5 * 3 * 214 * 2), -#' c(member = 5, sdate = 3, ftime = 214, lon = 2)) +#' +#'exp$data <- array(abs(rnorm(5 * 3 * 214 * 2)*50), +#' c(member = 5, sdate = 3, ftime = 214, lon = 2)) #'exp$attrs$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')) -#'exp_probs <- CST_QThreshold(exp, threshold) +#'dim(exp$attrs$Dates) <- c(sdate = 3, ftime = 214) +#'class(exp) <- 's2dv_cube' +#'exp_probs <- CST_QThreshold(exp, threshold, start = list(21, 4), +#' end = list(21, 6)) #' #'@import multiApply #'@export @@ -92,6 +96,7 @@ CST_QThreshold <- function(data, threshold, start = NULL, end = NULL, start, end, time_dim = time_dim, memb_dim = memb_dim, sdate_dim = sdate_dim, ncores = ncores) data$data <- probs + data$dims <- dim(probs) if (!is.null(start) && !is.null(end)) { data$attrs$Dates <- SelectPeriodOnDates(dates = data$attrs$Dates, start = start, end = end, @@ -127,9 +132,9 @@ CST_QThreshold <- function(data, threshold, start = NULL, end = NULL, #'@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 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 dates A multidimensional array of dates with named dimensions matching +#' the temporal dimensions on parameter 'data'. By default it is NULL, to +#' select aperiod 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 @@ -157,14 +162,24 @@ CST_QThreshold <- function(data, threshold, start = NULL, end = NULL, #'@examples #'threshold = 25 #'data <- array(rnorm(5 * 3 * 20 * 2, mean = 26), -#' c(member = 5, sdate = 3, time = 20, lon = 2)) -#'thres_q <- QThreshold(data, threshold) +#' c(member = 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')) +#'dim(Dates) <- c(sdate = 3, time = 214) +#' +#'thres_q <- QThreshold(data, threshold, dates = Dates, time_dim = 'time', +#' start = list(21, 4), end = list(21, 6)) #' #'@import multiApply #'@export QThreshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, - time_dim = 'time', memb_dim = 'member', sdate_dim = 'sdate', - ncores = NULL) { + time_dim = 'ftime', memb_dim = 'member', + sdate_dim = 'sdate', ncores = NULL) { # Initial checks ## data if (is.null(data)) { @@ -220,8 +235,13 @@ QThreshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, } } } - data <- SelectPeriodOnData(data, dates, start, end, - time_dim = time_dim, ncores = ncores) + if (!is.null(dim(dates))) { + data <- SelectPeriodOnData(data = data, dates = dates, start = start, + end = end, time_dim = time_dim, ncores = ncores) + } else { + warning("Parameter 'dates' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + } } } if (length(threshold) == 1) { diff --git a/R/Threshold.R b/R/Threshold.R index 3122c12..d76cbfa 100644 --- a/R/Threshold.R +++ b/R/Threshold.R @@ -8,7 +8,7 @@ #'@param data An 's2dv_cube' object as provided function \code{CST_Load} in #' package CSTools. #'@param threshold A single scalar or vector indicating the relative -#' threshold(s). +#' threshold(s). It must contain values between 0 and 1. #'@param start An optional parameter to defined the initial date of the period #' to selectfrom 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 @@ -40,13 +40,14 @@ #'threshold <- 0.9 #'exp <- NULL #'exp$data <- array(rnorm(5 * 3 * 214 * 2), -#' c(member = 5, sdate = 3, ftime = 214, lon = 2)) +#' c(member = 5, sdate = 3, ftime = 214, lon = 2)) #'exp$attrs$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')) +#'dim(exp$attrs$Dates) <- c(sdate = 3, ftime = 214) #'class(exp) <- 's2dv_cube' #'exp_probs <- CST_Threshold(exp, threshold, start = list(21, 4), end = list(21, 6)) #' @@ -74,6 +75,7 @@ CST_Threshold <- function(data, threshold, start = NULL, end = NULL, time_dim = time_dim, memb_dim = memb_dim, sdate_dim = sdate_dim, na.rm = na.rm, ncores = ncores) data$data <- thres + data$dims <- dim(thres) if (!is.null(start) && !is.null(end)) { data$attrs$Dates <- SelectPeriodOnDates(dates = data$attrs$Dates, start = start, end = end, @@ -91,10 +93,10 @@ CST_Threshold <- function(data, threshold, start = NULL, end = NULL, #' #'@param data A multidimensional array with named dimensions. #'@param threshold A single scalar or vector indicating the relative -#' threshold(s). -#'@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. +#' threshold(s). It must contain values between 0 and 1. +#'@param dates A multidimensional array of dates with named dimensions matching +#' the temporal dimensions on parameter 'data'. By default it is NULL, to +#' select aperiod 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 @@ -134,7 +136,7 @@ CST_Threshold <- function(data, threshold, start = NULL, end = NULL, #'@importFrom stats quantile #'@export Threshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, - time_dim = 'time', memb_dim = 'member', sdate_dim = 'sdate', + time_dim = 'ftime', memb_dim = 'member', sdate_dim = 'sdate', na.rm = FALSE, ncores = NULL) { if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") @@ -147,7 +149,7 @@ Threshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, names(dim(data)) <- c(memb_dim, sdate_dim) } if (is.null(threshold)) { - stop("Parameter 'threshold' cannot be NULL.") + stop("Parameter 'threshold' cannot be NULL.") } if (!is.numeric(threshold)) { stop("Parameter 'threshold' must be numeric.") @@ -161,8 +163,14 @@ Threshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, stop("Parameter 'start' and 'end' must be lists indicating the ", "day and the month of the period start and end.") } - data <- SelectPeriodOnData(data, dates, start, end, - time_dim = time_dim, ncores = ncores) + if (!is.null(dim(dates))) { + data <- SelectPeriodOnData(data = data, dates = dates, start = start, + end = end, time_dim = time_dim, + ncores = ncores) + } else { + warning("Parameter 'dates' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + } } } if (!is.null(memb_dim)) { diff --git a/R/TotalSpellTimeExceedingThreshold.R b/R/TotalSpellTimeExceedingThreshold.R index 3ee22a2..5d649b4 100644 --- a/R/TotalSpellTimeExceedingThreshold.R +++ b/R/TotalSpellTimeExceedingThreshold.R @@ -48,7 +48,12 @@ #' computation. #' #'@return An 's2dv_cube' object containing the number of days that are part of a -#'spell within a threshold in element \code{data}. +#'spell within a threshold in element \code{data} with dimensions of the input +#'parameter 'data' except the dimension where the indicator has been computed. +#'A new element called 'time_bounds' will be added into the 'attrs' element in +#'the 's2dv_cube' object. It consists of a list containing two elements, the +#'start and end dates of the aggregated period with the same dimensions of +#''Dates' element. #' #'@examples #'exp <- NULL @@ -60,10 +65,14 @@ #' 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')) +#'dim(exp$attrs$Dates) <- c(sdate = 3, ftime = 214) #'class(exp) <- 's2dv_cube' -#'TTSET <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = 23, spell = 3) +#'TTSET <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = 23, spell = 3, +#' start = list(21, 4), +#' end = list(21, 6)) #' #'@import multiApply +#'@importFrom ClimProjDiags Subset #'@export CST_TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '>', start = NULL, end = NULL, @@ -95,19 +104,41 @@ CST_TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '> threshold[[2]] <- threshold[[2]]$data } } + + Dates <- data$attrs$Dates - total <- TotalSpellTimeExceedingThreshold(data$data, data$attrs$Dates, + total <- TotalSpellTimeExceedingThreshold(data$data, Dates, threshold = threshold, spell = spell, op = op, start = start, end = end, time_dim = time_dim, ncores = ncores) data$data <- total - if (!is.null(start) && !is.null(end)) { - data$attrs$Dates <- SelectPeriodOnDates(dates = data$attrs$Dates, - start = start, end = end, - time_dim = time_dim, - ncores = ncores) + data$dims <- dim(total) + + if (!is.null(Dates)) { + if (!is.null(start) && !is.null(end)) { + Dates <- SelectPeriodOnDates(dates = Dates, start = start, end = end, + time_dim = time_dim, ncores = ncores) + } + if (is.null(dim(Dates))) { + warning("Element 'Dates' has NULL dimensions. They will not be ", + "subset and 'time_bounds' will be missed.") + data$attrs$Dates <- Dates + } else { + # Create time_bounds + time_bounds <- NULL + time_bounds$start <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = 1, drop = 'selected') + time_bounds$end <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = dim(Dates)[time_dim], + drop = 'selected') + + # Add Dates in attrs + data$attrs$Dates <- time_bounds$start + data$attrs$time_bounds <- time_bounds + } } + return(data) } #'Total Spell Time Exceeding Threshold @@ -143,9 +174,9 @@ CST_TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '> #' are used it has to be a vector of a pair of two logical operators: #' c('<', '>'), c('<', '>='), c('<=', '>'), c('<=', '>='), c('>', '<'), #' c('>', '<='), c('>=', '<'),c('>=', '<=')). -#'@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 dates A multidimensional array of dates with named dimensions matching +#' the temporal dimensions on parameter 'data'. By default it is NULL, to +#' select aperiod 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 @@ -171,9 +202,19 @@ CST_TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '> #'values by values exceeding the threshold. #'@examples -#'data <- array(rnorm(120), c(member = 1, sdate = 2, ftime = 20, lat = 4)) -#'threshold <- array(rnorm(4), c(lat = 4)) -#'total <- TotalSpellTimeExceedingThreshold(data, threshold, spell = 6) +#'data <- array(1:100, c(member = 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"), +#' 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')) +#'dim(Dates) <- c(sdate = 3, ftime = 214) +#' +#'threshold <- array(1:4, c(lat = 4)) +#'total <- TotalSpellTimeExceedingThreshold(data, threshold, dates = Dates, +#' spell = 6, start = list(21, 4), +#' end = list(21, 6)) #' #'@import multiApply #'@export @@ -334,6 +375,14 @@ TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '>', } } } + if (!is.null(dim(dates))) { + data <- SelectPeriodOnData(data = data, dates = dates, start = start, + end = end, time_dim = time_dim, + ncores = ncores) + } else { + warning("Parameter 'dates' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + } data <- SelectPeriodOnData(data, dates, start, end, time_dim = time_dim, ncores = ncores) } diff --git a/R/TotalTimeExceedingThreshold.R b/R/TotalTimeExceedingThreshold.R index ceda1ee..49fa988 100644 --- a/R/TotalTimeExceedingThreshold.R +++ b/R/TotalTimeExceedingThreshold.R @@ -54,11 +54,14 @@ #' #'@return An 's2dv_cube' object containing in element \code{data} the total #'number of the corresponding units of the data frequency that a variable is -#'exceeding a threshold during a period. +#'exceeding a threshold during a period. A new element called 'time_bounds' will +#'be added into the 'attrs' element in the 's2dv_cube' object. It consists of a +#'list containing two elements, the start and end dates of the aggregated period +#'with the same dimensions of 'Dates' element. #' #'@examples #'exp <- NULL -#'exp$data <- array(abs(rnorm(5 * 3 * 214 * 2)*280), +#'exp$data <- array(rnorm(5 * 3 * 214 * 2)*23, #' c(member = 5, sdate = 3, ftime = 214, lon = 2)) #'exp$attrs$Dates <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), #' as.Date("30-11-2000", format = "%d-%m-%Y"), by = 'day'), @@ -66,10 +69,13 @@ #' 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')) +#'dim(exp$attrs$Dates) <- c(sdate = 3, ftime = 214) #'class(exp) <- 's2dv_cube' -#'DOT <- CST_TotalTimeExceedingThreshold(exp, threshold = 280) +#'DOT <- CST_TotalTimeExceedingThreshold(exp, threshold = 23, start = list(21, 4), +#' end = list(21, 6)) #' #'@import multiApply +#'@importFrom ClimProjDiags Subset #'@export CST_TotalTimeExceedingThreshold <- function(data, threshold, op = '>', start = NULL, end = NULL, @@ -101,17 +107,38 @@ CST_TotalTimeExceedingThreshold <- function(data, threshold, op = '>', threshold[[2]] <- threshold[[2]]$data } } - total <- TotalTimeExceedingThreshold(data$data, dates = data$attrs$Dates, + + Dates <- data$attrs$Dates + total <- TotalTimeExceedingThreshold(data = data$data, dates = Dates, 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$attrs$Dates <- SelectPeriodOnDates(dates = data$attrs$Dates, - start = start, end = end, - time_dim = time_dim, - ncores = ncores) + data$dims <- dim(total) + + if (!is.null(Dates)) { + if (!is.null(start) && !is.null(end)) { + Dates <- SelectPeriodOnDates(dates = Dates, start = start, end = end, + time_dim = time_dim, ncores = ncores) + } + if (is.null(dim(Dates))) { + warning("Element 'Dates' has NULL dimensions. They will not be ", + "subset and 'time_bounds' will be missed.") + data$attrs$Dates <- Dates + } else { + # Create time_bounds + time_bounds <- NULL + time_bounds$start <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = 1, drop = 'selected') + time_bounds$end <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = dim(Dates)[time_dim], + drop = 'selected') + + # Add Dates in attrs + data$attrs$Dates <- time_bounds$start + data$attrs$time_bounds <- time_bounds + } } return(data) } @@ -151,9 +178,9 @@ CST_TotalTimeExceedingThreshold <- function(data, threshold, op = '>', #' are used it has to be a vector of a pair of two logical operators: #' c('<', '>'), c('<', '>='), c('<=', '>'), c('<=', '>='), c('>', '<'), #' c('>', '<='), c('>=', '<'),c('>=', '<=')). -#'@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 dates A multidimensional array of dates with named dimensions matching +#' the temporal dimensions on parameter 'data'. By default it is NULL, to +#' select aperiod this parameter must be provided. #'@param start An optional parameter to define 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 @@ -173,12 +200,21 @@ CST_TotalTimeExceedingThreshold <- function(data, threshold, op = '>', #' #'@return A multidimensional array with named dimensions containing the total #'number of the corresponding units of the data frequency that a variable is -#'exceeding a threshold during a period. +#'exceeding a threshold during a period with dimensions of the input parameter +#''data' except the dimension where the indicator has been computed. #' #'@examples -#'exp <- array(abs(rnorm(5 * 3 * 214 * 2)*280), -#' c(member = 5, sdate = 3, ftime = 214, lon = 2)) -#'DOT <- TotalTimeExceedingThreshold(exp, threshold = 300, time_dim = 'ftime') +#'data <- array(rnorm(5 * 3 * 214 * 2)*23, +#' c(member = 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"), +#' 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')) +#'dim(Dates) <- c(sdate = 3, ftime = 214) +#'DOT <- TotalTimeExceedingThreshold(data, threshold = 23, dates = Dates, +#' start = list(21, 4), end = list(21, 6)) #' #'@import multiApply #'@export @@ -336,8 +372,14 @@ TotalTimeExceedingThreshold <- function(data, threshold, op = '>', } } } - data <- SelectPeriodOnData(data, dates, start, end, - time_dim = time_dim, ncores = ncores) + if (!is.null(dim(dates))) { + data <- SelectPeriodOnData(data = data, dates = dates, start = start, + end = end, time_dim = time_dim, + ncores = ncores) + } else { + warning("Parameter 'dates' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + } } } diff --git a/R/WindCapacityFactor.R b/R/WindCapacityFactor.R index 8ed2084..906ade3 100644 --- a/R/WindCapacityFactor.R +++ b/R/WindCapacityFactor.R @@ -42,14 +42,23 @@ #'@examples #'wind <- NULL #'wind$data <- array(rweibull(n = 100, shape = 2, scale = 6), -#' c(member = 10, lat = 2, lon = 5)) +#' c(member = 5, sdate = 3, ftime = 214, lon = 2, lat = 5)) #'wind$coords <- list(lat = c(40, 41), lon = 1:5) #'variable <- list(varName = 'sfcWind', #' metadata = list(sfcWind = list(level = 'Surface'))) #'wind$attrs <- list(Variable = variable, Datasets = 'synthetic', #' when = Sys.time(), Dates = '1990-01-01 00:00:00') +#'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')) +#'dim(Dates) <- c(sdate = 3, ftime = 214) +#'wind$attrs$Dates <- Dates #'class(wind) <- 's2dv_cube' -#'WCF <- CST_WindCapacityFactor(wind, IEC_class = "III") +#'WCF <- CST_WindCapacityFactor(wind, IEC_class = "III", +#' start = list(21, 4), end = list(21, 6)) #' #'@export CST_WindCapacityFactor <- function(wind, IEC_class = c("I", "I/II", "II", "II/III", "III"), @@ -73,6 +82,8 @@ CST_WindCapacityFactor <- function(wind, IEC_class = c("I", "I/II", "II", "II/II dates = wind$attrs$Dates, start = start, end = end, ncores = ncores) wind$data <- WindCapacity + wind$dims <- dim(WindCapacity) + if ('Variable' %in% names(wind$attrs)) { if ('varName' %in% names(wind$attrs$Variable)) { wind$attrs$Variable$varName <- 'WindCapacityFactor' @@ -111,9 +122,9 @@ CST_WindCapacityFactor <- function(wind, IEC_class = c("I", "I/II", "II", "II/II #' respectively. Classes \code{'I/II'} and \code{'II/III'} indicate #' intermediate turbines that fit both classes. More details of the five #' turbines and a plot of its power curves can be found in Lledó et al. (2019). -#'@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 dates A multidimensional array of dates with named dimensions matching +#' the temporal dimensions on parameter 'data'. By default it is NULL, to +#' select aperiod 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 @@ -134,15 +145,26 @@ CST_WindCapacityFactor <- function(wind, IEC_class = c("I", "I/II", "II", "II/II #' Capacity Factor (unitless). #' #'@examples -#'wind <- rweibull(n = 100, shape = 2, scale = 6) -#'WCF <- WindCapacityFactor(wind, IEC_class = "III") +#'wind <- array(rweibull(n = 32100, shape = 2, scale = 6), +#' c(member = 5, sdate = 3, ftime = 214, lon = 2, lat = 5)) +#' +#'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')) +#'dim(Dates) <- c(sdate = 3, ftime = 214) +#' +#'WCF <- WindCapacityFactor(wind, IEC_class = "III", dates = Dates, +#' start = list(21, 4), end = list(21, 6)) #' #'@importFrom stats approxfun #'@importFrom utils read.delim #'@export WindCapacityFactor <- function(wind, IEC_class = c("I", "I/II", "II", "II/III", "III"), dates = NULL, start = NULL, end = NULL, - time_dim = 'time', ncores = NULL) { + time_dim = 'ftime', ncores = NULL) { IEC_class <- match.arg(IEC_class) pc_files <- c( "I" = "Enercon_E70_2.3MW.txt", @@ -159,8 +181,14 @@ WindCapacityFactor <- function(wind, IEC_class = c("I", "I/II", "II", "II/III", stop("Parameter 'start' and 'end' must be lists indicating the ", "day and the month of the period start and end.") } - wind <- SelectPeriodOnData(wind, dates, start, end, - time_dim = time_dim, ncores = ncores) + if (!is.null(dim(dates))) { + wind <- SelectPeriodOnData(data = wind, dates = dates, start = start, + end = end, time_dim = time_dim, + ncores = ncores) + } else { + warning("Parameter 'wind' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + } } } diff --git a/R/WindPowerDensity.R b/R/WindPowerDensity.R index 3578209..e9c70f6 100644 --- a/R/WindPowerDensity.R +++ b/R/WindPowerDensity.R @@ -6,8 +6,8 @@ #'@description It is computed as 0.5*ro*wspd^3. As this function is non-linear, #'it will give inaccurate results if used with period means. #' -#'@param wind An s2dv_cube object with instantaneous wind speeds expressed in m/s -#' obtained from CST_Load or s2dv_cube functions from CSTools pacakge. +#'@param wind An 's2dv_cube' object with instantaneous wind speeds expressed in +#' m/s obtained from CST_Load or s2dv_cube functions from CSTools pacakge. #'@param ro A scalar, or alternatively a multidimensional array with the same #' dimensions as wind, with the air density expressed in kg/m^3. By default it #' takes the value 1.225, the standard density of air at 15ºC and 1013.25 hPa. @@ -32,14 +32,23 @@ #'@examples #'wind <- NULL #'wind$data <- array(rweibull(n = 100, shape = 2, scale = 6), -#' c(member = 10, lat = 2, lon = 5)) +#' c(member = 5, sdate = 3, ftime = 214, lon = 2, lat = 5)) #'wind$coords <- list(lat = c(40, 41), lon = 1:5) #'variable <- list(varName = 'sfcWind', #' metadata = list(sfcWind = list(level = 'Surface'))) #'wind$attrs <- list(Variable = variable, Datasets = 'synthetic', #' when = Sys.time(), Dates = '1990-01-01 00:00:00') +#'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')) +#'dim(Dates) <- c(sdate = 3, ftime = 214) +#'wind$attrs$Dates <- Dates #'class(wind) <- 's2dv_cube' -#'WCF <- CST_WindPowerDensity(wind) +#'WPD <- CST_WindPowerDensity(wind, start = list(21, 4), +#' end = list(21, 6)) #' #'@export CST_WindPowerDensity <- function(wind, ro = 1.225, start = NULL, end = NULL, @@ -61,6 +70,7 @@ CST_WindPowerDensity <- function(wind, ro = 1.225, start = NULL, end = NULL, dates = wind$attrs$Dates, start = start, end = end, ncores = ncores) wind$data <- WindPower + wind$dims <- dim(WindPower) if ('Variable' %in% names(wind$attrs)) { if ('varName' %in% names(wind$attrs$Variable)) { wind$attrs$Variable$varName <- 'WindPowerDensity' @@ -88,9 +98,9 @@ CST_WindPowerDensity <- function(wind, ro = 1.225, start = NULL, end = NULL, #'@param ro A scalar, or alternatively a multidimensional array with the same #' dimensions as wind, with the air density expressed in kg/m^3. By default it #' takes the value 1.225, the standard density of air at 15ºC and 1013.25 hPa. -#'@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 dates A multidimensional array of dates with named dimensions matching +#' the temporal dimensions on parameter 'data'. By default it is NULL, to +#' select aperiod 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 @@ -111,20 +121,35 @@ CST_WindPowerDensity <- function(wind, ro = 1.225, start = NULL, end = NULL, #'Density expressed in W/m^2. #' #'@examples -#'wind <- rweibull(n = 100, shape = 2, scale = 6) -#'WPD <- WindPowerDensity(wind) +#'wind <- array(rweibull(n = 32100, shape = 2, scale = 6), +#' c(member = 5, sdate = 3, ftime = 214, lon = 2, lat = 5)) +#'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')) +#'dim(Dates) <- c(sdate = 3, ftime = 214) +#'WPD <- WindPowerDensity(wind, dates = Dates, start = list(21, 4), +#' end = list(21, 6)) #' #'@export WindPowerDensity <- function(wind, ro = 1.225, dates = NULL, start = NULL, - end = NULL, time_dim = 'time', ncores = NULL) { + end = NULL, time_dim = 'ftime', ncores = NULL) { 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.") } - wind <- SelectPeriodOnData(wind, dates, start, end, - time_dim = time_dim, ncores = ncores) + if (!is.null(dim(dates))) { + wind <- SelectPeriodOnData(data = wind, dates = dates, start = start, + end = end, time_dim = time_dim, + ncores = ncores) + } else { + warning("Parameter 'wind' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + } } } return(0.5 * ro * wind^3) diff --git a/man/AccumulationExceedingThreshold.Rd b/man/AccumulationExceedingThreshold.Rd index 172592c..0f9a64a 100644 --- a/man/AccumulationExceedingThreshold.Rd +++ b/man/AccumulationExceedingThreshold.Rd @@ -39,9 +39,9 @@ c('>', '<='), c('>=', '<'),c('>=', '<=')).} between data and threshold (TRUE) or not (FALSE by default). It can only be TRUE if a unique threshold is used.} -\item{dates}{A vector of dates or a multidimensional array with 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{dates}{A multidimensional array of dates with named dimensions matching +the temporal dimensions on parameter 'data'. By default it is NULL, to +select aperiod this parameter must be provided.} \item{start}{An optional parameter to define the initial date of the period to select from the data by providing a list of two elements: the initial @@ -86,12 +86,6 @@ function: # Assuming data is already (tasmax + tasmin)/2 - 10 data <- array(rnorm(5 * 3 * 214 * 2, mean = 25, sd = 3), 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"), - 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 = 0, start = list(1, 4), end = list(31, 10)) } diff --git a/man/CST_AccumulationExceedingThreshold.Rd b/man/CST_AccumulationExceedingThreshold.Rd index bc0eb83..f14c33b 100644 --- a/man/CST_AccumulationExceedingThreshold.Rd +++ b/man/CST_AccumulationExceedingThreshold.Rd @@ -63,7 +63,10 @@ computation.} \value{ An 's2dv_cube' object containing the aggregated values in the element \code{data} with dimensions of the input parameter 'data' except the dimension -where the indicator has been computed. +where the indicator has been computed. A new element called 'time_bounds' will +be added into the 'attrs' element in the 's2dv_cube' object. It consists of a +list containing two elements, the start and end dates of the aggregated period +with the same dimensions of 'Dates' element. } \description{ The accumulation (sum) of a variable in the days (or time steps) that the @@ -80,9 +83,19 @@ function: } \examples{ exp <- NULL -exp$data <- array(rnorm(216)*200, dim = c(dataset = 1, member = 2, sdate = 3, - ftime = 9, lat = 2, lon = 2)) +exp$data <- array(abs(rnorm(5 * 3 * 214 * 2)*100), + c(memb = 5, sdate = 3, ftime = 214, lon = 2)) class(exp) <- 's2dv_cube' -DOT <- CST_AccumulationExceedingThreshold(exp, threshold = 280) +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')) +dim(Dates) <- c(sdate = 3, ftime = 214) +exp$attrs$Dates <- Dates +AT <- CST_AccumulationExceedingThreshold(data = exp, threshold = 100, + start = list(21, 4), + end = list(21, 6)) } diff --git a/man/CST_PeriodMean.Rd b/man/CST_PeriodMean.Rd index f9db984..d0e1ba8 100644 --- a/man/CST_PeriodMean.Rd +++ b/man/CST_PeriodMean.Rd @@ -59,19 +59,19 @@ this function: } \examples{ exp <- NULL -exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 6, ftime = 3)) -Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), - as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), - seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), - as.Date("2002-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), - seq(as.Date("2002-11-01", "\%Y-\%m-\%d", tz = "UTC"), - as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), - seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), - as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) +exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2002-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2002-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) dim(Dates) <- c(sdate = 4, ftime = 3) exp$attrs$Dates <- Dates class(exp) <- 's2dv_cube' -SA <- CST_PeriodMean(exp) +SA <- CST_PeriodMean(exp, start = list(01, 12), end = list(01, 01)) } diff --git a/man/CST_QThreshold.Rd b/man/CST_QThreshold.Rd index eda0fd1..5a68bc3 100644 --- a/man/CST_QThreshold.Rd +++ b/man/CST_QThreshold.Rd @@ -83,14 +83,18 @@ exp <- NULL exp$data <- array(abs(rnorm(112)*26), dim = c(member = 7, sdate = 8, ftime = 2)) class(exp) <- 's2dv_cube' exp_probs <- CST_QThreshold(exp, threshold) -exp$data <- array(rnorm(5 * 3 * 214 * 2), - c(member = 5, sdate = 3, ftime = 214, lon = 2)) + +exp$data <- array(abs(rnorm(5 * 3 * 214 * 2)*50), + c(member = 5, sdate = 3, ftime = 214, lon = 2)) exp$attrs$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')) -exp_probs <- CST_QThreshold(exp, threshold) +dim(exp$attrs$Dates) <- c(sdate = 3, ftime = 214) +class(exp) <- 's2dv_cube' +exp_probs <- CST_QThreshold(exp, threshold, start = list(21, 4), + end = list(21, 6)) } diff --git a/man/CST_Threshold.Rd b/man/CST_Threshold.Rd index ffe0600..e513ec0 100644 --- a/man/CST_Threshold.Rd +++ b/man/CST_Threshold.Rd @@ -21,7 +21,7 @@ CST_Threshold( package CSTools.} \item{threshold}{A single scalar or vector indicating the relative -threshold(s).} +threshold(s). It must contain values between 0 and 1.} \item{start}{An optional parameter to defined the initial date of the period to selectfrom the data by providing a list of two elements: the initial date @@ -67,13 +67,14 @@ given a dataset. threshold <- 0.9 exp <- NULL exp$data <- array(rnorm(5 * 3 * 214 * 2), - c(member = 5, sdate = 3, ftime = 214, lon = 2)) + c(member = 5, sdate = 3, ftime = 214, lon = 2)) exp$attrs$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')) +dim(exp$attrs$Dates) <- c(sdate = 3, ftime = 214) class(exp) <- 's2dv_cube' exp_probs <- CST_Threshold(exp, threshold, start = list(21, 4), end = list(21, 6)) diff --git a/man/CST_TotalSpellTimeExceedingThreshold.Rd b/man/CST_TotalSpellTimeExceedingThreshold.Rd index e2f7d26..69dee16 100644 --- a/man/CST_TotalSpellTimeExceedingThreshold.Rd +++ b/man/CST_TotalSpellTimeExceedingThreshold.Rd @@ -56,7 +56,12 @@ computation.} } \value{ An 's2dv_cube' object containing the number of days that are part of a -spell within a threshold in element \code{data}. +spell within a threshold in element \code{data} with dimensions of the input +parameter 'data' except the dimension where the indicator has been computed. +A new element called 'time_bounds' will be added into the 'attrs' element in +the 's2dv_cube' object. It consists of a list containing two elements, the +start and end dates of the aggregated period with the same dimensions of +'Dates' element. } \description{ The number of days (when daily data is provided) that are part of a spell @@ -84,8 +89,11 @@ exp$attrs$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')) +dim(exp$attrs$Dates) <- c(sdate = 3, ftime = 214) class(exp) <- 's2dv_cube' -TTSET <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = 23, spell = 3) +TTSET <- CST_TotalSpellTimeExceedingThreshold(exp, threshold = 23, spell = 3, + start = list(21, 4), + end = list(21, 6)) } \seealso{ diff --git a/man/CST_TotalTimeExceedingThreshold.Rd b/man/CST_TotalTimeExceedingThreshold.Rd index b09ae53..840700a 100644 --- a/man/CST_TotalTimeExceedingThreshold.Rd +++ b/man/CST_TotalTimeExceedingThreshold.Rd @@ -58,7 +58,10 @@ computation.} \value{ An 's2dv_cube' object containing in element \code{data} the total number of the corresponding units of the data frequency that a variable is -exceeding a threshold during a period. +exceeding a threshold during a period. A new element called 'time_bounds' will +be added into the 'attrs' element in the 's2dv_cube' object. It consists of a +list containing two elements, the start and end dates of the aggregated period +with the same dimensions of 'Dates' element. } \description{ The Total Time of a variable exceeding (or not) a Threshold. It returns the @@ -83,7 +86,7 @@ indices for heat stress can be obtained by using this function: } \examples{ exp <- NULL -exp$data <- array(abs(rnorm(5 * 3 * 214 * 2)*280), +exp$data <- array(rnorm(5 * 3 * 214 * 2)*23, c(member = 5, sdate = 3, ftime = 214, lon = 2)) exp$attrs$Dates <- c(seq(as.Date("01-05-2000", format = "\%d-\%m-\%Y"), as.Date("30-11-2000", format = "\%d-\%m-\%Y"), by = 'day'), @@ -91,7 +94,9 @@ exp$attrs$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')) +dim(exp$attrs$Dates) <- c(sdate = 3, ftime = 214) class(exp) <- 's2dv_cube' -DOT <- CST_TotalTimeExceedingThreshold(exp, threshold = 280) +DOT <- CST_TotalTimeExceedingThreshold(exp, threshold = 23, start = list(21, 4), + end = list(21, 6)) } diff --git a/man/CST_WindCapacityFactor.Rd b/man/CST_WindCapacityFactor.Rd index 638f5b8..84c057d 100644 --- a/man/CST_WindCapacityFactor.Rd +++ b/man/CST_WindCapacityFactor.Rd @@ -60,14 +60,23 @@ below). \examples{ wind <- NULL wind$data <- array(rweibull(n = 100, shape = 2, scale = 6), - c(member = 10, lat = 2, lon = 5)) + c(member = 5, sdate = 3, ftime = 214, lon = 2, lat = 5)) wind$coords <- list(lat = c(40, 41), lon = 1:5) variable <- list(varName = 'sfcWind', metadata = list(sfcWind = list(level = 'Surface'))) wind$attrs <- list(Variable = variable, Datasets = 'synthetic', when = Sys.time(), Dates = '1990-01-01 00:00:00') +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')) +dim(Dates) <- c(sdate = 3, ftime = 214) +wind$attrs$Dates <- Dates class(wind) <- 's2dv_cube' -WCF <- CST_WindCapacityFactor(wind, IEC_class = "III") +WCF <- CST_WindCapacityFactor(wind, IEC_class = "III", + start = list(21, 4), end = list(21, 6)) } \references{ diff --git a/man/CST_WindPowerDensity.Rd b/man/CST_WindPowerDensity.Rd index c33bd8d..4b04aed 100644 --- a/man/CST_WindPowerDensity.Rd +++ b/man/CST_WindPowerDensity.Rd @@ -14,8 +14,8 @@ CST_WindPowerDensity( ) } \arguments{ -\item{wind}{An s2dv_cube object with instantaneous wind speeds expressed in m/s -obtained from CST_Load or s2dv_cube functions from CSTools pacakge.} +\item{wind}{An 's2dv_cube' object with instantaneous wind speeds expressed in +m/s obtained from CST_Load or s2dv_cube functions from CSTools pacakge.} \item{ro}{A scalar, or alternatively a multidimensional array with the same dimensions as wind, with the air density expressed in kg/m^3. By default it @@ -53,14 +53,23 @@ it will give inaccurate results if used with period means. \examples{ wind <- NULL wind$data <- array(rweibull(n = 100, shape = 2, scale = 6), - c(member = 10, lat = 2, lon = 5)) + c(member = 5, sdate = 3, ftime = 214, lon = 2, lat = 5)) wind$coords <- list(lat = c(40, 41), lon = 1:5) variable <- list(varName = 'sfcWind', metadata = list(sfcWind = list(level = 'Surface'))) wind$attrs <- list(Variable = variable, Datasets = 'synthetic', when = Sys.time(), Dates = '1990-01-01 00:00:00') +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')) +dim(Dates) <- c(sdate = 3, ftime = 214) +wind$attrs$Dates <- Dates class(wind) <- 's2dv_cube' -WCF <- CST_WindPowerDensity(wind) +WPD <- CST_WindPowerDensity(wind, start = list(21, 4), + end = list(21, 6)) } \author{ diff --git a/man/PeriodAccumulation.Rd b/man/PeriodAccumulation.Rd index 0f55937..614b65c 100644 --- a/man/PeriodAccumulation.Rd +++ b/man/PeriodAccumulation.Rd @@ -17,10 +17,9 @@ PeriodAccumulation( \arguments{ \item{data}{A multidimensional array with named dimensions.} -\item{dates}{A multidimensional array of datesW with named dimensions matching -the dimensions on parameter 'data'. By default it is NULL, to select a -period this parameter must be provided and it needs to have temporal -dimensions.} +\item{dates}{A multidimensional array of dates with named dimensions matching +the temporal dimensions on parameter 'data'. By default it is NULL, to +select aperiod 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 diff --git a/man/PeriodMean.Rd b/man/PeriodMean.Rd index fffb332..f52db40 100644 --- a/man/PeriodMean.Rd +++ b/man/PeriodMean.Rd @@ -17,9 +17,9 @@ PeriodMean( \arguments{ \item{data}{A multidimensional array with named dimensions.} -\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{dates}{A multidimensional array of dates with named dimensions matching +the temporal dimensions on parameter 'data'. By default it is NULL, to +select aperiod 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 diff --git a/man/QThreshold.Rd b/man/QThreshold.Rd index 2af6e5f..ba023d8 100644 --- a/man/QThreshold.Rd +++ b/man/QThreshold.Rd @@ -10,7 +10,7 @@ QThreshold( dates = NULL, start = NULL, end = NULL, - time_dim = "time", + time_dim = "ftime", memb_dim = "member", sdate_dim = "sdate", ncores = NULL @@ -23,9 +23,9 @@ QThreshold( units as parameter 'data' and with the common dimensions of the element 'data' of the same length.} -\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{dates}{A multidimensional array of dates with named dimensions matching +the temporal dimensions on parameter 'data'. By default it is NULL, to +select aperiod 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 @@ -82,7 +82,17 @@ and memb_dim parameters: \examples{ threshold = 25 data <- array(rnorm(5 * 3 * 20 * 2, mean = 26), - c(member = 5, sdate = 3, time = 20, lon = 2)) -thres_q <- QThreshold(data, threshold) + c(member = 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')) +dim(Dates) <- c(sdate = 3, time = 214) + +thres_q <- QThreshold(data, threshold, dates = Dates, time_dim = 'time', + start = list(21, 4), end = list(21, 6)) } diff --git a/man/Threshold.Rd b/man/Threshold.Rd index db59817..d254cbe 100644 --- a/man/Threshold.Rd +++ b/man/Threshold.Rd @@ -10,7 +10,7 @@ Threshold( dates = NULL, start = NULL, end = NULL, - time_dim = "time", + time_dim = "ftime", memb_dim = "member", sdate_dim = "sdate", na.rm = FALSE, @@ -21,11 +21,11 @@ Threshold( \item{data}{A multidimensional array with named dimensions.} \item{threshold}{A single scalar or vector indicating the relative -threshold(s).} +threshold(s). It must contain values between 0 and 1.} -\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{dates}{A multidimensional array of dates with named dimensions matching +the temporal dimensions on parameter 'data'. By default it is NULL, to +select aperiod 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 diff --git a/man/TotalSpellTimeExceedingThreshold.Rd b/man/TotalSpellTimeExceedingThreshold.Rd index 276423b..10124de 100644 --- a/man/TotalSpellTimeExceedingThreshold.Rd +++ b/man/TotalSpellTimeExceedingThreshold.Rd @@ -36,9 +36,9 @@ are used it has to be a vector of a pair of two logical operators: c('<', '>'), c('<', '>='), c('<=', '>'), c('<=', '>='), c('>', '<'), c('>', '<='), c('>=', '<'),c('>=', '<=')).} -\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{dates}{A multidimensional array of dates with named dimensions matching +the temporal dimensions on parameter 'data'. By default it is NULL, to +select aperiod 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 @@ -86,9 +86,19 @@ different behaviour consider to modify the 'data' input by substituting NA values by values exceeding the threshold. } \examples{ -data <- array(rnorm(120), c(member = 1, sdate = 2, ftime = 20, lat = 4)) -threshold <- array(rnorm(4), c(lat = 4)) -total <- TotalSpellTimeExceedingThreshold(data, threshold, spell = 6) +data <- array(1:100, c(member = 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"), + 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')) +dim(Dates) <- c(sdate = 3, ftime = 214) + +threshold <- array(1:4, c(lat = 4)) +total <- TotalSpellTimeExceedingThreshold(data, threshold, dates = Dates, + spell = 6, start = list(21, 4), + end = list(21, 6)) } \seealso{ diff --git a/man/TotalTimeExceedingThreshold.Rd b/man/TotalTimeExceedingThreshold.Rd index 2068475..4dc00d0 100644 --- a/man/TotalTimeExceedingThreshold.Rd +++ b/man/TotalTimeExceedingThreshold.Rd @@ -34,9 +34,9 @@ are used it has to be a vector of a pair of two logical operators: c('<', '>'), c('<', '>='), c('<=', '>'), c('<=', '>='), c('>', '<'), c('>', '<='), c('>=', '<'),c('>=', '<=')).} -\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{dates}{A multidimensional array of dates with named dimensions matching +the temporal dimensions on parameter 'data'. By default it is NULL, to +select aperiod this parameter must be provided.} \item{start}{An optional parameter to define the initial date of the period to select from the data by providing a list of two elements: the initial @@ -62,7 +62,8 @@ computation.} \value{ A multidimensional array with named dimensions containing the total number of the corresponding units of the data frequency that a variable is -exceeding a threshold during a period. +exceeding a threshold during a period with dimensions of the input parameter +'data' except the dimension where the indicator has been computed. } \description{ The Total Time of a variable exceeding (or not) a Threshold. It returns the @@ -86,8 +87,16 @@ indices for heat stress can be obtained by using this function: } } \examples{ -exp <- array(abs(rnorm(5 * 3 * 214 * 2)*280), - c(member = 5, sdate = 3, ftime = 214, lon = 2)) -DOT <- TotalTimeExceedingThreshold(exp, threshold = 300, time_dim = 'ftime') +data <- array(rnorm(5 * 3 * 214 * 2)*23, + c(member = 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"), + 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')) +dim(Dates) <- c(sdate = 3, ftime = 214) +DOT <- TotalTimeExceedingThreshold(data, threshold = 23, dates = Dates, + start = list(21, 4), end = list(21, 6)) } diff --git a/man/WindCapacityFactor.Rd b/man/WindCapacityFactor.Rd index 69549a8..3ddeec6 100644 --- a/man/WindCapacityFactor.Rd +++ b/man/WindCapacityFactor.Rd @@ -10,7 +10,7 @@ WindCapacityFactor( dates = NULL, start = NULL, end = NULL, - time_dim = "time", + time_dim = "ftime", ncores = NULL ) } @@ -25,9 +25,9 @@ respectively. Classes \code{'I/II'} and \code{'II/III'} indicate intermediate turbines that fit both classes. More details of the five turbines and a plot of its power curves can be found in Lledó et al. (2019).} -\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{dates}{A multidimensional array of dates with named dimensions matching +the temporal dimensions on parameter 'data'. By default it is NULL, to +select aperiod 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 @@ -65,8 +65,19 @@ different power curves that span different IEC classes can be selected (see below). } \examples{ -wind <- rweibull(n = 100, shape = 2, scale = 6) -WCF <- WindCapacityFactor(wind, IEC_class = "III") +wind <- array(rweibull(n = 32100, shape = 2, scale = 6), + c(member = 5, sdate = 3, ftime = 214, lon = 2, lat = 5)) + +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')) +dim(Dates) <- c(sdate = 3, ftime = 214) + +WCF <- WindCapacityFactor(wind, IEC_class = "III", dates = Dates, + start = list(21, 4), end = list(21, 6)) } \references{ diff --git a/man/WindPowerDensity.Rd b/man/WindPowerDensity.Rd index 8e3c8e3..9b935bc 100644 --- a/man/WindPowerDensity.Rd +++ b/man/WindPowerDensity.Rd @@ -10,7 +10,7 @@ WindPowerDensity( dates = NULL, start = NULL, end = NULL, - time_dim = "time", + time_dim = "ftime", ncores = NULL ) } @@ -22,9 +22,9 @@ speeds expressed in m/s.} dimensions as wind, with the air density expressed in kg/m^3. By default it takes the value 1.225, the standard density of air at 15ºC and 1013.25 hPa.} -\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{dates}{A multidimensional array of dates with named dimensions matching +the temporal dimensions on parameter 'data'. By default it is NULL, to +select aperiod 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 @@ -57,8 +57,17 @@ It is computed as 0.5*ro*wspd^3. As this function is non-linear, it will give inaccurate results if used with period means. } \examples{ -wind <- rweibull(n = 100, shape = 2, scale = 6) -WPD <- WindPowerDensity(wind) +wind <- array(rweibull(n = 32100, shape = 2, scale = 6), + c(member = 5, sdate = 3, ftime = 214, lon = 2, lat = 5)) +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')) +dim(Dates) <- c(sdate = 3, ftime = 214) +WPD <- WindPowerDensity(wind, dates = Dates, start = list(21, 4), + end = list(21, 6)) } \author{ diff --git a/tests/testthat/test-AccumulationExceedingThreshold.R b/tests/testthat/test-AccumulationExceedingThreshold.R index 0331e8e..baa2c50 100644 --- a/tests/testthat/test-AccumulationExceedingThreshold.R +++ b/tests/testthat/test-AccumulationExceedingThreshold.R @@ -1,4 +1,7 @@ ############################################## + +library(CSTools) + # dat1 dat1 <- 1:20 @@ -234,7 +237,6 @@ test_that("4. Output checks", { }) ############################################## -library(CSTools) test_that("5. Seasonal forecasts", { exp <- CSTools::lonlat_temp$exp @@ -260,24 +262,25 @@ test_that("5. Seasonal forecasts", { 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')) + dim(Dates) <- c(sdate = 3, ftime = 214) 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, 367, 116, 519, 219, 282) + c(549, 387, 125, 554, 245, 282) ) expect_equal( dim(GDD), - c(member = 6, sdate = 3, lat =4, lon = 4) + 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), time_dim = 'time'), "Parameter 'time_dim' is not found in 'data' dimension." ) 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))) + !any(is.na(AccumulationExceedingThreshold(exp - 17, threshold = 0, dates = Dates, time_dim = 'ftime',start = list(1, 4), end = list(31, 10)))), + !any(is.na(c(1, 1))) ) # test the 'diff' @@ -294,7 +297,6 @@ test_that("5. Seasonal forecasts", { AccumulationExceedingThreshold(input_1, threshold_1), 204 ) - expect_equal( AccumulationExceedingThreshold(input_2, threshold_2, op = '<'), -105 @@ -304,3 +306,47 @@ test_that("5. Seasonal forecasts", { -55 ) }) + +############################################## +test_that("6. Subset Dates and check time_bounds", { + exp <- CSTools::lonlat_prec + res <- CST_AccumulationExceedingThreshold(data = exp, threshold = mean(exp$data), + time_dim = 'ftime', start = list(10, 03), + end = list(20, 03)) + # Check dims + expect_equal( + dim(res$data), + res$dims + ) + # Check Dates + expect_equal( + dim(res$data)['sdate'], + dim(res$attrs$Dates) + ) + # Check time_bounds + expect_equal( + res$attrs$Dates, + res$attrs$time_bounds$start + ) + expect_equal( + dim(res$attrs$time_bounds$start), + dim(res$attrs$time_bounds$end) + ) + # Check 'sdates' + expect_equal( + all(lubridate::month(res$attrs$time_bounds$start) == 3), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$start) == 10), + TRUE + ) + expect_equal( + all(lubridate::month(res$attrs$time_bounds$end) == 03), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$end) == 20), + TRUE + ) +}) diff --git a/tests/testthat/test-QThreshold.R b/tests/testthat/test-QThreshold.R index deb35df..3599bd9 100644 --- a/tests/testthat/test-QThreshold.R +++ b/tests/testthat/test-QThreshold.R @@ -1,5 +1,21 @@ + +library(CSTools) + +# dat1 +threshold <- 26 +dat1 <- array(abs(rnorm(5 * 3 * 214 * 2)*50), + c(member = 5, sdate = 3, ftime = 214, lon = 2)) +dates0 <- 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')) +dates1 <- dates0 +dim(dates1) <- c(sdate = 3, ftime = 214) + ############################################## -test_that("Sanity checks", { +test_that("1. Sanity checks", { expect_error( QThreshold(NULL), "Parameter 'data' cannot be NULL." @@ -104,13 +120,23 @@ test_that("Sanity checks", { dim(res), c(sdate = 3, ftime = 52) ) - + # test start and end + expect_warning( + QThreshold(dat1, threshold = 26, dates = dates0, start = list(21, 4), + end = list(21, 6)), + paste0("Parameter 'dates' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + ) + expect_equal( + dim(QThreshold(dat1, threshold = 26, dates = dates1, start = list(21, 4), + end = list(21, 6))), + c(sdate = 3, member = 5, ftime = 52, lon = 2) + ) }) ############################################## -library(CSTools) -test_that("Seasonal forecasts", { +test_that("2. Seasonal forecasts", { obs <- CSTools::lonlat_temp$obs$data - 248 obs_percentile <- QThreshold(obs, threshold = 35) expect_equal( @@ -142,3 +168,5 @@ test_that("Seasonal forecasts", { c(0.6, 0.4, 0.6, 0.6, 0.4, 0.4) ) }) + +############################################## diff --git a/tests/testthat/test-Threshold.R b/tests/testthat/test-Threshold.R index 84e4e0d..258e438 100644 --- a/tests/testthat/test-Threshold.R +++ b/tests/testthat/test-Threshold.R @@ -1,5 +1,21 @@ + +library(CSTools) + +# dat1 +threshold <- 0.9 +dat1 <- array(abs(rnorm(5 * 3 * 214 * 2)*50), + c(member = 5, sdate = 3, ftime = 214, lon = 2)) +dates0 <- 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')) +dates1 <- dates0 +dim(dates1) <- c(sdate = 3, ftime = 214) + ############################################## -test_that("Sanity checks", { +test_that("1. Sanity checks", { expect_error( Threshold(NULL), "Parameter 'data' cannot be NULL." @@ -60,9 +76,23 @@ test_that("Sanity checks", { dim(Threshold(data, threshold, memb_dim = 'x', sdate_dim = 'ftime')), c(probs = 2) ) + # test start and end + expect_warning( + Threshold(dat1, threshold = 0.9, dates = dates0, start = list(21, 4), + end = list(21, 6)), + paste0("Parameter 'dates' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + ) + expect_equal( + dim(Threshold(dat1, threshold = 0.8, dates = dates1, start = list(21, 4), + end = list(21, 6))), + c(ftime = 52, lon = 2) + ) }) -test_that("Seasonal forecasts", { +############################################## + +test_that("2. Seasonal forecasts", { exp <- CSTools::lonlat_temp$exp$data thresholdP <- Threshold(exp, threshold = 0.9) expect_equal( diff --git a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R index 36e46cf..f76b457 100644 --- a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R +++ b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R @@ -240,7 +240,7 @@ test_that("4. Output checks", { }) -########################################################################### +################################################################## test_that("5. Seasonal Forecasts", { exp <- CSTools::lonlat_temp$exp @@ -263,3 +263,47 @@ test_that("5. Seasonal Forecasts", { WSDI1$data[3,3,3,], c(rep(0, 53))) }) + +################################################################## + +test_that("6. Subset Dates and check time_bounds", { + exp <- CSTools::lonlat_prec + res <- CST_PeriodMean(data = CSTools::lonlat_prec, time_dim = 'ftime', + start = list(10, 03), end = list(20, 03)) + # Check dims + expect_equal( + dim(res$data), + res$dims + ) + # Check Dates + expect_equal( + dim(res$data)['sdate'], + dim(res$attrs$Dates) + ) + # Check time_bounds + expect_equal( + res$attrs$Dates, + res$attrs$time_bounds$start + ) + expect_equal( + dim(res$attrs$time_bounds$start), + dim(res$attrs$time_bounds$end) + ) + # Check 'sdates' + expect_equal( + all(lubridate::month(res$attrs$time_bounds$start) == 3), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$start) == 10), + TRUE + ) + expect_equal( + all(lubridate::month(res$attrs$time_bounds$end) == 03), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$end) == 20), + TRUE + ) +}) \ No newline at end of file diff --git a/tests/testthat/test-TotalTimeExceedingThreshold.R b/tests/testthat/test-TotalTimeExceedingThreshold.R index 1c3ca19..4a10b1b 100644 --- a/tests/testthat/test-TotalTimeExceedingThreshold.R +++ b/tests/testthat/test-TotalTimeExceedingThreshold.R @@ -40,7 +40,7 @@ thres4_7 <- rnorm(5, 20) set.seed(2) thres4_8 <- rnorm(5, 25) -########################################################################### +############################################################# test_that("1. Sanity checks", { # data @@ -137,7 +137,7 @@ test_that("1. Sanity checks", { }) -########################################################################### +####################################################### test_that("2. Output checks", { expect_equal( @@ -231,7 +231,7 @@ test_that("4. Output checks", { ########################################################################### -test_that("Seasonal forecasts", { +test_that("5. Seasonal forecasts", { # compare with scalar fixed threshold exp <- CSTools::lonlat_temp$exp obs <- CSTools::lonlat_temp$obs @@ -252,3 +252,47 @@ test_that("Seasonal forecasts", { c(3, 3, 3, 3, 3, 3) ) }) + +################################################################## + +test_that("6. Subset Dates and check time_bounds", { + exp <- CSTools::lonlat_prec + res <- CST_PeriodMean(data = CSTools::lonlat_prec, time_dim = 'ftime', + start = list(10, 03), end = list(20, 03)) + # Check dims + expect_equal( + dim(res$data), + res$dims + ) + # Check Dates + expect_equal( + dim(res$data)['sdate'], + dim(res$attrs$Dates) + ) + # Check time_bounds + expect_equal( + res$attrs$Dates, + res$attrs$time_bounds$start + ) + expect_equal( + dim(res$attrs$time_bounds$start), + dim(res$attrs$time_bounds$end) + ) + # Check 'sdates' + expect_equal( + all(lubridate::month(res$attrs$time_bounds$start) == 3), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$start) == 10), + TRUE + ) + expect_equal( + all(lubridate::month(res$attrs$time_bounds$end) == 03), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$end) == 20), + TRUE + ) +}) diff --git a/tests/testthat/test-WindCapacityFactor.R b/tests/testthat/test-WindCapacityFactor.R index bcecdbc..6fec014 100644 --- a/tests/testthat/test-WindCapacityFactor.R +++ b/tests/testthat/test-WindCapacityFactor.R @@ -12,7 +12,19 @@ wind$attrs <- list(Variable = variable, Datasets = 'synthetic', class(wind) <- 's2dv_cube' WCF <- CST_WindCapacityFactor(wind, IEC_class = "III") -########################################################################### +# dat2 +dat2 <- array(abs(rnorm(5 * 3 * 214 * 2)*50), + c(member = 5, sdate = 3, ftime = 214, lon = 2)) +dates0 <- 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')) +dates2 <- dates0 +dim(dates2) <- c(sdate = 3, ftime = 214) + +################################################### test_that("1. Input checks", { # Check 's2dv_cube' expect_error( @@ -35,7 +47,7 @@ test_that("1. Input checks", { ) }) -########################################################################### +#################################################### test_that("2. Output checks", { expect_equal( CST_WindCapacityFactor(wind = wind)$attrs$Variable$varName, @@ -45,5 +57,17 @@ test_that("2. Output checks", { dim(CST_WindCapacityFactor(wind = wind)$data), c(member = 10, lat = 2, lon = 5) ) + # test start and end + expect_warning( + WindCapacityFactor(wind = dat2, IEC_class = "III", dates = dates0, + start = list(21, 4), end = list(21, 6)), + paste0("Parameter 'wind' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + ) + expect_equal( + dim(WindCapacityFactor(wind = dat2, IEC_class = "III", dates = dates2, + start = list(21, 4), end = list(21, 6))), + c(member = 5, sdate = 3, ftime = 52, lon = 2) + ) }) diff --git a/tests/testthat/test-WindPowerDensity.R b/tests/testthat/test-WindPowerDensity.R index 184b062..a5abd4d 100644 --- a/tests/testthat/test-WindPowerDensity.R +++ b/tests/testthat/test-WindPowerDensity.R @@ -11,6 +11,18 @@ wind$attrs <- list(Variable = variable, Datasets = 'synthetic', when = Sys.time(), Dates = '1990-01-01 00:00:00') class(wind) <- 's2dv_cube' +# dat2 +dat2 <- array(abs(rnorm(5 * 3 * 214 * 2)*50), + c(member = 5, sdate = 3, ftime = 214, lon = 2)) +dates0 <- 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')) +dates2 <- dates0 +dim(dates2) <- c(sdate = 3, ftime = 214) + ########################################################################### test_that("1. Input checks", { # Check 's2dv_cube' @@ -44,5 +56,17 @@ test_that("2. Output checks", { dim(CST_WindPowerDensity(wind = wind)$data), c(member = 10, lat = 2, lon = 5) ) + # test start and end + expect_warning( + WindPowerDensity(wind = dat2, dates = dates0, + start = list(21, 4), end = list(21, 6)), + paste0("Parameter 'wind' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + ) + expect_equal( + dim(WindPowerDensity(wind = dat2, dates = dates2, + start = list(21, 4), end = list(21, 6))), + c(member = 5, sdate = 3, ftime = 52, lon = 2) + ) }) -- GitLab From e9f952eedfad50a9fa796428d816078bbe1787bc Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Tue, 20 Jun 2023 09:51:45 +0200 Subject: [PATCH 04/10] Improve output description in documentation --- R/AccumulationExceedingThreshold.R | 1 + R/PeriodAccumulation.R | 10 ++++++---- R/PeriodMean.R | 10 ++++++---- R/TotalTimeExceedingThreshold.R | 10 ++++++---- man/CST_PeriodAccumulation.Rd | 10 ++++++---- man/CST_PeriodMean.Rd | 10 ++++++---- man/CST_TotalTimeExceedingThreshold.Rd | 10 ++++++---- 7 files changed, 37 insertions(+), 24 deletions(-) diff --git a/R/AccumulationExceedingThreshold.R b/R/AccumulationExceedingThreshold.R index d3c7147..636b211 100644 --- a/R/AccumulationExceedingThreshold.R +++ b/R/AccumulationExceedingThreshold.R @@ -53,6 +53,7 @@ #'be added into the 'attrs' element in the 's2dv_cube' object. It consists of a #'list containing two elements, the start and end dates of the aggregated period #'with the same dimensions of 'Dates' element. +#' #'@examples #'exp <- NULL #'exp$data <- array(abs(rnorm(5 * 3 * 214 * 2)*100), diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index c8e976e..9bd33e5 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -31,10 +31,12 @@ #' computation. #' #'@return A 's2dv_cube' object containing the indicator in the element -#'\code{data}. A new element called 'time_bounds' will be added into -#' the 'attrs' element in the 's2dv_cube' object. It consists of a list -#' containing two elements, the start and end dates of the aggregated period -#' with the same dimensions of 'Dates' element. +#'\code{data} with dimensions of the input parameter 'data' except the dimension +#'where the accumulation has been computed (specified with 'time_dim'). A new +#'element called 'time_bounds' will be added into the 'attrs' element in the +#''s2dv_cube' object. It consists of a list containing two elements, the start +#'and end dates of the aggregated period with the same dimensions of 'Dates' +#'element. #' #'@examples #'exp <- NULL diff --git a/R/PeriodMean.R b/R/PeriodMean.R index 6acea60..3e7619d 100644 --- a/R/PeriodMean.R +++ b/R/PeriodMean.R @@ -31,10 +31,12 @@ #' computation. #' #'@return An 's2dv_cube' object containing the indicator in the element -#' \code{data}. A new element called 'time_bounds' will be added into -#' the 'attrs' element in the 's2dv_cube' object. It consists of a list -#' containing two elements, the start and end dates of the aggregated period -#' with the same dimensions of 'Dates' element. +#'\code{data} with dimensions of the input parameter 'data' except the +#'dimension where the mean has been computed (specified with 'time_dim'). A new +#'element called 'time_bounds' will be added into the 'attrs' element in the +#''s2dv_cube' object. It consists of a list containing two elements, the start +#'and end dates of the aggregated period with the same dimensions of 'Dates' +#'element. #' #'@examples #'exp <- NULL diff --git a/R/TotalTimeExceedingThreshold.R b/R/TotalTimeExceedingThreshold.R index 49fa988..057bb8b 100644 --- a/R/TotalTimeExceedingThreshold.R +++ b/R/TotalTimeExceedingThreshold.R @@ -54,10 +54,12 @@ #' #'@return An 's2dv_cube' object containing in element \code{data} the total #'number of the corresponding units of the data frequency that a variable is -#'exceeding a threshold during a period. A new element called 'time_bounds' will -#'be added into the 'attrs' element in the 's2dv_cube' object. It consists of a -#'list containing two elements, the start and end dates of the aggregated period -#'with the same dimensions of 'Dates' element. +#'exceeding a threshold during a period with dimensions of the input parameter +#''data' except the dimension where the indicator has been computed. A new +#'element called 'time_bounds' will be added into the 'attrs' element in the +#''s2dv_cube' object. It consists of a list containing two elements, the start +#'and end dates of the aggregated period with the same dimensions of 'Dates' +#'element. #' #'@examples #'exp <- NULL diff --git a/man/CST_PeriodAccumulation.Rd b/man/CST_PeriodAccumulation.Rd index 71122d6..0878399 100644 --- a/man/CST_PeriodAccumulation.Rd +++ b/man/CST_PeriodAccumulation.Rd @@ -41,10 +41,12 @@ computation.} } \value{ A 's2dv_cube' object containing the indicator in the element -\code{data}. A new element called 'time_bounds' will be added into - the 'attrs' element in the 's2dv_cube' object. It consists of a list - containing two elements, the start and end dates of the aggregated period - with the same dimensions of 'Dates' element. +\code{data} with dimensions of the input parameter 'data' except the dimension +where the accumulation has been computed (specified with 'time_dim'). A new +element called 'time_bounds' will be added into the 'attrs' element in the +'s2dv_cube' object. It consists of a list containing two elements, the start +and end dates of the aggregated period with the same dimensions of 'Dates' +element. } \description{ Period Accumulation computes the sum (accumulation) of a given variable in a diff --git a/man/CST_PeriodMean.Rd b/man/CST_PeriodMean.Rd index d0e1ba8..025acfd 100644 --- a/man/CST_PeriodMean.Rd +++ b/man/CST_PeriodMean.Rd @@ -41,10 +41,12 @@ computation.} } \value{ An 's2dv_cube' object containing the indicator in the element - \code{data}. A new element called 'time_bounds' will be added into - the 'attrs' element in the 's2dv_cube' object. It consists of a list - containing two elements, the start and end dates of the aggregated period - with the same dimensions of 'Dates' element. +\code{data} with dimensions of the input parameter 'data' except the +dimension where the mean has been computed (specified with 'time_dim'). A new +element called 'time_bounds' will be added into the 'attrs' element in the +'s2dv_cube' object. It consists of a list containing two elements, the start +and end dates of the aggregated period with the same dimensions of 'Dates' +element. } \description{ Period Mean computes the average (mean) of a given variable in a period. diff --git a/man/CST_TotalTimeExceedingThreshold.Rd b/man/CST_TotalTimeExceedingThreshold.Rd index 840700a..2449014 100644 --- a/man/CST_TotalTimeExceedingThreshold.Rd +++ b/man/CST_TotalTimeExceedingThreshold.Rd @@ -58,10 +58,12 @@ computation.} \value{ An 's2dv_cube' object containing in element \code{data} the total number of the corresponding units of the data frequency that a variable is -exceeding a threshold during a period. A new element called 'time_bounds' will -be added into the 'attrs' element in the 's2dv_cube' object. It consists of a -list containing two elements, the start and end dates of the aggregated period -with the same dimensions of 'Dates' element. +exceeding a threshold during a period with dimensions of the input parameter +'data' except the dimension where the indicator has been computed. A new +element called 'time_bounds' will be added into the 'attrs' element in the +'s2dv_cube' object. It consists of a list containing two elements, the start +and end dates of the aggregated period with the same dimensions of 'Dates' +element. } \description{ The Total Time of a variable exceeding (or not) a Threshold. It returns the -- GitLab From 292e1e2d1aeaf8c7ec5e27009ef897334c83563c Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 21 Jun 2023 10:25:46 +0200 Subject: [PATCH 05/10] Update time_dim and improve example --- R/PeriodAccumulation.R | 2 +- R/PeriodMean.R | 15 ++++++++++++--- man/PeriodAccumulation.Rd | 2 +- man/PeriodMean.Rd | 15 ++++++++++++--- 4 files changed, 26 insertions(+), 8 deletions(-) diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index 9bd33e5..8f1fb7f 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -168,7 +168,7 @@ CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, #'@import multiApply #'@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.") diff --git a/R/PeriodMean.R b/R/PeriodMean.R index 3e7619d..3b1cf7f 100644 --- a/R/PeriodMean.R +++ b/R/PeriodMean.R @@ -146,13 +146,22 @@ CST_PeriodMean <- function(data, start = NULL, end = NULL, #'indicator in the element \code{data}. #' #'@examples -#'exp <- array(rnorm(56), dim = c(member = 7, ftime = 8)) -#'SA <- PeriodMean(exp, time_dim = 'ftime') +#'data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2002-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2002-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) +#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'SA <- PeriodMean(data, dates = Dates, start = list(01, 12), end = list(01, 01)) #' #'@import multiApply #'@export PeriodMean <- function(data, dates = NULL, start = NULL, end = NULL, - time_dim = 'time', na.rm = FALSE, ncores = NULL) { + time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") diff --git a/man/PeriodAccumulation.Rd b/man/PeriodAccumulation.Rd index 614b65c..0260648 100644 --- a/man/PeriodAccumulation.Rd +++ b/man/PeriodAccumulation.Rd @@ -9,7 +9,7 @@ PeriodAccumulation( dates = NULL, start = NULL, end = NULL, - time_dim = "time", + time_dim = "ftime", na.rm = FALSE, ncores = NULL ) diff --git a/man/PeriodMean.Rd b/man/PeriodMean.Rd index f52db40..d02a0ab 100644 --- a/man/PeriodMean.Rd +++ b/man/PeriodMean.Rd @@ -9,7 +9,7 @@ PeriodMean( dates = NULL, start = NULL, end = NULL, - time_dim = "time", + time_dim = "ftime", na.rm = FALSE, ncores = NULL ) @@ -59,7 +59,16 @@ this function: } } \examples{ -exp <- array(rnorm(56), dim = c(member = 7, ftime = 8)) -SA <- PeriodMean(exp, time_dim = 'ftime') +data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2002-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2002-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) +dim(Dates) <- c(sdate = 4, ftime = 3) +SA <- PeriodMean(data, dates = Dates, start = list(01, 12), end = list(01, 01)) } -- GitLab From 9eb3e4aecb2444fc1a3b6771b835633b11d6b90e Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 21 Jun 2023 11:27:51 +0200 Subject: [PATCH 06/10] Improve check when start and end are provided but dates is NULL; add test for this --- R/PeriodAccumulation.R | 8 ++++++-- R/PeriodMean.R | 13 +++++++------ R/QThreshold.R | 9 +++++++-- R/Threshold.R | 8 ++++++-- R/TotalSpellTimeExceedingThreshold.R | 7 +++++-- R/TotalTimeExceedingThreshold.R | 7 +++++-- R/WindCapacityFactor.R | 8 ++++++-- R/WindPowerDensity.R | 8 ++++++-- tests/testthat/test-PeriodAccumulation.R | 11 +++++++++-- tests/testthat/test-PeriodMean.R | 16 ++++++++++++---- tests/testthat/test-QThreshold.R | 7 +++++++ tests/testthat/test-Threshold.R | 7 +++++++ .../test-TotalSpellTimeExceedingThreshold.R | 7 +++++++ .../testthat/test-TotalTimeExceedingThreshold.R | 7 +++++++ tests/testthat/test-WindCapacityFactor.R | 7 +++++++ tests/testthat/test-WindPowerDensity.R | 7 +++++++ 16 files changed, 111 insertions(+), 26 deletions(-) diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index 8f1fb7f..965534f 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -180,8 +180,12 @@ PeriodAccumulation <- function(data, dates = NULL, start = NULL, end = NULL, dim(data) <- length(data) names(dim(data)) <- time_dim } - if (!is.null(dates)) { - if (!is.null(start) && !is.null(end)) { + + if (!is.null(start) && !is.null(end)) { + if (is.null(dates)) { + warning("Parameter 'dates' is NULL and the average of the ", + "full data provided in 'data' is computed.") + } else { 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.") diff --git a/R/PeriodMean.R b/R/PeriodMean.R index 3b1cf7f..fd8fd7a 100644 --- a/R/PeriodMean.R +++ b/R/PeriodMean.R @@ -173,13 +173,14 @@ PeriodMean <- function(data, dates = NULL, start = NULL, end = NULL, dim(data) <- length(data) names(data) <- time_dim } - if (is.null(dates)) { - warning("Parameter 'dates' is NULL and the Average of the ", - "full data provided in 'data' is computed.") - } else { - if (!is.null(start) && !is.null(end)) { + + if (!is.null(start) && !is.null(end)) { + if (is.null(dates)) { + warning("Parameter 'dates' is NULL and the average of the ", + "full data provided in 'data' is computed.") + } else { if (!any(c(is.list(start), is.list(end)))) { - stop("Parameter 'start' and 'end' must be lists indicating the ", + stop("Parameter 'start' and 'end' must be lists indicating the ", "day and the month of the period start and end.") } if (!is.null(dim(dates))) { diff --git a/R/QThreshold.R b/R/QThreshold.R index 0d069bb..c39a14b 100644 --- a/R/QThreshold.R +++ b/R/QThreshold.R @@ -217,8 +217,12 @@ QThreshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, if (is.null(memb_dim)) { memb_dim <- 99999 } - if (!is.null(dates)) { - if (!is.null(start) && !is.null(end)) { + + if (!is.null(start) && !is.null(end)) { + if (is.null(dates)) { + warning("Parameter 'dates' is NULL and the average of the ", + "full data provided in 'data' is computed.") + } else { 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.") @@ -244,6 +248,7 @@ QThreshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, } } } + if (length(threshold) == 1) { if (memb_dim %in% names(dim(data))) { probs <- Apply(list(data), target_dims = c(memb_dim, sdate_dim), diff --git a/R/Threshold.R b/R/Threshold.R index d76cbfa..b4e9638 100644 --- a/R/Threshold.R +++ b/R/Threshold.R @@ -157,8 +157,12 @@ Threshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, if (is.null(names(dim(data)))) { stop("Parameter 'data' must have named dimensions.") } - if (!is.null(dates)) { - if (!is.null(start) && !is.null(end)) { + + if (!is.null(start) && !is.null(end)) { + if (is.null(dates)) { + warning("Parameter 'dates' is NULL and the average of the ", + "full data provided in 'data' is computed.") + } else { 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.") diff --git a/R/TotalSpellTimeExceedingThreshold.R b/R/TotalSpellTimeExceedingThreshold.R index 5d649b4..5cf2e1d 100644 --- a/R/TotalSpellTimeExceedingThreshold.R +++ b/R/TotalSpellTimeExceedingThreshold.R @@ -352,8 +352,11 @@ TotalSpellTimeExceedingThreshold <- function(data, threshold, spell, op = '>', } } # dates - if (!is.null(dates)) { - if (!is.null(start) && !is.null(end)) { + if (!is.null(start) && !is.null(end)) { + if (is.null(dates)) { + warning("Parameter 'dates' is NULL and the average of the ", + "full data provided in 'data' is computed.") + } else { 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.") diff --git a/R/TotalTimeExceedingThreshold.R b/R/TotalTimeExceedingThreshold.R index 057bb8b..8a8b7ed 100644 --- a/R/TotalTimeExceedingThreshold.R +++ b/R/TotalTimeExceedingThreshold.R @@ -351,8 +351,11 @@ TotalTimeExceedingThreshold <- function(data, threshold, op = '>', } } # dates - if (!is.null(dates)) { - if (!is.null(start) && !is.null(end)) { + if (!is.null(start) && !is.null(end)) { + if (is.null(dates)) { + warning("Parameter 'dates' is NULL and the average of the ", + "full data provided in 'data' is computed.") + } else { 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.") diff --git a/R/WindCapacityFactor.R b/R/WindCapacityFactor.R index 906ade3..7f32139 100644 --- a/R/WindCapacityFactor.R +++ b/R/WindCapacityFactor.R @@ -175,8 +175,12 @@ WindCapacityFactor <- function(wind, IEC_class = c("I", "I/II", "II", "II/III", ) pc_file <- system.file("power_curves", pc_files[IEC_class], package = "CSIndicators", mustWork = T) pc <- read_pc(pc_file) - if (!is.null(dates)) { - if (!is.null(start) && !is.null(end)) { + + if (!is.null(start) && !is.null(end)) { + if (is.null(dates)) { + warning("Parameter 'dates' is NULL and the average of the ", + "full data provided in 'data' is computed.") + } else { 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.") diff --git a/R/WindPowerDensity.R b/R/WindPowerDensity.R index e9c70f6..181e509 100644 --- a/R/WindPowerDensity.R +++ b/R/WindPowerDensity.R @@ -136,8 +136,12 @@ CST_WindPowerDensity <- function(wind, ro = 1.225, start = NULL, end = NULL, #'@export WindPowerDensity <- function(wind, ro = 1.225, dates = NULL, start = NULL, end = NULL, time_dim = 'ftime', ncores = NULL) { - if (!is.null(dates)) { - if (!is.null(start) && !is.null(end)) { + + if (!is.null(start) && !is.null(end)) { + if (is.null(dates)) { + warning("Parameter 'dates' is NULL and the average of the ", + "full data provided in 'data' is computed.") + } else { 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.") diff --git a/tests/testthat/test-PeriodAccumulation.R b/tests/testthat/test-PeriodAccumulation.R index 74bb45d..6898a93 100644 --- a/tests/testthat/test-PeriodAccumulation.R +++ b/tests/testthat/test-PeriodAccumulation.R @@ -27,20 +27,27 @@ test_that("1. Sanity Checks", { PeriodAccumulation(1:10), 55 ) - data <- array(1:24, c(sdate = 2, time = 3, lon = 4)) + data <- array(1:24, c(sdate = 2, ftime = 3, lon = 4)) expect_equal( PeriodAccumulation(data), array(c(9, 12, 27, 30, 45, 48, 63, 66), c(sdate = 2, lon = 4)) ) # Test dates warning expect_warning( - PeriodAccumulation(array(1:10, c(time = 10)), + PeriodAccumulation(array(1:10, c(ftime = 10)), dates = seq(as.Date("01-05-2000", format = "%d-%m-%Y"), as.Date("10-05-2000", format = "%d-%m-%Y"), by = 'day'), start = list(05, 02), end = list(05, 09)), paste0("Parameter 'dates' must have named dimensions if 'start' and 'end' ", "are not NULL. All data will be used.") ) + # start and end when dates is not provided + expect_warning( + PeriodAccumulation(array(1:10, c(ftime = 10)), + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' is NULL and the average of the full data ", + "provided in 'data' is computed.") + ) }) ############################################## diff --git a/tests/testthat/test-PeriodMean.R b/tests/testthat/test-PeriodMean.R index 18b5995..cd9f5fe 100644 --- a/tests/testthat/test-PeriodMean.R +++ b/tests/testthat/test-PeriodMean.R @@ -18,14 +18,15 @@ test_that("1. Sanity Checks", { ) expect_error( PeriodMean(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.") + "Parameter 'start' and 'end' must be lists indicating the day and the month of the period start and end." + ) suppressWarnings( expect_equal( - PeriodMean(array(1:10, c(time = 10))), + PeriodMean(array(1:10, c(ftime = 10))), 5.5 ) ) - data <- array(1:24, c(sdate = 2, time = 3, lon = 4)) + data <- array(1:24, c(sdate = 2, ftime = 3, lon = 4)) suppressWarnings( expect_equal( PeriodMean(data), @@ -35,13 +36,20 @@ test_that("1. Sanity Checks", { ) # Test dates warning expect_warning( - PeriodMean(array(1:10, c(time = 10)), + PeriodMean(array(1:10, c(ftime = 10)), dates = seq(as.Date("01-05-2000", format = "%d-%m-%Y"), as.Date("10-05-2000", format = "%d-%m-%Y"), by = 'day'), start = list(05, 02), end = list(05, 09)), paste0("Parameter 'dates' must have named dimensions if 'start' and 'end' ", "are not NULL. All data will be used.") ) + # start and end when dates is not provided + expect_warning( + PeriodMean(array(1:10, c(ftime = 10)), + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' is NULL and the average of the full data ", + "provided in 'data' is computed.") + ) }) ############################################## diff --git a/tests/testthat/test-QThreshold.R b/tests/testthat/test-QThreshold.R index 3599bd9..57883b1 100644 --- a/tests/testthat/test-QThreshold.R +++ b/tests/testthat/test-QThreshold.R @@ -132,6 +132,13 @@ test_that("1. Sanity checks", { end = list(21, 6))), c(sdate = 3, member = 5, ftime = 52, lon = 2) ) + # start and end when dates is not provided + expect_warning( + QThreshold(array(1:61, dim = c(ftime = 61, sdate = 3)), threshold = 25, + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' is NULL and the average of the full data ", + "provided in 'data' is computed.") + ) }) ############################################## diff --git a/tests/testthat/test-Threshold.R b/tests/testthat/test-Threshold.R index 258e438..7cb83cf 100644 --- a/tests/testthat/test-Threshold.R +++ b/tests/testthat/test-Threshold.R @@ -88,6 +88,13 @@ test_that("1. Sanity checks", { end = list(21, 6))), c(ftime = 52, lon = 2) ) + # start and end when dates is not provided + expect_warning( + Threshold(array(1:366, dim = c(ftime = 61, sdate = 3, member = 2)), + threshold = 0.8, start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' is NULL and the average of the full data ", + "provided in 'data' is computed.") + ) }) ############################################## diff --git a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R index f76b457..b66c5ae 100644 --- a/tests/testthat/test-TotalSpellTimeExceedingThreshold.R +++ b/tests/testthat/test-TotalSpellTimeExceedingThreshold.R @@ -142,6 +142,13 @@ test_that("1. Sanity checks", { paste0("Parameter 'start' and 'end' must be lists indicating the ", "day and the month of the period start and end.") ) + # start and end when dates is not provided + expect_warning( + TotalSpellTimeExceedingThreshold(array(1:10, c(ftime = 10)), threshold = 5, spell = 2, + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' is NULL and the average of the full data ", + "provided in 'data' is computed.") + ) }) ########################################################################### diff --git a/tests/testthat/test-TotalTimeExceedingThreshold.R b/tests/testthat/test-TotalTimeExceedingThreshold.R index 4a10b1b..c025c3e 100644 --- a/tests/testthat/test-TotalTimeExceedingThreshold.R +++ b/tests/testthat/test-TotalTimeExceedingThreshold.R @@ -134,6 +134,13 @@ test_that("1. Sanity checks", { paste0("Parameter 'start' and 'end' must be lists indicating the ", "day and the month of the period start and end.") ) + # start and end when dates is not provided + expect_warning( + TotalTimeExceedingThreshold(array(1:10, c(ftime = 10)), threshold = 5, + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' is NULL and the average of the full data ", + "provided in 'data' is computed.") + ) }) diff --git a/tests/testthat/test-WindCapacityFactor.R b/tests/testthat/test-WindCapacityFactor.R index 6fec014..3afa27e 100644 --- a/tests/testthat/test-WindCapacityFactor.R +++ b/tests/testthat/test-WindCapacityFactor.R @@ -45,6 +45,13 @@ test_that("1. Input checks", { paste0("Parameter 'start' and 'end' must be lists indicating the ", "day and the month of the period start and end.") ) + # start and end when dates is not provided + expect_warning( + WindCapacityFactor(array(1:10, c(ftime = 10)), + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' is NULL and the average of the full data ", + "provided in 'data' is computed.") + ) }) #################################################### diff --git a/tests/testthat/test-WindPowerDensity.R b/tests/testthat/test-WindPowerDensity.R index a5abd4d..999235a 100644 --- a/tests/testthat/test-WindPowerDensity.R +++ b/tests/testthat/test-WindPowerDensity.R @@ -44,6 +44,13 @@ test_that("1. Input checks", { paste0("Parameter 'start' and 'end' must be lists indicating the ", "day and the month of the period start and end.") ) + # start and end when dates is not provided + expect_warning( + WindPowerDensity(array(1:10, c(ftime = 10)), + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' is NULL and the average of the full data ", + "provided in 'data' is computed.") + ) }) ########################################################################### -- GitLab From 8777fc856ee4baff0106f407110a3aadbdf5245d Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 21 Jun 2023 16:11:11 +0200 Subject: [PATCH 07/10] Add return to PeriodMean --- R/PeriodMean.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/PeriodMean.R b/R/PeriodMean.R index fd8fd7a..2a85ceb 100644 --- a/R/PeriodMean.R +++ b/R/PeriodMean.R @@ -195,6 +195,7 @@ PeriodMean <- function(data, dates = NULL, start = NULL, end = NULL, } total <- Apply(list(data), target_dims = time_dim, fun = mean, na.rm = na.rm, ncores = ncores)$output1 + return(total) } -- GitLab From 4a8dd49ac07d1bb54b23d404b023179b5c4b2130 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Thu, 29 Jun 2023 14:23:44 +0200 Subject: [PATCH 08/10] Add in documentation that in result, the Dates correspond to the beginning of the aggregated time period --- R/AccumulationExceedingThreshold.R | 10 ++++++---- R/PeriodAccumulation.R | 13 +++++++------ R/PeriodMean.R | 11 ++++++----- R/TotalSpellTimeExceedingThreshold.R | 9 +++++---- R/TotalTimeExceedingThreshold.R | 11 ++++++----- man/CST_AccumulationExceedingThreshold.Rd | 10 ++++++---- man/CST_PeriodAccumulation.Rd | 13 +++++++------ man/CST_PeriodMean.Rd | 11 ++++++----- man/CST_TotalSpellTimeExceedingThreshold.Rd | 9 +++++---- man/CST_TotalTimeExceedingThreshold.Rd | 11 ++++++----- 10 files changed, 60 insertions(+), 48 deletions(-) diff --git a/R/AccumulationExceedingThreshold.R b/R/AccumulationExceedingThreshold.R index 636b211..083b76c 100644 --- a/R/AccumulationExceedingThreshold.R +++ b/R/AccumulationExceedingThreshold.R @@ -49,10 +49,12 @@ #' #'@return An 's2dv_cube' object containing the aggregated values in the element #'\code{data} with dimensions of the input parameter 'data' except the dimension -#'where the indicator has been computed. A new element called 'time_bounds' will -#'be added into the 'attrs' element in the 's2dv_cube' object. It consists of a -#'list containing two elements, the start and end dates of the aggregated period -#'with the same dimensions of 'Dates' element. +#'where the indicator has been computed. The 'Dates' array is updated to +#'the dates corresponding to the beginning of the aggregated time period. A new +#'element called 'time_bounds' will be added into the 'attrs' element in the +#''s2dv_cube' object. It consists of a list containing two elements, the start +#'and end dates of the aggregated period with the same dimensions of 'Dates' +#'element. #' #'@examples #'exp <- NULL diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index 965534f..1a8fea0 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -30,13 +30,14 @@ #'@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 +#'@return An 's2dv_cube' object containing the indicator in the element #'\code{data} with dimensions of the input parameter 'data' except the dimension -#'where the accumulation has been computed (specified with 'time_dim'). A new -#'element called 'time_bounds' will be added into the 'attrs' element in the -#''s2dv_cube' object. It consists of a list containing two elements, the start -#'and end dates of the aggregated period with the same dimensions of 'Dates' -#'element. +#'where the accumulation has been computed (specified with 'time_dim'). The +#''Dates' array is updated to the dates corresponding to the beginning of the +#'aggregated time period. A new element called 'time_bounds' will be added into +#'the 'attrs' element in the 's2dv_cube' object. It consists of a list +#'containing two elements, the start and end dates of the aggregated period with +#'the same dimensions of 'Dates' element. #' #'@examples #'exp <- NULL diff --git a/R/PeriodMean.R b/R/PeriodMean.R index 2a85ceb..f848fda 100644 --- a/R/PeriodMean.R +++ b/R/PeriodMean.R @@ -32,11 +32,12 @@ #' #'@return An 's2dv_cube' object containing the indicator in the element #'\code{data} with dimensions of the input parameter 'data' except the -#'dimension where the mean has been computed (specified with 'time_dim'). A new -#'element called 'time_bounds' will be added into the 'attrs' element in the -#''s2dv_cube' object. It consists of a list containing two elements, the start -#'and end dates of the aggregated period with the same dimensions of 'Dates' -#'element. +#'dimension where the mean has been computed (specified with 'time_dim'). The +#''Dates' array is updated to the dates corresponding to the beginning of the +#'aggregated time period. A new element called 'time_bounds' will be added into +#'the 'attrs' element in the 's2dv_cube' object. It consists of a list +#'containing two elements, the start and end dates of the aggregated period with +#'the same dimensions of 'Dates' element. #' #'@examples #'exp <- NULL diff --git a/R/TotalSpellTimeExceedingThreshold.R b/R/TotalSpellTimeExceedingThreshold.R index 5cf2e1d..38a3ff4 100644 --- a/R/TotalSpellTimeExceedingThreshold.R +++ b/R/TotalSpellTimeExceedingThreshold.R @@ -50,10 +50,11 @@ #'@return An 's2dv_cube' object containing the number of days that are part of a #'spell within a threshold in element \code{data} with dimensions of the input #'parameter 'data' except the dimension where the indicator has been computed. -#'A new element called 'time_bounds' will be added into the 'attrs' element in -#'the 's2dv_cube' object. It consists of a list containing two elements, the -#'start and end dates of the aggregated period with the same dimensions of -#''Dates' element. +#'The 'Dates' array is updated to the dates corresponding to the beginning of +#'the aggregated time period. A new element called 'time_bounds' will be added +#'into the 'attrs' element in the 's2dv_cube' object. It consists of a list +#'containing two elements, the start and end dates of the aggregated period with +#'the same dimensions of 'Dates' element. #' #'@examples #'exp <- NULL diff --git a/R/TotalTimeExceedingThreshold.R b/R/TotalTimeExceedingThreshold.R index 8a8b7ed..94d2c53 100644 --- a/R/TotalTimeExceedingThreshold.R +++ b/R/TotalTimeExceedingThreshold.R @@ -55,11 +55,12 @@ #'@return An 's2dv_cube' object containing in element \code{data} the total #'number of the corresponding units of the data frequency that a variable is #'exceeding a threshold during a period with dimensions of the input parameter -#''data' except the dimension where the indicator has been computed. A new -#'element called 'time_bounds' will be added into the 'attrs' element in the -#''s2dv_cube' object. It consists of a list containing two elements, the start -#'and end dates of the aggregated period with the same dimensions of 'Dates' -#'element. +#''data' except the dimension where the indicator has been computed. The +#''Dates' array is updated to the dates corresponding to the beginning of the +#'aggregated time period. A new element called 'time_bounds' will be added into +#'the 'attrs' element in the 's2dv_cube' object. It consists of a list +#'containing two elements, the start and end dates of the aggregated period with +#'the same dimensions of 'Dates' element. #' #'@examples #'exp <- NULL diff --git a/man/CST_AccumulationExceedingThreshold.Rd b/man/CST_AccumulationExceedingThreshold.Rd index f14c33b..ff02e4c 100644 --- a/man/CST_AccumulationExceedingThreshold.Rd +++ b/man/CST_AccumulationExceedingThreshold.Rd @@ -63,10 +63,12 @@ computation.} \value{ An 's2dv_cube' object containing the aggregated values in the element \code{data} with dimensions of the input parameter 'data' except the dimension -where the indicator has been computed. A new element called 'time_bounds' will -be added into the 'attrs' element in the 's2dv_cube' object. It consists of a -list containing two elements, the start and end dates of the aggregated period -with the same dimensions of 'Dates' element. +where the indicator has been computed. The 'Dates' array is updated to +the dates corresponding to the beginning of the aggregated time period. A new +element called 'time_bounds' will be added into the 'attrs' element in the +'s2dv_cube' object. It consists of a list containing two elements, the start +and end dates of the aggregated period with the same dimensions of 'Dates' +element. } \description{ The accumulation (sum) of a variable in the days (or time steps) that the diff --git a/man/CST_PeriodAccumulation.Rd b/man/CST_PeriodAccumulation.Rd index 0878399..77f4a38 100644 --- a/man/CST_PeriodAccumulation.Rd +++ b/man/CST_PeriodAccumulation.Rd @@ -40,13 +40,14 @@ not (FALSE).} computation.} } \value{ -A 's2dv_cube' object containing the indicator in the element +An 's2dv_cube' object containing the indicator in the element \code{data} with dimensions of the input parameter 'data' except the dimension -where the accumulation has been computed (specified with 'time_dim'). A new -element called 'time_bounds' will be added into the 'attrs' element in the -'s2dv_cube' object. It consists of a list containing two elements, the start -and end dates of the aggregated period with the same dimensions of 'Dates' -element. +where the accumulation has been computed (specified with 'time_dim'). The +'Dates' array is updated to the dates corresponding to the beginning of the +aggregated time period. A new element called 'time_bounds' will be added into +the 'attrs' element in the 's2dv_cube' object. It consists of a list +containing two elements, the start and end dates of the aggregated period with +the same dimensions of 'Dates' element. } \description{ Period Accumulation computes the sum (accumulation) of a given variable in a diff --git a/man/CST_PeriodMean.Rd b/man/CST_PeriodMean.Rd index 025acfd..0aa4aa3 100644 --- a/man/CST_PeriodMean.Rd +++ b/man/CST_PeriodMean.Rd @@ -42,11 +42,12 @@ computation.} \value{ An 's2dv_cube' object containing the indicator in the element \code{data} with dimensions of the input parameter 'data' except the -dimension where the mean has been computed (specified with 'time_dim'). A new -element called 'time_bounds' will be added into the 'attrs' element in the -'s2dv_cube' object. It consists of a list containing two elements, the start -and end dates of the aggregated period with the same dimensions of 'Dates' -element. +dimension where the mean has been computed (specified with 'time_dim'). The +'Dates' array is updated to the dates corresponding to the beginning of the +aggregated time period. A new element called 'time_bounds' will be added into +the 'attrs' element in the 's2dv_cube' object. It consists of a list +containing two elements, the start and end dates of the aggregated period with +the same dimensions of 'Dates' element. } \description{ Period Mean computes the average (mean) of a given variable in a period. diff --git a/man/CST_TotalSpellTimeExceedingThreshold.Rd b/man/CST_TotalSpellTimeExceedingThreshold.Rd index 69dee16..0715414 100644 --- a/man/CST_TotalSpellTimeExceedingThreshold.Rd +++ b/man/CST_TotalSpellTimeExceedingThreshold.Rd @@ -58,10 +58,11 @@ computation.} An 's2dv_cube' object containing the number of days that are part of a spell within a threshold in element \code{data} with dimensions of the input parameter 'data' except the dimension where the indicator has been computed. -A new element called 'time_bounds' will be added into the 'attrs' element in -the 's2dv_cube' object. It consists of a list containing two elements, the -start and end dates of the aggregated period with the same dimensions of -'Dates' element. +The 'Dates' array is updated to the dates corresponding to the beginning of +the aggregated time period. A new element called 'time_bounds' will be added +into the 'attrs' element in the 's2dv_cube' object. It consists of a list +containing two elements, the start and end dates of the aggregated period with +the same dimensions of 'Dates' element. } \description{ The number of days (when daily data is provided) that are part of a spell diff --git a/man/CST_TotalTimeExceedingThreshold.Rd b/man/CST_TotalTimeExceedingThreshold.Rd index 2449014..4a1f736 100644 --- a/man/CST_TotalTimeExceedingThreshold.Rd +++ b/man/CST_TotalTimeExceedingThreshold.Rd @@ -59,11 +59,12 @@ computation.} An 's2dv_cube' object containing in element \code{data} the total number of the corresponding units of the data frequency that a variable is exceeding a threshold during a period with dimensions of the input parameter -'data' except the dimension where the indicator has been computed. A new -element called 'time_bounds' will be added into the 'attrs' element in the -'s2dv_cube' object. It consists of a list containing two elements, the start -and end dates of the aggregated period with the same dimensions of 'Dates' -element. +'data' except the dimension where the indicator has been computed. The +'Dates' array is updated to the dates corresponding to the beginning of the +aggregated time period. A new element called 'time_bounds' will be added into +the 'attrs' element in the 's2dv_cube' object. It consists of a list +containing two elements, the start and end dates of the aggregated period with +the same dimensions of 'Dates' element. } \description{ The Total Time of a variable exceeding (or not) a Threshold. It returns the -- GitLab From 1096e69c87fd71b09b914de90dd9d67882dbf344 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Thu, 29 Jun 2023 15:13:05 +0200 Subject: [PATCH 09/10] Undo changes in default value of time_dim; CST functions have ftime, simplified functions have time --- R/PeriodAccumulation.R | 2 +- R/PeriodMean.R | 4 ++-- R/QThreshold.R | 4 ++-- R/Threshold.R | 4 ++-- R/WindCapacityFactor.R | 4 ++-- R/WindPowerDensity.R | 4 ++-- man/PeriodAccumulation.Rd | 2 +- man/PeriodMean.Rd | 4 ++-- man/QThreshold.Rd | 4 ++-- man/Threshold.Rd | 4 ++-- man/WindCapacityFactor.Rd | 4 ++-- man/WindPowerDensity.Rd | 4 ++-- 12 files changed, 22 insertions(+), 22 deletions(-) diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index 1a8fea0..3b0d33d 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -169,7 +169,7 @@ CST_PeriodAccumulation <- function(data, start = NULL, end = NULL, #'@import multiApply #'@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.") diff --git a/R/PeriodMean.R b/R/PeriodMean.R index f848fda..abc585a 100644 --- a/R/PeriodMean.R +++ b/R/PeriodMean.R @@ -135,7 +135,7 @@ CST_PeriodMean <- function(data, start = NULL, end = NULL, #' 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 dimension to -#' compute the indicator. By default, it is set to 'ftime'. More than one +#' 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 @@ -162,7 +162,7 @@ CST_PeriodMean <- function(data, start = NULL, end = NULL, #'@import multiApply #'@export PeriodMean <- function(data, dates = NULL, start = NULL, end = NULL, - time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { + time_dim = 'time', na.rm = FALSE, ncores = NULL) { if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") diff --git a/R/QThreshold.R b/R/QThreshold.R index c39a14b..c5089df 100644 --- a/R/QThreshold.R +++ b/R/QThreshold.R @@ -145,7 +145,7 @@ CST_QThreshold <- function(data, threshold, start = NULL, end = NULL, #' 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 temporal -#' dimension. By default, it is set to 'ftime'. More than one dimension name +#' dimension. 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. This dimension is required to subset the data in a requested #' period. @@ -178,7 +178,7 @@ CST_QThreshold <- function(data, threshold, start = NULL, end = NULL, #'@import multiApply #'@export QThreshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, - time_dim = 'ftime', memb_dim = 'member', + time_dim = 'time', memb_dim = 'member', sdate_dim = 'sdate', ncores = NULL) { # Initial checks ## data diff --git a/R/Threshold.R b/R/Threshold.R index b4e9638..73e3715 100644 --- a/R/Threshold.R +++ b/R/Threshold.R @@ -107,7 +107,7 @@ CST_Threshold <- function(data, threshold, start = NULL, end = NULL, #' 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 temporal -#' dimension. By default, it is set to 'ftime'. More than one dimension name +#' dimension. 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. This dimension is required to subset the data in a requested #' period. @@ -136,7 +136,7 @@ CST_Threshold <- function(data, threshold, start = NULL, end = NULL, #'@importFrom stats quantile #'@export Threshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, - time_dim = 'ftime', memb_dim = 'member', sdate_dim = 'sdate', + time_dim = 'time', memb_dim = 'member', sdate_dim = 'sdate', na.rm = FALSE, ncores = NULL) { if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") diff --git a/R/WindCapacityFactor.R b/R/WindCapacityFactor.R index 7f32139..760dba0 100644 --- a/R/WindCapacityFactor.R +++ b/R/WindCapacityFactor.R @@ -135,7 +135,7 @@ CST_WindCapacityFactor <- function(wind, IEC_class = c("I", "I/II", "II", "II/II #' 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 dimension to -#' compute the indicator. By default, it is set to 'ftime'. More than one +#' 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 ncores An integer indicating the number of cores to use in parallel @@ -164,7 +164,7 @@ CST_WindCapacityFactor <- function(wind, IEC_class = c("I", "I/II", "II", "II/II #'@export WindCapacityFactor <- function(wind, IEC_class = c("I", "I/II", "II", "II/III", "III"), dates = NULL, start = NULL, end = NULL, - time_dim = 'ftime', ncores = NULL) { + time_dim = 'time', ncores = NULL) { IEC_class <- match.arg(IEC_class) pc_files <- c( "I" = "Enercon_E70_2.3MW.txt", diff --git a/R/WindPowerDensity.R b/R/WindPowerDensity.R index 181e509..3eba59a 100644 --- a/R/WindPowerDensity.R +++ b/R/WindPowerDensity.R @@ -111,7 +111,7 @@ CST_WindPowerDensity <- function(wind, ro = 1.225, start = NULL, end = NULL, #' 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 dimension to -#' compute the indicator. By default, it is set to 'ftime'. More than one +#' 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 ncores An integer indicating the number of cores to use in parallel @@ -135,7 +135,7 @@ CST_WindPowerDensity <- function(wind, ro = 1.225, start = NULL, end = NULL, #' #'@export WindPowerDensity <- function(wind, ro = 1.225, dates = NULL, start = NULL, - end = NULL, time_dim = 'ftime', ncores = NULL) { + end = NULL, time_dim = 'time', ncores = NULL) { if (!is.null(start) && !is.null(end)) { if (is.null(dates)) { diff --git a/man/PeriodAccumulation.Rd b/man/PeriodAccumulation.Rd index 0260648..614b65c 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 ) diff --git a/man/PeriodMean.Rd b/man/PeriodMean.Rd index d02a0ab..cd1fcef 100644 --- a/man/PeriodMean.Rd +++ b/man/PeriodMean.Rd @@ -9,7 +9,7 @@ PeriodMean( dates = NULL, start = NULL, end = NULL, - time_dim = "ftime", + time_dim = "time", na.rm = FALSE, ncores = NULL ) @@ -33,7 +33,7 @@ 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 dimension to -compute the indicator. By default, it is set to 'ftime'. More than one +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.} diff --git a/man/QThreshold.Rd b/man/QThreshold.Rd index ba023d8..efc48cf 100644 --- a/man/QThreshold.Rd +++ b/man/QThreshold.Rd @@ -10,7 +10,7 @@ QThreshold( dates = NULL, start = NULL, end = NULL, - time_dim = "ftime", + time_dim = "time", memb_dim = "member", sdate_dim = "sdate", ncores = NULL @@ -39,7 +39,7 @@ 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 temporal -dimension. By default, it is set to 'ftime'. More than one dimension name +dimension. 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. This dimension is required to subset the data in a requested period.} diff --git a/man/Threshold.Rd b/man/Threshold.Rd index d254cbe..dc9d2a2 100644 --- a/man/Threshold.Rd +++ b/man/Threshold.Rd @@ -10,7 +10,7 @@ Threshold( dates = NULL, start = NULL, end = NULL, - time_dim = "ftime", + time_dim = "time", memb_dim = "member", sdate_dim = "sdate", na.rm = FALSE, @@ -39,7 +39,7 @@ 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 temporal -dimension. By default, it is set to 'ftime'. More than one dimension name +dimension. 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. This dimension is required to subset the data in a requested period.} diff --git a/man/WindCapacityFactor.Rd b/man/WindCapacityFactor.Rd index 3ddeec6..a0a7ce5 100644 --- a/man/WindCapacityFactor.Rd +++ b/man/WindCapacityFactor.Rd @@ -10,7 +10,7 @@ WindCapacityFactor( dates = NULL, start = NULL, end = NULL, - time_dim = "ftime", + time_dim = "time", ncores = NULL ) } @@ -41,7 +41,7 @@ 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 dimension to -compute the indicator. By default, it is set to 'ftime'. More than one +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.} diff --git a/man/WindPowerDensity.Rd b/man/WindPowerDensity.Rd index 9b935bc..8b72009 100644 --- a/man/WindPowerDensity.Rd +++ b/man/WindPowerDensity.Rd @@ -10,7 +10,7 @@ WindPowerDensity( dates = NULL, start = NULL, end = NULL, - time_dim = "ftime", + time_dim = "time", ncores = NULL ) } @@ -38,7 +38,7 @@ 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 dimension to -compute the indicator. By default, it is set to 'ftime'. More than one +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.} -- GitLab From 008f379d1a844bd713fad3defe5bea6d3935e43c Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Thu, 20 Jul 2023 13:20:42 +0200 Subject: [PATCH 10/10] Correct few examples due to time_dim value and add ClimProjDiags in Importd --- DESCRIPTION | 3 ++- R/PeriodMean.R | 4 ++-- R/WindCapacityFactor.R | 7 ++++--- R/WindPowerDensity.R | 7 ++++--- man/PeriodMean.Rd | 4 ++-- man/WindCapacityFactor.Rd | 4 ++-- man/WindPowerDensity.Rd | 4 ++-- 7 files changed, 18 insertions(+), 15 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4e20983..835c96b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -27,7 +27,8 @@ Depends: R (>= 3.6.0) Imports: multiApply (>= 2.1.1), - stats + stats, + ClimProjDiags Suggests: testthat, CSTools, diff --git a/R/PeriodMean.R b/R/PeriodMean.R index abc585a..db6a78f 100644 --- a/R/PeriodMean.R +++ b/R/PeriodMean.R @@ -147,7 +147,7 @@ CST_PeriodMean <- function(data, start = NULL, end = NULL, #'indicator in the element \code{data}. #' #'@examples -#'data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) #'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), @@ -156,7 +156,7 @@ CST_PeriodMean <- function(data, start = NULL, end = NULL, #' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) -#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'dim(Dates) <- c(sdate = 4, time = 3) #'SA <- PeriodMean(data, dates = Dates, start = list(01, 12), end = list(01, 01)) #' #'@import multiApply diff --git a/R/WindCapacityFactor.R b/R/WindCapacityFactor.R index 760dba0..76092dd 100644 --- a/R/WindCapacityFactor.R +++ b/R/WindCapacityFactor.R @@ -80,7 +80,8 @@ CST_WindCapacityFactor <- function(wind, IEC_class = c("I", "I/II", "II", "II/II WindCapacity <- WindCapacityFactor(wind = wind$data, IEC_class = IEC_class, dates = wind$attrs$Dates, start = start, - end = end, ncores = ncores) + end = end, time_dim = time_dim, + ncores = ncores) wind$data <- WindCapacity wind$dims <- dim(WindCapacity) @@ -146,7 +147,7 @@ CST_WindCapacityFactor <- function(wind, IEC_class = c("I", "I/II", "II", "II/II #' #'@examples #'wind <- array(rweibull(n = 32100, shape = 2, scale = 6), -#' c(member = 5, sdate = 3, ftime = 214, lon = 2, lat = 5)) +#' c(member = 5, sdate = 3, time = 214, lon = 2, lat = 5)) #' #'Dates <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), #' as.Date("30-11-2000", format = "%d-%m-%Y"), by = 'day'), @@ -154,7 +155,7 @@ CST_WindCapacityFactor <- function(wind, IEC_class = c("I", "I/II", "II", "II/II #' 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')) -#'dim(Dates) <- c(sdate = 3, ftime = 214) +#'dim(Dates) <- c(sdate = 3, time = 214) #' #'WCF <- WindCapacityFactor(wind, IEC_class = "III", dates = Dates, #' start = list(21, 4), end = list(21, 6)) diff --git a/R/WindPowerDensity.R b/R/WindPowerDensity.R index 3eba59a..3944e3d 100644 --- a/R/WindPowerDensity.R +++ b/R/WindPowerDensity.R @@ -68,7 +68,8 @@ CST_WindPowerDensity <- function(wind, ro = 1.225, start = NULL, end = NULL, } WindPower <- WindPowerDensity(wind = wind$data, ro = ro, dates = wind$attrs$Dates, start = start, - end = end, ncores = ncores) + end = end, time_dim = time_dim, + ncores = ncores) wind$data <- WindPower wind$dims <- dim(WindPower) if ('Variable' %in% names(wind$attrs)) { @@ -122,14 +123,14 @@ CST_WindPowerDensity <- function(wind, ro = 1.225, start = NULL, end = NULL, #' #'@examples #'wind <- array(rweibull(n = 32100, shape = 2, scale = 6), -#' c(member = 5, sdate = 3, ftime = 214, lon = 2, lat = 5)) +#' c(member = 5, sdate = 3, time = 214, lon = 2, lat = 5)) #'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')) -#'dim(Dates) <- c(sdate = 3, ftime = 214) +#'dim(Dates) <- c(sdate = 3, time = 214) #'WPD <- WindPowerDensity(wind, dates = Dates, start = list(21, 4), #' end = list(21, 6)) #' diff --git a/man/PeriodMean.Rd b/man/PeriodMean.Rd index cd1fcef..9637d58 100644 --- a/man/PeriodMean.Rd +++ b/man/PeriodMean.Rd @@ -59,7 +59,7 @@ this function: } } \examples{ -data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), @@ -68,7 +68,7 @@ Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) -dim(Dates) <- c(sdate = 4, ftime = 3) +dim(Dates) <- c(sdate = 4, time = 3) SA <- PeriodMean(data, dates = Dates, start = list(01, 12), end = list(01, 01)) } diff --git a/man/WindCapacityFactor.Rd b/man/WindCapacityFactor.Rd index a0a7ce5..0b6b958 100644 --- a/man/WindCapacityFactor.Rd +++ b/man/WindCapacityFactor.Rd @@ -66,7 +66,7 @@ below). } \examples{ wind <- array(rweibull(n = 32100, shape = 2, scale = 6), - c(member = 5, sdate = 3, ftime = 214, lon = 2, lat = 5)) + c(member = 5, sdate = 3, time = 214, lon = 2, lat = 5)) Dates <- c(seq(as.Date("01-05-2000", format = "\%d-\%m-\%Y"), as.Date("30-11-2000", format = "\%d-\%m-\%Y"), by = 'day'), @@ -74,7 +74,7 @@ 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')) -dim(Dates) <- c(sdate = 3, ftime = 214) +dim(Dates) <- c(sdate = 3, time = 214) WCF <- WindCapacityFactor(wind, IEC_class = "III", dates = Dates, start = list(21, 4), end = list(21, 6)) diff --git a/man/WindPowerDensity.Rd b/man/WindPowerDensity.Rd index 8b72009..9ca3234 100644 --- a/man/WindPowerDensity.Rd +++ b/man/WindPowerDensity.Rd @@ -58,14 +58,14 @@ it will give inaccurate results if used with period means. } \examples{ wind <- array(rweibull(n = 32100, shape = 2, scale = 6), - c(member = 5, sdate = 3, ftime = 214, lon = 2, lat = 5)) + c(member = 5, sdate = 3, time = 214, lon = 2, lat = 5)) 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')) -dim(Dates) <- c(sdate = 3, ftime = 214) +dim(Dates) <- c(sdate = 3, time = 214) WPD <- WindPowerDensity(wind, dates = Dates, start = list(21, 4), end = list(21, 6)) -- GitLab