From b9ac1a5792d9d417935ed12621ef5da47355c3cd Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 12 Dec 2019 17:53:50 +0100 Subject: [PATCH 1/5] Parameter filter_span added --- R/CST_Anomaly.R | 31 ++++++++++++++++++++++++++++--- man/CST_Anomaly.Rd | 4 +++- 2 files changed, 31 insertions(+), 4 deletions(-) diff --git a/R/CST_Anomaly.R b/R/CST_Anomaly.R index e76c46ab..8699b860 100644 --- a/R/CST_Anomaly.R +++ b/R/CST_Anomaly.R @@ -12,7 +12,7 @@ #'@param cross A logical value indicating whether cross-validation should be applied or not. Default = FALSE. #'@param memb A logical value indicating whether Clim() computes one climatology for each experimental data #'product member(TRUE) or it computes one sole climatology for all members (FALSE). Default = TRUE. -#' +#'@param filter_span a numeric value indicating the degree of smoothing. This option is only available if parameter \code{cross} is set to FALSE. #'@param dim_anom An integer indicating the dimension along which the climatology will be computed. It #'usually corresponds to 3 (sdates) or 4 (ftime). Default = 3. #' @@ -48,7 +48,8 @@ #' #' #'@export -CST_Anomaly <- function(exp = NULL, obs = NULL, cross = FALSE, memb = TRUE, dim_anom = 3) { +CST_Anomaly <- function(exp = NULL, obs = NULL, cross = FALSE, memb = TRUE, + filter_span = NULL, dim_anom = 3) { if (!inherits(exp, 's2dv_cube') || !inherits(obs, 's2dv_cube')) { stop("Parameter 'exp' and 'obs' must be of the class 's2dv_cube', ", @@ -137,7 +138,22 @@ CST_Anomaly <- function(exp = NULL, obs = NULL, cross = FALSE, memb = TRUE, dim_ # Without cross-validation } else { tmp <- Clim(var_exp = exp$data, var_obs = obs$data, memb = memb) - + if (!is.null(filter_span)) { + if (is.numeric(filter_span)) { + pos_dims <- names(dim(tmp$clim_exp)) + reorder <- match(pos_dims, c('ftime', + pos_dims[-which(pos_dims == 'ftime')])) + tmp$clim_obs <- aperm(apply(tmp$clim_obs, c(1 : + length(dim(tmp$clim_obs)))[-which(names(dim(tmp$clim_obs)) == 'ftime')], + .Loess, loess_span = filter_span), reorder) + tmp$clim_exp <- aperm(apply(tmp$clim_exp, c(1 : + length(dim(tmp$clim_exp)))[-which(names(dim(tmp$clim_exp)) == 'ftime')], + .Loess, loess_span = filter_span), reorder) + } else { + warning("Paramater 'filter_span' is not numeric and any filter", + " is being applied.") + } + } if (memb) { clim_exp <- tmp$clim_exp clim_obs <- tmp$clim_obs @@ -149,6 +165,8 @@ CST_Anomaly <- function(exp = NULL, obs = NULL, cross = FALSE, memb = TRUE, dim_ clim_exp <- InsertDim(clim_exp, 3, dim_exp[3]) clim_obs <- InsertDim(clim_obs, 3, dim_obs[3]) ano <- NULL +print(dim(exp$data)) +print(dim(clim_exp)) ano$ano_exp <- exp$data - clim_exp ano$ano_obs <- obs$data - clim_obs } @@ -186,3 +204,10 @@ CST_Anomaly <- function(exp = NULL, obs = NULL, cross = FALSE, memb = TRUE, dim_ return(list(exp = exp, obs = obs)) } } +.Loess <- function(clim, loess_span) { + data <- data.frame(ensmean = clim, day = 1 : length(clim)) + loess_filt <- loess(ensmean ~ day, data, span = loess_span) + output <- predict(loess_filt) + return(output) +} + diff --git a/man/CST_Anomaly.Rd b/man/CST_Anomaly.Rd index e1c31f0c..0e90c0df 100644 --- a/man/CST_Anomaly.Rd +++ b/man/CST_Anomaly.Rd @@ -5,7 +5,7 @@ \title{Anomalies relative to a climatology along selected dimension with or without cross-validation} \usage{ CST_Anomaly(exp = NULL, obs = NULL, cross = FALSE, memb = TRUE, - dim_anom = 3) + filter_span = NULL, dim_anom = 3) } \arguments{ \item{exp}{an object of class \code{s2dv_cube} as returned by \code{CST_Load} function, containing the seasonal forecast experiment data in the element named \code{$data}.} @@ -17,6 +17,8 @@ CST_Anomaly(exp = NULL, obs = NULL, cross = FALSE, memb = TRUE, \item{memb}{A logical value indicating whether Clim() computes one climatology for each experimental data product member(TRUE) or it computes one sole climatology for all members (FALSE). Default = TRUE.} +\item{filter_span}{a numeric value indicating the degree of smoothing. This option is only available if parameter \code{cross} is set to FALSE.} + \item{dim_anom}{An integer indicating the dimension along which the climatology will be computed. It usually corresponds to 3 (sdates) or 4 (ftime). Default = 3.} } -- GitLab From 62987e26391d04c6e8f80ec103de905259d16795 Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 12 Dec 2019 17:55:48 +0100 Subject: [PATCH 2/5] sea also loess function --- R/CST_Anomaly.R | 2 +- man/CST_Anomaly.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/CST_Anomaly.R b/R/CST_Anomaly.R index 8699b860..3abd39b7 100644 --- a/R/CST_Anomaly.R +++ b/R/CST_Anomaly.R @@ -44,7 +44,7 @@ #'anom4 <- CST_Anomaly(exp = exp, obs = obs, cross = FALSE, memb = FALSE) #'str(anom4) #' -#'@seealso \code{\link[s2dverification]{Ano_CrossValid}}, \code{\link[s2dverification]{Clim}} and \code{\link{CST_Load}} +#'@seealso \code{\link[s2dverification]{Ano_CrossValid}}, \code{\link[s2dverification]{Clim}}, \code{\link{CST_Load}} and \code{\link[stats]{loess}} #' #' #'@export diff --git a/man/CST_Anomaly.Rd b/man/CST_Anomaly.Rd index 0e90c0df..3f3ff81b 100644 --- a/man/CST_Anomaly.Rd +++ b/man/CST_Anomaly.Rd @@ -62,6 +62,6 @@ Perez-Zanon Nuria, \email{nuria.perez@bsc.es} Pena Jesus, \email{jesus.pena@bsc.es} } \seealso{ -\code{\link[s2dverification]{Ano_CrossValid}}, \code{\link[s2dverification]{Clim}} and \code{\link{CST_Load}} +\code{\link[s2dverification]{Ano_CrossValid}}, \code{\link[s2dverification]{Clim}}, \code{\link{CST_Load}} and \code{\link[stats]{loess}} } -- GitLab From f9655fc0d67ef988c49f23a73b2cd951e2df335e Mon Sep 17 00:00:00 2001 From: nperez Date: Wed, 18 Dec 2019 12:30:34 +0100 Subject: [PATCH 3/5] remove prints in the code --- R/CST_Anomaly.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/CST_Anomaly.R b/R/CST_Anomaly.R index 3abd39b7..b35635f1 100644 --- a/R/CST_Anomaly.R +++ b/R/CST_Anomaly.R @@ -165,8 +165,6 @@ CST_Anomaly <- function(exp = NULL, obs = NULL, cross = FALSE, memb = TRUE, clim_exp <- InsertDim(clim_exp, 3, dim_exp[3]) clim_obs <- InsertDim(clim_obs, 3, dim_obs[3]) ano <- NULL -print(dim(exp$data)) -print(dim(clim_exp)) ano$ano_exp <- exp$data - clim_exp ano$ano_obs <- obs$data - clim_obs } -- GitLab From d6c9c5416ed13e94668becefc5f6cc8860f5aaba Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 11 Jun 2020 16:33:19 +0200 Subject: [PATCH 4/5] devtools doc --- man/CST_Anomaly.Rd | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/man/CST_Anomaly.Rd b/man/CST_Anomaly.Rd index d67276d5..11574168 100644 --- a/man/CST_Anomaly.Rd +++ b/man/CST_Anomaly.Rd @@ -4,8 +4,14 @@ \alias{CST_Anomaly} \title{Anomalies relative to a climatology along selected dimension with or without cross-validation} \usage{ -CST_Anomaly(exp = NULL, obs = NULL, cross = FALSE, memb = TRUE, - filter_span = NULL, dim_anom = 3) +CST_Anomaly( + exp = NULL, + obs = NULL, + cross = FALSE, + memb = TRUE, + filter_span = NULL, + dim_anom = 3 +) } \arguments{ \item{exp}{an object of class \code{s2dv_cube} as returned by \code{CST_Load} function, containing the seasonal forecast experiment data in the element named \code{$data}.} @@ -61,7 +67,7 @@ anom6 <- CST_Anomaly(obs = lonlat_data$obs) } \seealso{ -\code{\link[s2dverification]{Ano_CrossValid}}, \code{\link[s2dverification]{Clim}}, \code{\link{CST_Load}} and \code{\link[stats]{loess}} +\code{\link[s2dverification]{Ano_CrossValid}}, \code{\link[s2dverification]{Clim}} and \code{\link{CST_Load}} } \author{ Perez-Zanon Nuria, \email{nuria.perez@bsc.es} -- GitLab From b2e6be3232a19cdae61b2b18344828e84795045f Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 11 Jun 2020 17:43:57 +0200 Subject: [PATCH 5/5] filter option added to NEWS --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 2a9cffb6..f108f5db 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,7 @@ + EnsClustering vignette + EnsClustering has a new parameter 'time_dim' + CST_BiasCorrection has na.rm paramter + + CST_Anomaly allows to smooth the climatology with filter.span parameter - Fixes + CST_Anomaly handles exp, obs or both + PlotForecastPDF vignette displays figures correctly -- GitLab