From ae1e2c809e176e9ea26631f30bea568ca044431d Mon Sep 17 00:00:00 2001
From: nperez <nperez@bscearth372.int.bsc.es>
Date: Thu, 11 Feb 2021 19:19:49 +0100
Subject: [PATCH] Fix SelectPeriodOnDates for dimensions order

---
 DESCRIPTION                        |  2 +-
 NAMESPACE                          |  1 +
 R/SelectPeriodOnDates.R            |  4 ++++
 tests/testthat/test-SelectPeriod.R | 24 ++++++++++++++++++++++++
 4 files changed, 30 insertions(+), 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 7fb4354..27a3ae3 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -8,11 +8,11 @@ Depends:
     R (>= 3.6.1)
 Imports:
     multiApply (>= 2.1.1),
+    s2dv,
     stats,
     ClimProjDiags
 Suggests:
     testthat,
-    s2dv,
     CSTools
 License: Apache License 2.0
 URL: https://earth.bsc.es/gitlab/es/csindicators/
diff --git a/NAMESPACE b/NAMESPACE
index 6ae2d5f..09b5709 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -21,5 +21,6 @@ export(TotalSpellTimeExceedingThreshold)
 export(TotalTimeExceedingThreshold)
 import(multiApply)
 importFrom(ClimProjDiags,Subset)
+importFrom(s2dv,Reorder)
 importFrom(stats,ecdf)
 importFrom(stats,quantile)
diff --git a/R/SelectPeriodOnDates.R b/R/SelectPeriodOnDates.R
index 46ae7ff..c8444c0 100644
--- a/R/SelectPeriodOnDates.R
+++ b/R/SelectPeriodOnDates.R
@@ -11,6 +11,7 @@
 #'@return A multidimensional array with named dimensions.
 #'
 #'@import multiApply
+#'@importFrom s2dv Reorder
 #'
 #'@examples
 #'Dates <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), 
@@ -52,6 +53,9 @@ 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)))) {
+      res <- s2dv::Reorder(res, names(dim(dates)))
+    }  
     res <- dates[res]
     dim(res) <- dims
   }
diff --git a/tests/testthat/test-SelectPeriod.R b/tests/testthat/test-SelectPeriod.R
index 5716b1a..3db72d8 100644
--- a/tests/testthat/test-SelectPeriod.R
+++ b/tests/testthat/test-SelectPeriod.R
@@ -3,6 +3,30 @@ context("Generic tests")
   #source("R/SelectPeriodOnDates.R")
   #source("R/SelectPeriodOnData.R")
   library(s2dv)
+test_that("Sanity checks", {
+    #source("csindicators/R/AbsToProbs.R")
+  expect_error(SelectPeriodOnDates('x', start = list(1,1), end = list(1,1)), "invalid 'trim' argument")
+  # Lluis issue #8:
+  dates <- c(seq(as.Date("02-05-1993", "%d-%m-%Y", tz = 'UTC'),
+               as.Date("01-12-1993","%d-%m-%Y", tz = 'UTC'), "day"),
+           seq(as.Date("02-05-1994", "%d-%m-%Y", tz = 'UTC'),
+               as.Date("01-12-1994","%d-%m-%Y", tz = 'UTC'), "day"),
+           seq(as.Date("02-05-1995", "%d-%m-%Y", tz = 'UTC'),
+               as.Date("01-12-1995","%d-%m-%Y", tz = 'UTC'), "day"))
+  dim(dates) <- c(time = 214, file_date = 3)
+  output <- c(seq(as.Date("21-06-1993", "%d-%m-%Y", tz = 'UTC'),
+               as.Date("21-09-1993","%d-%m-%Y", tz = 'UTC'), "day"),
+           seq(as.Date("21-06-1994", "%d-%m-%Y", tz = 'UTC'),
+               as.Date("21-09-1994","%d-%m-%Y", tz = 'UTC'), "day"),
+           seq(as.Date("21-06-1995", "%d-%m-%Y", tz = 'UTC'),
+               as.Date("21-09-1995","%d-%m-%Y", tz = 'UTC'), "day"))
+  dim(output) <- c(time = 93, file_date = 3)
+  expect_equal(SelectPeriodOnDates(dates, list(21,6),list(21,9), time_dim = 'time'), output)
+  dates <- s2dv::Reorder(dates, c('file_date', 'time'))
+  output <- s2dv::Reorder(output, c('file_date', 'time'))
+  expect_equal(SelectPeriodOnDates(dates, list(21,6),list(21,9), time_dim = 'time'), output)
+})
+
 test_that("Decadal", { 
  # -------- DECADAL ----------#
   # decadal: 1 sdate several consequtive years:
-- 
GitLab