From 836da7683231ba07c1185905ad03b9006aa785cd Mon Sep 17 00:00:00 2001 From: Deborah Verfaillie Date: Fri, 21 Feb 2020 14:25:41 +0100 Subject: [PATCH 01/13] Including new Persistence function --- R/Persistence.R | 193 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 193 insertions(+) create mode 100644 R/Persistence.R diff --git a/R/Persistence.R b/R/Persistence.R new file mode 100644 index 0000000..9e49732 --- /dev/null +++ b/R/Persistence.R @@ -0,0 +1,193 @@ +#'Compute persistence +#' +#'Compute a persistence forecast based on a lagged autoregression of +#'observational data along the time dimension, with a measure of forecast +#'uncertainty (prediction interval) based on Coelho et al., 2004.\cr\cr +#' +#'@param data A numeric array corresponding to the observational data +#' including the time dimension along which the autoregression is computed. The data +#' should start at least 30 years before 'sdate_beg'. +#'@param time_dim A character string indicating the dimension along which to +#' compute the autoregression. The default value is 'time'. +#'@param sdate_beg A 4-digit integer indicating the first start date of the persistence +#' forecast. +#'@param sdate_end A 4-digit integer indicating the last start date of the persistence +#' forecast. +#'@param fyr_beg An integer indicating the forecast year for which +#' the persistence forecast should be calculated, or the first forecast +#' year of the average forecast years for which persistence should be +#' calculated. +#'@param fyr_end An (optional) integer indicating the last forecast year +#' of the average forecast years for which persistence should be calculated +#' in the case of a multiyear average persistence. The default value is 'fyr_beg'. +#'@param memb An integer indicating the number of ensemble members to +#' generate for the persistence forecast. The default value is 1. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' +#'@return +#'A list containing: +#'\item{$persistence}{ +#' A numeric array with dimensions 'memb', start dates, latitudes and longitudes +#' containing the persistence forecast. +#'} +#'\item{$persistence.mean}{ +#' A numeric array with same dimensions as 'persistence', except the 'memb' dimension +#' which is of length 1, containing the ensemble mean persistence forecast. +#'} +#'\item{$persistence.predint}{ +#' A numeric array with same dimensions as 'persistence', except the 'memb' dimension +#' which is of length 1, containing the prediction interval of the persistence forecast. +#'} +#'\item{$AR.slope}{ +#' A numeric array with same dimensions as 'persistence', except the 'memb' dimension +#' which is of length 1, containing the slope coefficient of the autoregression. +#'} +#'\item{$AR.intercept}{ +#' A numeric array with same dimensions as 'persistence', except the 'memb' dimension +#' which is of length 1, containing the intercept coefficient of the autoregression. +#'} +#'\item{$AR.lowCI}{ +#' A numeric array with same dimensions as 'persistence', except the 'memb' dimension +#' which is of length 1, containing the lower value of the confidence interval of the +#' autoregression. +#'} +#'\item{$AR.highCI}{ +#' A numeric array with same dimensions as 'persistence', except the 'memb' dimension +#' which is of length 1, containing the upper value of the confidence interval of the +#' autoregression. +#'} +#' +#'@examples +#'# Load sample data as in Load() example: +#'example(Load) +#'months_between_startdates <- 60 +#'persist <- Persistence(sampleData$obs, sdate_beg = 1961, sdate_end = 2005, fyr_beg = 1, memb = 40) +#' +#'@rdname Persistence +#'@import multiApply +#'@export +Persistence <- function(data, time_dim = 'time', sdate_beg, sdate_end, fyr_beg, + fyr_end = fyr_beg, memb = 1, ncores = NULL) { + + # Check inputs + ## data + if (is.null(data)) { + stop("Parameter 'data' cannot be NULL.") + } + if (!is.numeric(data)) { + stop("Parameter 'data' must be a numeric array.") + } + if (is.null(dim(data))) { #is vector + dim(data) <- c(length(data)) + names(dim(data)) <- time_dim + } + if(any(is.null(names(dim(data))))| any(nchar(names(dim(data))) == 0)) { + stop("Parameter 'data' must have dimension names.") + } + ## time_dim + if (!is.character(time_dim) | length(time_dim) > 1) { + stop("Parameter 'time_dim' must be a character string.") + } + if (!time_dim %in% names(dim(data))) { + stop("Parameter 'time_dim' is not found in 'data' dimension.") + } + ## sdate_beg + if (!is.numeric(sdate_beg) | sdate_beg %% 1 != 0 | sdate_beg < 0 | + length(sdate_beg) > 1) | sdate_beg < 1850 | sdate_beg > 2020 { + stop("Parameter 'sdate_beg' must be an integer between 1850 and 2020.") + } + ## sdate_end + if (!is.numeric(sdate_end) | sdate_end %% 1 != 0 | sdate_end < 0 | + length(sdate_end) > 1) | sdate_end < 1850 | sdate_end > 2020 { + stop("Parameter 'sdate_end' must be an integer between 1850 and 2020.") + } + ## fyr_beg + if (!is.numeric(fyr_beg) | fyr_beg %% 1 != 0 | fyr_beg < 0 | + length(fyr_beg) > 1) { + stop("Parameter 'fyr_beg' must be a positive integer.") + } + ## fyr_end + if (!is.numeric(fyr_end) | fyr_end %% 1 != 0 | fyr_end < 0 | + length(fyr_end) > 1) | fyr_end > 10 { + stop("Parameter 'fyr_end' must be a positive integer below 10.") + } + ## memb + if (!is.numeric(memb) | memb %% 1 != 0 | memb < 0 | + length(memb) > 1) { + stop("Parameter 'memb' must be a positive integer.") + } + ## ncores + if (!is.null(ncores)) { + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | + length(ncores) > 1) { + stop("Parameter 'ncores' must be a positive integer.") + } + } + + ############################### + # Calculate Trend + dim_names <- names(dim(data)) + + if (conf) { + output_dims <- list(trend = 'stats', conf.lower = 'stats', + conf.upper = 'stats', detrended = time_dim) + } else if (!conf) { + output_dims <- list(trend = 'stats', detrended = time_dim) + } + + + output <- Apply(list(data), + target_dims = time_dim, + fun = .Trend, + output_dims = output_dims, + time_dim = time_dim, interval = interval, + polydeg = polydeg, conf = conf, + conf.lev = conf.lev, + ncores = ncores) + + #output <- lapply(output, .reorder, time_dim = time_dim, dim_names = dim_names) + + return(output) +} + +.Trend <- function(x, time_dim = 'sdate', interval = 1, polydeg = 1, + conf = TRUE, conf.lev = 0.95) { + + mon <- seq(x) * interval + + # remove NAs for potential poly() + NApos <- 1:length(x) + NApos[which(is.na(x))] <- NA + x2 <- x[!is.na(NApos)] + mon2 <- mon[!is.na(NApos)] + + if (length(x2) > 0) { +# lm.out <- lm(x ~ mon, na.action = na.omit) + lm.out <- lm(x2 ~ poly(mon2, degree = polydeg, raw = TRUE), na.action = na.omit) + trend <- lm.out$coefficients #intercept, slope1, slope2,... + + if (conf) { + conf.lower <- confint(lm.out, level = conf.lev)[, 1] + conf.upper <- confint(lm.out, level = conf.lev)[, 2] + } + + detrended <- c() + detrended[is.na(x) == FALSE] <- x[is.na(x) == FALSE] - lm.out$fitted.values + } else { + trend <- rep(NA, polydeg + 1) + detrend <- NA + if (conf) { + conf.lower <- rep(NA, polydeg + 1) + conf.upper <- rep(NA, polydeg + 1) + } + } + + if (conf) { + return(list(trend = trend, conf.lower = conf.lower, conf.upper = conf.upper, + detrended = detrended)) + } else { + return(list(trend = trend, detrended = detrended)) + } + +} -- GitLab From dde91f7c99f70e7a34ae3484dc74de600b3ec9ea Mon Sep 17 00:00:00 2001 From: Deborah Verfaillie Date: Mon, 24 Feb 2020 18:26:16 +0100 Subject: [PATCH 02/13] New modifications to Persistence function --- R/Persistence.R | 170 +++++++++++++++++++++++++++++++++--------------- 1 file changed, 117 insertions(+), 53 deletions(-) diff --git a/R/Persistence.R b/R/Persistence.R index 9e49732..d286cfd 100644 --- a/R/Persistence.R +++ b/R/Persistence.R @@ -6,9 +6,9 @@ #' #'@param data A numeric array corresponding to the observational data #' including the time dimension along which the autoregression is computed. The data -#' should start at least 30 years before 'sdate_beg'. +#' should start at least 40 years before 'sdate_beg'. #'@param time_dim A character string indicating the dimension along which to -#' compute the autoregression. The default value is 'time'. +#' compute the autoregression. The default value is 'sdate'. #'@param sdate_beg A 4-digit integer indicating the first start date of the persistence #' forecast. #'@param sdate_end A 4-digit integer indicating the last start date of the persistence @@ -22,6 +22,10 @@ #' in the case of a multiyear average persistence. The default value is 'fyr_beg'. #'@param memb An integer indicating the number of ensemble members to #' generate for the persistence forecast. The default value is 1. +#'@param na.action A function or an integer. A function (e.g., na.omit, +#' na.exclude, na.fail, na.pass) indicates what should happen when the data +#' contain NAs. A numeric indicates the maximum number of NA position allowed to +#' compute regression. The default value is 10. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -59,16 +63,20 @@ #'} #' #'@examples -#'# Load sample data as in Load() example: -#'example(Load) -#'months_between_startdates <- 60 -#'persist <- Persistence(sampleData$obs, sdate_beg = 1961, sdate_end = 2005, fyr_beg = 1, memb = 40) +#'#Building an example dataset with yearly start dates from 1930 to 2009 +#'obs1 <- 1 : (1 * 1 * 80 * 5 * 6 * 7) +#'dim(obs1) <- c(dataset = 1, member = 1, sdate = 90, ftime = 5, lat = 6, lon = 7) +#'sdates <- seq(1920,2005,1) +#'lon <- seq(0, 30, 5) +#'lat <- seq(0, 25, 5) +#'obs <- list(data = obs1, sdates = sdates, lat = lat, lon = lon) +#'persist <- Persistence(obs, sdate_beg = 1961, sdate_end = 2005, fyr_beg = 1, memb = 40) #' #'@rdname Persistence #'@import multiApply #'@export -Persistence <- function(data, time_dim = 'time', sdate_beg, sdate_end, fyr_beg, - fyr_end = fyr_beg, memb = 1, ncores = NULL) { +Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, + fyr_end = fyr_beg, memb = 1, na.action = 10, ncores = NULL) { # Check inputs ## data @@ -96,11 +104,19 @@ Persistence <- function(data, time_dim = 'time', sdate_beg, sdate_end, fyr_beg, if (!is.numeric(sdate_beg) | sdate_beg %% 1 != 0 | sdate_beg < 0 | length(sdate_beg) > 1) | sdate_beg < 1850 | sdate_beg > 2020 { stop("Parameter 'sdate_beg' must be an integer between 1850 and 2020.") - } + } + if (sdate_beg < sdates[1]+40 { + stop("Parameter 'sdate_beg' must start at least 40 years after the + first start date of 'data'.") + } ## sdate_end if (!is.numeric(sdate_end) | sdate_end %% 1 != 0 | sdate_end < 0 | length(sdate_end) > 1) | sdate_end < 1850 | sdate_end > 2020 { stop("Parameter 'sdate_end' must be an integer between 1850 and 2020.") + } + if (sdate_end > sdates[length(sdates)]+1 { + stop("Parameter 'sdate_end' must end at most 1 year after the + last start date of 'data'.") } ## fyr_beg if (!is.numeric(fyr_beg) | fyr_beg %% 1 != 0 | fyr_beg < 0 | @@ -117,6 +133,19 @@ Persistence <- function(data, time_dim = 'time', sdate_beg, sdate_end, fyr_beg, length(memb) > 1) { stop("Parameter 'memb' must be a positive integer.") } + ## na.action + if (!is.function(na.action) & !is.numeric(na.action)) { + stop(paste0("Parameter 'na.action' must be a function for NA values or ", + "a numeric indicating the number of NA values allowed ", + "before returning NA.")) + } + if (is.numeric(na.action)) { + if (any(na.action %% 1 != 0) | any(na.action < 0) | length(na.action) > 1) { + stop(paste0("Parameter 'na.action' must be a function for NA values or ", + "a numeric indicating the number of NA values allowed ", + "before returning NA.")) + } + } ## ncores if (!is.null(ncores)) { if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | @@ -126,68 +155,103 @@ Persistence <- function(data, time_dim = 'time', sdate_beg, sdate_end, fyr_beg, } ############################### - # Calculate Trend + # Calculate Persistence dim_names <- names(dim(data)) - if (conf) { - output_dims <- list(trend = 'stats', conf.lower = 'stats', - conf.upper = 'stats', detrended = time_dim) - } else if (!conf) { - output_dims <- list(trend = 'stats', detrended = time_dim) - } - output <- Apply(list(data), target_dims = time_dim, - fun = .Trend, + fun = .Persistence, output_dims = output_dims, - time_dim = time_dim, interval = interval, - polydeg = polydeg, conf = conf, - conf.lev = conf.lev, + time_dim = time_dim, + sdate_beg = sdate_beg, + sdate_end = sdate_end, + fyr_beg = fyr_beg, + fyr_end = fyr_end, + memb = memb, + na.action = na.action, ncores = ncores) - #output <- lapply(output, .reorder, time_dim = time_dim, dim_names = dim_names) - return(output) } -.Trend <- function(x, time_dim = 'sdate', interval = 1, polydeg = 1, - conf = TRUE, conf.lev = 0.95) { +.Persistence <- function(x, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, + fyr_end = fyr_beg, memb = 1, na.action = 10) { - mon <- seq(x) * interval + tm <- sdate_end - sdate_beg + 1 + latl <- length(x$lat) + lonn <- length(x$lon) + max_date <- match(sdate_beg,sdates) + interval <- fyr_end - fyr_beg + persistence <- array(NA,dim=c(memb,tm,latl,lonn)) + persistence.mean <- array(NA,dim=c(tm,latl,lonn)) + persistence.predint <- array(NA,dim=c(tm,latl,lonn)) + AR.slope <- array(NA,dim=c(tm,latl,lonn)) + AR.intercept <- array(NA,dim=c(tm,latl,lonn)) + AR.lowCI <- array(NA,dim=c(tm,latl,lonn)) + AR.highCI <- array(NA,dim=c(tm,latl,lonn)) - # remove NAs for potential poly() - NApos <- 1:length(x) - NApos[which(is.na(x))] <- NA - x2 <- x[!is.na(NApos)] - mon2 <- mon[!is.na(NApos)] - if (length(x2) > 0) { -# lm.out <- lm(x ~ mon, na.action = na.omit) - lm.out <- lm(x2 ~ poly(mon2, degree = polydeg, raw = TRUE), na.action = na.omit) - trend <- lm.out$coefficients #intercept, slope1, slope2,... + for (sdate in tm:1){ + min_y = 10 + fyr_beg + max_y = max_date + sdate - 2 + min_x = 10 # for extreme case: forecast years 1-10, interval = 9 + max_x = max_date + sdate - 2 -fyr_beg - if (conf) { - conf.lower <- confint(lm.out, level = conf.lev)[, 1] - conf.upper <- confint(lm.out, level = conf.lev)[, 2] - } + regdates = max_y - min_y + 1 - detrended <- c() - detrended[is.na(x) == FALSE] <- x[is.na(x) == FALSE] - lm.out$fitted.values - } else { - trend <- rep(NA, polydeg + 1) - detrend <- NA - if (conf) { - conf.lower <- rep(NA, polydeg + 1) - conf.upper <- rep(NA, polydeg + 1) - } + for (longi in 1:lonn){ # Global + for (lati in 1:latl){ # Global + for (val_x in min_x:max_x){ + tmp_x <- mean(x[(val_x-interval):val_x,lati,longi]) + if (val_x == min_x){ + obs_x <- tmp_x + }else{ + obs_x <- abind(obs_x,tmp_x,along=1) + } + } + + for (val_y in min_y:max_y){ + tmp_y <- mean(trace_ano_obs_long[val_y:(val_y+interval),lati,longi]) + if (val_y == min_y){ + obs_y <- tmp_y + }else{ + obs_y <- abind(obs_y,tmp_y,along=1) + } + } + + y_axis <- obs_y + x_axis <- obs_x + dim(y_axis) <- c(time = regdates) + dim(x_axis) <- c(time = regdates) + reg <- Regression(y_axis, x_axis, posREG = 'time', na.action = na.action) + len <- length(obs_x) + a <- reg$regression[2] # slope + b <- reg$regression[4] # intercept + CI <- abs(reg$regression[3] - reg$regression[1]) # confidence interval + stdev_reg <- CI / 1.96 + n <- max_x + X_sq <- (obs_x[len] - mean(obs_x))**2 + S_sq <- sum((obs_x[1:len] - mean(obs_x))**2) + + + + persistence.mean[sdate,lati,longi] <- a * mean(x[(max_y-interval):max_y,lati,longi]) + b + persistence.predint[sdate,lati,longi] <- stdev_reg * sqrt(1 + 1/n + X_sq/S_sq) + AR.slope[sdate,lati,longi] <- a + AR.intercept[sdate,lati,longi] <- b + AR.lowCI[sdate,lati,longi] <- reg$regression[1] + AR.highCI[sdate,lati,longi] <- reg$regression[3] + persistence[,sdate,lati,longi] <- rnorm(n=memb,mean=persistence.mean[sdate,lati,longi],sd=persistence.predint[sdate,lati,longi]) + + } } - if (conf) { - return(list(trend = trend, conf.lower = conf.lower, conf.upper = conf.upper, - detrended = detrended)) - } else { - return(list(trend = trend, detrended = detrended)) } + + + return(list(trend = trend, detrended = detrended)) + + } -- GitLab From 7eab60837839d1e128a727119100745f0f360ef4 Mon Sep 17 00:00:00 2001 From: Deborah Verfaillie Date: Thu, 27 Feb 2020 18:09:08 +0100 Subject: [PATCH 03/13] New developments of Persistence --- R/Persistence.R | 46 +++++++++++++++++++++++++++------------------- 1 file changed, 27 insertions(+), 19 deletions(-) diff --git a/R/Persistence.R b/R/Persistence.R index d286cfd..ae5fe9c 100644 --- a/R/Persistence.R +++ b/R/Persistence.R @@ -20,6 +20,8 @@ #'@param fyr_end An (optional) integer indicating the last forecast year #' of the average forecast years for which persistence should be calculated #' in the case of a multiyear average persistence. The default value is 'fyr_beg'. +#'@param dates A sequence of 4-digit integers indicating the dates available +#' in the observations. #'@param memb An integer indicating the number of ensemble members to #' generate for the persistence forecast. The default value is 1. #'@param na.action A function or an integer. A function (e.g., na.omit, @@ -63,20 +65,22 @@ #'} #' #'@examples -#'#Building an example dataset with yearly start dates from 1930 to 2009 -#'obs1 <- 1 : (1 * 1 * 80 * 5 * 6 * 7) -#'dim(obs1) <- c(dataset = 1, member = 1, sdate = 90, ftime = 5, lat = 6, lon = 7) -#'sdates <- seq(1920,2005,1) +#'#Building an example dataset with yearly start dates from 1920 to 2009 +#'obs1 <- 1 : (1 * 1 * 90 * 6 * 7) +#'dim(obs1) <- c(dataset = 1, member = 1, sdate = 90, lat = 6, lon = 7) +#'dates <- seq(1920,2009,1) #'lon <- seq(0, 30, 5) #'lat <- seq(0, 25, 5) -#'obs <- list(data = obs1, sdates = sdates, lat = lat, lon = lon) -#'persist <- Persistence(obs, sdate_beg = 1961, sdate_end = 2005, fyr_beg = 1, memb = 40) +#'obs <- list(data = obs1, dates = dates, lat = lat, lon = lon) +#'persist <- Persistence(obs, sdate_beg = 1961, sdate_end = 2005, fyr_beg = 1, +#' dates = dates, memb = 40) #' #'@rdname Persistence #'@import multiApply +#'@import abind #'@export Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, - fyr_end = fyr_beg, memb = 1, na.action = 10, ncores = NULL) { + fyr_end = fyr_beg, dates, memb = 1, na.action = 10, ncores = NULL) { # Check inputs ## data @@ -127,6 +131,10 @@ Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, if (!is.numeric(fyr_end) | fyr_end %% 1 != 0 | fyr_end < 0 | length(fyr_end) > 1) | fyr_end > 10 { stop("Parameter 'fyr_end' must be a positive integer below 10.") + } + ## dates + if (length(dates) != length(data[[2]])) { + stop("Parameter 'dates' must have the same length as in 'time_dim'.") } ## memb if (!is.numeric(memb) | memb %% 1 != 0 | memb < 0 | @@ -168,6 +176,7 @@ Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, sdate_end = sdate_end, fyr_beg = fyr_beg, fyr_end = fyr_end, + dates = dates, memb = memb, na.action = na.action, ncores = ncores) @@ -176,12 +185,12 @@ Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, } .Persistence <- function(x, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, - fyr_end = fyr_beg, memb = 1, na.action = 10) { + fyr_end = fyr_beg, dates = dates, memb = 1, na.action = 10) { tm <- sdate_end - sdate_beg + 1 latl <- length(x$lat) lonn <- length(x$lon) - max_date <- match(sdate_beg,sdates) + max_date <- match(sdate_beg,dates) interval <- fyr_end - fyr_beg persistence <- array(NA,dim=c(memb,tm,latl,lonn)) persistence.mean <- array(NA,dim=c(tm,latl,lonn)) @@ -203,7 +212,7 @@ Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, for (longi in 1:lonn){ # Global for (lati in 1:latl){ # Global for (val_x in min_x:max_x){ - tmp_x <- mean(x[(val_x-interval):val_x,lati,longi]) + tmp_x <- mean(x$data[,,(val_x-interval):val_x,lati,longi]) if (val_x == min_x){ obs_x <- tmp_x }else{ @@ -212,7 +221,7 @@ Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, } for (val_y in min_y:max_y){ - tmp_y <- mean(trace_ano_obs_long[val_y:(val_y+interval),lati,longi]) + tmp_y <- mean(x$data[,,val_y:(val_y+interval),lati,longi]) if (val_y == min_y){ obs_y <- tmp_y }else{ @@ -234,24 +243,23 @@ Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, X_sq <- (obs_x[len] - mean(obs_x))**2 S_sq <- sum((obs_x[1:len] - mean(obs_x))**2) - - - persistence.mean[sdate,lati,longi] <- a * mean(x[(max_y-interval):max_y,lati,longi]) + b + persistence.mean[sdate,lati,longi] <- a * mean(x$data[,,(max_y-interval):max_y,lati,longi]) + b persistence.predint[sdate,lati,longi] <- stdev_reg * sqrt(1 + 1/n + X_sq/S_sq) AR.slope[sdate,lati,longi] <- a AR.intercept[sdate,lati,longi] <- b AR.lowCI[sdate,lati,longi] <- reg$regression[1] AR.highCI[sdate,lati,longi] <- reg$regression[3] - persistence[,sdate,lati,longi] <- rnorm(n=memb,mean=persistence.mean[sdate,lati,longi],sd=persistence.predint[sdate,lati,longi]) + persistence[,sdate,lati,longi] <- rnorm(n=memb,mean=persistence.mean[sdate,lati,longi], + sd=persistence.predint[sdate,lati,longi]) } } } - - - return(list(trend = trend, detrended = detrended)) - + return(list(persistence = persistence, persistence.mean = persistence.mean, + persistence.predint = persistence.predint, AR.slope = AR.slope, + AR.intercept = AR.intercept, AR.lowCI = AR.lowCI, + AR.highCI = AR.highCI)) } -- GitLab From a94af895dd51bc5f94fbfd01f5c4d195573ce77b Mon Sep 17 00:00:00 2001 From: nperez Date: Mon, 2 Mar 2020 15:31:01 +0100 Subject: [PATCH 04/13] automatic documentation with devtools for Persistence --- NAMESPACE | 2 + R/Persistence.R | 10 ++--- man/Persistence.Rd | 97 ++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 104 insertions(+), 5 deletions(-) create mode 100644 man/Persistence.Rd diff --git a/NAMESPACE b/NAMESPACE index 627bf51..ca33898 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ export(InsertDim) export(LeapYear) export(Load) export(MeanDims) +export(Persistence) export(PlotClim) export(PlotEquiMap) export(PlotLayout) @@ -37,6 +38,7 @@ export(Trend) export(clim.colors) export(clim.palette) import(GEOmap) +import(abind) import(bigmemory) import(geomapdata) import(graphics) diff --git a/R/Persistence.R b/R/Persistence.R index ae5fe9c..bdf47b2 100644 --- a/R/Persistence.R +++ b/R/Persistence.R @@ -106,19 +106,19 @@ Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, } ## sdate_beg if (!is.numeric(sdate_beg) | sdate_beg %% 1 != 0 | sdate_beg < 0 | - length(sdate_beg) > 1) | sdate_beg < 1850 | sdate_beg > 2020 { + length(sdate_beg) > 1 | sdate_beg < 1850 | sdate_beg > 2020) { stop("Parameter 'sdate_beg' must be an integer between 1850 and 2020.") } - if (sdate_beg < sdates[1]+40 { + if (sdate_beg < sdates[1] + 40) { stop("Parameter 'sdate_beg' must start at least 40 years after the first start date of 'data'.") } ## sdate_end if (!is.numeric(sdate_end) | sdate_end %% 1 != 0 | sdate_end < 0 | - length(sdate_end) > 1) | sdate_end < 1850 | sdate_end > 2020 { + length(sdate_end) > 1 | sdate_end < 1850 | sdate_end > 2020) { stop("Parameter 'sdate_end' must be an integer between 1850 and 2020.") } - if (sdate_end > sdates[length(sdates)]+1 { + if (sdate_end > sdates[length(sdates)] + 1) { stop("Parameter 'sdate_end' must end at most 1 year after the last start date of 'data'.") } @@ -129,7 +129,7 @@ Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, } ## fyr_end if (!is.numeric(fyr_end) | fyr_end %% 1 != 0 | fyr_end < 0 | - length(fyr_end) > 1) | fyr_end > 10 { + length(fyr_end) > 1 | fyr_end > 10) { stop("Parameter 'fyr_end' must be a positive integer below 10.") } ## dates diff --git a/man/Persistence.Rd b/man/Persistence.Rd new file mode 100644 index 0000000..b3a083a --- /dev/null +++ b/man/Persistence.Rd @@ -0,0 +1,97 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Persistence.R +\name{Persistence} +\alias{Persistence} +\title{Compute persistence} +\usage{ +Persistence(data, time_dim = "sdate", sdate_beg, sdate_end, fyr_beg, + fyr_end = fyr_beg, dates, memb = 1, na.action = 10, ncores = NULL) +} +\arguments{ +\item{data}{A numeric array corresponding to the observational data +including the time dimension along which the autoregression is computed. The data +should start at least 40 years before 'sdate_beg'.} + +\item{time_dim}{A character string indicating the dimension along which to +compute the autoregression. The default value is 'sdate'.} + +\item{sdate_beg}{A 4-digit integer indicating the first start date of the persistence +forecast.} + +\item{sdate_end}{A 4-digit integer indicating the last start date of the persistence +forecast.} + +\item{fyr_beg}{An integer indicating the forecast year for which +the persistence forecast should be calculated, or the first forecast +year of the average forecast years for which persistence should be +calculated.} + +\item{fyr_end}{An (optional) integer indicating the last forecast year +of the average forecast years for which persistence should be calculated +in the case of a multiyear average persistence. The default value is 'fyr_beg'.} + +\item{dates}{A sequence of 4-digit integers indicating the dates available +in the observations.} + +\item{memb}{An integer indicating the number of ensemble members to +generate for the persistence forecast. The default value is 1.} + +\item{na.action}{A function or an integer. A function (e.g., na.omit, +na.exclude, na.fail, na.pass) indicates what should happen when the data +contain NAs. A numeric indicates the maximum number of NA position allowed to +compute regression. The default value is 10.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A list containing: +\item{$persistence}{ + A numeric array with dimensions 'memb', start dates, latitudes and longitudes + containing the persistence forecast. +} +\item{$persistence.mean}{ + A numeric array with same dimensions as 'persistence', except the 'memb' dimension + which is of length 1, containing the ensemble mean persistence forecast. +} +\item{$persistence.predint}{ + A numeric array with same dimensions as 'persistence', except the 'memb' dimension + which is of length 1, containing the prediction interval of the persistence forecast. +} +\item{$AR.slope}{ + A numeric array with same dimensions as 'persistence', except the 'memb' dimension + which is of length 1, containing the slope coefficient of the autoregression. +} +\item{$AR.intercept}{ + A numeric array with same dimensions as 'persistence', except the 'memb' dimension + which is of length 1, containing the intercept coefficient of the autoregression. +} +\item{$AR.lowCI}{ + A numeric array with same dimensions as 'persistence', except the 'memb' dimension + which is of length 1, containing the lower value of the confidence interval of the + autoregression. +} +\item{$AR.highCI}{ + A numeric array with same dimensions as 'persistence', except the 'memb' dimension + which is of length 1, containing the upper value of the confidence interval of the + autoregression. +} +} +\description{ +Compute a persistence forecast based on a lagged autoregression of +observational data along the time dimension, with a measure of forecast +uncertainty (prediction interval) based on Coelho et al., 2004.\cr\cr +} +\examples{ +#Building an example dataset with yearly start dates from 1920 to 2009 +obs1 <- 1 : (1 * 1 * 90 * 6 * 7) +dim(obs1) <- c(dataset = 1, member = 1, sdate = 90, lat = 6, lon = 7) +dates <- seq(1920,2009,1) +lon <- seq(0, 30, 5) +lat <- seq(0, 25, 5) +obs <- list(data = obs1, dates = dates, lat = lat, lon = lon) +persist <- Persistence(obs, sdate_beg = 1961, sdate_end = 2005, fyr_beg = 1, + dates = dates, memb = 40) + +} + -- GitLab From b015e9cf66f2ee15453ae13148c00412885efb56 Mon Sep 17 00:00:00 2001 From: nperez Date: Mon, 2 Mar 2020 16:21:33 +0100 Subject: [PATCH 05/13] .Persistence working on 1D object using Regression from s2dv package --- R/Persistence.R | 123 +++++++++++++++++++++--------------------------- 1 file changed, 54 insertions(+), 69 deletions(-) diff --git a/R/Persistence.R b/R/Persistence.R index bdf47b2..686e338 100644 --- a/R/Persistence.R +++ b/R/Persistence.R @@ -183,78 +183,63 @@ Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, return(output) } - -.Persistence <- function(x, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, - fyr_end = fyr_beg, dates = dates, memb = 1, na.action = 10) { - - tm <- sdate_end - sdate_beg + 1 - latl <- length(x$lat) - lonn <- length(x$lon) - max_date <- match(sdate_beg,dates) - interval <- fyr_end - fyr_beg - persistence <- array(NA,dim=c(memb,tm,latl,lonn)) - persistence.mean <- array(NA,dim=c(tm,latl,lonn)) - persistence.predint <- array(NA,dim=c(tm,latl,lonn)) - AR.slope <- array(NA,dim=c(tm,latl,lonn)) - AR.intercept <- array(NA,dim=c(tm,latl,lonn)) - AR.lowCI <- array(NA,dim=c(tm,latl,lonn)) - AR.highCI <- array(NA,dim=c(tm,latl,lonn)) - +# x could be a vector timeseries +# start/end is a year (numeric) .. could be a date? +# fyr_start/fyr_end are indices +.Persistence <- function(x, dates, time_dim = 'sdate', start, end, fyr_start = 1, + fyr_end = 1, memb = 1, na.action = 10) { + + tm <- end - start + 1 + max_date <- match(start, dates) + interval <- fyr_end - fyr_start + persistence.mean <- persistence.predint <- NULL + AR.slope <- AR.intercept <- AR.lowCI <- AR.highCI <- NULL + persistence <- matrix(NA, nrow = memb, ncol = tm) + names(dim(persistence)) <- c('realization', time_dim) for (sdate in tm:1){ - min_y = 10 + fyr_beg - max_y = max_date + sdate - 2 - min_x = 10 # for extreme case: forecast years 1-10, interval = 9 - max_x = max_date + sdate - 2 -fyr_beg - - regdates = max_y - min_y + 1 - - for (longi in 1:lonn){ # Global - for (lati in 1:latl){ # Global - for (val_x in min_x:max_x){ - tmp_x <- mean(x$data[,,(val_x-interval):val_x,lati,longi]) - if (val_x == min_x){ - obs_x <- tmp_x - }else{ - obs_x <- abind(obs_x,tmp_x,along=1) - } - } - - for (val_y in min_y:max_y){ - tmp_y <- mean(x$data[,,val_y:(val_y+interval),lati,longi]) - if (val_y == min_y){ - obs_y <- tmp_y - }else{ - obs_y <- abind(obs_y,tmp_y,along=1) - } - } - - y_axis <- obs_y - x_axis <- obs_x - dim(y_axis) <- c(time = regdates) - dim(x_axis) <- c(time = regdates) - reg <- Regression(y_axis, x_axis, posREG = 'time', na.action = na.action) - len <- length(obs_x) - a <- reg$regression[2] # slope - b <- reg$regression[4] # intercept - CI <- abs(reg$regression[3] - reg$regression[1]) # confidence interval - stdev_reg <- CI / 1.96 - n <- max_x - X_sq <- (obs_x[len] - mean(obs_x))**2 - S_sq <- sum((obs_x[1:len] - mean(obs_x))**2) - - persistence.mean[sdate,lati,longi] <- a * mean(x$data[,,(max_y-interval):max_y,lati,longi]) + b - persistence.predint[sdate,lati,longi] <- stdev_reg * sqrt(1 + 1/n + X_sq/S_sq) - AR.slope[sdate,lati,longi] <- a - AR.intercept[sdate,lati,longi] <- b - AR.lowCI[sdate,lati,longi] <- reg$regression[1] - AR.highCI[sdate,lati,longi] <- reg$regression[3] - persistence[,sdate,lati,longi] <- rnorm(n=memb,mean=persistence.mean[sdate,lati,longi], - sd=persistence.predint[sdate,lati,longi]) - - } - } + min_y = 10 + fyr_start + max_y = max_date + sdate - 2 + min_x = 10 # for extreme case: forecast years 1-10, interval = 9 + max_x = max_date + sdate - 2 - fyr_start + + regdates = max_y - min_y + 1 + + for (val_x in min_x:max_x) { + tmp_x <- mean(x[(val_x - interval):val_x]) + if (val_x == min_x){ + obs_x <- tmp_x + } else { + obs_x <- c(obs_x, tmp_x) + } + } + for (val_y in min_y:max_y) { + tmp_y <- mean(x[val_y:(val_y + interval)]) + if (val_y == min_y){ + obs_y <- tmp_y + } else { + obs_y <- c(obs_y, tmp_y) + } + } + reg <- .Regression(obs_y, obs_x, na.action = na.action) + len <- length(obs_x) + a <- reg$regression[2] # slope + b <- reg$regression[1] # intercept + CI <- abs(reg$conf.upper[2] - reg$conf.lower[2]) # confidence interval + stdev_reg <- CI / 1.96 + n <- max_x + X_sq <- (obs_x[len] - mean(obs_x)) ** 2 + S_sq <- sum((obs_x[1:len] - mean(obs_x)) ** 2) + + persistence.mean[sdate] <- a * mean(x[(max_y - interval):max_y]) + b + persistence.predint[sdate] <- stdev_reg * sqrt(1 + 1 / n + X_sq / S_sq) + AR.slope[sdate] <- a + AR.intercept[sdate] <- b + AR.lowCI[sdate] <- reg$regression[1] + AR.highCI[sdate] <- reg$regression[3] + persistence[ ,sdate] <- rnorm(n = memb, mean = persistence.mean[sdate], + sd = persistence.predint[sdate]) } return(list(persistence = persistence, persistence.mean = persistence.mean, -- GitLab From e9570b8adb753e9a646c8b6f8b47f32325763d12 Mon Sep 17 00:00:00 2001 From: Deborah Verfaillie Date: Tue, 24 Mar 2020 12:54:04 +0100 Subject: [PATCH 06/13] Improving the Persistence function --- R/Persistence.R | 138 ++++++++++++++++++++++++++---------------------- 1 file changed, 74 insertions(+), 64 deletions(-) diff --git a/R/Persistence.R b/R/Persistence.R index 686e338..f59a8c6 100644 --- a/R/Persistence.R +++ b/R/Persistence.R @@ -6,22 +6,25 @@ #' #'@param data A numeric array corresponding to the observational data #' including the time dimension along which the autoregression is computed. The data -#' should start at least 40 years before 'sdate_beg'. +#' should start at least 40 time steps (years or days) before 'start'. +#'@param dates A sequence of 4-digit integers (YYYY) or dates (YYYY-MM-DD) indicating +#' the dates available in the observations. #'@param time_dim A character string indicating the dimension along which to -#' compute the autoregression. The default value is 'sdate'. -#'@param sdate_beg A 4-digit integer indicating the first start date of the persistence -#' forecast. -#'@param sdate_end A 4-digit integer indicating the last start date of the persistence -#' forecast. -#'@param fyr_beg An integer indicating the forecast year for which +#' compute the autoregression. The default value is 'time'. +#'@param start A 4-digit integer (YYYY) or a date in the ISOdate format (YYYY-MM-DD) +#' indicating the first start date of the persistence forecast. +#'@param end A 4-digit integer (YYYY) or a date in the ISOdate format (YYYY-MM-DD) +#' indicating the last start date of the persistence forecast. +#'@param ft_start An integer indicating the forecast time for which #' the persistence forecast should be calculated, or the first forecast -#' year of the average forecast years for which persistence should be +#' time of the average forecast times for which persistence should be #' calculated. -#'@param fyr_end An (optional) integer indicating the last forecast year -#' of the average forecast years for which persistence should be calculated -#' in the case of a multiyear average persistence. The default value is 'fyr_beg'. -#'@param dates A sequence of 4-digit integers indicating the dates available -#' in the observations. +#'@param ft_end An (optional) integer indicating the last forecast time +#' of the average forecast times for which persistence should be calculated +#' in the case of a multi-timestep average persistence. The default value is 'ft_start'. +#'@param max_ft An integer indicating the maximum forecast time possible for 'data'. +#' For example, for decadal prediction 'max_ft' would correspond to 10 (years). The +#' default value is 10. #'@param memb An integer indicating the number of ensemble members to #' generate for the persistence forecast. The default value is 1. #'@param na.action A function or an integer. A function (e.g., na.omit, @@ -34,7 +37,7 @@ #'@return #'A list containing: #'\item{$persistence}{ -#' A numeric array with dimensions 'memb', start dates, latitudes and longitudes +#' A numeric array with dimensions 'memb', time (start dates), latitudes and longitudes #' containing the persistence forecast. #'} #'\item{$persistence.mean}{ @@ -66,21 +69,22 @@ #' #'@examples #'#Building an example dataset with yearly start dates from 1920 to 2009 -#'obs1 <- 1 : (1 * 1 * 90 * 6 * 7) -#'dim(obs1) <- c(dataset = 1, member = 1, sdate = 90, lat = 6, lon = 7) +#'obs1 <- 1 : (1 * 90 * 6 * 7) +#'dim(obs1) <- c(member = 1, time = 90, lat = 6, lon = 7) #'dates <- seq(1920,2009,1) #'lon <- seq(0, 30, 5) #'lat <- seq(0, 25, 5) -#'obs <- list(data = obs1, dates = dates, lat = lat, lon = lon) -#'persist <- Persistence(obs, sdate_beg = 1961, sdate_end = 2005, fyr_beg = 1, -#' dates = dates, memb = 40) +#'obs <- list(data = obs1, time = dates, lat = lat, lon = lon) +#'persist <- Persistence(obs$data, dates = dates, start = 1961, end = 2005, ft_start = 1, +#' memb = 40) #' #'@rdname Persistence #'@import multiApply #'@import abind #'@export -Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, - fyr_end = fyr_beg, dates, memb = 1, na.action = 10, ncores = NULL) { +Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, + ft_end = ft_start, max_ft = 10, memb = 1, na.action = 10, + ncores = NULL) { # Check inputs ## data @@ -97,6 +101,10 @@ Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, if(any(is.null(names(dim(data))))| any(nchar(names(dim(data))) == 0)) { stop("Parameter 'data' must have dimension names.") } + ## dates + if (length(dates) != dim(data)[time_dim]) { + stop("Parameter 'dates' must have the same length as in 'time_dim'.") + } ## time_dim if (!is.character(time_dim) | length(time_dim) > 1) { stop("Parameter 'time_dim' must be a character string.") @@ -104,42 +112,43 @@ Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, if (!time_dim %in% names(dim(data))) { stop("Parameter 'time_dim' is not found in 'data' dimension.") } - ## sdate_beg - if (!is.numeric(sdate_beg) | sdate_beg %% 1 != 0 | sdate_beg < 0 | - length(sdate_beg) > 1 | sdate_beg < 1850 | sdate_beg > 2020) { - stop("Parameter 'sdate_beg' must be an integer between 1850 and 2020.") - } - if (sdate_beg < sdates[1] + 40) { - stop("Parameter 'sdate_beg' must start at least 40 years after the + ## start + if (!is.numeric(start) | start %% 1 != 0 | start < 0 | + length(start) > 1 | start < 1850 | start > 2020) { + stop("Parameter 'start' must be an integer between 1850 and 2020.") + } + if (start < dates[1] + 40) { + stop("Parameter 'start' must start at least 40 years after the first start date of 'data'.") - } - ## sdate_end - if (!is.numeric(sdate_end) | sdate_end %% 1 != 0 | sdate_end < 0 | - length(sdate_end) > 1 | sdate_end < 1850 | sdate_end > 2020) { - stop("Parameter 'sdate_end' must be an integer between 1850 and 2020.") - } - if (sdate_end > sdates[length(sdates)] + 1) { - stop("Parameter 'sdate_end' must end at most 1 year after the + } + ## end + if (!is.numeric(end) | end %% 1 != 0 | end < 0 | + length(end) > 1 | end < 1850 | end > 2020) { + stop("Parameter 'end' must be an integer between 1850 and 2020.") + } + if (end > dates[length(dates)] + 1) { + stop("Parameter 'end' must end at most 1 year after the last start date of 'data'.") } - ## fyr_beg - if (!is.numeric(fyr_beg) | fyr_beg %% 1 != 0 | fyr_beg < 0 | - length(fyr_beg) > 1) { - stop("Parameter 'fyr_beg' must be a positive integer.") + ## ft_start + if (!is.numeric(ft_start) | ft_start %% 1 != 0 | ft_start < 0 | + length(ft_start) > 1) { + stop("Parameter 'ft_start' must be a positive integer.") } - ## fyr_end - if (!is.numeric(fyr_end) | fyr_end %% 1 != 0 | fyr_end < 0 | - length(fyr_end) > 1 | fyr_end > 10) { - stop("Parameter 'fyr_end' must be a positive integer below 10.") - } - ## dates - if (length(dates) != length(data[[2]])) { - stop("Parameter 'dates' must have the same length as in 'time_dim'.") + ## ft_end + if (!is.numeric(ft_end) | ft_end %% 1 != 0 | ft_end < 0 | + length(ft_end) > 1 | ft_end > max_ft) { + stop("Parameter 'ft_end' must be a positive integer below 'max_ft'.") + } + ## max_ft + if (!is.numeric(max_ft) | max_ft %% 1 != 0 | max_ft < 0 | + length(max_ft) > 1) { + stop("Parameter 'max_ft' must be a positive integer.") } ## memb if (!is.numeric(memb) | memb %% 1 != 0 | memb < 0 | length(memb) > 1) { - stop("Parameter 'memb' must be a positive integer.") + stop("Parameter 'memb' must be a positive integer.") } ## na.action if (!is.function(na.action) & !is.numeric(na.action)) { @@ -170,13 +179,14 @@ Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, output <- Apply(list(data), target_dims = time_dim, fun = .Persistence, - output_dims = output_dims, - time_dim = time_dim, - sdate_beg = sdate_beg, - sdate_end = sdate_end, - fyr_beg = fyr_beg, - fyr_end = fyr_end, +# output_dims = output_dims, dates = dates, + time_dim = time_dim, + start = start, + end = end, + ft_start = ft_start, + ft_end = ft_end, + max_ft = max_ft, memb = memb, na.action = na.action, ncores = ncores) @@ -184,24 +194,24 @@ Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, return(output) } # x could be a vector timeseries -# start/end is a year (numeric) .. could be a date? -# fyr_start/fyr_end are indices -.Persistence <- function(x, dates, time_dim = 'sdate', start, end, fyr_start = 1, - fyr_end = 1, memb = 1, na.action = 10) { +# start/end is a year (4-digit numeric) or a date (ISOdate) +# ft_start/ft_end are indices +.Persistence <- function(x, dates, time_dim = 'time', start, end, ft_start = 1, + ft_end = 1, max_ft = 10, memb = 1, na.action = 10) { tm <- end - start + 1 max_date <- match(start, dates) - interval <- fyr_end - fyr_start + interval <- ft_end - ft_start persistence.mean <- persistence.predint <- NULL AR.slope <- AR.intercept <- AR.lowCI <- AR.highCI <- NULL persistence <- matrix(NA, nrow = memb, ncol = tm) - names(dim(persistence)) <- c('realization', time_dim) + names(dim(persistence)) <- c('member', time_dim) for (sdate in tm:1){ - min_y = 10 + fyr_start + min_y = max_ft + ft_start max_y = max_date + sdate - 2 - min_x = 10 # for extreme case: forecast years 1-10, interval = 9 - max_x = max_date + sdate - 2 - fyr_start + min_x = max_ft # for extreme case: ex. forecast years 1-10, interval = 9 + max_x = max_date + sdate - 2 - ft_start regdates = max_y - min_y + 1 -- GitLab From 7dcc12ddae5ea35918ab810649462a2387da6bf3 Mon Sep 17 00:00:00 2001 From: Deborah Verfaillie Date: Tue, 24 Mar 2020 12:57:33 +0100 Subject: [PATCH 07/13] Improving the Persistence function --- DESCRIPTION | 2 +- man/AnimateMap.Rd | 33 +++++++++--- man/Clim.Rd | 16 ++++-- man/ColorBar.Rd | 32 +++++++++--- man/ConfigApplyMatchingEntries.Rd | 11 ++-- man/ConfigEditDefinition.Rd | 1 - man/ConfigEditEntry.Rd | 45 ++++++++++++---- man/ConfigFileOpen.Rd | 3 +- man/ConfigShowSimilarEntries.Rd | 17 ++++-- man/ConfigShowTable.Rd | 3 +- man/Corr.Rd | 17 ++++-- man/Eno.Rd | 1 - man/InsertDim.Rd | 1 - man/LeapYear.Rd | 1 - man/Load.Rd | 40 ++++++++++---- man/MeanDims.Rd | 1 - man/Persistence.Rd | 58 +++++++++++++-------- man/PlotClim.Rd | 26 +++++++--- man/PlotEquiMap.Rd | 86 ++++++++++++++++++++++++------- man/PlotLayout.Rd | 73 ++++++++++++++++++-------- man/PlotMatrix.Rd | 29 ++++++++--- man/PlotSection.Rd | 25 +++++++-- man/PlotStereoMap.Rd | 61 +++++++++++++++++----- man/RMS.Rd | 14 +++-- man/RMSSS.Rd | 11 ++-- man/Regression.Rd | 14 +++-- man/Reorder.Rd | 1 - man/Season.Rd | 13 +++-- man/ToyModel.Rd | 15 ++++-- man/Trend.Rd | 12 +++-- man/clim.palette.Rd | 3 +- man/s2dv-package.Rd | 39 ++++++++++---- man/sampleDepthData.Rd | 1 - man/sampleMap.Rd | 1 - man/sampleTimeSeries.Rd | 1 - 35 files changed, 515 insertions(+), 192 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ad60630..68730c9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,4 +41,4 @@ BugReports: https://earth.bsc.es/gitlab/es/s2dv/issues LazyData: true SystemRequirements: cdo Encoding: UTF-8 -RoxygenNote: 5.0.0 +RoxygenNote: 7.0.1 diff --git a/man/AnimateMap.Rd b/man/AnimateMap.Rd index d2003ee..2ec930d 100644 --- a/man/AnimateMap.Rd +++ b/man/AnimateMap.Rd @@ -4,13 +4,33 @@ \alias{AnimateMap} \title{Animate Maps of Forecast/Observed Values or Scores Over Forecast Time} \usage{ -AnimateMap(var, lon, lat, toptitle = rep("", 11), sizetit = 1, units = "", - monini = 1, freq = 12, msk95lev = FALSE, brks = NULL, cols = NULL, - filled.continents = FALSE, lonmin = 0, lonmax = 360, latmin = -90, - latmax = 90, intlon = 20, intlat = 30, drawleg = TRUE, - subsampleg = 1, colNA = "white", equi = TRUE, +AnimateMap( + var, + lon, + lat, + toptitle = rep("", 11), + sizetit = 1, + units = "", + monini = 1, + freq = 12, + msk95lev = FALSE, + brks = NULL, + cols = NULL, + filled.continents = FALSE, + lonmin = 0, + lonmax = 360, + latmin = -90, + latmax = 90, + intlon = 20, + intlat = 30, + drawleg = TRUE, + subsampleg = 1, + colNA = "white", + equi = TRUE, fileout = c("output1_animvsltime.gif", "output2_animvsltime.gif", - "output3_animvsltime.gif"), ...) + "output3_animvsltime.gif"), + ... +) } \arguments{ \item{var}{Matrix of dimensions (nltime, nlat, nlon) or @@ -162,4 +182,3 @@ AnimateMap(clim$clim_exp, sampleData$lon, sampleData$lat, # More examples in s2dverification but are deleted for now } - diff --git a/man/Clim.Rd b/man/Clim.Rd index 8bb93f1..7a06bb8 100644 --- a/man/Clim.Rd +++ b/man/Clim.Rd @@ -4,9 +4,18 @@ \alias{Clim} \title{Compute Bias Corrected Climatologies} \usage{ -Clim(exp, obs, time_dim = "sdate", dat_dim = c("dataset", "member"), - method = "clim", ftime_dim = "ftime", memb_dim = "member", - memb = TRUE, na.rm = TRUE, ncores = NULL) +Clim( + exp, + obs, + time_dim = "sdate", + dat_dim = c("dataset", "member"), + method = "clim", + ftime_dim = "ftime", + memb_dim = "member", + memb = TRUE, + na.rm = TRUE, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -82,4 +91,3 @@ PlotClim(clim$clim_exp, clim$clim_obs, listobs = c('ERSST'), biglab = FALSE, fileout = 'tos_clim.eps') } } - diff --git a/man/ColorBar.Rd b/man/ColorBar.Rd index 1287b70..6d62f15 100644 --- a/man/ColorBar.Rd +++ b/man/ColorBar.Rd @@ -4,13 +4,30 @@ \alias{ColorBar} \title{Draws a Color Bar} \usage{ -ColorBar(brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, - bar_limits = NULL, var_limits = NULL, triangle_ends = NULL, - col_inf = NULL, col_sup = NULL, color_fun = clim.palette(), - plot = TRUE, draw_ticks = TRUE, draw_separators = FALSE, - triangle_ends_scale = 1, extra_labels = NULL, title = NULL, - title_scale = 1, label_scale = 1, tick_scale = 1, - extra_margin = rep(0, 4), label_digits = 4, ...) +ColorBar( + brks = NULL, + cols = NULL, + vertical = TRUE, + subsampleg = NULL, + bar_limits = NULL, + var_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + color_fun = clim.palette(), + plot = TRUE, + draw_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + extra_labels = NULL, + title = NULL, + title_scale = 1, + label_scale = 1, + tick_scale = 1, + extra_margin = rep(0, 4), + label_digits = 4, + ... +) } \arguments{ \item{brks}{Can be provided in two formats: @@ -175,4 +192,3 @@ cols <- c("dodgerblue4", "dodgerblue1", "forestgreen", "yellowgreen", "white", lims <- seq(-1, 1, 0.2) ColorBar(lims, cols) } - diff --git a/man/ConfigApplyMatchingEntries.Rd b/man/ConfigApplyMatchingEntries.Rd index 5f0efb1..ee4cb5a 100644 --- a/man/ConfigApplyMatchingEntries.Rd +++ b/man/ConfigApplyMatchingEntries.Rd @@ -4,8 +4,14 @@ \alias{ConfigApplyMatchingEntries} \title{Apply Matching Entries To Dataset Name And Variable Name To Find Related Info} \usage{ -ConfigApplyMatchingEntries(configuration, var, exp = NULL, obs = NULL, - show_entries = FALSE, show_result = TRUE) +ConfigApplyMatchingEntries( + configuration, + var, + exp = NULL, + obs = NULL, + show_entries = FALSE, + show_result = TRUE +) } \arguments{ \item{configuration}{Configuration object obtained from ConfigFileOpen() @@ -68,4 +74,3 @@ ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigEditDefinition.Rd b/man/ConfigEditDefinition.Rd index 8e1e968..223e95a 100644 --- a/man/ConfigEditDefinition.Rd +++ b/man/ConfigEditDefinition.Rd @@ -57,4 +57,3 @@ match_info <- ConfigApplyMatchingEntries(configuration, 'tas', [ConfigEditEntry()], [ConfigFileOpen()], [ConfigShowSimilarEntries()], [ConfigShowTable()]. } - diff --git a/man/ConfigEditEntry.Rd b/man/ConfigEditEntry.Rd index 9abf3e5..e597709 100644 --- a/man/ConfigEditEntry.Rd +++ b/man/ConfigEditEntry.Rd @@ -1,22 +1,46 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigEditEntry.R \name{ConfigEditEntry} -\alias{ConfigAddEntry} \alias{ConfigEditEntry} +\alias{ConfigAddEntry} \alias{ConfigRemoveEntry} \title{Add, Remove Or Edit Entries In The Configuration} \usage{ -ConfigEditEntry(configuration, dataset_type, position, dataset_name = NULL, - var_name = NULL, main_path = NULL, file_path = NULL, - nc_var_name = NULL, suffix = NULL, varmin = NULL, varmax = NULL) +ConfigEditEntry( + configuration, + dataset_type, + position, + dataset_name = NULL, + var_name = NULL, + main_path = NULL, + file_path = NULL, + nc_var_name = NULL, + suffix = NULL, + varmin = NULL, + varmax = NULL +) -ConfigAddEntry(configuration, dataset_type, position = "last", - dataset_name = ".*", var_name = ".*", main_path = "*", - file_path = "*", nc_var_name = "*", suffix = "*", varmin = "*", - varmax = "*") +ConfigAddEntry( + configuration, + dataset_type, + position = "last", + dataset_name = ".*", + var_name = ".*", + main_path = "*", + file_path = "*", + nc_var_name = "*", + suffix = "*", + varmin = "*", + varmax = "*" +) -ConfigRemoveEntry(configuration, dataset_type, dataset_name = NULL, - var_name = NULL, position = NULL) +ConfigRemoveEntry( + configuration, + dataset_type, + dataset_name = NULL, + var_name = NULL, + position = NULL +) } \arguments{ \item{configuration}{Configuration object obtained via ConfigFileOpen() @@ -99,4 +123,3 @@ ConfigFileSave(configuration, config_file, confirm = FALSE) ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigFileOpen.Rd b/man/ConfigFileOpen.Rd index cf40e00..8669382 100644 --- a/man/ConfigFileOpen.Rd +++ b/man/ConfigFileOpen.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigFileOpen.R \name{ConfigFileOpen} -\alias{ConfigFileCreate} \alias{ConfigFileOpen} +\alias{ConfigFileCreate} \alias{ConfigFileSave} \title{Functions To Create Open And Save Configuration File} \usage{ @@ -194,4 +194,3 @@ ConfigFileSave(configuration, config_file, confirm = FALSE) ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigShowSimilarEntries.Rd b/man/ConfigShowSimilarEntries.Rd index b9f80ce..72b77e1 100644 --- a/man/ConfigShowSimilarEntries.Rd +++ b/man/ConfigShowSimilarEntries.Rd @@ -4,10 +4,18 @@ \alias{ConfigShowSimilarEntries} \title{Find Similar Entries In Tables Of Datasets} \usage{ -ConfigShowSimilarEntries(configuration, dataset_name = NULL, - var_name = NULL, main_path = NULL, file_path = NULL, - nc_var_name = NULL, suffix = NULL, varmin = NULL, varmax = NULL, - n_results = 10) +ConfigShowSimilarEntries( + configuration, + dataset_name = NULL, + var_name = NULL, + main_path = NULL, + file_path = NULL, + nc_var_name = NULL, + suffix = NULL, + varmin = NULL, + varmax = NULL, + n_results = 10 +) } \arguments{ \item{configuration}{Configuration object obtained either from @@ -79,4 +87,3 @@ ConfigShowSimilarEntries(configuration, dataset_name = "Exper", ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigShowTable.Rd b/man/ConfigShowTable.Rd index 7c08053..5e4172a 100644 --- a/man/ConfigShowTable.Rd +++ b/man/ConfigShowTable.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigShowTable.R \name{ConfigShowTable} -\alias{ConfigShowDefinitions} \alias{ConfigShowTable} +\alias{ConfigShowDefinitions} \title{Show Configuration Tables And Definitions} \usage{ ConfigShowTable(configuration, dataset_type, line_numbers = NULL) @@ -54,4 +54,3 @@ ConfigShowDefinitions(configuration) [ConfigEditEntry()], [ConfigFileOpen()], [ConfigShowSimilarEntries()], [ConfigShowTable()]. } - diff --git a/man/Corr.Rd b/man/Corr.Rd index 45eb166..a2f45b0 100644 --- a/man/Corr.Rd +++ b/man/Corr.Rd @@ -4,9 +4,19 @@ \alias{Corr} \title{Compute the correlation coefficient between an array of forecast and their corresponding observation} \usage{ -Corr(exp, obs, time_dim = "sdate", memb_dim = "member", comp_dim = NULL, - limits = NULL, method = "pearson", pval = TRUE, conf = TRUE, - conf.lev = 0.95, ncores = NULL) +Corr( + exp, + obs, + time_dim = "sdate", + memb_dim = "member", + comp_dim = NULL, + limits = NULL, + method = "pearson", + pval = TRUE, + conf = TRUE, + conf.lev = 0.95, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -81,4 +91,3 @@ corr <- Corr(clim$clim_exp, clim$clim_obs, time_dim = 'ftime') # Renew the example when Ano and Smoothing is ready } - diff --git a/man/Eno.Rd b/man/Eno.Rd index 32468bd..03c3b4f 100644 --- a/man/Eno.Rd +++ b/man/Eno.Rd @@ -39,4 +39,3 @@ data[na] <- NA res <- Eno(data) } - diff --git a/man/InsertDim.Rd b/man/InsertDim.Rd index 8ab628d..c0dd7d8 100644 --- a/man/InsertDim.Rd +++ b/man/InsertDim.Rd @@ -32,4 +32,3 @@ res <- InsertDim(InsertDim(a, posdim = 2, lendim = 1, name = 'e'), 4, c(f = 2)) dim(res) } - diff --git a/man/LeapYear.Rd b/man/LeapYear.Rd index d261b0a..c2960f3 100644 --- a/man/LeapYear.Rd +++ b/man/LeapYear.Rd @@ -21,4 +21,3 @@ print(LeapYear(1991)) print(LeapYear(1992)) print(LeapYear(1993)) } - diff --git a/man/Load.Rd b/man/Load.Rd index 214f984..10c03f9 100644 --- a/man/Load.Rd +++ b/man/Load.Rd @@ -4,15 +4,36 @@ \alias{Load} \title{Loads Experimental And Observational Data} \usage{ -Load(var, exp = NULL, obs = NULL, sdates, nmember = NULL, - nmemberobs = NULL, nleadtime = NULL, leadtimemin = 1, - leadtimemax = NULL, storefreq = "monthly", sampleperiod = 1, - lonmin = 0, lonmax = 360, latmin = -90, latmax = 90, - output = "areave", method = "conservative", grid = NULL, - maskmod = vector("list", 15), maskobs = vector("list", 15), - configfile = NULL, varmin = NULL, varmax = NULL, silent = FALSE, - nprocs = NULL, dimnames = NULL, remapcells = 2, - path_glob_permissive = "partial") +Load( + var, + exp = NULL, + obs = NULL, + sdates, + nmember = NULL, + nmemberobs = NULL, + nleadtime = NULL, + leadtimemin = 1, + leadtimemax = NULL, + storefreq = "monthly", + sampleperiod = 1, + lonmin = 0, + lonmax = 360, + latmin = -90, + latmax = 90, + output = "areave", + method = "conservative", + grid = NULL, + maskmod = vector("list", 15), + maskobs = vector("list", 15), + configfile = NULL, + varmin = NULL, + varmax = NULL, + silent = FALSE, + nprocs = NULL, + dimnames = NULL, + remapcells = 2, + path_glob_permissive = "partial" +) } \arguments{ \item{var}{Short name of the variable to load. It should coincide with the @@ -874,4 +895,3 @@ sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), lonmin = -12, lonmax = 40) } } - diff --git a/man/MeanDims.Rd b/man/MeanDims.Rd index f2140f3..419756f 100644 --- a/man/MeanDims.Rd +++ b/man/MeanDims.Rd @@ -30,4 +30,3 @@ print(dim(MeanDims(a, 2))) print(dim(MeanDims(a, c(2, 3)))) print(dim(MeanDims(a, c('a', 'b')))) } - diff --git a/man/Persistence.Rd b/man/Persistence.Rd index b3a083a..e151218 100644 --- a/man/Persistence.Rd +++ b/man/Persistence.Rd @@ -4,34 +4,49 @@ \alias{Persistence} \title{Compute persistence} \usage{ -Persistence(data, time_dim = "sdate", sdate_beg, sdate_end, fyr_beg, - fyr_end = fyr_beg, dates, memb = 1, na.action = 10, ncores = NULL) +Persistence( + data, + dates, + time_dim = "time", + start, + end, + ft_start, + ft_end = ft_start, + max_ft = 10, + memb = 1, + na.action = 10, + ncores = NULL +) } \arguments{ \item{data}{A numeric array corresponding to the observational data including the time dimension along which the autoregression is computed. The data -should start at least 40 years before 'sdate_beg'.} +should start at least 40 time steps (years or days) before 'start'.} + +\item{dates}{A sequence of 4-digit integers (YYYY) or dates (YYYY-MM-DD) indicating +the dates available in the observations.} \item{time_dim}{A character string indicating the dimension along which to -compute the autoregression. The default value is 'sdate'.} +compute the autoregression. The default value is 'time'.} -\item{sdate_beg}{A 4-digit integer indicating the first start date of the persistence -forecast.} +\item{start}{A 4-digit integer (YYYY) or a date in the ISOdate format (YYYY-MM-DD) +indicating the first start date of the persistence forecast.} -\item{sdate_end}{A 4-digit integer indicating the last start date of the persistence -forecast.} +\item{end}{A 4-digit integer (YYYY) or a date in the ISOdate format (YYYY-MM-DD) +indicating the last start date of the persistence forecast.} -\item{fyr_beg}{An integer indicating the forecast year for which +\item{ft_start}{An integer indicating the forecast time for which the persistence forecast should be calculated, or the first forecast -year of the average forecast years for which persistence should be +time of the average forecast times for which persistence should be calculated.} -\item{fyr_end}{An (optional) integer indicating the last forecast year -of the average forecast years for which persistence should be calculated -in the case of a multiyear average persistence. The default value is 'fyr_beg'.} +\item{ft_end}{An (optional) integer indicating the last forecast time +of the average forecast times for which persistence should be calculated +in the case of a multi-timestep average persistence. The default value is 'ft_start'.} -\item{dates}{A sequence of 4-digit integers indicating the dates available -in the observations.} +\item{max_ft}{An integer indicating the maximum forecast time possible for 'data'. +For example, for decadal prediction 'max_ft' would correspond to 10 (years). The +default value is 10.} \item{memb}{An integer indicating the number of ensemble members to generate for the persistence forecast. The default value is 1.} @@ -47,7 +62,7 @@ computation. The default value is NULL.} \value{ A list containing: \item{$persistence}{ - A numeric array with dimensions 'memb', start dates, latitudes and longitudes + A numeric array with dimensions 'memb', time (start dates), latitudes and longitudes containing the persistence forecast. } \item{$persistence.mean}{ @@ -84,14 +99,13 @@ uncertainty (prediction interval) based on Coelho et al., 2004.\cr\cr } \examples{ #Building an example dataset with yearly start dates from 1920 to 2009 -obs1 <- 1 : (1 * 1 * 90 * 6 * 7) -dim(obs1) <- c(dataset = 1, member = 1, sdate = 90, lat = 6, lon = 7) +obs1 <- 1 : (1 * 90 * 6 * 7) +dim(obs1) <- c(member = 1, time = 90, lat = 6, lon = 7) dates <- seq(1920,2009,1) lon <- seq(0, 30, 5) lat <- seq(0, 25, 5) -obs <- list(data = obs1, dates = dates, lat = lat, lon = lon) -persist <- Persistence(obs, sdate_beg = 1961, sdate_end = 2005, fyr_beg = 1, - dates = dates, memb = 40) +obs <- list(data = obs1, time = dates, lat = lat, lon = lon) +persist <- Persistence(obs$data, dates = dates, start = 1961, end = 2005, ft_start = 1, + memb = 40) } - diff --git a/man/PlotClim.Rd b/man/PlotClim.Rd index 35ab17d..3023ae6 100644 --- a/man/PlotClim.Rd +++ b/man/PlotClim.Rd @@ -4,11 +4,26 @@ \alias{PlotClim} \title{Plots Climatologies} \usage{ -PlotClim(exp_clim, obs_clim = NULL, toptitle = "", ytitle = "", - monini = 1, freq = 12, limits = NULL, listexp = c("exp1", "exp2", - "exp3"), listobs = c("obs1", "obs2", "obs3"), biglab = FALSE, - leg = TRUE, sizetit = 1, fileout = "output_plotclim.eps", width = 8, - height = 5, size_units = "in", res = 100, ...) +PlotClim( + exp_clim, + obs_clim = NULL, + toptitle = "", + ytitle = "", + monini = 1, + freq = 12, + limits = NULL, + listexp = c("exp1", "exp2", "exp3"), + listobs = c("obs1", "obs2", "obs3"), + biglab = FALSE, + leg = TRUE, + sizetit = 1, + fileout = "output_plotclim.eps", + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{exp_clim}{Matrix containing the experimental data with dimensions:\cr @@ -81,4 +96,3 @@ PlotClim(clim$clim_exp, clim$clim_obs, toptitle = paste('climatologies'), } } - diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index cf45ead..fbd7042 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -4,25 +4,72 @@ \alias{PlotEquiMap} \title{Maps A Two-Dimensional Variable On A Cylindrical Equidistant Projection} \usage{ -PlotEquiMap(var, lon, lat, varu = NULL, varv = NULL, toptitle = NULL, - sizetit = NULL, units = NULL, brks = NULL, cols = NULL, - bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, - col_sup = NULL, colNA = NULL, color_fun = clim.palette(), - square = TRUE, filled.continents = NULL, coast_color = NULL, - coast_width = 1, contours = NULL, brks2 = NULL, contour_lwd = 0.5, - contour_color = "black", contour_lty = 1, contour_label_scale = 1, - dots = NULL, dot_symbol = 4, dot_size = 1, - arr_subsamp = floor(length(lon)/30), arr_scale = 1, arr_ref_len = 15, - arr_units = "m/s", arr_scale_shaft = 1, arr_scale_shaft_angle = 1, - axelab = TRUE, labW = FALSE, intylat = 20, intxlon = 20, - axes_tick_scale = 1, axes_label_scale = 1, drawleg = TRUE, - subsampleg = NULL, bar_extra_labels = NULL, draw_bar_ticks = TRUE, - draw_separators = FALSE, triangle_ends_scale = 1, bar_label_digits = 4, - bar_label_scale = 1, units_scale = 1, bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), boxlim = NULL, boxcol = "purple2", - boxlwd = 5, margin_scale = rep(1, 4), title_scale = 1, numbfig = NULL, - fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, - ...) +PlotEquiMap( + var, + lon, + lat, + varu = NULL, + varv = NULL, + toptitle = NULL, + sizetit = NULL, + units = NULL, + brks = NULL, + cols = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + colNA = NULL, + color_fun = clim.palette(), + square = TRUE, + filled.continents = NULL, + coast_color = NULL, + coast_width = 1, + contours = NULL, + brks2 = NULL, + contour_lwd = 0.5, + contour_color = "black", + contour_lty = 1, + contour_label_scale = 1, + dots = NULL, + dot_symbol = 4, + dot_size = 1, + arr_subsamp = floor(length(lon)/30), + arr_scale = 1, + arr_ref_len = 15, + arr_units = "m/s", + arr_scale_shaft = 1, + arr_scale_shaft_angle = 1, + axelab = TRUE, + labW = FALSE, + intylat = 20, + intxlon = 20, + axes_tick_scale = 1, + axes_label_scale = 1, + drawleg = TRUE, + subsampleg = NULL, + bar_extra_labels = NULL, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_label_digits = 4, + bar_label_scale = 1, + units_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + boxlim = NULL, + boxcol = "purple2", + boxlwd = 5, + margin_scale = rep(1, 4), + title_scale = 1, + numbfig = NULL, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Array with the values at each cell of a grid on a regular @@ -278,4 +325,3 @@ PlotEquiMap(sampleData$mod[1, 1, 1, 1, , ], sampleData$lon, sampleData$lat, toptitle = 'Predicted sea surface temperature for Nov 1960 from 1st Nov', sizetit = 0.5) } - diff --git a/man/PlotLayout.Rd b/man/PlotLayout.Rd index f01fdf9..453cf2e 100644 --- a/man/PlotLayout.Rd +++ b/man/PlotLayout.Rd @@ -4,20 +4,52 @@ \alias{PlotLayout} \title{Arrange and Fill Multi-Pannel Layouts With Optional Colour Bar} \usage{ -PlotLayout(fun, plot_dims, var, ..., special_args = NULL, nrow = NULL, - ncol = NULL, toptitle = NULL, row_titles = NULL, col_titles = NULL, - bar_scale = 1, title_scale = 1, title_margin_scale = 1, - title_left_shift_scale = 1, subtitle_scale = 1, - subtitle_margin_scale = 1, brks = NULL, cols = NULL, drawleg = "S", - titles = NULL, subsampleg = NULL, bar_limits = NULL, - triangle_ends = NULL, col_inf = NULL, col_sup = NULL, - color_fun = clim.colors, draw_bar_ticks = TRUE, draw_separators = FALSE, - triangle_ends_scale = 1, bar_extra_labels = NULL, units = NULL, - units_scale = 1, bar_label_scale = 1, bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), bar_left_shift_scale = 1, - bar_label_digits = 4, extra_margin = rep(0, 4), fileout = NULL, - width = NULL, height = NULL, size_units = "in", res = 100, - close_device = TRUE) +PlotLayout( + fun, + plot_dims, + var, + ..., + special_args = NULL, + nrow = NULL, + ncol = NULL, + toptitle = NULL, + row_titles = NULL, + col_titles = NULL, + bar_scale = 1, + title_scale = 1, + title_margin_scale = 1, + title_left_shift_scale = 1, + subtitle_scale = 1, + subtitle_margin_scale = 1, + brks = NULL, + cols = NULL, + drawleg = "S", + titles = NULL, + subsampleg = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + color_fun = clim.colors, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_extra_labels = NULL, + units = NULL, + units_scale = 1, + bar_label_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + bar_left_shift_scale = 1, + bar_label_digits = 4, + extra_margin = rep(0, 4), + fileout = NULL, + width = NULL, + height = NULL, + size_units = "in", + res = 100, + close_device = TRUE +) } \arguments{ \item{fun}{Plot function (or name of the function) to be called on the @@ -48,6 +80,12 @@ applied to each of them. NAs can be passed to the list: a NA will yield a blank cell in the layout, which can be populated after (see .SwitchToFigure).} +\item{\dots}{Parameters to be sent to the plotting function 'fun'. If +multiple arrays are provided in 'var' and multiple functions are provided +in 'fun', the parameters provided through \dots will be sent to all the +plot functions, as common parameters. To specify concrete arguments for +each of the plot functions see parameter 'special_args'.} + \item{special_args}{List of sub-lists, each sub-list having specific extra arguments for each of the plot functions provided in 'fun'. If you want to fix a different value for each plot in the layout you can do so by @@ -164,12 +202,6 @@ the layout and a 'fileout' has been specified. This is useful to avoid closing the device when saving the layout into a file and willing to add extra elements or figures. Takes TRUE by default. Disregarded if no 'fileout' has been specified.} - -\item{\dots}{Parameters to be sent to the plotting function 'fun'. If -multiple arrays are provided in 'var' and multiple functions are provided -in 'fun', the parameters provided through \dots will be sent to all the -plot functions, as common parameters. To specify concrete arguments for -each of the plot functions see parameter 'special_args'.} } \value{ \item{brks}{ @@ -244,4 +276,3 @@ PlotLayout(PlotEquiMap, c('lat', 'lon'), sampleData$mod[1, , 1, 1, , ], titles = paste('Member', 1:15)) } - diff --git a/man/PlotMatrix.Rd b/man/PlotMatrix.Rd index 24f046d..5275df0 100644 --- a/man/PlotMatrix.Rd +++ b/man/PlotMatrix.Rd @@ -4,12 +4,28 @@ \alias{PlotMatrix} \title{Function to convert any numerical table to a grid of coloured squares.} \usage{ -PlotMatrix(var, brks = NULL, cols = NULL, toptitle = NULL, - title.color = "royalblue4", xtitle = NULL, ytitle = NULL, - xlabels = NULL, xvert = FALSE, ylabels = NULL, line = 3, - figure.width = 1, legend = TRUE, legend.width = 0.15, - xlab_dist = NULL, ylab_dist = NULL, fileout = NULL, size_units = "px", - res = 100, ...) +PlotMatrix( + var, + brks = NULL, + cols = NULL, + toptitle = NULL, + title.color = "royalblue4", + xtitle = NULL, + ytitle = NULL, + xlabels = NULL, + xvert = FALSE, + ylabels = NULL, + line = 3, + figure.width = 1, + legend = TRUE, + legend.width = 0.15, + xlab_dist = NULL, + ylab_dist = NULL, + fileout = NULL, + size_units = "px", + res = 100, + ... +) } \arguments{ \item{var}{A numerical matrix containing the values to be displayed in a @@ -93,4 +109,3 @@ PlotMatrix(var = matrix(rnorm(n = 120, mean = 0.3), 10, 12), xlabels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")) } - diff --git a/man/PlotSection.Rd b/man/PlotSection.Rd index 413ef63..1627339 100644 --- a/man/PlotSection.Rd +++ b/man/PlotSection.Rd @@ -4,10 +4,26 @@ \alias{PlotSection} \title{Plots A Vertical Section} \usage{ -PlotSection(var, horiz, depth, toptitle = "", sizetit = 1, units = "", - brks = NULL, cols = NULL, axelab = TRUE, intydep = 200, - intxhoriz = 20, drawleg = TRUE, fileout = NULL, width = 8, - height = 5, size_units = "in", res = 100, ...) +PlotSection( + var, + horiz, + depth, + toptitle = "", + sizetit = 1, + units = "", + brks = NULL, + cols = NULL, + axelab = TRUE, + intydep = 200, + intxhoriz = 20, + drawleg = TRUE, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Matrix to plot with (longitude/latitude, depth) dimensions.} @@ -69,4 +85,3 @@ sampleData <- s2dv::sampleDepthData PlotSection(sampleData$mod[1, 1, 1, 1, , ], sampleData$lat, sampleData$depth, toptitle = 'temperature 1995-11 member 0') } - diff --git a/man/PlotStereoMap.Rd b/man/PlotStereoMap.Rd index 4b910a9..95c2f71 100644 --- a/man/PlotStereoMap.Rd +++ b/man/PlotStereoMap.Rd @@ -4,19 +4,53 @@ \alias{PlotStereoMap} \title{Maps A Two-Dimensional Variable On A Polar Stereographic Projection} \usage{ -PlotStereoMap(var, lon, lat, latlims = c(60, 90), toptitle = NULL, - sizetit = NULL, units = NULL, brks = NULL, cols = NULL, - bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, - col_sup = NULL, colNA = NULL, color_fun = clim.palette(), - filled.continents = FALSE, coast_color = NULL, coast_width = 1, - dots = NULL, dot_symbol = 4, dot_size = 0.8, intlat = 10, - drawleg = TRUE, subsampleg = NULL, bar_extra_labels = NULL, - draw_bar_ticks = TRUE, draw_separators = FALSE, triangle_ends_scale = 1, - bar_label_digits = 4, bar_label_scale = 1, units_scale = 1, - bar_tick_scale = 1, bar_extra_margin = rep(0, 4), boxlim = NULL, - boxcol = "purple2", boxlwd = 5, margin_scale = rep(1, 4), - title_scale = 1, numbfig = NULL, fileout = NULL, width = 6, - height = 5, size_units = "in", res = 100, ...) +PlotStereoMap( + var, + lon, + lat, + latlims = c(60, 90), + toptitle = NULL, + sizetit = NULL, + units = NULL, + brks = NULL, + cols = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + colNA = NULL, + color_fun = clim.palette(), + filled.continents = FALSE, + coast_color = NULL, + coast_width = 1, + dots = NULL, + dot_symbol = 4, + dot_size = 0.8, + intlat = 10, + drawleg = TRUE, + subsampleg = NULL, + bar_extra_labels = NULL, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_label_digits = 4, + bar_label_scale = 1, + units_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + boxlim = NULL, + boxcol = "purple2", + boxlwd = 5, + margin_scale = rep(1, 4), + title_scale = 1, + numbfig = NULL, + fileout = NULL, + width = 6, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Array with the values at each cell of a grid on a regular @@ -183,4 +217,3 @@ y <- seq(from = -90, to = 90, length.out = 50) PlotStereoMap(data, x, y, latlims = c(60, 90), brks = 50, toptitle = "This is the title") } - diff --git a/man/RMS.Rd b/man/RMS.Rd index ac54686..7aa8f5a 100644 --- a/man/RMS.Rd +++ b/man/RMS.Rd @@ -4,8 +4,17 @@ \alias{RMS} \title{Compute root mean square error} \usage{ -RMS(exp, obs, time_dim = "sdate", memb_dim = "member", comp_dim = NULL, - limits = NULL, conf = TRUE, conf.lev = 0.95, ncores = NULL) +RMS( + exp, + obs, + time_dim = "sdate", + memb_dim = "member", + comp_dim = NULL, + limits = NULL, + conf = TRUE, + conf.lev = 0.95, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -75,4 +84,3 @@ The confidence interval is computed by the chi2 distribution.\cr # Renew example when Ano and Smoothing are ready } - diff --git a/man/RMSSS.Rd b/man/RMSSS.Rd index 3b9c1be..fd4a03b 100644 --- a/man/RMSSS.Rd +++ b/man/RMSSS.Rd @@ -4,8 +4,14 @@ \alias{RMSSS} \title{Compute root mean square error skill score} \usage{ -RMSSS(exp, obs, time_dim = "sdate", memb_dim = "member", pval = TRUE, - ncores = NULL) +RMSSS( + exp, + obs, + time_dim = "sdate", + memb_dim = "member", + pval = TRUE, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data which contains at least @@ -62,4 +68,3 @@ obs <- array(rnorm(6), dim = c(time = 3, member = 2, dat = 1)) res <- RMSSS(exp, obs, time_dim = 'time') } - diff --git a/man/Regression.Rd b/man/Regression.Rd index cbb2875..56a3291 100644 --- a/man/Regression.Rd +++ b/man/Regression.Rd @@ -4,8 +4,17 @@ \alias{Regression} \title{Compute the regression of an array on another along one dimension.} \usage{ -Regression(datay, datax, time_dim = "sdate", formula = y ~ x, pval = TRUE, - conf = TRUE, conf.lev = 0.95, na.action = na.omit, ncores = NULL) +Regression( + datay, + datax, + time_dim = "sdate", + formula = y ~ x, + pval = TRUE, + conf = TRUE, + conf.lev = 0.95, + na.action = na.omit, + ncores = NULL +) } \arguments{ \item{datay}{An numeric array as predictand including the dimension along @@ -92,4 +101,3 @@ res1 <- Regression(datay, datax, formula = y~poly(x, 2, raw = TRUE)) res2 <- Regression(datay, datax, conf.lev = 0.9) } - diff --git a/man/Reorder.Rd b/man/Reorder.Rd index 0afa07e..8748aaf 100644 --- a/man/Reorder.Rd +++ b/man/Reorder.Rd @@ -26,4 +26,3 @@ Reorder the dimension order of a multi-dimensional array dat2 <- array(c(1:10), dim = c(2, 1, 5)) print(dim(Reorder(dat2, c(2, 1, 3)))) } - diff --git a/man/Season.Rd b/man/Season.Rd index fad6f22..3878e48 100644 --- a/man/Season.Rd +++ b/man/Season.Rd @@ -4,8 +4,16 @@ \alias{Season} \title{Compute seasonal mean} \usage{ -Season(data, time_dim = "sdate", monini, moninf, monsup, method = mean, - na.rm = TRUE, ncores = NULL) +Season( + data, + time_dim = "sdate", + monini, + moninf, + monsup, + method = mean, + na.rm = TRUE, + ncores = NULL +) } \arguments{ \item{data}{A named numeric array with at least one dimension 'time_dim'.} @@ -53,4 +61,3 @@ dat2[na] <- NA res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2) res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2, na.rm = FALSE) } - diff --git a/man/ToyModel.Rd b/man/ToyModel.Rd index 379ed3b..ee7a98e 100644 --- a/man/ToyModel.Rd +++ b/man/ToyModel.Rd @@ -7,8 +7,18 @@ components of a forecast: (1) predictabiltiy (2) forecast error (3) non-stationarity and (4) ensemble generation. The forecast can be computed for real observations or observations generated artifically.} \usage{ -ToyModel(alpha = 0.1, beta = 0.4, gamma = 1, sig = 1, trend = 0, - nstartd = 30, nleadt = 4, nmemb = 10, obsini = NULL, fxerr = NULL) +ToyModel( + alpha = 0.1, + beta = 0.4, + gamma = 1, + sig = 1, + trend = 0, + nstartd = 30, + nleadt = 4, + nmemb = 10, + obsini = NULL, + fxerr = NULL +) } \arguments{ \item{alpha}{Predicabiltiy of the forecast on the observed residuals @@ -120,4 +130,3 @@ toyforecast <- ToyModel(alpha = a, beta = b, gamma = g, nmemb = nm, # } } - diff --git a/man/Trend.Rd b/man/Trend.Rd index e9c890e..61aeb3e 100644 --- a/man/Trend.Rd +++ b/man/Trend.Rd @@ -4,8 +4,15 @@ \alias{Trend} \title{Compute the trend} \usage{ -Trend(data, time_dim = "sdate", interval = 1, polydeg = 1, conf = TRUE, - conf.lev = 0.95, ncores = NULL) +Trend( + data, + time_dim = "sdate", + interval = 1, + polydeg = 1, + conf = TRUE, + conf.lev = 0.95, + ncores = NULL +) } \arguments{ \item{data}{An numeric array including the dimension along which the trend @@ -72,4 +79,3 @@ months_between_startdates <- 60 trend <- Trend(sampleData$obs, polydeg = 2) } - diff --git a/man/clim.palette.Rd b/man/clim.palette.Rd index d912f47..5d17947 100644 --- a/man/clim.palette.Rd +++ b/man/clim.palette.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/clim.palette.R \name{clim.palette} -\alias{clim.colors} \alias{clim.palette} +\alias{clim.colors} \title{Generate Climate Color Palettes} \usage{ clim.palette(palette = "bluered") @@ -30,4 +30,3 @@ cols <- clim.colors(20) ColorBar(lims, cols) } - diff --git a/man/s2dv-package.Rd b/man/s2dv-package.Rd index 71e5d16..809066a 100644 --- a/man/s2dv-package.Rd +++ b/man/s2dv-package.Rd @@ -4,20 +4,37 @@ \name{s2dv-package} \alias{s2dv} \alias{s2dv-package} -\title{A Set of Common Tools for Seasonal to Decadal Verification} +\title{s2dv: A Set of Common Tools for Seasonal to Decadal Verification} \description{ -The advanced version of package 's2dverification'. It is -intended for 'seasonal to decadal' (s2d) climate forecast verification, but -it can also be used in other kinds of forecasts or general climate analysis. -This package is specially designed for the comparison between the experimental -and observational datasets. The functionality of the included functions covers -from data retrieval, data post-processing, skill scores against observation, -to visualization. Compared to 's2dverification', 's2dv' is more compatible -with the package 'startR', able to use multiple cores for computation and -handle multi-dimensional arrays with a higher flexibility. +The advanced version of package 's2dverification'. It is + intended for 'seasonal to decadal' (s2d) climate forecast verification, but + it can also be used in other kinds of forecasts or general climate analysis. + This package is specially designed for the comparison between the experimental + and observational datasets. The functionality of the included functions covers + from data retrieval, data post-processing, skill scores against observation, + to visualization. Compared to 's2dverification', 's2dv' is more compatible + with the package 'startR', able to use multiple cores for computation and + handle multi-dimensional arrays with a higher flexibility. } \references{ \url{https://earth.bsc.es/gitlab/es/s2dverification/} } -\keyword{internal} +\seealso{ +Useful links: +\itemize{ + \item \url{https://earth.bsc.es/gitlab/es/s2dv/} + \item Report bugs at \url{https://earth.bsc.es/gitlab/es/s2dv/issues} +} + +} +\author{ +\strong{Maintainer}: An-Chi Ho \email{an.ho@bsc.es} +Authors: +\itemize{ + \item BSC-CNS [copyright holder] + \item Nuria Perez-Zanon \email{nuria.perez@bsc.es} +} + +} +\keyword{internal} diff --git a/man/sampleDepthData.Rd b/man/sampleDepthData.Rd index 869af86..77e4a7a 100644 --- a/man/sampleDepthData.Rd +++ b/man/sampleDepthData.Rd @@ -28,4 +28,3 @@ variable 'tos', i.e. sea surface temperature, from the decadal climate prediction experiment run at IC3 in the context of the CMIP5 project.\cr Its name within IC3 local database is 'i00k'. } - diff --git a/man/sampleMap.Rd b/man/sampleMap.Rd index 651d185..eaf8aa5 100644 --- a/man/sampleMap.Rd +++ b/man/sampleMap.Rd @@ -43,4 +43,3 @@ sampleData <- Load('tos', list(exp), list(obs), startDates, } Check the documentation on 'Load()' in the package 's2dv' for more information. } - diff --git a/man/sampleTimeSeries.Rd b/man/sampleTimeSeries.Rd index 280277e..05a8e79 100644 --- a/man/sampleTimeSeries.Rd +++ b/man/sampleTimeSeries.Rd @@ -47,4 +47,3 @@ sampleData <- Load('tos', list(exp), list(obs), startDates, } Check the documentation on 'Load()' in the package 's2dv' for more information. } - -- GitLab From 3c8031c2e25854b43253b5a80d291a7c7072c0a0 Mon Sep 17 00:00:00 2001 From: nperez Date: Mon, 8 Jun 2020 17:16:19 +0200 Subject: [PATCH 08/13] add author name --- R/Persistence.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/Persistence.R b/R/Persistence.R index f59a8c6..cb5dee5 100644 --- a/R/Persistence.R +++ b/R/Persistence.R @@ -4,6 +4,8 @@ #'observational data along the time dimension, with a measure of forecast #'uncertainty (prediction interval) based on Coelho et al., 2004.\cr\cr #' +#'@author Deborah Verfaillie, \email{deborah.verfaillie@bsc.es} +#' #'@param data A numeric array corresponding to the observational data #' including the time dimension along which the autoregression is computed. The data #' should start at least 40 time steps (years or days) before 'start'. @@ -71,7 +73,7 @@ #'#Building an example dataset with yearly start dates from 1920 to 2009 #'obs1 <- 1 : (1 * 90 * 6 * 7) #'dim(obs1) <- c(member = 1, time = 90, lat = 6, lon = 7) -#'dates <- seq(1920,2009,1) +#'dates <- seq(1920, 2009, 1) #'lon <- seq(0, 30, 5) #'lat <- seq(0, 25, 5) #'obs <- list(data = obs1, time = dates, lat = lat, lon = lon) -- GitLab From 10770f617ce0ac2366d844fce3d0666c20cdbae5 Mon Sep 17 00:00:00 2001 From: nperez Date: Mon, 8 Jun 2020 18:18:55 +0200 Subject: [PATCH 09/13] parameter nmemb renamed and realization dimension --- R/Persistence.R | 25 +++++++++++-------------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/R/Persistence.R b/R/Persistence.R index cb5dee5..115295f 100644 --- a/R/Persistence.R +++ b/R/Persistence.R @@ -27,7 +27,7 @@ #'@param max_ft An integer indicating the maximum forecast time possible for 'data'. #' For example, for decadal prediction 'max_ft' would correspond to 10 (years). The #' default value is 10. -#'@param memb An integer indicating the number of ensemble members to +#'@param nmemb An integer indicating the number of ensemble members to #' generate for the persistence forecast. The default value is 1. #'@param na.action A function or an integer. A function (e.g., na.omit, #' na.exclude, na.fail, na.pass) indicates what should happen when the data @@ -74,18 +74,15 @@ #'obs1 <- 1 : (1 * 90 * 6 * 7) #'dim(obs1) <- c(member = 1, time = 90, lat = 6, lon = 7) #'dates <- seq(1920, 2009, 1) -#'lon <- seq(0, 30, 5) -#'lat <- seq(0, 25, 5) -#'obs <- list(data = obs1, time = dates, lat = lat, lon = lon) -#'persist <- Persistence(obs$data, dates = dates, start = 1961, end = 2005, ft_start = 1, -#' memb = 40) +#'persist <- Persistence(obs1, dates = dates, start = 1961, end = 2005, ft_start = 1, +#' nmemb = 40) #' #'@rdname Persistence #'@import multiApply #'@import abind #'@export Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, - ft_end = ft_start, max_ft = 10, memb = 1, na.action = 10, + ft_end = ft_start, max_ft = 10, nmemb = 1, na.action = 10, ncores = NULL) { # Check inputs @@ -148,8 +145,8 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, stop("Parameter 'max_ft' must be a positive integer.") } ## memb - if (!is.numeric(memb) | memb %% 1 != 0 | memb < 0 | - length(memb) > 1) { + if (!is.numeric(nmemb) | nmemb %% 1 != 0 | nmemb < 0 | + length(nmemb) > 1) { stop("Parameter 'memb' must be a positive integer.") } ## na.action @@ -189,7 +186,7 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, ft_start = ft_start, ft_end = ft_end, max_ft = max_ft, - memb = memb, + nmemb = nmemb, na.action = na.action, ncores = ncores) @@ -199,15 +196,15 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, # start/end is a year (4-digit numeric) or a date (ISOdate) # ft_start/ft_end are indices .Persistence <- function(x, dates, time_dim = 'time', start, end, ft_start = 1, - ft_end = 1, max_ft = 10, memb = 1, na.action = 10) { + ft_end = 1, max_ft = 10, nmemb = 1, na.action = 10) { tm <- end - start + 1 max_date <- match(start, dates) interval <- ft_end - ft_start persistence.mean <- persistence.predint <- NULL AR.slope <- AR.intercept <- AR.lowCI <- AR.highCI <- NULL - persistence <- matrix(NA, nrow = memb, ncol = tm) - names(dim(persistence)) <- c('member', time_dim) + persistence <- matrix(NA, nrow = nmemb, ncol = tm) + names(dim(persistence)) <- c('realization', time_dim) for (sdate in tm:1){ min_y = max_ft + ft_start @@ -250,7 +247,7 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, AR.intercept[sdate] <- b AR.lowCI[sdate] <- reg$regression[1] AR.highCI[sdate] <- reg$regression[3] - persistence[ ,sdate] <- rnorm(n = memb, mean = persistence.mean[sdate], + persistence[ ,sdate] <- rnorm(n = nmemb, mean = persistence.mean[sdate], sd = persistence.predint[sdate]) } -- GitLab From 7506510f1d2fcc1ca64fe4c8dbda4ddd80346d6b Mon Sep 17 00:00:00 2001 From: nperez Date: Mon, 8 Jun 2020 18:33:59 +0200 Subject: [PATCH 10/13] documentation devtools --- DESCRIPTION | 18 +++++++++--------- man/Persistence.Rd | 16 ++++++++-------- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5634525..b5de231 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -5,15 +5,15 @@ Authors@R: c( person("BSC-CNS", role = c("aut", "cph")), person("An-Chi", "Ho", , "an.ho@bsc.es", role = c("aut", "cre")), person("Nuria", "Perez-Zanon", , "nuria.perez@bsc.es", role = "aut")) -Description: The advanced version of package 's2dverification'. It is - intended for 'seasonal to decadal' (s2d) climate forecast verification, but - it can also be used in other kinds of forecasts or general climate analysis. - This package is specially designed for the comparison between the experimental - and observational datasets. The functionality of the included functions covers - from data retrieval, data post-processing, skill scores against observation, - to visualization. Compared to 's2dverification', 's2dv' is more compatible - with the package 'startR', able to use multiple cores for computation and - handle multi-dimensional arrays with a higher flexibility. +Description: The advanced version of package 's2dverification'. It is intended + for 'seasonal to decadal' (s2d) climate forecast verification, but it can + also be used in other kinds of forecasts or general climate analysis. This + package is specially designed for the comparison between the experimental and + observational datasets. The functionality of the included functions covers + from data retrieval, data post-processing, skill scores against observation, to + visualization. Compared to 's2dverification', 's2dv' is more compatible with the + package 'startR', able to use multiple cores for computation and handle multi- + dimensional arrays with a higher flexibility. Depends: maps, methods, diff --git a/man/Persistence.Rd b/man/Persistence.Rd index e151218..f7b61d8 100644 --- a/man/Persistence.Rd +++ b/man/Persistence.Rd @@ -13,7 +13,7 @@ Persistence( ft_start, ft_end = ft_start, max_ft = 10, - memb = 1, + nmemb = 1, na.action = 10, ncores = NULL ) @@ -48,7 +48,7 @@ in the case of a multi-timestep average persistence. The default value is 'ft_st For example, for decadal prediction 'max_ft' would correspond to 10 (years). The default value is 10.} -\item{memb}{An integer indicating the number of ensemble members to +\item{nmemb}{An integer indicating the number of ensemble members to generate for the persistence forecast. The default value is 1.} \item{na.action}{A function or an integer. A function (e.g., na.omit, @@ -101,11 +101,11 @@ uncertainty (prediction interval) based on Coelho et al., 2004.\cr\cr #Building an example dataset with yearly start dates from 1920 to 2009 obs1 <- 1 : (1 * 90 * 6 * 7) dim(obs1) <- c(member = 1, time = 90, lat = 6, lon = 7) -dates <- seq(1920,2009,1) -lon <- seq(0, 30, 5) -lat <- seq(0, 25, 5) -obs <- list(data = obs1, time = dates, lat = lat, lon = lon) -persist <- Persistence(obs$data, dates = dates, start = 1961, end = 2005, ft_start = 1, - memb = 40) +dates <- seq(1920, 2009, 1) +persist <- Persistence(obs1, dates = dates, start = 1961, end = 2005, ft_start = 1, + nmemb = 40) } +\author{ +Deborah Verfaillie, \email{deborah.verfaillie@bsc.es} +} -- GitLab From fdc1692816ede2ceaa5f99d7be56dc8c445135ac Mon Sep 17 00:00:00 2001 From: nperez Date: Tue, 9 Jun 2020 10:09:25 +0200 Subject: [PATCH 11/13] devtools documentation with R3.2.0 --- DESCRIPTION | 2 +- man/AnimateMap.Rd | 33 +++--------- man/Clim.Rd | 1 + man/ColorBar.Rd | 32 +++--------- man/ConfigApplyMatchingEntries.Rd | 11 ++-- man/ConfigEditDefinition.Rd | 1 + man/ConfigEditEntry.Rd | 45 ++++------------ man/ConfigFileOpen.Rd | 3 +- man/ConfigShowSimilarEntries.Rd | 17 ++---- man/ConfigShowTable.Rd | 3 +- man/Corr.Rd | 17 ++---- man/Eno.Rd | 1 + man/InsertDim.Rd | 1 + man/LeapYear.Rd | 1 + man/Load.Rd | 40 ++++---------- man/MeanDims.Rd | 1 + man/Persistence.Rd | 17 ++---- man/PlotClim.Rd | 26 +++------- man/PlotEquiMap.Rd | 86 +++++++------------------------ man/PlotLayout.Rd | 73 ++++++++------------------ man/PlotMatrix.Rd | 29 +++-------- man/PlotSection.Rd | 25 ++------- man/PlotStereoMap.Rd | 61 +++++----------------- man/RMS.Rd | 14 ++--- man/RMSSS.Rd | 11 ++-- man/Regression.Rd | 1 + man/Reorder.Rd | 1 + man/Season.Rd | 1 + man/ToyModel.Rd | 15 ++---- man/Trend.Rd | 1 + man/clim.palette.Rd | 3 +- man/s2dv-package.Rd | 39 ++++---------- man/sampleDepthData.Rd | 1 + man/sampleMap.Rd | 1 + man/sampleTimeSeries.Rd | 1 + 35 files changed, 165 insertions(+), 450 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b5de231..520a773 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,4 +41,4 @@ BugReports: https://earth.bsc.es/gitlab/es/s2dv/issues LazyData: true SystemRequirements: cdo Encoding: UTF-8 -RoxygenNote: 7.0.1 +RoxygenNote: 5.0.0 diff --git a/man/AnimateMap.Rd b/man/AnimateMap.Rd index 2ec930d..d2003ee 100644 --- a/man/AnimateMap.Rd +++ b/man/AnimateMap.Rd @@ -4,33 +4,13 @@ \alias{AnimateMap} \title{Animate Maps of Forecast/Observed Values or Scores Over Forecast Time} \usage{ -AnimateMap( - var, - lon, - lat, - toptitle = rep("", 11), - sizetit = 1, - units = "", - monini = 1, - freq = 12, - msk95lev = FALSE, - brks = NULL, - cols = NULL, - filled.continents = FALSE, - lonmin = 0, - lonmax = 360, - latmin = -90, - latmax = 90, - intlon = 20, - intlat = 30, - drawleg = TRUE, - subsampleg = 1, - colNA = "white", - equi = TRUE, +AnimateMap(var, lon, lat, toptitle = rep("", 11), sizetit = 1, units = "", + monini = 1, freq = 12, msk95lev = FALSE, brks = NULL, cols = NULL, + filled.continents = FALSE, lonmin = 0, lonmax = 360, latmin = -90, + latmax = 90, intlon = 20, intlat = 30, drawleg = TRUE, + subsampleg = 1, colNA = "white", equi = TRUE, fileout = c("output1_animvsltime.gif", "output2_animvsltime.gif", - "output3_animvsltime.gif"), - ... -) + "output3_animvsltime.gif"), ...) } \arguments{ \item{var}{Matrix of dimensions (nltime, nlat, nlon) or @@ -182,3 +162,4 @@ AnimateMap(clim$clim_exp, sampleData$lon, sampleData$lat, # More examples in s2dverification but are deleted for now } + diff --git a/man/Clim.Rd b/man/Clim.Rd index d1d3b9c..a997a7f 100644 --- a/man/Clim.Rd +++ b/man/Clim.Rd @@ -82,3 +82,4 @@ PlotClim(clim$clim_exp, clim$clim_obs, listobs = c('ERSST'), biglab = FALSE, fileout = 'tos_clim.eps') } } + diff --git a/man/ColorBar.Rd b/man/ColorBar.Rd index 6d62f15..1287b70 100644 --- a/man/ColorBar.Rd +++ b/man/ColorBar.Rd @@ -4,30 +4,13 @@ \alias{ColorBar} \title{Draws a Color Bar} \usage{ -ColorBar( - brks = NULL, - cols = NULL, - vertical = TRUE, - subsampleg = NULL, - bar_limits = NULL, - var_limits = NULL, - triangle_ends = NULL, - col_inf = NULL, - col_sup = NULL, - color_fun = clim.palette(), - plot = TRUE, - draw_ticks = TRUE, - draw_separators = FALSE, - triangle_ends_scale = 1, - extra_labels = NULL, - title = NULL, - title_scale = 1, - label_scale = 1, - tick_scale = 1, - extra_margin = rep(0, 4), - label_digits = 4, - ... -) +ColorBar(brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, + bar_limits = NULL, var_limits = NULL, triangle_ends = NULL, + col_inf = NULL, col_sup = NULL, color_fun = clim.palette(), + plot = TRUE, draw_ticks = TRUE, draw_separators = FALSE, + triangle_ends_scale = 1, extra_labels = NULL, title = NULL, + title_scale = 1, label_scale = 1, tick_scale = 1, + extra_margin = rep(0, 4), label_digits = 4, ...) } \arguments{ \item{brks}{Can be provided in two formats: @@ -192,3 +175,4 @@ cols <- c("dodgerblue4", "dodgerblue1", "forestgreen", "yellowgreen", "white", lims <- seq(-1, 1, 0.2) ColorBar(lims, cols) } + diff --git a/man/ConfigApplyMatchingEntries.Rd b/man/ConfigApplyMatchingEntries.Rd index ee4cb5a..5f0efb1 100644 --- a/man/ConfigApplyMatchingEntries.Rd +++ b/man/ConfigApplyMatchingEntries.Rd @@ -4,14 +4,8 @@ \alias{ConfigApplyMatchingEntries} \title{Apply Matching Entries To Dataset Name And Variable Name To Find Related Info} \usage{ -ConfigApplyMatchingEntries( - configuration, - var, - exp = NULL, - obs = NULL, - show_entries = FALSE, - show_result = TRUE -) +ConfigApplyMatchingEntries(configuration, var, exp = NULL, obs = NULL, + show_entries = FALSE, show_result = TRUE) } \arguments{ \item{configuration}{Configuration object obtained from ConfigFileOpen() @@ -74,3 +68,4 @@ ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } + diff --git a/man/ConfigEditDefinition.Rd b/man/ConfigEditDefinition.Rd index 223e95a..8e1e968 100644 --- a/man/ConfigEditDefinition.Rd +++ b/man/ConfigEditDefinition.Rd @@ -57,3 +57,4 @@ match_info <- ConfigApplyMatchingEntries(configuration, 'tas', [ConfigEditEntry()], [ConfigFileOpen()], [ConfigShowSimilarEntries()], [ConfigShowTable()]. } + diff --git a/man/ConfigEditEntry.Rd b/man/ConfigEditEntry.Rd index e597709..9abf3e5 100644 --- a/man/ConfigEditEntry.Rd +++ b/man/ConfigEditEntry.Rd @@ -1,46 +1,22 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigEditEntry.R \name{ConfigEditEntry} -\alias{ConfigEditEntry} \alias{ConfigAddEntry} +\alias{ConfigEditEntry} \alias{ConfigRemoveEntry} \title{Add, Remove Or Edit Entries In The Configuration} \usage{ -ConfigEditEntry( - configuration, - dataset_type, - position, - dataset_name = NULL, - var_name = NULL, - main_path = NULL, - file_path = NULL, - nc_var_name = NULL, - suffix = NULL, - varmin = NULL, - varmax = NULL -) +ConfigEditEntry(configuration, dataset_type, position, dataset_name = NULL, + var_name = NULL, main_path = NULL, file_path = NULL, + nc_var_name = NULL, suffix = NULL, varmin = NULL, varmax = NULL) -ConfigAddEntry( - configuration, - dataset_type, - position = "last", - dataset_name = ".*", - var_name = ".*", - main_path = "*", - file_path = "*", - nc_var_name = "*", - suffix = "*", - varmin = "*", - varmax = "*" -) +ConfigAddEntry(configuration, dataset_type, position = "last", + dataset_name = ".*", var_name = ".*", main_path = "*", + file_path = "*", nc_var_name = "*", suffix = "*", varmin = "*", + varmax = "*") -ConfigRemoveEntry( - configuration, - dataset_type, - dataset_name = NULL, - var_name = NULL, - position = NULL -) +ConfigRemoveEntry(configuration, dataset_type, dataset_name = NULL, + var_name = NULL, position = NULL) } \arguments{ \item{configuration}{Configuration object obtained via ConfigFileOpen() @@ -123,3 +99,4 @@ ConfigFileSave(configuration, config_file, confirm = FALSE) ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } + diff --git a/man/ConfigFileOpen.Rd b/man/ConfigFileOpen.Rd index 8669382..cf40e00 100644 --- a/man/ConfigFileOpen.Rd +++ b/man/ConfigFileOpen.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigFileOpen.R \name{ConfigFileOpen} -\alias{ConfigFileOpen} \alias{ConfigFileCreate} +\alias{ConfigFileOpen} \alias{ConfigFileSave} \title{Functions To Create Open And Save Configuration File} \usage{ @@ -194,3 +194,4 @@ ConfigFileSave(configuration, config_file, confirm = FALSE) ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } + diff --git a/man/ConfigShowSimilarEntries.Rd b/man/ConfigShowSimilarEntries.Rd index 72b77e1..b9f80ce 100644 --- a/man/ConfigShowSimilarEntries.Rd +++ b/man/ConfigShowSimilarEntries.Rd @@ -4,18 +4,10 @@ \alias{ConfigShowSimilarEntries} \title{Find Similar Entries In Tables Of Datasets} \usage{ -ConfigShowSimilarEntries( - configuration, - dataset_name = NULL, - var_name = NULL, - main_path = NULL, - file_path = NULL, - nc_var_name = NULL, - suffix = NULL, - varmin = NULL, - varmax = NULL, - n_results = 10 -) +ConfigShowSimilarEntries(configuration, dataset_name = NULL, + var_name = NULL, main_path = NULL, file_path = NULL, + nc_var_name = NULL, suffix = NULL, varmin = NULL, varmax = NULL, + n_results = 10) } \arguments{ \item{configuration}{Configuration object obtained either from @@ -87,3 +79,4 @@ ConfigShowSimilarEntries(configuration, dataset_name = "Exper", ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } + diff --git a/man/ConfigShowTable.Rd b/man/ConfigShowTable.Rd index 5e4172a..7c08053 100644 --- a/man/ConfigShowTable.Rd +++ b/man/ConfigShowTable.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigShowTable.R \name{ConfigShowTable} -\alias{ConfigShowTable} \alias{ConfigShowDefinitions} +\alias{ConfigShowTable} \title{Show Configuration Tables And Definitions} \usage{ ConfigShowTable(configuration, dataset_type, line_numbers = NULL) @@ -54,3 +54,4 @@ ConfigShowDefinitions(configuration) [ConfigEditEntry()], [ConfigFileOpen()], [ConfigShowSimilarEntries()], [ConfigShowTable()]. } + diff --git a/man/Corr.Rd b/man/Corr.Rd index a2f45b0..45eb166 100644 --- a/man/Corr.Rd +++ b/man/Corr.Rd @@ -4,19 +4,9 @@ \alias{Corr} \title{Compute the correlation coefficient between an array of forecast and their corresponding observation} \usage{ -Corr( - exp, - obs, - time_dim = "sdate", - memb_dim = "member", - comp_dim = NULL, - limits = NULL, - method = "pearson", - pval = TRUE, - conf = TRUE, - conf.lev = 0.95, - ncores = NULL -) +Corr(exp, obs, time_dim = "sdate", memb_dim = "member", comp_dim = NULL, + limits = NULL, method = "pearson", pval = TRUE, conf = TRUE, + conf.lev = 0.95, ncores = NULL) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -91,3 +81,4 @@ corr <- Corr(clim$clim_exp, clim$clim_obs, time_dim = 'ftime') # Renew the example when Ano and Smoothing is ready } + diff --git a/man/Eno.Rd b/man/Eno.Rd index 03c3b4f..32468bd 100644 --- a/man/Eno.Rd +++ b/man/Eno.Rd @@ -39,3 +39,4 @@ data[na] <- NA res <- Eno(data) } + diff --git a/man/InsertDim.Rd b/man/InsertDim.Rd index c0dd7d8..8ab628d 100644 --- a/man/InsertDim.Rd +++ b/man/InsertDim.Rd @@ -32,3 +32,4 @@ res <- InsertDim(InsertDim(a, posdim = 2, lendim = 1, name = 'e'), 4, c(f = 2)) dim(res) } + diff --git a/man/LeapYear.Rd b/man/LeapYear.Rd index c2960f3..d261b0a 100644 --- a/man/LeapYear.Rd +++ b/man/LeapYear.Rd @@ -21,3 +21,4 @@ print(LeapYear(1991)) print(LeapYear(1992)) print(LeapYear(1993)) } + diff --git a/man/Load.Rd b/man/Load.Rd index 10c03f9..214f984 100644 --- a/man/Load.Rd +++ b/man/Load.Rd @@ -4,36 +4,15 @@ \alias{Load} \title{Loads Experimental And Observational Data} \usage{ -Load( - var, - exp = NULL, - obs = NULL, - sdates, - nmember = NULL, - nmemberobs = NULL, - nleadtime = NULL, - leadtimemin = 1, - leadtimemax = NULL, - storefreq = "monthly", - sampleperiod = 1, - lonmin = 0, - lonmax = 360, - latmin = -90, - latmax = 90, - output = "areave", - method = "conservative", - grid = NULL, - maskmod = vector("list", 15), - maskobs = vector("list", 15), - configfile = NULL, - varmin = NULL, - varmax = NULL, - silent = FALSE, - nprocs = NULL, - dimnames = NULL, - remapcells = 2, - path_glob_permissive = "partial" -) +Load(var, exp = NULL, obs = NULL, sdates, nmember = NULL, + nmemberobs = NULL, nleadtime = NULL, leadtimemin = 1, + leadtimemax = NULL, storefreq = "monthly", sampleperiod = 1, + lonmin = 0, lonmax = 360, latmin = -90, latmax = 90, + output = "areave", method = "conservative", grid = NULL, + maskmod = vector("list", 15), maskobs = vector("list", 15), + configfile = NULL, varmin = NULL, varmax = NULL, silent = FALSE, + nprocs = NULL, dimnames = NULL, remapcells = 2, + path_glob_permissive = "partial") } \arguments{ \item{var}{Short name of the variable to load. It should coincide with the @@ -895,3 +874,4 @@ sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), lonmin = -12, lonmax = 40) } } + diff --git a/man/MeanDims.Rd b/man/MeanDims.Rd index 9e98348..ed621e4 100644 --- a/man/MeanDims.Rd +++ b/man/MeanDims.Rd @@ -30,3 +30,4 @@ print(dim(MeanDims(a, 2))) print(dim(MeanDims(a, c(2, 3)))) print(dim(MeanDims(a, c('a', 'b')))) } + diff --git a/man/Persistence.Rd b/man/Persistence.Rd index f7b61d8..7990b18 100644 --- a/man/Persistence.Rd +++ b/man/Persistence.Rd @@ -4,19 +4,9 @@ \alias{Persistence} \title{Compute persistence} \usage{ -Persistence( - data, - dates, - time_dim = "time", - start, - end, - ft_start, - ft_end = ft_start, - max_ft = 10, - nmemb = 1, - na.action = 10, - ncores = NULL -) +Persistence(data, dates, time_dim = "time", start, end, ft_start, + ft_end = ft_start, max_ft = 10, nmemb = 1, na.action = 10, + ncores = NULL) } \arguments{ \item{data}{A numeric array corresponding to the observational data @@ -109,3 +99,4 @@ persist <- Persistence(obs1, dates = dates, start = 1961, end = 2005, ft_start = \author{ Deborah Verfaillie, \email{deborah.verfaillie@bsc.es} } + diff --git a/man/PlotClim.Rd b/man/PlotClim.Rd index 3023ae6..35ab17d 100644 --- a/man/PlotClim.Rd +++ b/man/PlotClim.Rd @@ -4,26 +4,11 @@ \alias{PlotClim} \title{Plots Climatologies} \usage{ -PlotClim( - exp_clim, - obs_clim = NULL, - toptitle = "", - ytitle = "", - monini = 1, - freq = 12, - limits = NULL, - listexp = c("exp1", "exp2", "exp3"), - listobs = c("obs1", "obs2", "obs3"), - biglab = FALSE, - leg = TRUE, - sizetit = 1, - fileout = "output_plotclim.eps", - width = 8, - height = 5, - size_units = "in", - res = 100, - ... -) +PlotClim(exp_clim, obs_clim = NULL, toptitle = "", ytitle = "", + monini = 1, freq = 12, limits = NULL, listexp = c("exp1", "exp2", + "exp3"), listobs = c("obs1", "obs2", "obs3"), biglab = FALSE, + leg = TRUE, sizetit = 1, fileout = "output_plotclim.eps", width = 8, + height = 5, size_units = "in", res = 100, ...) } \arguments{ \item{exp_clim}{Matrix containing the experimental data with dimensions:\cr @@ -96,3 +81,4 @@ PlotClim(clim$clim_exp, clim$clim_obs, toptitle = paste('climatologies'), } } + diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index fbd7042..cf45ead 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -4,72 +4,25 @@ \alias{PlotEquiMap} \title{Maps A Two-Dimensional Variable On A Cylindrical Equidistant Projection} \usage{ -PlotEquiMap( - var, - lon, - lat, - varu = NULL, - varv = NULL, - toptitle = NULL, - sizetit = NULL, - units = NULL, - brks = NULL, - cols = NULL, - bar_limits = NULL, - triangle_ends = NULL, - col_inf = NULL, - col_sup = NULL, - colNA = NULL, - color_fun = clim.palette(), - square = TRUE, - filled.continents = NULL, - coast_color = NULL, - coast_width = 1, - contours = NULL, - brks2 = NULL, - contour_lwd = 0.5, - contour_color = "black", - contour_lty = 1, - contour_label_scale = 1, - dots = NULL, - dot_symbol = 4, - dot_size = 1, - arr_subsamp = floor(length(lon)/30), - arr_scale = 1, - arr_ref_len = 15, - arr_units = "m/s", - arr_scale_shaft = 1, - arr_scale_shaft_angle = 1, - axelab = TRUE, - labW = FALSE, - intylat = 20, - intxlon = 20, - axes_tick_scale = 1, - axes_label_scale = 1, - drawleg = TRUE, - subsampleg = NULL, - bar_extra_labels = NULL, - draw_bar_ticks = TRUE, - draw_separators = FALSE, - triangle_ends_scale = 1, - bar_label_digits = 4, - bar_label_scale = 1, - units_scale = 1, - bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), - boxlim = NULL, - boxcol = "purple2", - boxlwd = 5, - margin_scale = rep(1, 4), - title_scale = 1, - numbfig = NULL, - fileout = NULL, - width = 8, - height = 5, - size_units = "in", - res = 100, - ... -) +PlotEquiMap(var, lon, lat, varu = NULL, varv = NULL, toptitle = NULL, + sizetit = NULL, units = NULL, brks = NULL, cols = NULL, + bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, + col_sup = NULL, colNA = NULL, color_fun = clim.palette(), + square = TRUE, filled.continents = NULL, coast_color = NULL, + coast_width = 1, contours = NULL, brks2 = NULL, contour_lwd = 0.5, + contour_color = "black", contour_lty = 1, contour_label_scale = 1, + dots = NULL, dot_symbol = 4, dot_size = 1, + arr_subsamp = floor(length(lon)/30), arr_scale = 1, arr_ref_len = 15, + arr_units = "m/s", arr_scale_shaft = 1, arr_scale_shaft_angle = 1, + axelab = TRUE, labW = FALSE, intylat = 20, intxlon = 20, + axes_tick_scale = 1, axes_label_scale = 1, drawleg = TRUE, + subsampleg = NULL, bar_extra_labels = NULL, draw_bar_ticks = TRUE, + draw_separators = FALSE, triangle_ends_scale = 1, bar_label_digits = 4, + bar_label_scale = 1, units_scale = 1, bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), boxlim = NULL, boxcol = "purple2", + boxlwd = 5, margin_scale = rep(1, 4), title_scale = 1, numbfig = NULL, + fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, + ...) } \arguments{ \item{var}{Array with the values at each cell of a grid on a regular @@ -325,3 +278,4 @@ PlotEquiMap(sampleData$mod[1, 1, 1, 1, , ], sampleData$lon, sampleData$lat, toptitle = 'Predicted sea surface temperature for Nov 1960 from 1st Nov', sizetit = 0.5) } + diff --git a/man/PlotLayout.Rd b/man/PlotLayout.Rd index 453cf2e..f01fdf9 100644 --- a/man/PlotLayout.Rd +++ b/man/PlotLayout.Rd @@ -4,52 +4,20 @@ \alias{PlotLayout} \title{Arrange and Fill Multi-Pannel Layouts With Optional Colour Bar} \usage{ -PlotLayout( - fun, - plot_dims, - var, - ..., - special_args = NULL, - nrow = NULL, - ncol = NULL, - toptitle = NULL, - row_titles = NULL, - col_titles = NULL, - bar_scale = 1, - title_scale = 1, - title_margin_scale = 1, - title_left_shift_scale = 1, - subtitle_scale = 1, - subtitle_margin_scale = 1, - brks = NULL, - cols = NULL, - drawleg = "S", - titles = NULL, - subsampleg = NULL, - bar_limits = NULL, - triangle_ends = NULL, - col_inf = NULL, - col_sup = NULL, - color_fun = clim.colors, - draw_bar_ticks = TRUE, - draw_separators = FALSE, - triangle_ends_scale = 1, - bar_extra_labels = NULL, - units = NULL, - units_scale = 1, - bar_label_scale = 1, - bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), - bar_left_shift_scale = 1, - bar_label_digits = 4, - extra_margin = rep(0, 4), - fileout = NULL, - width = NULL, - height = NULL, - size_units = "in", - res = 100, - close_device = TRUE -) +PlotLayout(fun, plot_dims, var, ..., special_args = NULL, nrow = NULL, + ncol = NULL, toptitle = NULL, row_titles = NULL, col_titles = NULL, + bar_scale = 1, title_scale = 1, title_margin_scale = 1, + title_left_shift_scale = 1, subtitle_scale = 1, + subtitle_margin_scale = 1, brks = NULL, cols = NULL, drawleg = "S", + titles = NULL, subsampleg = NULL, bar_limits = NULL, + triangle_ends = NULL, col_inf = NULL, col_sup = NULL, + color_fun = clim.colors, draw_bar_ticks = TRUE, draw_separators = FALSE, + triangle_ends_scale = 1, bar_extra_labels = NULL, units = NULL, + units_scale = 1, bar_label_scale = 1, bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), bar_left_shift_scale = 1, + bar_label_digits = 4, extra_margin = rep(0, 4), fileout = NULL, + width = NULL, height = NULL, size_units = "in", res = 100, + close_device = TRUE) } \arguments{ \item{fun}{Plot function (or name of the function) to be called on the @@ -80,12 +48,6 @@ applied to each of them. NAs can be passed to the list: a NA will yield a blank cell in the layout, which can be populated after (see .SwitchToFigure).} -\item{\dots}{Parameters to be sent to the plotting function 'fun'. If -multiple arrays are provided in 'var' and multiple functions are provided -in 'fun', the parameters provided through \dots will be sent to all the -plot functions, as common parameters. To specify concrete arguments for -each of the plot functions see parameter 'special_args'.} - \item{special_args}{List of sub-lists, each sub-list having specific extra arguments for each of the plot functions provided in 'fun'. If you want to fix a different value for each plot in the layout you can do so by @@ -202,6 +164,12 @@ the layout and a 'fileout' has been specified. This is useful to avoid closing the device when saving the layout into a file and willing to add extra elements or figures. Takes TRUE by default. Disregarded if no 'fileout' has been specified.} + +\item{\dots}{Parameters to be sent to the plotting function 'fun'. If +multiple arrays are provided in 'var' and multiple functions are provided +in 'fun', the parameters provided through \dots will be sent to all the +plot functions, as common parameters. To specify concrete arguments for +each of the plot functions see parameter 'special_args'.} } \value{ \item{brks}{ @@ -276,3 +244,4 @@ PlotLayout(PlotEquiMap, c('lat', 'lon'), sampleData$mod[1, , 1, 1, , ], titles = paste('Member', 1:15)) } + diff --git a/man/PlotMatrix.Rd b/man/PlotMatrix.Rd index 5275df0..24f046d 100644 --- a/man/PlotMatrix.Rd +++ b/man/PlotMatrix.Rd @@ -4,28 +4,12 @@ \alias{PlotMatrix} \title{Function to convert any numerical table to a grid of coloured squares.} \usage{ -PlotMatrix( - var, - brks = NULL, - cols = NULL, - toptitle = NULL, - title.color = "royalblue4", - xtitle = NULL, - ytitle = NULL, - xlabels = NULL, - xvert = FALSE, - ylabels = NULL, - line = 3, - figure.width = 1, - legend = TRUE, - legend.width = 0.15, - xlab_dist = NULL, - ylab_dist = NULL, - fileout = NULL, - size_units = "px", - res = 100, - ... -) +PlotMatrix(var, brks = NULL, cols = NULL, toptitle = NULL, + title.color = "royalblue4", xtitle = NULL, ytitle = NULL, + xlabels = NULL, xvert = FALSE, ylabels = NULL, line = 3, + figure.width = 1, legend = TRUE, legend.width = 0.15, + xlab_dist = NULL, ylab_dist = NULL, fileout = NULL, size_units = "px", + res = 100, ...) } \arguments{ \item{var}{A numerical matrix containing the values to be displayed in a @@ -109,3 +93,4 @@ PlotMatrix(var = matrix(rnorm(n = 120, mean = 0.3), 10, 12), xlabels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")) } + diff --git a/man/PlotSection.Rd b/man/PlotSection.Rd index 1627339..413ef63 100644 --- a/man/PlotSection.Rd +++ b/man/PlotSection.Rd @@ -4,26 +4,10 @@ \alias{PlotSection} \title{Plots A Vertical Section} \usage{ -PlotSection( - var, - horiz, - depth, - toptitle = "", - sizetit = 1, - units = "", - brks = NULL, - cols = NULL, - axelab = TRUE, - intydep = 200, - intxhoriz = 20, - drawleg = TRUE, - fileout = NULL, - width = 8, - height = 5, - size_units = "in", - res = 100, - ... -) +PlotSection(var, horiz, depth, toptitle = "", sizetit = 1, units = "", + brks = NULL, cols = NULL, axelab = TRUE, intydep = 200, + intxhoriz = 20, drawleg = TRUE, fileout = NULL, width = 8, + height = 5, size_units = "in", res = 100, ...) } \arguments{ \item{var}{Matrix to plot with (longitude/latitude, depth) dimensions.} @@ -85,3 +69,4 @@ sampleData <- s2dv::sampleDepthData PlotSection(sampleData$mod[1, 1, 1, 1, , ], sampleData$lat, sampleData$depth, toptitle = 'temperature 1995-11 member 0') } + diff --git a/man/PlotStereoMap.Rd b/man/PlotStereoMap.Rd index 95c2f71..4b910a9 100644 --- a/man/PlotStereoMap.Rd +++ b/man/PlotStereoMap.Rd @@ -4,53 +4,19 @@ \alias{PlotStereoMap} \title{Maps A Two-Dimensional Variable On A Polar Stereographic Projection} \usage{ -PlotStereoMap( - var, - lon, - lat, - latlims = c(60, 90), - toptitle = NULL, - sizetit = NULL, - units = NULL, - brks = NULL, - cols = NULL, - bar_limits = NULL, - triangle_ends = NULL, - col_inf = NULL, - col_sup = NULL, - colNA = NULL, - color_fun = clim.palette(), - filled.continents = FALSE, - coast_color = NULL, - coast_width = 1, - dots = NULL, - dot_symbol = 4, - dot_size = 0.8, - intlat = 10, - drawleg = TRUE, - subsampleg = NULL, - bar_extra_labels = NULL, - draw_bar_ticks = TRUE, - draw_separators = FALSE, - triangle_ends_scale = 1, - bar_label_digits = 4, - bar_label_scale = 1, - units_scale = 1, - bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), - boxlim = NULL, - boxcol = "purple2", - boxlwd = 5, - margin_scale = rep(1, 4), - title_scale = 1, - numbfig = NULL, - fileout = NULL, - width = 6, - height = 5, - size_units = "in", - res = 100, - ... -) +PlotStereoMap(var, lon, lat, latlims = c(60, 90), toptitle = NULL, + sizetit = NULL, units = NULL, brks = NULL, cols = NULL, + bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, + col_sup = NULL, colNA = NULL, color_fun = clim.palette(), + filled.continents = FALSE, coast_color = NULL, coast_width = 1, + dots = NULL, dot_symbol = 4, dot_size = 0.8, intlat = 10, + drawleg = TRUE, subsampleg = NULL, bar_extra_labels = NULL, + draw_bar_ticks = TRUE, draw_separators = FALSE, triangle_ends_scale = 1, + bar_label_digits = 4, bar_label_scale = 1, units_scale = 1, + bar_tick_scale = 1, bar_extra_margin = rep(0, 4), boxlim = NULL, + boxcol = "purple2", boxlwd = 5, margin_scale = rep(1, 4), + title_scale = 1, numbfig = NULL, fileout = NULL, width = 6, + height = 5, size_units = "in", res = 100, ...) } \arguments{ \item{var}{Array with the values at each cell of a grid on a regular @@ -217,3 +183,4 @@ y <- seq(from = -90, to = 90, length.out = 50) PlotStereoMap(data, x, y, latlims = c(60, 90), brks = 50, toptitle = "This is the title") } + diff --git a/man/RMS.Rd b/man/RMS.Rd index 7aa8f5a..ac54686 100644 --- a/man/RMS.Rd +++ b/man/RMS.Rd @@ -4,17 +4,8 @@ \alias{RMS} \title{Compute root mean square error} \usage{ -RMS( - exp, - obs, - time_dim = "sdate", - memb_dim = "member", - comp_dim = NULL, - limits = NULL, - conf = TRUE, - conf.lev = 0.95, - ncores = NULL -) +RMS(exp, obs, time_dim = "sdate", memb_dim = "member", comp_dim = NULL, + limits = NULL, conf = TRUE, conf.lev = 0.95, ncores = NULL) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -84,3 +75,4 @@ The confidence interval is computed by the chi2 distribution.\cr # Renew example when Ano and Smoothing are ready } + diff --git a/man/RMSSS.Rd b/man/RMSSS.Rd index fd4a03b..3b9c1be 100644 --- a/man/RMSSS.Rd +++ b/man/RMSSS.Rd @@ -4,14 +4,8 @@ \alias{RMSSS} \title{Compute root mean square error skill score} \usage{ -RMSSS( - exp, - obs, - time_dim = "sdate", - memb_dim = "member", - pval = TRUE, - ncores = NULL -) +RMSSS(exp, obs, time_dim = "sdate", memb_dim = "member", pval = TRUE, + ncores = NULL) } \arguments{ \item{exp}{A named numeric array of experimental data which contains at least @@ -68,3 +62,4 @@ obs <- array(rnorm(6), dim = c(time = 3, member = 2, dat = 1)) res <- RMSSS(exp, obs, time_dim = 'time') } + diff --git a/man/Regression.Rd b/man/Regression.Rd index a1bac32..4faafc1 100644 --- a/man/Regression.Rd +++ b/man/Regression.Rd @@ -92,3 +92,4 @@ res1 <- Regression(datay, datax, formula = y~poly(x, 2, raw = TRUE)) res2 <- Regression(datay, datax, conf.lev = 0.9) } + diff --git a/man/Reorder.Rd b/man/Reorder.Rd index 8748aaf..0afa07e 100644 --- a/man/Reorder.Rd +++ b/man/Reorder.Rd @@ -26,3 +26,4 @@ Reorder the dimension order of a multi-dimensional array dat2 <- array(c(1:10), dim = c(2, 1, 5)) print(dim(Reorder(dat2, c(2, 1, 3)))) } + diff --git a/man/Season.Rd b/man/Season.Rd index 39fd4c5..cb10dee 100644 --- a/man/Season.Rd +++ b/man/Season.Rd @@ -53,3 +53,4 @@ dat2[na] <- NA res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2) res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2, na.rm = FALSE) } + diff --git a/man/ToyModel.Rd b/man/ToyModel.Rd index ee7a98e..379ed3b 100644 --- a/man/ToyModel.Rd +++ b/man/ToyModel.Rd @@ -7,18 +7,8 @@ components of a forecast: (1) predictabiltiy (2) forecast error (3) non-stationarity and (4) ensemble generation. The forecast can be computed for real observations or observations generated artifically.} \usage{ -ToyModel( - alpha = 0.1, - beta = 0.4, - gamma = 1, - sig = 1, - trend = 0, - nstartd = 30, - nleadt = 4, - nmemb = 10, - obsini = NULL, - fxerr = NULL -) +ToyModel(alpha = 0.1, beta = 0.4, gamma = 1, sig = 1, trend = 0, + nstartd = 30, nleadt = 4, nmemb = 10, obsini = NULL, fxerr = NULL) } \arguments{ \item{alpha}{Predicabiltiy of the forecast on the observed residuals @@ -130,3 +120,4 @@ toyforecast <- ToyModel(alpha = a, beta = b, gamma = g, nmemb = nm, # } } + diff --git a/man/Trend.Rd b/man/Trend.Rd index 2c0eb43..a641041 100644 --- a/man/Trend.Rd +++ b/man/Trend.Rd @@ -80,3 +80,4 @@ months_between_startdates <- 60 trend <- Trend(sampleData$obs, polydeg = 2, interval = months_between_startdates) } + diff --git a/man/clim.palette.Rd b/man/clim.palette.Rd index 5d17947..d912f47 100644 --- a/man/clim.palette.Rd +++ b/man/clim.palette.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/clim.palette.R \name{clim.palette} -\alias{clim.palette} \alias{clim.colors} +\alias{clim.palette} \title{Generate Climate Color Palettes} \usage{ clim.palette(palette = "bluered") @@ -30,3 +30,4 @@ cols <- clim.colors(20) ColorBar(lims, cols) } + diff --git a/man/s2dv-package.Rd b/man/s2dv-package.Rd index 809066a..7151e84 100644 --- a/man/s2dv-package.Rd +++ b/man/s2dv-package.Rd @@ -4,37 +4,20 @@ \name{s2dv-package} \alias{s2dv} \alias{s2dv-package} -\title{s2dv: A Set of Common Tools for Seasonal to Decadal Verification} +\title{A Set of Common Tools for Seasonal to Decadal Verification} \description{ -The advanced version of package 's2dverification'. It is - intended for 'seasonal to decadal' (s2d) climate forecast verification, but - it can also be used in other kinds of forecasts or general climate analysis. - This package is specially designed for the comparison between the experimental - and observational datasets. The functionality of the included functions covers - from data retrieval, data post-processing, skill scores against observation, - to visualization. Compared to 's2dverification', 's2dv' is more compatible - with the package 'startR', able to use multiple cores for computation and - handle multi-dimensional arrays with a higher flexibility. +The advanced version of package 's2dverification'. It is intended +for 'seasonal to decadal' (s2d) climate forecast verification, but it can +also be used in other kinds of forecasts or general climate analysis. This +package is specially designed for the comparison between the experimental and +observational datasets. The functionality of the included functions covers +from data retrieval, data post-processing, skill scores against observation, to +visualization. Compared to 's2dverification', 's2dv' is more compatible with the +package 'startR', able to use multiple cores for computation and handle multi- +dimensional arrays with a higher flexibility. } \references{ \url{https://earth.bsc.es/gitlab/es/s2dverification/} -} -\seealso{ -Useful links: -\itemize{ - \item \url{https://earth.bsc.es/gitlab/es/s2dv/} - \item Report bugs at \url{https://earth.bsc.es/gitlab/es/s2dv/issues} -} - -} -\author{ -\strong{Maintainer}: An-Chi Ho \email{an.ho@bsc.es} - -Authors: -\itemize{ - \item BSC-CNS [copyright holder] - \item Nuria Perez-Zanon \email{nuria.perez@bsc.es} -} - } \keyword{internal} + diff --git a/man/sampleDepthData.Rd b/man/sampleDepthData.Rd index 77e4a7a..869af86 100644 --- a/man/sampleDepthData.Rd +++ b/man/sampleDepthData.Rd @@ -28,3 +28,4 @@ variable 'tos', i.e. sea surface temperature, from the decadal climate prediction experiment run at IC3 in the context of the CMIP5 project.\cr Its name within IC3 local database is 'i00k'. } + diff --git a/man/sampleMap.Rd b/man/sampleMap.Rd index eaf8aa5..651d185 100644 --- a/man/sampleMap.Rd +++ b/man/sampleMap.Rd @@ -43,3 +43,4 @@ sampleData <- Load('tos', list(exp), list(obs), startDates, } Check the documentation on 'Load()' in the package 's2dv' for more information. } + diff --git a/man/sampleTimeSeries.Rd b/man/sampleTimeSeries.Rd index 05a8e79..280277e 100644 --- a/man/sampleTimeSeries.Rd +++ b/man/sampleTimeSeries.Rd @@ -47,3 +47,4 @@ sampleData <- Load('tos', list(exp), list(obs), startDates, } Check the documentation on 'Load()' in the package 's2dv' for more information. } + -- GitLab From c7c64214601f3a248e4511847cdb07a5651e152b Mon Sep 17 00:00:00 2001 From: Deborah Verfaillie Date: Tue, 28 Jul 2020 11:36:04 +0200 Subject: [PATCH 12/13] Removing checks for start and end in Persistence --- R/Persistence.R | 61 ++++++++++++++++++++++++------------------------- 1 file changed, 30 insertions(+), 31 deletions(-) diff --git a/R/Persistence.R b/R/Persistence.R index f59a8c6..cc09b86 100644 --- a/R/Persistence.R +++ b/R/Persistence.R @@ -4,6 +4,8 @@ #'observational data along the time dimension, with a measure of forecast #'uncertainty (prediction interval) based on Coelho et al., 2004.\cr\cr #' +#'@author Deborah Verfaillie, \email{deborah.verfaillie@bsc.es} +#' #'@param data A numeric array corresponding to the observational data #' including the time dimension along which the autoregression is computed. The data #' should start at least 40 time steps (years or days) before 'start'. @@ -25,7 +27,7 @@ #'@param max_ft An integer indicating the maximum forecast time possible for 'data'. #' For example, for decadal prediction 'max_ft' would correspond to 10 (years). The #' default value is 10. -#'@param memb An integer indicating the number of ensemble members to +#'@param nmemb An integer indicating the number of ensemble members to #' generate for the persistence forecast. The default value is 1. #'@param na.action A function or an integer. A function (e.g., na.omit, #' na.exclude, na.fail, na.pass) indicates what should happen when the data @@ -71,19 +73,16 @@ #'#Building an example dataset with yearly start dates from 1920 to 2009 #'obs1 <- 1 : (1 * 90 * 6 * 7) #'dim(obs1) <- c(member = 1, time = 90, lat = 6, lon = 7) -#'dates <- seq(1920,2009,1) -#'lon <- seq(0, 30, 5) -#'lat <- seq(0, 25, 5) -#'obs <- list(data = obs1, time = dates, lat = lat, lon = lon) -#'persist <- Persistence(obs$data, dates = dates, start = 1961, end = 2005, ft_start = 1, -#' memb = 40) +#'dates <- seq(1920, 2009, 1) +#'persist <- Persistence(obs1, dates = dates, start = 1961, end = 2005, ft_start = 1, +#' nmemb = 40) #' #'@rdname Persistence #'@import multiApply #'@import abind #'@export Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, - ft_end = ft_start, max_ft = 10, memb = 1, na.action = 10, + ft_end = ft_start, max_ft = 10, nmemb = 1, na.action = 10, ncores = NULL) { # Check inputs @@ -113,23 +112,23 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, stop("Parameter 'time_dim' is not found in 'data' dimension.") } ## start - if (!is.numeric(start) | start %% 1 != 0 | start < 0 | - length(start) > 1 | start < 1850 | start > 2020) { - stop("Parameter 'start' must be an integer between 1850 and 2020.") - } - if (start < dates[1] + 40) { - stop("Parameter 'start' must start at least 40 years after the - first start date of 'data'.") - } +# if (!is.numeric(start) | start %% 1 != 0 | start < 0 | +# length(start) > 1 | start < 1850 | start > 2020) { +# stop("Parameter 'start' must be an integer between 1850 and 2020.") +# } +# if (start < dates[1] + 40) { +# stop("Parameter 'start' must start at least 40 time steps after the +# first start date of 'data'.") +# } ## end - if (!is.numeric(end) | end %% 1 != 0 | end < 0 | - length(end) > 1 | end < 1850 | end > 2020) { - stop("Parameter 'end' must be an integer between 1850 and 2020.") - } - if (end > dates[length(dates)] + 1) { - stop("Parameter 'end' must end at most 1 year after the - last start date of 'data'.") - } +# if (!is.numeric(end) | end %% 1 != 0 | end < 0 | +# length(end) > 1 | end < 1850 | end > 2020) { +# stop("Parameter 'end' must be an integer between 1850 and 2020.") +# } +# if (end > dates[length(dates)] + 1) { +# stop("Parameter 'end' must end at most 1 time step after the +# last start date of 'data'.") +# } ## ft_start if (!is.numeric(ft_start) | ft_start %% 1 != 0 | ft_start < 0 | length(ft_start) > 1) { @@ -146,8 +145,8 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, stop("Parameter 'max_ft' must be a positive integer.") } ## memb - if (!is.numeric(memb) | memb %% 1 != 0 | memb < 0 | - length(memb) > 1) { + if (!is.numeric(nmemb) | nmemb %% 1 != 0 | nmemb < 0 | + length(nmemb) > 1) { stop("Parameter 'memb' must be a positive integer.") } ## na.action @@ -187,7 +186,7 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, ft_start = ft_start, ft_end = ft_end, max_ft = max_ft, - memb = memb, + nmemb = nmemb, na.action = na.action, ncores = ncores) @@ -197,15 +196,15 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, # start/end is a year (4-digit numeric) or a date (ISOdate) # ft_start/ft_end are indices .Persistence <- function(x, dates, time_dim = 'time', start, end, ft_start = 1, - ft_end = 1, max_ft = 10, memb = 1, na.action = 10) { + ft_end = 1, max_ft = 10, nmemb = 1, na.action = 10) { tm <- end - start + 1 max_date <- match(start, dates) interval <- ft_end - ft_start persistence.mean <- persistence.predint <- NULL AR.slope <- AR.intercept <- AR.lowCI <- AR.highCI <- NULL - persistence <- matrix(NA, nrow = memb, ncol = tm) - names(dim(persistence)) <- c('member', time_dim) + persistence <- matrix(NA, nrow = nmemb, ncol = tm) + names(dim(persistence)) <- c('realization', time_dim) for (sdate in tm:1){ min_y = max_ft + ft_start @@ -248,7 +247,7 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, AR.intercept[sdate] <- b AR.lowCI[sdate] <- reg$regression[1] AR.highCI[sdate] <- reg$regression[3] - persistence[ ,sdate] <- rnorm(n = memb, mean = persistence.mean[sdate], + persistence[ ,sdate] <- rnorm(n = nmemb, mean = persistence.mean[sdate], sd = persistence.predint[sdate]) } -- GitLab From c8e5cfc4258b50ba0a724818357d4229dbf26a98 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 5 Nov 2020 10:03:54 +0100 Subject: [PATCH 13/13] Review Persistence and create unit test --- NAMESPACE | 2 - R/Persistence.R | 70 ++++++++++---------- man/Persistence.Rd | 45 ++++++------- man/s2dv-package.Rd | 18 +++--- tests/testthat/test-Persistence.R | 103 ++++++++++++++++++++++++++++++ 5 files changed, 169 insertions(+), 69 deletions(-) create mode 100644 tests/testthat/test-Persistence.R diff --git a/NAMESPACE b/NAMESPACE index 2062869..fb340b8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,7 +25,6 @@ export(Load) export(MeanDims) export(Persistence) export(PlotAno) ->>>>>>> master export(PlotClim) export(PlotEquiMap) export(PlotLayout) @@ -44,7 +43,6 @@ export(Trend) export(clim.colors) export(clim.palette) import(GEOmap) -import(abind) import(bigmemory) import(geomapdata) import(graphics) diff --git a/R/Persistence.R b/R/Persistence.R index cc09b86..88e15d2 100644 --- a/R/Persistence.R +++ b/R/Persistence.R @@ -4,35 +4,34 @@ #'observational data along the time dimension, with a measure of forecast #'uncertainty (prediction interval) based on Coelho et al., 2004.\cr\cr #' -#'@author Deborah Verfaillie, \email{deborah.verfaillie@bsc.es} -#' #'@param data A numeric array corresponding to the observational data -#' including the time dimension along which the autoregression is computed. The data -#' should start at least 40 time steps (years or days) before 'start'. -#'@param dates A sequence of 4-digit integers (YYYY) or dates (YYYY-MM-DD) indicating -#' the dates available in the observations. +#' including the time dimension along which the autoregression is computed. +#' The data should start at least 40 time steps (years or days) before +#' 'start'. +#'@param dates A sequence of 4-digit integers (YYYY) or dates (YYYY-MM-DD) +#' indicating the dates available in the observations. #'@param time_dim A character string indicating the dimension along which to #' compute the autoregression. The default value is 'time'. -#'@param start A 4-digit integer (YYYY) or a date in the ISOdate format (YYYY-MM-DD) -#' indicating the first start date of the persistence forecast. -#'@param end A 4-digit integer (YYYY) or a date in the ISOdate format (YYYY-MM-DD) -#' indicating the last start date of the persistence forecast. -#'@param ft_start An integer indicating the forecast time for which -#' the persistence forecast should be calculated, or the first forecast -#' time of the average forecast times for which persistence should be -#' calculated. -#'@param ft_end An (optional) integer indicating the last forecast time -#' of the average forecast times for which persistence should be calculated -#' in the case of a multi-timestep average persistence. The default value is 'ft_start'. -#'@param max_ft An integer indicating the maximum forecast time possible for 'data'. -#' For example, for decadal prediction 'max_ft' would correspond to 10 (years). The -#' default value is 10. -#'@param nmemb An integer indicating the number of ensemble members to -#' generate for the persistence forecast. The default value is 1. +#'@param start A 4-digit integer (YYYY) or a date in the ISOdate format +#' (YYYY-MM-DD) indicating the first start date of the persistence forecast. +#'@param end A 4-digit integer (YYYY) or a date in the ISOdate format +#' (YYYY-MM-DD) indicating the last start date of the persistence forecast. +#'@param ft_start An integer indicating the forecast time for which the +#' persistence forecast should be calculated, or the first forecast time of +#' the average forecast times for which persistence should be calculated. +#'@param ft_end An (optional) integer indicating the last forecast time of the +#' average forecast times for which persistence should be calculated in the +#' case of a multi-timestep average persistence. The default value is +#' 'ft_start'. +#'@param max_ft An integer indicating the maximum forecast time possible for +#' 'data'. For example, for decadal prediction 'max_ft' would correspond to 10 +#' (years). The default value is 10. +#'@param nmemb An integer indicating the number of ensemble members to generate +#' for the persistence forecast. The default value is 1. #'@param na.action A function or an integer. A function (e.g., na.omit, #' na.exclude, na.fail, na.pass) indicates what should happen when the data -#' contain NAs. A numeric indicates the maximum number of NA position allowed to -#' compute regression. The default value is 10. +#' contain NAs. A numeric indicates the maximum number of NA position allowed +#' to compute regression. The default value is 10. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -77,9 +76,8 @@ #'persist <- Persistence(obs1, dates = dates, start = 1961, end = 2005, ft_start = 1, #' nmemb = 40) #' -#'@rdname Persistence +#'@author Deborah Verfaillie, \email{deborah.verfaillie@bsc.es} #'@import multiApply -#'@import abind #'@export Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, ft_end = ft_start, max_ft = 10, nmemb = 1, na.action = 10, @@ -100,10 +98,6 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, if(any(is.null(names(dim(data))))| any(nchar(names(dim(data))) == 0)) { stop("Parameter 'data' must have dimension names.") } - ## dates - if (length(dates) != dim(data)[time_dim]) { - stop("Parameter 'dates' must have the same length as in 'time_dim'.") - } ## time_dim if (!is.character(time_dim) | length(time_dim) > 1) { stop("Parameter 'time_dim' must be a character string.") @@ -111,6 +105,10 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, if (!time_dim %in% names(dim(data))) { stop("Parameter 'time_dim' is not found in 'data' dimension.") } + ## dates + if (length(dates) != dim(data)[time_dim]) { + stop("Parameter 'dates' must have the same length as in 'time_dim'.") + } ## start # if (!is.numeric(start) | start %% 1 != 0 | start < 0 | # length(start) > 1 | start < 1850 | start > 2020) { @@ -144,10 +142,10 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, length(max_ft) > 1) { stop("Parameter 'max_ft' must be a positive integer.") } - ## memb - if (!is.numeric(nmemb) | nmemb %% 1 != 0 | nmemb < 0 | + ## nmemb + if (!is.numeric(nmemb) | nmemb %% 1 != 0 | nmemb <= 0 | length(nmemb) > 1) { - stop("Parameter 'memb' must be a positive integer.") + stop("Parameter 'nmemb' must be a positive integer.") } ## na.action if (!is.function(na.action) & !is.numeric(na.action)) { @@ -164,7 +162,7 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } @@ -225,7 +223,7 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, for (val_y in min_y:max_y) { tmp_y <- mean(x[val_y:(val_y + interval)]) - if (val_y == min_y){ + if (val_y == min_y) { obs_y <- tmp_y } else { obs_y <- c(obs_y, tmp_y) @@ -248,7 +246,7 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, AR.lowCI[sdate] <- reg$regression[1] AR.highCI[sdate] <- reg$regression[3] persistence[ ,sdate] <- rnorm(n = nmemb, mean = persistence.mean[sdate], - sd = persistence.predint[sdate]) + sd = persistence.predint[sdate]) } return(list(persistence = persistence, persistence.mean = persistence.mean, diff --git a/man/Persistence.Rd b/man/Persistence.Rd index 7990b18..4cbacf1 100644 --- a/man/Persistence.Rd +++ b/man/Persistence.Rd @@ -10,41 +10,42 @@ Persistence(data, dates, time_dim = "time", start, end, ft_start, } \arguments{ \item{data}{A numeric array corresponding to the observational data -including the time dimension along which the autoregression is computed. The data -should start at least 40 time steps (years or days) before 'start'.} +including the time dimension along which the autoregression is computed. +The data should start at least 40 time steps (years or days) before +'start'.} -\item{dates}{A sequence of 4-digit integers (YYYY) or dates (YYYY-MM-DD) indicating -the dates available in the observations.} +\item{dates}{A sequence of 4-digit integers (YYYY) or dates (YYYY-MM-DD) +indicating the dates available in the observations.} \item{time_dim}{A character string indicating the dimension along which to compute the autoregression. The default value is 'time'.} -\item{start}{A 4-digit integer (YYYY) or a date in the ISOdate format (YYYY-MM-DD) -indicating the first start date of the persistence forecast.} +\item{start}{A 4-digit integer (YYYY) or a date in the ISOdate format +(YYYY-MM-DD) indicating the first start date of the persistence forecast.} -\item{end}{A 4-digit integer (YYYY) or a date in the ISOdate format (YYYY-MM-DD) -indicating the last start date of the persistence forecast.} +\item{end}{A 4-digit integer (YYYY) or a date in the ISOdate format +(YYYY-MM-DD) indicating the last start date of the persistence forecast.} -\item{ft_start}{An integer indicating the forecast time for which -the persistence forecast should be calculated, or the first forecast -time of the average forecast times for which persistence should be -calculated.} +\item{ft_start}{An integer indicating the forecast time for which the +persistence forecast should be calculated, or the first forecast time of +the average forecast times for which persistence should be calculated.} -\item{ft_end}{An (optional) integer indicating the last forecast time -of the average forecast times for which persistence should be calculated -in the case of a multi-timestep average persistence. The default value is 'ft_start'.} +\item{ft_end}{An (optional) integer indicating the last forecast time of the +average forecast times for which persistence should be calculated in the +case of a multi-timestep average persistence. The default value is +'ft_start'.} -\item{max_ft}{An integer indicating the maximum forecast time possible for 'data'. -For example, for decadal prediction 'max_ft' would correspond to 10 (years). The -default value is 10.} +\item{max_ft}{An integer indicating the maximum forecast time possible for +'data'. For example, for decadal prediction 'max_ft' would correspond to 10 +(years). The default value is 10.} -\item{nmemb}{An integer indicating the number of ensemble members to -generate for the persistence forecast. The default value is 1.} +\item{nmemb}{An integer indicating the number of ensemble members to generate +for the persistence forecast. The default value is 1.} \item{na.action}{A function or an integer. A function (e.g., na.omit, na.exclude, na.fail, na.pass) indicates what should happen when the data -contain NAs. A numeric indicates the maximum number of NA position allowed to -compute regression. The default value is 10.} +contain NAs. A numeric indicates the maximum number of NA position allowed +to compute regression. The default value is 10.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} diff --git a/man/s2dv-package.Rd b/man/s2dv-package.Rd index 7151e84..71e5d16 100644 --- a/man/s2dv-package.Rd +++ b/man/s2dv-package.Rd @@ -6,15 +6,15 @@ \alias{s2dv-package} \title{A Set of Common Tools for Seasonal to Decadal Verification} \description{ -The advanced version of package 's2dverification'. It is intended -for 'seasonal to decadal' (s2d) climate forecast verification, but it can -also be used in other kinds of forecasts or general climate analysis. This -package is specially designed for the comparison between the experimental and -observational datasets. The functionality of the included functions covers -from data retrieval, data post-processing, skill scores against observation, to -visualization. Compared to 's2dverification', 's2dv' is more compatible with the -package 'startR', able to use multiple cores for computation and handle multi- -dimensional arrays with a higher flexibility. +The advanced version of package 's2dverification'. It is +intended for 'seasonal to decadal' (s2d) climate forecast verification, but +it can also be used in other kinds of forecasts or general climate analysis. +This package is specially designed for the comparison between the experimental +and observational datasets. The functionality of the included functions covers +from data retrieval, data post-processing, skill scores against observation, +to visualization. Compared to 's2dverification', 's2dv' is more compatible +with the package 'startR', able to use multiple cores for computation and +handle multi-dimensional arrays with a higher flexibility. } \references{ \url{https://earth.bsc.es/gitlab/es/s2dverification/} diff --git a/tests/testthat/test-Persistence.R b/tests/testthat/test-Persistence.R new file mode 100644 index 0000000..a75c518 --- /dev/null +++ b/tests/testthat/test-Persistence.R @@ -0,0 +1,103 @@ +context("s2dv::Persistence tests") + +############################################## + set.seed(1) + dat1 <- array(rnorm(540), dim = c(member = 1, time = 90, lat = 2, lon = 3)) + dates1 <- seq(1920, 2009, 1) + +############################################## +test_that("1. Input checks", { + + expect_error( + Persistence(c()), + "Parameter 'data' cannot be NULL." + ) + expect_error( + Persistence(data = 'a'), + "Parameter 'data' must be a numeric array." + ) + expect_error( + Persistence(data = array(1:10, dim = c(2, 5))), + "Parameter 'data' must have dimension names." + ) + expect_error( + Persistence(data = dat1, dates = seq(1900, 2009, 1)), + "Parameter 'dates' must have the same length as in 'time_dim'." + ) + expect_error( + Persistence(data = dat1, dates = dates1, time_dim = 12), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + Persistence(data = dat1, dates = dates1, time_dim = 'ftime'), + "Parameter 'time_dim' is not found in 'data' dimension." + ) + expect_error( + Persistence(data = dat1, dates = dates1, start = 1961, end = 2005, ft_start = 0.5), + "Parameter 'ft_start' must be a positive integer." + ) + expect_error( + Persistence(data = dat1, dates = dates1, start = 1961, end = 2005, ft_start = 1, + ft_end = 12), + "Parameter 'ft_end' must be a positive integer below 'max_ft'." + ) + expect_error( + Persistence(data = dat1, dates = dates1, start = 1961, end = 2005, ft_start = 1, + ft_end = 12, max_ft = 13.5), + "Parameter 'max_ft' must be a positive integer." + ) + expect_error( + Persistence(data = dat1, dates = dates1, start = 1961, end = 2005, ft_start = 1, + nmemb = 0), + "Parameter 'nmemb' must be a positive integer." + ) + + expect_error( + Persistence(data = dat1, dates = dates1, start = 1961, end = 2005, ft_start = 1, + na.action = T), + paste0("Parameter 'na.action' must be a function for NA values or ", + "a numeric indicating the number of NA values allowed ", + "before returning NA.") + ) + expect_error( + Persistence(data = dat1, dates = dates1, start = 1961, end = 2005, ft_start = 1, + ncores = 0), + "Parameter 'ncores' must be a positive integer." + ) + +}) + +############################################## +test_that("2. Output checks: dat1", { + res <- Persistence(dat1, dates = dates1, start = 1961, end = 2005, ft_start = 1) + + expect_equal( + names(res), + c('persistence', 'persistence.mean', 'persistence.predint', 'AR.slope', + 'AR.intercept', 'AR.lowCI', 'AR.highCI') + ) + expect_equal( + dim(res$persistence), + c(realization = 1, time = 45, member = 1, lat = 2, lon = 3) + ) + expect_equal( + dim(res$persistence.mean), + c(45, member = 1, lat = 2, lon = 3) + ) + expect_equal( + mean(res$persistence), + 0.03481641, + tolerance = 0.00001 + ) + expect_equal( + range(res$persistence), + c(-1.025059, 1.042929), + tolerance = 0.0001 + ) + expect_equal( + range(res$AR.slope), + c(-0.2636489, 0.2334777), + tolerance = 0.0001 + ) +}) + -- GitLab