diff --git a/R/NcDataReader.R b/R/NcDataReader.R index 1c83d0af68c155c35bbe0dfb103342001fe3f594..25e33d412dca7545f1878b18eabe90d07e0432d4 100644 --- a/R/NcDataReader.R +++ b/R/NcDataReader.R @@ -240,58 +240,123 @@ NcDataReader <- function(file_path = NULL, file_object = NULL, # define day in each month leap_month_day <- c(31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) no_leap_month_day <- c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) - # Origin year and month - ori_year <- as.numeric(substr(parts[2], 1, 4)) - ori_month <- as.numeric(substr(parts[2], 6, 7)) - if (is.na(ori_month)) { - ori_month <- as.numeric(substr(parts[2], 6, 6)) - } - if (!is.numeric(ori_year) | !is.numeric(ori_month)) { - stop(paste0("The time unit attribute format is not 'YYYY-MM-DD' or 'YYYY-M-D'. ", - "Check the file or contact the maintainer.")) - } + # If calendar is gregorian, we get the result date directly instead of calculating how many seconds we have. + # The other calendar type can also do this but then we need to calculate each date in for loop. + #TODO: Try to use 'clock' to calculate the date (but dependency will be added) if (calendar == 'gregorian') { - # Find how many years + months - yr_num <- floor(result / 12) - month_left <- result - yr_num * 12 - # Find the leap years we care - if (ori_month <= 2) { - leap_num <- length(which(sapply(ori_year:(ori_year + yr_num - 1), s2dv::LeapYear))) - } else { - leap_num <- length(which(sapply((ori_year + 1):(ori_year + yr_num), s2dv::LeapYear))) + # Origin year and month and day + ori_year <- as.numeric(substr(parts[2], 1, 4)) + ori_month <- as.numeric(substr(parts[2], 6, 7)) + ori_day <- as.numeric(substr(parts[2], 9, 10)) + if (is.na(ori_month)) { + ori_month <- as.numeric(substr(parts[2], 6, 6)) + ori_day <- as.numeric(substr(parts[2], 8, 8)) } - total_days <- leap_num * 366 + (yr_num - leap_num) * 365 # not include month_left yet - - if (month_left != 0) { - if ((ori_month + month_left) <= 12) { # the last month is still in the same last yr - # Is the last year a leap year? - last_leap <- s2dv::LeapYear(ori_year + yr_num) - if (last_leap) { - total_days <- total_days + sum(leap_month_day[ori_month:(ori_month + month_left - 1)]) + if (!is.numeric(ori_year) | !is.numeric(ori_month) | !is.numeric(ori_day)) { + stop(paste0("The time unit attribute format is not 'YYYY-MM-DD' or 'YYYY-M-D'. ", + "Check the file or contact the maintainer.")) + } + result_vec <- rep(NA, length = length(result)) + for (result_i in 1:length(result)) { + yr_num <- floor(result[result_i] / 12) + month_left <- result[result_i] - yr_num * 12 + result_year <- ori_year + yr_num + result_month <- ori_month + floor(month_left) + result_day <- ori_day + #NOTE: Assumption that hour down is 00 + result_hour <- 0 + if (result_month > 12) { + result_year <- result_year + 1 + result_month <- result_month - 12 + } + if (month_left %% 1 != 0) { + if (result_month == 2) { + day_in_month <- ifelse(s2dv::LeapYear(result_year), 29, 28) } else { - total_days <- total_days + sum(no_leap_month_day[ori_month:(ori_month + month_left - 1)]) + day_in_month <- no_leap_month_day[result_month] } - } else { # the last month ends in the next yr - if (ori_month == 2) { # e.g., 2005-02-16 + 11mth = 2006-01-16 - last_leap <- s2dv::LeapYear(ori_year + yr_num) # still consider 2005 - if (last_leap) { - total_days <- total_days + sum(leap_month_day[2:12]) - } else { - total_days <- total_days + sum(no_leap_month_day[2:12]) - } - } else { # e.g., 2005-04-16 + 11mth = 2006-03-16 - last_leap <- s2dv::LeapYear(ori_year + yr_num + 1) - needed_month <- c(ori_month:12, 1:(ori_month + month_left - 12 - 1)) - if (last_leap) { - total_days <- total_days + sum(leap_month_day[needed_month]) - } else { - total_days <- total_days + sum(no_leap_month_day[needed_month]) - } + result_day <- ori_day + (month_left - floor(month_left)) * day_in_month + if (result_day > day_in_month) { + result_month <- result_month + 1 + result_day <- result_day - day_in_month + } + if (result_month > 12) { + result_year <- result_year + 1 + result_month <- result_month - 12 + } + # if there is hour left + if (result_day %% 1 != 0) { + result_hour <- (result_day - floor(result_day)) * 24 + result_day <- floor(result_day) + } + if (result_hour %% 1 != 0) { + warning("The time value is not correct below 'hour'.") + result_hour <- round(result_hour) } } + result_month <- sprintf("%02d", result_month) + result_day <- sprintf("%02d", result_day) + result_hour <- sprintf("%02d", result_hour) + # Combine all the parts into one string + tmp <- paste(result_year, result_month, result_day, sep = '-') + tmp <- paste0(tmp, ' ', result_hour, ':00:00') + result_vec[result_i] <- tmp } - result <- total_days * 24 * 60 * 60 # day to sec + # Transfer the strings to time class + new_array <- PCICt::as.PCICt(result_vec, cal = 'gregorian') + new_array <- suppressWarnings(PCICt::as.POSIXct.PCICt(new_array, tz = "UTC")) + +# if (calendar == 'gregorian') { +# # Find how many years + months +# yr_num <- floor(result / 12) +# month_left <- result - yr_num * 12 +# # Find the leap years we care +# if (ori_month <= 2) { +# leap_num <- length(which(sapply(ori_year:(ori_year + yr_num - 1), s2dv::LeapYear))) +# } else { +# leap_num <- length(which(sapply((ori_year + 1):(ori_year + yr_num), s2dv::LeapYear))) +# } +# total_days <- leap_num * 366 + (yr_num - leap_num) * 365 # not include month_left yet +# +# if (month_left != 0) { +##TODO: This part until result <- total_days* 24 ... is not correct. It doesn't consider ori_day +# if ((ori_month + month_left - 1) <= 12) { # the last month is still in the same last yr +# # Is the last year a leap year? +# last_leap <- s2dv::LeapYear(ori_year + yr_num) +# if (last_leap) { +# month_day_vector <- leap_month_day +# } else { +# month_day_vector <- no_leap_month_day +# } +# if (month_left >= 1) { # Only a few days in Jan. only, directly go to the next "if" +# total_days <- total_days + sum(month_day_vector[ori_month:(ori_month + month_left - 1)]) +# } +# if ((month_left %% 1) != 0) { +# # month_left has decimal point like 11.5 +# total_days <- total_days + (month_left - floor(month_left)) * month_day_vector[ceiling(month_left)] +# } +# } else { # the last month ends in the next yr +# if (ori_month == 2) { # e.g., 2005-02-16 + 11mth = 2006-01-16 +# last_leap <- s2dv::LeapYear(ori_year + yr_num) # still consider 2005 +# if (last_leap) { +# total_days <- total_days + sum(leap_month_day[2:12]) +# } else { +# total_days <- total_days + sum(no_leap_month_day[2:12]) +# } +# } else { # e.g., 2005-04-16 + 11mth = 2006-03-16 +# last_leap <- s2dv::LeapYear(ori_year + yr_num + 1) +# needed_month <- c(ori_month:12, 1:(ori_month + month_left - 12 - 1)) +# if (last_leap) { +# total_days <- total_days + sum(leap_month_day[needed_month]) +# } else { +# total_days <- total_days + sum(no_leap_month_day[needed_month]) +# } +# } +# } +# } +# result <- total_days * 24 * 60 * 60 # day to sec + } else if (calendar %in% c('365_day',' 365', 'noleap')) { yr_num <- floor(result / 12) month_left <- result - yr_num * 12 @@ -308,9 +373,10 @@ NcDataReader <- function(file_path = NULL, file_object = NULL, } } - new_array <- PCICt::as.PCICt(result, cal = calendar, origin = parts[2])[] - new_array <- suppressWarnings(PCICt::as.POSIXct.PCICt(new_array, tz = "UTC")) - + if (!(units %in% c('month', 'months') & 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 index fde9c5e49074a03fade98c02a9c9669f1b84317e..da63e53a3ef0966bf17aab6ee7c9f8af46cf92f3 100644 --- a/tests/testthat/test-Start-calendar.R +++ b/tests/testthat/test-Start-calendar.R @@ -3,7 +3,7 @@ context("Start() different calendar") test_that("1. 360_day, daily, unit = 'days since 1850-01-01'", { path_hadgem3 <- paste0('/esarchive/exp/CMIP6/dcppA-hindcast//HadGEM3-GC31-MM/', 'DCPP/MOHC/HadGEM3-GC31-MM/', - 'dcppA-hindcast/r1i1p1f2/day/$var$/gn/v20200101/', + 'dcppA-hindcast/r1i1p1f2/day/$var$/gn/v20200417/', '$var$_day_HadGEM3-GC31-MM_dcppA-hindcast_s$sdate$-r1i1p1f2_gn_$fyear$.nc') sdate <- c('2000', '2001') @@ -186,7 +186,7 @@ expect_equal( ) }) -test_that("6. standard, monthly, unit = 'months since 1870-01-16 12:00:00'", { +test_that("6. standard, monthly, unit = 'months since 1850-01-01 00:00:00'", { repos_obs <- '/esarchive/obs/ukmo/hadisst_v1.1/monthly_mean/$var$/$var$_$date$.nc' suppressWarnings( @@ -194,8 +194,8 @@ suppressWarnings( var = 'tos', date = '200505', #dates_file, time = 'all', - lat = indices(1:10), - lon = indices(1:10), + lat = indices(1), + lon = indices(1), time_across = 'date', #combine time and file_date dims merge_across_dims = TRUE, @@ -211,14 +211,37 @@ suppressWarnings( expect_equal( attr(obs, 'Variables')$common$time[1], - as.POSIXct('2005-05-01', tz = 'UTC') + as.POSIXct('2005-05-16 12:00:00', tz = 'UTC') ) expect_equal( dim(attr(obs, 'Variables')$common$time), c(time = 1) ) -}) +suppressWarnings( +data_obs <- Start(dat = repos_obs, + var = 'tos', + date = c("196011", "196012", "196101", "196102"), + latitude = indices(100), + longitude = indices(100), + synonims = list(longitude = c('lon', 'longitude'), + latitude = c('lat', 'latitude')), + return_vars = list(time = c('date'), + latitude = NULL, longitude = NULL), + retrieve = TRUE) +) + +expect_equal( +dim(attr(data_obs, 'Variables')$common$time), +c(date = 4, time = 1) +) +expect_equal( +as.character(attr(data_obs, 'Variables')$common$time), +c("1960-11-16 00:00:00", "1960-12-16 12:00:00", "1961-01-16 12:00:00", "1961-02-15 00:00:00") +) + +}) + test_that("7. proleptic_gregorian, monthly, unit = 'days since 1850-1-1 00:00:00'", { diff --git a/tests/testthat/test-Start-metadata_dims.R b/tests/testthat/test-Start-metadata_dims.R index 5e4d97252c149516d72eb7e0b6380c60d6bc01fb..ce30eec3100f661df7c99f3706af8a314597f366 100644 --- a/tests/testthat/test-Start-metadata_dims.R +++ b/tests/testthat/test-Start-metadata_dims.R @@ -433,14 +433,14 @@ path_list <- list( Had = list(name = 'HadGEM3', path = paste0('/esarchive/exp/CMIP6/dcppA-hindcast/HadGEM3-GC31-MM/', 'DCPP/MOHC/HadGEM3-GC31-MM/', - 'dcppA-hindcast/$member$/day/$var$/gn/v20200101/', + 'dcppA-hindcast/$member$/day/$var$/gn/v20200417/', '$var$_day_HadGEM3-GC31-MM_dcppA-hindcast_s$sdate$-$member$_gn_$chunk$.nc'))) suppressWarnings( data <- Start(dataset = path_list, var = 'tasmin', member = list(c('r1i1p1f1', 'r2i1p1f2')), sdate = paste0(2018), - chunk = list(c('20181101-20281231', '20181101-20281230')), + chunk = list(c('20181101-20281231', '20181101-20181230')), time = indices(1), #'all', lat = values(list(0, 14)), lon = values(list(0, 28)), @@ -484,7 +484,7 @@ data <- Start(dataset = path_list, attr(data, 'Files'), array(c("/esarchive/exp/CMIP6/dcppA-hindcast/MPI-ESM1-2-HR/DCPP/MPI-M/MPI-ESM1-2-HR/dcppA-hindcast/r1i1p1f1/day/tasmin/gn/v20200101/tasmin_day_MPI-ESM1-2-HR_dcppA-hindcast_s2018-r1i1p1f1_gn_20181101-20281231.nc", NA, NA, NA, NA, NA, NA, - "/esarchive/exp/CMIP6/dcppA-hindcast/HadGEM3-GC31-MM/DCPP/MOHC/HadGEM3-GC31-MM/dcppA-hindcast/r2i1p1f2/day/tasmin/gn/v20200101/tasmin_day_HadGEM3-GC31-MM_dcppA-hindcast_s2018-r2i1p1f2_gn_20181101-20281230.nc"), + "/esarchive/exp/CMIP6/dcppA-hindcast/HadGEM3-GC31-MM/DCPP/MOHC/HadGEM3-GC31-MM/dcppA-hindcast/r2i1p1f2/day/tasmin/gn/v20200417/tasmin_day_HadGEM3-GC31-MM_dcppA-hindcast_s2018-r2i1p1f2_gn_20181101-20181230.nc"), dim = c(dataset = 2, var = 1, member = 2, sdate = 1, chunk = 2)) )