From 3fa78bd03b82e18c3b017f0d97925e4a5b7a58dc Mon Sep 17 00:00:00 2001 From: vagudets Date: Mon, 23 Jun 2025 11:31:02 +0200 Subject: [PATCH 1/3] PeriodAccumulation(): Remove unneeded extra time dimension --- R/PeriodAccumulation.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index 2adf45f..16a0f03 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -322,7 +322,6 @@ PeriodAccumulation <- function(data, dates = NULL, start = NULL, end = NULL, pos <- match(dimnames, names(dim(total))) total <- aperm(total, pos) } - dim(total) <- c(dim(total), setNames(1, time_dim)) return(total) } -- GitLab From c6ca51d564113eadb03d6b2476b94e50916167de Mon Sep 17 00:00:00 2001 From: vagudets Date: Mon, 23 Jun 2025 11:36:20 +0200 Subject: [PATCH 2/3] Add time_dim only if not present --- R/PeriodAccumulation.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/PeriodAccumulation.R b/R/PeriodAccumulation.R index 16a0f03..b68be57 100644 --- a/R/PeriodAccumulation.R +++ b/R/PeriodAccumulation.R @@ -322,6 +322,9 @@ PeriodAccumulation <- function(data, dates = NULL, start = NULL, end = NULL, pos <- match(dimnames, names(dim(total))) total <- aperm(total, pos) } + if (!time_dim %in% names(dim(total))) { + dim(total) <- c(dim(total), setNames(1, time_dim)) + } return(total) } -- GitLab From 0df5ccba145ccc71f76ea3ef9d8d021d97cacb94 Mon Sep 17 00:00:00 2001 From: vagudets Date: Mon, 23 Jun 2025 12:09:12 +0200 Subject: [PATCH 3/3] Fix pipeline --- tests/testthat/test-PeriodAccumulation.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-PeriodAccumulation.R b/tests/testthat/test-PeriodAccumulation.R index 3aa47ea..d5e41a0 100644 --- a/tests/testthat/test-PeriodAccumulation.R +++ b/tests/testthat/test-PeriodAccumulation.R @@ -196,29 +196,29 @@ test_that("4. Rolling", { # Output checks expect_equal( PeriodAccumulation(data = dat2, rollwidth = -2, dates = dates2, frequency = 'daily'), - array(c(4, 6, 8, 10, NA, NA), dim = c(sdate = 2, time = 3, member = 1, time = 1)) + array(c(4, 6, 8, 10, NA, NA), dim = c(sdate = 2, time = 3, member = 1)) ) expect_equal( PeriodAccumulation(data = dat2, rollwidth = 3, dates = dates2, frequency = 'daily'), - array(c(rep(NA, 4), 9, 12), dim = c(sdate = 2, time = 3, member = 1, time = 1)) + array(c(rep(NA, 4), 9, 12), dim = c(sdate = 2, time = 3, member = 1)) ) dat2_1 <- dat2 dat2_1[1,1,1] <- NA expect_equal( PeriodAccumulation(data = dat2_1, rollwidth = 2, dates = dates2, na.rm = FALSE, frequency = 'daily'), - array(c(rep(NA, 3), 6, 8, 10), dim = c(sdate = 2, time = 3, member = 1, time = 1)) + array(c(rep(NA, 3), 6, 8, 10), dim = c(sdate = 2, time = 3, member = 1)) ) # Test rolling with start and end expect_equal( PeriodAccumulation(data = dat2, rollwidth = 1, dates = dates2, start = list(1, 4), end = list(2, 4), frequency = 'daily'), - array(c(1, 2, 3, 4), dim = c(sdate = 2, time = 2, member = 1, time = 1)) + array(c(1, 2, 3, 4), dim = c(sdate = 2, time = 2, member = 1)) ) expect_equal( PeriodAccumulation(data = dat2, rollwidth = 2, dates = dates2, start = list(1, 4), end = list(2, 4), frequency = 'daily'), - array(c(NA, NA, 4, 6), dim = c(sdate = 2, time = 2, member = 1, time = 1)) + array(c(NA, NA, 4, 6), dim = c(sdate = 2, time = 2, member = 1)) ) }) -- GitLab