From e504ff7d0c0b5dac0527930879270d641a944f31 Mon Sep 17 00:00:00 2001 From: nperez Date: Tue, 1 Jun 2021 10:21:27 +0200 Subject: [PATCH 1/3] Fix SelectPeriodOnData and test MergeRefToExp --- R/SelectPeriodOnData.R | 5 ++++ tests/testthat/test-MergeRefToExp.R | 40 +++++++++++++++++++++++++++-- 2 files changed, 43 insertions(+), 2 deletions(-) diff --git a/R/SelectPeriodOnData.R b/R/SelectPeriodOnData.R index a6f9c29..85b7ff3 100644 --- a/R/SelectPeriodOnData.R +++ b/R/SelectPeriodOnData.R @@ -121,6 +121,11 @@ SelectPeriodOnData <- function(data, dates, start, end, res <- Apply(list(data, res), target_dims = time_dim, fun = function(x, y) { res <- x[y] + if (is.null(dim(res))) { + dim(res) <- 1 + names(dim(res)) <- time_dim + } + return(res) }, output_dims = time_dim, ncores = ncores)$output1 } return(res) diff --git a/tests/testthat/test-MergeRefToExp.R b/tests/testthat/test-MergeRefToExp.R index a74df90..aed1964 100644 --- a/tests/testthat/test-MergeRefToExp.R +++ b/tests/testthat/test-MergeRefToExp.R @@ -11,7 +11,7 @@ test_that("Sanity checks", { as.Date("01-12-1994", "%d-%m-%Y", tz = 'UTC'), "day") dim(ref_dates) <- c(ftime = 350, sdate = 2) ref <- array(1001:1700, c(ftime = 350, sdate = 2)) - data <- array(1:(2*154*2), c(ftime = 154, sdate = 2, member= 2)) + data <- array(1:(2 * 154 * 2), c(ftime = 154, sdate = 2, member= 2)) ref <- CSTools::s2dv_cube(data = ref, Dates = list(start = ref_dates, end = ref_dates)) data <- CSTools::s2dv_cube(data = data, Dates = list(start = data_dates, @@ -29,7 +29,43 @@ test_that("Sanity checks", { end1 = list(30, 6), start2 = list(1, 7), end2 = list(21, 9))$data, output) - }) + + # issue 13: One lead time + data_dates <- c(as.Date("01-06-1993", "%d-%m-%Y", tz = 'UTC'), + as.Date("01-07-1993", "%d-%m-%Y", tz = 'UTC'), + as.Date("01-06-1994", "%d-%m-%Y", tz = 'UTC'), + as.Date("01-07-1994","%d-%m-%Y", tz = 'UTC')) + + dim(data_dates) <- c(ftime = 2, sdate = 2) + ref_dates <- c(as.Date("01-05-1993", "%d-%m-%Y", tz = 'UTC'), + as.Date("01-05-1994", "%d-%m-%Y", tz = 'UTC')) + dim(ref_dates) <- c(ftime = 1, sdate = 2) + ref <- array(1:2, c(ftime = 1, sdate = 2)) + data <- array(1:(2 * 3 * 2), c(ftime = 2, sdate = 2, member = 3)) + ref <- CSTools::s2dv_cube(data = ref, Dates = list(start = ref_dates, + end = ref_dates)) + data <- CSTools::s2dv_cube(data = data, Dates = list(start = data_dates, + end = data_dates)) + res_dates <- c(as.Date("01-05-1993", "%d-%m-%Y", tz = 'UTC'), + as.Date("01-06-1993", "%d-%m-%Y", tz = 'UTC'), + as.Date("01-07-1993", "%d-%m-%Y", tz = 'UTC'), + as.Date("01-05-1994", "%d-%m-%Y", tz = 'UTC'), + as.Date("01-06-1994", "%d-%m-%Y", tz = 'UTC'), + as.Date("01-07-1994","%d-%m-%Y", tz = 'UTC')) + dim(res_dates) <- c(ftime = 3, sdate = 2) + expect_equal(CST_MergeRefToExp(data1 = ref, data2 = data, start1 = list(1, 5), + end1 = list(31, 5), start2 = list(1, 6), + end2 = list(31, 7))$Dates, + res_dates) + output <- abind::abind(t(matrix(rep(1:2, 3), ncol = 2, nrow = 3, byrow = T)), + data$data, along = 1) + names(dim(output)) <- c('ftime', 'sdate', 'member') + expect_equal(CST_MergeRefToExp(data1 = ref, data2 = data, start1 = list(1, 5), + end1 = list(31, 5), start2 = list(1, 6), + end2 = list(31, 7))$data, + output) + +}) test_that("Seasonal", { -- GitLab From 5a51593be55a372fc3bddfea82374db5d7127bd9 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 13 Jul 2022 16:06:17 +0200 Subject: [PATCH 2/3] Added warnings for NULL dates dimensions --- R/MergeRefToExp.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/MergeRefToExp.R b/R/MergeRefToExp.R index 365ceb5..a5cfc20 100644 --- a/R/MergeRefToExp.R +++ b/R/MergeRefToExp.R @@ -143,10 +143,14 @@ MergeRefToExp <- function(data1, dates1, start1, end1, data2, dates2, start2, en names(dim(data2)) <- time_dim } if (is.null(dim(dates1))) { + warning("Dimensions in 'dates1' element are missed and ", + "all data would be used.") dim(dates1) <- length(dates1) names(dim(dates1)) <- time_dim } if (is.null(dim(dates2))) { + warning("Dimensions in 'dates2' element are missed and ", + "all data would be used.") dim(dates2) <- length(dates2) names(dim(dates2)) <- time_dim } -- GitLab From 341bf54b3673f2467716b71e5ef59592f315ba6b Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 13 Jul 2022 16:07:43 +0200 Subject: [PATCH 3/3] Supressed warnings from test-MergeRefToExp --- tests/testthat/test-MergeRefToExp.R | 32 ++++++++++++++++++++++++++++- 1 file changed, 31 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-MergeRefToExp.R b/tests/testthat/test-MergeRefToExp.R index aed1964..b4503d8 100644 --- a/tests/testthat/test-MergeRefToExp.R +++ b/tests/testthat/test-MergeRefToExp.R @@ -12,23 +12,31 @@ test_that("Sanity checks", { dim(ref_dates) <- c(ftime = 350, sdate = 2) ref <- array(1001:1700, c(ftime = 350, sdate = 2)) data <- array(1:(2 * 154 * 2), c(ftime = 154, sdate = 2, member= 2)) + +suppressWarnings( ref <- CSTools::s2dv_cube(data = ref, Dates = list(start = ref_dates, end = ref_dates)) +) +suppressWarnings( data <- CSTools::s2dv_cube(data = data, Dates = list(start = data_dates, end = data_dates)) - +) +suppressWarnings( expect_equal(CST_MergeRefToExp(data1 = ref, data2 = data, start1 = list(21, 6), end1 = list(30, 6), start2 = list(1, 7), end2 = list(21, 9))$Dates, SelectPeriodOnDates(ref_dates, start = list(21, 6), end = list(21,9))) +) output <- array(c(1172:1181, 1:83, 1537:1546, 155:237, 1172:1181, 309:391, 1537:1546, 463:545), c(ftime = 93, sdate = 2, member = 2)) +suppressWarnings( expect_equal(CST_MergeRefToExp(data1 = ref, data2 = data, start1 = list(21, 6), end1 = list(30, 6), start2 = list(1, 7), end2 = list(21, 9))$data, output) +) # issue 13: One lead time data_dates <- c(as.Date("01-06-1993", "%d-%m-%Y", tz = 'UTC'), @@ -42,10 +50,15 @@ test_that("Sanity checks", { dim(ref_dates) <- c(ftime = 1, sdate = 2) ref <- array(1:2, c(ftime = 1, sdate = 2)) data <- array(1:(2 * 3 * 2), c(ftime = 2, sdate = 2, member = 3)) + +suppressWarnings( ref <- CSTools::s2dv_cube(data = ref, Dates = list(start = ref_dates, end = ref_dates)) +) +suppressWarnings( data <- CSTools::s2dv_cube(data = data, Dates = list(start = data_dates, end = data_dates)) +) res_dates <- c(as.Date("01-05-1993", "%d-%m-%Y", tz = 'UTC'), as.Date("01-06-1993", "%d-%m-%Y", tz = 'UTC'), as.Date("01-07-1993", "%d-%m-%Y", tz = 'UTC'), @@ -53,17 +66,24 @@ test_that("Sanity checks", { as.Date("01-06-1994", "%d-%m-%Y", tz = 'UTC'), as.Date("01-07-1994","%d-%m-%Y", tz = 'UTC')) dim(res_dates) <- c(ftime = 3, sdate = 2) + +suppressWarnings( expect_equal(CST_MergeRefToExp(data1 = ref, data2 = data, start1 = list(1, 5), end1 = list(31, 5), start2 = list(1, 6), end2 = list(31, 7))$Dates, res_dates) +) + output <- abind::abind(t(matrix(rep(1:2, 3), ncol = 2, nrow = 3, byrow = T)), data$data, along = 1) names(dim(output)) <- c('ftime', 'sdate', 'member') + +suppressWarnings( expect_equal(CST_MergeRefToExp(data1 = ref, data2 = data, start1 = list(1, 5), end1 = list(31, 5), start2 = list(1, 6), end2 = list(31, 7))$data, output) +) }) @@ -85,22 +105,32 @@ test_that("Seasonal", { dim(dates) <- dim.dates ref <- array(1:(215*25), c(ftime = 215, sdate = 25)) + +suppressWarnings( ref <- CSTools::s2dv_cube(data = ref, Dates = list(start = dates, end = dates)) +) data <- array(1:(215*25*3), c(ftime = 215, sdate = 25, member=3)) + +suppressWarnings( data <- CSTools::s2dv_cube(data = data, Dates = list(start = dates, end = dates)) +) +suppressWarnings( expect_equal(CST_MergeRefToExp(data1 = data, data2 = ref, start1 = list(21, 6), end1 = list(30, 6), start2 = list(1, 7), end2 = list(21, 9))$Dates, SelectPeriodOnDates(dates, start = list(21, 6), end = list(21,9))) +) +suppressWarnings( expect_equal(CST_MergeRefToExp(data1 = ref, data2 = data, start1 = list(21, 6), end1 = list(30, 6), start2 = list(1, 7), end2 = list(21, 9))$Dates, SelectPeriodOnDates(dates, start = list(21, 6), end = list(21,9))) +) }) -- GitLab