From 46380ae6f2fa277300b7b40a444db43b9e81db88 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 31 Jan 2020 15:34:53 +0100 Subject: [PATCH 1/3] Add MeanDims function --- R/MeanDims.R | 93 +++++++++++++++++++++++ man/MeanDims.Rd | 41 ++++++++++ tests/testthat/test-MeanDims.R | 132 +++++++++++++++++++++++++++++++++ 3 files changed, 266 insertions(+) create mode 100644 R/MeanDims.R create mode 100644 man/MeanDims.Rd create mode 100644 tests/testthat/test-MeanDims.R diff --git a/R/MeanDims.R b/R/MeanDims.R new file mode 100644 index 0000000..2b734ce --- /dev/null +++ b/R/MeanDims.R @@ -0,0 +1,93 @@ +#'Average an array along multiple dimensions +#' +#'This function returns the mean of an array along a set of dimensions and +#'preserves the dimension names if it has. +#' +#'@param data An array to be averaged. +#'@param dims A vector of numeric or charactor string, indicating along which +#' dimensions to average. +#'@param na.rm A logical value indicating whether to ignore NA values (TRUE) or +#' not (FALSE). +#' +#'@return An array with the same dimension as parameter 'data' except the 'dims' +#' dimensions. +#' removed. +#' +#'@keywords datagen +#'@author History:\cr +#'0.1 - 2011-04 (V. Guemas, \email{vguemas@@ic3.cat}) - Original code\cr +#'1.0 - 2013-09 (N. Manubens, \email{nicolau.manubens@@ic3.cat}) - Formatting to R CRAN\cr +#'1.1 - 2015-03 (N. Manubens, \email{nicolau.manubens@@ic3.cat}) - Improved memory usage +#'3.0 - 2020-01 (A. Ho, \email{an.ho@bsc.es}) - Preserve dimension names +#'@examples +#'a <- array(rnorm(24), dim = c(2, 3, 4)) +#'print(a) +#'print(Mean1Dim(a, 2)) +#'print(MeanListDim(a, c(2, 3))) +#'@export +MeanDims <- function(data, dims, na.rm = TRUE) { + + # Check inputs + ## data + if (is.null(data)) { + stop("Parameter 'data' cannot be NULL.") + } + if (!is.numeric(data)) { + stop("Parameter 'data' must be a numeric array.") + } + if (is.null(dim(data))) { #is vector, turn into array + data <- as.array(data) + } + ## dims + if (is.null(dims)) { + stop("Parameter 'dims' cannot be NULL.") + } + if (!is.vector(dims) | (is.vector(dims) & !is.numeric(dims) & !is.character(dims))) { + stop("Parameter 'dims' must be a vector of numeric or character string.") + } + if (is.numeric(dims)) { + if (any(dims < 1) | any(dims %% 1 != 0)) { + stop("Parameter 'dims' must be positive integers.") + } else if (any(dims > length(dim(data)))) { + stop("Parameter 'dims' exceeds the dimension length of parameter 'data'.") + } + } + if (is.character(dims)) { + if (!all(dims %in% names(dim(data)))) { + stop("Parameter 'dims' do not match the dimension names of parameter 'data'.") + } + } + ## na.rm + if (!is.logical(na.rm) | length(na.rm) > 1) { + stop("Parameter 'na.rm' must be one logical value.") + } + + + + ############################### + # Calculate MeanDims + + ## Change character dims into indices + if (is.character(dims)) { + tmp <- rep(0, length(dims)) + for (i in 1:length(dims)) { + tmp[i] <- which(names(dim(data)) == dims[i]) + } + dims <- tmp + } + + if (length(dim(data)) == 1) { + res <- mean(data, na.rm = na.rm) + } else { + + margins <- setdiff(c(1:length(dim(data))), dims) + res <- as.array(apply(data, margins, mean, na.rm = na.rm)) + if (!is.null(names(dim(data))[margins]) & is.null(names(dim(res)))) { + names(dim(res)) <- names(dim(data))[margins] + } + } + + return(res) + +} + diff --git a/man/MeanDims.Rd b/man/MeanDims.Rd new file mode 100644 index 0000000..bab7e83 --- /dev/null +++ b/man/MeanDims.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/MeanDims.R +\name{MeanDims} +\alias{MeanDims} +\title{Average an array along multiple dimensions} +\usage{ +MeanDims(data, dims, na.rm = TRUE) +} +\arguments{ +\item{data}{An array to be averaged.} + +\item{dims}{A vector of numeric or charactor string, indicating along which +dimensions to average.} + +\item{na.rm}{A logical value indicating whether to ignore NA values (TRUE) or +not (FALSE).} +} +\value{ +An array with the same dimension as parameter 'data' except the 'dims' + dimensions. + removed. +} +\description{ +This function returns the mean of an array along a set of dimensions and +preserves the dimension names if it has. +} +\examples{ +a <- array(rnorm(24), dim = c(2, 3, 4)) +print(a) +print(Mean1Dim(a, 2)) +print(MeanListDim(a, c(2, 3))) +} +\author{ +History:\cr +0.1 - 2011-04 (V. Guemas, \email{vguemas@ic3.cat}) - Original code\cr +1.0 - 2013-09 (N. Manubens, \email{nicolau.manubens@ic3.cat}) - Formatting to R CRAN\cr +1.1 - 2015-03 (N. Manubens, \email{nicolau.manubens@ic3.cat}) - Improved memory usage +3.0 - 2020-01 (A. Ho, \email{an.ho@bsc.es}) - Preserve dimension names +} +\keyword{datagen} + diff --git a/tests/testthat/test-MeanDims.R b/tests/testthat/test-MeanDims.R new file mode 100644 index 0000000..7e0f7fb --- /dev/null +++ b/tests/testthat/test-MeanDims.R @@ -0,0 +1,132 @@ +context("s2dv::MeanDims tests") + +############################################## + # dat1 + dat1 <- array(c(1:20), + dim = c(dat = 1, sdate = 5, ftime = 4)) + # dat2 + dat2 <- dat1 + set.seed(1) + na <- floor(runif(4, min = 1, max = 20)) + dat2[na] <- NA + + # dat3 + set.seed(2) + dat3 <- array(rnorm(48), dim = c(member = 2, time = 4, 2, lon = 3)) + + # dat4 + set.seed(3) + dat4 <- rnorm(10) + +############################################## +test_that("1. Input checks", { + + expect_error( + MeanDims(c()), + "Parameter 'data' cannot be NULL." + ) + expect_error( + MeanDims(data = 'a'), + "Parameter 'data' must be a numeric array." + ) + expect_error( + MeanDims(c(1:10), c()), + "Parameter 'dims' cannot be NULL." + ) + expect_error( + MeanDims(dat1, dims = list(1,2)), + "Parameter 'dims' must be a vector of numeric or character string." + ) + expect_error( + MeanDims(dat1, dims = c(TRUE, TRUE)), + "Parameter 'dims' must be a vector of numeric or character string." + ) + expect_error( + MeanDims(dat1, dims = c(0, 1)), + "Parameter 'dims' must be positive integers." + ) + expect_error( + MeanDims(dat1, dims = 5), + "Parameter 'dims' exceeds the dimension length of parameter 'data'." + ) + expect_error( + MeanDims(dat1, dims = 'lat'), + "Parameter 'dims' do not match the dimension names of parameter 'data'." + ) + expect_error( + MeanDims(dat1, dims = 'ftime', na.rm = na.omit), + "Parameter 'na.rm' must be one logical value." + ) + +}) + +############################################## +test_that("2. Output checks: dat1", { + + expect_equal( + dim(MeanDims(dat1, dims = c(1))), + c(sdate = 5, ftime = 4) + ) + expect_equal( + dim(MeanDims(dat1, dims = c(1, 3))), + c(sdate = 5) + ) + expect_equal( + dim(MeanDims(dat1, dims = c('sdate', 'ftime'))), + c(dat = 1) + ) + expect_equal( + MeanDims(dat1, dims = c('sdate'))[1:2], + c(3, 8) + ) + +}) + +############################################## +test_that("3. Output checks: dat2", { + + expect_equal( + summary(MeanDims(dat2, dims = c(1,3), na.rm = TRUE))[4], + c(Mean = 10), + tolerance = 0.01 + ) + expect_equal( + summary(MeanDims(dat2, dims = c(1,3), na.rm = FALSE))[4], + c(Mean = 11.17), + tolerance = 0.01 + ) + expect_equal( + length(which(is.na(MeanDims(dat2, dims = c(1,3), na.rm = FALSE)))), + 2 + ) + +}) + +############################################## +test_that("4. Output checks: dat3", { + + expect_equal( + dim(MeanDims(dat3, dims = c(1))), + c(time = 4, 2, lon = 3) + ) + expect_equal( + dim(MeanDims(dat3, dims = c('time', 'lon'))), + c(member = 2, 2) + ) + expect_equal( + dim(MeanDims(dat3, dims = c('time', 'lon', 'member'))), + c(a = 2, 2)[2] + ) + +}) + +############################################## +test_that("5. Output checks: dat4", { + + expect_equal( + length(MeanDims(dat4, dims = 1)), + 1 + ) +}) +############################################## + -- GitLab From e1e672fbad944a529efc506721308723c568b664 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 31 Jan 2020 15:35:16 +0100 Subject: [PATCH 2/3] Renew documentation from s2dverification to s2dv --- DESCRIPTION | 24 +++++++++++---------- NAMESPACE | 62 +---------------------------------------------------- 2 files changed, 14 insertions(+), 72 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6780c83..75743c6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ -Package: s2dverification +Package: s2dv Title: Set of Common Tools for Forecast Verification -Version: 2.8.6 +Version: 0.0.1 Authors@R: c( person("BSC-CNS", role = c("aut", "cph")), person("Virginie", "Guemas", , "virginie.guemas@bsc.es", role = "aut"), @@ -29,13 +29,15 @@ Authors@R: c( person("Ruben", "Cruz", , "ruben.cruzgarcia@bsc.es", role = "ctb"), person("Isabel", "Andreu-Burillo", , "isabel.andreu.burillo@ic3.cat", role = "ctb"), person("Ramiro", "Saurral", , "ramiro.saurral@ic3.cat", role = "ctb")) -Description: Set of tools to verify forecasts through the computation of typical - prediction scores against one or more observational datasets or reanalyses (a - reanalysis being a physical extrapolation of observations that relies on the - equations from a model, not a pure observational dataset). Intended for seasonal - to decadal climate forecasts although can be useful to verify other kinds of - forecasts. The package can be helpful in climate sciences for other purposes - than forecasting. +Description: s2dv is 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 obeservation, + to visualization. Compared to 's2dverification', 's2dv' adopts the regime of + package 'multiApply'. Therefore, it can use multi-core for computation and work + with multi-dimensional arrays with a higher level of flexibility. Depends: maps, methods, @@ -56,8 +58,8 @@ Suggests: easyVerification, testthat License: LGPL-3 -URL: https://earth.bsc.es/gitlab/es/s2dverification/wikis/home -BugReports: https://earth.bsc.es/gitlab/es/s2dverification/issues +URL: https://earth.bsc.es/gitlab/es/s2dv/wikis/home +BugReports: https://earth.bsc.es/gitlab/es/s2dv/issues LazyData: true SystemRequirements: cdo Encoding: UTF-8 diff --git a/NAMESPACE b/NAMESPACE index 83b3be1..bd962e3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,50 +1,15 @@ # Generated by roxygen2: do not edit by hand -export(.BrierScore) -export(.RatioRMS) -export(.RatioSDRMS) -export(ACC) -export(Alpha) export(AnimateMap) -export(Ano) -export(Ano_CrossValid) -export(ArrayToNetCDF) -export(BrierScore) export(CDORemap) export(Clim) -export(Cluster) export(ColorBar) -export(Composite) -export(ConfigAddEntry) -export(ConfigApplyMatchingEntries) -export(ConfigEditDefinition) -export(ConfigEditEntry) -export(ConfigFileCreate) -export(ConfigFileOpen) -export(ConfigFileSave) -export(ConfigRemoveDefinition) -export(ConfigRemoveEntry) -export(ConfigShowDefinitions) -export(ConfigShowSimilarEntries) -export(ConfigShowTable) -export(Consist_Trend) export(Corr) -export(EOF) -export(Enlarge) export(Eno) -export(EnoNew) -export(Filter) -export(FitAcfCoef) -export(FitAutocor) -export(GenSeries) -export(Histo2Hindcast) -export(IniListDims) export(InsertDim) export(LeapYear) export(Load) -export(Mean1Dim) -export(MeanListDim) -export(NAO) +export(MeanDims) export(Plot2VarsVsLTime) export(PlotACC) export(PlotAno) @@ -56,30 +21,15 @@ export(PlotMatrix) export(PlotSection) export(PlotStereoMap) export(PlotVsLTime) -export(ProbBins) -export(ProjectField) export(RMS) export(RMSSS) -export(RatioRMS) -export(RatioSDRMS) export(Regression) -export(SVD) export(Season) -export(SelIndices) -export(Smoothing) -export(Spectrum) -export(Spread) -export(StatSeasAtlHurr) -export(Subset) export(ToyModel) export(Trend) -export(UltimateBrier) export(clim.colors) export(clim.palette) import(GEOmap) -import(NbClust) -import(SpecsVerification) -import(abind) import(bigmemory) import(geomapdata) import(graphics) @@ -89,7 +39,6 @@ import(methods) import(multiApply) import(ncdf4) import(parallel) -import(plyr) importFrom(abind,adrop) importFrom(grDevices,bmp) importFrom(grDevices,col2rgb) @@ -106,27 +55,18 @@ importFrom(grDevices,rainbow) importFrom(grDevices,rgb) importFrom(grDevices,svg) importFrom(grDevices,tiff) -importFrom(stats,IQR) importFrom(stats,acf) importFrom(stats,confint) importFrom(stats,cor) -importFrom(stats,kmeans) importFrom(stats,lm) -importFrom(stats,mad) importFrom(stats,median) importFrom(stats,na.fail) importFrom(stats,na.omit) importFrom(stats,na.pass) -importFrom(stats,pf) importFrom(stats,predict) importFrom(stats,pt) importFrom(stats,qnorm) -importFrom(stats,qt) -importFrom(stats,quantile) importFrom(stats,rnorm) -importFrom(stats,runif) -importFrom(stats,sd) importFrom(stats,setNames) -importFrom(stats,spectrum) importFrom(stats,ts) importFrom(stats,window) -- GitLab From 85536c9d864ba4416a1d490fff92f450c64b553b Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 31 Jan 2020 16:45:06 +0100 Subject: [PATCH 3/3] Modify functions to use MeanDims() --- R/Clim.R | 22 +++++++++++----------- R/Corr.R | 9 +++++---- R/InsertDim.R | 6 +++--- R/RMS.R | 11 ++++++----- R/RMSSS.R | 2 +- R/Regression.R | 2 +- man/Corr.Rd | 4 ++-- man/RMS.Rd | 4 ++-- 8 files changed, 31 insertions(+), 29 deletions(-) diff --git a/R/Clim.R b/R/Clim.R index 7f165d3..283437d 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 <- .aperm2(obs, order_obs) + obs <- s2dverification:::.aperm2(obs, order_obs) ############################### @@ -172,8 +172,8 @@ 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 <- MeanListDim(exp, pos, narm = FALSE) + - MeanListDim(obs, pos, narm = FALSE) + outrows_exp <- MeanDims(exp, pos, na.rm = FALSE) + + MeanDims(obs, pos, na.rm = FALSE) outrows_obs <- outrows_exp for (i in 1:length(pos)) { @@ -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 <- .aperm2(trend_exp, c(len, 1:(len - 1))) - trend_obs <- .aperm2(trend_obs, c(len, 1:(len - 1))) + trend_exp <- s2dverification:::.aperm2(trend_exp, c(len, 1:(len - 1))) + trend_obs <- s2dverification:::.aperm2(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 <- .aperm2(intercept_obs, c(2:length(dim(intercept_obs)), 1)) + intercept_obs <- s2dverification:::.aperm2(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 <- .aperm2(slope_obs, c(2:length(dim(slope_obs)), 1)) + slope_obs <- s2dverification:::.aperm2(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 <- .aperm2(tmp, c(2:length(dim(tmp)), 1)) #[dat_dim, ftime] + tmp <- s2dverification:::.aperm2(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 <- .aperm2(trend_exp, c(len, 1:(len - 1))) - trend_obs <- .aperm2(trend_obs, c(len, 1:(len - 1))) + trend_exp <- s2dverification:::.aperm2(trend_exp, c(len, 1:(len - 1))) + trend_obs <- s2dverification:::.aperm2(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 <- .aperm2(clim_obs_mean, c(2:len, 1)) + clim_obs_mean <- s2dverification:::.aperm2(clim_obs_mean, c(2:len, 1)) #[sdate, dat_dim, ftime] clim_exp <- trend_exp - trend_obs + clim_obs_mean diff --git a/R/Corr.R b/R/Corr.R index b8463ed..8c0e581 100644 --- a/R/Corr.R +++ b/R/Corr.R @@ -3,7 +3,7 @@ #'Calculate the correlation coefficient (Pearson, Kendall or Spearman) for #'an array of forecast and an array of observation. The correlations are #'computed along time_dim, the startdate dimension. If comp_dim is given, -#'the correlations are computed only if data along the comp_dim dimension are +#'the correlations are computed only if obs along the comp_dim dimension are #'complete between limits[1] and limits[2], i.e., there is no NA between #'limits[1] and limits[2]. This option can be activated if the user wants to #'account only for the forecasts which the corresponding observations are @@ -20,7 +20,7 @@ #'@param memb_dim A character string indicating the name of member (nobs/nexp) #' dimension. The default value is 'member'. #'@param comp_dim A character string indicating the name of dimension along which -#' the data is taken into account only if it is complete. The default value +#' obs is taken into account only if it is complete. The default value #' is NULL. #'@param limits A vector of two integers indicating the range along comp_dim to #' be completed. The default is c(1, length(comp_dim dimension)). @@ -184,7 +184,7 @@ Corr <- 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 <- .aperm2(obs, order_obs) + obs <- s2dverification:::.aperm2(obs, order_obs) ############################### @@ -196,7 +196,8 @@ Corr <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', limits <- c(1, dim(obs)[comp_dim]) } pos <- which(names(dim(obs)) == comp_dim) - outrows <- is.na(Mean1Dim(obs, pos, narm = FALSE, limits)) + 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]) obs[which(outrows)] <- NA } diff --git a/R/InsertDim.R b/R/InsertDim.R index 590df25..630dada 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 <- .aperm2(res, c(1:(posdim - 1), length(outdim), posdim:(length(outdim) - 1))) + res <- s2dverification:::.aperm2(res, c(1:(posdim - 1), length(outdim), posdim:(length(outdim) - 1))) } else { #posdim = length(outdim) - res <- .aperm2(res, c(1:(posdim - 1), length(outdim))) + res <- s2dverification:::.aperm2(res, c(1:(posdim - 1), length(outdim))) } } else { - res <- .aperm2(res, c(length(outdim), 1:(length(outdim) - 1))) + res <- s2dverification:::.aperm2(res, c(length(outdim), 1:(length(outdim) - 1))) } return(res) diff --git a/R/RMS.R b/R/RMS.R index 3a8b961..1fa7417 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -3,7 +3,7 @@ #'Compute the root mean square error for an array of forecasts and an array of #'observations. The RMSEs are computed along time_dim, the dimension which #'corresponds to the startdate dimension. If comp_dim is given, the RMSEs are -#'computed only if data along the comp_dim dimension are complete between +#'computed only if obs along the comp_dim dimension are complete between #'limits[1] and limits[2], i.e. there are no NAs between limits[1] and #'limits[2]. This option can be activated if the user wishes to account only #'for the forecasts for which the corresponding observations are available at @@ -19,7 +19,7 @@ #'@param memb_dim A character string indicating the name of member (nobs/nexp) #' dimension. The default value is 'member'. #'@param comp_dim A character string indicating the name of dimension along which -#' the data is taken into account only if it is complete. The default value +#' obs is taken into account only if it is complete. The default value #' is NULL. #'@param limits A vector of two integers indicating the range along comp_dim to #' be completed. The default value is c(1, length(comp_dim dimension)). @@ -164,11 +164,11 @@ 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 <- .aperm2(obs, order_obs) + obs <- s2dverification:::.aperm2(obs, order_obs) ############################### - # Calculate Corr + # Calculate RMS # Remove data along comp_dim dim if there is at least one NA between limits if (!is.null(comp_dim)) { @@ -176,7 +176,8 @@ RMS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', limits <- c(1, dim(obs)[comp_dim]) } pos <- which(names(dim(obs)) == comp_dim) - outrows <- is.na(Mean1Dim(obs, pos, narm = FALSE, limits)) + 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]) obs[which(outrows)] <- NA } diff --git a/R/RMSSS.R b/R/RMSSS.R index 53a6ec1..ea5e23c 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 <- .aperm2(obs, order_obs) + obs <- s2dverification:::.aperm2(obs, order_obs) ############################### diff --git a/R/Regression.R b/R/Regression.R index a20bf45..1b6ae12 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 <- .aperm2(datax, order_datax) + datax <- s2dverification:::.aperm2(datax, order_datax) ############################### diff --git a/man/Corr.Rd b/man/Corr.Rd index 72edd2c..c44acac 100644 --- a/man/Corr.Rd +++ b/man/Corr.Rd @@ -22,7 +22,7 @@ which the correlations are computed. The default value is 'sdate'.} dimension. The default value is 'member'.} \item{comp_dim}{A character string indicating the name of dimension along which -the data is taken into account only if it is complete. The default value +obs is taken into account only if it is complete. The default value is NULL.} \item{limits}{A vector of two integers indicating the range along comp_dim to @@ -65,7 +65,7 @@ number of observation (i.e., memb_dim in obs).\cr Calculate the correlation coefficient (Pearson, Kendall or Spearman) for an array of forecast and an array of observation. The correlations are computed along time_dim, the startdate dimension. If comp_dim is given, -the correlations are computed only if data along the comp_dim dimension are +the correlations are computed only if obs along the comp_dim dimension are complete between limits[1] and limits[2], i.e., there is no NA between limits[1] and limits[2]. This option can be activated if the user wants to account only for the forecasts which the corresponding observations are diff --git a/man/RMS.Rd b/man/RMS.Rd index 91aa9b0..ebbe544 100644 --- a/man/RMS.Rd +++ b/man/RMS.Rd @@ -21,7 +21,7 @@ which the correlations are computed. The default value is 'sdate'.} dimension. The default value is 'member'.} \item{comp_dim}{A character string indicating the name of dimension along which -the data is taken into account only if it is complete. The default value +obs is taken into account only if it is complete. The default value is NULL.} \item{limits}{A vector of two integers indicating the range along comp_dim to @@ -55,7 +55,7 @@ number of observation (i.e., memb_dim in obs).\cr Compute the root mean square error for an array of forecasts and an array of observations. The RMSEs are computed along time_dim, the dimension which corresponds to the startdate dimension. If comp_dim is given, the RMSEs are -computed only if data along the comp_dim dimension are complete between +computed only if obs along the comp_dim dimension are complete between limits[1] and limits[2], i.e. there are no NAs between limits[1] and limits[2]. This option can be activated if the user wishes to account only for the forecasts for which the corresponding observations are available at -- GitLab