From 5a7435f3243631207aa9fb539b97895fcb15e2f0 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Tue, 26 Sep 2023 12:09:19 +0200 Subject: [PATCH 1/2] Remove some warnings; add parameter 'drop_dims' and correct adding metadata when it is a vector --- R/CST_SaveExp.R | 42 +++++++++++++++++++++++-------- man/CST_SaveExp.Rd | 5 ++++ man/SaveExp.Rd | 9 +++++-- tests/testthat/test-CST_SaveExp.R | 27 +++++++++++++++++++- 4 files changed, 70 insertions(+), 13 deletions(-) diff --git a/R/CST_SaveExp.R b/R/CST_SaveExp.R index 2c363e46..274e67f5 100644 --- a/R/CST_SaveExp.R +++ b/R/CST_SaveExp.R @@ -36,6 +36,9 @@ #' If it is NULL, the coordinate corresponding the the start date dimension or #' the first Date of each time step will be used as the name of the files. #' It is NULL by default. +#'@param drop_dims A vector of character strings indicating the dimension names +#' of length 1 that need to be dropped in order that they don't appear in the +#' netCDF file. It is NULL by default (optional). #'@param single_file A logical value indicating if all object is saved in a #' single file (TRUE) or in multiple files (FALSE). When it is FALSE, #' the array is separated for Datasets, variable and start date. It is FALSE @@ -83,8 +86,8 @@ CST_SaveExp <- function(data, destination = "./", sdate_dim = 'sdate', ftime_dim = 'time', dat_dim = 'dataset', var_dim = 'var', memb_dim = 'member', - startdates = NULL, single_file = FALSE, - extra_string = NULL) { + startdates = NULL, drop_dims = NULL, + single_file = FALSE, extra_string = NULL) { # Check 's2dv_cube' if (!inherits(data, 's2dv_cube')) { stop("Parameter 'data' must be of the class 's2dv_cube', ", @@ -167,7 +170,8 @@ CST_SaveExp <- function(data, destination = "./", sdate_dim = 'sdate', startdates = startdates, dat_dim = dat_dim, sdate_dim = sdate_dim, ftime_dim = ftime_dim, var_dim = var_dim, - memb_dim = memb_dim, + memb_dim = memb_dim, + drop_dims = drop_dims, extra_string = extra_string, single_file = single_file) } @@ -217,13 +221,16 @@ CST_SaveExp <- function(data, destination = "./", sdate_dim = 'sdate', #'@param memb_dim A character string indicating the name of the member dimension. #' By default, it is set to 'member'. It can be NULL if there is no member #' dimension. +#'@param drop_dims A vector of character strings indicating the dimension names +#' of length 1 that need to be dropped in order that they don't appear in the +#' netCDF file. It is NULL by default (optional). #'@param single_file A logical value indicating if all object is saved in a #' unique file (TRUE) or in separated directories (FALSE). When it is FALSE, #' the array is separated for Datasets, variable and start date. It is FALSE -#' by default. +#' by default (optional). #'@param extra_string A character string to be include as part of the file name, #' for instance, to identify member or realization. It would be added to the -#' file name between underscore characters. +#' file name between underscore characters (optional). #' #'@return Multiple or single NetCDF files containing the data array.\cr #'\item{\code{single_file = TRUE}}{ @@ -271,7 +278,7 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, varname = NULL, metadata = NULL, Datasets = NULL, startdates = NULL, dat_dim = 'dataset', sdate_dim = 'sdate', ftime_dim = 'time', var_dim = 'var', memb_dim = 'member', - single_file = FALSE, extra_string = NULL) { + drop_dims = NULL, single_file = FALSE, extra_string = NULL) { ## Initial checks # data if (is.null(data)) { @@ -296,6 +303,21 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, stop("Parameter 'Dates' must have dimension names.") } } + # drop_dims + if (!is.null(drop_dims)) { + if (!is.character(drop_dims) | any(!drop_dims %in% names(dim(data)))) { + warning("Parameter 'drop_dims' must be character string containing ", + "the data dimension names to be dropped. It will not be used.") + } else if (!all(dim(data)[drop_dims] %in% 1)) { + warning("Parameter 'drop_dims' can only contain dimension names ", + "that are of length 1. It will not be used.") + } else { + data <- Subset(x = data, along = drop_dims, + indices = lapply(1:length(drop_dims), function(x) 1), + drop = 'selected') + dimnames <- names(dim(data)) + } + } # coords if (!is.null(coords)) { if (!all(names(coords) %in% dimnames)) { @@ -352,7 +374,6 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, # Spatial coordinates if (!any(dimnames %in% .KnownLonNames()) | !any(dimnames %in% .KnownLatNames())) { - warning("Spatial coordinates not found.") lon_dim <- NULL lat_dim <- NULL } else { @@ -517,7 +538,6 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, alldims <- c(dat_dim, var_dim, sdate_dim, lon_dim, lat_dim, memb_dim, ftime_dim) if (!all(dimnames %in% alldims)) { unknown_dims <- dimnames[which(!dimnames %in% alldims)] - # warning("Detected unknown dimension: ", paste(unknown_dims, collapse = ', ')) memb_dim <- c(memb_dim, unknown_dims) alldims <- c(dat_dim, var_dim, sdate_dim, lon_dim, lat_dim, memb_dim, ftime_dim) } @@ -924,14 +944,16 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, for (dim in names(defined_dims)) { if (dim %in% names(extra_info_dim)) { for (info_dim in names(extra_info_dim[[dim]])) { - ncatt_put(file_nc, dim, info_dim, as.character(extra_info_dim[[dim]][[info_dim]])) + add_info_dim <- paste0(extra_info_dim[[dim]][[info_dim]], collapse = ', ') + ncatt_put(file_nc, dim, info_dim, add_info_dim) } } } # Additional dimension attributes if (!is.null(extra_info_var)) { for (info_var in names(extra_info_var)) { - ncatt_put(file_nc, varname, info_var, as.character(extra_info_var[[info_var]])) + add_info_var <- paste0(extra_info_var[[info_var]], collapse = ', ') + ncatt_put(file_nc, varname, info_var, add_info_var) } } diff --git a/man/CST_SaveExp.Rd b/man/CST_SaveExp.Rd index f8918eb9..5dd125ad 100644 --- a/man/CST_SaveExp.Rd +++ b/man/CST_SaveExp.Rd @@ -13,6 +13,7 @@ CST_SaveExp( var_dim = "var", memb_dim = "member", startdates = NULL, + drop_dims = NULL, single_file = FALSE, extra_string = NULL ) @@ -54,6 +55,10 @@ If it is NULL, the coordinate corresponding the the start date dimension or the first Date of each time step will be used as the name of the files. It is NULL by default.} +\item{drop_dims}{A vector of character strings indicating the dimension names +of length 1 that need to be dropped in order that they don't appear in the +netCDF file. It is NULL by default (optional).} + \item{single_file}{A logical value indicating if all object is saved in a single file (TRUE) or in multiple files (FALSE). When it is FALSE, the array is separated for Datasets, variable and start date. It is FALSE diff --git a/man/SaveExp.Rd b/man/SaveExp.Rd index a9c0ac36..d9bac6f0 100644 --- a/man/SaveExp.Rd +++ b/man/SaveExp.Rd @@ -18,6 +18,7 @@ SaveExp( ftime_dim = "time", var_dim = "var", memb_dim = "member", + drop_dims = NULL, single_file = FALSE, extra_string = NULL ) @@ -74,14 +75,18 @@ dimension.} By default, it is set to 'member'. It can be NULL if there is no member dimension.} +\item{drop_dims}{A vector of character strings indicating the dimension names +of length 1 that need to be dropped in order that they don't appear in the +netCDF file. It is NULL by default (optional).} + \item{single_file}{A logical value indicating if all object is saved in a unique file (TRUE) or in separated directories (FALSE). When it is FALSE, the array is separated for Datasets, variable and start date. It is FALSE -by default.} +by default (optional).} \item{extra_string}{A character string to be include as part of the file name, for instance, to identify member or realization. It would be added to the -file name between underscore characters.} +file name between underscore characters (optional).} } \value{ Multiple or single NetCDF files containing the data array.\cr diff --git a/tests/testthat/test-CST_SaveExp.R b/tests/testthat/test-CST_SaveExp.R index 7f633270..0ed7923c 100644 --- a/tests/testthat/test-CST_SaveExp.R +++ b/tests/testthat/test-CST_SaveExp.R @@ -103,7 +103,7 @@ test_that("1. Input checks: CST_SaveExp", { # CST_SaveExp(data = cube1, ftime_dim = 'ftime', memb_dim = NULL, # dat_dim = NULL, var_dim = NULL, startdates = '20100101'), # paste0("Parameter 'startdates' doesn't have the same length ", - # "as dimension '", sdate_dim,"', it will not be used.") + # "as dimension '", 'sdate',"', it will not be used.") # ) # # metadata # expect_warning( @@ -175,6 +175,31 @@ test_that("1. Input checks", { Dates = as.Date('2022-02-01', format = "%Y-%m-%d")), paste0("Parameter 'Dates' must have dimension names.") ) + # # drop_dims + # expect_warning( + # SaveExp(data = dat2, coords = coords2, + # metadata = list(tas = list(level = '2m')), + # Dates = dates2, ftime_dim = 'ftime', memb_dim = NULL, + # dat_dim = NULL, var_dim = NULL, drop_dims = 1), + # paste0("Parameter 'drop_dims' must be character string containing ", + # "the data dimension names to be dropped. It will not be used.") + # ) + # expect_warning( + # SaveExp(data = dat2, coords = coords2, + # metadata = list(tas = list(level = '2m')), + # Dates = dates2, ftime_dim = 'ftime', memb_dim = NULL, + # dat_dim = NULL, var_dim = NULL, drop_dims = 'time'), + # paste0("Parameter 'drop_dims' must be character string containing ", + # "the data dimension names to be dropped. It will not be used.") + # ) + # expect_warning( + # SaveExp(data = dat2, coords = coords2, + # metadata = list(tas = list(level = '2m')), + # Dates = dates2, ftime_dim = 'ftime', memb_dim = NULL, + # dat_dim = NULL, var_dim = NULL, drop_dims = 'sdate'), + # paste0("Parameter 'drop_dims' can only contain dimension names ", + # "that are of length 1. It will not be used.") + # ) # # varname # expect_warning( # SaveExp(data = dat2, coords = coords2, -- GitLab From 7f5b2acac4e877590329c7f7dbb34affdc4900e0 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Tue, 26 Sep 2023 12:11:49 +0200 Subject: [PATCH 2/2] Correct adding metadata for single file --- R/CST_SaveExp.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/CST_SaveExp.R b/R/CST_SaveExp.R index 274e67f5..0f7ea2e0 100644 --- a/R/CST_SaveExp.R +++ b/R/CST_SaveExp.R @@ -843,7 +843,8 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, for (dim in names(defined_dims)) { if (dim %in% names(extra_info_dim)) { for (info_dim in names(extra_info_dim[[dim]])) { - ncatt_put(file_nc, dim, info_dim, as.character(extra_info_dim[[dim]][[info_dim]])) + add_info_dim <- paste0(extra_info_dim[[dim]][[info_dim]], collapse = ', ') + ncatt_put(file_nc, dim, info_dim, add_info_dim) } } } @@ -851,7 +852,8 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, for (var in names(defined_vars)) { if (var %in% names(extra_info_var)) { for (info_var in names(extra_info_var[[var]])) { - ncatt_put(file_nc, var, info_var, as.character(extra_info_var[[var]][[info_var]])) + add_info_var <- paste0(extra_info_var[[var]][[info_var]], collapse = ', ') + ncatt_put(file_nc, var, info_var, add_info_var) } } } -- GitLab