From 5afb45a8f5ed26e519c0727244f720ae6c1f8968 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 17 Feb 2021 20:10:16 +0100 Subject: [PATCH] Not use Apply() in InsertDim --- R/Clim.R | 8 ++--- R/Corr.R | 2 +- R/InsertDim.R | 60 ++++++++------------------------- R/RMS.R | 2 +- R/Season.R | 2 +- man/ACC.Rd | 21 +++++++++--- man/InsertDim.Rd | 5 +-- man/PlotACC.Rd | 27 +++++++++++---- tests/testthat/test-InsertDim.R | 16 ++++----- 9 files changed, 67 insertions(+), 76 deletions(-) diff --git a/R/Clim.R b/R/Clim.R index caf96ca..0de6f82 100644 --- a/R/Clim.R +++ b/R/Clim.R @@ -177,8 +177,8 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), outrows_obs <- outrows_exp for (i in 1:length(pos)) { - 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) + outrows_exp <- InsertDim(outrows_exp, pos[i], dim(exp)[pos[i]]) + outrows_obs <- InsertDim(outrows_obs, pos[i], dim(obs)[pos[i]]) } exp[which(is.na(outrows_exp))] <- NA obs[which(is.na(outrows_obs))] <- NA @@ -331,9 +331,9 @@ 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, ncores = ncores_input) #only first ftime + ini_exp <- InsertDim(tmp, pos_ftime, dim_ftime) #only first ftime tmp <- Subset(obs, ftime_dim, 1, drop = 'selected') - ini_obs <- InsertDim(tmp, pos_ftime, dim_ftime, ncores = ncores_input) #only first ftime + ini_obs <- InsertDim(tmp, pos_ftime, dim_ftime) #only first ftime #ini_: [sdate, dat_dim, ftime] tmp_exp <- Regression(datay = exp, datax = ini_exp, reg_dim = time_dim, na.action = na.omit, diff --git a/R/Corr.R b/R/Corr.R index 14f5c58..463d5f8 100644 --- a/R/Corr.R +++ b/R/Corr.R @@ -228,7 +228,7 @@ 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, ncores = ncores)) - outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim], ncores = ncores) + outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim]) obs[which(outrows)] <- NA } diff --git a/R/InsertDim.R b/R/InsertDim.R index e2daccb..950479c 100644 --- a/R/InsertDim.R +++ b/R/InsertDim.R @@ -8,8 +8,6 @@ #'@param lendim An integer indicating the length of the new dimension. #'@param name A character string indicating the name for the new dimension. #' The default value is NULL. -#'@param ncores An integer indicating the number of cores to use for parallel -#' computation. The default value is NULL. #' #'@return An array as parameter 'data' but with the added named dimension. #' @@ -20,7 +18,7 @@ #' #'@import multiApply #'@export -InsertDim <- function(data, posdim, lendim, name = NULL, ncores = NULL) { +InsertDim <- function(data, posdim, lendim, name = NULL) { # Check inputs ## data @@ -61,54 +59,24 @@ InsertDim <- function(data, posdim, lendim, name = NULL, ncores = NULL) { stop("Parameter 'name' must be a character string.") } } - # 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 InsertDim + names(lendim) <- name - ## create output dimension - if (posdim == 1) { # first dim - outdim <- c(lendim, dim(data)) - } else { - if (posdim > length(dim(data))) { # last dim - outdim <- c(dim(data), lendim) - } else { # middle dim - outdim <- c(dim(data)[1:(posdim - 1)], lendim, dim(data)[posdim:length(dim(data))]) - } - } - - ## create output array - outvar <- array(dim = c(outdim)) - ## give temporary names for Apply(). The name will be replaced by data in the end - names(dim(outvar)) <- paste0('D', 1:length(outdim)) - names(dim(outvar))[posdim] <- name + ## Put the new dim at the end first + data <- array(data, dim = c(dim(data), lendim)) - res <- Apply(list(outvar), - margins = name, - fun = .InsertDim, - val = data, - ncores = ncores)$output1 - - if (posdim != 1) { - if (posdim < length(outdim)) { - res <- Reorder(res, c(1:(posdim - 1), length(outdim), posdim:(length(outdim) - 1))) - } else { #posdim = length(outdim) - res <- Reorder(res, c(1:(posdim - 1), length(outdim))) - } - } else { - res <- Reorder(res, c(length(outdim), 1:(length(outdim) - 1))) + ## Reorder dimension + if (posdim == 1) { + order <- c(length(dim(data)), 1:(length(dim(data)) - 1)) + data <- Reorder(data, order) + } else if (posdim == length(dim(data))) { # last dim + + } else { # middle dim + order <- c(1:(posdim - 1), length(dim(data)), posdim:(length(dim(data)) - 1)) + data <- Reorder(data, order) } - return(res) -} - -.InsertDim <- function(x, val) { - x <- val - return(x) + return(data) } diff --git a/R/RMS.R b/R/RMS.R index 86d4461..b3c8ad4 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -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], ncores = ncores) + outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim]) obs[which(outrows)] <- NA } diff --git a/R/Season.R b/R/Season.R index a1402af..d56aa16 100644 --- a/R/Season.R +++ b/R/Season.R @@ -137,7 +137,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, ncores = ncores) + res <- InsertDim(res, posdim = 1, lendim = 1, name = time_dim) } else { names(dim(res))[1] <- time_dim } diff --git a/man/ACC.Rd b/man/ACC.Rd index d48d6b8..d1389fd 100644 --- a/man/ACC.Rd +++ b/man/ACC.Rd @@ -4,10 +4,22 @@ \alias{ACC} \title{Compute the anomaly correlation coefficient between the forecast and corresponding observation} \usage{ -ACC(exp, obs, dat_dim = "dataset", space_dim = c("lat", "lon"), - avg_dim = "sdate", memb_dim = "member", lat = NULL, lon = NULL, - lonlatbox = NULL, conf = TRUE, conftype = "parametric", - conf.lev = 0.95, pval = TRUE, ncores = NULL) +ACC( + exp, + obs, + dat_dim = "dataset", + space_dim = c("lat", "lon"), + avg_dim = "sdate", + memb_dim = "member", + lat = NULL, + lon = NULL, + lonlatbox = NULL, + conf = TRUE, + conftype = "parametric", + conf.lev = 0.95, + pval = TRUE, + ncores = NULL +) } \arguments{ \item{exp}{A numeric array of experimental anomalies with named dimensions. @@ -141,4 +153,3 @@ PlotACC(res_bootstrap, startDates) Joliffe and Stephenson (2012). Forecast Verification: A Practitioner's Guide in Atmospheric Science. Wiley-Blackwell. } - diff --git a/man/InsertDim.Rd b/man/InsertDim.Rd index c0dd7d8..7a866a3 100644 --- a/man/InsertDim.Rd +++ b/man/InsertDim.Rd @@ -4,7 +4,7 @@ \alias{InsertDim} \title{Add a named dimension to an array} \usage{ -InsertDim(data, posdim, lendim, name = NULL, ncores = NULL) +InsertDim(data, posdim, lendim, name = NULL) } \arguments{ \item{data}{An array to which the additional dimension to be added.} @@ -15,9 +15,6 @@ InsertDim(data, posdim, lendim, name = NULL, ncores = NULL) \item{name}{A character string indicating the name for the new dimension. The default value is NULL.} - -\item{ncores}{An integer indicating the number of cores to use for parallel -computation. The default value is NULL.} } \value{ An array as parameter 'data' but with the added named dimension. diff --git a/man/PlotACC.Rd b/man/PlotACC.Rd index 1dbd7cf..cd2b357 100644 --- a/man/PlotACC.Rd +++ b/man/PlotACC.Rd @@ -4,11 +4,27 @@ \alias{PlotACC} \title{Plot Plumes/Timeseries Of Anomaly Correlation Coefficients} \usage{ -PlotACC(ACC, sdates, toptitle = "", sizetit = 1, ytitle = "", - limits = NULL, legends = NULL, freq = 12, biglab = FALSE, - fill = FALSE, linezero = FALSE, points = TRUE, vlines = NULL, - fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, - ...) +PlotACC( + ACC, + sdates, + toptitle = "", + sizetit = 1, + ytitle = "", + limits = NULL, + legends = NULL, + freq = 12, + biglab = FALSE, + fill = FALSE, + linezero = FALSE, + points = TRUE, + vlines = NULL, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{ACC}{An ACC array with with dimensions:\cr @@ -106,4 +122,3 @@ PlotACC(res, startDates) PlotACC(res_bootstrap, startDates) } } - diff --git a/tests/testthat/test-InsertDim.R b/tests/testthat/test-InsertDim.R index c4d3226..f3cfab8 100644 --- a/tests/testthat/test-InsertDim.R +++ b/tests/testthat/test-InsertDim.R @@ -42,14 +42,14 @@ test_that("1. Input checks", { InsertDim(1:10, posdim = 1, lendim = 1, name = 1), "Parameter 'name' must be a character string." ) - expect_error( - InsertDim(1:10, posdim = 1, lendim = 1, ncores = 'a'), - "Parameter 'ncores' must be a positive integer." - ) - expect_error( - InsertDim(1:10, posdim = 1, lendim = 1, ncores = 0), - "Parameter 'ncores' must be a positive integer." - ) +# expect_error( +# InsertDim(1:10, posdim = 1, lendim = 1, ncores = 'a'), +# "Parameter 'ncores' must be a positive integer." +# ) +# expect_error( +# InsertDim(1:10, posdim = 1, lendim = 1, ncores = 0), +# "Parameter 'ncores' must be a positive integer." +# ) }) -- GitLab