From 18c77dfe194af21ea7f877dbde1f3b19215538dd Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 21 Jun 2023 16:28:29 +0200 Subject: [PATCH 1/5] Add functions to compute bioclimatic indicators; add unit tests --- R/PeriodFun.R | 190 +++++++++++++++++++++++ R/PeriodMax.R | 205 +++++++++++++++++++++++++ R/PeriodMin.R | 205 +++++++++++++++++++++++++ R/PeriodVariance.R | 219 +++++++++++++++++++++++++++ tests/testthat/test-PeriodFun.R | 120 +++++++++++++++ tests/testthat/test-PeriodMax.R | 123 +++++++++++++++ tests/testthat/test-PeriodMin.R | 119 +++++++++++++++ tests/testthat/test-PeriodVariance.R | 118 +++++++++++++++ 8 files changed, 1299 insertions(+) create mode 100644 R/PeriodFun.R create mode 100644 R/PeriodMax.R create mode 100644 R/PeriodMin.R create mode 100644 R/PeriodVariance.R create mode 100644 tests/testthat/test-PeriodFun.R create mode 100644 tests/testthat/test-PeriodMax.R create mode 100644 tests/testthat/test-PeriodMin.R create mode 100644 tests/testthat/test-PeriodVariance.R diff --git a/R/PeriodFun.R b/R/PeriodFun.R new file mode 100644 index 0000000..9c33ba2 --- /dev/null +++ b/R/PeriodFun.R @@ -0,0 +1,190 @@ +#'Period Function on 's2dv_cube' objects +#' +#'Period Fun computes a calculation of a given variable in a period. +#' +#'@param data An 's2dv_cube' object as provided function \code{CST_Load} in +#' package CSTools. +#'@param fun An atomic function to compute a calculation over a period. +#'@param start An optional 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. By default it is set +#' to NULL and the indicator is computed using all the data provided in +#' \code{data}. +#'@param end An optional 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. By default it is set to NULL +#' and the indicator is computed using all the data provided in \code{data}. +#'@param time_dim A character string indicating the name of the dimension to +#' compute the indicator. 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 na.rm A logical value indicating whether to ignore NA values (TRUE) or +#' not (FALSE). +#'@param ncores An integer indicating the number of cores to use in parallel +#' computation. +#' +#'@return An 's2dv_cube' object containing the indicator in the element +#'\code{data} with dimensions of the input parameter 'data' except the +#'dimension where the mean has been computed (specified with 'time_dim'). A new +#'element called 'time_bounds' will be added into the 'attrs' element in the +#''s2dv_cube' object. It consists of a list containing two elements, the start +#'and end dates of the aggregated period with the same dimensions of 'Dates' +#'element. +#' +#'@examples +#'exp <- NULL +#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2002-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2002-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) +#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'exp$attrs$Dates <- Dates +#'class(exp) <- 's2dv_cube' +#' +#'SA <- CST_PeriodFun(exp, fun = mean, start = list(01, 12), +#' end = list(01, 01)) +#' +#'@import multiApply +#'@importFrom ClimProjDiags Subset +#'@export +CST_PeriodFun <- function(data, fun, start = NULL, end = NULL, + time_dim = 'ftime', na.rm = FALSE, + ncores = NULL) { + # Check 's2dv_cube' + if (!inherits(data, 's2dv_cube')) { + stop("Parameter 'data' must be of the class 's2dv_cube'.") + } + # Dates subset + if (!is.null(start) && !is.null(end)) { + if (is.null(dim(data$attrs$Dates))) { + warning("Dimensions in 'data' element 'attrs$Dates' are missed and ", + "all data would be used.") + start <- NULL + end <- NULL + } + } + + Dates <- data$attrs$Dates + total <- PeriodFun(data = data$data, fun = fun, dates = Dates, start = start, + end = end, time_dim = time_dim, na.rm = na.rm, + ncores = ncores) + + data$data <- total + data$dims <- dim(total) + + if (!is.null(Dates)) { + if (!is.null(start) && !is.null(end)) { + Dates <- SelectPeriodOnDates(dates = Dates, start = start, end = end, + time_dim = time_dim, ncores = ncores) + } + if (is.null(dim(Dates))) { + warning("Element 'Dates' has NULL dimensions. They will not be ", + "subset and 'time_bounds' will be missed.") + data$attrs$Dates <- Dates + } else { + # Create time_bounds + time_bounds <- NULL + time_bounds$start <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = 1, drop = 'selected') + time_bounds$end <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = dim(Dates)[time_dim], + drop = 'selected') + + # Add Dates in attrs + data$attrs$Dates <- time_bounds$start + data$attrs$time_bounds <- time_bounds + } + } + return(data) +} + +#'Period Function on multidimensional array objects +#' +#'Period Fun computes a calculation of a given variable in a period. +#' +#'@param data A multidimensional array with named dimensions. +#'@param fun An atomic function to compute a calculation over a period. +#'@param dates A multidimensional array of dates with named dimensions matching +#' the temporal dimensions on parameter 'data'. By default it is NULL, to +#' select aperiod this parameter must be provided. +#'@param start An optional 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. By default it is set +#' to NULL and the indicator is computed using all the data provided in +#' \code{data}. +#'@param end An optional 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. By default it is set to NULL +#' and the indicator is computed using all the data provided in \code{data}. +#'@param time_dim A character string indicating the name of the dimension to +#' compute the indicator. 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 na.rm A logical value indicating whether to ignore NA values (TRUE) or +#' not (FALSE). +#'@param ncores An integer indicating the number of cores to use in parallel +#' computation. +#' +#'@return A multidimensional array with named dimensions containing the +#'indicator in the element \code{data}. +#' +#'@examples +#'data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2002-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2002-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) +#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'SA <- PeriodFun(data, fun = mean, dates = Dates, start = list(01, 12), +#' end = list(01, 01)) +#' +#'@import multiApply +#'@export +PeriodFun <- function(data, fun, dates = NULL, start = NULL, end = NULL, + time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { + + if (is.null(data)) { + stop("Parameter 'data' cannot be NULL.") + } + if (!is.numeric(data)) { + stop("Parameter 'data' must be numeric.") + } + if (!is.array(data)) { + dim(data) <- length(data) + names(data) <- time_dim + } + + if (!is.null(start) && !is.null(end)) { + if (is.null(dates)) { + warning("Parameter 'dates' is NULL and the average of the ", + "full data provided in 'data' is computed.") + } else { + if (!any(c(is.list(start), is.list(end)))) { + stop("Parameter 'start' and 'end' must be lists indicating the ", + "day and the month of the period start and end.") + } + if (!is.null(dim(dates))) { + data <- SelectPeriodOnData(data = data, dates = dates, start = start, + end = end, time_dim = time_dim, + ncores = ncores) + } else { + warning("Parameter 'dates' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + } + } + } + total <- Apply(list(data), target_dims = time_dim, fun = fun, + na.rm = na.rm, ncores = ncores)$output1 + return(total) +} + + diff --git a/R/PeriodMax.R b/R/PeriodMax.R new file mode 100644 index 0000000..0d47033 --- /dev/null +++ b/R/PeriodMax.R @@ -0,0 +1,205 @@ +#'Period Max on 's2dv_cube' objects +#' +#'Period Max computes the maximum (max) of a given variable in a period. +#'Two bioclimatic indicators can be obtained by using this function: +#'\itemize{ +#' \item\code{BIO5}{(Providing temperature data) Max Temperature of Warmest +#' Month. The maximum monthly temperature occurrence over a +#' given year (time-series) or averaged span of years +#' (normal).} +#' \item\code{BIO13}{(Providing precipitation data) Precipitation of Wettest +#' Month. This index identifies the total precipitation +#' that prevails during the wettest month.} +#'} +#' +#'@param data An 's2dv_cube' object as provided function \code{CST_Load} in +#' package CSTools. +#'@param start An optional 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. By default it is set +#' to NULL and the indicator is computed using all the data provided in +#' \code{data}. +#'@param end An optional 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. By default it is set to NULL +#' and the indicator is computed using all the data provided in \code{data}. +#'@param time_dim A character string indicating the name of the dimension to +#' compute the indicator. 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 na.rm A logical value indicating whether to ignore NA values (TRUE) or +#' not (FALSE). +#'@param ncores An integer indicating the number of cores to use in parallel +#' computation. +#' +#'@return An 's2dv_cube' object containing the indicator in the element +#'\code{data} with dimensions of the input parameter 'data' except the +#'dimension where the max has been computed (specified with 'time_dim'). A new +#'element called 'time_bounds' will be added into the 'attrs' element in the +#''s2dv_cube' object. It consists of a list containing two elements, the start +#'and end dates of the aggregated period with the same dimensions of 'Dates' +#'element. +#' +#'@examples +#'exp <- NULL +#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2002-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2002-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) +#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'exp$attrs$Dates <- Dates +#'class(exp) <- 's2dv_cube' +#' +#'res <- CST_PeriodMax(exp, start = list(01, 12), end = list(01, 01)) +#' +#'@import multiApply +#'@importFrom ClimProjDiags Subset +#'@export +CST_PeriodMax <- function(data, start = NULL, end = NULL, + time_dim = 'ftime', na.rm = FALSE, + ncores = NULL) { + # Check 's2dv_cube' + if (!inherits(data, 's2dv_cube')) { + stop("Parameter 'data' must be of the class 's2dv_cube'.") + } + # Dates subset + if (!is.null(start) && !is.null(end)) { + if (is.null(dim(data$attrs$Dates))) { + warning("Dimensions in 'data' element 'attrs$Dates' are missed and ", + "all data would be used.") + start <- NULL + end <- NULL + } + } + + Dates <- data$attrs$Dates + total <- PeriodMax(data = data$data, dates = Dates, start = start, end = end, + time_dim = time_dim, na.rm = na.rm, ncores = ncores) + + data$data <- total + data$dims <- dim(total) + + if (!is.null(Dates)) { + if (!is.null(start) && !is.null(end)) { + Dates <- SelectPeriodOnDates(dates = Dates, start = start, end = end, + time_dim = time_dim, ncores = ncores) + } + if (is.null(dim(Dates))) { + warning("Element 'Dates' has NULL dimensions. They will not be ", + "subset and 'time_bounds' will be missed.") + data$attrs$Dates <- Dates + } else { + # Create time_bounds + time_bounds <- NULL + time_bounds$start <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = 1, drop = 'selected') + time_bounds$end <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = dim(Dates)[time_dim], + drop = 'selected') + + # Add Dates in attrs + data$attrs$Dates <- time_bounds$start + data$attrs$time_bounds <- time_bounds + } + } + return(data) +} + +#'Period max on multidimensional array objects +#' +#'Period max computes the average (max) of a given variable in a period. +#'Two bioclimatic indicators can be obtained by using this function: +#'\itemize{ +#' \item\code{BIO5}{(Providing temperature data) Max Temperature of Warmest +#' Month. The maximum monthly temperature occurrence over a +#' given year (time-series) or averaged span of years +#' (normal).} +#' \item\code{BIO13}{(Providing precipitation data) Precipitation of Wettest +#' Month. This index identifies the total precipitation +#' that prevails during the wettest month.} +#'} +#' +#'@param data A multidimensional array with named dimensions. +#'@param dates A multidimensional array of dates with named dimensions matching +#' the temporal dimensions on parameter 'data'. By default it is NULL, to +#' select aperiod this parameter must be provided. +#'@param start An optional 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. By default it is set +#' to NULL and the indicator is computed using all the data provided in +#' \code{data}. +#'@param end An optional 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. By default it is set to NULL +#' and the indicator is computed using all the data provided in \code{data}. +#'@param time_dim A character string indicating the name of the dimension to +#' compute the indicator. 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 na.rm A logical value indicating whether to ignore NA values (TRUE) or +#' not (FALSE). +#'@param ncores An integer indicating the number of cores to use in parallel +#' computation. +#' +#'@return A multidimensional array with named dimensions containing the +#'indicator in the element \code{data}. +#' +#'@examples +#'data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2002-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2002-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) +#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'res <- PeriodMax(data, dates = Dates, start = list(01, 12), end = list(01, 01)) +#' +#'@import multiApply +#'@export +PeriodMax <- function(data, dates = NULL, start = NULL, end = NULL, + time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { + + if (is.null(data)) { + stop("Parameter 'data' cannot be NULL.") + } + if (!is.numeric(data)) { + stop("Parameter 'data' must be numeric.") + } + if (!is.array(data)) { + dim(data) <- length(data) + names(data) <- time_dim + } + + if (!is.null(start) && !is.null(end)) { + if (is.null(dates)) { + warning("Parameter 'dates' is NULL and the average of the ", + "full data provided in 'data' is computed.") + } else { + if (!any(c(is.list(start), is.list(end)))) { + stop("Parameter 'start' and 'end' must be lists indicating the ", + "day and the month of the period start and end.") + } + if (!is.null(dim(dates))) { + data <- SelectPeriodOnData(data = data, dates = dates, start = start, + end = end, time_dim = time_dim, + ncores = ncores) + } else { + warning("Parameter 'dates' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + } + } + } + total <- Apply(list(data), target_dims = time_dim, fun = max, + na.rm = na.rm, ncores = ncores)$output1 + return(total) +} + + diff --git a/R/PeriodMin.R b/R/PeriodMin.R new file mode 100644 index 0000000..f5ea5b0 --- /dev/null +++ b/R/PeriodMin.R @@ -0,0 +1,205 @@ +#'Period Min on 's2dv_cube' objects +#' +#'Period Min computes the average (min) of a given variable in a period. +#'Two bioclimatic indicators can be obtained by using this function: +#'\itemize{ +#' \item\code{BIO6}{(Providing temperature data) Min Temperature of Coldest +#' Month. The minimum monthly temperature occurrence over a +#' given year (time-series) or averaged span of years +#' (normal).} +#' \item\code{BIO14}{(Providing precipitation data) Precipitation of Driest +#' Month. This index identifies the total precipitation +#' that prevails during the driest month.} +#'} +#' +#'@param data An 's2dv_cube' object as provided function \code{CST_Load} in +#' package CSTools. +#'@param start An optional 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. By default it is set +#' to NULL and the indicator is computed using all the data provided in +#' \code{data}. +#'@param end An optional 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. By default it is set to NULL +#' and the indicator is computed using all the data provided in \code{data}. +#'@param time_dim A character string indicating the name of the dimension to +#' compute the indicator. 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 na.rm A logical value indicating whether to ignore NA values (TRUE) or +#' not (FALSE). +#'@param ncores An integer indicating the number of cores to use in parallel +#' computation. +#' +#'@return An 's2dv_cube' object containing the indicator in the element +#'\code{data} with dimensions of the input parameter 'data' except the +#'dimension where the min has been computed (specified with 'time_dim'). A new +#'element called 'time_bounds' will be added into the 'attrs' element in the +#''s2dv_cube' object. It consists of a list containing two elements, the start +#'and end dates of the aggregated period with the same dimensions of 'Dates' +#'element. +#' +#'@examples +#'exp <- NULL +#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2002-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2002-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) +#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'exp$attrs$Dates <- Dates +#'class(exp) <- 's2dv_cube' +#' +#'res <- CST_PeriodMin(exp, start = list(01, 12), end = list(01, 01)) +#' +#'@import multiApply +#'@importFrom ClimProjDiags Subset +#'@export +CST_PeriodMin <- function(data, start = NULL, end = NULL, + time_dim = 'ftime', na.rm = FALSE, + ncores = NULL) { + # Check 's2dv_cube' + if (!inherits(data, 's2dv_cube')) { + stop("Parameter 'data' must be of the class 's2dv_cube'.") + } + # Dates subset + if (!is.null(start) && !is.null(end)) { + if (is.null(dim(data$attrs$Dates))) { + warning("Dimensions in 'data' element 'attrs$Dates' are missed and ", + "all data would be used.") + start <- NULL + end <- NULL + } + } + + Dates <- data$attrs$Dates + total <- PeriodMin(data = data$data, dates = Dates, start = start, end = end, + time_dim = time_dim, na.rm = na.rm, ncores = ncores) + + data$data <- total + data$dims <- dim(total) + + if (!is.null(Dates)) { + if (!is.null(start) && !is.null(end)) { + Dates <- SelectPeriodOnDates(dates = Dates, start = start, end = end, + time_dim = time_dim, ncores = ncores) + } + if (is.null(dim(Dates))) { + warning("Element 'Dates' has NULL dimensions. They will not be ", + "subset and 'time_bounds' will be missed.") + data$attrs$Dates <- Dates + } else { + # Create time_bounds + time_bounds <- NULL + time_bounds$start <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = 1, drop = 'selected') + time_bounds$end <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = dim(Dates)[time_dim], + drop = 'selected') + + # Add Dates in attrs + data$attrs$Dates <- time_bounds$start + data$attrs$time_bounds <- time_bounds + } + } + return(data) +} + +#'Period Min on multidimensional array objects +#' +#'Period Min computes the average (min) of a given variable in a period. +#'Two bioclimatic indicators can be obtained by using this function: +#'\itemize{ +#' \item\code{BIO6}{(Providing temperature data) Min Temperature of Coldest +#' Month. The minimum monthly temperature occurrence over a +#' given year (time-series) or averaged span of years +#' (normal).} +#' \item\code{BIO14}{(Providing precipitation data) Precipitation of Driest +#' Month. This index identifies the total precipitation +#' that prevails during the driest month.} +#'} +#' +#'@param data A multidimensional array with named dimensions. +#'@param dates A multidimensional array of dates with named dimensions matching +#' the temporal dimensions on parameter 'data'. By default it is NULL, to +#' select aperiod this parameter must be provided. +#'@param start An optional 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. By default it is set +#' to NULL and the indicator is computed using all the data provided in +#' \code{data}. +#'@param end An optional 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. By default it is set to NULL +#' and the indicator is computed using all the data provided in \code{data}. +#'@param time_dim A character string indicating the name of the dimension to +#' compute the indicator. 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 na.rm A logical value indicating whether to ignore NA values (TRUE) or +#' not (FALSE). +#'@param ncores An integer indicating the number of cores to use in parallel +#' computation. +#' +#'@return A multidimensional array with named dimensions containing the +#'indicator in the element \code{data}. +#' +#'@examples +#'data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2002-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2002-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) +#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'res <- PeriodMin(data, dates = Dates, start = list(01, 12), end = list(01, 01)) +#' +#'@import multiApply +#'@export +PeriodMin <- function(data, dates = NULL, start = NULL, end = NULL, + time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { + + if (is.null(data)) { + stop("Parameter 'data' cannot be NULL.") + } + if (!is.numeric(data)) { + stop("Parameter 'data' must be numeric.") + } + if (!is.array(data)) { + dim(data) <- length(data) + names(data) <- time_dim + } + + if (!is.null(start) && !is.null(end)) { + if (is.null(dates)) { + warning("Parameter 'dates' is NULL and the average of the ", + "full data provided in 'data' is computed.") + } else { + if (!any(c(is.list(start), is.list(end)))) { + stop("Parameter 'start' and 'end' must be lists indicating the ", + "day and the month of the period start and end.") + } + if (!is.null(dim(dates))) { + data <- SelectPeriodOnData(data = data, dates = dates, start = start, + end = end, time_dim = time_dim, + ncores = ncores) + } else { + warning("Parameter 'dates' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + } + } + } + total <- Apply(list(data), target_dims = time_dim, fun = min, + na.rm = na.rm, ncores = ncores)$output1 + return(total) +} + + diff --git a/R/PeriodVariance.R b/R/PeriodVariance.R new file mode 100644 index 0000000..b9f3cff --- /dev/null +++ b/R/PeriodVariance.R @@ -0,0 +1,219 @@ +#'Period Variance on 's2dv_cube' objects +#' +#'Period Variance computes the average (var) of a given variable in a period. +#'Two bioclimatic indicators can be obtained by using this function: +#'\itemize{ +#' \item\code{BIO4}{(Providing temperature data) Temperature Seasonality +#' (Standard Deviation). The amount of temperature variation +#' over a given year (or averaged years) based on the standard +#' deviation (variation) of monthly temperature averages. } +#' \item\code{BIO15}{(Providing precipitation data) Precipitation Seasonality +#' (CV). This is a measure of the variation in +#' monthly precipitation totals over the course of the year. +#' This index is the ratio of the standard deviation of the +#' monthly total precipitation to the mean monthly total +#' precipitation (also known as the coefficient of variation) +#' and is expressed as a percentage} +#'} +#' +#'@param data An 's2dv_cube' object as provided function \code{CST_Load} in +#' package CSTools. +#'@param start An optional 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. By default it is set +#' to NULL and the indicator is computed using all the data provided in +#' \code{data}. +#'@param end An optional 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. By default it is set to NULL +#' and the indicator is computed using all the data provided in \code{data}. +#'@param time_dim A character string indicating the name of the dimension to +#' compute the indicator. 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 na.rm A logical value indicating whether to ignore NA values (TRUE) or +#' not (FALSE). +#'@param ncores An integer indicating the number of cores to use in parallel +#' computation. +#' +#'@return An 's2dv_cube' object containing the indicator in the element +#'\code{data} with dimensions of the input parameter 'data' except the +#'dimension where the var has been computed (specified with 'time_dim'). A new +#'element called 'time_bounds' will be added into the 'attrs' element in the +#''s2dv_cube' object. It consists of a list containing two elements, the start +#'and end dates of the aggregated period with the same dimensions of 'Dates' +#'element. +#' +#'@examples +#'exp <- NULL +#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2002-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2002-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) +#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'exp$attrs$Dates <- Dates +#'class(exp) <- 's2dv_cube' +#' +#'res <- CST_PeriodVariance(exp, start = list(01, 12), end = list(01, 01)) +#' +#'@import multiApply +#'@importFrom ClimProjDiags Subset +#'@export +CST_PeriodVariance <- function(data, start = NULL, end = NULL, + time_dim = 'ftime', na.rm = FALSE, + ncores = NULL) { + # Check 's2dv_cube' + if (!inherits(data, 's2dv_cube')) { + stop("Parameter 'data' must be of the class 's2dv_cube'.") + } + # Dates subset + if (!is.null(start) && !is.null(end)) { + if (is.null(dim(data$attrs$Dates))) { + warning("Dimensions in 'data' element 'attrs$Dates' are missed and ", + "all data would be used.") + start <- NULL + end <- NULL + } + } + + Dates <- data$attrs$Dates + total <- PeriodVariance(data = data$data, dates = Dates, start = start, end = end, + time_dim = time_dim, na.rm = na.rm, ncores = ncores) + + data$data <- total + data$dims <- dim(total) + + if (!is.null(Dates)) { + if (!is.null(start) && !is.null(end)) { + Dates <- SelectPeriodOnDates(dates = Dates, start = start, end = end, + time_dim = time_dim, ncores = ncores) + } + if (is.null(dim(Dates))) { + warning("Element 'Dates' has NULL dimensions. They will not be ", + "subset and 'time_bounds' will be missed.") + data$attrs$Dates <- Dates + } else { + # Create time_bounds + time_bounds <- NULL + time_bounds$start <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = 1, drop = 'selected') + time_bounds$end <- ClimProjDiags::Subset(x = Dates, along = time_dim, + indices = dim(Dates)[time_dim], + drop = 'selected') + + # Add Dates in attrs + data$attrs$Dates <- time_bounds$start + data$attrs$time_bounds <- time_bounds + } + } + return(data) +} + +#'Period Variance on multidimensional array objects +#' +#'Period Variance computes the average (var) of a given variable in a period. +#'Two bioclimatic indicators can be obtained by using this function: +#'\itemize{ +#' \item\code{BIO4}{(Providing temperature data) Temperature Seasonality +#' (Standard Deviation). The amount of temperature variation +#' over a given year (or averaged years) based on the standard +#' deviation (variation) of monthly temperature averages. } +#' \item\code{BIO15}{(Providing precipitation data) Precipitation Seasonality +#' (CV). This is a measure of the variation in +#' monthly precipitation totals over the course of the year. +#' This index is the ratio of the standard deviation of the +#' monthly total precipitation to the mean monthly total +#' precipitation (also known as the coefficient of variation) +#' and is expressed as a percentage} +#'} +#' +#'@param data A multidimensional array with named dimensions. +#'@param dates A multidimensional array of dates with named dimensions matching +#' the temporal dimensions on parameter 'data'. By default it is NULL, to +#' select aperiod this parameter must be provided. +#'@param start An optional 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. By default it is set +#' to NULL and the indicator is computed using all the data provided in +#' \code{data}. +#'@param end An optional 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. By default it is set to NULL +#' and the indicator is computed using all the data provided in \code{data}. +#'@param time_dim A character string indicating the name of the dimension to +#' compute the indicator. 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 na.rm A logical value indicating whether to ignore NA values (TRUE) or +#' not (FALSE). +#'@param ncores An integer indicating the number of cores to use in parallel +#' computation. +#' +#'@return A multidimensional array with named dimensions containing the +#'indicator in the element \code{data}. +#' +#'@examples +#'data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2002-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2002-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), +#' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), +#' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) +#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'res <- PeriodVariance(data, dates = Dates, start = list(01, 12), end = list(01, 01)) +#' +#'@import multiApply +#'@export +PeriodVariance <- function(data, dates = NULL, start = NULL, end = NULL, + time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { + + if (is.null(data)) { + stop("Parameter 'data' cannot be NULL.") + } + if (!is.numeric(data)) { + stop("Parameter 'data' must be numeric.") + } + if (!is.array(data)) { + dim(data) <- length(data) + names(data) <- time_dim + } + + if (!is.null(start) && !is.null(end)) { + if (is.null(dates)) { + warning("Parameter 'dates' is NULL and the average of the ", + "full data provided in 'data' is computed.") + } else { + if (!any(c(is.list(start), is.list(end)))) { + stop("Parameter 'start' and 'end' must be lists indicating the ", + "day and the month of the period start and end.") + } + if (!is.null(dim(dates))) { + data <- SelectPeriodOnData(data = data, dates = dates, start = start, + end = end, time_dim = time_dim, + ncores = ncores) + } else { + warning("Parameter 'dates' must have named dimensions if 'start' and ", + "'end' are not NULL. All data will be used.") + } + } + } + total <- Apply(list(data), target_dims = time_dim, + fun = .periodvariance, + na.rm = na.rm, ncores = ncores)$output1 + return(total) +} + +.periodvariance <- function(data, na.rm) { + var <- sum((data - mean(data, na.rm = na.rm))^2) / (length(data)-1) + return(var) +} + + diff --git a/tests/testthat/test-PeriodFun.R b/tests/testthat/test-PeriodFun.R new file mode 100644 index 0000000..c743aee --- /dev/null +++ b/tests/testthat/test-PeriodFun.R @@ -0,0 +1,120 @@ +library(CSTools) + +############################################## +test_that("1. Sanity Checks", { + expect_error( + PeriodFun('x'), + "Parameter 'data' must be numeric." + ) + suppressWarnings( + expect_equal( + PeriodFun(array(1, c(x = 1)), fun = mean, time_dim = 'x'), + 1 + ) + ) + expect_error( + PeriodFun(data = NULL, fun = mean), + "Parameter 'data' cannot be NULL." + ) + expect_error( + PeriodFun(1, fun = mean, dates = '2000-01-01', end = 3, start = 4), + paste0("Parameter 'start' and 'end' must be lists indicating the day ", + "and the month of the period start and end.") + ) + expect_equal( + PeriodFun(array(1:10, c(ftime = 10)), fun = mean), + 5.5 + ) + data <- array(1:24, c(sdate = 2, ftime = 3, lon = 4)) + expect_equal( + PeriodFun(data, fun = min), + array(c(1, 2, 7, 8, 13, 14, 19, 20), + c(sdate = 2, lon = 4)) + ) + # Test dates warning + expect_warning( + PeriodFun(array(1:10, c(ftime = 10)), fun = mean, + dates = seq(as.Date("01-05-2000", format = "%d-%m-%Y"), + as.Date("10-05-2000", format = "%d-%m-%Y"), by = 'day'), + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' must have named dimensions if 'start' and 'end' ", + "are not NULL. All data will be used.") + ) + # start and end when dates is not provided + expect_warning( + PeriodFun(array(1:10, c(ftime = 10)), fun = sum, + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' is NULL and the average of the full data ", + "provided in 'data' is computed.") + ) +}) + +############################################## + +test_that("2. Seasonal", { + exp <- NULL + exp$data <- array(1:(1 * 3 * 214 * 2), + c(memb = 1, sdate = 3, ftime = 214, lon = 2)) + exp$dims <- dim(exp$data) + exp$attrs$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')) + dim(exp$attrs$Dates) <- c(ftime = 214, sdate = 3) + class(exp) <- 's2dv_cube' + output <- exp + output$data <- array(c(min(exp$data[1,1,21:82,1]), min(exp$data[1,2,21:82,1]), + min(exp$data[1,3,21:82,1]), min(exp$data[1,1,21:82,2]), + min(exp$data[1,2,21:82,2]), min(exp$data[1,3,21:82,2])), + c(memb = 1, sdate = 3, lon = 2)) + expect_equal( + CST_PeriodFun(exp, fun = min, start = list(21, 4), end = list(21, 6))$data, + output$data + ) +}) + +############################################## +test_that("3. Subset Dates and check time_bounds", { + exp <- CSTools::lonlat_prec + res <- CST_PeriodFun(data = CSTools::lonlat_prec, fun = min, time_dim = 'ftime', + start = list(10, 03), end = list(20, 03)) + # Check dims + expect_equal( + dim(res$data), + res$dims + ) + # Check Dates + expect_equal( + dim(res$data)['sdate'], + dim(res$attrs$Dates) + ) + # Check time_bounds + expect_equal( + res$attrs$Dates, + res$attrs$time_bounds$start + ) + expect_equal( + dim(res$attrs$time_bounds$start), + dim(res$attrs$time_bounds$end) + ) + # Check 'sdates' + expect_equal( + all(lubridate::month(res$attrs$time_bounds$start) == 3), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$start) == 10), + TRUE + ) + expect_equal( + all(lubridate::month(res$attrs$time_bounds$end) == 03), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$end) == 20), + TRUE + ) +}) + diff --git a/tests/testthat/test-PeriodMax.R b/tests/testthat/test-PeriodMax.R new file mode 100644 index 0000000..967b086 --- /dev/null +++ b/tests/testthat/test-PeriodMax.R @@ -0,0 +1,123 @@ +library(CSTools) + +############################################## +test_that("1. Sanity Checks", { + expect_error( + PeriodMax('x'), + "Parameter 'data' must be numeric." + ) + suppressWarnings( + expect_equal( + PeriodMax(array(1, c(x = 1)), time_dim = 'x'), + 1 + ) + ) + expect_error( + PeriodMax(data = NULL), + "Parameter 'data' cannot be NULL." + ) + expect_error( + PeriodMax(1, dates = '2000-01-01', end = 3, start = 4), + "Parameter 'start' and 'end' must be lists indicating the day and the month of the period start and end." + ) + suppressWarnings( + expect_equal( + PeriodMax(array(1:10, c(ftime = 10))), + 10 + ) + ) + data <- array(1:24, c(sdate = 2, ftime = 3, lon = 4)) + suppressWarnings( + expect_equal( + PeriodMax(data), + array(c(5, 6, 11, 12, 17, 18, 23, 24), + c(sdate = 2, lon = 4)) + ) + ) + # Test dates warning + expect_warning( + PeriodMax(array(1:10, c(ftime = 10)), + dates = seq(as.Date("01-05-2000", format = "%d-%m-%Y"), + as.Date("10-05-2000", format = "%d-%m-%Y"), by = 'day'), + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' must have named dimensions if 'start' and 'end' ", + "are not NULL. All data will be used.") + ) + # start and end when dates is not provided + expect_warning( + PeriodMax(array(1:10, c(ftime = 10)), + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' is NULL and the average of the full data ", + "provided in 'data' is computed.") + ) +}) + +############################################## + +test_that("2. Seasonal", { + exp <- NULL + exp$data <- array(1:(1 * 3 * 214 * 2), + c(memb = 1, sdate = 3, ftime = 214, lon = 2)) + exp$dims <- dim(exp$data) + exp$attrs$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')) + dim(exp$attrs$Dates) <- c(ftime = 214, sdate = 3) + class(exp) <- 's2dv_cube' + output <- exp + output$data <- array(c(max(exp$data[1,1,21:82,1]), max(exp$data[1,2,21:82,1]), + max(exp$data[1,3,21:82,1]), max(exp$data[1,1,21:82,2]), + max(exp$data[1,2,21:82,2]), max(exp$data[1,3,21:82,2])), + c(memb = 1, sdate = 3, lon = 2)) + expect_equal( + CST_PeriodMax(exp, start = list(21, 4), end = list(21, 6))$data, + output$data + ) +}) + +############################################## +test_that("3. Subset Dates and check time_bounds", { + exp <- CSTools::lonlat_prec + res <- CST_PeriodMax(data = CSTools::lonlat_prec, time_dim = 'ftime', + start = list(10, 03), end = list(20, 03)) + # Check dims + expect_equal( + dim(res$data), + res$dims + ) + # Check Dates + expect_equal( + dim(res$data)['sdate'], + dim(res$attrs$Dates) + ) + # Check time_bounds + expect_equal( + res$attrs$Dates, + res$attrs$time_bounds$start + ) + expect_equal( + dim(res$attrs$time_bounds$start), + dim(res$attrs$time_bounds$end) + ) + # Check 'sdates' + expect_equal( + all(lubridate::month(res$attrs$time_bounds$start) == 3), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$start) == 10), + TRUE + ) + expect_equal( + all(lubridate::month(res$attrs$time_bounds$end) == 03), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$end) == 20), + TRUE + ) +}) + diff --git a/tests/testthat/test-PeriodMin.R b/tests/testthat/test-PeriodMin.R new file mode 100644 index 0000000..da91a3c --- /dev/null +++ b/tests/testthat/test-PeriodMin.R @@ -0,0 +1,119 @@ +library(CSTools) + +############################################## +test_that("1. Sanity Checks", { + expect_error( + PeriodMin('x'), + "Parameter 'data' must be numeric." + ) + suppressWarnings( + expect_equal( + PeriodMin(array(1, c(x = 1)), time_dim = 'x'), + 1 + ) + ) + expect_error( + PeriodMin(data = NULL), + "Parameter 'data' cannot be NULL." + ) + expect_error( + PeriodMin(1, dates = '2000-01-01', end = 3, start = 4), + "Parameter 'start' and 'end' must be lists indicating the day and the month of the period start and end." + ) + expect_equal( + PeriodMin(array(1:10, c(ftime = 10))), + 1 + ) + data <- array(1:24, c(sdate = 2, ftime = 3, lon = 4)) + expect_equal( + PeriodMin(data), + array(c(1, 2, 7, 8, 13, 14, 19, 20), + c(sdate = 2, lon = 4)) + ) + # Test dates warning + expect_warning( + PeriodMin(array(1:10, c(ftime = 10)), + dates = seq(as.Date("01-05-2000", format = "%d-%m-%Y"), + as.Date("10-05-2000", format = "%d-%m-%Y"), by = 'day'), + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' must have named dimensions if 'start' and 'end' ", + "are not NULL. All data will be used.") + ) + # start and end when dates is not provided + expect_warning( + PeriodMin(array(1:10, c(ftime = 10)), + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' is NULL and the average of the full data ", + "provided in 'data' is computed.") + ) +}) + +############################################## + +test_that("2. Seasonal", { + exp <- NULL + exp$data <- array(1:(1 * 3 * 214 * 2), + c(memb = 1, sdate = 3, ftime = 214, lon = 2)) + exp$dims <- dim(exp$data) + exp$attrs$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')) + dim(exp$attrs$Dates) <- c(ftime = 214, sdate = 3) + class(exp) <- 's2dv_cube' + output <- exp + output$data <- array(c(min(exp$data[1,1,21:82,1]), min(exp$data[1,2,21:82,1]), + min(exp$data[1,3,21:82,1]), min(exp$data[1,1,21:82,2]), + min(exp$data[1,2,21:82,2]), min(exp$data[1,3,21:82,2])), + c(memb = 1, sdate = 3, lon = 2)) + expect_equal( + CST_PeriodMin(exp, start = list(21, 4), end = list(21, 6))$data, + output$data + ) +}) + +############################################## +test_that("3. Subset Dates and check time_bounds", { + exp <- CSTools::lonlat_prec + res <- CST_PeriodMin(data = CSTools::lonlat_prec, time_dim = 'ftime', + start = list(10, 03), end = list(20, 03)) + # Check dims + expect_equal( + dim(res$data), + res$dims + ) + # Check Dates + expect_equal( + dim(res$data)['sdate'], + dim(res$attrs$Dates) + ) + # Check time_bounds + expect_equal( + res$attrs$Dates, + res$attrs$time_bounds$start + ) + expect_equal( + dim(res$attrs$time_bounds$start), + dim(res$attrs$time_bounds$end) + ) + # Check 'sdates' + expect_equal( + all(lubridate::month(res$attrs$time_bounds$start) == 3), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$start) == 10), + TRUE + ) + expect_equal( + all(lubridate::month(res$attrs$time_bounds$end) == 03), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$end) == 20), + TRUE + ) +}) + diff --git a/tests/testthat/test-PeriodVariance.R b/tests/testthat/test-PeriodVariance.R new file mode 100644 index 0000000..1ac78c1 --- /dev/null +++ b/tests/testthat/test-PeriodVariance.R @@ -0,0 +1,118 @@ +library(CSTools) + +############################################## +test_that("1. Sanity Checks", { + expect_error( + PeriodVariance('x'), + "Parameter 'data' must be numeric." + ) + expect_equal( + PeriodVariance(array(1:2, c(x = 2)), time_dim = 'x'), + 0.5 + ) + expect_error( + PeriodVariance(data = NULL), + "Parameter 'data' cannot be NULL." + ) + expect_error( + PeriodVariance(1, dates = '2000-01-01', end = 3, start = 4), + "Parameter 'start' and 'end' must be lists indicating the day and the month of the period start and end." + ) + expect_equal( + PeriodVariance(array(1:10, c(ftime = 10))), + 9.166667, + tolerance = 0.001 + ) + data <- array(1:24, c(sdate = 2, ftime = 3, lon = 4)) + expect_equal( + PeriodVariance(data), + array(rep(4, 8), + c(sdate = 2, lon = 4)) + ) + # Test dates warning + expect_warning( + PeriodVariance(array(1:10, c(ftime = 10)), + dates = seq(as.Date("01-05-2000", format = "%d-%m-%Y"), + as.Date("10-05-2000", format = "%d-%m-%Y"), by = 'day'), + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' must have named dimensions if 'start' and 'end' ", + "are not NULL. All data will be used.") + ) + # start and end when dates is not provided + expect_warning( + PeriodVariance(array(1:10, c(ftime = 10)), + start = list(05, 02), end = list(05, 09)), + paste0("Parameter 'dates' is NULL and the average of the full data ", + "provided in 'data' is computed.") + ) +}) + +############################################## + +test_that("2. Seasonal", { + exp <- NULL + exp$data <- array(1:(1 * 3 * 214 * 2), + c(memb = 1, sdate = 3, ftime = 214, lon = 2)) + exp$dims <- dim(exp$data) + exp$attrs$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')) + dim(exp$attrs$Dates) <- c(ftime = 214, sdate = 3) + class(exp) <- 's2dv_cube' + output <- exp + output$data <- array(c(var(exp$data[1,1,21:82,1]), var(exp$data[1,2,21:82,1]), + var(exp$data[1,3,21:82,1]), var(exp$data[1,1,21:82,2]), + var(exp$data[1,2,21:82,2]), var(exp$data[1,3,21:82,2])), + c(memb = 1, sdate = 3, lon = 2)) + expect_equal( + CST_PeriodVariance(exp, start = list(21, 4), end = list(21, 6))$data, + output$data + ) +}) + +############################################## +test_that("3. Subset Dates and check time_bounds", { + exp <- CSTools::lonlat_prec + res <- CST_PeriodVariance(data = CSTools::lonlat_prec, time_dim = 'ftime', + start = list(10, 03), end = list(20, 03)) + # Check dims + expect_equal( + dim(res$data), + res$dims + ) + # Check Dates + expect_equal( + dim(res$data)['sdate'], + dim(res$attrs$Dates) + ) + # Check time_bounds + expect_equal( + res$attrs$Dates, + res$attrs$time_bounds$start + ) + expect_equal( + dim(res$attrs$time_bounds$start), + dim(res$attrs$time_bounds$end) + ) + # Check 'sdates' + expect_equal( + all(lubridate::month(res$attrs$time_bounds$start) == 3), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$start) == 10), + TRUE + ) + expect_equal( + all(lubridate::month(res$attrs$time_bounds$end) == 03), + TRUE + ) + expect_equal( + all(lubridate::day(res$attrs$time_bounds$end) == 20), + TRUE + ) +}) + -- GitLab From 5fcc11fad521548fba24eca96d3581699dab00ea Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 21 Jun 2023 16:29:40 +0200 Subject: [PATCH 2/5] Update documentation --- NAMESPACE | 9 +++++ man/CST_PeriodFun.Rd | 75 ++++++++++++++++++++++++++++++++++ man/CST_PeriodMax.Rd | 81 +++++++++++++++++++++++++++++++++++++ man/CST_PeriodMin.Rd | 81 +++++++++++++++++++++++++++++++++++++ man/CST_PeriodVariance.Rd | 85 +++++++++++++++++++++++++++++++++++++++ man/PeriodFun.Rd | 70 ++++++++++++++++++++++++++++++++ man/PeriodMax.Rd | 76 ++++++++++++++++++++++++++++++++++ man/PeriodMin.Rd | 76 ++++++++++++++++++++++++++++++++++ man/PeriodVariance.Rd | 80 ++++++++++++++++++++++++++++++++++++ 9 files changed, 633 insertions(+) create mode 100644 man/CST_PeriodFun.Rd create mode 100644 man/CST_PeriodMax.Rd create mode 100644 man/CST_PeriodMin.Rd create mode 100644 man/CST_PeriodVariance.Rd create mode 100644 man/PeriodFun.Rd create mode 100644 man/PeriodMax.Rd create mode 100644 man/PeriodMin.Rd create mode 100644 man/PeriodVariance.Rd diff --git a/NAMESPACE b/NAMESPACE index d80accb..f02cee5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,11 @@ export(CST_AbsToProbs) export(CST_AccumulationExceedingThreshold) export(CST_MergeRefToExp) export(CST_PeriodAccumulation) +export(CST_PeriodFun) +export(CST_PeriodMax) export(CST_PeriodMean) +export(CST_PeriodMin) +export(CST_PeriodVariance) export(CST_QThreshold) export(CST_SelectPeriodOnData) export(CST_Threshold) @@ -16,7 +20,11 @@ export(CST_WindCapacityFactor) export(CST_WindPowerDensity) export(MergeRefToExp) export(PeriodAccumulation) +export(PeriodFun) +export(PeriodMax) export(PeriodMean) +export(PeriodMin) +export(PeriodVariance) export(QThreshold) export(SelectPeriodOnData) export(SelectPeriodOnDates) @@ -26,6 +34,7 @@ export(TotalTimeExceedingThreshold) export(WindCapacityFactor) export(WindPowerDensity) import(multiApply) +importFrom(ClimProjDiags,Subset) importFrom(stats,approxfun) importFrom(stats,ecdf) importFrom(stats,quantile) diff --git a/man/CST_PeriodFun.Rd b/man/CST_PeriodFun.Rd new file mode 100644 index 0000000..1ffe32b --- /dev/null +++ b/man/CST_PeriodFun.Rd @@ -0,0 +1,75 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PeriodFun.R +\name{CST_PeriodFun} +\alias{CST_PeriodFun} +\title{Period Function on 's2dv_cube' objects} +\usage{ +CST_PeriodFun( + data, + fun, + start = NULL, + end = NULL, + time_dim = "ftime", + na.rm = FALSE, + ncores = NULL +) +} +\arguments{ +\item{data}{An 's2dv_cube' object as provided function \code{CST_Load} in +package CSTools.} + +\item{fun}{An atomic function to compute a calculation over a period.} + +\item{start}{An optional 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. By default it is set +to NULL and the indicator is computed using all the data provided in +\code{data}.} + +\item{end}{An optional 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. By default it is set to NULL +and the indicator is computed using all the data provided in \code{data}.} + +\item{time_dim}{A character string indicating the name of the dimension to +compute the indicator. 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.} + +\item{na.rm}{A logical value indicating whether to ignore NA values (TRUE) or +not (FALSE).} + +\item{ncores}{An integer indicating the number of cores to use in parallel +computation.} +} +\value{ +An 's2dv_cube' object containing the indicator in the element +\code{data} with dimensions of the input parameter 'data' except the +dimension where the mean has been computed (specified with 'time_dim'). A new +element called 'time_bounds' will be added into the 'attrs' element in the +'s2dv_cube' object. It consists of a list containing two elements, the start +and end dates of the aggregated period with the same dimensions of 'Dates' +element. +} +\description{ +Period Fun computes a calculation of a given variable in a period. +} +\examples{ +exp <- NULL +exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2002-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2002-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) +dim(Dates) <- c(sdate = 4, ftime = 3) +exp$attrs$Dates <- Dates +class(exp) <- 's2dv_cube' + +SA <- CST_PeriodFun(exp, fun = mean, start = list(01, 12), + end = list(01, 01)) + +} diff --git a/man/CST_PeriodMax.Rd b/man/CST_PeriodMax.Rd new file mode 100644 index 0000000..02a4a8a --- /dev/null +++ b/man/CST_PeriodMax.Rd @@ -0,0 +1,81 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PeriodMax.R +\name{CST_PeriodMax} +\alias{CST_PeriodMax} +\title{Period Max on 's2dv_cube' objects} +\usage{ +CST_PeriodMax( + data, + start = NULL, + end = NULL, + time_dim = "ftime", + na.rm = FALSE, + ncores = NULL +) +} +\arguments{ +\item{data}{An 's2dv_cube' object as provided function \code{CST_Load} in +package CSTools.} + +\item{start}{An optional 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. By default it is set +to NULL and the indicator is computed using all the data provided in +\code{data}.} + +\item{end}{An optional 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. By default it is set to NULL +and the indicator is computed using all the data provided in \code{data}.} + +\item{time_dim}{A character string indicating the name of the dimension to +compute the indicator. 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.} + +\item{na.rm}{A logical value indicating whether to ignore NA values (TRUE) or +not (FALSE).} + +\item{ncores}{An integer indicating the number of cores to use in parallel +computation.} +} +\value{ +An 's2dv_cube' object containing the indicator in the element +\code{data} with dimensions of the input parameter 'data' except the +dimension where the max has been computed (specified with 'time_dim'). A new +element called 'time_bounds' will be added into the 'attrs' element in the +'s2dv_cube' object. It consists of a list containing two elements, the start +and end dates of the aggregated period with the same dimensions of 'Dates' +element. +} +\description{ +Period Max computes the maximum (max) of a given variable in a period. +Two bioclimatic indicators can be obtained by using this function: +\itemize{ + \item\code{BIO5}{(Providing temperature data) Max Temperature of Warmest + Month. The maximum monthly temperature occurrence over a + given year (time-series) or averaged span of years + (normal).} + \item\code{BIO13}{(Providing precipitation data) Precipitation of Wettest + Month. This index identifies the total precipitation + that prevails during the wettest month.} +} +} +\examples{ +exp <- NULL +exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2002-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2002-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) +dim(Dates) <- c(sdate = 4, ftime = 3) +exp$attrs$Dates <- Dates +class(exp) <- 's2dv_cube' + +res <- CST_PeriodMax(exp, start = list(01, 12), end = list(01, 01)) + +} diff --git a/man/CST_PeriodMin.Rd b/man/CST_PeriodMin.Rd new file mode 100644 index 0000000..7076ccd --- /dev/null +++ b/man/CST_PeriodMin.Rd @@ -0,0 +1,81 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PeriodMin.R +\name{CST_PeriodMin} +\alias{CST_PeriodMin} +\title{Period Min on 's2dv_cube' objects} +\usage{ +CST_PeriodMin( + data, + start = NULL, + end = NULL, + time_dim = "ftime", + na.rm = FALSE, + ncores = NULL +) +} +\arguments{ +\item{data}{An 's2dv_cube' object as provided function \code{CST_Load} in +package CSTools.} + +\item{start}{An optional 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. By default it is set +to NULL and the indicator is computed using all the data provided in +\code{data}.} + +\item{end}{An optional 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. By default it is set to NULL +and the indicator is computed using all the data provided in \code{data}.} + +\item{time_dim}{A character string indicating the name of the dimension to +compute the indicator. 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.} + +\item{na.rm}{A logical value indicating whether to ignore NA values (TRUE) or +not (FALSE).} + +\item{ncores}{An integer indicating the number of cores to use in parallel +computation.} +} +\value{ +An 's2dv_cube' object containing the indicator in the element +\code{data} with dimensions of the input parameter 'data' except the +dimension where the min has been computed (specified with 'time_dim'). A new +element called 'time_bounds' will be added into the 'attrs' element in the +'s2dv_cube' object. It consists of a list containing two elements, the start +and end dates of the aggregated period with the same dimensions of 'Dates' +element. +} +\description{ +Period Min computes the average (min) of a given variable in a period. +Two bioclimatic indicators can be obtained by using this function: +\itemize{ + \item\code{BIO6}{(Providing temperature data) Min Temperature of Coldest + Month. The minimum monthly temperature occurrence over a + given year (time-series) or averaged span of years + (normal).} + \item\code{BIO14}{(Providing precipitation data) Precipitation of Driest + Month. This index identifies the total precipitation + that prevails during the driest month.} +} +} +\examples{ +exp <- NULL +exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2002-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2002-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) +dim(Dates) <- c(sdate = 4, ftime = 3) +exp$attrs$Dates <- Dates +class(exp) <- 's2dv_cube' + +res <- CST_PeriodMin(exp, start = list(01, 12), end = list(01, 01)) + +} diff --git a/man/CST_PeriodVariance.Rd b/man/CST_PeriodVariance.Rd new file mode 100644 index 0000000..fa68197 --- /dev/null +++ b/man/CST_PeriodVariance.Rd @@ -0,0 +1,85 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PeriodVariance.R +\name{CST_PeriodVariance} +\alias{CST_PeriodVariance} +\title{Period Variance on 's2dv_cube' objects} +\usage{ +CST_PeriodVariance( + data, + start = NULL, + end = NULL, + time_dim = "ftime", + na.rm = FALSE, + ncores = NULL +) +} +\arguments{ +\item{data}{An 's2dv_cube' object as provided function \code{CST_Load} in +package CSTools.} + +\item{start}{An optional 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. By default it is set +to NULL and the indicator is computed using all the data provided in +\code{data}.} + +\item{end}{An optional 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. By default it is set to NULL +and the indicator is computed using all the data provided in \code{data}.} + +\item{time_dim}{A character string indicating the name of the dimension to +compute the indicator. 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.} + +\item{na.rm}{A logical value indicating whether to ignore NA values (TRUE) or +not (FALSE).} + +\item{ncores}{An integer indicating the number of cores to use in parallel +computation.} +} +\value{ +An 's2dv_cube' object containing the indicator in the element +\code{data} with dimensions of the input parameter 'data' except the +dimension where the var has been computed (specified with 'time_dim'). A new +element called 'time_bounds' will be added into the 'attrs' element in the +'s2dv_cube' object. It consists of a list containing two elements, the start +and end dates of the aggregated period with the same dimensions of 'Dates' +element. +} +\description{ +Period Variance computes the average (var) of a given variable in a period. +Two bioclimatic indicators can be obtained by using this function: +\itemize{ + \item\code{BIO4}{(Providing temperature data) Temperature Seasonality + (Standard Deviation). The amount of temperature variation + over a given year (or averaged years) based on the standard + deviation (variation) of monthly temperature averages. } + \item\code{BIO15}{(Providing precipitation data) Precipitation Seasonality + (CV). This is a measure of the variation in + monthly precipitation totals over the course of the year. + This index is the ratio of the standard deviation of the + monthly total precipitation to the mean monthly total + precipitation (also known as the coefficient of variation) + and is expressed as a percentage} +} +} +\examples{ +exp <- NULL +exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2002-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2002-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) +dim(Dates) <- c(sdate = 4, ftime = 3) +exp$attrs$Dates <- Dates +class(exp) <- 's2dv_cube' + +res <- CST_PeriodVariance(exp, start = list(01, 12), end = list(01, 01)) + +} diff --git a/man/PeriodFun.Rd b/man/PeriodFun.Rd new file mode 100644 index 0000000..9378273 --- /dev/null +++ b/man/PeriodFun.Rd @@ -0,0 +1,70 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PeriodFun.R +\name{PeriodFun} +\alias{PeriodFun} +\title{Period Function on multidimensional array objects} +\usage{ +PeriodFun( + data, + fun, + dates = NULL, + start = NULL, + end = NULL, + time_dim = "ftime", + na.rm = FALSE, + ncores = NULL +) +} +\arguments{ +\item{data}{A multidimensional array with named dimensions.} + +\item{fun}{An atomic function to compute a calculation over a period.} + +\item{dates}{A multidimensional array of dates with named dimensions matching +the temporal dimensions on parameter 'data'. By default it is NULL, to +select aperiod this parameter must be provided.} + +\item{start}{An optional 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. By default it is set +to NULL and the indicator is computed using all the data provided in +\code{data}.} + +\item{end}{An optional 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. By default it is set to NULL +and the indicator is computed using all the data provided in \code{data}.} + +\item{time_dim}{A character string indicating the name of the dimension to +compute the indicator. 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.} + +\item{na.rm}{A logical value indicating whether to ignore NA values (TRUE) or +not (FALSE).} + +\item{ncores}{An integer indicating the number of cores to use in parallel +computation.} +} +\value{ +A multidimensional array with named dimensions containing the +indicator in the element \code{data}. +} +\description{ +Period Fun computes a calculation of a given variable in a period. +} +\examples{ +data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2002-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2002-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) +dim(Dates) <- c(sdate = 4, ftime = 3) +SA <- PeriodFun(data, fun = mean, dates = Dates, start = list(01, 12), + end = list(01, 01)) + +} diff --git a/man/PeriodMax.Rd b/man/PeriodMax.Rd new file mode 100644 index 0000000..26e62a4 --- /dev/null +++ b/man/PeriodMax.Rd @@ -0,0 +1,76 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PeriodMax.R +\name{PeriodMax} +\alias{PeriodMax} +\title{Period max on multidimensional array objects} +\usage{ +PeriodMax( + data, + dates = NULL, + start = NULL, + end = NULL, + time_dim = "ftime", + na.rm = FALSE, + ncores = NULL +) +} +\arguments{ +\item{data}{A multidimensional array with named dimensions.} + +\item{dates}{A multidimensional array of dates with named dimensions matching +the temporal dimensions on parameter 'data'. By default it is NULL, to +select aperiod this parameter must be provided.} + +\item{start}{An optional 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. By default it is set +to NULL and the indicator is computed using all the data provided in +\code{data}.} + +\item{end}{An optional 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. By default it is set to NULL +and the indicator is computed using all the data provided in \code{data}.} + +\item{time_dim}{A character string indicating the name of the dimension to +compute the indicator. 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.} + +\item{na.rm}{A logical value indicating whether to ignore NA values (TRUE) or +not (FALSE).} + +\item{ncores}{An integer indicating the number of cores to use in parallel +computation.} +} +\value{ +A multidimensional array with named dimensions containing the +indicator in the element \code{data}. +} +\description{ +Period max computes the average (max) of a given variable in a period. +Two bioclimatic indicators can be obtained by using this function: +\itemize{ + \item\code{BIO5}{(Providing temperature data) Max Temperature of Warmest + Month. The maximum monthly temperature occurrence over a + given year (time-series) or averaged span of years + (normal).} + \item\code{BIO13}{(Providing precipitation data) Precipitation of Wettest + Month. This index identifies the total precipitation + that prevails during the wettest month.} +} +} +\examples{ +data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2002-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2002-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) +dim(Dates) <- c(sdate = 4, ftime = 3) +res <- PeriodMax(data, dates = Dates, start = list(01, 12), end = list(01, 01)) + +} diff --git a/man/PeriodMin.Rd b/man/PeriodMin.Rd new file mode 100644 index 0000000..72d6c78 --- /dev/null +++ b/man/PeriodMin.Rd @@ -0,0 +1,76 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PeriodMin.R +\name{PeriodMin} +\alias{PeriodMin} +\title{Period Min on multidimensional array objects} +\usage{ +PeriodMin( + data, + dates = NULL, + start = NULL, + end = NULL, + time_dim = "ftime", + na.rm = FALSE, + ncores = NULL +) +} +\arguments{ +\item{data}{A multidimensional array with named dimensions.} + +\item{dates}{A multidimensional array of dates with named dimensions matching +the temporal dimensions on parameter 'data'. By default it is NULL, to +select aperiod this parameter must be provided.} + +\item{start}{An optional 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. By default it is set +to NULL and the indicator is computed using all the data provided in +\code{data}.} + +\item{end}{An optional 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. By default it is set to NULL +and the indicator is computed using all the data provided in \code{data}.} + +\item{time_dim}{A character string indicating the name of the dimension to +compute the indicator. 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.} + +\item{na.rm}{A logical value indicating whether to ignore NA values (TRUE) or +not (FALSE).} + +\item{ncores}{An integer indicating the number of cores to use in parallel +computation.} +} +\value{ +A multidimensional array with named dimensions containing the +indicator in the element \code{data}. +} +\description{ +Period Min computes the average (min) of a given variable in a period. +Two bioclimatic indicators can be obtained by using this function: +\itemize{ + \item\code{BIO6}{(Providing temperature data) Min Temperature of Coldest + Month. The minimum monthly temperature occurrence over a + given year (time-series) or averaged span of years + (normal).} + \item\code{BIO14}{(Providing precipitation data) Precipitation of Driest + Month. This index identifies the total precipitation + that prevails during the driest month.} +} +} +\examples{ +data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2002-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2002-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) +dim(Dates) <- c(sdate = 4, ftime = 3) +res <- PeriodMin(data, dates = Dates, start = list(01, 12), end = list(01, 01)) + +} diff --git a/man/PeriodVariance.Rd b/man/PeriodVariance.Rd new file mode 100644 index 0000000..be4a243 --- /dev/null +++ b/man/PeriodVariance.Rd @@ -0,0 +1,80 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PeriodVariance.R +\name{PeriodVariance} +\alias{PeriodVariance} +\title{Period Variance on multidimensional array objects} +\usage{ +PeriodVariance( + data, + dates = NULL, + start = NULL, + end = NULL, + time_dim = "ftime", + na.rm = FALSE, + ncores = NULL +) +} +\arguments{ +\item{data}{A multidimensional array with named dimensions.} + +\item{dates}{A multidimensional array of dates with named dimensions matching +the temporal dimensions on parameter 'data'. By default it is NULL, to +select aperiod this parameter must be provided.} + +\item{start}{An optional 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. By default it is set +to NULL and the indicator is computed using all the data provided in +\code{data}.} + +\item{end}{An optional 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. By default it is set to NULL +and the indicator is computed using all the data provided in \code{data}.} + +\item{time_dim}{A character string indicating the name of the dimension to +compute the indicator. 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.} + +\item{na.rm}{A logical value indicating whether to ignore NA values (TRUE) or +not (FALSE).} + +\item{ncores}{An integer indicating the number of cores to use in parallel +computation.} +} +\value{ +A multidimensional array with named dimensions containing the +indicator in the element \code{data}. +} +\description{ +Period Variance computes the average (var) of a given variable in a period. +Two bioclimatic indicators can be obtained by using this function: +\itemize{ + \item\code{BIO4}{(Providing temperature data) Temperature Seasonality + (Standard Deviation). The amount of temperature variation + over a given year (or averaged years) based on the standard + deviation (variation) of monthly temperature averages. } + \item\code{BIO15}{(Providing precipitation data) Precipitation Seasonality + (CV). This is a measure of the variation in + monthly precipitation totals over the course of the year. + This index is the ratio of the standard deviation of the + monthly total precipitation to the mean monthly total + precipitation (also known as the coefficient of variation) + and is expressed as a percentage} +} +} +\examples{ +data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2002-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2002-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), + seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), + as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) +dim(Dates) <- c(sdate = 4, ftime = 3) +res <- PeriodVariance(data, dates = Dates, start = list(01, 12), end = list(01, 01)) + +} -- GitLab From 70ec75370d642254964bcd0f23be585ad0f61885 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Fri, 28 Jul 2023 14:45:54 +0200 Subject: [PATCH 3/5] Hide function PeriodFun from CSIndicators package; the function PeriodFun will remain hidden --- DESCRIPTION | 2 +- NAMESPACE | 2 -- R/PeriodFun.R | 24 +++++++------- man/CST_PeriodFun.Rd | 75 -------------------------------------------- man/PeriodFun.Rd | 70 ----------------------------------------- 5 files changed, 13 insertions(+), 160 deletions(-) delete mode 100644 man/CST_PeriodFun.Rd delete mode 100644 man/PeriodFun.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 4151ba4..4e20983 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,4 +40,4 @@ URL: https://earth.bsc.es/gitlab/es/csindicators/ BugReports: https://earth.bsc.es/gitlab/es/csindicators/-/issues Encoding: UTF-8 RoxygenNote: 7.2.0 -Config/testthat/edition: 3 \ No newline at end of file +Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index f02cee5..d92da37 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,6 @@ export(CST_AbsToProbs) export(CST_AccumulationExceedingThreshold) export(CST_MergeRefToExp) export(CST_PeriodAccumulation) -export(CST_PeriodFun) export(CST_PeriodMax) export(CST_PeriodMean) export(CST_PeriodMin) @@ -20,7 +19,6 @@ export(CST_WindCapacityFactor) export(CST_WindPowerDensity) export(MergeRefToExp) export(PeriodAccumulation) -export(PeriodFun) export(PeriodMax) export(PeriodMean) export(PeriodMin) diff --git a/R/PeriodFun.R b/R/PeriodFun.R index 9c33ba2..77484a1 100644 --- a/R/PeriodFun.R +++ b/R/PeriodFun.R @@ -46,15 +46,15 @@ #'exp$attrs$Dates <- Dates #'class(exp) <- 's2dv_cube' #' -#'SA <- CST_PeriodFun(exp, fun = mean, start = list(01, 12), -#' end = list(01, 01)) +#'SA <- CSIndicators:::.CST_PeriodFun(exp, fun = mean, start = list(01, 12), +#' end = list(01, 01)) #' #'@import multiApply #'@importFrom ClimProjDiags Subset -#'@export -CST_PeriodFun <- function(data, fun, start = NULL, end = NULL, - time_dim = 'ftime', na.rm = FALSE, - ncores = NULL) { +#'@noRd +.CST_PeriodFun <- function(data, fun, start = NULL, end = NULL, + time_dim = 'ftime', na.rm = FALSE, + ncores = NULL) { # Check 's2dv_cube' if (!inherits(data, 's2dv_cube')) { stop("Parameter 'data' must be of the class 's2dv_cube'.") @@ -70,9 +70,9 @@ CST_PeriodFun <- function(data, fun, start = NULL, end = NULL, } Dates <- data$attrs$Dates - total <- PeriodFun(data = data$data, fun = fun, dates = Dates, start = start, - end = end, time_dim = time_dim, na.rm = na.rm, - ncores = ncores) + total <- CSIndicators:::.PeriodFun(data = data$data, fun = fun, dates = Dates, start = start, + end = end, time_dim = time_dim, na.rm = na.rm, + ncores = ncores) data$data <- total data$dims <- dim(total) @@ -144,12 +144,12 @@ CST_PeriodFun <- function(data, fun, start = NULL, end = NULL, #' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) #'dim(Dates) <- c(sdate = 4, ftime = 3) -#'SA <- PeriodFun(data, fun = mean, dates = Dates, start = list(01, 12), +#'SA <- CSIndicators:::.PeriodFun(data, fun = mean, dates = Dates, start = list(01, 12), #' end = list(01, 01)) #' #'@import multiApply -#'@export -PeriodFun <- function(data, fun, dates = NULL, start = NULL, end = NULL, +#'@noRd +.PeriodFun <- function(data, fun, dates = NULL, start = NULL, end = NULL, time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { if (is.null(data)) { diff --git a/man/CST_PeriodFun.Rd b/man/CST_PeriodFun.Rd deleted file mode 100644 index 1ffe32b..0000000 --- a/man/CST_PeriodFun.Rd +++ /dev/null @@ -1,75 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/PeriodFun.R -\name{CST_PeriodFun} -\alias{CST_PeriodFun} -\title{Period Function on 's2dv_cube' objects} -\usage{ -CST_PeriodFun( - data, - fun, - start = NULL, - end = NULL, - time_dim = "ftime", - na.rm = FALSE, - ncores = NULL -) -} -\arguments{ -\item{data}{An 's2dv_cube' object as provided function \code{CST_Load} in -package CSTools.} - -\item{fun}{An atomic function to compute a calculation over a period.} - -\item{start}{An optional 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. By default it is set -to NULL and the indicator is computed using all the data provided in -\code{data}.} - -\item{end}{An optional 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. By default it is set to NULL -and the indicator is computed using all the data provided in \code{data}.} - -\item{time_dim}{A character string indicating the name of the dimension to -compute the indicator. 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.} - -\item{na.rm}{A logical value indicating whether to ignore NA values (TRUE) or -not (FALSE).} - -\item{ncores}{An integer indicating the number of cores to use in parallel -computation.} -} -\value{ -An 's2dv_cube' object containing the indicator in the element -\code{data} with dimensions of the input parameter 'data' except the -dimension where the mean has been computed (specified with 'time_dim'). A new -element called 'time_bounds' will be added into the 'attrs' element in the -'s2dv_cube' object. It consists of a list containing two elements, the start -and end dates of the aggregated period with the same dimensions of 'Dates' -element. -} -\description{ -Period Fun computes a calculation of a given variable in a period. -} -\examples{ -exp <- NULL -exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) -Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), - as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), - seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), - as.Date("2002-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), - seq(as.Date("2002-11-01", "\%Y-\%m-\%d", tz = "UTC"), - as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), - seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), - as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) -dim(Dates) <- c(sdate = 4, ftime = 3) -exp$attrs$Dates <- Dates -class(exp) <- 's2dv_cube' - -SA <- CST_PeriodFun(exp, fun = mean, start = list(01, 12), - end = list(01, 01)) - -} diff --git a/man/PeriodFun.Rd b/man/PeriodFun.Rd deleted file mode 100644 index 9378273..0000000 --- a/man/PeriodFun.Rd +++ /dev/null @@ -1,70 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/PeriodFun.R -\name{PeriodFun} -\alias{PeriodFun} -\title{Period Function on multidimensional array objects} -\usage{ -PeriodFun( - data, - fun, - dates = NULL, - start = NULL, - end = NULL, - time_dim = "ftime", - na.rm = FALSE, - ncores = NULL -) -} -\arguments{ -\item{data}{A multidimensional array with named dimensions.} - -\item{fun}{An atomic function to compute a calculation over a period.} - -\item{dates}{A multidimensional array of dates with named dimensions matching -the temporal dimensions on parameter 'data'. By default it is NULL, to -select aperiod this parameter must be provided.} - -\item{start}{An optional 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. By default it is set -to NULL and the indicator is computed using all the data provided in -\code{data}.} - -\item{end}{An optional 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. By default it is set to NULL -and the indicator is computed using all the data provided in \code{data}.} - -\item{time_dim}{A character string indicating the name of the dimension to -compute the indicator. 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.} - -\item{na.rm}{A logical value indicating whether to ignore NA values (TRUE) or -not (FALSE).} - -\item{ncores}{An integer indicating the number of cores to use in parallel -computation.} -} -\value{ -A multidimensional array with named dimensions containing the -indicator in the element \code{data}. -} -\description{ -Period Fun computes a calculation of a given variable in a period. -} -\examples{ -data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) -Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), - as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), - seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), - as.Date("2002-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), - seq(as.Date("2002-11-01", "\%Y-\%m-\%d", tz = "UTC"), - as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), - seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), - as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) -dim(Dates) <- c(sdate = 4, ftime = 3) -SA <- PeriodFun(data, fun = mean, dates = Dates, start = list(01, 12), - end = list(01, 01)) - -} -- GitLab From 7fcf6a9a1fca8759e853f2fc217531ddf7dd10a2 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Tue, 3 Oct 2023 15:53:01 +0200 Subject: [PATCH 4/5] Improve initial checks and change default value time_dim to 'time' --- R/PeriodFun.R | 190 --------------------------- R/PeriodMax.R | 23 +++- R/PeriodMean.R | 19 ++- R/PeriodMin.R | 23 +++- R/PeriodVariance.R | 23 +++- man/CST_PeriodMax.Rd | 4 +- man/CST_PeriodMean.Rd | 4 +- man/CST_PeriodMin.Rd | 4 +- man/CST_PeriodVariance.Rd | 4 +- man/PeriodMax.Rd | 4 +- man/PeriodMin.Rd | 4 +- man/PeriodVariance.Rd | 4 +- tests/testthat/test-PeriodFun.R | 120 ----------------- tests/testthat/test-PeriodMax.R | 30 +++-- tests/testthat/test-PeriodMean.R | 22 +++- tests/testthat/test-PeriodMin.R | 22 +++- tests/testthat/test-PeriodVariance.R | 18 ++- 17 files changed, 142 insertions(+), 376 deletions(-) delete mode 100644 R/PeriodFun.R delete mode 100644 tests/testthat/test-PeriodFun.R diff --git a/R/PeriodFun.R b/R/PeriodFun.R deleted file mode 100644 index 77484a1..0000000 --- a/R/PeriodFun.R +++ /dev/null @@ -1,190 +0,0 @@ -#'Period Function on 's2dv_cube' objects -#' -#'Period Fun computes a calculation of a given variable in a period. -#' -#'@param data An 's2dv_cube' object as provided function \code{CST_Load} in -#' package CSTools. -#'@param fun An atomic function to compute a calculation over a period. -#'@param start An optional 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. By default it is set -#' to NULL and the indicator is computed using all the data provided in -#' \code{data}. -#'@param end An optional 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. By default it is set to NULL -#' and the indicator is computed using all the data provided in \code{data}. -#'@param time_dim A character string indicating the name of the dimension to -#' compute the indicator. 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 na.rm A logical value indicating whether to ignore NA values (TRUE) or -#' not (FALSE). -#'@param ncores An integer indicating the number of cores to use in parallel -#' computation. -#' -#'@return An 's2dv_cube' object containing the indicator in the element -#'\code{data} with dimensions of the input parameter 'data' except the -#'dimension where the mean has been computed (specified with 'time_dim'). A new -#'element called 'time_bounds' will be added into the 'attrs' element in the -#''s2dv_cube' object. It consists of a list containing two elements, the start -#'and end dates of the aggregated period with the same dimensions of 'Dates' -#'element. -#' -#'@examples -#'exp <- NULL -#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) -#'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), -#' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), -#' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), -#' as.Date("2002-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), -#' seq(as.Date("2002-11-01", "%Y-%m-%d", tz = "UTC"), -#' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), -#' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), -#' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) -#'dim(Dates) <- c(sdate = 4, ftime = 3) -#'exp$attrs$Dates <- Dates -#'class(exp) <- 's2dv_cube' -#' -#'SA <- CSIndicators:::.CST_PeriodFun(exp, fun = mean, start = list(01, 12), -#' end = list(01, 01)) -#' -#'@import multiApply -#'@importFrom ClimProjDiags Subset -#'@noRd -.CST_PeriodFun <- function(data, fun, start = NULL, end = NULL, - time_dim = 'ftime', na.rm = FALSE, - ncores = NULL) { - # Check 's2dv_cube' - if (!inherits(data, 's2dv_cube')) { - stop("Parameter 'data' must be of the class 's2dv_cube'.") - } - # Dates subset - if (!is.null(start) && !is.null(end)) { - if (is.null(dim(data$attrs$Dates))) { - warning("Dimensions in 'data' element 'attrs$Dates' are missed and ", - "all data would be used.") - start <- NULL - end <- NULL - } - } - - Dates <- data$attrs$Dates - total <- CSIndicators:::.PeriodFun(data = data$data, fun = fun, dates = Dates, start = start, - end = end, time_dim = time_dim, na.rm = na.rm, - ncores = ncores) - - data$data <- total - data$dims <- dim(total) - - if (!is.null(Dates)) { - if (!is.null(start) && !is.null(end)) { - Dates <- SelectPeriodOnDates(dates = Dates, start = start, end = end, - time_dim = time_dim, ncores = ncores) - } - if (is.null(dim(Dates))) { - warning("Element 'Dates' has NULL dimensions. They will not be ", - "subset and 'time_bounds' will be missed.") - data$attrs$Dates <- Dates - } else { - # Create time_bounds - time_bounds <- NULL - time_bounds$start <- ClimProjDiags::Subset(x = Dates, along = time_dim, - indices = 1, drop = 'selected') - time_bounds$end <- ClimProjDiags::Subset(x = Dates, along = time_dim, - indices = dim(Dates)[time_dim], - drop = 'selected') - - # Add Dates in attrs - data$attrs$Dates <- time_bounds$start - data$attrs$time_bounds <- time_bounds - } - } - return(data) -} - -#'Period Function on multidimensional array objects -#' -#'Period Fun computes a calculation of a given variable in a period. -#' -#'@param data A multidimensional array with named dimensions. -#'@param fun An atomic function to compute a calculation over a period. -#'@param dates A multidimensional array of dates with named dimensions matching -#' the temporal dimensions on parameter 'data'. By default it is NULL, to -#' select aperiod this parameter must be provided. -#'@param start An optional 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. By default it is set -#' to NULL and the indicator is computed using all the data provided in -#' \code{data}. -#'@param end An optional 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. By default it is set to NULL -#' and the indicator is computed using all the data provided in \code{data}. -#'@param time_dim A character string indicating the name of the dimension to -#' compute the indicator. 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 na.rm A logical value indicating whether to ignore NA values (TRUE) or -#' not (FALSE). -#'@param ncores An integer indicating the number of cores to use in parallel -#' computation. -#' -#'@return A multidimensional array with named dimensions containing the -#'indicator in the element \code{data}. -#' -#'@examples -#'data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) -#'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), -#' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), -#' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), -#' as.Date("2002-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), -#' seq(as.Date("2002-11-01", "%Y-%m-%d", tz = "UTC"), -#' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), -#' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), -#' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) -#'dim(Dates) <- c(sdate = 4, ftime = 3) -#'SA <- CSIndicators:::.PeriodFun(data, fun = mean, dates = Dates, start = list(01, 12), -#' end = list(01, 01)) -#' -#'@import multiApply -#'@noRd -.PeriodFun <- function(data, fun, dates = NULL, start = NULL, end = NULL, - time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { - - if (is.null(data)) { - stop("Parameter 'data' cannot be NULL.") - } - if (!is.numeric(data)) { - stop("Parameter 'data' must be numeric.") - } - if (!is.array(data)) { - dim(data) <- length(data) - names(data) <- time_dim - } - - if (!is.null(start) && !is.null(end)) { - if (is.null(dates)) { - warning("Parameter 'dates' is NULL and the average of the ", - "full data provided in 'data' is computed.") - } else { - if (!any(c(is.list(start), is.list(end)))) { - stop("Parameter 'start' and 'end' must be lists indicating the ", - "day and the month of the period start and end.") - } - if (!is.null(dim(dates))) { - data <- SelectPeriodOnData(data = data, dates = dates, start = start, - end = end, time_dim = time_dim, - ncores = ncores) - } else { - warning("Parameter 'dates' must have named dimensions if 'start' and ", - "'end' are not NULL. All data will be used.") - } - } - } - total <- Apply(list(data), target_dims = time_dim, fun = fun, - na.rm = na.rm, ncores = ncores)$output1 - return(total) -} - - diff --git a/R/PeriodMax.R b/R/PeriodMax.R index 0d47033..b8df92b 100644 --- a/R/PeriodMax.R +++ b/R/PeriodMax.R @@ -24,7 +24,7 @@ #' the period and the final month of the period. By default it is set to NULL #' and the indicator is computed using all the data provided in \code{data}. #'@param time_dim A character string indicating the name of the dimension to -#' compute the indicator. By default, it is set to 'ftime'. More than one +#' compute the indicator. By default, it is set to 'time'. More than one #' dimension name matching the dimensions provided in the object #' \code{data$data} can be specified. #'@param na.rm A logical value indicating whether to ignore NA values (TRUE) or @@ -61,12 +61,13 @@ #'@importFrom ClimProjDiags Subset #'@export CST_PeriodMax <- function(data, start = NULL, end = NULL, - time_dim = 'ftime', na.rm = FALSE, + time_dim = 'time', na.rm = FALSE, ncores = NULL) { - # Check 's2dv_cube' + # Check 's2dv_cube' if (!inherits(data, 's2dv_cube')) { stop("Parameter 'data' must be of the class 's2dv_cube'.") } + # Dates subset if (!is.null(start) && !is.null(end)) { if (is.null(dim(data$attrs$Dates))) { @@ -138,7 +139,7 @@ CST_PeriodMax <- function(data, start = NULL, end = NULL, #' the period and the final month of the period. By default it is set to NULL #' and the indicator is computed using all the data provided in \code{data}. #'@param time_dim A character string indicating the name of the dimension to -#' compute the indicator. By default, it is set to 'ftime'. More than one +#' compute the indicator. By default, it is set to 'time'. More than one #' dimension name matching the dimensions provided in the object #' \code{data$data} can be specified. #'@param na.rm A logical value indicating whether to ignore NA values (TRUE) or @@ -165,17 +166,25 @@ CST_PeriodMax <- function(data, start = NULL, end = NULL, #'@import multiApply #'@export PeriodMax <- function(data, dates = NULL, start = NULL, end = NULL, - time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { - + time_dim = 'time', na.rm = FALSE, ncores = NULL) { + # Initial checks + ## data if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") } if (!is.numeric(data)) { stop("Parameter 'data' must be numeric.") } + ## time_dim + if (!is.character(time_dim) | length(time_dim) != 1) { + stop("Parameter 'time_dim' must be a character string.") + } if (!is.array(data)) { dim(data) <- length(data) - names(data) <- time_dim + names(dim(data)) <- time_dim + } + if (!time_dim %in% names(dim(data))) { + stop("Parameter 'time_dim' is not found in 'data' dimension.") } if (!is.null(start) && !is.null(end)) { diff --git a/R/PeriodMean.R b/R/PeriodMean.R index db6a78f..79deb5d 100644 --- a/R/PeriodMean.R +++ b/R/PeriodMean.R @@ -22,7 +22,7 @@ #' the period and the final month of the period. By default it is set to NULL #' and the indicator is computed using all the data provided in \code{data}. #'@param time_dim A character string indicating the name of the dimension to -#' compute the indicator. By default, it is set to 'ftime'. More than one +#' compute the indicator. By default, it is set to 'time'. More than one #' dimension name matching the dimensions provided in the object #' \code{data$data} can be specified. #'@param na.rm A logical value indicating whether to ignore NA values (TRUE) or @@ -60,12 +60,13 @@ #'@importFrom ClimProjDiags Subset #'@export CST_PeriodMean <- function(data, start = NULL, end = NULL, - time_dim = 'ftime', na.rm = FALSE, + time_dim = 'time', na.rm = FALSE, ncores = NULL) { - # Check 's2dv_cube' + # Check 's2dv_cube' if (!inherits(data, 's2dv_cube')) { stop("Parameter 'data' must be of the class 's2dv_cube'.") } + # Dates subset if (!is.null(start) && !is.null(end)) { if (is.null(dim(data$attrs$Dates))) { @@ -163,16 +164,24 @@ CST_PeriodMean <- function(data, start = NULL, end = NULL, #'@export PeriodMean <- function(data, dates = NULL, start = NULL, end = NULL, time_dim = 'time', na.rm = FALSE, ncores = NULL) { - + # Initial checks + ## data if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") } if (!is.numeric(data)) { stop("Parameter 'data' must be numeric.") } + ## time_dim + if (!is.character(time_dim) | length(time_dim) != 1) { + stop("Parameter 'time_dim' must be a character string.") + } if (!is.array(data)) { dim(data) <- length(data) - names(data) <- time_dim + names(dim(data)) <- time_dim + } + if (!time_dim %in% names(dim(data))) { + stop("Parameter 'time_dim' is not found in 'data' dimension.") } if (!is.null(start) && !is.null(end)) { diff --git a/R/PeriodMin.R b/R/PeriodMin.R index f5ea5b0..0365d47 100644 --- a/R/PeriodMin.R +++ b/R/PeriodMin.R @@ -24,7 +24,7 @@ #' the period and the final month of the period. By default it is set to NULL #' and the indicator is computed using all the data provided in \code{data}. #'@param time_dim A character string indicating the name of the dimension to -#' compute the indicator. By default, it is set to 'ftime'. More than one +#' compute the indicator. By default, it is set to 'time'. More than one #' dimension name matching the dimensions provided in the object #' \code{data$data} can be specified. #'@param na.rm A logical value indicating whether to ignore NA values (TRUE) or @@ -61,12 +61,13 @@ #'@importFrom ClimProjDiags Subset #'@export CST_PeriodMin <- function(data, start = NULL, end = NULL, - time_dim = 'ftime', na.rm = FALSE, + time_dim = 'time', na.rm = FALSE, ncores = NULL) { - # Check 's2dv_cube' + # Check 's2dv_cube' if (!inherits(data, 's2dv_cube')) { stop("Parameter 'data' must be of the class 's2dv_cube'.") } + # Dates subset if (!is.null(start) && !is.null(end)) { if (is.null(dim(data$attrs$Dates))) { @@ -138,7 +139,7 @@ CST_PeriodMin <- function(data, start = NULL, end = NULL, #' the period and the final month of the period. By default it is set to NULL #' and the indicator is computed using all the data provided in \code{data}. #'@param time_dim A character string indicating the name of the dimension to -#' compute the indicator. By default, it is set to 'ftime'. More than one +#' compute the indicator. By default, it is set to 'time'. More than one #' dimension name matching the dimensions provided in the object #' \code{data$data} can be specified. #'@param na.rm A logical value indicating whether to ignore NA values (TRUE) or @@ -165,17 +166,25 @@ CST_PeriodMin <- function(data, start = NULL, end = NULL, #'@import multiApply #'@export PeriodMin <- function(data, dates = NULL, start = NULL, end = NULL, - time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { - + time_dim = 'time', na.rm = FALSE, ncores = NULL) { + # Initial checks + ## data if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") } if (!is.numeric(data)) { stop("Parameter 'data' must be numeric.") } + ## time_dim + if (!is.character(time_dim) | length(time_dim) != 1) { + stop("Parameter 'time_dim' must be a character string.") + } if (!is.array(data)) { dim(data) <- length(data) - names(data) <- time_dim + names(dim(data)) <- time_dim + } + if (!time_dim %in% names(dim(data))) { + stop("Parameter 'time_dim' is not found in 'data' dimension.") } if (!is.null(start) && !is.null(end)) { diff --git a/R/PeriodVariance.R b/R/PeriodVariance.R index b9f3cff..d6b0153 100644 --- a/R/PeriodVariance.R +++ b/R/PeriodVariance.R @@ -28,7 +28,7 @@ #' the period and the final month of the period. By default it is set to NULL #' and the indicator is computed using all the data provided in \code{data}. #'@param time_dim A character string indicating the name of the dimension to -#' compute the indicator. By default, it is set to 'ftime'. More than one +#' compute the indicator. By default, it is set to 'time'. More than one #' dimension name matching the dimensions provided in the object #' \code{data$data} can be specified. #'@param na.rm A logical value indicating whether to ignore NA values (TRUE) or @@ -65,12 +65,13 @@ #'@importFrom ClimProjDiags Subset #'@export CST_PeriodVariance <- function(data, start = NULL, end = NULL, - time_dim = 'ftime', na.rm = FALSE, + time_dim = 'time', na.rm = FALSE, ncores = NULL) { - # Check 's2dv_cube' + # Check 's2dv_cube' if (!inherits(data, 's2dv_cube')) { stop("Parameter 'data' must be of the class 's2dv_cube'.") } + # Dates subset if (!is.null(start) && !is.null(end)) { if (is.null(dim(data$attrs$Dates))) { @@ -146,7 +147,7 @@ CST_PeriodVariance <- function(data, start = NULL, end = NULL, #' the period and the final month of the period. By default it is set to NULL #' and the indicator is computed using all the data provided in \code{data}. #'@param time_dim A character string indicating the name of the dimension to -#' compute the indicator. By default, it is set to 'ftime'. More than one +#' compute the indicator. By default, it is set to 'time'. More than one #' dimension name matching the dimensions provided in the object #' \code{data$data} can be specified. #'@param na.rm A logical value indicating whether to ignore NA values (TRUE) or @@ -173,17 +174,25 @@ CST_PeriodVariance <- function(data, start = NULL, end = NULL, #'@import multiApply #'@export PeriodVariance <- function(data, dates = NULL, start = NULL, end = NULL, - time_dim = 'ftime', na.rm = FALSE, ncores = NULL) { - + time_dim = 'time', na.rm = FALSE, ncores = NULL) { + # Initial checks + ## data if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") } if (!is.numeric(data)) { stop("Parameter 'data' must be numeric.") } + ## time_dim + if (!is.character(time_dim) | length(time_dim) != 1) { + stop("Parameter 'time_dim' must be a character string.") + } if (!is.array(data)) { dim(data) <- length(data) - names(data) <- time_dim + names(dim(data)) <- time_dim + } + if (!time_dim %in% names(dim(data))) { + stop("Parameter 'time_dim' is not found in 'data' dimension.") } if (!is.null(start) && !is.null(end)) { diff --git a/man/CST_PeriodMax.Rd b/man/CST_PeriodMax.Rd index 02a4a8a..52d3cd6 100644 --- a/man/CST_PeriodMax.Rd +++ b/man/CST_PeriodMax.Rd @@ -8,7 +8,7 @@ CST_PeriodMax( data, start = NULL, end = NULL, - time_dim = "ftime", + time_dim = "time", na.rm = FALSE, ncores = NULL ) @@ -29,7 +29,7 @@ the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.} \item{time_dim}{A character string indicating the name of the dimension to -compute the indicator. By default, it is set to 'ftime'. More than one +compute the indicator. By default, it is set to 'time'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified.} diff --git a/man/CST_PeriodMean.Rd b/man/CST_PeriodMean.Rd index 0aa4aa3..7b4611c 100644 --- a/man/CST_PeriodMean.Rd +++ b/man/CST_PeriodMean.Rd @@ -8,7 +8,7 @@ CST_PeriodMean( data, start = NULL, end = NULL, - time_dim = "ftime", + time_dim = "time", na.rm = FALSE, ncores = NULL ) @@ -29,7 +29,7 @@ the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.} \item{time_dim}{A character string indicating the name of the dimension to -compute the indicator. By default, it is set to 'ftime'. More than one +compute the indicator. By default, it is set to 'time'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified.} diff --git a/man/CST_PeriodMin.Rd b/man/CST_PeriodMin.Rd index 7076ccd..bfe48f4 100644 --- a/man/CST_PeriodMin.Rd +++ b/man/CST_PeriodMin.Rd @@ -8,7 +8,7 @@ CST_PeriodMin( data, start = NULL, end = NULL, - time_dim = "ftime", + time_dim = "time", na.rm = FALSE, ncores = NULL ) @@ -29,7 +29,7 @@ the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.} \item{time_dim}{A character string indicating the name of the dimension to -compute the indicator. By default, it is set to 'ftime'. More than one +compute the indicator. By default, it is set to 'time'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified.} diff --git a/man/CST_PeriodVariance.Rd b/man/CST_PeriodVariance.Rd index fa68197..064cc5c 100644 --- a/man/CST_PeriodVariance.Rd +++ b/man/CST_PeriodVariance.Rd @@ -8,7 +8,7 @@ CST_PeriodVariance( data, start = NULL, end = NULL, - time_dim = "ftime", + time_dim = "time", na.rm = FALSE, ncores = NULL ) @@ -29,7 +29,7 @@ the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.} \item{time_dim}{A character string indicating the name of the dimension to -compute the indicator. By default, it is set to 'ftime'. More than one +compute the indicator. By default, it is set to 'time'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified.} diff --git a/man/PeriodMax.Rd b/man/PeriodMax.Rd index 26e62a4..4ec388c 100644 --- a/man/PeriodMax.Rd +++ b/man/PeriodMax.Rd @@ -9,7 +9,7 @@ PeriodMax( dates = NULL, start = NULL, end = NULL, - time_dim = "ftime", + time_dim = "time", na.rm = FALSE, ncores = NULL ) @@ -33,7 +33,7 @@ the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.} \item{time_dim}{A character string indicating the name of the dimension to -compute the indicator. By default, it is set to 'ftime'. More than one +compute the indicator. By default, it is set to 'time'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified.} diff --git a/man/PeriodMin.Rd b/man/PeriodMin.Rd index 72d6c78..04d0b01 100644 --- a/man/PeriodMin.Rd +++ b/man/PeriodMin.Rd @@ -9,7 +9,7 @@ PeriodMin( dates = NULL, start = NULL, end = NULL, - time_dim = "ftime", + time_dim = "time", na.rm = FALSE, ncores = NULL ) @@ -33,7 +33,7 @@ the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.} \item{time_dim}{A character string indicating the name of the dimension to -compute the indicator. By default, it is set to 'ftime'. More than one +compute the indicator. By default, it is set to 'time'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified.} diff --git a/man/PeriodVariance.Rd b/man/PeriodVariance.Rd index be4a243..c49fd3e 100644 --- a/man/PeriodVariance.Rd +++ b/man/PeriodVariance.Rd @@ -9,7 +9,7 @@ PeriodVariance( dates = NULL, start = NULL, end = NULL, - time_dim = "ftime", + time_dim = "time", na.rm = FALSE, ncores = NULL ) @@ -33,7 +33,7 @@ the period and the final month of the period. By default it is set to NULL and the indicator is computed using all the data provided in \code{data}.} \item{time_dim}{A character string indicating the name of the dimension to -compute the indicator. By default, it is set to 'ftime'. More than one +compute the indicator. By default, it is set to 'time'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified.} diff --git a/tests/testthat/test-PeriodFun.R b/tests/testthat/test-PeriodFun.R deleted file mode 100644 index c743aee..0000000 --- a/tests/testthat/test-PeriodFun.R +++ /dev/null @@ -1,120 +0,0 @@ -library(CSTools) - -############################################## -test_that("1. Sanity Checks", { - expect_error( - PeriodFun('x'), - "Parameter 'data' must be numeric." - ) - suppressWarnings( - expect_equal( - PeriodFun(array(1, c(x = 1)), fun = mean, time_dim = 'x'), - 1 - ) - ) - expect_error( - PeriodFun(data = NULL, fun = mean), - "Parameter 'data' cannot be NULL." - ) - expect_error( - PeriodFun(1, fun = mean, dates = '2000-01-01', end = 3, start = 4), - paste0("Parameter 'start' and 'end' must be lists indicating the day ", - "and the month of the period start and end.") - ) - expect_equal( - PeriodFun(array(1:10, c(ftime = 10)), fun = mean), - 5.5 - ) - data <- array(1:24, c(sdate = 2, ftime = 3, lon = 4)) - expect_equal( - PeriodFun(data, fun = min), - array(c(1, 2, 7, 8, 13, 14, 19, 20), - c(sdate = 2, lon = 4)) - ) - # Test dates warning - expect_warning( - PeriodFun(array(1:10, c(ftime = 10)), fun = mean, - dates = seq(as.Date("01-05-2000", format = "%d-%m-%Y"), - as.Date("10-05-2000", format = "%d-%m-%Y"), by = 'day'), - start = list(05, 02), end = list(05, 09)), - paste0("Parameter 'dates' must have named dimensions if 'start' and 'end' ", - "are not NULL. All data will be used.") - ) - # start and end when dates is not provided - expect_warning( - PeriodFun(array(1:10, c(ftime = 10)), fun = sum, - start = list(05, 02), end = list(05, 09)), - paste0("Parameter 'dates' is NULL and the average of the full data ", - "provided in 'data' is computed.") - ) -}) - -############################################## - -test_that("2. Seasonal", { - exp <- NULL - exp$data <- array(1:(1 * 3 * 214 * 2), - c(memb = 1, sdate = 3, ftime = 214, lon = 2)) - exp$dims <- dim(exp$data) - exp$attrs$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')) - dim(exp$attrs$Dates) <- c(ftime = 214, sdate = 3) - class(exp) <- 's2dv_cube' - output <- exp - output$data <- array(c(min(exp$data[1,1,21:82,1]), min(exp$data[1,2,21:82,1]), - min(exp$data[1,3,21:82,1]), min(exp$data[1,1,21:82,2]), - min(exp$data[1,2,21:82,2]), min(exp$data[1,3,21:82,2])), - c(memb = 1, sdate = 3, lon = 2)) - expect_equal( - CST_PeriodFun(exp, fun = min, start = list(21, 4), end = list(21, 6))$data, - output$data - ) -}) - -############################################## -test_that("3. Subset Dates and check time_bounds", { - exp <- CSTools::lonlat_prec - res <- CST_PeriodFun(data = CSTools::lonlat_prec, fun = min, time_dim = 'ftime', - start = list(10, 03), end = list(20, 03)) - # Check dims - expect_equal( - dim(res$data), - res$dims - ) - # Check Dates - expect_equal( - dim(res$data)['sdate'], - dim(res$attrs$Dates) - ) - # Check time_bounds - expect_equal( - res$attrs$Dates, - res$attrs$time_bounds$start - ) - expect_equal( - dim(res$attrs$time_bounds$start), - dim(res$attrs$time_bounds$end) - ) - # Check 'sdates' - expect_equal( - all(lubridate::month(res$attrs$time_bounds$start) == 3), - TRUE - ) - expect_equal( - all(lubridate::day(res$attrs$time_bounds$start) == 10), - TRUE - ) - expect_equal( - all(lubridate::month(res$attrs$time_bounds$end) == 03), - TRUE - ) - expect_equal( - all(lubridate::day(res$attrs$time_bounds$end) == 20), - TRUE - ) -}) - diff --git a/tests/testthat/test-PeriodMax.R b/tests/testthat/test-PeriodMax.R index 967b086..97907e6 100644 --- a/tests/testthat/test-PeriodMax.R +++ b/tests/testthat/test-PeriodMax.R @@ -2,31 +2,41 @@ library(CSTools) ############################################## test_that("1. Sanity Checks", { + # data + expect_error( + PeriodMax(data = NULL), + "Parameter 'data' cannot be NULL." + ) expect_error( PeriodMax('x'), "Parameter 'data' must be numeric." ) + # time_dim + expect_error( + PeriodMax(array(1:10), time_dim = 1), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + PeriodMax(array(1:10, dim = c(ftime = 10)), time_dim = 'time'), + "Parameter 'time_dim' is not found in 'data' dimension." + ) suppressWarnings( expect_equal( PeriodMax(array(1, c(x = 1)), time_dim = 'x'), 1 ) ) - expect_error( - PeriodMax(data = NULL), - "Parameter 'data' cannot be NULL." - ) expect_error( PeriodMax(1, dates = '2000-01-01', end = 3, start = 4), "Parameter 'start' and 'end' must be lists indicating the day and the month of the period start and end." ) suppressWarnings( expect_equal( - PeriodMax(array(1:10, c(ftime = 10))), + PeriodMax(array(1:10, c(time = 10))), 10 ) ) - data <- array(1:24, c(sdate = 2, ftime = 3, lon = 4)) + data <- array(1:24, c(sdate = 2, time = 3, lon = 4)) suppressWarnings( expect_equal( PeriodMax(data), @@ -36,7 +46,7 @@ test_that("1. Sanity Checks", { ) # Test dates warning expect_warning( - PeriodMax(array(1:10, c(ftime = 10)), + PeriodMax(array(1:10, c(time = 10)), dates = seq(as.Date("01-05-2000", format = "%d-%m-%Y"), as.Date("10-05-2000", format = "%d-%m-%Y"), by = 'day'), start = list(05, 02), end = list(05, 09)), @@ -45,7 +55,7 @@ test_that("1. Sanity Checks", { ) # start and end when dates is not provided expect_warning( - PeriodMax(array(1:10, c(ftime = 10)), + PeriodMax(array(1:10, c(time = 10)), start = list(05, 02), end = list(05, 09)), paste0("Parameter 'dates' is NULL and the average of the full data ", "provided in 'data' is computed.") @@ -57,7 +67,7 @@ test_that("1. Sanity Checks", { test_that("2. Seasonal", { exp <- NULL exp$data <- array(1:(1 * 3 * 214 * 2), - c(memb = 1, sdate = 3, ftime = 214, lon = 2)) + c(memb = 1, sdate = 3, time = 214, lon = 2)) exp$dims <- dim(exp$data) exp$attrs$Dates <- c(seq(as.Date("01-04-2000", format = "%d-%m-%Y"), as.Date("31-10-2000", format = "%d-%m-%Y"), by = 'day'), @@ -65,7 +75,7 @@ test_that("2. Seasonal", { 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')) - dim(exp$attrs$Dates) <- c(ftime = 214, sdate = 3) + dim(exp$attrs$Dates) <- c(time = 214, sdate = 3) class(exp) <- 's2dv_cube' output <- exp output$data <- array(c(max(exp$data[1,1,21:82,1]), max(exp$data[1,2,21:82,1]), diff --git a/tests/testthat/test-PeriodMean.R b/tests/testthat/test-PeriodMean.R index cd9f5fe..f51f7a1 100644 --- a/tests/testthat/test-PeriodMean.R +++ b/tests/testthat/test-PeriodMean.R @@ -2,6 +2,7 @@ library(CSTools) ############################################## test_that("1. Sanity Checks", { + # data expect_error( PeriodMean('x'), "Parameter 'data' must be numeric." @@ -16,17 +17,26 @@ test_that("1. Sanity Checks", { PeriodMean(data = NULL), "Parameter 'data' cannot be NULL." ) + # time_dim + expect_error( + PeriodMean(array(1:10), time_dim = 1), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + PeriodMean(array(1:10, dim = c(ftime = 10)), time_dim = 'time'), + "Parameter 'time_dim' is not found in 'data' dimension." + ) expect_error( PeriodMean(1, dates = '2000-01-01', end = 3, start = 4), "Parameter 'start' and 'end' must be lists indicating the day and the month of the period start and end." ) suppressWarnings( expect_equal( - PeriodMean(array(1:10, c(ftime = 10))), + PeriodMean(array(1:10, c(time = 10))), 5.5 ) ) - data <- array(1:24, c(sdate = 2, ftime = 3, lon = 4)) + data <- array(1:24, c(sdate = 2, time = 3, lon = 4)) suppressWarnings( expect_equal( PeriodMean(data), @@ -36,7 +46,7 @@ test_that("1. Sanity Checks", { ) # Test dates warning expect_warning( - PeriodMean(array(1:10, c(ftime = 10)), + PeriodMean(array(1:10, c(time = 10)), dates = seq(as.Date("01-05-2000", format = "%d-%m-%Y"), as.Date("10-05-2000", format = "%d-%m-%Y"), by = 'day'), start = list(05, 02), end = list(05, 09)), @@ -45,7 +55,7 @@ test_that("1. Sanity Checks", { ) # start and end when dates is not provided expect_warning( - PeriodMean(array(1:10, c(ftime = 10)), + PeriodMean(array(1:10, c(time = 10)), start = list(05, 02), end = list(05, 09)), paste0("Parameter 'dates' is NULL and the average of the full data ", "provided in 'data' is computed.") @@ -57,7 +67,7 @@ test_that("1. Sanity Checks", { test_that("2. Seasonal", { exp <- NULL exp$data <- array(1:(1 * 3 * 214 * 2), - c(memb = 1, sdate = 3, ftime = 214, lon = 2)) + c(memb = 1, sdate = 3, time = 214, lon = 2)) exp$dims <- dim(exp$data) exp$attrs$Dates <- c(seq(as.Date("01-04-2000", format = "%d-%m-%Y"), as.Date("31-10-2000", format = "%d-%m-%Y"), by = 'day'), @@ -65,7 +75,7 @@ test_that("2. Seasonal", { 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')) - dim(exp$attrs$Dates) <- c(ftime = 214, sdate = 3) + dim(exp$attrs$Dates) <- c(time = 214, sdate = 3) class(exp) <- 's2dv_cube' output <- exp output$data <- array(c(mean(exp$data[1,1,21:82,1]), mean(exp$data[1,2,21:82,1]), diff --git a/tests/testthat/test-PeriodMin.R b/tests/testthat/test-PeriodMin.R index da91a3c..5ed6c1f 100644 --- a/tests/testthat/test-PeriodMin.R +++ b/tests/testthat/test-PeriodMin.R @@ -2,6 +2,7 @@ library(CSTools) ############################################## test_that("1. Sanity Checks", { + # data expect_error( PeriodMin('x'), "Parameter 'data' must be numeric." @@ -16,15 +17,24 @@ test_that("1. Sanity Checks", { PeriodMin(data = NULL), "Parameter 'data' cannot be NULL." ) + # time_dim + expect_error( + PeriodMin(array(1:10), time_dim = 1), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + PeriodMin(array(1:10, dim = c(ftime = 10)), time_dim = 'time'), + "Parameter 'time_dim' is not found in 'data' dimension." + ) expect_error( PeriodMin(1, dates = '2000-01-01', end = 3, start = 4), "Parameter 'start' and 'end' must be lists indicating the day and the month of the period start and end." ) expect_equal( - PeriodMin(array(1:10, c(ftime = 10))), + PeriodMin(array(1:10, c(time = 10))), 1 ) - data <- array(1:24, c(sdate = 2, ftime = 3, lon = 4)) + data <- array(1:24, c(sdate = 2, time = 3, lon = 4)) expect_equal( PeriodMin(data), array(c(1, 2, 7, 8, 13, 14, 19, 20), @@ -32,7 +42,7 @@ test_that("1. Sanity Checks", { ) # Test dates warning expect_warning( - PeriodMin(array(1:10, c(ftime = 10)), + PeriodMin(array(1:10, c(time = 10)), dates = seq(as.Date("01-05-2000", format = "%d-%m-%Y"), as.Date("10-05-2000", format = "%d-%m-%Y"), by = 'day'), start = list(05, 02), end = list(05, 09)), @@ -41,7 +51,7 @@ test_that("1. Sanity Checks", { ) # start and end when dates is not provided expect_warning( - PeriodMin(array(1:10, c(ftime = 10)), + PeriodMin(array(1:10, c(time = 10)), start = list(05, 02), end = list(05, 09)), paste0("Parameter 'dates' is NULL and the average of the full data ", "provided in 'data' is computed.") @@ -53,7 +63,7 @@ test_that("1. Sanity Checks", { test_that("2. Seasonal", { exp <- NULL exp$data <- array(1:(1 * 3 * 214 * 2), - c(memb = 1, sdate = 3, ftime = 214, lon = 2)) + c(memb = 1, sdate = 3, time = 214, lon = 2)) exp$dims <- dim(exp$data) exp$attrs$Dates <- c(seq(as.Date("01-04-2000", format = "%d-%m-%Y"), as.Date("31-10-2000", format = "%d-%m-%Y"), by = 'day'), @@ -61,7 +71,7 @@ test_that("2. Seasonal", { 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')) - dim(exp$attrs$Dates) <- c(ftime = 214, sdate = 3) + dim(exp$attrs$Dates) <- c(time = 214, sdate = 3) class(exp) <- 's2dv_cube' output <- exp output$data <- array(c(min(exp$data[1,1,21:82,1]), min(exp$data[1,2,21:82,1]), diff --git a/tests/testthat/test-PeriodVariance.R b/tests/testthat/test-PeriodVariance.R index 1ac78c1..e525644 100644 --- a/tests/testthat/test-PeriodVariance.R +++ b/tests/testthat/test-PeriodVariance.R @@ -2,6 +2,7 @@ library(CSTools) ############################################## test_that("1. Sanity Checks", { + # data expect_error( PeriodVariance('x'), "Parameter 'data' must be numeric." @@ -14,16 +15,25 @@ test_that("1. Sanity Checks", { PeriodVariance(data = NULL), "Parameter 'data' cannot be NULL." ) + # time_dim + expect_error( + PeriodVariance(array(1:10), time_dim = 1), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + PeriodVariance(array(1:10, dim = c(ftime = 10)), time_dim = 'time'), + "Parameter 'time_dim' is not found in 'data' dimension." + ) expect_error( PeriodVariance(1, dates = '2000-01-01', end = 3, start = 4), "Parameter 'start' and 'end' must be lists indicating the day and the month of the period start and end." ) expect_equal( - PeriodVariance(array(1:10, c(ftime = 10))), + PeriodVariance(array(1:10, c(time = 10))), 9.166667, tolerance = 0.001 ) - data <- array(1:24, c(sdate = 2, ftime = 3, lon = 4)) + data <- array(1:24, c(sdate = 2, time = 3, lon = 4)) expect_equal( PeriodVariance(data), array(rep(4, 8), @@ -31,7 +41,7 @@ test_that("1. Sanity Checks", { ) # Test dates warning expect_warning( - PeriodVariance(array(1:10, c(ftime = 10)), + PeriodVariance(array(1:10, c(time = 10)), dates = seq(as.Date("01-05-2000", format = "%d-%m-%Y"), as.Date("10-05-2000", format = "%d-%m-%Y"), by = 'day'), start = list(05, 02), end = list(05, 09)), @@ -40,7 +50,7 @@ test_that("1. Sanity Checks", { ) # start and end when dates is not provided expect_warning( - PeriodVariance(array(1:10, c(ftime = 10)), + PeriodVariance(array(1:10, c(time = 10)), start = list(05, 02), end = list(05, 09)), paste0("Parameter 'dates' is NULL and the average of the full data ", "provided in 'data' is computed.") -- GitLab From a5a387ac6d5cc7ddd9f999b03c098b51abb6bbb5 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Tue, 3 Oct 2023 17:59:24 +0200 Subject: [PATCH 5/5] Correct examples of new functions Period... --- R/PeriodMax.R | 8 ++++---- R/PeriodMean.R | 4 ++-- R/PeriodMin.R | 8 ++++---- R/PeriodVariance.R | 8 ++++---- man/CST_PeriodMax.Rd | 4 ++-- man/CST_PeriodMean.Rd | 4 ++-- man/CST_PeriodMin.Rd | 4 ++-- man/CST_PeriodVariance.Rd | 4 ++-- man/PeriodMax.Rd | 4 ++-- man/PeriodMin.Rd | 4 ++-- man/PeriodVariance.Rd | 4 ++-- 11 files changed, 28 insertions(+), 28 deletions(-) diff --git a/R/PeriodMax.R b/R/PeriodMax.R index b8df92b..0806c51 100644 --- a/R/PeriodMax.R +++ b/R/PeriodMax.R @@ -42,7 +42,7 @@ #' #'@examples #'exp <- NULL -#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) #'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), @@ -51,7 +51,7 @@ #' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) -#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'dim(Dates) <- c(sdate = 4, time = 3) #'exp$attrs$Dates <- Dates #'class(exp) <- 's2dv_cube' #' @@ -151,7 +151,7 @@ CST_PeriodMax <- function(data, start = NULL, end = NULL, #'indicator in the element \code{data}. #' #'@examples -#'data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) #'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), @@ -160,7 +160,7 @@ CST_PeriodMax <- function(data, start = NULL, end = NULL, #' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) -#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'dim(Dates) <- c(sdate = 4, time = 3) #'res <- PeriodMax(data, dates = Dates, start = list(01, 12), end = list(01, 01)) #' #'@import multiApply diff --git a/R/PeriodMean.R b/R/PeriodMean.R index 79deb5d..7066fdd 100644 --- a/R/PeriodMean.R +++ b/R/PeriodMean.R @@ -41,7 +41,7 @@ #' #'@examples #'exp <- NULL -#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) #'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), @@ -50,7 +50,7 @@ #' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) -#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'dim(Dates) <- c(sdate = 4, time = 3) #'exp$attrs$Dates <- Dates #'class(exp) <- 's2dv_cube' #' diff --git a/R/PeriodMin.R b/R/PeriodMin.R index 0365d47..842e2e8 100644 --- a/R/PeriodMin.R +++ b/R/PeriodMin.R @@ -42,7 +42,7 @@ #' #'@examples #'exp <- NULL -#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) #'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), @@ -51,7 +51,7 @@ #' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) -#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'dim(Dates) <- c(sdate = 4, time = 3) #'exp$attrs$Dates <- Dates #'class(exp) <- 's2dv_cube' #' @@ -151,7 +151,7 @@ CST_PeriodMin <- function(data, start = NULL, end = NULL, #'indicator in the element \code{data}. #' #'@examples -#'data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) #'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), @@ -160,7 +160,7 @@ CST_PeriodMin <- function(data, start = NULL, end = NULL, #' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) -#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'dim(Dates) <- c(sdate = 4, time = 3) #'res <- PeriodMin(data, dates = Dates, start = list(01, 12), end = list(01, 01)) #' #'@import multiApply diff --git a/R/PeriodVariance.R b/R/PeriodVariance.R index d6b0153..b702981 100644 --- a/R/PeriodVariance.R +++ b/R/PeriodVariance.R @@ -46,7 +46,7 @@ #' #'@examples #'exp <- NULL -#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) #'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), @@ -55,7 +55,7 @@ #' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) -#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'dim(Dates) <- c(sdate = 4, time = 3) #'exp$attrs$Dates <- Dates #'class(exp) <- 's2dv_cube' #' @@ -159,7 +159,7 @@ CST_PeriodVariance <- function(data, start = NULL, end = NULL, #'indicator in the element \code{data}. #' #'@examples -#'data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +#'data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) #'Dates <- c(seq(as.Date("2000-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2001-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2001-11-01", "%Y-%m-%d", tz = "UTC"), @@ -168,7 +168,7 @@ CST_PeriodVariance <- function(data, start = NULL, end = NULL, #' as.Date("2003-01-01", "%Y-%m-%d", tz = "UTC"), by = "month"), #' seq(as.Date("2003-11-01", "%Y-%m-%d", tz = "UTC"), #' as.Date("2004-01-01", "%Y-%m-%d", tz = "UTC"), by = "month")) -#'dim(Dates) <- c(sdate = 4, ftime = 3) +#'dim(Dates) <- c(sdate = 4, time = 3) #'res <- PeriodVariance(data, dates = Dates, start = list(01, 12), end = list(01, 01)) #' #'@import multiApply diff --git a/man/CST_PeriodMax.Rd b/man/CST_PeriodMax.Rd index 52d3cd6..7b01d14 100644 --- a/man/CST_PeriodMax.Rd +++ b/man/CST_PeriodMax.Rd @@ -63,7 +63,7 @@ Two bioclimatic indicators can be obtained by using this function: } \examples{ exp <- NULL -exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), @@ -72,7 +72,7 @@ Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) -dim(Dates) <- c(sdate = 4, ftime = 3) +dim(Dates) <- c(sdate = 4, time = 3) exp$attrs$Dates <- Dates class(exp) <- 's2dv_cube' diff --git a/man/CST_PeriodMean.Rd b/man/CST_PeriodMean.Rd index 7b4611c..ab42066 100644 --- a/man/CST_PeriodMean.Rd +++ b/man/CST_PeriodMean.Rd @@ -62,7 +62,7 @@ this function: } \examples{ exp <- NULL -exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), @@ -71,7 +71,7 @@ Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) -dim(Dates) <- c(sdate = 4, ftime = 3) +dim(Dates) <- c(sdate = 4, time = 3) exp$attrs$Dates <- Dates class(exp) <- 's2dv_cube' diff --git a/man/CST_PeriodMin.Rd b/man/CST_PeriodMin.Rd index bfe48f4..9395699 100644 --- a/man/CST_PeriodMin.Rd +++ b/man/CST_PeriodMin.Rd @@ -63,7 +63,7 @@ Two bioclimatic indicators can be obtained by using this function: } \examples{ exp <- NULL -exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), @@ -72,7 +72,7 @@ Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) -dim(Dates) <- c(sdate = 4, ftime = 3) +dim(Dates) <- c(sdate = 4, time = 3) exp$attrs$Dates <- Dates class(exp) <- 's2dv_cube' diff --git a/man/CST_PeriodVariance.Rd b/man/CST_PeriodVariance.Rd index 064cc5c..e28bf95 100644 --- a/man/CST_PeriodVariance.Rd +++ b/man/CST_PeriodVariance.Rd @@ -67,7 +67,7 @@ Two bioclimatic indicators can be obtained by using this function: } \examples{ exp <- NULL -exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +exp$data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), @@ -76,7 +76,7 @@ Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) -dim(Dates) <- c(sdate = 4, ftime = 3) +dim(Dates) <- c(sdate = 4, time = 3) exp$attrs$Dates <- Dates class(exp) <- 's2dv_cube' diff --git a/man/PeriodMax.Rd b/man/PeriodMax.Rd index 4ec388c..cb776d2 100644 --- a/man/PeriodMax.Rd +++ b/man/PeriodMax.Rd @@ -61,7 +61,7 @@ Two bioclimatic indicators can be obtained by using this function: } } \examples{ -data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), @@ -70,7 +70,7 @@ Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) -dim(Dates) <- c(sdate = 4, ftime = 3) +dim(Dates) <- c(sdate = 4, time = 3) res <- PeriodMax(data, dates = Dates, start = list(01, 12), end = list(01, 01)) } diff --git a/man/PeriodMin.Rd b/man/PeriodMin.Rd index 04d0b01..154acf0 100644 --- a/man/PeriodMin.Rd +++ b/man/PeriodMin.Rd @@ -61,7 +61,7 @@ Two bioclimatic indicators can be obtained by using this function: } } \examples{ -data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), @@ -70,7 +70,7 @@ Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) -dim(Dates) <- c(sdate = 4, ftime = 3) +dim(Dates) <- c(sdate = 4, time = 3) res <- PeriodMin(data, dates = Dates, start = list(01, 12), end = list(01, 01)) } diff --git a/man/PeriodVariance.Rd b/man/PeriodVariance.Rd index c49fd3e..e1e8d7c 100644 --- a/man/PeriodVariance.Rd +++ b/man/PeriodVariance.Rd @@ -65,7 +65,7 @@ Two bioclimatic indicators can be obtained by using this function: } } \examples{ -data <- array(rnorm(45), dim = c(member = 7, sdate = 4, ftime = 3)) +data <- array(rnorm(45), dim = c(member = 7, sdate = 4, time = 3)) Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2001-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2001-11-01", "\%Y-\%m-\%d", tz = "UTC"), @@ -74,7 +74,7 @@ Dates <- c(seq(as.Date("2000-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2003-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month"), seq(as.Date("2003-11-01", "\%Y-\%m-\%d", tz = "UTC"), as.Date("2004-01-01", "\%Y-\%m-\%d", tz = "UTC"), by = "month")) -dim(Dates) <- c(sdate = 4, ftime = 3) +dim(Dates) <- c(sdate = 4, time = 3) res <- PeriodVariance(data, dates = Dates, start = list(01, 12), end = list(01, 01)) } -- GitLab