From 9386a9cbd635e744228970c88b001436b924b5b0 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 20 Dec 2022 11:44:27 +0100 Subject: [PATCH 1/2] Add sanity checks to prevent exceeding month selection --- R/Season.R | 25 ++++++++++++++++++------- man/Season.Rd | 17 +++++++++-------- tests/testthat/test-Season.R | 20 ++++++++++++++++++++ 3 files changed, 47 insertions(+), 15 deletions(-) diff --git a/R/Season.R b/R/Season.R index 086dc52..152ebbe 100644 --- a/R/Season.R +++ b/R/Season.R @@ -1,4 +1,4 @@ -#'Compute seasonal mean +#'Compute seasonal mean or other calculations #' #'Compute the seasonal mean (or other methods) on monthly time series along #'one dimension of a named multi-dimensional arrays. Partial season is not @@ -6,13 +6,14 @@ #' #'@param data A named numeric array with at least one dimension 'time_dim'. #'@param time_dim A character string indicating the name of dimension along -#' which the seasonal means are computed. The default value is 'ftime'. +#' which the seasonal mean or other calculations are computed. The default +#' value is 'ftime'. #'@param monini An integer indicating what the first month of the time series is. #' It can be from 1 to 12. -#'@param moninf An integer indicating the starting month of the seasonal mean. +#'@param moninf An integer indicating the starting month of the seasonal +#' calculation. It can be from 1 to 12. +#'@param monsup An integer indicating the end month of the seasonal calculation. #' It can be from 1 to 12. -#'@param monsup An integer indicating the end month of the seasonal mean. It -#' can be from 1 to 12. #'@param method An R function to be applied for seasonal calculation. For #' example, 'sum' can be used for total precipitation. The default value is mean. #'@param na.rm A logical value indicating whether to remove NA values along @@ -26,12 +27,12 @@ #' #'@examples #'set.seed(1) -#'dat1 <- array(rnorm(144*3), dim = c(member = 2, sdate = 2, ftime = 12*3, lon = 3)) +#'dat1 <- array(rnorm(144 * 3), dim = c(member = 2, sdate = 2, ftime = 12*3, lon = 3)) #'res <- Season(data = dat1, monini = 1, moninf = 1, monsup = 2) #'res <- Season(data = dat1, monini = 10, moninf = 12, monsup = 2) #'dat2 <- dat1 #'set.seed(2) -#'na <- floor(runif(30, min = 1, max = 144*3)) +#'na <- floor(runif(30, min = 1, max = 144 * 3)) #'dat2[na] <- NA #'res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2) #'res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2, na.rm = FALSE) @@ -86,6 +87,16 @@ Season <- function(data, time_dim = 'ftime', monini, moninf, monsup, stop("Parameter 'monsup' must be a positive integer between 1 and 12.") } } + ## time_dim, monini, moninf, monsup + mon_gap <- ifelse(moninf >= monini, moninf - monini, moninf + 12 - monini) + if ((mon_gap + 1) > dim(data)[time_dim]) { + stop("Parameter 'moninf' is out of the range because 'monini' is ", monini, + " and time dimenision length is ", as.numeric(dim(data)[time_dim]), ".") + } + mon_diff <- ifelse(monsup > moninf, monsup - moninf, monsup + 12 - moninf) + if ((mon_gap + mon_diff + 1) > dim(data)[time_dim]) { + stop("The chosen month length exceeds the time dimension of 'data'.") + } ## method if (!is.function(method)) { stop("Parameter 'method' should be an existing R function, e.g., mean or sum.") diff --git a/man/Season.Rd b/man/Season.Rd index 3c1e3ff..fccd9ff 100644 --- a/man/Season.Rd +++ b/man/Season.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/Season.R \name{Season} \alias{Season} -\title{Compute seasonal mean} +\title{Compute seasonal mean or other calculations} \usage{ Season( data, @@ -19,16 +19,17 @@ Season( \item{data}{A named numeric array with at least one dimension 'time_dim'.} \item{time_dim}{A character string indicating the name of dimension along -which the seasonal means are computed. The default value is 'ftime'.} +which the seasonal mean or other calculations are computed. The default +value is 'ftime'.} \item{monini}{An integer indicating what the first month of the time series is. It can be from 1 to 12.} -\item{moninf}{An integer indicating the starting month of the seasonal mean. -It can be from 1 to 12.} +\item{moninf}{An integer indicating the starting month of the seasonal +calculation. It can be from 1 to 12.} -\item{monsup}{An integer indicating the end month of the seasonal mean. It -can be from 1 to 12.} +\item{monsup}{An integer indicating the end month of the seasonal calculation. +It can be from 1 to 12.} \item{method}{An R function to be applied for seasonal calculation. For example, 'sum' can be used for total precipitation. The default value is mean.} @@ -51,12 +52,12 @@ accounted. } \examples{ set.seed(1) -dat1 <- array(rnorm(144*3), dim = c(member = 2, sdate = 2, ftime = 12*3, lon = 3)) +dat1 <- array(rnorm(144 * 3), dim = c(member = 2, sdate = 2, ftime = 12*3, lon = 3)) res <- Season(data = dat1, monini = 1, moninf = 1, monsup = 2) res <- Season(data = dat1, monini = 10, moninf = 12, monsup = 2) dat2 <- dat1 set.seed(2) -na <- floor(runif(30, min = 1, max = 144*3)) +na <- floor(runif(30, min = 1, max = 144 * 3)) dat2[na] <- NA res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2) res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2, na.rm = FALSE) diff --git a/tests/testthat/test-Season.R b/tests/testthat/test-Season.R index 0b009a6..f9bfc43 100644 --- a/tests/testthat/test-Season.R +++ b/tests/testthat/test-Season.R @@ -15,6 +15,10 @@ context("s2dv::Season tests") set.seed(1) dat3 <- array(rnorm(12), dim = c(ftime = 12)) + # dat4 + set.seed(1) + dat4 <- array(rnorm(16), dim = c(sdate = 2, ftime = 8)) + ############################################## test_that("1. Input checks", { @@ -54,6 +58,22 @@ test_that("1. Input checks", { Season(dat1, monini = 1, moninf = 1, monsup = 'Jan'), "Parameter 'monsup' must be a positive integer between 1 and 12." ) + expect_error( + Season(dat4, monini = 1, moninf = 9, monsup = 10), + "Parameter 'moninf' is out of the range because 'monini' is 1 and time dimenision length is 8." + ) + expect_error( + Season(dat4, monini = 11, moninf = 9, monsup = 10), + "Parameter 'moninf' is out of the range because 'monini' is 11 and time dimenision length is 8." + ) + expect_error( + Season(dat4, monini = 1, moninf = 2, monsup = 9), + "The chosen month length exceeds the time dimension of 'data'." + ) + expect_error( + Season(dat4, monini = 11, moninf = 12, monsup = 7), + "The chosen month length exceeds the time dimension of 'data'." + ) expect_error( Season(dat1, monini = 1, moninf = 1, monsup = 2, method = 'mean'), "Parameter 'method' should be an existing R function, e.g., mean or sum." -- GitLab From 21730041c24468150f484eee57d77fee6e46e7c7 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 22 Dec 2022 05:36:55 +0100 Subject: [PATCH 2/2] Correct check when moninf = monsup --- R/Season.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Season.R b/R/Season.R index 152ebbe..1425d59 100644 --- a/R/Season.R +++ b/R/Season.R @@ -93,7 +93,7 @@ Season <- function(data, time_dim = 'ftime', monini, moninf, monsup, stop("Parameter 'moninf' is out of the range because 'monini' is ", monini, " and time dimenision length is ", as.numeric(dim(data)[time_dim]), ".") } - mon_diff <- ifelse(monsup > moninf, monsup - moninf, monsup + 12 - moninf) + mon_diff <- ifelse(monsup >= moninf, monsup - moninf, monsup + 12 - moninf) if ((mon_gap + mon_diff + 1) > dim(data)[time_dim]) { stop("The chosen month length exceeds the time dimension of 'data'.") } -- GitLab