From 5464161f619e74eeaee83f8bdd44bc2597c30a4d Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Mon, 4 Dec 2023 15:31:37 +0100 Subject: [PATCH 1/2] Correct dimensions order of dates and add unit test --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/SelectPeriodOnData.R | 6 ++-- R/SelectPeriodOnDates.R | 17 +++++++---- tests/testthat/test-SelectPeriod.R | 47 +++++++++++++++++++++++++++++- 5 files changed, 63 insertions(+), 10 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 98fecac..4270c0b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -47,5 +47,5 @@ License: GPL-3 URL: https://earth.bsc.es/gitlab/es/csindicators/ BugReports: https://earth.bsc.es/gitlab/es/csindicators/-/issues Encoding: UTF-8 -RoxygenNote: 7.2.0 +RoxygenNote: 7.2.3 Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index bab43ed..15c3c9a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -54,6 +54,7 @@ importFrom(lmomco,parpe3) importFrom(lmomco,pwm.pp) importFrom(lmomco,pwm.ub) importFrom(lmomco,pwm2lmom) +importFrom(s2dv,Reorder) importFrom(stats,approxfun) importFrom(stats,ecdf) importFrom(stats,qnorm) diff --git a/R/SelectPeriodOnData.R b/R/SelectPeriodOnData.R index a4cc07c..1cc2792 100644 --- a/R/SelectPeriodOnData.R +++ b/R/SelectPeriodOnData.R @@ -101,6 +101,7 @@ CST_SelectPeriodOnData <- function(data, start, end, time_dim = 'time', #'Period <- SelectPeriodOnData(data, Dates, start = list(21, 6), end = list(21, 9)) #'@import multiApply #'@importFrom ClimProjDiags Subset +#'@importFrom s2dv Reorder #'@export SelectPeriodOnData <- function(data, dates, start, end, time_dim = 'time', ncores = NULL) { @@ -153,7 +154,8 @@ SelectPeriodOnData <- function(data, dates, start, end, indices <- as.list(rep(1, length(dim_remove))) res <- Subset(res, along = dim_remove, indices, drop = 'selected') } - pos <- match(names(dim(data)), names(dim(res))) - res <- aperm(res, pos) + if (any(names(dims) != names(dim(res)))) { + res <- Reorder(res, names(dims)) + } return(res) } diff --git a/R/SelectPeriodOnDates.R b/R/SelectPeriodOnDates.R index 0919c5d..550aad9 100644 --- a/R/SelectPeriodOnDates.R +++ b/R/SelectPeriodOnDates.R @@ -19,8 +19,6 @@ #'@return A multidimensional array with named dimensions containing the subset of #'the vector dates during the period requested from \code{start} to \code{end}. #' -#'@import multiApply -#' #'@examples #'Dates <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), #' as.Date("30-11-2000", format = "%d-%m-%Y"), by = 'day'), @@ -30,6 +28,8 @@ #' as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day')) #'dim(Dates) <- c(time = 214, sdate = 3) #'Period <- SelectPeriodOnDates(Dates, start = list(21, 6), end = list(21, 9)) +#'@import multiApply +#'@importFrom s2dv Reorder #'@export SelectPeriodOnDates <- function(dates, start, end, time_dim = 'time', ncores = NULL) { @@ -45,6 +45,12 @@ SelectPeriodOnDates <- function(dates, start, end, ini_day = start[[1]], ini_month = start[[2]], end_day = end[[1]], end_month = end[[2]], ncores = ncores)$output1 + reorder <- FALSE + if (which(names(dim(dates)) == time_dim) != 1) { + dimdates <- names(dim(dates)) + dates <- Reorder(dates, c(time_dim, names(dim(dates))[which(names(dim(dates)) != time_dim)])) + reorder <- TRUE + } # when 29Feb is included the length of the output changes: regular <- Apply(list(res), target_dims = time_dim, fun = sum, ncores = ncores)$output1 @@ -64,12 +70,11 @@ SelectPeriodOnDates <- function(dates, start, end, }, ncores = ncores)$output1 res <- as.POSIXct(res, origin = '1970-01-01', tz = 'UTC') } else { - if (!all(names(dim(res)) == names(dim(dates)))) { - pos <- match(names(dim(dates)), names(dim(res))) - res <- aperm(res, pos) - } res <- dates[res] dim(res) <- dims + if (reorder) { + res <- Reorder(res, dimdates) + } } return(res) } diff --git a/tests/testthat/test-SelectPeriod.R b/tests/testthat/test-SelectPeriod.R index 93fc6eb..03b4072 100644 --- a/tests/testthat/test-SelectPeriod.R +++ b/tests/testthat/test-SelectPeriod.R @@ -56,7 +56,6 @@ test_that("2. Output checks", { dim(res), c(time = 52) ) - }) ############################################## @@ -250,3 +249,49 @@ test_that("4. Seasonal", { ) }) +############################################## + +test_that("5. Test sample data", { + dates <- c(seq(as.POSIXct("10-03-2011", format = "%d-%m-%Y", tz = "UTC"), + as.POSIXct("20-03-2011", format = "%d-%m-%Y", tz = "UTC"), by = 'day'), + seq(as.POSIXct("10-03-2012", format = "%d-%m-%Y", tz = "UTC"), + as.POSIXct("20-03-2012", format = "%d-%m-%Y", tz = "UTC"), by = 'day'), + seq(as.POSIXct("10-03-2013", format = "%d-%m-%Y", tz = "UTC"), + as.POSIXct("20-03-2013", format = "%d-%m-%Y", tz = "UTC"), by = 'day')) + dim(dates) <- c(ftime = 11, sdate = 3) + expect_equal( + SelectPeriodOnDates(dates = lonlat_prec$attrs$Dates, start = list(10, 03), + end = list(20, 03), time_dim = 'ftime'), + dates + ) + dates_lonlat <- lonlat_prec_st$attrs$Dates + dates_lonlat <- Reorder(dates_lonlat-12*3600, c(2,1)) + expect_equal( + SelectPeriodOnDates(dates = dates_lonlat, start = list(10, 03), + end = list(20, 03), time_dim = 'ftime'), + dates + ) + # test error + dates <- CSTools::lonlat_prec_st$attrs$Dates + out_sdates <- c(as.POSIXct("10-03-2011", format = "%d-%m-%Y", tz = "UTC"), + as.POSIXct("10-03-2012", format = "%d-%m-%Y", tz = "UTC"), + as.POSIXct("10-03-2013", format = "%d-%m-%Y", tz = "UTC")) + dim(dates) <- c(a = 3, len = 31) + expect_error( + SelectPeriodOnDates(dates = dates, start = list(10, 03), + end = list(20, 03), time_dim = 'ftime'), + "Could not find dimension 'ftime' in 1th object provided in 'data'." + ) + dim(dates) <- c(sdate = 3, ftime = 31) + expect_equal( + SelectPeriodOnDates(dates = dates-12*3600, start = list(10, 03), + end = list(20, 03), time_dim = 'ftime')[, 1], + out_sdates + ) + dates <- Reorder(dates, c(2,1)) + expect_equal( + SelectPeriodOnDates(dates = dates-12*3600, start = list(10, 03), + end = list(20, 03), time_dim = 'ftime')[1, ], + out_sdates + ) +}) -- GitLab From 948b057a2843f828cf3fa9b1c64990cead349367 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Mon, 4 Dec 2023 15:48:53 +0100 Subject: [PATCH 2/2] Add s2dv in DESCRIPTION --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4270c0b..eddf374 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,7 +36,8 @@ Imports: SPEI, lmom, lmomco, - zoo + zoo, + s2dv Suggests: testthat, knitr, -- GitLab