From a4170dd8ead20cdf3b43f2c1f6fd949d1b3f8ef6 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 9 Dec 2020 17:05:49 +0100 Subject: [PATCH] Use PCICt to transfer numeric to dates --- DESCRIPTION | 3 +- NAMESPACE | 1 + R/NcDataReader.R | 32 ++++-- tests/testthat/test-Start-calendar.R | 148 +++++++++++++++++++++++++++ 4 files changed, 173 insertions(+), 11 deletions(-) create mode 100644 tests/testthat/test-Start-calendar.R diff --git a/DESCRIPTION b/DESCRIPTION index bf0ed00..f501e90 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -28,7 +28,8 @@ Imports: parallel, easyNCDF, s2dverification, - ClimProjDiags + ClimProjDiags, + PCICt Suggests: stats, utils diff --git a/NAMESPACE b/NAMESPACE index a3ad75f..ccf783c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -16,6 +16,7 @@ export(Start) export(Step) export(indices) export(values) +import(PCICt) import(abind) import(bigmemory) import(easyNCDF) diff --git a/R/NcDataReader.R b/R/NcDataReader.R index 0dfe0b2..74df355 100644 --- a/R/NcDataReader.R +++ b/R/NcDataReader.R @@ -43,7 +43,7 @@ #' first_round_indices, synonims) #'@seealso \code{\link{NcOpener}} \code{\link{NcDimReader}} #' \code{\link{NcCloser}} \code{\link{NcVarReader}} -#'@import easyNCDF +#'@import easyNCDF PCICt #'@export NcDataReader <- function(file_path = NULL, file_object = NULL, file_selectors = NULL, inner_indices = NULL, @@ -182,32 +182,44 @@ NcDataReader <- function(file_path = NULL, file_object = NULL, x } }) + if (length(names(attr(result, 'variables'))) == 1) { var_name <- names(attr(result, 'variables')) units <- attr(result, 'variables')[[var_name]][['units']] + if (units %in% c('seconds', 'minutes', 'hours', 'days', 'weeks', 'months', 'years')) { if (units == 'seconds') { - units <- 'secs' +# units <- 'secs' } else if (units == 'minutes') { - units <- 'mins' +# units <- 'mins' + result <- result * 60 # min to sec } result[] <- paste(result[], units) + } else if (grepl(' since ', units)) { parts <- strsplit(units, ' since ')[[1]] units <- parts[1] + if (units %in% c('second', 'seconds')) { - units <- 'secs' +# units <- 'secs' } else if (units %in% c('minute', 'minutes')) { - units <- 'mins' - } else if (units == 'day') { - units <- 'days' +# units <- 'mins' + result <- result * 60 # min to sec + } else if (units %in% c('day', 'days')) { +# units <- 'days' + result <- result * 24 * 60 * 60 # day to sec } else if (units %in% c('month', 'months')) { result <- result * 30.5 - units <- 'days' + result <- result * 24 * 60 * 60 # day to sec +# units <- 'days' } - new_array <- rep(as.POSIXct(parts[2], tz = 'UTC'), length(result)) + - as.difftime(result[], units = units) + # Find the calendar + calendar <- attr(result, 'variables')$time$calendar + if (calendar == 'standard') calendar <- 'gregorian' + new_array <- PCICt::as.PCICt(result, cal = calendar, origin = parts[2])[] + new_array <- suppressWarnings(PCICt::as.POSIXct.PCICt(new_array, tz = "UTC")) + #new_array <- seq(as.POSIXct(parts[2]), # length = max(result, na.rm = TRUE) + 1, # by = units)[result[] + 1] diff --git a/tests/testthat/test-Start-calendar.R b/tests/testthat/test-Start-calendar.R new file mode 100644 index 0000000..2653920 --- /dev/null +++ b/tests/testthat/test-Start-calendar.R @@ -0,0 +1,148 @@ +context("Start() different calendar") + +test_that("1. 360_day, daily", { + + path_hadgem3 <- paste0('/esarchive/exp/CMIP6/dcppA-hindcast/hadgem3-gc31-mm/', + 'cmip6-dcppA-hindcast_i1p1/DCPP/MOHC/HadGEM3-GC31-MM/', + 'dcppA-hindcast/r1i1p1f2/day/$var$/gn/v20200101/', + '$var$_day_HadGEM3-GC31-MM_dcppA-hindcast_s$sdate$-r1i1p1f2_gn_$fyear$.nc') + + sdate <- c('2000', '2001') + fyear_hadgem3 <- indices(1) + + suppressWarnings( + data <- Start(dat = path_hadgem3, + var = 'tasmax', + sdate = sdate, + fyear = fyear_hadgem3, + fyear_depends = 'sdate', + time = indices(1:3), + lat = indices(1), lon = indices(1), + return_vars = list(lat = 'dat', lon = 'dat', time = 'sdate'), + retrieve = FALSE) + ) + +expect_equal( + dim(attr(data, 'Variables')$common$time), + c(sdate = 2, time = 3) +) + time <- c(as.POSIXct('2000-11-01 12:00:00', tz = 'UTC'), + as.POSIXct('2000-11-02 12:00:00', tz = 'UTC'), + as.POSIXct('2000-11-03 12:00:00', tz = 'UTC')) + attr(time, "tzone") <- "UTC" +expect_equal( + attr(data, 'Variables')$common$time[1, ], + time +) + time <- c( + as.POSIXct('2001-11-01 12:00:00', tz = 'UTC'), + as.POSIXct('2001-11-02 12:00:00', tz = 'UTC'), + as.POSIXct('2001-11-03 12:00:00', tz = 'UTC')) + attr(time, "tzone") <- "UTC" +expect_equal( + attr(data, 'Variables')$common$time[2, ], + time +) + + +}) + +test_that("2. 365_day, daily", { +path_bcc_csm2 <- '/esarchive/exp/CMIP6/dcppA-hindcast/bcc-csm2-mr/cmip6-dcppA-hindcast_i1p1/DCPP/BCC/BCC-CSM2-MR/dcppA-hindcast/r1i1p1f1/day/$var$/gn/v20200408/$var$_day_BCC-CSM2-MR_dcppA-hindcast_s$sdate$-r1i1p1f1_gn_19800101-19891231.nc' + + data <- Start(dat = path_bcc_csm2, + var = 'tasmax', + sdate = '1980', + time = indices(1:3), + lat = indices(1), + lon = indices(1), + return_vars = list(lat = 'dat', lon = 'dat', time = 'sdate'), + retrieve = FALSE) + +expect_equal( + dim(attr(data, 'Variables')$common$time), + c(sdate = 1, time = 3) +) + time <- c(as.POSIXct('1980-01-01 12:00:00', tz = 'UTC'), + as.POSIXct('1980-01-02 12:00:00', tz = 'UTC'), + as.POSIXct('1980-01-03 12:00:00', tz = 'UTC')) + attr(time, "tzone") <- "UTC" +expect_equal( + attr(data, 'Variables')$common$time[1, ], + time +) + + +}) + + +test_that("3. gregorian/standard, daily", { + + path_mpi_esm <- paste0('/esarchive/exp/CMIP6/dcppA-hindcast/mpi-esm1-2-hr/', + 'cmip6-dcppA-hindcast_i1p1/DCPP/MPI-M/MPI-ESM1-2-HR/', + 'dcppA-hindcast/r1i1p1f1/day/$var$/gn/v20200101/', + '$var$_day_MPI-ESM1-2-HR_dcppA-hindcast_s$sdate$-r1i1p1f1_gn_$fyear$.nc') + + var <- 'tasmax' + sdate <- '2000' + fyear_mpi_esm <- paste0(sdate, '1101-', as.numeric(sdate) + 10, '1231') + + data <- Start(dat = path_mpi_esm, + var = var, + sdate = sdate, + fyear = fyear_mpi_esm, + fyear_depends = 'sdate', + time = indices(1:3), + lat = indices(1), + lon = indices(1), + return_vars = list(lat = 'dat', lon = 'dat', time = 'sdate'), + retrieve = FALSE) + +expect_equal( + dim(attr(data, 'Variables')$common$time), + c(sdate = 1, time = 3) +) + time <- c(as.POSIXct('2000-11-01 12:00:00', tz = 'UTC'), + as.POSIXct('2000-11-02 12:00:00', tz = 'UTC'), + as.POSIXct('2000-11-03 12:00:00', tz = 'UTC')) + attr(time, "tzone") <- "UTC" +expect_equal( + attr(data, 'Variables')$common$time[1, ], + time +) + + +}) + +test_that("4. gregorian/standard, monthly", { + + path_mpi_esm <- paste0('/esarchive/exp/CMIP6/dcppA-hindcast/mpi-esm1-2-hr/', + 'cmip6-dcppA-hindcast_i1p1/DCPP/MPI-M/MPI-ESM1-2-HR/', + 'dcppA-hindcast/r1i1p1f1/Amon/$var$/gn/v20200320/', + '$var$_Amon_MPI-ESM1-2-HR_dcppA-hindcast_s$sdate$-r1i1p1f1_gn_200011-201012.nc') + sdate <- '2000' + fyear_mpi_esm <- paste0(sdate, '1101-', as.numeric(sdate) + 10, '1231') + + data <- Start(dat = path_mpi_esm, + var = 'tasmax', + sdate = '2000', + time = indices(1:3), + lat = indices(1), + lon = indices(1), + return_vars = list(lat = 'dat', lon = 'dat', time = 'sdate'), + retrieve = FALSE) + +expect_equal( + dim(attr(data, 'Variables')$common$time), + c(sdate = 1, time = 3) +) + time <- c(as.POSIXct('2000-11-16 00:00:00', tz = 'UTC'), + as.POSIXct('2000-12-16 12:00:00', tz = 'UTC'), + as.POSIXct('2001-01-16 12:00:00', tz = 'UTC')) + attr(time, "tzone") <- "UTC" +expect_equal( + attr(data, 'Variables')$common$time[1, ], + time +) + +}) -- GitLab