From 83540063c59b0df46a42fb60603aa8bdf86b00af Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 3 Feb 2020 10:26:33 +0100 Subject: [PATCH] Change the usage of .aperm2() to Reorder() --- R/Clim.R | 18 +++++++++--------- R/InsertDim.R | 6 +++--- R/PlotLayout.R | 2 +- R/RMS.R | 2 +- R/RMSSS.R | 6 +++--- R/Regression.R | 2 +- 6 files changed, 18 insertions(+), 18 deletions(-) diff --git a/R/Clim.R b/R/Clim.R index 283437d..f8299a3 100644 --- a/R/Clim.R +++ b/R/Clim.R @@ -158,7 +158,7 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), name_exp <- names(dim(exp)) name_obs <- names(dim(obs)) order_obs <- match(name_exp, name_obs) - obs <- s2dverification:::.aperm2(obs, order_obs) + obs <- Reorder(obs, order_obs) ############################### @@ -292,8 +292,8 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), trend_exp <- array(unlist(trend_exp), dim = c(dim(exp)[-1], dim(exp)[1])) trend_obs <- array(unlist(trend_obs), dim = c(dim(exp)[-1], dim(exp)[1])) len <- length(dim(exp)) - trend_exp <- s2dverification:::.aperm2(trend_exp, c(len, 1:(len - 1))) - trend_obs <- s2dverification:::.aperm2(trend_obs, c(len, 1:(len - 1))) + trend_exp <- Reorder(trend_exp, c(len, 1:(len - 1))) + trend_obs <- Reorder(trend_obs, c(len, 1:(len - 1))) clim_obs_mean <- mean(apply(clim_obs, 1, mean)) #average out dat_dim, get a number clim_obs_mean <- array(clim_obs_mean, dim = dim(exp)) #enlarge it for the next line @@ -352,11 +352,11 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), slope_exp <- Subset(tmp_exp, 1, 2, drop = 'selected') #[dat_dim, ftime] intercept_obs <- array(tmp_obs_mean[1, ], dim = c(dim_ftime, dim_dat)) #[ftime, dat_dim] exp - intercept_obs <- s2dverification:::.aperm2(intercept_obs, c(2:length(dim(intercept_obs)), 1)) + intercept_obs <- Reorder(intercept_obs, c(2:length(dim(intercept_obs)), 1)) #[dat_dim, ftime] exp slope_obs <- array(tmp_obs_mean[2, ], dim = c(dim_ftime, dim_dat)) #[ftime, dat_dim] exp - slope_obs <- s2dverification:::.aperm2(slope_obs, c(2:length(dim(slope_obs)), 1)) + slope_obs <- Reorder(slope_obs, c(2:length(dim(slope_obs)), 1)) #[dat_dim, ftime] exp trend_exp <- list() @@ -366,7 +366,7 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), trend_exp[[jdate]] <- intercept_exp + tmp * slope_exp #[dat_dim, ftime] tmp <- array(ini_obs_mean[jdate, ], dim = c(dim_ftime, dim_dat)) #[ftime, dat_dim] - tmp <- s2dverification:::.aperm2(tmp, c(2:length(dim(tmp)), 1)) #[dat_dim, ftime] + tmp <- Reorder(tmp, c(2:length(dim(tmp)), 1)) #[dat_dim, ftime] trend_obs[[jdate]] <- intercept_obs + tmp * slope_obs } # turn list into array @@ -374,15 +374,15 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), trend_obs <- array(unlist(trend_obs), dim = c(dim(exp)[-1], dim(exp)[1])) #trend_: [dat_dim, ftime, sdate] len <- length(dim(exp)) - trend_exp <- s2dverification:::.aperm2(trend_exp, c(len, 1:(len - 1))) - trend_obs <- s2dverification:::.aperm2(trend_obs, c(len, 1:(len - 1))) + trend_exp <- Reorder(trend_exp, c(len, 1:(len - 1))) + trend_obs <- Reorder(trend_obs, c(len, 1:(len - 1))) #trend_: [sdate, dat_dim, ftime] clim_obs_mean <- apply(clim_obs, length(dim(clim_obs)), mean) #average out dat_dim, [ftime] clim_obs_mean <- array(clim_obs_mean, dim = c(dim_ftime, dim(exp)[1], dim_dat)) #[ftime, sdate, dat_dim] len <- length(dim(clim_obs_mean)) - clim_obs_mean <- s2dverification:::.aperm2(clim_obs_mean, c(2:len, 1)) + clim_obs_mean <- Reorder(clim_obs_mean, c(2:len, 1)) #[sdate, dat_dim, ftime] clim_exp <- trend_exp - trend_obs + clim_obs_mean diff --git a/R/InsertDim.R b/R/InsertDim.R index 630dada..2a28f5c 100644 --- a/R/InsertDim.R +++ b/R/InsertDim.R @@ -102,12 +102,12 @@ InsertDim <- function(data, posdim, lendim, name = NULL, ncores = NULL) { if (posdim != 1) { if (posdim < length(outdim)) { - res <- s2dverification:::.aperm2(res, c(1:(posdim - 1), length(outdim), posdim:(length(outdim) - 1))) + res <- Reorder(res, c(1:(posdim - 1), length(outdim), posdim:(length(outdim) - 1))) } else { #posdim = length(outdim) - res <- s2dverification:::.aperm2(res, c(1:(posdim - 1), length(outdim))) + res <- Reorder(res, c(1:(posdim - 1), length(outdim))) } } else { - res <- s2dverification:::.aperm2(res, c(length(outdim), 1:(length(outdim) - 1))) + res <- Reorder(res, c(length(outdim), 1:(length(outdim) - 1))) } return(res) diff --git a/R/PlotLayout.R b/R/PlotLayout.R index b5239f2..0e10c30 100644 --- a/R/PlotLayout.R +++ b/R/PlotLayout.R @@ -435,7 +435,7 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, stop("All arrays provided in parameter 'var' must have all the dimensions in 'plot_dims'.") } dim_ids <- sapply(dim_ids, function(x) which(dimnames == x)[1]) - var[[plot_array_i]] <- .aperm2(var[[plot_array_i]], c((1:length(dim(plot_array)))[-dim_ids], dim_ids)) + var[[plot_array_i]] <- Reorder(var[[plot_array_i]], c((1:length(dim(plot_array)))[-dim_ids], dim_ids)) } else { .warning(paste0("Assuming the ", plot_array_i, "th array provided in 'var' has 'plot_dims' as last dimensions (right-most).")) dims <- tail(c(rep(1, length(dim_ids)), dim(plot_array)), length(dim_ids)) diff --git a/R/RMS.R b/R/RMS.R index 1fa7417..d4555d2 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -164,7 +164,7 @@ RMS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', name_exp <- names(dim(exp)) name_obs <- names(dim(obs)) order_obs <- match(name_exp, name_obs) - obs <- s2dverification:::.aperm2(obs, order_obs) + obs <- Reorder(obs, order_obs) ############################### diff --git a/R/RMSSS.R b/R/RMSSS.R index ea5e23c..d59e0af 100644 --- a/R/RMSSS.R +++ b/R/RMSSS.R @@ -123,7 +123,7 @@ RMSSS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', name_exp <- names(dim(exp)) name_obs <- names(dim(obs)) order_obs <- match(name_exp, name_obs) - obs <- s2dverification:::.aperm2(obs, order_obs) + obs <- Reorder(obs, order_obs) ############################### @@ -172,7 +172,7 @@ RMSSS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', #rms2 above: [nobs] rms2 <- array(rms2, dim = c(nobs = n_obs, nexp = n_exp)) #rms2 above: [nobs, nexp] - rms2 <- .aperm2(rms2, c(2, 1)) + rms2 <- Reorder(rms2, c(2, 1)) #rms2 above: [nexp, nobs] # use rms1 and rms2 to calculate rmsss @@ -183,7 +183,7 @@ RMSSS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', eno1 <- Eno(dif1, time_dim) eno2 <- Eno(obs, time_dim) eno2 <- array(eno2, dim = c(nobs = n_obs, nexp = n_exp)) - eno2 <- .aperm2(eno2, c(2, 1)) + eno2 <- Reorder(eno2, c(2, 1)) } # pval diff --git a/R/Regression.R b/R/Regression.R index 1b6ae12..a0c3874 100644 --- a/R/Regression.R +++ b/R/Regression.R @@ -159,7 +159,7 @@ Regression <- function(datay, datax, time_dim = 'sdate', formula = y ~ x, name_datay <- names(dim(datay)) name_datax <- names(dim(datax)) order_datax <- match(name_datay, name_datax) - datax <- s2dverification:::.aperm2(datax, order_datax) + datax <- Reorder(datax, order_datax) ############################### -- GitLab