diff --git a/.Rbuildignore b/.Rbuildignore index fa596e707601da63df8c53cf4f087a70a953dbea..62a63bb483658fb6c751ec2ebd39bb69a8d15f2c 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -5,4 +5,3 @@ ./.nc$ .*^(?!data)\.RData$ .*\.gitlab-ci.yml$ -^tests$ diff --git a/DESCRIPTION b/DESCRIPTION index 45093eef3112c7f74ca9914f6d9df7dbb0eec301..a60be7531c84dbeb3db37d7f8002994b8c9ad74d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -3,7 +3,7 @@ Title: Sectorial Indicators for Climate Services from Sub-Seasonal Forecast to D Version: 0.0.1 Authors@R: c( person("Nuria", "Perez-Zanon", , "nuria.perez@bsc.es", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-8568-3071"))) -Description: To be added. +Description: The package contains the definition-based computation of the sectoral indicators for the Climate Service. Depends: R (>= 3.6.1) Imports: diff --git a/NAMESPACE b/NAMESPACE index 65c34f0352e9b40ac738e36d4101fcf05a6ce550..7bee168e0f5ab17ef1e95495c07d7eed6d8857f3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,10 @@ # Generated by roxygen2: do not edit by hand export(CST_PeriodAccumulation) +export(CST_PeriodMean) export(CST_SelectPeriodOnData) export(PeriodAccumulation) +export(PeriodMean) export(SelectPeriodOnData) export(SelectPeriodOnDates) import(multiApply) diff --git a/R/PeriodMean.R b/R/PeriodMean.R new file mode 100644 index 0000000000000000000000000000000000000000..fa1b4783131560e9de5b5ba7cd5a731a3bf68f2a --- /dev/null +++ b/R/PeriodMean.R @@ -0,0 +1,134 @@ +#'Period Mean on 's2dv_cube' objects +#' +#'Period Mean computes the average (mean) of a given variable in a period. +#'Providing temperature data, two agriculture indices can be obtain by using this function: +#'\itemize{ +#' \item\code{GST}{Growing Season average Temperature: The average temperature from April 1st to Octobe 31st} +#' \item\code{SprTX}{Spring Average Maximum Temperature: The average daily maximum temperature from April 1st to May 31st}} +#' +#'@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 function 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 's2dv_cube' object containing the indicator in the element \code{data}. +#' +#'@import multiApply +#' +#'@examples +#'exp <- CSTools::lonlat_data$exp +#'SA <- CST_PeriodMean(exp) +#' +#'exp$data <- array(rnorm(5 * 3 * 214 * 2), +#' c(memb = 5, sdate = 3, ftime = 214, lon = 2)) +#'exp$Dates[[1]] <- c(seq(as.Date("01-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')) +#'SprTX <- CST_PeriodMean(exp, start = list(1, 4), end = list(31, 5)) +#'dim(SprTX$data) +#'head(SprTX$Dates) +#'@export +CST_PeriodMean <- function(data, start = NULL, end = NULL, + time_dim = 'ftime', na.rm = FALSE, + ncores = NULL) { +# Consider to add an option for providing tx and tn in data + if (!inherits(data, 's2dv_cube')) { + stop("Parameter 'data' must be of the class 's2dv_cube', ", + "as output by CSTools::CST_Load.") + } + # when subsetting is needed, dimensions are also needed: + if (!is.null(start) && !is.null(end)) { + if (is.null(dim(data$Dates$start))) { + if (length(data$Dates$start) != dim(data$data)[time_dim]) { + if (length(data$Dates$start) == + prod(dim(data$data)[time_dim] * dim(data$data)['sdate'])) { + dim(data$Dates$start) <- c(dim(data$data)[time_dim], + dim(data$data)['sdate']) + } + } else { + warning("Dimensions in 'data' element 'Dates$start' are missed/unmatched. All data would be used.") + } + } + } + total <- PeriodMean(data = data$data, dates = data$Dates[[1]], start, end, + time_dim = time_dim, na.rm = na.rm, ncores = ncores) + data$data <- total + if (!is.null(start) && !is.null(end)) { + data$Dates <- SelectPeriodOnDates(dates = data$Dates[[1]], + start = start, end = end, + time_dim = time_dim, ncores = ncores) + } + return(data) +} + +#'Period Mean on multidimensional array objects +#' +#'Period Mean computes the average (mean) of a given variable in a period. +#'Providing temperature data, two agriculture indices can be obtain by using this function: +#'\itemize{ +#' \item\code{GST}{Growing Season average Temperature: The average temperature from April 1st to Octobe 31st} +#' \item\code{SprTX}{Spring Average Maximum Temperature: The average daily maximum temperature from April 1st to May 31st}} +#' +#'@param data a multidimensional array with named dimensions. +#'@param dates a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data'. By default it is NULL, to select a period 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 function 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. +#' +#'@import multiApply +#' +#'@examples +#'exp <- CSTools::lonlat_prec$data +#'SA <- PeriodMean(exp, time_dim = 'ftime') +#' +#'data <- array(rnorm(5 * 3 * 214 * 2), +#' c(memb = 5, sdate = 3, time = 214, lon = 2)) +#'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(Dates) <- c(time = 214, sdate = 3) +#'SprTX <- PeriodMean(data, Dates, start = list(1, 4), end = list(31, 5)) +#'@export +PeriodMean <- function(data, dates = NULL, start = NULL, end = NULL, + time_dim = 'time', 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(dates)) { + warning("Parameter 'dates' is NULL and the Average of the ", + "full data provided in 'data' is computed.") + } else { + if (!is.null(start) && !is.null(end)) { + 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.") + } + data <- SelectPeriodOnData(data, dates, start, end, + time_dim = time_dim, ncores = ncores) + } + } + total <- Apply(list(data), target_dims = time_dim, fun = mean, + na.rm = na.rm, ncores = ncores)$output1 +} + + diff --git a/man/CST_PeriodMean.Rd b/man/CST_PeriodMean.Rd new file mode 100644 index 0000000000000000000000000000000000000000..bbc1fe350f14d11ae56bc1af07431feb8dbba825 --- /dev/null +++ b/man/CST_PeriodMean.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PeriodMean.R +\name{CST_PeriodMean} +\alias{CST_PeriodMean} +\title{Period Mean on 's2dv_cube' objects} +\usage{ +CST_PeriodMean( + 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 function 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 's2dv_cube' object containing the indicator in the element \code{data}. +} +\description{ +Period Mean computes the average (mean) of a given variable in a period. +Providing temperature data, two agriculture indices can be obtain by using this function: +\itemize{ + \item\code{GST}{Growing Season average Temperature: The average temperature from April 1st to Octobe 31st} + \item\code{SprTX}{Spring Average Maximum Temperature: The average daily maximum temperature from April 1st to May 31st}} +} +\examples{ +exp <- CSTools::lonlat_data$exp +SA <- CST_PeriodMean(exp) + +exp$data <- array(rnorm(5 * 3 * 214 * 2), + c(memb = 5, sdate = 3, ftime = 214, lon = 2)) +exp$Dates[[1]] <- c(seq(as.Date("01-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')) +SprTX <- CST_PeriodMean(exp, start = list(1, 4), end = list(31, 5)) +dim(SprTX$data) +head(SprTX$Dates) +} diff --git a/man/PeriodMean.Rd b/man/PeriodMean.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b0fd0c3bc3bd7930b3e53016761a9c2cab3f04b9 --- /dev/null +++ b/man/PeriodMean.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PeriodMean.R +\name{PeriodMean} +\alias{PeriodMean} +\title{Period Mean on multidimensional array objects} +\usage{ +PeriodMean( + data, + dates = NULL, + start = NULL, + end = NULL, + time_dim = "time", + na.rm = FALSE, + ncores = NULL +) +} +\arguments{ +\item{data}{a multidimensional array with named dimensions.} + +\item{dates}{a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data'. By default it is NULL, to select a period 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 function 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. +} +\description{ +Period Mean computes the average (mean) of a given variable in a period. +Providing temperature data, two agriculture indices can be obtain by using this function: +\itemize{ + \item\code{GST}{Growing Season average Temperature: The average temperature from April 1st to Octobe 31st} + \item\code{SprTX}{Spring Average Maximum Temperature: The average daily maximum temperature from April 1st to May 31st}} +} +\examples{ +exp <- CSTools::lonlat_prec$data +SA <- PeriodMean(exp, time_dim = 'ftime') + +data <- array(rnorm(5 * 3 * 214 * 2), + c(memb = 5, sdate = 3, time = 214, lon = 2)) +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(Dates) <- c(time = 214, sdate = 3) +SprTX <- PeriodMean(data, Dates, start = list(1, 4), end = list(31, 5)) +} diff --git a/tests/testthat/test-PeriodMean.R b/tests/testthat/test-PeriodMean.R new file mode 100644 index 0000000000000000000000000000000000000000..c9a0a37e40daf7e8dbda589d348f25367d03ac4b --- /dev/null +++ b/tests/testthat/test-PeriodMean.R @@ -0,0 +1,38 @@ +context("Generic tests") +test_that("Sanity Checks", { + #source("csindicators/R/PeriodMean.R") + expect_error(PeriodMean('x'), "Parameter 'data' must be numeric.") + expect_equal(PeriodMean(array(1, c(x = 1)), time_dim = 'x'), 1) + expect_error(PeriodMean(data = NULL), "Parameter 'data' cannot be NULL.") + 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.") + + expect_equal(PeriodMean(array(1:10, c(time = 10))), 5.5) + data <- array(1:24, c(sdate = 2, time = 3, lon = 4)) + expect_equal(PeriodMean(data), + array(c(3,4,9,10,15,16,21,22), c(sdate = 2, lon = 4))) +}) + +test_that("seasonal", { + + exp <- CSTools::lonlat_prec + exp$data <- array(1:(1 * 3 * 214 * 2), + c(memb = 1, sdate = 3, ftime = 214, lon = 2)) + exp$Dates[[1]] <- 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')) + output <- exp + output$data <- array(c(mean(exp$data[1,1,21:82,1]), mean(exp$data[1,2,21:82,1]), + mean(exp$data[1,3,21:82,1]), mean(exp$data[1,1,21:82,2]), + mean(exp$data[1,2,21:82,2]), mean(exp$data[1,3,21:82,2])), + c(memb = 1, sdate = 3, lon = 2)) + expect_equal( + CST_PeriodMean(exp, start = list(21, 4), end = list(21, 6))$data, + output$data) + + + +})