From f8bab7d8173b3dec46304331d7f8d8c78cb06a2e Mon Sep 17 00:00:00 2001 From: nperez Date: Fri, 12 Feb 2021 17:31:04 +0100 Subject: [PATCH 01/16] Version working with dates only with time_dim --- R/MergeObsToExp.R | 68 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) create mode 100644 R/MergeObsToExp.R diff --git a/R/MergeObsToExp.R b/R/MergeObsToExp.R new file mode 100644 index 0000000..6e93b8d --- /dev/null +++ b/R/MergeObsToExp.R @@ -0,0 +1,68 @@ +#'Merge Observations To Experiments +#' +#'Some indicators are defined for specific temporal periods (e.g.: summer from June 21st to September 21st). If the initialization forecast date is later than the one required for the indicator (e.g.: July 1st), the user may want to merge past observations, or other reference, to the forecast to compute the indicator. The function \code{MergeObs2Exp} takes care of this steps. +#' +#'@param ref a multidimensional array with named dimensions. +#'@param ref_dates a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'ref'. +#'@param data a multidimensional array with named dimensions. +#'@param data_dates a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data'. +#'@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 temporal dimension. 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. This dimension is required to subset the data in a requested period. +#'@param memb_dim a character string indicating the name of the dimension in which the ensemble members are stored. +#'@param sdate_dim a character string indicating the name of the dimension in which the initialization dates are stored. +#'@param ncores an integer indicating the number of cores to use in parallel computation. +#' +#'@return A multidimensional array with named dimensions. +#' +#'@import multiApply +MergeRefToData <- function(ref, ref_dates, data, data_dates, start, end, + time_dim = 'time', sdate_dim = 'sdate', + memb_dim = 'member', ncores = NULL) { + if (!is.array(ref)) { + dim(ref) <- c(length(ref)) + names(dim(ref)) <- time_dim + } + if (!is.array(data)) { + dim(data) <- c(length(data)) + names(dim(data)) <- time_dim + } + if (is.null(dim(ref_dates))) { + dim(ref_dates) <- length(ref_dates) + names(dim(ref_dates)) <- time_dim + } + if (is.null(dim(data_dates))) { + dim(data_dates) <- length(data_dates) + names(dim(data_dates)) <- time_dim + } + if (sdate_dim %in% names(dim(data_dates))) { + ini <- ClimProjDiags::Subset(data_dates, along = sdate_dim, indices = 1) + } else { + ini <- ClimProjDiags::Subset(data_dates, along = time_dim, indices = 1) + } + day <- format(ini, "%d") + month <- format(ini, "%m") + check_refd <- SelectPeriodOnDates(ref_dates, start = start, + end = list(format(ini, "%d"), format(ini, "%m")), + time_dim = time_dim) + ref <- SelectPeriodOnData(ref, dates = ref_dates, start = start, +# to review last day of the month + #end = list(sprintf('%02d', as.numeric(day) - 1), month), + end = list(day, month), + time_dim = time_dim) + if ((memb_dim %in% names(dim(data))) && dim(data)[memb_dim] > 1) { + ref <- s2dv::InsertDim(ref, posdim = which(names(dim(data)) == memb_dim), + lendim = dim(data)[memb_dim], name = memb_dim) + } + check_datad <- SelectPeriodOnDates(data_dates, + start = list(day, month), + end = end, + time_dim = time_dim) + + data <- SelectPeriodOnData(data, dates = data_dates, start = list(day, month), + end = end, time_dim = time_dim, ncores = 1) + data <- abind::abind(ref, data, along = which(names(dim(data)) == time_dim)) + return(data) +} + + -- GitLab From a37f55897ec08febd55fac0ff5d33af16ee98019 Mon Sep 17 00:00:00 2001 From: nperez Date: Fri, 12 Feb 2021 18:10:15 +0100 Subject: [PATCH 02/16] forecast have startdates to Merge --- R/MergeObsToExp.R | 51 +++++++++++++++++++++++++++++++---------------- 1 file changed, 34 insertions(+), 17 deletions(-) diff --git a/R/MergeObsToExp.R b/R/MergeObsToExp.R index 6e93b8d..9e473b1 100644 --- a/R/MergeObsToExp.R +++ b/R/MergeObsToExp.R @@ -35,29 +35,46 @@ MergeRefToData <- function(ref, ref_dates, data, data_dates, start, end, dim(data_dates) <- length(data_dates) names(dim(data_dates)) <- time_dim } - if (sdate_dim %in% names(dim(data_dates))) { - ini <- ClimProjDiags::Subset(data_dates, along = sdate_dim, indices = 1) - } else { - ini <- ClimProjDiags::Subset(data_dates, along = time_dim, indices = 1) - } + ini <- ClimProjDiags::Subset(data_dates, along = time_dim, indices = 1) day <- format(ini, "%d") month <- format(ini, "%m") - check_refd <- SelectPeriodOnDates(ref_dates, start = start, - end = list(format(ini, "%d"), format(ini, "%m")), - time_dim = time_dim) + if (length(day) > 1) { + if (any(day[1] != day)) { + warning("Different initialization days found in 'data_dates'.", + " Only the first one is being used. Check the result.") + } + day <- day[1] + } + if (length(month) > 1) { + if (any(month[1] != month)) { + warning("Different initialization months found in 'data_dates'.", + " Only the first one is being used. Check the result.") + } + month <- month[1] + } + + #check_refd <- SelectPeriodOnDates(ref_dates, start = start, + # end = list(day, month), + # time_dim = time_dim) ref <- SelectPeriodOnData(ref, dates = ref_dates, start = start, -# to review last day of the month - #end = list(sprintf('%02d', as.numeric(day) - 1), month), end = list(day, month), time_dim = time_dim) - if ((memb_dim %in% names(dim(data))) && dim(data)[memb_dim] > 1) { - ref <- s2dv::InsertDim(ref, posdim = which(names(dim(data)) == memb_dim), - lendim = dim(data)[memb_dim], name = memb_dim) + if ((sdate_dim %in% names(dim(data))) && dim(data)[sdate_dim] > 1 && + !sdate_dim %in% names(dim(ref))) { + dim(ref) <- c(length(ref)/dim(data)[sdate_dim], dim(data)[sdate_dim]) + names(dim(ref)) <- c(time_dim, sdate_dim) } - check_datad <- SelectPeriodOnDates(data_dates, - start = list(day, month), - end = end, - time_dim = time_dim) + if (length(dim(data)) != length(dim(ref))) { + dif_dims <- which(names(dim(data)) %in% names(dim(ref)) == FALSE) + for (i in dif_dims) { + ref <- s2dv::InsertDim(ref, posdim = i, lendim = dim(data)[i], + name = names(dim(data))[i]) + } + } + #check_datad <- SelectPeriodOnDates(data_dates, + # start = list(day, month), + # end = end, + # time_dim = time_dim) data <- SelectPeriodOnData(data, dates = data_dates, start = list(day, month), end = end, time_dim = time_dim, ncores = 1) -- GitLab From e23bd3497d2b29f9119a89a68c4ba56696376d93 Mon Sep 17 00:00:00 2001 From: nperez Date: Mon, 15 Feb 2021 11:22:30 +0100 Subject: [PATCH 03/16] Renamed CST_MergeRefToExp --- NAMESPACE | 3 + R/MergeObsToExp.R | 85 ------------------ R/MergeRefToExp.R | 185 +++++++++++++++++++++++++++++++++++++++ man/CST_MergeRefToExp.Rd | 54 ++++++++++++ man/MergeRefToExp.Rd | 57 ++++++++++++ 5 files changed, 299 insertions(+), 85 deletions(-) delete mode 100644 R/MergeObsToExp.R create mode 100644 R/MergeRefToExp.R create mode 100644 man/CST_MergeRefToExp.Rd create mode 100644 man/MergeRefToExp.Rd diff --git a/NAMESPACE b/NAMESPACE index 09b5709..7e4ee23 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,7 @@ export(AbsToProbs) export(AccumulationExceedingThreshold) export(CST_AbsToProbs) export(CST_AccumulationExceedingThreshold) +export(CST_MergeRefToExp) export(CST_PeriodAccumulation) export(CST_PeriodMean) export(CST_QThreshold) @@ -11,6 +12,7 @@ export(CST_SelectPeriodOnData) export(CST_Threshold) export(CST_TotalSpellTimeExceedingThreshold) export(CST_TotalTimeExceedingThreshold) +export(MergeRefToExp) export(PeriodAccumulation) export(PeriodMean) export(QThreshold) @@ -21,6 +23,7 @@ export(TotalSpellTimeExceedingThreshold) export(TotalTimeExceedingThreshold) import(multiApply) importFrom(ClimProjDiags,Subset) +importFrom(s2dv,InsertDim) importFrom(s2dv,Reorder) importFrom(stats,ecdf) importFrom(stats,quantile) diff --git a/R/MergeObsToExp.R b/R/MergeObsToExp.R deleted file mode 100644 index 9e473b1..0000000 --- a/R/MergeObsToExp.R +++ /dev/null @@ -1,85 +0,0 @@ -#'Merge Observations To Experiments -#' -#'Some indicators are defined for specific temporal periods (e.g.: summer from June 21st to September 21st). If the initialization forecast date is later than the one required for the indicator (e.g.: July 1st), the user may want to merge past observations, or other reference, to the forecast to compute the indicator. The function \code{MergeObs2Exp} takes care of this steps. -#' -#'@param ref a multidimensional array with named dimensions. -#'@param ref_dates a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'ref'. -#'@param data a multidimensional array with named dimensions. -#'@param data_dates a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data'. -#'@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 temporal dimension. 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. This dimension is required to subset the data in a requested period. -#'@param memb_dim a character string indicating the name of the dimension in which the ensemble members are stored. -#'@param sdate_dim a character string indicating the name of the dimension in which the initialization dates are stored. -#'@param ncores an integer indicating the number of cores to use in parallel computation. -#' -#'@return A multidimensional array with named dimensions. -#' -#'@import multiApply -MergeRefToData <- function(ref, ref_dates, data, data_dates, start, end, - time_dim = 'time', sdate_dim = 'sdate', - memb_dim = 'member', ncores = NULL) { - if (!is.array(ref)) { - dim(ref) <- c(length(ref)) - names(dim(ref)) <- time_dim - } - if (!is.array(data)) { - dim(data) <- c(length(data)) - names(dim(data)) <- time_dim - } - if (is.null(dim(ref_dates))) { - dim(ref_dates) <- length(ref_dates) - names(dim(ref_dates)) <- time_dim - } - if (is.null(dim(data_dates))) { - dim(data_dates) <- length(data_dates) - names(dim(data_dates)) <- time_dim - } - ini <- ClimProjDiags::Subset(data_dates, along = time_dim, indices = 1) - day <- format(ini, "%d") - month <- format(ini, "%m") - if (length(day) > 1) { - if (any(day[1] != day)) { - warning("Different initialization days found in 'data_dates'.", - " Only the first one is being used. Check the result.") - } - day <- day[1] - } - if (length(month) > 1) { - if (any(month[1] != month)) { - warning("Different initialization months found in 'data_dates'.", - " Only the first one is being used. Check the result.") - } - month <- month[1] - } - - #check_refd <- SelectPeriodOnDates(ref_dates, start = start, - # end = list(day, month), - # time_dim = time_dim) - ref <- SelectPeriodOnData(ref, dates = ref_dates, start = start, - end = list(day, month), - time_dim = time_dim) - if ((sdate_dim %in% names(dim(data))) && dim(data)[sdate_dim] > 1 && - !sdate_dim %in% names(dim(ref))) { - dim(ref) <- c(length(ref)/dim(data)[sdate_dim], dim(data)[sdate_dim]) - names(dim(ref)) <- c(time_dim, sdate_dim) - } - if (length(dim(data)) != length(dim(ref))) { - dif_dims <- which(names(dim(data)) %in% names(dim(ref)) == FALSE) - for (i in dif_dims) { - ref <- s2dv::InsertDim(ref, posdim = i, lendim = dim(data)[i], - name = names(dim(data))[i]) - } - } - #check_datad <- SelectPeriodOnDates(data_dates, - # start = list(day, month), - # end = end, - # time_dim = time_dim) - - data <- SelectPeriodOnData(data, dates = data_dates, start = list(day, month), - end = end, time_dim = time_dim, ncores = 1) - data <- abind::abind(ref, data, along = which(names(dim(data)) == time_dim)) - return(data) -} - - diff --git a/R/MergeRefToExp.R b/R/MergeRefToExp.R new file mode 100644 index 0000000..279a15d --- /dev/null +++ b/R/MergeRefToExp.R @@ -0,0 +1,185 @@ +#'Merge a Reference To Experiments +#' +#'Some indicators are defined for specific temporal periods (e.g.: summer from June 21st to September 21st). If the initialization forecast date is later than the one required for the indicator (e.g.: July 1st), the user may want to merge past observations, or other reference, to the forecast (or hindcast) to compute the indicator. The function \code{MergeObs2Exp} takes care of this steps. +#' +#'@param ref an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools. +#'@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 temporal dimension. 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. This dimension is required to subset the data in a requested period. +#'@param sdate_dim a character string indicating the name of the dimension in which the initialization dates are stored. +#'@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 +#'@importFrom ClimProjDiags Subset +#' +#'@examples +#'data_dates <- c(seq(as.Date("01-07-1993", "%d-%m-%Y", tz = 'UTC'), +#' as.Date("01-12-1993","%d-%m-%Y", tz = 'UTC'), "day"), +#' seq(as.Date("01-07-1994", "%d-%m-%Y", tz = 'UTC'), +#' as.Date("01-12-1994","%d-%m-%Y", tz = 'UTC'), "day")) +#'dim(data_dates) <- c(ftime = 154, sdate = 2) +#'ref_dates <- seq(as.Date("01-01-1993", "%d-%m-%Y", tz = 'UTC'), +#' as.Date("01-12-1994","%d-%m-%Y", tz = 'UTC'), "day") +#'dim(ref_dates) <- c(ftime = 350, sdate = 2) +#'ref <- array(1001:1700, c(ftime = 350, sdate = 2)) +#'data <- array(1:(2*154*2), c(ftime = 154, sdate = 2, member= 2)) +#'ref <- CSTools::s2dv_cube(data = ref, Dates = list(start = ref_dates, +#' end = ref_dates)) +#'data <- CSTools::s2dv_cube(data = data, Dates = list(start = data_dates, +#' end = data_dates)) +#'new_data <- CST_MergeRefToExp(ref, data, start = list(21, 6), end = list(21, 9)) +#'@export +CST_MergeRefToExp <- function(ref, data, start, end, + time_dim = 'ftime', sdate_dim = 'sdate', + ncores = NULL) { + if (!inherits(ref, 's2dv_cube')) { + stop("Parameter 'ref' must be of the class 's2dv_cube', ", + "as output by CSTools::CST_Load.") + } + 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(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 'data$Dates$start' are missed and", + "all data would be used.") + } + } + data$data <- MergeRefToExp(ref = ref$data, ref_dates = ref$Dates[[1]], + data = data$data, data_dates = data$Dates[[1]], + start, end, time_dim = time_dim, + sdate_dim = sdate_dim, ncores = ncores) + ini <- ClimProjDiags::Subset(data$Dates[[1]], along = time_dim, indices = 1) + day <- format(ini, "%d") + month <- format(ini, "%m") + if (length(day) > 1) { + if (any(day[1] != day)) { + warning("Different initialization days found in 'data_dates'.", + " Only the first one is being used. Check the result.") + } + day <- day[1] + } + if (length(month) > 1) { + if (any(month[1] != month)) { + warning("Different initialization months found in 'data_dates'.", + " Only the first one is being used. Check the result.") + } + month <- month[1] + } + + ref_dates <- SelectPeriodOnDates(ref$Dates[[1]], start = start, + end = list(day, month), + time_dim = time_dim) + data_dates <- SelectPeriodOnDates(data$Dates[[1]], + start = list(day, month), + end = end, time_dim = time_dim) +# TO DO CONCATENATE DATES + res <- Apply(list(data_dates, ref_dates), target_dims = time_dim, + c, ncores = ncores)$output1 + data$Dates <- as.POSIXct(res*3600*24, origin = '1970-01-01', tz = 'UTC') + return(data) +} + +#'Merge a Reference To Experiments +#' +#'Some indicators are defined for specific temporal periods (e.g.: summer from June 21st to September 21st). If the initialization forecast date is later than the one required for the indicator (e.g.: July 1st), the user may want to merge past observations, or other reference, to the forecast (or hindcast) to compute the indicator. The function \code{MergeObs2Exp} takes care of this steps. +#' +#'@param ref a multidimensional array with named dimensions. +#'@param ref_dates a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'ref'. +#'@param data a multidimensional array with named dimensions. +#'@param data_dates a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data'. +#'@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 temporal dimension. 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. This dimension is required to subset the data in a requested period. +#'@param sdate_dim a character string indicating the name of the dimension in which the initialization dates are stored. +#'@param ncores an integer indicating the number of cores to use in parallel computation. +#' +#'@return A multidimensional array with named dimensions. +#' +#'@import multiApply +#'@importFrom ClimProjDiags Subset +#'@importFrom s2dv InsertDim +#' +#'@examples +#'data_dates <- c(seq(as.Date("01-07-1993", "%d-%m-%Y", tz = 'UTC'), +#' as.Date("01-12-1993","%d-%m-%Y", tz = 'UTC'), "day"), +#' seq(as.Date("01-07-1994", "%d-%m-%Y", tz = 'UTC'), +#' as.Date("01-12-1994","%d-%m-%Y", tz = 'UTC'), "day")) +#'dim(data_dates) <- c(time = 154, sdate = 2) +#'ref_dates <- seq(as.Date("01-01-1993", "%d-%m-%Y", tz = 'UTC'), +#' as.Date("01-12-1994","%d-%m-%Y", tz = 'UTC'), "day") +#'dim(ref_dates) <- c(time = 350, sdate = 2) +#'ref <- array(1001:1700, c(time = 350, sdate = 2)) +#'data <- array(1:(2*154*2), c(time = 154, sdate = 2, member= 2)) +#'new_data <- MergeRefToExp(ref, ref_dates, data, data_dates, +#' start = list(21, 6), end = list(21, 9)) +#'@export +MergeRefToExp <- function(ref, ref_dates, data, data_dates, start, end, + time_dim = 'time', sdate_dim = 'sdate', + ncores = NULL) { + if (!is.array(ref)) { + dim(ref) <- c(length(ref)) + names(dim(ref)) <- time_dim + } + if (!is.array(data)) { + dim(data) <- c(length(data)) + names(dim(data)) <- time_dim + } + if (is.null(dim(ref_dates))) { + dim(ref_dates) <- length(ref_dates) + names(dim(ref_dates)) <- time_dim + } + if (is.null(dim(data_dates))) { + dim(data_dates) <- length(data_dates) + names(dim(data_dates)) <- time_dim + } + ini <- ClimProjDiags::Subset(data_dates, along = time_dim, indices = 1) + day <- format(ini, "%d") + month <- format(ini, "%m") + if (length(day) > 1) { + if (any(day[1] != day)) { + warning("Different initialization days found in 'data_dates'.", + " Only the first one is being used. Check the result.") + } + day <- day[1] + } + if (length(month) > 1) { + if (any(month[1] != month)) { + warning("Different initialization months found in 'data_dates'.", + " Only the first one is being used. Check the result.") + } + month <- month[1] + } + ref <- SelectPeriodOnData(ref, dates = ref_dates, start = start, + end = list(day, month), + time_dim = time_dim, ncores = ncores) + if ((sdate_dim %in% names(dim(data))) && dim(data)[sdate_dim] > 1 && + !sdate_dim %in% names(dim(ref))) { + dim(ref) <- c(length(ref)/dim(data)[sdate_dim], dim(data)[sdate_dim]) + names(dim(ref)) <- c(time_dim, sdate_dim) + } + if (length(dim(data)) != length(dim(ref))) { + dif_dims <- which(names(dim(data)) %in% names(dim(ref)) == FALSE) + for (i in dif_dims) { + ref <- s2dv::InsertDim(ref, posdim = i, lendim = dim(data)[i], + name = names(dim(data))[i]) + } + } + data <- SelectPeriodOnData(data, dates = data_dates, start = list(day, month), + end = end, time_dim = time_dim, ncores = ncores) + data <- Apply(list(ref, data), target_dims = time_dim, c, + ncores = ncores)$output1 + return(data) +} + + diff --git a/man/CST_MergeRefToExp.Rd b/man/CST_MergeRefToExp.Rd new file mode 100644 index 0000000..fb92117 --- /dev/null +++ b/man/CST_MergeRefToExp.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/MergeRefToExp.R +\name{CST_MergeRefToExp} +\alias{CST_MergeRefToExp} +\title{Merge a Reference To Experiments} +\usage{ +CST_MergeRefToExp( + ref, + data, + start, + end, + time_dim = "ftime", + sdate_dim = "sdate", + ncores = NULL +) +} +\arguments{ +\item{ref}{an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools.} + +\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 temporal dimension. 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. This dimension is required to subset the data in a requested period.} + +\item{sdate_dim}{a character string indicating the name of the dimension in which the initialization dates are stored.} + +\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{ +Some indicators are defined for specific temporal periods (e.g.: summer from June 21st to September 21st). If the initialization forecast date is later than the one required for the indicator (e.g.: July 1st), the user may want to merge past observations, or other reference, to the forecast (or hindcast) to compute the indicator. The function \code{MergeObs2Exp} takes care of this steps. +} +\examples{ +data_dates <- c(seq(as.Date("01-07-1993", "\%d-\%m-\%Y", tz = 'UTC'), + as.Date("01-12-1993","\%d-\%m-\%Y", tz = 'UTC'), "day"), + seq(as.Date("01-07-1994", "\%d-\%m-\%Y", tz = 'UTC'), + as.Date("01-12-1994","\%d-\%m-\%Y", tz = 'UTC'), "day")) +dim(data_dates) <- c(ftime = 154, sdate = 2) +ref_dates <- seq(as.Date("01-01-1993", "\%d-\%m-\%Y", tz = 'UTC'), + as.Date("01-12-1994","\%d-\%m-\%Y", tz = 'UTC'), "day") +dim(ref_dates) <- c(ftime = 350, sdate = 2) +ref <- array(1001:1700, c(ftime = 350, sdate = 2)) +data <- array(1:(2*154*2), c(ftime = 154, sdate = 2, member= 2)) +ref <- CSTools::s2dv_cube(data = ref, Dates = list(start = ref_dates, + end = ref_dates)) +data <- CSTools::s2dv_cube(data = data, Dates = list(start = data_dates, + end = data_dates)) +new_data <- CST_MergeRefToExp(ref, data, start = list(21, 6), end = list(21, 9)) +} diff --git a/man/MergeRefToExp.Rd b/man/MergeRefToExp.Rd new file mode 100644 index 0000000..b44bcfc --- /dev/null +++ b/man/MergeRefToExp.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/MergeRefToExp.R +\name{MergeRefToExp} +\alias{MergeRefToExp} +\title{Merge a Reference To Experiments} +\usage{ +MergeRefToExp( + ref, + ref_dates, + data, + data_dates, + start, + end, + time_dim = "time", + sdate_dim = "sdate", + ncores = NULL +) +} +\arguments{ +\item{ref}{a multidimensional array with named dimensions.} + +\item{ref_dates}{a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'ref'.} + +\item{data}{a multidimensional array with named dimensions.} + +\item{data_dates}{a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data'.} + +\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 temporal dimension. 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. This dimension is required to subset the data in a requested period.} + +\item{sdate_dim}{a character string indicating the name of the dimension in which the initialization dates are stored.} + +\item{ncores}{an integer indicating the number of cores to use in parallel computation.} +} +\value{ +A multidimensional array with named dimensions. +} +\description{ +Some indicators are defined for specific temporal periods (e.g.: summer from June 21st to September 21st). If the initialization forecast date is later than the one required for the indicator (e.g.: July 1st), the user may want to merge past observations, or other reference, to the forecast (or hindcast) to compute the indicator. The function \code{MergeObs2Exp} takes care of this steps. +} +\examples{ +data_dates <- c(seq(as.Date("01-07-1993", "\%d-\%m-\%Y", tz = 'UTC'), + as.Date("01-12-1993","\%d-\%m-\%Y", tz = 'UTC'), "day"), + seq(as.Date("01-07-1994", "\%d-\%m-\%Y", tz = 'UTC'), + as.Date("01-12-1994","\%d-\%m-\%Y", tz = 'UTC'), "day")) +dim(data_dates) <- c(time = 154, sdate = 2) +ref_dates <- seq(as.Date("01-01-1993", "\%d-\%m-\%Y", tz = 'UTC'), + as.Date("01-12-1994","\%d-\%m-\%Y", tz = 'UTC'), "day") +dim(ref_dates) <- c(time = 350, sdate = 2) +ref <- array(1001:1700, c(time = 350, sdate = 2)) +data <- array(1:(2*154*2), c(time = 154, sdate = 2, member= 2)) +new_data <- MergeRefToExp(ref, ref_dates, data, data_dates, + start = list(21, 6), end = list(21, 9)) +} -- GitLab From be6d7a87902966160631f79a3cd1f7f960a475dd Mon Sep 17 00:00:00 2001 From: nperez Date: Mon, 15 Feb 2021 11:25:40 +0100 Subject: [PATCH 04/16] Reorder dates output --- R/MergeRefToExp.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/MergeRefToExp.R b/R/MergeRefToExp.R index 279a15d..640e66a 100644 --- a/R/MergeRefToExp.R +++ b/R/MergeRefToExp.R @@ -84,7 +84,7 @@ CST_MergeRefToExp <- function(ref, data, start, end, start = list(day, month), end = end, time_dim = time_dim) # TO DO CONCATENATE DATES - res <- Apply(list(data_dates, ref_dates), target_dims = time_dim, + res <- Apply(list(ref_dates, data_dates), target_dims = time_dim, c, ncores = ncores)$output1 data$Dates <- as.POSIXct(res*3600*24, origin = '1970-01-01', tz = 'UTC') return(data) -- GitLab From 8204fc2e323207a964718e601be97cded1326dea Mon Sep 17 00:00:00 2001 From: nperez Date: Mon, 15 Feb 2021 12:10:57 +0100 Subject: [PATCH 05/16] Basic tests CST_MergeRefToExp --- R/MergeRefToExp.R | 10 +++++++--- tests/testthat/test-MergeRefToExp.R | 27 +++++++++++++++++++++++++++ 2 files changed, 34 insertions(+), 3 deletions(-) create mode 100644 tests/testthat/test-MergeRefToExp.R diff --git a/R/MergeRefToExp.R b/R/MergeRefToExp.R index 640e66a..46b969e 100644 --- a/R/MergeRefToExp.R +++ b/R/MergeRefToExp.R @@ -85,8 +85,12 @@ CST_MergeRefToExp <- function(ref, data, start, end, end = end, time_dim = time_dim) # TO DO CONCATENATE DATES res <- Apply(list(ref_dates, data_dates), target_dims = time_dim, - c, ncores = ncores)$output1 - data$Dates <- as.POSIXct(res*3600*24, origin = '1970-01-01', tz = 'UTC') + c, output_dims = time_dim, ncores = ncores)$output1 + if (class(ref_dates) == 'Date') { + data$Dates <- as.Date(res, origin = '1970-01-01') + } else { + data$Dates <- as.POSIXct(res*3600*24, origin = '1970-01-01', tz = 'UTC') + } return(data) } @@ -178,7 +182,7 @@ MergeRefToExp <- function(ref, ref_dates, data, data_dates, start, end, data <- SelectPeriodOnData(data, dates = data_dates, start = list(day, month), end = end, time_dim = time_dim, ncores = ncores) data <- Apply(list(ref, data), target_dims = time_dim, c, - ncores = ncores)$output1 + output_dims = time_dim, ncores = ncores)$output1 return(data) } diff --git a/tests/testthat/test-MergeRefToExp.R b/tests/testthat/test-MergeRefToExp.R new file mode 100644 index 0000000..a3865dd --- /dev/null +++ b/tests/testthat/test-MergeRefToExp.R @@ -0,0 +1,27 @@ +context("Generic tests") +test_that("Sanity checks", { + #source("csindicators/R/MergeRefToExp.R") + data_dates <- c(seq(as.Date("01-07-1993", "%d-%m-%Y", tz = 'UTC'), + as.Date("01-12-1993","%d-%m-%Y", tz = 'UTC'), "day"), + seq(as.Date("01-07-1994", "%d-%m-%Y", tz = 'UTC'), + as.Date("01-12-1994","%d-%m-%Y", tz = 'UTC'), "day")) + dim(data_dates) <- c(ftime = 154, sdate = 2) + ref_dates <- seq(as.Date("01-01-1993", "%d-%m-%Y", tz = 'UTC'), + as.Date("01-12-1994","%d-%m-%Y", tz = 'UTC'), "day") + dim(ref_dates) <- c(ftime = 350, sdate = 2) + ref <- array(1001:1700, c(ftime = 350, sdate = 2)) + data <- array(1:(2*154*2), c(ftime = 154, sdate = 2, member= 2)) + ref <- CSTools::s2dv_cube(data = ref, Dates = list(start = ref_dates, + end = ref_dates)) + data <- CSTools::s2dv_cube(data = data, Dates = list(start = data_dates, + end = data_dates)) + + expect_equal(CST_MergeRefToExp(ref, data, start = list(21, 6), + end = list(21, 9))$Dates, SelectPeriodOnDates(ref_dates, + start = list(21, 6), end = list(21,9))) + output <- array(c(1172:1181, 1:83, 1537:1546, 155:237, 1172:1181, 309:391, + 1537:1546, 463:545), c(ftime = 93, sdate = 2, member = 2)) + expect_equal(CST_MergeRefToExp(ref, data, start = list(21, 6), + end = list(21, 9))$data, output) + }) + -- GitLab From 0e37a988b37276bfb6fbcf816fde17f0e68972d3 Mon Sep 17 00:00:00 2001 From: nperez Date: Tue, 16 Feb 2021 18:45:24 +0100 Subject: [PATCH 06/16] add parameter ncores to insertdims --- R/MergeRefToExp.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/MergeRefToExp.R b/R/MergeRefToExp.R index 46b969e..725fd62 100644 --- a/R/MergeRefToExp.R +++ b/R/MergeRefToExp.R @@ -176,7 +176,7 @@ MergeRefToExp <- function(ref, ref_dates, data, data_dates, start, end, dif_dims <- which(names(dim(data)) %in% names(dim(ref)) == FALSE) for (i in dif_dims) { ref <- s2dv::InsertDim(ref, posdim = i, lendim = dim(data)[i], - name = names(dim(data))[i]) + name = names(dim(data), ncores = ncores)[i]) } } data <- SelectPeriodOnData(data, dates = data_dates, start = list(day, month), -- GitLab From 3df0b4f4e519a1f0df3dfdd26aec68ea79a3eb67 Mon Sep 17 00:00:00 2001 From: nperez Date: Tue, 16 Feb 2021 18:51:38 +0100 Subject: [PATCH 07/16] adding ncores in the correct place --- R/MergeRefToExp.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/MergeRefToExp.R b/R/MergeRefToExp.R index 725fd62..95ee315 100644 --- a/R/MergeRefToExp.R +++ b/R/MergeRefToExp.R @@ -176,7 +176,7 @@ MergeRefToExp <- function(ref, ref_dates, data, data_dates, start, end, dif_dims <- which(names(dim(data)) %in% names(dim(ref)) == FALSE) for (i in dif_dims) { ref <- s2dv::InsertDim(ref, posdim = i, lendim = dim(data)[i], - name = names(dim(data), ncores = ncores)[i]) + name = names(dim(data))[i], ncores = ncores) } } data <- SelectPeriodOnData(data, dates = data_dates, start = list(day, month), -- GitLab From 7b2faa7e008b5b34c13239d1cd1ee0b0abccdcce Mon Sep 17 00:00:00 2001 From: nperez Date: Fri, 26 Feb 2021 09:03:26 +0100 Subject: [PATCH 08/16] Change function description --- R/MergeRefToExp.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/MergeRefToExp.R b/R/MergeRefToExp.R index 95ee315..ccfc6c3 100644 --- a/R/MergeRefToExp.R +++ b/R/MergeRefToExp.R @@ -1,6 +1,6 @@ #'Merge a Reference To Experiments #' -#'Some indicators are defined for specific temporal periods (e.g.: summer from June 21st to September 21st). If the initialization forecast date is later than the one required for the indicator (e.g.: July 1st), the user may want to merge past observations, or other reference, to the forecast (or hindcast) to compute the indicator. The function \code{MergeObs2Exp} takes care of this steps. +#'Some indicators are defined for specific temporal periods (e.g.: summer from June 21st to September 21st). If the initialization forecast date is later than the one required for the indicator (e.g.: July 1st), the user may want to merge past observations, or other reference, to the forecast (or hindcast) to compute the indicator. The function \code{MergeObs2Exp} takes care of this steps. If the forecast simulation doesn't cover the required period because it is inizialed to early (e.g.: Initialization on November 1st the forecast covers until begining of June next year), a climatology (or other reference) could be added at the end of the forecast lead time to cover the desired period (e.g.: until the end of summer). #' #'@param ref an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools. #'@param data an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools. -- GitLab From 2bc066c99aff48cb5d80a9f7cfb95d47ce7f1aa3 Mon Sep 17 00:00:00 2001 From: nperez Date: Fri, 26 Feb 2021 09:09:29 +0100 Subject: [PATCH 09/16] output dimensions names from SelectPeriodOnData --- R/SelectPeriodOnData.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/SelectPeriodOnData.R b/R/SelectPeriodOnData.R index 529f787..ef96bc4 100644 --- a/R/SelectPeriodOnData.R +++ b/R/SelectPeriodOnData.R @@ -121,7 +121,7 @@ SelectPeriodOnData <- function(data, dates, start, end, res <- Apply(list(data, res), target_dims = time_dim, fun = function(x, y) { res <- x[y] - }, ncores = ncores)$output1 + }, output_dims = time_dim, ncores = ncores)$output1 } return(res) } -- GitLab From 8c31dfd7605b24e957cbdbaf1385f88e0f64d594 Mon Sep 17 00:00:00 2001 From: nperez Date: Fri, 26 Feb 2021 10:49:40 +0100 Subject: [PATCH 10/16] Allow member dim length 1 in ref array --- R/MergeRefToExp.R | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/R/MergeRefToExp.R b/R/MergeRefToExp.R index ccfc6c3..3e6e979 100644 --- a/R/MergeRefToExp.R +++ b/R/MergeRefToExp.R @@ -178,10 +178,20 @@ MergeRefToExp <- function(ref, ref_dates, data, data_dates, start, end, ref <- s2dv::InsertDim(ref, posdim = i, lendim = dim(data)[i], name = names(dim(data))[i], ncores = ncores) } + } + dims1 <- which(dim(ref) == 1) + for (i in dims1) { + dim1_in_data <- which(names(dim(data)) == names(dim(ref))[i]) + if (dim(data)[dim1_in_data] > 1) { + ref <- s2dv::InsertDim(Subset(ref, along = i, indices = 1, drop = TRUE), + posdim = i, lendim = dim(data)[dim1_in_data], + name = names(dim(data))[dim1_in_data]) + } } + data <- SelectPeriodOnData(data, dates = data_dates, start = list(day, month), end = end, time_dim = time_dim, ncores = ncores) - data <- Apply(list(ref, data), target_dims = time_dim, c, + data <- Apply(list(ref, data), target_dims = time_dim, fun = 'c', output_dims = time_dim, ncores = ncores)$output1 return(data) } -- GitLab From 5c9ae260338b92b1bd3d942149d587c83198bebc Mon Sep 17 00:00:00 2001 From: nperez Date: Fri, 26 Feb 2021 10:57:22 +0100 Subject: [PATCH 11/16] Fix description --- R/MergeRefToExp.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/MergeRefToExp.R b/R/MergeRefToExp.R index 3e6e979..2faa6de 100644 --- a/R/MergeRefToExp.R +++ b/R/MergeRefToExp.R @@ -1,6 +1,6 @@ #'Merge a Reference To Experiments #' -#'Some indicators are defined for specific temporal periods (e.g.: summer from June 21st to September 21st). If the initialization forecast date is later than the one required for the indicator (e.g.: July 1st), the user may want to merge past observations, or other reference, to the forecast (or hindcast) to compute the indicator. The function \code{MergeObs2Exp} takes care of this steps. If the forecast simulation doesn't cover the required period because it is inizialed to early (e.g.: Initialization on November 1st the forecast covers until begining of June next year), a climatology (or other reference) could be added at the end of the forecast lead time to cover the desired period (e.g.: until the end of summer). +#'Some indicators are defined for specific temporal periods (e.g.: summer from June 21st to September 21st). If the initialization forecast date is later than the one required for the indicator (e.g.: July 1st), the user may want to merge past observations, or other references, to the forecast (or hindcast) to compute the indicator. The function \code{MergeObs2Exp} takes care of this steps. If the forecast simulation doesn't cover the required period because it is initialized too early (e.g.: Initialization on November 1st the forecast covers until the beginning of June next year), a climatology (or other references) could be added at the end of the forecast lead time to cover the desired period (e.g.: until the end of summer). #' #'@param ref an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools. #'@param data an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools. -- GitLab From 623a31ed95002241832a0c617735ad365812a1fd Mon Sep 17 00:00:00 2001 From: nperez Date: Fri, 26 Feb 2021 18:57:40 +0100 Subject: [PATCH 12/16] New development version ongoing --- R/MergeRefToExp.R | 116 ++++++++++++++-------------- tests/testthat/test-MergeRefToExp.R | 6 +- 2 files changed, 63 insertions(+), 59 deletions(-) diff --git a/R/MergeRefToExp.R b/R/MergeRefToExp.R index 2faa6de..0baab95 100644 --- a/R/MergeRefToExp.R +++ b/R/MergeRefToExp.R @@ -2,10 +2,10 @@ #' #'Some indicators are defined for specific temporal periods (e.g.: summer from June 21st to September 21st). If the initialization forecast date is later than the one required for the indicator (e.g.: July 1st), the user may want to merge past observations, or other references, to the forecast (or hindcast) to compute the indicator. The function \code{MergeObs2Exp} takes care of this steps. If the forecast simulation doesn't cover the required period because it is initialized too early (e.g.: Initialization on November 1st the forecast covers until the beginning of June next year), a climatology (or other references) could be added at the end of the forecast lead time to cover the desired period (e.g.: until the end of summer). #' -#'@param ref an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools. -#'@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 data1 an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools. +#'@param data2 an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools. +#'@param start1 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 end1 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 temporal dimension. 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. This dimension is required to subset the data in a requested period. #'@param sdate_dim a character string indicating the name of the dimension in which the initialization dates are stored. #'@param ncores an integer indicating the number of cores to use in parallel computation. @@ -128,72 +128,74 @@ CST_MergeRefToExp <- function(ref, data, start, end, #'new_data <- MergeRefToExp(ref, ref_dates, data, data_dates, #' start = list(21, 6), end = list(21, 9)) #'@export -MergeRefToExp <- function(ref, ref_dates, data, data_dates, start, end, +MergeRefToExp <- function(data1, dates1, start1, end1, data2, dates2, start2, end2, time_dim = 'time', sdate_dim = 'sdate', ncores = NULL) { - if (!is.array(ref)) { - dim(ref) <- c(length(ref)) - names(dim(ref)) <- time_dim + if (!is.array(data1)) { + dim(data1) <- c(length(data1)) + names(dim(data1)) <- time_dim } - if (!is.array(data)) { - dim(data) <- c(length(data)) - names(dim(data)) <- time_dim + if (!is.array(data2)) { + dim(data2) <- c(length(data2)) + names(dim(data2)) <- time_dim } - if (is.null(dim(ref_dates))) { - dim(ref_dates) <- length(ref_dates) - names(dim(ref_dates)) <- time_dim + if (is.null(dim(dates1))) { + dim(dates1) <- length(dates1) + names(dim(dates1)) <- time_dim } - if (is.null(dim(data_dates))) { - dim(data_dates) <- length(data_dates) - names(dim(data_dates)) <- time_dim + if (is.null(dim(dates2))) { + dim(dates2) <- length(dates2) + names(dim(dates2)) <- time_dim } - ini <- ClimProjDiags::Subset(data_dates, along = time_dim, indices = 1) - day <- format(ini, "%d") - month <- format(ini, "%m") - if (length(day) > 1) { - if (any(day[1] != day)) { - warning("Different initialization days found in 'data_dates'.", - " Only the first one is being used. Check the result.") - } - day <- day[1] - } - if (length(month) > 1) { - if (any(month[1] != month)) { - warning("Different initialization months found in 'data_dates'.", - " Only the first one is being used. Check the result.") - } - month <- month[1] - } - ref <- SelectPeriodOnData(ref, dates = ref_dates, start = start, - end = list(day, month), + data1 <- SelectPeriodOnData(data1, dates = dates1, start = start1, + end = end1, time_dim = time_dim, ncores = ncores) - if ((sdate_dim %in% names(dim(data))) && dim(data)[sdate_dim] > 1 && - !sdate_dim %in% names(dim(ref))) { - dim(ref) <- c(length(ref)/dim(data)[sdate_dim], dim(data)[sdate_dim]) - names(dim(ref)) <- c(time_dim, sdate_dim) + # Check if data2 has dimension sdate_dim and it should be added to data1: + if ((sdate_dim %in% names(dim(data2))) && dim(data2)[sdate_dim] > 1 && + !sdate_dim %in% names(dim(data1))) { + dim(data1) <- c(length(data1)/dim(data2)[sdate_dim], dim(data2)[sdate_dim]) + names(dim(data1)) <- c(time_dim, sdate_dim) } - if (length(dim(data)) != length(dim(ref))) { - dif_dims <- which(names(dim(data)) %in% names(dim(ref)) == FALSE) + # Check if data1 has dimension sdate_dim and it should be added to data2: + if ((sdate_dim %in% names(dim(data1))) && dim(data1)[sdate_dim] > 1 && + !sdate_dim %in% names(dim(data2))) { + dim(data2) <- c(length(data2)/dim(data1)[sdate_dim], dim(data1)[sdate_dim]) + names(dim(data2)) <- c(time_dim, sdate_dim) + } + # Check if data1 needs to be extended to the length of the dimensions of data2: + if (length(dim(data2)) != length(dim(data1))) { + dif_dims <- which(names(dim(data2)) %in% names(dim(data1)) == FALSE) for (i in dif_dims) { - ref <- s2dv::InsertDim(ref, posdim = i, lendim = dim(data)[i], - name = names(dim(data))[i], ncores = ncores) + data1 <- s2dv::InsertDim(data1, posdim = i, lendim = dim(data2)[i], + name = names(dim(data2))[i], ncores = ncores) } } - dims1 <- which(dim(ref) == 1) - for (i in dims1) { - dim1_in_data <- which(names(dim(data)) == names(dim(ref))[i]) - if (dim(data)[dim1_in_data] > 1) { - ref <- s2dv::InsertDim(Subset(ref, along = i, indices = 1, drop = TRUE), - posdim = i, lendim = dim(data)[dim1_in_data], - name = names(dim(data))[dim1_in_data]) + # Check if data2 needs to be extended to the length of the dimensions of data1: + if (length(dim(data1)) != length(dim(data2))) { + dif_dims <- which(names(dim(data1)) %in% names(dim(data2)) == FALSE) + for (i in dif_dims) { + data2 <- s2dv::InsertDim(data2, posdim = i, lendim = dim(data1)[i], + name = names(dim(data1))[i], ncores = ncores) } - } - - data <- SelectPeriodOnData(data, dates = data_dates, start = list(day, month), - end = end, time_dim = time_dim, ncores = ncores) - data <- Apply(list(ref, data), target_dims = time_dim, fun = 'c', + } + # Check dimensions different lenght + dims_to_check <- dim(data1)[-which(names(dim(data1)) == time_dim)] + lapply(1:length(dims_to_check), function(x) { + if (dim(data2)[which(names(dim(data2)) == names(dim(data1))[x])] != + dim(data1)[x]) { + stop("Found one dimension with different length among data1 and data2.") + }}) + dims_to_check <- dim(data2)[-which(names(dim(data2)) == time_dim)] + lapply(dim(data1), function(x) { + if (dim(data2)[which(names(dim(data2)) == names(dim(data2))[x])] != + dim(data2)[x]) { + stop("Found one dimension with different length among data1 and data2.") + }}) + data2 <- SelectPeriodOnData(data2, dates = dates2, start = start2, + end = end2, time_dim = time_dim, ncores = ncores) + data1 <- Apply(list(data1, data2), target_dims = time_dim, fun = 'c', output_dims = time_dim, ncores = ncores)$output1 - return(data) + return(data1) } diff --git a/tests/testthat/test-MergeRefToExp.R b/tests/testthat/test-MergeRefToExp.R index a3865dd..8beb270 100644 --- a/tests/testthat/test-MergeRefToExp.R +++ b/tests/testthat/test-MergeRefToExp.R @@ -16,12 +16,14 @@ test_that("Sanity checks", { data <- CSTools::s2dv_cube(data = data, Dates = list(start = data_dates, end = data_dates)) - expect_equal(CST_MergeRefToExp(ref, data, start = list(21, 6), + expect_equal(CST_MergeRefToExp(data1 = ref, data2 = data, start1 = list(21, 6), + end1 = list(30, 6), start2 = list(1, 7), end = list(21, 9))$Dates, SelectPeriodOnDates(ref_dates, start = list(21, 6), end = list(21,9))) output <- array(c(1172:1181, 1:83, 1537:1546, 155:237, 1172:1181, 309:391, 1537:1546, 463:545), c(ftime = 93, sdate = 2, member = 2)) - expect_equal(CST_MergeRefToExp(ref, data, start = list(21, 6), + expect_equal(CST_MergeRefToExp(data1 = ref, data2 = data, start1 = list(21, 6), + end1 = list(30, 6), start2 = list(1, 7) end = list(21, 9))$data, output) }) -- GitLab From 8dae339771377b2e4474d1c73a0beedae2596d4c Mon Sep 17 00:00:00 2001 From: nperez Date: Mon, 1 Mar 2021 15:21:51 +0100 Subject: [PATCH 13/16] Fix CST_MergeRefToExp and examples --- R/MergeRefToExp.R | 53 ++++++++++++++++++----------------------------- 1 file changed, 20 insertions(+), 33 deletions(-) diff --git a/R/MergeRefToExp.R b/R/MergeRefToExp.R index 0baab95..ab9b84b 100644 --- a/R/MergeRefToExp.R +++ b/R/MergeRefToExp.R @@ -29,9 +29,11 @@ #' end = ref_dates)) #'data <- CSTools::s2dv_cube(data = data, Dates = list(start = data_dates, #' end = data_dates)) -#'new_data <- CST_MergeRefToExp(ref, data, start = list(21, 6), end = list(21, 9)) +#'new_data <- CST_MergeRefToExp(data1 = ref, data2 = data, +#' start1 = list(21, 6), end1 = list(20, 6), +#' start2 = list(1, 7), end2 = list(21, 9)) #'@export -CST_MergeRefToExp <- function(ref, data, start, end, +CST_MergeRefToExp <- function(data1, data2, start1, end1, start2, end2, time_dim = 'ftime', sdate_dim = 'sdate', ncores = NULL) { if (!inherits(ref, 's2dv_cube')) { @@ -55,43 +57,27 @@ CST_MergeRefToExp <- function(ref, data, start, end, "all data would be used.") } } - data$data <- MergeRefToExp(ref = ref$data, ref_dates = ref$Dates[[1]], - data = data$data, data_dates = data$Dates[[1]], - start, end, time_dim = time_dim, + data1$data <- MergeRefToExp(data1 = data1$data, dates1 = data1$Dates[[1]], + start1 = start1, end1 = end1, + data2 = data2$data, dates2 = data2$Dates[[1]], + start2, end2, time_dim = time_dim, sdate_dim = sdate_dim, ncores = ncores) - ini <- ClimProjDiags::Subset(data$Dates[[1]], along = time_dim, indices = 1) - day <- format(ini, "%d") - month <- format(ini, "%m") - if (length(day) > 1) { - if (any(day[1] != day)) { - warning("Different initialization days found in 'data_dates'.", - " Only the first one is being used. Check the result.") - } - day <- day[1] - } - if (length(month) > 1) { - if (any(month[1] != month)) { - warning("Different initialization months found in 'data_dates'.", - " Only the first one is being used. Check the result.") - } - month <- month[1] - } - ref_dates <- SelectPeriodOnDates(ref$Dates[[1]], start = start, - end = list(day, month), + dates1 <- SelectPeriodOnDates(data1$Dates[[1]], start = start1, + end = end1, time_dim = time_dim) - data_dates <- SelectPeriodOnDates(data$Dates[[1]], - start = list(day, month), - end = end, time_dim = time_dim) + dates2 <- SelectPeriodOnDates(data2$Dates[[1]], + start = start2, + end = end2, time_dim = time_dim) # TO DO CONCATENATE DATES - res <- Apply(list(ref_dates, data_dates), target_dims = time_dim, + res <- Apply(list(dates1, dates2), target_dims = time_dim, c, output_dims = time_dim, ncores = ncores)$output1 if (class(ref_dates) == 'Date') { - data$Dates <- as.Date(res, origin = '1970-01-01') + data1$Dates <- as.Date(res, origin = '1970-01-01') } else { - data$Dates <- as.POSIXct(res*3600*24, origin = '1970-01-01', tz = 'UTC') + data1$Dates <- as.POSIXct(res*3600*24, origin = '1970-01-01', tz = 'UTC') } - return(data) + return(data1) } #'Merge a Reference To Experiments @@ -125,8 +111,9 @@ CST_MergeRefToExp <- function(ref, data, start, end, #'dim(ref_dates) <- c(time = 350, sdate = 2) #'ref <- array(1001:1700, c(time = 350, sdate = 2)) #'data <- array(1:(2*154*2), c(time = 154, sdate = 2, member= 2)) -#'new_data <- MergeRefToExp(ref, ref_dates, data, data_dates, -#' start = list(21, 6), end = list(21, 9)) +#'new_data <- MergeRefToExp(data1 = ref, dates1 = ref_dates, start1 = list(21, 6), +#' end1 = list(30, 6), data2 = data, dates2 = data_dates, +#' start2 = list(1, 7), end = list(21, 9)) #'@export MergeRefToExp <- function(data1, dates1, start1, end1, data2, dates2, start2, end2, time_dim = 'time', sdate_dim = 'sdate', -- GitLab From 7d4b5b1054a21100193fcc73457ac5f479e4eb79 Mon Sep 17 00:00:00 2001 From: nperez Date: Mon, 1 Mar 2021 19:01:19 +0100 Subject: [PATCH 14/16] fixed parameters --- R/MergeRefToExp.R | 83 ++++++++++++++++------------- man/CST_MergeRefToExp.Rd | 28 ++++++---- man/MergeRefToExp.Rd | 35 +++++++----- tests/testthat/test-MergeRefToExp.R | 6 +-- 4 files changed, 87 insertions(+), 65 deletions(-) diff --git a/R/MergeRefToExp.R b/R/MergeRefToExp.R index ab9b84b..365ceb5 100644 --- a/R/MergeRefToExp.R +++ b/R/MergeRefToExp.R @@ -4,8 +4,10 @@ #' #'@param data1 an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools. #'@param data2 an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools. -#'@param start1 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 end1 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 start1 a list to defined the initial date of the period to select from data1 by providing a list of two elements: the initial date of the period and the initial month of the period. +#'@param end1 a list to defined the final date of the period to select from data1 by providing a list of two elements: the final day of the period and the final month of the period. +#'@param start2 a list to defined the initial date of the period to select from data2 by providing a list of two elements: the initial date of the period and the initial month of the period. +#'@param end2 a list to defined the final date of the period to select from data2 by providing a list of two elements: the final day of the period and the final month of the period. #'@param time_dim a character string indicating the name of the temporal dimension. 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. This dimension is required to subset the data in a requested period. #'@param sdate_dim a character string indicating the name of the dimension in which the initialization dates are stored. #'@param ncores an integer indicating the number of cores to use in parallel computation. @@ -30,27 +32,40 @@ #'data <- CSTools::s2dv_cube(data = data, Dates = list(start = data_dates, #' end = data_dates)) #'new_data <- CST_MergeRefToExp(data1 = ref, data2 = data, -#' start1 = list(21, 6), end1 = list(20, 6), +#' start1 = list(21, 6), end1 = list(30, 6), #' start2 = list(1, 7), end2 = list(21, 9)) #'@export CST_MergeRefToExp <- function(data1, data2, start1, end1, start2, end2, time_dim = 'ftime', sdate_dim = 'sdate', ncores = NULL) { - if (!inherits(ref, 's2dv_cube')) { + if (!inherits(data1, 's2dv_cube')) { stop("Parameter 'ref' must be of the class 's2dv_cube', ", "as output by CSTools::CST_Load.") } - if (!inherits(data, 's2dv_cube')) { + if (!inherits(data2, '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(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']) + if (is.null(dim(data1$Dates$start))) { + if (length(data1$Dates$start) != dim(data1$data)[time_dim]) { + if (length(data1$Dates$start) == + prod(dim(data1$data)[time_dim] * dim(data1$data)['sdate'])) { + dim(data1$Dates$start) <- c(dim(data1$data)[time_dim], + dim(data1$data)['sdate']) + } + } else { + warning("Dimensions in 'data' element 'data$Dates$start' are missed and", + "all data would be used.") + } + } + # when subsetting is needed, dimensions are also needed: + if (is.null(dim(data2$Dates$start))) { + if (length(data2$Dates$start) != dim(data2$data)[time_dim]) { + if (length(data2$Dates$start) == + prod(dim(data2$data)[time_dim] * dim(data2$data)['sdate'])) { + dim(data2$Dates$start) <- c(dim(data2$data)[time_dim], + dim(data2$data)['sdate']) } } else { warning("Dimensions in 'data' element 'data$Dates$start' are missed and", @@ -62,7 +77,6 @@ CST_MergeRefToExp <- function(data1, data2, start1, end1, start2, end2, data2 = data2$data, dates2 = data2$Dates[[1]], start2, end2, time_dim = time_dim, sdate_dim = sdate_dim, ncores = ncores) - dates1 <- SelectPeriodOnDates(data1$Dates[[1]], start = start1, end = end1, time_dim = time_dim) @@ -72,7 +86,7 @@ CST_MergeRefToExp <- function(data1, data2, start1, end1, start2, end2, # TO DO CONCATENATE DATES res <- Apply(list(dates1, dates2), target_dims = time_dim, c, output_dims = time_dim, ncores = ncores)$output1 - if (class(ref_dates) == 'Date') { + if (class(data1$Dates[[1]]) == 'Date') { data1$Dates <- as.Date(res, origin = '1970-01-01') } else { data1$Dates <- as.POSIXct(res*3600*24, origin = '1970-01-01', tz = 'UTC') @@ -84,12 +98,14 @@ CST_MergeRefToExp <- function(data1, data2, start1, end1, start2, end2, #' #'Some indicators are defined for specific temporal periods (e.g.: summer from June 21st to September 21st). If the initialization forecast date is later than the one required for the indicator (e.g.: July 1st), the user may want to merge past observations, or other reference, to the forecast (or hindcast) to compute the indicator. The function \code{MergeObs2Exp} takes care of this steps. #' -#'@param ref a multidimensional array with named dimensions. -#'@param ref_dates a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'ref'. -#'@param data a multidimensional array with named dimensions. -#'@param data_dates a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data'. -#'@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 data1 a multidimensional array with named dimensions. +#'@param dates1 a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data1'. +#'@param data2 a multidimensional array with named dimensions. +#'@param dates2 a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data2'. +#'@param start1 a list to defined the initial date of the period to select from data1 by providing a list of two elements: the initial date of the period and the initial month of the period. +#'@param end1 a list to defined the final date of the period to select from data1 by providing a list of two elements: the final day of the period and the final month of the period. +#'@param start2 a list to defined the initial date of the period to select from data2 by providing a list of two elements: the initial date of the period and the initial month of the period. +#'@param end2 a list to defined the final date of the period to select from data2 by providing a list of two elements: the final day of the period and the final month of the period. #'@param time_dim a character string indicating the name of the temporal dimension. 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. This dimension is required to subset the data in a requested period. #'@param sdate_dim a character string indicating the name of the dimension in which the initialization dates are stored. #'@param ncores an integer indicating the number of cores to use in parallel computation. @@ -152,32 +168,23 @@ MergeRefToExp <- function(data1, dates1, start1, end1, data2, dates2, start2, en # Check if data1 needs to be extended to the length of the dimensions of data2: if (length(dim(data2)) != length(dim(data1))) { dif_dims <- which(names(dim(data2)) %in% names(dim(data1)) == FALSE) - for (i in dif_dims) { - data1 <- s2dv::InsertDim(data1, posdim = i, lendim = dim(data2)[i], - name = names(dim(data2))[i], ncores = ncores) + if (length(dif_dims) > 0) { + for (i in dif_dims) { + data1 <- s2dv::InsertDim(data1, posdim = i, lendim = dim(data2)[i], + name = names(dim(data2))[i], ncores = ncores) + } } } # Check if data2 needs to be extended to the length of the dimensions of data1: if (length(dim(data1)) != length(dim(data2))) { dif_dims <- which(names(dim(data1)) %in% names(dim(data2)) == FALSE) - for (i in dif_dims) { - data2 <- s2dv::InsertDim(data2, posdim = i, lendim = dim(data1)[i], - name = names(dim(data1))[i], ncores = ncores) + if (length(dif_dims) > 0) { + for (i in dif_dims) { + data2 <- s2dv::InsertDim(data2, posdim = i, lendim = dim(data1)[i], + name = names(dim(data1))[i], ncores = ncores) + } } } - # Check dimensions different lenght - dims_to_check <- dim(data1)[-which(names(dim(data1)) == time_dim)] - lapply(1:length(dims_to_check), function(x) { - if (dim(data2)[which(names(dim(data2)) == names(dim(data1))[x])] != - dim(data1)[x]) { - stop("Found one dimension with different length among data1 and data2.") - }}) - dims_to_check <- dim(data2)[-which(names(dim(data2)) == time_dim)] - lapply(dim(data1), function(x) { - if (dim(data2)[which(names(dim(data2)) == names(dim(data2))[x])] != - dim(data2)[x]) { - stop("Found one dimension with different length among data1 and data2.") - }}) data2 <- SelectPeriodOnData(data2, dates = dates2, start = start2, end = end2, time_dim = time_dim, ncores = ncores) data1 <- Apply(list(data1, data2), target_dims = time_dim, fun = 'c', diff --git a/man/CST_MergeRefToExp.Rd b/man/CST_MergeRefToExp.Rd index fb92117..61c1840 100644 --- a/man/CST_MergeRefToExp.Rd +++ b/man/CST_MergeRefToExp.Rd @@ -5,23 +5,29 @@ \title{Merge a Reference To Experiments} \usage{ CST_MergeRefToExp( - ref, - data, - start, - end, + data1, + data2, + start1, + end1, + start2, + end2, time_dim = "ftime", sdate_dim = "sdate", ncores = NULL ) } \arguments{ -\item{ref}{an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools.} +\item{data1}{an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools.} -\item{data}{an 's2dv_cube' object as provided function \code{CST_Load} in package CSTools.} +\item{data2}{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{start1}{a list to defined the initial date of the period to select from data1 by providing a list of two elements: the initial date of the period and the initial month of the period.} -\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{end1}{a list to defined the final date of the period to select from data1 by providing a list of two elements: the final day of the period and the final month of the period.} + +\item{start2}{a list to defined the initial date of the period to select from data2 by providing a list of two elements: the initial date of the period and the initial month of the period.} + +\item{end2}{a list to defined the final date of the period to select from data2 by providing a list of two elements: the final day of the period and the final month of the period.} \item{time_dim}{a character string indicating the name of the temporal dimension. 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. This dimension is required to subset the data in a requested period.} @@ -33,7 +39,7 @@ CST_MergeRefToExp( A 's2dv_cube' object containing the indicator in the element \code{data}. } \description{ -Some indicators are defined for specific temporal periods (e.g.: summer from June 21st to September 21st). If the initialization forecast date is later than the one required for the indicator (e.g.: July 1st), the user may want to merge past observations, or other reference, to the forecast (or hindcast) to compute the indicator. The function \code{MergeObs2Exp} takes care of this steps. +Some indicators are defined for specific temporal periods (e.g.: summer from June 21st to September 21st). If the initialization forecast date is later than the one required for the indicator (e.g.: July 1st), the user may want to merge past observations, or other references, to the forecast (or hindcast) to compute the indicator. The function \code{MergeObs2Exp} takes care of this steps. If the forecast simulation doesn't cover the required period because it is initialized too early (e.g.: Initialization on November 1st the forecast covers until the beginning of June next year), a climatology (or other references) could be added at the end of the forecast lead time to cover the desired period (e.g.: until the end of summer). } \examples{ data_dates <- c(seq(as.Date("01-07-1993", "\%d-\%m-\%Y", tz = 'UTC'), @@ -50,5 +56,7 @@ ref <- CSTools::s2dv_cube(data = ref, Dates = list(start = ref_dates, end = ref_dates)) data <- CSTools::s2dv_cube(data = data, Dates = list(start = data_dates, end = data_dates)) -new_data <- CST_MergeRefToExp(ref, data, start = list(21, 6), end = list(21, 9)) +new_data <- CST_MergeRefToExp(data1 = ref, data2 = data, + start1 = list(21, 6), end1 = list(30, 6), + start2 = list(1, 7), end2 = list(21, 9)) } diff --git a/man/MergeRefToExp.Rd b/man/MergeRefToExp.Rd index b44bcfc..9826df7 100644 --- a/man/MergeRefToExp.Rd +++ b/man/MergeRefToExp.Rd @@ -5,29 +5,35 @@ \title{Merge a Reference To Experiments} \usage{ MergeRefToExp( - ref, - ref_dates, - data, - data_dates, - start, - end, + data1, + dates1, + start1, + end1, + data2, + dates2, + start2, + end2, time_dim = "time", sdate_dim = "sdate", ncores = NULL ) } \arguments{ -\item{ref}{a multidimensional array with named dimensions.} +\item{data1}{a multidimensional array with named dimensions.} -\item{ref_dates}{a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'ref'.} +\item{dates1}{a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data1'.} -\item{data}{a multidimensional array with named dimensions.} +\item{start1}{a list to defined the initial date of the period to select from data1 by providing a list of two elements: the initial date of the period and the initial month of the period.} -\item{data_dates}{a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data'.} +\item{end1}{a list to defined the final date of the period to select from data1 by providing a list of two elements: the final day of the period and the final month of the 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{data2}{a multidimensional array with named dimensions.} -\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{dates2}{a vector of dates or a multidimensional array of dates with named dimensions matching the dimensions on parameter 'data2'.} + +\item{start2}{a list to defined the initial date of the period to select from data2 by providing a list of two elements: the initial date of the period and the initial month of the period.} + +\item{end2}{a list to defined the final date of the period to select from data2 by providing a list of two elements: the final day of the period and the final month of the period.} \item{time_dim}{a character string indicating the name of the temporal dimension. 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. This dimension is required to subset the data in a requested period.} @@ -52,6 +58,7 @@ ref_dates <- seq(as.Date("01-01-1993", "\%d-\%m-\%Y", tz = 'UTC'), dim(ref_dates) <- c(time = 350, sdate = 2) ref <- array(1001:1700, c(time = 350, sdate = 2)) data <- array(1:(2*154*2), c(time = 154, sdate = 2, member= 2)) -new_data <- MergeRefToExp(ref, ref_dates, data, data_dates, - start = list(21, 6), end = list(21, 9)) +new_data <- MergeRefToExp(data1 = ref, dates1 = ref_dates, start1 = list(21, 6), + end1 = list(30, 6), data2 = data, dates2 = data_dates, + start2 = list(1, 7), end = list(21, 9)) } diff --git a/tests/testthat/test-MergeRefToExp.R b/tests/testthat/test-MergeRefToExp.R index 8beb270..5f57e74 100644 --- a/tests/testthat/test-MergeRefToExp.R +++ b/tests/testthat/test-MergeRefToExp.R @@ -18,12 +18,12 @@ test_that("Sanity checks", { expect_equal(CST_MergeRefToExp(data1 = ref, data2 = data, start1 = list(21, 6), end1 = list(30, 6), start2 = list(1, 7), - end = list(21, 9))$Dates, SelectPeriodOnDates(ref_dates, + end2 = list(21, 9))$Dates, SelectPeriodOnDates(ref_dates, start = list(21, 6), end = list(21,9))) output <- array(c(1172:1181, 1:83, 1537:1546, 155:237, 1172:1181, 309:391, 1537:1546, 463:545), c(ftime = 93, sdate = 2, member = 2)) expect_equal(CST_MergeRefToExp(data1 = ref, data2 = data, start1 = list(21, 6), - end1 = list(30, 6), start2 = list(1, 7) - end = list(21, 9))$data, output) + end1 = list(30, 6), start2 = list(1, 7), + end2 = list(21, 9))$data, output) }) -- GitLab From 210d5d3e5bce3d393ecdebe93648cf0f6c382205 Mon Sep 17 00:00:00 2001 From: lpalma Date: Tue, 4 May 2021 14:16:33 +0200 Subject: [PATCH 15/16] Tests for merge to exp --- tests/testthat/test-MergeRefToExp.R | 59 ++++++++++++++++++++++++----- 1 file changed, 50 insertions(+), 9 deletions(-) diff --git a/tests/testthat/test-MergeRefToExp.R b/tests/testthat/test-MergeRefToExp.R index 5f57e74..a74df90 100644 --- a/tests/testthat/test-MergeRefToExp.R +++ b/tests/testthat/test-MergeRefToExp.R @@ -2,12 +2,13 @@ context("Generic tests") test_that("Sanity checks", { #source("csindicators/R/MergeRefToExp.R") data_dates <- c(seq(as.Date("01-07-1993", "%d-%m-%Y", tz = 'UTC'), - as.Date("01-12-1993","%d-%m-%Y", tz = 'UTC'), "day"), - seq(as.Date("01-07-1994", "%d-%m-%Y", tz = 'UTC'), - as.Date("01-12-1994","%d-%m-%Y", tz = 'UTC'), "day")) + as.Date("01-12-1993", "%d-%m-%Y", tz = 'UTC'), "day"), + seq(as.Date("01-07-1994", "%d-%m-%Y", tz = 'UTC'), + as.Date("01-12-1994","%d-%m-%Y", tz = 'UTC'), "day")) + dim(data_dates) <- c(ftime = 154, sdate = 2) ref_dates <- seq(as.Date("01-01-1993", "%d-%m-%Y", tz = 'UTC'), - as.Date("01-12-1994","%d-%m-%Y", tz = 'UTC'), "day") + as.Date("01-12-1994", "%d-%m-%Y", tz = 'UTC'), "day") dim(ref_dates) <- c(ftime = 350, sdate = 2) ref <- array(1001:1700, c(ftime = 350, sdate = 2)) data <- array(1:(2*154*2), c(ftime = 154, sdate = 2, member= 2)) @@ -17,13 +18,53 @@ test_that("Sanity checks", { end = data_dates)) expect_equal(CST_MergeRefToExp(data1 = ref, data2 = data, start1 = list(21, 6), - end1 = list(30, 6), start2 = list(1, 7), - end2 = list(21, 9))$Dates, SelectPeriodOnDates(ref_dates, - start = list(21, 6), end = list(21,9))) + end1 = list(30, 6), start2 = list(1, 7), + end2 = list(21, 9))$Dates, + SelectPeriodOnDates(ref_dates, start = list(21, 6), end = list(21,9))) + output <- array(c(1172:1181, 1:83, 1537:1546, 155:237, 1172:1181, 309:391, 1537:1546, 463:545), c(ftime = 93, sdate = 2, member = 2)) + expect_equal(CST_MergeRefToExp(data1 = ref, data2 = data, start1 = list(21, 6), - end1 = list(30, 6), start2 = list(1, 7), - end2 = list(21, 9))$data, output) + end1 = list(30, 6), start2 = list(1, 7), + end2 = list(21, 9))$data, + output) }) +test_that("Seasonal", { + + dates <- NULL + hcst.inityear <- 1993 + hcst.endyear <- 2017 + for (year in hcst.inityear:hcst.endyear){ + dates <- c(dates, format(seq(as.Date(paste0("01-04-",year), "%d-%m-%Y", + tz = 'UTC'), + as.Date(paste0("01-11-",year), "%d-%m-%Y", + tz = 'UTC'), "day"), + "%Y-%m-%d")) + } + dates <- as.Date(dates, tz = 'UTC') + dim.dates <- c(ftime=215, sweek = 1, sday = 1, + sdate=(hcst.endyear-hcst.inityear)+1) + dim(dates) <- dim.dates + + ref <- array(1:(215*25), c(ftime = 215, sdate = 25)) + ref <- CSTools::s2dv_cube(data = ref, + Dates = list(start = dates, + end = dates)) + + data <- array(1:(215*25*3), c(ftime = 215, sdate = 25, member=3)) + data <- CSTools::s2dv_cube(data = data, + Dates = list(start = dates, + end = dates)) + + expect_equal(CST_MergeRefToExp(data1 = data, data2 = ref, start1 = list(21, 6), + end1 = list(30, 6), start2 = list(1, 7), + end2 = list(21, 9))$Dates, + SelectPeriodOnDates(dates, start = list(21, 6), end = list(21,9))) + + expect_equal(CST_MergeRefToExp(data1 = ref, data2 = data, start1 = list(21, 6), + end1 = list(30, 6), start2 = list(1, 7), + end2 = list(21, 9))$Dates, + SelectPeriodOnDates(dates, start = list(21, 6), end = list(21,9))) +}) -- GitLab From 08b79256c15b79d2a94e6a419042402adecfee8e Mon Sep 17 00:00:00 2001 From: nperez Date: Tue, 4 May 2021 15:09:48 +0200 Subject: [PATCH 16/16] Add contributor --- DESCRIPTION | 1 + NAMESPACE | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index f8939a9..16274dc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,6 +7,7 @@ Authors@R: c( person("Llorenç", "Lledó", , "llorenc.lledo@bsc.es", role = "aut"), person("González-Reviriego", "Nube", , "nube.gonzalez@bsc.es", role = "ctb"), person("Marcos", "Raül", , "raul.marcos@bsc.es", role = "ctb"), + person("Palma", "Lluis", , "lluis.palma@bsc.es", role = "ctb"), person("BSC-CNS", role = "cph")) Description: Set of generalised tools for the flexible computation of climate related indicators defined by the user. Each method represents a specific mathematical approach which is combined with the possibility to select an arbitrary time period to define the indicator. This enables a wide range of possibilities to tailor the most suitable indicator for each particular climate service application (agriculture, food security, energy, water management…). This package is intended for sub-seasonal, seasonal and decadal climate predictions, but its methods are also applicable to other time-scales, provided the dimensional structure of the input is maintained. Additionally, the outputs of the functions in this package are compatible with CSTools. This package was developed in the context of H2020 MED-GOLD (776467) and S2S4E (776787) projects. Depends: diff --git a/NAMESPACE b/NAMESPACE index bab5fde..133942a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,9 +12,9 @@ export(CST_SelectPeriodOnData) export(CST_Threshold) export(CST_TotalSpellTimeExceedingThreshold) export(CST_TotalTimeExceedingThreshold) -export(MergeRefToExp) export(CST_WindCapacityFactor) export(CST_WindPowerDensity) +export(MergeRefToExp) export(PeriodAccumulation) export(PeriodMean) export(QThreshold) -- GitLab