Commit f329134a authored by aho's avatar aho
Browse files

Merge branch 'develop-InsertDim_noApply' into 'master'

Not use Apply() in InsertDim

See merge request !47
parents 0853af53 5afb45a8
Pipeline #5080 passed with stage
in 8 minutes and 35 seconds
......@@ -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,
......
......@@ -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
}
......
......@@ -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)
}
......@@ -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
}
......
......@@ -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
}
......
......@@ -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.
}
......@@ -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.
......
......@@ -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)
}
}
......@@ -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."
# )
})
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment