From f92604910576c5603a3790d9481613fe86b5f3a1 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Mon, 19 Nov 2018 18:08:15 +0100 Subject: [PATCH 1/3] Updated to multiApply v2.0.0. --- R/AnoAgree.R | 6 ++++-- R/Climdex.R | 12 ++++++------ R/DTRIndicator.R | 4 ++-- R/DTRRef.R | 5 +++-- R/Extremes.R | 12 +++++++----- R/Threshold.R | 5 +++-- R/WaveDuration.R | 5 +++-- vignettes/extreme_indices.Rmd | 10 +++++----- 8 files changed, 33 insertions(+), 26 deletions(-) diff --git a/R/AnoAgree.R b/R/AnoAgree.R index d2e6985..4212039 100644 --- a/R/AnoAgree.R +++ b/R/AnoAgree.R @@ -73,7 +73,9 @@ AnoAgree <- function(ano, membersdim, na.rm = TRUE, ncores = NULL) { } margins <- 1 : length(dim(ano)) margins <- margins[-membersdim] - ano_agree <- Apply(data = list(ano), margins = list(margins), AtomicFun = .AnoAgree, na.rm = na.rm, + ano_agree <- Apply(data = list(ano), margins = list(margins), + fun = .AnoAgree, + na.rm = na.rm, ncores = ncores)[[1]] if (!is.null(names(dim(ano))) & length(dim(ano)) > 0) { dim_names <- names(dim(ano)) @@ -96,4 +98,4 @@ AnoAgree <- function(ano, membersdim, na.rm = TRUE, ncores = NULL) { ano_agree <- NA } return(ano_agree) -} \ No newline at end of file +} diff --git a/R/Climdex.R b/R/Climdex.R index 0b6057f..e182979 100644 --- a/R/Climdex.R +++ b/R/Climdex.R @@ -210,12 +210,12 @@ Climdex <- function(data, metric, threshold = NULL, base.range = NULL, dates = N target_dims <- list('time', 'jdays') } if (length(dims) > 1) { - result <- Apply(data = data, AtomicFun = .Climdex, + result <- Apply(data = data, fun = .Climdex, # margins = list(2, 1), - target_dims = target_dims, - output_dims = 'year', - dates = dates, date.factor = date.factor, metric = metric, - jdays = jdays, base.range = base.range, ncores = ncores) + target_dims = target_dims, + output_dims = 'year', + dates = dates, date.factor = date.factor, metric = metric, + jdays = jdays, base.range = base.range, ncores = ncores) } else { result <- list() result$output1 <- .Climdex(data = data[[1]], threshold = data[[2]], dates = dates, metric = metric, @@ -242,4 +242,4 @@ Climdex <- function(data, metric, threshold = NULL, base.range = NULL, dates = N op = "<", 20) } return(result) -} \ No newline at end of file +} diff --git a/R/DTRIndicator.R b/R/DTRIndicator.R index ae2b955..7f32b9c 100644 --- a/R/DTRIndicator.R +++ b/R/DTRIndicator.R @@ -217,7 +217,7 @@ DTRIndicator <- function(tmax, tmin, ref, by.seasons = TRUE, dates = NULL, timed } dtr <- (tmax - tmin) indicator = Apply(list(dtr, ref$dtr.ref), margins = list(margins_dtr, margins_ref), - AtomicFun = .DTRIndicator, date.factor = date.factor, + fun = .DTRIndicator, date.factor = date.factor, ref_seasons = ref$season, ncores = ncores) names(dim(indicator$output1)) <- c("year", "season", dim_names[c(-time_dim_dtr)]) @@ -240,4 +240,4 @@ DTRIndicator <- function(tmax, tmin, ref, by.seasons = TRUE, dates = NULL, timed } names(dim(result)) <- c("year", "season") return(result) -} \ No newline at end of file +} diff --git a/R/DTRRef.R b/R/DTRRef.R index c9d5fd7..008a993 100644 --- a/R/DTRRef.R +++ b/R/DTRRef.R @@ -197,7 +197,8 @@ DTRRef <- function(tmax, tmin, by.seasons = TRUE, dates = NULL, timedim = NULL, levels(date.factor)[which(levels(date.factor) == "03" | levels(date.factor) == "04"|levels(date.factor) == "05")] <- "MAM" } - dtr.ref <- Apply(list(tmax,tmin), margins = list(margins, margins), AtomicFun = .DTRRef, date.factor = date.factor, + dtr.ref <- Apply(list(tmax,tmin), margins = list(margins, margins), + fun = .DTRRef, date.factor = date.factor, na.rm = na.rm, ncores = ncores) indices <- levels(date.factor) dtr.ref = dtr.ref$output1 @@ -207,4 +208,4 @@ DTRRef <- function(tmax, tmin, by.seasons = TRUE, dates = NULL, timedim = NULL, .DTRRef <- function(tmax, tmin, ref, date.factor, na.rm = na.rm) { result <- tapply(tmax - tmin, INDEX = date.factor, FUN = mean, na.rm = na.rm) return(result) -} \ No newline at end of file +} diff --git a/R/Extremes.R b/R/Extremes.R index a60b4fe..46ecbaf 100644 --- a/R/Extremes.R +++ b/R/Extremes.R @@ -191,10 +191,12 @@ Extremes <- function(data, threshold, op = ">", min.length = 6, spells.can.span. data <- list(data, threshold) date.factor <- as.factor(substr(dates, 1, 4)) if (length(dim_names) > 1) { - exceedance <- Apply(data = data, target_dims = list(timedim, time_dim_threshold), AtomicFun = .Extremes, - date.factor = date.factor, jdays = jdays, op = op, - min.length = min.length, spells.can.span.years = spells.can.span.years, - max.missing.days = max.missing.days, ncores = ncores) + exceedance <- Apply(data = data, target_dims = list(timedim, time_dim_threshold), + fun = .Extremes, + date.factor = date.factor, jdays = jdays, op = op, + min.length = min.length, + spells.can.span.years = spells.can.span.years, + max.missing.days = max.missing.days, ncores = ncores) names(dim(exceedance$output1)) <- dim_names[-timedim] exceedance$year <- unique(as.numeric(as.vector(date.factor))) } else { @@ -213,4 +215,4 @@ Extremes <- function(data, threshold, op = ">", min.length = 6, spells.can.span. result <- threshold.exceedance.duration.index(data, date.factor, jdays, threshold,op, min.length, spells.can.span.years, max.missing.days) -} \ No newline at end of file +} diff --git a/R/Threshold.R b/R/Threshold.R index 99a2d07..aa43b3a 100644 --- a/R/Threshold.R +++ b/R/Threshold.R @@ -168,8 +168,9 @@ Threshold <- function(data, dates = NULL, calendar = NULL, base.range = NULL, qt } } if (length(dim(data)) > 1) { - result <- Apply(data = data, margins = margins, AtomicFun = .Threshold, indices = jdays, qtiles = qtiles, - ncores = ncores) + result <- Apply(data = data, margins = margins, + fun = .Threshold, indices = jdays, qtiles = qtiles, + ncores = ncores) names(dim(result$output1)) <- c("jdays", dim_names[-time_dim]) } else { result <- list() diff --git a/R/WaveDuration.R b/R/WaveDuration.R index 59caaac..b46ef52 100644 --- a/R/WaveDuration.R +++ b/R/WaveDuration.R @@ -198,7 +198,8 @@ WaveDuration <- function(data, threshold, op = ">", spell.length = 6, by.seasons c(1 : length(dim(threshold)))[-c(time_dim_threshold)]) data <- list(data , threshold ) if (length(dim_names) > 1) { - result <- Apply(data = data, margins = margins, AtomicFun = .WaveDuration, date.factor = date.factor, jdays = jdays, + result <- Apply(data = data, margins = margins, + fun = .WaveDuration, date.factor = date.factor, jdays = jdays, op = op, spell.length = spell.length, ncores = ncores) } else { result <- list() @@ -229,4 +230,4 @@ WaveDuration <- function(data, threshold, op = ">", spell.length = 6, by.seasons op = op, min.length = spell.length, spells.can.span.years = TRUE, 1) return(result) -} \ No newline at end of file +} diff --git a/vignettes/extreme_indices.Rmd b/vignettes/extreme_indices.Rmd index 2d55bc6..b0c33ee 100644 --- a/vignettes/extreme_indices.Rmd +++ b/vignettes/extreme_indices.Rmd @@ -216,7 +216,7 @@ Now, the standard deviation is computed in order to standardize the index. Notic ```r base_sd <- Apply(list(base_index$result), target_dims = list(c(1)), - AtomicFun = "sd")$output1 + fun = "sd")$output1 ``` @@ -302,9 +302,9 @@ To compute the Extreme Drought Index during the reference period and its standar base_index <- Climdex(data = ppt_historical, metric = 'cdd', ncores = detectCores() - 1) base_mean <- Apply(list(base_index$result), target_dims = list(c(1)), - AtomicFun = "mean")$output1 + fun = "mean")$output1 base_sd <- Apply(list(base_index$result), target_dims = list(c(1)), - AtomicFun = "sd")$output1 + fun = "sd")$output1 ``` @@ -381,9 +381,9 @@ The Extreme Flooding Index during the reference period and its standard deviatio base_index <- Climdex(data = ppt_historical, metric = 'rx5day', ncores = detectCores() - 1) base_mean <- Apply(list(base_index$result), target_dims = list(c(1)), - AtomicFun = "mean")$output1 + fun = "mean")$output1 base_sd <- Apply(list(base_index$result), target_dims = list(c(1)), - AtomicFun = "sd")$output1 + fun = "sd")$output1 ``` The Extreme Flooding Index is computed and standardized: -- GitLab From 490c4be1e04614d2b58062a62d6e46657a5cfa16 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Mon, 19 Nov 2018 18:10:02 +0100 Subject: [PATCH 2/3] Updated dependency. --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 90932ce..806a17e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,7 +10,7 @@ Authors@R: c( Description: Set of tools to compute metrics and indices for climate analysis. The package provides functions to compute extreme indices, evaluate the agreement between models and combine theses models into an ensemble. Multi-model time series of climate indices can be computed either after averaging the 2-D fields from different models provided they share a common grid or by combining time series computed on the model native grid. Indices can be assigned weights and/or combined to construct new indices. Depends: R (>= 3.2.0) Imports: - multiApply, + multiApply (>= 2.0.0), climdex.pcic, PCICt, plyr, -- GitLab From 59d3127512f7dad3d5d27fecf920b801b9413607 Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 22 Nov 2018 11:28:05 +0100 Subject: [PATCH 3/3] Correction in the text: One sentence removed --- vignettes/extreme_indices.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/extreme_indices.Rmd b/vignettes/extreme_indices.Rmd index b0c33ee..57eb34f 100644 --- a/vignettes/extreme_indices.Rmd +++ b/vignettes/extreme_indices.Rmd @@ -11,7 +11,7 @@ Extreme Indices ======================== -The extreme indices are an ensemble of indices based on the Expert Team on Climate Change Detection Indices (ETCCDI). There are currently 5 available indices to be computed: extreme heat (tx90p), extreme cold (tn10p), extreme wind (wx), drought (ccd) and flooding (rx5day). The individual indices can be combined into a single index with or without weighting for each component. This combined index is roughly analogous to the Actuaries Climate Risk Index (see http://actuariesclimateindex.org/home/). +The extreme indices are an ensemble of indices based on the Expert Team on Climate Change Detection Indices (ETCCDI). There are currently 5 available indices to be computed: extreme heat (tx90p), extreme cold (tn10p), extreme wind (wx), drought (ccd) and flooding (rx5day). The individual indices can be combined into a single index with or without weighting for each component. ### 1- Load dependencies -- GitLab