diff --git a/DESCRIPTION b/DESCRIPTION index 126179a2af69c234ead2c12cf6d6e562cfdd91e8..30fd237a2d6be5f375e45b55a683ffec062c0d8c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -45,4 +45,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/R/AMV.R b/R/AMV.R index 985444986e2cec5c58e8548428ce676f63f50683..1895fa6d9949f1cda46979f78c68b51ee2e63ac9 100644 --- a/R/AMV.R +++ b/R/AMV.R @@ -55,6 +55,8 @@ #'@param member_dim A character string indicating the name of the member #' dimension. The default value is 'member'. Only used if parameter 'type' is #' 'dcpp' or 'hist'. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. #' #'@return A numerical array of the AMV index with the dimensions of: #' 1) sdate, forecast year, and member (in case of decadal predictions); @@ -86,7 +88,7 @@ AMV <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lon', mask = NULL, monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, year_dim = 'year', month_dim = 'month', - member_dim = 'member') { + member_dim = 'member', ncores = NULL) { ## Input Checks # data @@ -130,6 +132,13 @@ AMV <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo stop(paste0("The longitude dimension of parameter 'data' must be the same", " length of parameter 'data_lons'.")) } + # 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.") + } + } # mask if (!is.null(mask)) { if (is.array(mask) & identical(names(dim(mask)), c(lat_dim,lon_dim)) & @@ -141,7 +150,7 @@ AMV <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo return(data) } data <- multiApply::Apply(data = data, target_dims = c(lat_dim, lon_dim), - fun = fun_mask, mask = mask)$output1 + fun = fun_mask, mask = mask, ncores = ncores)$output1 } else { stop(paste0("Parameter 'mask' must be NULL (no mask) or a numerical array ", "with c(lat_dim, lon_dim) dimensions and 0 in those grid ", @@ -209,7 +218,7 @@ AMV <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo stop("Parameter 'member_dim' is not found in 'data' dimension.") } } - + ## Regions for AMV (Doblas-Reyes et al., 2013) lat_min_1 <- 0; lat_max_1 <- 60 lon_min_1 <- 280; lon_max_1 <- 359.9 diff --git a/R/Ano.R b/R/Ano.R index 75a3edfef98ec1876c42541286532a444b3bd4d6..13ee211c106514c910835ac5d33e2aab81ae47cd 100644 --- a/R/Ano.R +++ b/R/Ano.R @@ -74,7 +74,7 @@ } ## 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.") } diff --git a/R/Clim.R b/R/Clim.R index d879fc4f4fdba572efeb4308ded28ea1ce41b799..caf96cae912d803d65cc70d173a5283e855fc71a 100644 --- a/R/Clim.R +++ b/R/Clim.R @@ -136,7 +136,7 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), } ## 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.") } @@ -172,13 +172,13 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), ## dat_dim: [dataset, member] pos[i] <- which(names(dim(obs)) == dat_dim[i]) } - outrows_exp <- MeanDims(exp, pos, na.rm = FALSE) + - MeanDims(obs, pos, na.rm = FALSE) + outrows_exp <- MeanDims(exp, pos, na.rm = FALSE, ncores = ncores) + + MeanDims(obs, pos, na.rm = FALSE, ncores = ncores) outrows_obs <- outrows_exp for (i in 1:length(pos)) { - outrows_exp <- InsertDim(outrows_exp, pos[i], dim(exp)[pos[i]]) - outrows_obs <- InsertDim(outrows_obs, pos[i], dim(obs)[pos[i]]) + outrows_exp <- InsertDim(outrows_exp, pos[i], dim(exp)[pos[i]], ncores = ncores) + outrows_obs <- InsertDim(outrows_obs, pos[i], dim(obs)[pos[i]], ncores = ncores) } exp[which(is.na(outrows_exp))] <- NA obs[which(is.na(outrows_obs))] <- NA @@ -191,7 +191,7 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), fun = .Clim, method = method, time_dim = time_dim, dat_dim = dat_dim, memb_dim = memb_dim, - memb = memb, na.rm = na.rm, + memb = memb, na.rm = na.rm, ncores_input = ncores, ncores = ncores) # Add member dimension name back if (memb) { @@ -207,7 +207,7 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), fun = .Clim, method = method, time_dim = time_dim, dat_dim = dat_dim, ftime_dim = ftime_dim, memb_dim = memb_dim, - memb = memb, na.rm = na.rm, + memb = memb, na.rm = na.rm, ncores_input = ncores, ncores = ncores) } else if (method == 'NDV') { @@ -216,7 +216,7 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), fun = .Clim, method = method, time_dim = time_dim, dat_dim = dat_dim, ftime_dim = ftime_dim, memb_dim = memb_dim, - memb = memb, na.rm = na.rm, + memb = memb, na.rm = na.rm, ncores_input = ncores, ncores = ncores) } @@ -227,7 +227,7 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), .Clim <- function(exp, obs, method = 'clim', time_dim = 'sdate', dat_dim = c('dataset', 'member'), ftime_dim = 'ftime', memb_dim = 'member', memb = TRUE, - na.rm = TRUE) { + na.rm = TRUE, ncores_input = NULL) { if (method == 'clim') { # exp: [sdate, dat_dim_exp] @@ -269,9 +269,9 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), # exp clim ##--- NEW trend ---## tmp_obs <- Trend(data = obs, time_dim = time_dim, interval = 1, - polydeg = 1, conf = FALSE)$trend + polydeg = 1, conf = FALSE, ncores = ncores_input)$trend tmp_exp <- Trend(data = exp, time_dim = time_dim, interval = 1, - polydeg = 1, conf = FALSE)$trend + polydeg = 1, conf = FALSE, ncores = ncores_input)$trend # tmp_exp: [stats, dat_dim)] tmp_obs_mean <- apply(tmp_obs, 1, mean) #average out dat_dim (dat and member) @@ -331,16 +331,16 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), # Create initial data set (i.e., only first ftime) tmp <- Subset(exp, ftime_dim, 1, drop = 'selected') - ini_exp <- InsertDim(tmp, pos_ftime, dim_ftime) #only first ftime + ini_exp <- InsertDim(tmp, pos_ftime, dim_ftime, ncores = ncores_input) #only first ftime tmp <- Subset(obs, ftime_dim, 1, drop = 'selected') - ini_obs <- InsertDim(tmp, pos_ftime, dim_ftime) #only first ftime + ini_obs <- InsertDim(tmp, pos_ftime, dim_ftime, ncores = ncores_input) #only first ftime #ini_: [sdate, dat_dim, ftime] tmp_exp <- Regression(datay = exp, datax = ini_exp, reg_dim = time_dim, na.action = na.omit, - pval = FALSE, conf = FALSE)$regression + pval = FALSE, conf = FALSE, ncores = ncores_input)$regression tmp_obs <- Regression(datay = obs, datax = ini_obs, reg_dim = time_dim, na.action = na.omit, - pval = FALSE, conf = FALSE)$regression + pval = FALSE, conf = FALSE, ncores = ncores_input)$regression #tmp_: [stats = 2, dat_dim, ftime] tmp_obs_mean <- apply(tmp_obs, c(1, length(dim(tmp_obs))), mean) #average out dat_dim (dat and member) #tmp_obs_mean: [stats = 2, ftime] diff --git a/R/Composite.R b/R/Composite.R index ebab24750a9bdf98e977ab914c134ac2f6fb0ac9..01b7acfc7491095eb680787768015c0bd36b12b6 100644 --- a/R/Composite.R +++ b/R/Composite.R @@ -157,7 +157,7 @@ Composite <- function(data, occ, time_dim = 'time', space_dim = c('lon', 'lat'), } ## 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.") } @@ -181,7 +181,7 @@ Composite <- function(data, occ, time_dim = 'time', space_dim = c('lon', 'lat'), fun = .Composite, output_dims = output_dims, occ = occ, time_dim = time_dim, space_dim = space_dim, - K = K, lag = lag, eno = eno, + K = K, lag = lag, eno = eno, ncores_input = ncores, ncores = ncores) if (!is.null(fileout)) { @@ -192,7 +192,7 @@ Composite <- function(data, occ, time_dim = 'time', space_dim = c('lon', 'lat'), } .Composite <- function(data, occ, time_dim = 'time', space_dim = c('lon', 'lat'), - K = NULL, lag = 0, eno = FALSE) { + K = NULL, lag = 0, eno = FALSE, ncores_input = NULL) { # data: [lon, lat, time] # occ: [time] if (is.null(K)) { @@ -204,12 +204,12 @@ Composite <- function(data, occ, time_dim = 'time', space_dim = c('lon', 'lat'), pval <- array(dim = c(dim(data)[1:2], composite = K)) if (eno == TRUE) { - n_tot <- Eno(data, time_dim = time_dim) + n_tot <- Eno(data, time_dim = time_dim, ncores = ncores_input) } else { n_tot <- length(occ) } - mean_tot <- MeanDims(data, dims = 3, na.rm = TRUE) + mean_tot <- MeanDims(data, dims = 3, na.rm = TRUE, ncores = ncores_input) stdv_tot <- apply(data, c(1, 2), sd, na.rm = TRUE) for (k in 1:K) { @@ -224,14 +224,14 @@ Composite <- function(data, occ, time_dim = 'time', space_dim = c('lon', 'lat'), if (eno == TRUE) { data_tmp <- data[, , indices] names(dim(data_tmp)) <- names(dim(data)) - n_k <- Eno(data_tmp, time_dim = time_dim) + n_k <- Eno(data_tmp, time_dim = time_dim, ncores = ncores_input) } else { n_k <- length(indices) } if (length(indices) == 1) { composite[, , k] <- data[, , indices] } else { - composite[, , k] <- MeanDims(data[, , indices], dims = 3, na.rm = TRUE) + composite[, , k] <- MeanDims(data[, , indices], dims = 3, na.rm = TRUE, ncores = ncores_input) } stdv_k <- apply(data[, , indices], c(1, 2), sd, na.rm = TRUE) diff --git a/R/Corr.R b/R/Corr.R index a74725f14be1990f9bb5352201f5eb3aa8d936f3..5a68cfb7b684257dc06ffa839c0350ca620f0378 100644 --- a/R/Corr.R +++ b/R/Corr.R @@ -147,7 +147,7 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', } ## 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.") } @@ -184,8 +184,8 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', } pos <- which(names(dim(obs)) == comp_dim) obs_sub <- Subset(obs, pos, list(limits[1]:limits[2])) - outrows <- is.na(MeanDims(obs_sub, pos, na.rm = FALSE)) - outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim]) + outrows <- is.na(MeanDims(obs_sub, pos, na.rm = FALSE, ncores = ncores)) + outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim], ncores = ncores) obs[which(outrows)] <- NA } @@ -194,13 +194,13 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', c(time_dim, dat_dim)), fun = .Corr, time_dim = time_dim, method = method, - pval = pval, conf = conf, conf.lev = conf.lev, + pval = pval, conf = conf, conf.lev = conf.lev, ncores_input = ncores, ncores = ncores) return(res) } .Corr <- function(exp, obs, time_dim = 'sdate', method = 'pearson', - conf = TRUE, pval = TRUE, conf.lev = 0.95) { + conf = TRUE, pval = TRUE, conf.lev = 0.95, ncores_input = NULL) { # exp: [sdate, dat_exp] # obs: [sdate, dat_obs] @@ -242,9 +242,9 @@ cor(exp[, x], obs[, i], if (method == "kendall" | method == "spearman") { tmp <- apply(obs, 2, rank) names(dim(tmp))[1] <- time_dim - eno <- Eno(tmp, time_dim) + eno <- Eno(tmp, time_dim, ncores = ncores_input) } else if (method == "pearson") { - eno <- Eno(obs, time_dim) + eno <- Eno(obs, time_dim, ncores = ncores_input) } for (i in 1:nexp) { eno_expand[i, ] <- eno diff --git a/R/Eno.R b/R/Eno.R index 9375b78bb1c7f7789ea0a71f24c9b7918374d964..8c8d16bfdf8aa4998df634b8f18b54942856ab3d 100644 --- a/R/Eno.R +++ b/R/Eno.R @@ -65,7 +65,7 @@ Eno <- function(data, time_dim = 'sdate', na.action = na.pass, ncores = NULL) { } ## 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.") } diff --git a/R/GMST.R b/R/GMST.R index c922eaec4ada4ba132f7a6793d52655f2dfbd551..4a0193a78028f1e4679ee922bf2ef6009b68b033 100644 --- a/R/GMST.R +++ b/R/GMST.R @@ -65,6 +65,8 @@ #'@param member_dim A character string indicating the name of the member #' dimension. The default value is 'member'. Only used if parameter 'type' is #' 'dcpp' or 'hist'. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. #' #'@return A numerical array of the GMST anomalies with the dimensions of: #' 1) sdate, forecast year, and member (in case of decadal predictions); @@ -111,7 +113,7 @@ GMST <- function(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_value, type, mask = NULL, lat_dim = 'lat', lon_dim = 'lon', monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, - year_dim = 'year', month_dim = 'month', member_dim = 'member') { + year_dim = 'year', month_dim = 'month', member_dim = 'member', ncores = NULL) { ## Input Checks # data_tas and data_tos @@ -243,6 +245,14 @@ GMST <- function(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_va stop("Parameter 'member_dim' is not found in 'data_tas' or 'data_tos' dimension.") } } + # 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.") + } + } + ## combination of tas and tos (data) mask_tas_tos <- function(data_tas, data_tos, mask_sea_land, sea_value) { @@ -254,7 +264,7 @@ GMST <- function(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_va data <- multiApply::Apply(data = list(data_tas, data_tos), target_dims = c(lat_dim, lon_dim), fun = mask_tas_tos, mask_sea_land = mask_sea_land, - sea_value = sea_value)$output1 + sea_value = sea_value, ncores = ncores)$output1 data <- drop(data) rm(data_tas, data_tos) @@ -266,7 +276,7 @@ GMST <- function(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_va return(data) } data <- multiApply::Apply(data = data, target_dims = c(lat_dim, lon_dim), - fun = fun_mask, mask = mask)$output1 + fun = fun_mask, mask = mask, ncores = ncores)$output1 } data <- ClimProjDiags::WeightedMean(data = data, lon = data_lons, lat = data_lats, diff --git a/R/GSAT.R b/R/GSAT.R index d76484320a9dd952f70115c94d7a24d28c0dd2e5..0c50a3460eac5d06112c7edf20483163831bf16d 100644 --- a/R/GSAT.R +++ b/R/GSAT.R @@ -50,6 +50,8 @@ #'@param member_dim A character string indicating the name of the member #' dimension. The default value is 'member'. Only used if parameter 'type' is #' 'dcpp' or 'hist'. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. #' #'@return A numerical array of the GSAT anomalies with the dimensions of: #' 1) sdate, forecast year, and member (in case of decadal predictions); @@ -81,7 +83,7 @@ GSAT <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lon', mask = NULL, monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, year_dim = 'year', month_dim = 'month', - member_dim = 'member') { + member_dim = 'member', ncores = NULL) { ## Input Checks # data @@ -125,6 +127,13 @@ GSAT <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'l stop(paste0("The longitude dimension of parameter 'data' must be the same", " length of parameter 'data_lons'.")) } + # 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.") + } + } # mask if (!is.null(mask)) { if (is.array(mask) & identical(names(dim(mask)), c(lat_dim,lon_dim)) & @@ -136,7 +145,7 @@ GSAT <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'l return(data) } data <- multiApply::Apply(data = data, target_dims = c(lat_dim, lon_dim), - fun = fun_mask, mask = mask)$output1 + fun = fun_mask, mask = mask, ncores = ncores)$output1 } else { stop(paste0("Parameter 'mask' must be NULL (no mask) or a numerical array ", "with c(lat_dim, lon_dim) dimensions and 0 in those grid ", diff --git a/R/InsertDim.R b/R/InsertDim.R index 195b8066ceeb79a29bc14a338eef5806cb314149..e2daccbf9cd59727ed874a4e47feca8adeb4c148 100644 --- a/R/InsertDim.R +++ b/R/InsertDim.R @@ -61,11 +61,10 @@ InsertDim <- function(data, posdim, lendim, name = NULL, ncores = NULL) { stop("Parameter 'name' must be a character string.") } } - ## ncores + # ncores if (!is.null(ncores)) { - if (!is.numeric(ncores)) { - stop("Parameter 'ncores' must be a positive integer.") - } else if (ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | + length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } } diff --git a/R/MeanDims.R b/R/MeanDims.R index 4b22d518cc5a7f1dab6320de16c7186115c8c6c8..cf4f929824ba6b33313adc3e2850f0f328b18d6c 100644 --- a/R/MeanDims.R +++ b/R/MeanDims.R @@ -23,6 +23,7 @@ #'a <- array(rnorm(24), dim = c(2, 3, 4)) #'MeanDims(a, 2) #'MeanDims(a, c(2, 3)) +#'@import multiApply #'@export MeanDims <- function(data, dims, na.rm = FALSE, ncores = NULL) { @@ -60,7 +61,13 @@ MeanDims <- function(data, dims, na.rm = FALSE, ncores = NULL) { if (!is.logical(na.rm) | length(na.rm) > 1) { stop("Parameter 'na.rm' must be one logical value.") } - + ## 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.") + } + } ############################### diff --git a/R/RMS.R b/R/RMS.R index c2cb8bccd5405fae4bcb31aeb35119818c3cf187..86d44619ff53302bfd5adfc4af38deb5dc7de4c0 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -143,7 +143,7 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', } ## 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.") } @@ -181,7 +181,7 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', pos <- which(names(dim(obs)) == comp_dim) obs_sub <- Subset(obs, pos, list(limits[1]:limits[2])) outrows <- is.na(MeanDims(obs_sub, pos, na.rm = FALSE)) - outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim]) + outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim], ncores = ncores) obs[which(outrows)] <- NA } @@ -190,12 +190,13 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', c(time_dim, dat_dim)), fun = .RMS, time_dim = time_dim, dat_dim = dat_dim, - conf = conf, conf.lev = conf.lev, ncores = ncores) + conf = conf, conf.lev = conf.lev, ncores_input = ncores, + ncores = ncores) return(res) } .RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', - conf = TRUE, conf.lev = 0.95) { + conf = TRUE, conf.lev = 0.95, ncores_input = NULL) { # exp: [sdate, dat_exp] # obs: [sdate, dat_obs] @@ -220,7 +221,7 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', if (conf) { #eno <- Eno(dif, 1) #count effective sample along sdate. dim = c(nexp, nobs) - eno <- Eno(dif, time_dim) #change to this line when Eno() is done + eno <- Eno(dif, time_dim, ncores = ncores_input) #change to this line when Eno() is done # conf.lower chi <- sapply(1:nobs, function(i) { diff --git a/R/RMSSS.R b/R/RMSSS.R index a00606666df797dbb441e87191f7d7d4a0ac12e1..5fa96596ebacc4a2d46ed4f9e511adf504eb3e04 100644 --- a/R/RMSSS.R +++ b/R/RMSSS.R @@ -108,7 +108,7 @@ RMSSS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', } ## 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.") } @@ -143,13 +143,14 @@ RMSSS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', c(time_dim, dat_dim)), fun = .RMSSS, time_dim = time_dim, dat_dim = dat_dim, - pval = pval, #conf = conf, conf.lev = conf.lev, + pval = pval, ncores_input = ncores, ncores = ncores) return(res) } -.RMSSS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', pval = TRUE) { +.RMSSS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', pval = TRUE, + ncores_input = NULL) { # exp: [sdate, dat_exp] # obs: [sdate, dat_obs] nexp <- as.numeric(dim(exp)[2]) @@ -189,8 +190,8 @@ RMSSS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', ## pval and conf if (pval) { - eno1 <- Eno(dif1, time_dim) - eno2 <- Eno(obs, time_dim) + eno1 <- Eno(dif1, time_dim, ncores = ncores_input) + eno2 <- Eno(obs, time_dim, ncores = ncores_input) eno2 <- array(eno2, dim = c(nobs = nobs, nexp = nexp)) eno2 <- Reorder(eno2, c(2, 1)) } diff --git a/R/RandomWalkTest.R b/R/RandomWalkTest.R index e818f57de0fe6e394d60bfbb7fdbccee9dc50946..494be6520dba4d6aedff0449b23e59a321e00732 100644 --- a/R/RandomWalkTest.R +++ b/R/RandomWalkTest.R @@ -57,7 +57,7 @@ RandomWalkTest <- function(skill_A, skill_B, time_dim = 'sdate', ncores = NULL){ stop("Parameter 'time_dim' is not found in 'skill_A' or 'skill_B' dimensions.") } if (!is.null(ncores)){ - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | length(ncores) > 1){ + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1){ stop("Parameter 'ncores' must be a positive integer.") } } diff --git a/R/Regression.R b/R/Regression.R index 8e5d8af41cb26c09ef37bff974d7584d06067a8f..244ddc729e94f8046b9c0ff1f0c47c89b08df62b 100644 --- a/R/Regression.R +++ b/R/Regression.R @@ -153,7 +153,7 @@ Regression <- function(datay, datax, reg_dim = 'sdate', formula = y ~ x, } ## 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.") } diff --git a/R/SPOD.R b/R/SPOD.R index 30527f136223cf57ce65d0c2f4495df0a4c8cada..5e8812d4561289bd7508b6962202f8619b6b50c7 100644 --- a/R/SPOD.R +++ b/R/SPOD.R @@ -53,6 +53,8 @@ #'@param member_dim A character string indicating the name of the member #' dimension. The default value is 'member'. Only used if parameter 'type' is #' 'dcpp' or 'hist'. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. #' #'@return A numerical array of the SPOD index with the dimensions of: #' 1) sdate, forecast year, and member (in case of decadal predictions); @@ -84,7 +86,7 @@ SPOD <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lon', mask = NULL, monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, year_dim = 'year', month_dim = 'month', - member_dim = 'member') { + member_dim = 'member', ncores = NULL) { ## Input Checks # data @@ -128,6 +130,13 @@ SPOD <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'l stop(paste0("The longitude dimension of parameter 'data' must be the same", " length of parameter 'data_lons'.")) } + # 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.") + } + } # mask if (!is.null(mask)) { if (is.array(mask) & identical(names(dim(mask)), c(lat_dim,lon_dim)) & @@ -139,7 +148,7 @@ SPOD <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'l return(data) } data <- multiApply::Apply(data = data, target_dims = c(lat_dim, lon_dim), - fun = fun_mask, mask = mask)$output1 + fun = fun_mask, mask = mask, ncores = ncores)$output1 } else { stop(paste0("Parameter 'mask' must be NULL (no mask) or a numerical array ", "with c(lat_dim, lon_dim) dimensions and 0 in those grid ", diff --git a/R/Season.R b/R/Season.R index 7bc5c52154adda2d6db36f1454db2a16b019d6f3..8745d26265c383041da59552c9cf4e43f87b4a6c 100644 --- a/R/Season.R +++ b/R/Season.R @@ -96,7 +96,7 @@ Season <- function(data, time_dim = 'ftime', monini, moninf, monsup, } ## 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.") } @@ -132,7 +132,7 @@ Season <- function(data, time_dim = 'ftime', monini, moninf, monsup, monini = monini, moninf = moninf, monsup = monsup, method = method, na.rm = na.rm) if (length(dim(res)) < length(dim(data))) { - res <- InsertDim(res, posdim = 1, lendim = 1, name = time_dim) + res <- InsertDim(res, posdim = 1, lendim = 1, name = time_dim, ncores = ncores) } else { names(dim(res))[1] <- time_dim } diff --git a/R/Smoothing.R b/R/Smoothing.R index b2b11c7539b49d26b0cc889e252055914f1ac0df..d5fd2a5eac95d11d7217b05d2c5b795f8792d71d 100644 --- a/R/Smoothing.R +++ b/R/Smoothing.R @@ -72,7 +72,7 @@ Smoothing <- function(data, time_dim = 'ftime', runmeanlen = 12, ncores = NULL) } ## 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.") } diff --git a/R/TPI.R b/R/TPI.R index a041c69c9be9e8ee7ef97910d25d79967bc5a334..e127ab1ccdae8347958eb92e97e827b98dc87a65 100644 --- a/R/TPI.R +++ b/R/TPI.R @@ -52,6 +52,8 @@ #'@param member_dim A character string indicating the name of the member #' dimension. The default value is 'member'. Only used if parameter 'type' is #' 'dcpp' or 'hist'. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. #' #'@return A numerical array of the TPI index with the dimensions of: #' 1) sdate, forecast year, and member (in case of decadal predictions); @@ -83,7 +85,7 @@ TPI <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lon', mask = NULL, monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, year_dim = 'year', month_dim = 'month', - member_dim = 'member') { + member_dim = 'member', ncores = NULL) { ## Input Checks # data @@ -127,6 +129,13 @@ TPI <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo stop(paste0("The longitude dimension of parameter 'data' must be the same", " length of parameter 'data_lons'.")) } + # 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.") + } + } # mask if (!is.null(mask)) { if (is.array(mask) & identical(names(dim(mask)), c(lat_dim,lon_dim)) & @@ -138,7 +147,7 @@ TPI <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo return(data) } data <- multiApply::Apply(data = data, target_dims = c(lat_dim, lon_dim), - fun = fun_mask, mask = mask)$output1 + fun = fun_mask, mask = mask, ncores = ncores)$output1 } else { stop(paste0("Parameter 'mask' must be NULL (no mask) or a numerical array ", "with c(lat_dim, lon_dim) dimensions and 0 in those grid ", diff --git a/R/Trend.R b/R/Trend.R index 4afb5237abb47ab5c7ec0e20f9ee2b9bb142fa77..211babbce7cab9ca93eaa4ecea80c869695a34e5 100644 --- a/R/Trend.R +++ b/R/Trend.R @@ -115,7 +115,7 @@ Trend <- function(data, time_dim = 'ftime', interval = 1, polydeg = 1, } ## 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.") } diff --git a/man/AMV.Rd b/man/AMV.Rd index 5aa6d3012cec89094ea1231f7e70d61c078d450f..0f816524837489f0518337b9f7fa57da2a2a4bdf 100644 --- a/man/AMV.Rd +++ b/man/AMV.Rd @@ -4,10 +4,23 @@ \alias{AMV} \title{Compute the Atlantic Multidecadal Variability (AMV) index} \usage{ -AMV(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +AMV( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member", + ncores = NULL +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -70,6 +83,9 @@ dimension. The default value is 'month'. Only used if parameter 'type' is \item{member_dim}{A character string indicating the name of the member dimension. The default value is 'member'. Only used if parameter 'type' is 'dcpp' or 'hist'.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} } \value{ A numerical array of the AMV index with the dimensions of: @@ -106,4 +122,3 @@ lon <- seq(0, 360, 10) index_dcpp <- AMV(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/AnimateMap.Rd b/man/AnimateMap.Rd index d2003ee4a385fb495d3571354a55e8623af56946..2ec930d5c964189f4c3e39ce167037c9cbe1d6fd 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/Ano.Rd b/man/Ano.Rd index 2dd4dead6f14828bf18cc108b050e53c6f3fa98c..8e423af81035c5bba6638e899f6b385279a804c9 100644 --- a/man/Ano.Rd +++ b/man/Ano.Rd @@ -41,4 +41,3 @@ PlotAno(ano_exp, ano_obs, startDates, legends = 'ERSST', biglab = FALSE, fileout = 'tos_ano.png') } } - diff --git a/man/Clim.Rd b/man/Clim.Rd index a997a7f1db2a33a5d63a4fe7219fe70af176b08f..78559bdbefc9c5253d510f2c7eee1fbc743324aa 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 = TRUE, - memb_dim = "member", na.rm = TRUE, ncores = NULL) +Clim( + exp, + obs, + time_dim = "sdate", + dat_dim = c("dataset", "member"), + method = "clim", + ftime_dim = "ftime", + memb = TRUE, + memb_dim = "member", + 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 1287b70ecba354d01441fb103b497e969a177bf9..6d62f153d89f73aae9cffea2e2ead04a66d894f2 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/Composite.Rd b/man/Composite.Rd index 64d5bfcc5f97ee75516a75fe3a5bc6937790fed2..cc21d389a4de84f7f5f7e4003579cc7008ff49d3 100644 --- a/man/Composite.Rd +++ b/man/Composite.Rd @@ -4,8 +4,17 @@ \alias{Composite} \title{Compute composites} \usage{ -Composite(data, occ, time_dim = "time", space_dim = c("lon", "lat"), - lag = 0, eno = FALSE, K = NULL, fileout = NULL, ncores = NULL) +Composite( + data, + occ, + time_dim = "time", + space_dim = c("lon", "lat"), + lag = 0, + eno = FALSE, + K = NULL, + fileout = NULL, + ncores = NULL +) } \arguments{ \item{data}{A numeric array containing two spatial and one temporal @@ -101,4 +110,3 @@ occ <- c(1, 1, 2, 2, 3, 3) res <- Composite(data, occ, time_dim = 'case', K = 4) } - diff --git a/man/ConfigApplyMatchingEntries.Rd b/man/ConfigApplyMatchingEntries.Rd index 5f0efb100dee5886b69850262cdcb54203bc77d3..ee4cb5a40bf6cc8c44ff82fff0cfecb4279ce298 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 8e1e968c8e842c471c2cc37dd44fd5284858e6c7..223e95abd08dc79547fcebdd56d154b860b69114 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 9abf3e522071ece12dec0db31e72c22c456a8c73..e597709dfa2c7a8683a716c0dad12cf4faf7c82c 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 eee183f0f87335a6404c1c0f8e975a0252c4d6d6..893900b688a343edc9c27ac4cf31cee49fa2da2c 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 b9f80ced42f8a8683939346b1f8a9616b1940e7e..72b77e1069e0249ef4194312455f56c2b070696e 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 7c08053e7e3aa21ca76a3f2ac951e05ddec0b175..5e4172a70380fdb3a980ce58d003d8515e6e7713 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 bf5575e443e13ff5a9a7d69eb166ec5045042ab3..9c20ec1111106771044f2ee30ff9e0c0cd79aba2 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", dat_dim = "dataset", comp_dim = NULL, - limits = NULL, method = "pearson", pval = TRUE, conf = TRUE, - conf.lev = 0.95, ncores = NULL) +Corr( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + 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 @@ -86,4 +96,3 @@ corr <- Corr(clim$clim_exp, clim$clim_obs, time_dim = 'ftime', dat_dim = 'member # Renew the example when Ano and Smoothing is ready } - diff --git a/man/Eno.Rd b/man/Eno.Rd index 32468bdddb048d1cf14c345ef6aedc4e37bb54d8..03c3b4fd1e11456ea2218e234de3cbfed4187c5d 100644 --- a/man/Eno.Rd +++ b/man/Eno.Rd @@ -39,4 +39,3 @@ data[na] <- NA res <- Eno(data) } - diff --git a/man/GMST.Rd b/man/GMST.Rd index 208ff75255f3fd15d87308b99be215131e55945e..80219439869581a1bebc9411310e4cc15be6898f 100644 --- a/man/GMST.Rd +++ b/man/GMST.Rd @@ -4,10 +4,26 @@ \alias{GMST} \title{Compute the Global Mean Surface Temperature (GMST) anomalies} \usage{ -GMST(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_value, type, - mask = NULL, lat_dim = "lat", lon_dim = "lon", monini = 11, - fmonth_dim = "fmonth", sdate_dim = "sdate", indices_for_clim = NULL, - year_dim = "year", month_dim = "month", member_dim = "member") +GMST( + data_tas, + data_tos, + data_lats, + data_lons, + mask_sea_land, + sea_value, + type, + mask = NULL, + lat_dim = "lat", + lon_dim = "lon", + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member", + ncores = NULL +) } \arguments{ \item{data_tas}{A numerical array indicating the surface air temperature data @@ -87,6 +103,9 @@ dimension. The default value is 'month'. Only used if parameter 'type' is \item{member_dim}{A character string indicating the name of the member dimension. The default value is 'member'. Only used if parameter 'type' is 'dcpp' or 'hist'.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} } \value{ A numerical array of the GMST anomalies with the dimensions of: @@ -134,4 +153,3 @@ index_dcpp <- GMST(data_tas = dcpp_tas, data_tos = dcpp_tos, data_lats = lat, sea_value = sea_value) } - diff --git a/man/GSAT.Rd b/man/GSAT.Rd index 9d3fbb65d61b9aa3d26edbd38a044432476ad7fa..d7fe3cf3c2f5d04eb45a0227812d8eadd242a781 100644 --- a/man/GSAT.Rd +++ b/man/GSAT.Rd @@ -4,10 +4,23 @@ \alias{GSAT} \title{Compute the Global Surface Air Temperature (GSAT) anomalies} \usage{ -GSAT(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +GSAT( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member", + ncores = NULL +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -70,6 +83,9 @@ dimension. The default value is 'month'. Only used if parameter 'type' is \item{member_dim}{A character string indicating the name of the member dimension. The default value is 'member'. Only used if parameter 'type' is 'dcpp' or 'hist'.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} } \value{ A numerical array of the GSAT anomalies with the dimensions of: @@ -101,4 +117,3 @@ lon <- seq(0, 360, 10) index_dcpp <- GSAT(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/InsertDim.Rd b/man/InsertDim.Rd index 8ab628d3eb3d99d50c94e0984aade50707b18e6e..c0dd7d861f1cdd18a025dc01daf3c06b52014f20 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 d261b0aea8d5697c7250114d7254affbca79b26c..c2960f3d4acfe71abf964738110f0901498edc60 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 214f984225c858da01f12ad9a80d8c66c373beff..10c03f94af836a709e9af17cfc409354681d6ee9 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 f2000239679377d0cd131b9fe6fa8f1a696976f6..9c874fc57975211a3b62915eb39779cf7eba4fa6 100644 --- a/man/MeanDims.Rd +++ b/man/MeanDims.Rd @@ -4,7 +4,7 @@ \alias{MeanDims} \title{Average an array along multiple dimensions} \usage{ -MeanDims(data, dims, na.rm = TRUE, ncores = NULL) +MeanDims(data, dims, na.rm = FALSE, ncores = NULL) } \arguments{ \item{data}{An array to be averaged.} @@ -39,4 +39,3 @@ History:\cr 3.0 - 2020-01 (A. Ho, \email{an.ho@bsc.es}) - Preserve dimension names } \keyword{datagen} - diff --git a/man/Persistence.Rd b/man/Persistence.Rd index 33d48682db86cecb1e87f9263bb78b34d7e1c68c..358263392df4fc16b9cf87e26db88d9402dd5449 100644 --- a/man/Persistence.Rd +++ b/man/Persistence.Rd @@ -4,9 +4,19 @@ \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 @@ -98,4 +108,3 @@ persist <- Persistence(obs1, dates = dates, start = 1961, end = 2005, ft_start = nmemb = 40) } - diff --git a/man/PlotAno.Rd b/man/PlotAno.Rd index 18bf0c903db72df4d7ff929b6f8360be5adf19ef..6591ef19f52879f38d3968450b5cc92b471f0ceb 100644 --- a/man/PlotAno.Rd +++ b/man/PlotAno.Rd @@ -4,12 +4,30 @@ \alias{PlotAno} \title{Plot Anomaly time series} \usage{ -PlotAno(exp_ano, obs_ano = NULL, sdates, toptitle = rep("", 15), - ytitle = rep("", 15), limits = NULL, legends = NULL, freq = 12, - biglab = FALSE, fill = TRUE, memb = TRUE, ensmean = TRUE, - linezero = FALSE, points = FALSE, vlines = NULL, sizetit = 1, - fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, - ...) +PlotAno( + exp_ano, + obs_ano = NULL, + sdates, + toptitle = rep("", 15), + ytitle = rep("", 15), + limits = NULL, + legends = NULL, + freq = 12, + biglab = FALSE, + fill = TRUE, + memb = TRUE, + ensmean = TRUE, + linezero = FALSE, + points = FALSE, + vlines = NULL, + sizetit = 1, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{exp_ano}{A numerical array containing the experimental data:\cr @@ -100,4 +118,3 @@ PlotAno(smooth_ano_exp, smooth_ano_obs, startDates, legends = 'ERSST', biglab = FALSE) } - diff --git a/man/PlotClim.Rd b/man/PlotClim.Rd index b62ff442b7cb6e82a4f1994a037b8f66518f70d0..9b3381edb0a11749c28c6da41ed5a0abf9a1ff11 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 = NULL, 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 = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{exp_clim}{Matrix containing the experimental data with dimensions:\cr @@ -79,4 +94,3 @@ PlotClim(clim$clim_exp, clim$clim_obs, toptitle = paste('climatologies'), listobs = c('ERSST'), biglab = FALSE, fileout = NULL) } - diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index cf45ead4b3555ba1417ebcc18d7b01140550b11c..fbd7042faf44c2629d5c49f975429f0804ff0398 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 f01fdf9ba3a823bc5c151f8eed280136f62be9fb..453cf2e924074f449efd4af697d21a60e3d5afb6 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 24f046d8d5d94170b3bda4ab0e51f6a72b9399be..5275df031e1d329fc3da932e5bd93ab19d5f45a7 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 413ef63223d806556fb1cb2a8ba42b64d9176bb2..1627339847efecf53cac6c798208eb744c2ec4af 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 4b910a90ce21857977ec676bc70d188232e78096..95c2f71de7f68fcc32ee11fd7fa8428b2d6a0d3a 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 7bd33b3ae69f711813806ff2dd266147791e8c7d..4391df47947a48b80c855d95f058d5e93034be3a 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", dat_dim = "dataset", comp_dim = NULL, - limits = NULL, conf = TRUE, conf.lev = 0.95, ncores = NULL) +RMS( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + 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 @@ -79,4 +88,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 1b8274f41c159812f639b8e580190f2ad3e0dfac..9ebcf65475512398233ccf6da90fe09289bf0388 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", dat_dim = "dataset", pval = TRUE, - ncores = NULL) +RMSSS( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + pval = TRUE, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data which contains at least @@ -66,4 +72,3 @@ obs <- array(rnorm(15), dim = c(time = 3, memb = 5, dataset = 1)) res <- RMSSS(exp, obs, time_dim = 'time') } - diff --git a/man/RandomWalkTest.Rd b/man/RandomWalkTest.Rd index 33b226fdd38740051d4a069c392c03252bbe2140..11106487e6ab0e82b7299c0f378ebbb7247d3a55 100644 --- a/man/RandomWalkTest.Rd +++ b/man/RandomWalkTest.Rd @@ -49,4 +49,3 @@ skill_B <- abs(fcst_B - reference) RandomWalkTest(skill_A = skill_A, skill_B = skill_B, time_dim = 'sdate', ncores = 1) } - diff --git a/man/Regression.Rd b/man/Regression.Rd index 4faafc1d83c57ab08f6d6fbf523e18593d89a131..8e27295175b9a357bad33c7c6ff28c09eb06ead4 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, reg_dim = "sdate", formula = y ~ x, pval = TRUE, - conf = TRUE, conf.lev = 0.95, na.action = na.omit, ncores = NULL) +Regression( + datay, + datax, + reg_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 0afa07ea27990f673828ea1d32547c2d993ffde1..8748aaf2662d81e53211e3001954cfc896428f11 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/SPOD.Rd b/man/SPOD.Rd index cbbbf1abda9a47c52bc13751d8fc1136f7502c97..0491739f7872b1558cad143afbf1300c1731df51 100644 --- a/man/SPOD.Rd +++ b/man/SPOD.Rd @@ -4,10 +4,23 @@ \alias{SPOD} \title{Compute the South Pacific Ocean Dipole (SPOD) index} \usage{ -SPOD(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +SPOD( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member", + ncores = NULL +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -70,6 +83,9 @@ dimension. The default value is 'month'. Only used if parameter 'type' is \item{member_dim}{A character string indicating the name of the member dimension. The default value is 'member'. Only used if parameter 'type' is 'dcpp' or 'hist'.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} } \value{ A numerical array of the SPOD index with the dimensions of: @@ -104,4 +120,3 @@ lon <- seq(0, 360, 10) index_dcpp <- SPOD(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/Season.Rd b/man/Season.Rd index cb10deefb8e4353a0901b0cd471efc9fd28e8106..3c1e3ffcda3ec669195e8762f1710a9ecc7855b7 100644 --- a/man/Season.Rd +++ b/man/Season.Rd @@ -4,8 +4,16 @@ \alias{Season} \title{Compute seasonal mean} \usage{ -Season(data, time_dim = "ftime", monini, moninf, monsup, method = mean, - na.rm = TRUE, ncores = NULL) +Season( + data, + time_dim = "ftime", + 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/Smoothing.Rd b/man/Smoothing.Rd index ba62ca17eab6aa023119e504b37abdae19157ea7..8d4a55871654d6159691f896bbed85434fe94da4 100644 --- a/man/Smoothing.Rd +++ b/man/Smoothing.Rd @@ -43,4 +43,3 @@ PlotAno(smooth_ano_exp, smooth_ano_obs, startDates, fileout = "tos_smoothed_ano.png") } } - diff --git a/man/TPI.Rd b/man/TPI.Rd index 6968f22e6cc4502755093ff012f39647c6561e13..3bdc17ca1965fb7301a3dd745c4f678077bf9bb0 100644 --- a/man/TPI.Rd +++ b/man/TPI.Rd @@ -4,10 +4,23 @@ \alias{TPI} \title{Compute the Tripole Index (TPI) for the Interdecadal Pacific Oscillation (IPO)} \usage{ -TPI(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +TPI( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member", + ncores = NULL +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -70,6 +83,9 @@ dimension. The default value is 'month'. Only used if parameter 'type' is \item{member_dim}{A character string indicating the name of the member dimension. The default value is 'member'. Only used if parameter 'type' is 'dcpp' or 'hist'.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} } \value{ A numerical array of the TPI index with the dimensions of: @@ -103,4 +119,3 @@ lon = seq(0, 360, 10) index_dcpp = TPI(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/ToyModel.Rd b/man/ToyModel.Rd index 379ed3bba67e39165ae85a5e41e80ce66313bbf4..ee7a98e93204383f416d1aacec019ead1ea12b66 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 a641041cd451628b948ccb0545970322e0cf1f81..d283ee652d6795f127c6853e5dfa52e9715ce2e9 100644 --- a/man/Trend.Rd +++ b/man/Trend.Rd @@ -4,8 +4,16 @@ \alias{Trend} \title{Compute the trend} \usage{ -Trend(data, time_dim = "ftime", interval = 1, polydeg = 1, conf = TRUE, - conf.lev = 0.95, pval = TRUE, ncores = NULL) +Trend( + data, + time_dim = "ftime", + interval = 1, + polydeg = 1, + conf = TRUE, + conf.lev = 0.95, + pval = TRUE, + ncores = NULL +) } \arguments{ \item{data}{An numeric array including the dimension along which the trend @@ -80,4 +88,3 @@ 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 d912f47a346c3e9a0d3255fe7fe9f1774cc1a58c..5d17947af606686801b830d29048be5a5df41790 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 cb522141db9a5c9aa5fa068ba61e4b65c80a5bc7..043b081c5295080af7072eb52c7d4115d3d28128 100644 --- a/man/s2dv-package.Rd +++ b/man/s2dv-package.Rd @@ -4,20 +4,45 @@ \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/s2dv/} } -\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} +} + +Other contributors: +\itemize{ + \item Roberto Bilbao \email{roberto.bilbao@bsc.es} [contributor] + \item Carlos Delgado \email{carlos.delgado@bsc.es} [contributor] + \item Andrea Manrique \email{andrea.manrique@bsc.es} [contributor] + \item Deborah Verfaillie \email{deborah.verfaillie@bsc.es} [contributor] +} +} +\keyword{internal} diff --git a/man/sampleDepthData.Rd b/man/sampleDepthData.Rd index 869af86eff4767dc415ecc948852362bdd7ed76e..77e4a7a290855556aa7b36f8a6c46af2e2791ca7 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 651d18597c5dbbf40a55f411d4cd2c39c6bc6fcf..eaf8aa5a686f589db7e223ccc651af29266203e6 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 280277eb9ccc2e2ae7bf6e37439d01d716b8e3d7..05a8e7980116c649d6b156a4746f16b2c45fea4e 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. } -