From 89551bc8942700911cf8f15c052c978dc77faeac Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Tue, 26 Jan 2021 08:58:23 +0100 Subject: [PATCH 1/5] developing TotalTimeExceedingThreshold.R for SU family --- R/TotalTimeExceedingThreshold.R | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 R/TotalTimeExceedingThreshold.R diff --git a/R/TotalTimeExceedingThreshold.R b/R/TotalTimeExceedingThreshold.R new file mode 100644 index 0000000..2e41273 --- /dev/null +++ b/R/TotalTimeExceedingThreshold.R @@ -0,0 +1,11 @@ +#' Total Time Exceeding Threshold on 's2dv_cube' objects +#' +#'TotalTimeExceedingThreshold computes the total time (e.g. days) above/below a given threshold for a given period. +#'The threshold can be a fixed value (e.g. 35°C) or a percentile corresponding to a fixed value. +#'Providing daily temperature maximum data, the following indicators can be obtained by using this function: +#'\itemize{ +#' \item\code{SU35}{Number of Heat Stress Days - 35°C in summer: The total count of days when daily maximum temperatures exceed 35°C in the seven months into the future.} +#' \item\code{SU36}{Number of Heat Stress Days - 36°C in summer: The total count of days when daily maximum temperatures exceed 36°C from June 21st to September 21st.} + + + -- GitLab From 80a2749d1198b211012fad860c1c0decc2265621 Mon Sep 17 00:00:00 2001 From: nperez Date: Tue, 26 Jan 2021 14:51:07 +0100 Subject: [PATCH 2/5] Tests for Selecting period --- tests/testthat.R | 4 + tests/testthat/test-SelectPeriod.R | 114 +++++++++++++++++++++++++++++ 2 files changed, 118 insertions(+) create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test-SelectPeriod.R diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..79cf4a7 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(CSIndicators) + +test_check("CSIndicators") diff --git a/tests/testthat/test-SelectPeriod.R b/tests/testthat/test-SelectPeriod.R new file mode 100644 index 0000000..19b5fec --- /dev/null +++ b/tests/testthat/test-SelectPeriod.R @@ -0,0 +1,114 @@ +context("Generic tests") + #source("R/zzz.R") + #source("R/SelectPeriodOnDates.R") + #source("R/SelectPeriodOnData.R") +test_that("Decadal", { + # -------- DECADAL ----------# + # decadal: 1 sdate several consequtive years: + dates <- seq(as.Date("01-01-2000", "%d-%m-%Y", tz = 'UTC'), + as.Date("31-12-2005","%d-%m-%Y", tz = 'UTC'), "day") + # No dims -> test .position + output <- c( + seq(as.Date("2000-02-01", "%Y-%m-%d"), as.Date("2000-02-10", "%Y-%m-%d"), 'day'), + seq(as.Date("2001-02-01", "%Y-%m-%d"), as.Date("2001-02-10", "%Y-%m-%d"), 'day'), + seq(as.Date("2002-02-01", "%Y-%m-%d"), as.Date("2002-02-10", "%Y-%m-%d"), 'day'), + seq(as.Date("2003-02-01", "%Y-%m-%d"), as.Date("2003-02-10", "%Y-%m-%d"), 'day'), + seq(as.Date("2004-02-01", "%Y-%m-%d"), as.Date("2004-02-10", "%Y-%m-%d"), 'day'), + seq(as.Date("2005-02-01", "%Y-%m-%d"), as.Date("2005-02-10", "%Y-%m-%d"), 'day')) + dim(output) <- c(ftime = 60) + expect_equal( + SelectPeriodOnDates(dates, start = list(1, 2), end = list(10, 2)), + output) + data <- array(1:(length(dates)*3), + c(memb = 1, ftime = length(dates), lon = 3)) + + expect_equal( + SelectPeriodOnData(data, dates, start = list(1, 2), end = list(10, 2)), + + array(c(c(32:41, 398:407, 763:772, 1128:1137, 1493:1502, 1859:1868), + c(32:41, 398:407, 763:772, 1128:1137, 1493:1502, 1859:1868) + 2192, + c(32:41, 398:407, 763:772, 1128:1137, 1493:1502, 1859:1868) + 2 * 2192), + c(ftime = 60, memb = 1, lon = 3))) + + output2 <- c( + seq(as.Date("2000-02-01", "%Y-%m-%d"), as.Date("2000-04-10", "%Y-%m-%d"), 'day'), + seq(as.Date("2001-02-01", "%Y-%m-%d"), as.Date("2001-04-10", "%Y-%m-%d"), 'day'), + seq(as.Date("2002-02-01", "%Y-%m-%d"), as.Date("2002-04-10", "%Y-%m-%d"), 'day'), + seq(as.Date("2003-02-01", "%Y-%m-%d"), as.Date("2003-04-10", "%Y-%m-%d"), 'day'), + seq(as.Date("2004-02-01", "%Y-%m-%d"), as.Date("2004-04-10", "%Y-%m-%d"), 'day'), + seq(as.Date("2005-02-01", "%Y-%m-%d"), as.Date("2005-04-10", "%Y-%m-%d"), 'day')) + dim(output2) <- c(ftime = 416) + expect_equal( + SelectPeriodOnDates(dates, start = list(1, 2), end = list(10, 4)), + output2) + + expect_equal( + SelectPeriodOnData(data, dates, start = list(1, 2), end = list(10, 4)), + array(c(c(32:101, 398:466, 763:831, 1128:1196, 1493:1562, 1859:1927), + c(32:101, 398:466, 763:831, 1128:1196, 1493:1562, 1859:1927) + 2192, + c(32:101, 398:466, 763:831, 1128:1196, 1493:1562, 1859:1927) + 2 * 2192), + c(ftime = 416, memb = 1, lon = 3))) + + # 1 dim -> test Apply + dim(dates) <- c(ftime = length(dates)) + expect_equal( + SelectPeriodOnDates(dates, start = list(1, 2), end = list(10, 2)), + output) # no need to check on Data, repited + expect_equal( + SelectPeriodOnDates(dates, start = list(1, 2), end = list(10, 4)), + output2) # no need to check on Data, repited + + # decadal: 5 sdates several consequtive years + dates <- rep(seq(as.Date("01-01-2000", "%d-%m-%Y", tz = 'UTC'), + as.Date("31-12-2005","%d-%m-%Y", tz = 'UTC'), "day"), 5) + dim(dates) <- c(ftime = 2192, sdate = 5) + output3 <- rep(output, 5) + dim(output3) <- c(ftime = 60, sdate = 5) + expect_equal( + SelectPeriodOnDates(dates, start = list(1, 2), end = list(10, 2)), + output3) + + data <- array(1:(length(dates)*3), + c(memb = 1, sdate = 5, ftime = length(dates)/5, lon = 3)) + expect_equal( #To be extended for all sdate dimensions: + SelectPeriodOnData(data, dates, start = list(1, 2), end = list(10, 2))[,1,1,1], + c(1:10 * 5 + 151, 1:10 * 5 + 1981, 1:10 * 5 + 3806, + 1:10 * 5 + 5631, 1:10 * 5 + 7456, 1:10 * 5 + 9286)) + output4 <- rep(output2, 5) + dim(output4) <- c(ftime = 416, sdate = 5) + expect_equal( + SelectPeriodOnDates(dates, start = list(1, 2), end = list(10, 4)), + output4) + + expect_equal( #To be extended for all ftime dimensions: + SelectPeriodOnData(data, dates, start = list(1, 2), end = list(10, 4))[1,1,,1], + 156:160) + + # Multiple dims: sdate, fyear, ftime + library(CSTools) + dates <- SplitDim(dates, indices = dates[,1], + split_dim = 'ftime', freq = 'year') + dates <- as.POSIXct(dates * 24 * 3600, origin = '1970-01-01', tz = 'UTC') + output5 <- SplitDim(output3, indices = output3[,1], split_dim = 'ftime' , freq = 'year') + output5 <- as.POSIXct(output5 * 24 * 3600, origin = '1970-01-01', tz = 'UTC') + expect_equal( + SelectPeriodOnDates(dates, start = list(1, 2), end = list(10, 2)), + output5) + data <- array(1:(366*6*5*3), + c(memb = 1, sdate = 5, year = 6, ftime = 366, lon = 3)) + expect_equal( + SelectPeriodOnData(data, dates, start = list(1, 2), end = list(10, 2)), + InsertDim(Reorder(data[,,,32:41,], c('ftime', 'sdate', 'year', 'lon')), + len = 1, pos = 2, name = 'memb')) + output6 <- SplitDim(output4, indices = output4[,1], split_dim = 'ftime' , freq = 'year') + output6 <- as.POSIXct(output6 * 24 * 3600, origin = '1970-01-01', tz = 'UTC') + expect_equal( + SelectPeriodOnDates(dates, start = list(1, 2), end = list(10, 4)), + output6) + #expect_equal( # to be fixed: + # SelectPeriodOnData(data, dates, start = list(1, 2), end = list(10, 4)), + # (931:935), outer(seq(931, 3001, 30), 0:4, '+') + # InsertDim(Reorder(data[,,,32:41,], c('ftime', 'sdate', 'year', 'lon')), + # len = 1, pos = 2, name = 'memb')) +}) + -- GitLab From b23291255fef937e600dd79c484b18fb6b8914f1 Mon Sep 17 00:00:00 2001 From: nperez Date: Tue, 26 Jan 2021 14:54:28 +0100 Subject: [PATCH 3/5] add library s2dv --- tests/testthat/test-SelectPeriod.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-SelectPeriod.R b/tests/testthat/test-SelectPeriod.R index 19b5fec..2451a84 100644 --- a/tests/testthat/test-SelectPeriod.R +++ b/tests/testthat/test-SelectPeriod.R @@ -2,6 +2,7 @@ context("Generic tests") #source("R/zzz.R") #source("R/SelectPeriodOnDates.R") #source("R/SelectPeriodOnData.R") + library(s2dv) test_that("Decadal", { # -------- DECADAL ----------# # decadal: 1 sdate several consequtive years: -- GitLab From 035757c613f2f1a798cd5ccdfd19324aba1489d6 Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Thu, 28 Jan 2021 07:15:37 +0100 Subject: [PATCH 4/5] CST_SelectPeriodOnData.R added --- R/SelectPeriodOnData.R | 69 ++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 67 insertions(+), 2 deletions(-) diff --git a/R/SelectPeriodOnData.R b/R/SelectPeriodOnData.R index d0dbb60..8cec416 100644 --- a/R/SelectPeriodOnData.R +++ b/R/SelectPeriodOnData.R @@ -1,4 +1,65 @@ -#' Select a period on Dates +#' Select a period on Data on 's2dv_cube' objects +#' +#' Auxiliary function to subset data for a specific period. +#' +#'@param data an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools. +#'@param start a parameter to defined the initial date of the period to select from the data by providing a list of two elements: the initial date of the period and the initial month of the period. +#'@param end a parameter to defined the final date of the period to select from the data by providing a list of two elements: the final day of the period and the final month of the period. +#'@param time_dim a character string indicating the name of the dimension to compute select the dates. By default, it is set to 'ftime'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified. +#'@param ncores an integer indicating the number of cores to use in parallel computation. +#' +#'@return A 's2dv_cube' object containing the subset of the object \code{data$data} during the period requested from \code{start} to \code{end}. +#' +#'@import multiApply +#' +#'@examples +#'exp <- CSTools::lonlat_prec +#'exp$data <- array(rnorm(5 * 3 * 214 * 2), +#' c(memb = 5, sdate = 3, ftime = 214, lon = 2)) +#'exp$Dates[[1]] <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), +#' as.Date("30-11-2000", format = "%d-%m-%Y"), by = 'day'), +#' seq(as.Date("01-05-2001", format = "%d-%m-%Y"), +#' as.Date("30-11-2001", format = "%d-%m-%Y"), by = 'day'), +#' seq(as.Date("01-05-2002", format = "%d-%m-%Y"), +#' as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day')) +#'Period <- CST_SelectPeriodOnData(exp, start = list(21, 6), end = list(21, 9)) +#'all.equal(exp$data[1,1,52:144,1], Period$data[,1,1,1]) +#'all.equal(exp$data[1,2,52:144,1], Period$data[,1,2,1]) +#'@export +CST_SelectPeriodOnData <- function(data, start, end, time_dim = 'ftime', ncores = NULL) { + if (!inherits(data, 's2dv_cube')) { + stop("Parameter 'data' must be of the class 's2dv_cube', ", + "as output by CSTools::CST_Load.") + } + # when subsetting is needed, dimensions are also needed: + if (!is.null(start) && !is.null(end)) { + if (is.null(dim(data$Dates$start))) { + if (length(data$Dates$start) != dim(data$data)[time_dim]) { + if (length(data$Dates$start) == + prod(dim(data$data)[time_dim] * dim(data$data)['sdate'])) { + dim(data$Dates$start) <- c(dim(data$data)[time_dim], + dim(data$data)['sdate']) + } + } else { + warning("Dimensions in 'data' element 'Dates$start' are missed and", + "all data would be used.") + } + } + } + res <- SelectPeriodOnData(data$data, data$Dates[[1]], + start = start, end = end, + time_dim = time_dim, ncores = ncores) + data$data <- res + if (!is.null(start) && !is.null(end)) { + data$Dates <- SelectPeriodOnDates(dates = data$Dates[[1]], + start = start, end = end, + time_dim = time_dim, ncores = ncores) + } + return(data) +} + + +#' Select a period on Data on multidimensional array objects #' #' Auxiliary function to subset data for a specific period. #' @@ -22,7 +83,11 @@ #' as.Date("30-11-2001", format = "%d-%m-%Y"), by = 'day'), #' seq(as.Date("01-05-2002", format = "%d-%m-%Y"), #' as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day')) -#'Period <- SelectPeriodOnDates(Dates, start = list(21, 6), end = list(21, 9)) +#'dim(Dates) <- c(ftime = 214, sdate = 3) +#'Period <- SelectPeriodOnData(data, Dates, start = list(21, 6), end = list(21, 9)) +#'all.equal(data[1,1,52:144,1], res[,1,1,1]) +#'all.equal(data[1,2,52:144,1], res[,1,2,1]) +#' #'@export SelectPeriodOnData <- function(data, dates, start, end, time_dim = 'ftime', ncores = NULL) { -- GitLab From bbaadbf829ce8f87905b8583439c8f4aee06cd2f Mon Sep 17 00:00:00 2001 From: Chihchung Chou Date: Thu, 28 Jan 2021 10:24:02 +0100 Subject: [PATCH 5/5] two tests for seasonal forecasts added --- tests/testthat/test-SelectPeriod.R | 63 ++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) diff --git a/tests/testthat/test-SelectPeriod.R b/tests/testthat/test-SelectPeriod.R index 2451a84..5716b1a 100644 --- a/tests/testthat/test-SelectPeriod.R +++ b/tests/testthat/test-SelectPeriod.R @@ -113,3 +113,66 @@ test_that("Decadal", { # len = 1, pos = 2, name = 'memb')) }) + +test_that("Seasonal", { + # 1 start month, select the required 'ftime' of each 'sdate' in-between the entire timeseries + dates <- c(seq(as.Date("01-04-2000", format = "%d-%m-%Y"), + as.Date("31-10-2000", format = "%d-%m-%Y"), by = 'day'), + seq(as.Date("01-04-2001", format = "%d-%m-%Y"), + as.Date("31-10-2001", format = "%d-%m-%Y"), by = 'day'), + seq(as.Date("01-04-2002", format = "%d-%m-%Y"), + as.Date("31-10-2002", format = "%d-%m-%Y"), by = 'day'), + seq(as.Date("01-04-2003", format = "%d-%m-%Y"), + as.Date("31-10-2003", format = "%d-%m-%Y"), by = 'day')) + + output <- c(seq(as.Date("21-04-2000", format = "%d-%m-%Y"), + as.Date("21-06-2000", format = "%d-%m-%Y"), by = 'day'), + seq(as.Date("21-04-2001", format = "%d-%m-%Y"), + as.Date("21-06-2001", format = "%d-%m-%Y"), by = 'day'), + seq(as.Date("21-04-2002", format = "%d-%m-%Y"), + as.Date("21-06-2002", format = "%d-%m-%Y"), by = 'day'), + seq(as.Date("21-04-2003", format = "%d-%m-%Y"), + as.Date("21-06-2003", format = "%d-%m-%Y"), by = 'day')) + dim(output) <- c(ftime = (30 - 20 + 31 + 21) * 4) + expect_equal( + SelectPeriodOnDates(dates, start = list(21, 4), end = list(21, 6)), + output) + + # following the above case, and select the data + data <- array(1:(5 * 4 * 214 * 2), + c(memb = 5, sdate = 4, ftime = 214, lon = 2)) + dim(dates) <- c(ftime = 214, sdate = 4) + + expect_equal( + SelectPeriodOnData(data, dates, start = list(21, 4), end = list(21, 6))[,1,1,1], + data[1,1,21:82,1]) + + +# when selecting the days across two years + dates <- seq(as.Date("2000-01-01", "%Y-%m-%d"), as.Date("2003-12-31", "%Y-%m-%d"), 'day') + + output1 <- c(seq(as.Date("01-01-2000", format = "%d-%m-%Y"), + as.Date("31-01-2000", format = "%d-%m-%Y"), by = 'day'), + seq(as.Date("01-12-2000", format = "%d-%m-%Y"), + as.Date("31-01-2001", format = "%d-%m-%Y"), by = 'day'), + seq(as.Date("01-12-2001", format = "%d-%m-%Y"), + as.Date("31-01-2002", format = "%d-%m-%Y"), by = 'day'), + seq(as.Date("01-12-2002", format = "%d-%m-%Y"), + as.Date("31-01-2003", format = "%d-%m-%Y"), by = 'day'), + seq(as.Date("01-12-2003", format = "%d-%m-%Y"), + as.Date("31-12-2003", format = "%d-%m-%Y"), by = 'day')) + dim(output1) <- c(ftime = 31 * 8) + + expect_equal( + SelectPeriodOnDates(dates, start = list(1, 12), end = list(31, 1)), + output1) + # following the above case, and select the data + data1 <- array(1:(length(dates) * 2), + c(memb = 1, ftime = length(dates), lon = 2)) + expect_equal( + SelectPeriodOnData(data1, dates, start = list(1, 12), end = list(31, 1)), + array(c(c(1:31, 336:397, 701:762, 1066:1127, 1431:1461), + c(1:31, 336:397, 701:762, 1066:1127, 1431:1461) + 1461), + c(ftime = 31 * 8, memb = 1, lon = 2))) +}) + -- GitLab