From 39be08f703d30ef9e2d6fc7938c555898f158dc3 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 15 Mar 2023 18:02:46 +0100 Subject: [PATCH 1/2] Improve time dimensions when single_file is TRUE --- R/CST_SaveExp.R | 66 ++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 51 insertions(+), 15 deletions(-) diff --git a/R/CST_SaveExp.R b/R/CST_SaveExp.R index 2130aadd..bf3d32fc 100644 --- a/R/CST_SaveExp.R +++ b/R/CST_SaveExp.R @@ -291,11 +291,6 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, "set as FALSE.") single_file <- FALSE } - if (single_file) { - warning("Parameter 'single_file' is TRUE. Time values saved in the NetCDF ", - "file may not be consistent for all the start dates. ", - "Further development is needed, sorry for the inconvinience.") - } # extra_string if (!is.null(extra_string)) { if (!is.character(extra_string)) { @@ -629,6 +624,7 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, defined_dims <- c(new_dim, defined_dims) extra_info_dim[[dat_dim]] <- list(Datasets = paste(Datasets, collapse = ', ')) } + first_sdate <- last_sdate <- NULL if (!is.null(Dates)) { # sdate definition sdates <- Subset(Dates, along = ftime_dim, 1, drop = 'selected') @@ -639,15 +635,48 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, names(new_dim) <- sdate_dim defined_dims <- c(defined_dims, new_dim) extra_info_dim[[sdate_dim]] <- list(sdates = paste(sdates, collapse = ', ')) + first_sdate <- sdates[1] + last_sdate <- sdates[length(sdates)] # ftime definition - ftime_dates <- Subset(Dates, along = sdate_dim, 1, drop = 'selected') - differ <- as.numeric((ftime_dates - ftime_dates[1])/3600) - # DOUBT HERE: which values we take? # FIX Dates[1] for single_file = TRUE - dim_time <- list(ncdim_def(name = ftime_dim, units = paste('hours since', paste(sdates, collapse = ', ')), - vals = differ, calendar = 'proleptic_gregorian', - longname = ftime_dim, unlim = TRUE)) - names(dim_time) <- ftime_dim - defined_dims <- c(defined_dims, dim_time) + sdate_dim_pos <- which(names(dim(Dates)) == sdate_dim) + ftime_dim_pos <- which(names(dim(Dates)) == ftime_dim) + differ_ftime <- apply(Dates, sdate_dim_pos, function(x){as.numeric((x - x[1])/3600)}) + differ_ftime_subset <- Subset(differ_ftime, along = sdate_dim, 1, drop = 'selected') + if (all(apply(differ_ftime, sdate_dim_pos, function(x){length(unique(x)) == 1}))) { + if (all(diff(differ_ftime_subset/24) == 1)) { + # daily values + dim_time <- list(ncdim_def(name = ftime_dim, units = 'days', + vals = differ_ftime_subset/24, calendar = 'proleptic_gregorian', + longname = ftime_dim, unlim = TRUE)) + names(dim_time) <- ftime_dim + defined_dims <- c(defined_dims, dim_time) + } else if (all(diff(differ_ftime_subset/24) %in% c(28, 29, 30, 31))) { + # monthly values + dim_time <- list(ncdim_def(name = ftime_dim, units = 'months', + vals = round(differ_ftime_subset/730), + calendar = 'proleptic_gregorian', + longname = ftime_dim, unlim = TRUE)) + names(dim_time) <- ftime_dim + defined_dims <- c(defined_dims, dim_time) + } else { + # other frequency + dim_time <- list(ncdim_def(name = ftime_dim, units = 'hours', + vals = differ_ftime_subset, + calendar = 'proleptic_gregorian', + longname = ftime_dim, unlim = TRUE)) + names(dim_time) <- ftime_dim + defined_dims <- c(defined_dims, dim_time) + } + } else { + warning("Time steps are not equal for all start dates. Only ", + "forecast time values for the first start date will be saved ", + "correctly.") + dim_time <- list(ncdim_def(name = ftime_dim, units = paste('hours since', paste(sdates, collapse = ', ')), + vals = differ_ftime_subset, calendar = 'proleptic_gregorian', + longname = ftime_dim, unlim = TRUE)) + names(dim_time) <- ftime_dim + defined_dims <- c(defined_dims, dim_time) + } } # var definition @@ -713,9 +742,16 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, defined_vars <- c(defined_vars, new_var) } if (is.null(extra_string)) { - file_name <- paste0(paste(c(varname), collapse = '_'), ".nc") + gsub("-", "", first_sdate) + file_name <- paste0(paste(c(varname, + gsub("-", "", first_sdate), + gsub("-", "", last_sdate)), + collapse = '_'), ".nc") } else { - file_name <- paste0(paste(c(varname), collapse = '_'), "_", extra_string, ".nc") + file_name <- paste0(paste(c(varname, + gsub("-", "", first_sdate), + gsub("-", "", last_sdate), + extra_string), collapse = '_'), ".nc") } full_filename <- file.path(destination, file_name) file_nc <- nc_create(full_filename, defined_vars) -- GitLab From ff4275c54001d1067c7e88fd7a4bb70530b81dc5 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Thu, 16 Mar 2023 10:24:33 +0100 Subject: [PATCH 2/2] Improve code when single_file is TRUE and data comes from startR --- R/CST_SaveExp.R | 8 ++++---- tests/testthat/test-CST_SaveExp.R | 4 ---- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/R/CST_SaveExp.R b/R/CST_SaveExp.R index bf3d32fc..dfcc7799 100644 --- a/R/CST_SaveExp.R +++ b/R/CST_SaveExp.R @@ -638,11 +638,11 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, first_sdate <- sdates[1] last_sdate <- sdates[length(sdates)] # ftime definition - sdate_dim_pos <- which(names(dim(Dates)) == sdate_dim) - ftime_dim_pos <- which(names(dim(Dates)) == ftime_dim) - differ_ftime <- apply(Dates, sdate_dim_pos, function(x){as.numeric((x - x[1])/3600)}) + Dates <- Reorder(Dates, c(ftime_dim, sdate_dim)) + differ_ftime <- apply(Dates, 2, function(x){as.numeric((x - x[1])/3600)}) + dim(differ_ftime) <- dim(Dates) differ_ftime_subset <- Subset(differ_ftime, along = sdate_dim, 1, drop = 'selected') - if (all(apply(differ_ftime, sdate_dim_pos, function(x){length(unique(x)) == 1}))) { + if (all(apply(differ_ftime, 1, function(x){length(unique(x)) == 1}))) { if (all(diff(differ_ftime_subset/24) == 1)) { # daily values dim_time <- list(ncdim_def(name = ftime_dim, units = 'days', diff --git a/tests/testthat/test-CST_SaveExp.R b/tests/testthat/test-CST_SaveExp.R index 987f41cf..cb028d6a 100644 --- a/tests/testthat/test-CST_SaveExp.R +++ b/tests/testthat/test-CST_SaveExp.R @@ -201,10 +201,6 @@ test_that("1. Input checks", { # dat_dim = NULL, var_dim = NULL, single_file = TRUE), # "Parameter 'varname' is NULL. It will be assigned to 'X'.", # "Parameter 'metadata' is not provided so the metadata saved will be incomplete.", - # paste0("Parameter 'single_file' is TRUE. Time values saved in the NetCDF ", - # "file may not be consistent for all the start dates. ", - # "Further development of the function is needed, sorry ", - # "for the inconvinience."), # paste0("Spatial coordinate names do not match any of the names accepted by ", # "the package."), # "Detected unknown dimension: test" -- GitLab