From 0cc5b0085bfdfc7b191aaa60307125c4ecba519c Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 16 Mar 2023 16:15:40 +0100 Subject: [PATCH 1/3] 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 From 0e576218eb28b31846ff847c91edf4944cda173d Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 23 Mar 2023 14:54:34 +0100 Subject: [PATCH 2/3] Update to v0.3.1 --- DESCRIPTION | 2 +- NEWS.md | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0c51519..d2444da 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ClimProjDiags Title: Set of Tools to Compute Various Climate Indices -Version: 0.3.0 +Version: 0.3.1 Authors@R: c( person("BSC-CNS", role = c("aut", "cph")), person("Nuria", "Perez-Zanon", , "nuria.perez@bsc.es", role = c("aut"), comment = c(ORCID = "0000-0001-8568-3071")), diff --git a/NEWS.md b/NEWS.md index dd95442..d908493 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,6 @@ +# 0.3.1 (Release date: 2023-03-23) +- Subset(): Prioritize the dimension names from names(dim(x)) rather than attribute 'dimensionsrather than attribute 'dimensions'' + # 0.3.0 (Release date: 2023-02-28) - SelBox() and ShiftLon() to accept non-numerical data input - SelBox() uses the latitude and longitude dimension name instead of index -- GitLab From 6cf05080e6fd586a1d965f6b0586ce07fc74b96e Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 23 Mar 2023 15:52:47 +0100 Subject: [PATCH 3/3] Bugfix for data that doesn't have dimension names --- NEWS.md | 2 +- R/Subset.R | 16 +++++++++++++--- tests/testthat/test-Subset.R | 12 +++++++++++- 3 files changed, 25 insertions(+), 5 deletions(-) diff --git a/NEWS.md b/NEWS.md index d908493..d72e8eb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,5 @@ # 0.3.1 (Release date: 2023-03-23) -- Subset(): Prioritize the dimension names from names(dim(x)) rather than attribute 'dimensionsrather than attribute 'dimensions'' +- Subset(): Prioritize the dimension names from names(dim(x)) rather than attribute 'dimensions'; If the input data doesn't have dimension names, the output doesn't have either. # 0.3.0 (Release date: 2023-02-28) - SelBox() and ShiftLon() to accept non-numerical data input diff --git a/R/Subset.R b/R/Subset.R index 37cb327..d9cb384 100644 --- a/R/Subset.R +++ b/R/Subset.R @@ -48,9 +48,11 @@ Subset <- function(x, along, indices, drop = FALSE) { } # Take the input array dimension names + x_has_names_dim <- TRUE dim_names <- names(dim(x)) if (is.null(dim_names)) { dim_names <- attr(x, 'dimensions') + x_has_names_dim <- FALSE } if (!is.character(dim_names)) { @@ -63,6 +65,8 @@ Subset <- function(x, along, indices, drop = FALSE) { warning("Found attribute 'dimensions' containing different dimension names from ", "dim(names(x)). Use the latter one only.") } + } else if (is.null(names(dim(x))) & !is.null(attr(x, 'dimensions'))) { + names(dim(x)) <- dim_names } } # Check along @@ -138,6 +142,10 @@ Subset <- function(x, along, indices, drop = FALSE) { } } } + # if names(dim(x)) doesn't exist, remove the dimension names + if (!x_has_names_dim) { + names(dim(subset)) <- NULL + } # Amend the final dimensions and put dimnames and attributes metadata <- attributes(x) @@ -157,12 +165,14 @@ Subset <- function(x, along, indices, drop = FALSE) { } } } else if (is.character(dim_names) & !identical(dim_names, character(0))) { - names(metadata[['dim']]) <- dim_names + if (x_has_names_dim) { + names(metadata[['dim']]) <- dim_names + } if ('dimensions' %in% names(attributes(x))) { metadata[['dimensions']] <- dim_names } } - attributes(subset) <- metadata - subset + + return(subset) } diff --git a/tests/testthat/test-Subset.R b/tests/testthat/test-Subset.R index 202112d..8144f96 100644 --- a/tests/testthat/test-Subset.R +++ b/tests/testthat/test-Subset.R @@ -253,7 +253,17 @@ check.attributes = F ) expect_equal( attributes(Subset(dat3, 'dat', 1, drop = FALSE)), -list(dim = c(dat = 1, lat = 2, lon = 10), dimensions = c('dat', 'lat', 'lon')) +list(dim = c(1, 2, 10), dimensions = c('dat', 'lat', 'lon')) +) + +# drop: dat, lat +expect_equal( +attributes(Subset(dat3, c('dat', 'lat'), list(1, 1), drop = FALSE)), +list(dim = c(1, 1, 10), dimensions = c('dat', 'lat', 'lon')) +) +expect_equal( +attributes(Subset(dat3, c('dat', 'lat'), list(1, 1), drop = TRUE)), +list(dim = c(10), dimensions = c('lon')) ) # drop: lat, lon -- GitLab