From 0cc5b0085bfdfc7b191aaa60307125c4ecba519c Mon Sep 17 00:00:00 2001
From: aho <an.ho@bsc.es>
Date: Thu, 16 Mar 2023 16:15:40 +0100
Subject: [PATCH] Prioritize names(dim(x)) than attribute 'dimensions'

---
 R/Subset.R                   | 26 +++++++++++++++-----------
 man/Subset.Rd                | 10 +++++-----
 tests/testthat/test-Subset.R | 29 +++++------------------------
 3 files changed, 25 insertions(+), 40 deletions(-)

diff --git a/R/Subset.R b/R/Subset.R
index 6c23215..37cb327 100644
--- a/R/Subset.R
+++ b/R/Subset.R
@@ -4,11 +4,11 @@
 #'similar way as done in the function \code{take()} in the package plyr. There
 #'are two main snprovements:\cr\cr First, the input array can have dimension 
 #'names, either in \code{names(dim(x))} or in the attribute 'dimensions'. If 
-#'both exist, the attribute 'dimensions' is prioritized. The dimensions to 
-#'subset along can be specified via the parameter \code{along} either with
-#'integer indices or either by their name.\cr\cr Second, there are additional
-#'ways to adjust which dimensions are dropped in the resulting array: either to
-#'drop all, to drop none, to drop only the ones that have been sliced or to drop
+#'both exist, \code{names(dim(x))} is prioritized. The dimensions to subset
+#'along can be specified via the parameter \code{along} either with integer
+#'indices or either by their name.\cr\cr Second, there are additional ways to
+#'adjust which dimensions are dropped in the resulting array: either to drop
+#'all, to drop none, to drop only the ones that have been sliced or to drop
 #'only the ones that have not been sliced.\cr\cr 
 #'
 #'@param x A named multidimensional array to be sliced. It can have dimension 
@@ -48,19 +48,23 @@ Subset <- function(x, along, indices, drop = FALSE) {
   }
 
   # Take the input array dimension names
-  dim_names <- attr(x, 'dimensions')
-  if (!is.character(dim_names)) {
-    dim_names <- names(dim(x))
-  } else {
-    names(dim(x)) <- dim_names
+  dim_names <- names(dim(x))
+  if (is.null(dim_names)) {
+    dim_names <- attr(x, 'dimensions')
   }
 
   if (!is.character(dim_names)) {
     if (any(sapply(along, is.character))) {
       stop("The input array 'x' doesn't have labels for the dimensions but the parameter 'along' contains dimension names.")
     }
+  } else {
+    if (!is.null(names(dim(x))) & !is.null(attr(x, 'dimensions'))) {
+      if (any(names(dim(x)) != attr(x, 'dimensions'))) {
+        warning("Found attribute 'dimensions' containing different dimension names from ",
+                "dim(names(x)). Use the latter one only.")
+      }
+    }
   }
-
   # Check along
   if (any(sapply(along, function(x) !is.numeric(x) && !is.character(x))) |
       length(along) == 0) {
diff --git a/man/Subset.Rd b/man/Subset.Rd
index f50c5da..6b73f28 100644
--- a/man/Subset.Rd
+++ b/man/Subset.Rd
@@ -31,11 +31,11 @@ This function allows to subset (i.e. slice, take a chunk of) an array, in a
 similar way as done in the function \code{take()} in the package plyr. There
 are two main snprovements:\cr\cr First, the input array can have dimension 
 names, either in \code{names(dim(x))} or in the attribute 'dimensions'. If 
-both exist, the attribute 'dimensions' is prioritized. The dimensions to 
-subset along can be specified via the parameter \code{along} either with
-integer indices or either by their name.\cr\cr Second, there are additional
-ways to adjust which dimensions are dropped in the resulting array: either to
-drop all, to drop none, to drop only the ones that have been sliced or to drop
+both exist, \code{names(dim(x))} is prioritized. The dimensions to subset
+along can be specified via the parameter \code{along} either with integer
+indices or either by their name.\cr\cr Second, there are additional ways to
+adjust which dimensions are dropped in the resulting array: either to drop
+all, to drop none, to drop only the ones that have been sliced or to drop
 only the ones that have not been sliced.\cr\cr
 }
 \examples{
diff --git a/tests/testthat/test-Subset.R b/tests/testthat/test-Subset.R
index e769453..202112d 100644
--- a/tests/testthat/test-Subset.R
+++ b/tests/testthat/test-Subset.R
@@ -43,6 +43,11 @@ expect_error(
 Subset(x = dat1, 'dat', 1, drop = 'yes'),
 "Parameter 'drop' must be one of TRUE, FALSE, 'all', 'selected', 'non-selected', 'none'."
 )
+expect_warning(
+Subset(dat4, 'lat', 1),
+"Found attribute 'dimensions' containing different dimension names from dim(names(x)). Use the latter one only.",
+fixed = T
+)
 
 })
 
@@ -264,27 +269,3 @@ list(dim = 1, dimensions = c('dat', 'lat', 'lon'))
 
 })
 
-test_that("5. dat4", {
-
-# drop: lat
-expect_equal(
-Subset(dat4, 'latitude', 1, drop = FALSE),
-Subset(dat1, 'lat', 1, drop = FALSE),
-check.attributes = F
-)
-expect_equal(
-attributes(Subset(dat4, 'latitude', 1, drop = FALSE)),
-list(dim = c(dataset = 1, latitude = 1, longitude = 10), dimensions = c('dataset', 'latitude', 'longitude'))
-)
-# drop: lat, lon
-expect_equal(
-Subset(dat4, c('latitude', 'longitude'), list(1, 2), drop = TRUE),
-Subset(dat1, c('lat', 'lon'), list(1, 2), drop = TRUE),
-check.attributes = F
-)
-expect_equal(
-attributes(Subset(dat4, c('latitude', 'longitude'), list(1, 2), drop = TRUE)),
-list(dim = 1, dimensions = c('dataset', 'latitude', 'longitude'))
-)
-
-})
-- 
GitLab