diff --git a/R/ACC.R b/R/ACC.R index fcd1735e2ae5f344c117509b73432b7f4379f684..d921ce8ec06217edc37ed792a52de729fb07905e 100644 --- a/R/ACC.R +++ b/R/ACC.R @@ -23,10 +23,6 @@ #'@param lon_dim A character string indicating the name of the longitude #' dimension of 'exp' and 'obs' along which ACC is computed. The default value #' is 'lon'. -#'@param space_dim A character string vector of 2 indicating the name of the -#' latitude and longitude dimensions (in order) along which ACC is computed. -#' The default value is c('lat', 'lon'). This argument has been deprecated. -#' Use 'lat_dim' and 'lon_dim' instead. #'@param avg_dim A character string indicating the name of the dimension to be #' averaged, which is usually the time dimension. If no need to calculate mean #' ACC, set as NULL. The default value is 'sdate'. @@ -139,7 +135,7 @@ #'@importFrom ClimProjDiags Subset #'@export ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', - space_dim = c('lat', 'lon'), avg_dim = 'sdate', memb_dim = 'member', + avg_dim = 'sdate', memb_dim = 'member', lat = NULL, lon = NULL, lonlatbox = NULL, alpha = 0.05, pval = TRUE, sign = FALSE, conf = TRUE, conftype = "parametric", ncores = NULL) { @@ -160,26 +156,16 @@ ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } - if(!all(names(dim(exp)) %in% names(dim(obs))) | - !all(names(dim(obs)) %in% names(dim(exp)))) { - stop("Parameter 'exp' and 'obs' must have same dimension names.") - } ## dat_dim if (!is.null(dat_dim)) { if (!is.character(dat_dim) | length(dat_dim) > 1) { stop("Parameter 'dat_dim' must be a character string or NULL.") } if (!dat_dim %in% names(dim(exp)) | !dat_dim %in% names(dim(obs))) { - stop("Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension.", + stop("Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension. ", "Set it as NULL if there is no dataset dimension.") } } - ## space_dim (deprecated) - if (!missing("space_dim")) { - .warning("Parameter 'space_dim' is deprecated. Use 'lat_dim' and 'lon_dim' instead.") - lat_dim <- space_dim[1] - lon_dim <- space_dim[2] - } ## lat_dim if (!is.character(lat_dim) | length(lat_dim) != 1) { stop("Parameter 'lat_dim' must be a character string.") @@ -208,10 +194,19 @@ ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', if (!is.character(memb_dim) | length(memb_dim) > 1) { stop("Parameter 'memb_dim' must be a character string.") } - if (!memb_dim %in% names(dim(exp)) | !memb_dim %in% names(dim(obs))) { - stop("Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension.", + if (!memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { + stop("Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension. ", "Set it as NULL if there is no member dimension.") } + # Add [member = 1] + if (memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { + dim(obs) <- c(dim(obs), 1) + names(dim(obs))[length(dim(obs))] <- memb_dim + } + if (!memb_dim %in% names(dim(exp)) & memb_dim %in% names(dim(obs))) { + dim(exp) <- c(dim(exp), 1) + names(dim(exp))[length(dim(exp))] <- memb_dim + } } ## lat if (is.null(lat)) { @@ -275,6 +270,9 @@ ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', ## exp and obs (2) name_exp <- sort(names(dim(exp))) name_obs <- sort(names(dim(obs))) + if(!all(name_exp %in% name_obs) | !all(name_obs %in% name_exp)) { + stop("Parameter 'exp' and 'obs' must have same dimension names.") + } if (!is.null(dat_dim)) { name_exp <- name_exp[-which(name_exp == dat_dim)] name_obs <- name_obs[-which(name_obs == dat_dim)] @@ -586,9 +584,12 @@ ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', nobs <- 1 dim(exp) <- c(dim(exp)[1], dat = 1, dim(exp)[-1]) dim(obs) <- c(dim(obs)[1], dat = 1, dim(obs)[-1]) + dat_dim <- 'dat' + remove_dat_dim <- TRUE } else { nexp <- as.numeric(dim(exp)[dat_dim]) nobs <- as.numeric(dim(obs)[dat_dim]) + remove_dat_dim <- FALSE } nmembexp <- as.numeric(dim(exp)[1]) @@ -650,26 +651,38 @@ ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', #calculate the confidence interval if (is.null(avg_dim)) { - acc_conf.upper <- apply(acc_draw, c(1, 2), - function (x) { - quantile(x, 1 - alpha / 2, na.rm = TRUE)}) - acc_conf.lower <- apply(acc_draw, c(1, 2), - function (x) { - quantile(x, alpha / 2, na.rm = TRUE)}) + acc_conf.upper <- apply(acc_draw, c(1, 2), + function (x) { + quantile(x, 1 - alpha / 2, na.rm = TRUE)}) + acc_conf.lower <- apply(acc_draw, c(1, 2), + function (x) { + quantile(x, alpha / 2, na.rm = TRUE)}) } else { - acc_conf.upper <- apply(acc_draw, c(1, 2, 3), - function (x) { - quantile(x, 1 - alpha / 2, na.rm = TRUE)}) - acc_conf.lower <- apply(acc_draw, c(1, 2, 3), - function (x) { - quantile(x, alpha / 2, na.rm = TRUE)}) - macc_conf.upper <- apply(macc_draw, c(1, 2), - function (x) { - quantile(x, 1 - alpha / 2, na.rm = TRUE)}) - macc_conf.lower <- apply(macc_draw, c(1, 2), - function (x) { - quantile(x, alpha / 2, na.rm = TRUE)}) + acc_conf.upper <- apply(acc_draw, c(1, 2, 3), + function (x) { + quantile(x, 1 - alpha / 2, na.rm = TRUE)}) + acc_conf.lower <- apply(acc_draw, c(1, 2, 3), + function (x) { + quantile(x, alpha / 2, na.rm = TRUE)}) + macc_conf.upper <- apply(macc_draw, c(1, 2), + function (x) { + quantile(x, 1 - alpha / 2, na.rm = TRUE)}) + macc_conf.lower <- apply(macc_draw, c(1, 2), + function (x) { + quantile(x, alpha / 2, na.rm = TRUE)}) + } + + if (remove_dat_dim) { + if (is.null(avg_dim)) { + dim(acc_conf.lower) <- NULL + dim(acc_conf.upper) <- NULL + } else { + dim(acc_conf.lower) <- dim(acc_conf.lower)[-c(1, 2)] + dim(acc_conf.upper) <- dim(acc_conf.upper)[-c(1, 2)] + dim(macc_conf.lower) <- NULL + dim(macc_conf.upper) <- NULL + } } # Return output diff --git a/R/Corr.R b/R/Corr.R index d00f7555fd764e0960b61aaa1ffb33e99725070e..fe0304158bcdbc72ac69113b7ead1a5fd7eec5f3 100644 --- a/R/Corr.R +++ b/R/Corr.R @@ -125,10 +125,6 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } - if(!all(names(dim(exp)) %in% names(dim(obs))) | - !all(names(dim(obs)) %in% names(dim(exp)))) { - stop("Parameter 'exp' and 'obs' must have same dimension name") - } ## time_dim if (!is.character(time_dim) | length(time_dim) > 1) { stop("Parameter 'time_dim' must be a character string.") @@ -175,8 +171,17 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, if (!is.character(memb_dim) | length(memb_dim) > 1) { stop("Parameter 'memb_dim' must be a character string.") } - if (!memb_dim %in% names(dim(exp)) | !memb_dim %in% names(dim(obs))) { - stop("Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension.") + if (!memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { + stop("Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension. Set it as NULL if there is no member dimension.") + } + # Add [member = 1] + if (memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { + dim(obs) <- c(dim(obs), 1) + names(dim(obs))[length(dim(obs))] <- memb_dim + } + if (!memb_dim %in% names(dim(exp)) & memb_dim %in% names(dim(obs))) { + dim(exp) <- c(dim(exp), 1) + names(dim(exp))[length(dim(exp))] <- memb_dim } } ## memb @@ -250,7 +255,6 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, obs[which(outrows)] <- NA rm(obs_sub, outrows) } - if (!is.null(memb_dim)) { if (!memb) { #ensemble mean exp <- MeanDims(exp, memb_dim, na.rm = TRUE) diff --git a/R/RMS.R b/R/RMS.R index 4e6bfeb2e9a8301e10d55d91ad9633811fd733b5..b603c3748635c4f44cd61e49f3441b4c2f1570d6 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -71,7 +71,7 @@ #' #'exp2 <- array(rnorm(20), dim = c(sdate = 5, member = 4)) #'obs2 <- array(rnorm(10), dim = c(sdate = 5, member = 2)) -#'res2 <- RMS(exp3, obs3, memb_dim = 'member') +#'res2 <- RMS(exp2, obs2, memb_dim = 'member') #' #'@import multiApply #'@importFrom ClimProjDiags Subset diff --git a/R/RatioPredictableComponents.R b/R/RatioPredictableComponents.R index 163d18fcdbd10524d24b6111a7b759527e5f611f..3d5cae58fc08aaf79847c080a18bedb958f95fc6 100644 --- a/R/RatioPredictableComponents.R +++ b/R/RatioPredictableComponents.R @@ -2,13 +2,13 @@ #' #'This function computes the ratio of predictable components (RPC; Eade et al., 2014). #' -#'@param exp A numerical array with, at least, 'time_dim' and 'member_dim' +#'@param exp A numerical array with, at least, 'time_dim' and 'memb_dim' #' dimensions. #'@param obs A numerical array with the same dimensions than 'exp' except the -#' 'member_dim' dimension. +#' 'memb_dim' dimension. #'@param time_dim A character string indicating the name of the time dimension. #' The default value is 'year'. -#'@param member_dim A character string indicating the name of the member +#'@param memb_dim A character string indicating the name of the member #' dimension. The default value is 'member'. #'@param na.rm A logical value indicating whether to remove NA values during #' the computation. The default value is FALSE. @@ -16,7 +16,7 @@ #' computation. The default value is NULL. #' #'@return An array of the ratio of the predictable components. it has the same -#' dimensions as 'exp' except 'time_dim' and 'member_dim' dimensions. +#' dimensions as 'exp' except 'time_dim' and 'memb_dim' dimensions. #' #'@examples #'exp <- array(data = runif(600), dim = c(year = 15, member = 10, lat = 2, lon = 2)) @@ -25,7 +25,7 @@ #' #'@import multiApply stats #'@export -RatioPredictableComponents <- function(exp, obs, time_dim = 'year', member_dim = 'member', na.rm = FALSE, ncores = NULL) { +RatioPredictableComponents <- function(exp, obs, time_dim = 'year', memb_dim = 'member', na.rm = FALSE, ncores = NULL) { ## Checkings if (is.null(exp)) { @@ -43,14 +43,14 @@ RatioPredictableComponents <- function(exp, obs, time_dim = 'year', member_dim = if (!(is.character(time_dim) & length(time_dim) == 1)) { stop("Parameter 'time_dim' must be a character string.") } - if (!(is.character(member_dim) & length(member_dim) == 1)) { - stop("Parameter 'member_dim' must be a character string.") + if (!(is.character(memb_dim) & length(memb_dim) == 1)) { + stop("Parameter 'memb_dim' must be a character string.") } if (!time_dim %in% names(dim(exp))) { stop("'exp' must have 'time_dim' dimension.") } - if (!member_dim %in% names(dim(exp))) { - stop("'exp' must have 'member_dim' dimension.") + if (!memb_dim %in% names(dim(exp))) { + stop("'exp' must have 'memb_dim' dimension.") } if (!time_dim %in% names(dim(obs))) { stop("'obs' must have 'time_dim' dimension.") @@ -68,7 +68,7 @@ RatioPredictableComponents <- function(exp, obs, time_dim = 'year', member_dim = } RPC <- multiApply::Apply(data = list(exp, obs), - target_dims = list(exp = c(time_dim, member_dim), + target_dims = list(exp = c(time_dim, memb_dim), obs = time_dim), output_dims = NULL, fun = .RatioPredictableComponents, diff --git a/R/RatioSDRMS.R b/R/RatioSDRMS.R index 2fe259c9d79c7cc076f07e57a4e9deda18713aa8..b38d5e22b45ade61ff1ceab162eaf7cc8ae96ad2 100644 --- a/R/RatioSDRMS.R +++ b/R/RatioSDRMS.R @@ -65,14 +65,10 @@ RatioSDRMS <- function(exp, obs, dat_dim = NULL, memb_dim = 'member', stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", "dimensions memb_dim and time_dim.")) } - if(any(is.null(names(dim(exp))))| any(nchar(names(dim(exp))) == 0) | - any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { + if (any(is.null(names(dim(exp))))| any(nchar(names(dim(exp))) == 0) | + any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } - if(!all(names(dim(exp)) %in% names(dim(obs))) | - !all(names(dim(obs)) %in% names(dim(exp)))) { - stop("Parameter 'exp' and 'obs' must have the same dimension names.") - } ## dat_dim if (!is.null(dat_dim)) { if (!is.character(dat_dim) | length(dat_dim) > 1) { @@ -86,8 +82,18 @@ RatioSDRMS <- function(exp, obs, dat_dim = NULL, memb_dim = 'member', if (!is.character(memb_dim) | length(memb_dim) > 1) { stop("Parameter 'memb_dim' must be a character string.") } - if (!memb_dim %in% names(dim(exp)) | !memb_dim %in% names(dim(obs))) { - stop("Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension.") + if (!memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { + stop("Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension. ", + "Set it as NULL if there is no member dimension.") + } + # Add [member = 1] + if (memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { + dim(obs) <- c(dim(obs), 1) + names(dim(obs))[length(dim(obs))] <- memb_dim + } + if (!memb_dim %in% names(dim(exp)) & memb_dim %in% names(dim(obs))) { + dim(exp) <- c(dim(exp), 1) + names(dim(exp))[length(dim(exp))] <- memb_dim } ## time_dim if (!is.character(time_dim) | length(time_dim) > 1) { diff --git a/man/ACC.Rd b/man/ACC.Rd index 840f01f71d578e1f63eb1105802c2bda48cf6e57..4a4a5f21842dd412608de71856e5dc2b60a002f0 100644 --- a/man/ACC.Rd +++ b/man/ACC.Rd @@ -10,7 +10,6 @@ ACC( dat_dim = NULL, lat_dim = "lat", lon_dim = "lon", - space_dim = c("lat", "lon"), avg_dim = "sdate", memb_dim = "member", lat = NULL, @@ -43,11 +42,6 @@ is 'lat'.} dimension of 'exp' and 'obs' along which ACC is computed. The default value is 'lon'.} -\item{space_dim}{A character string vector of 2 indicating the name of the -latitude and longitude dimensions (in order) along which ACC is computed. -The default value is c('lat', 'lon'). This argument has been deprecated. -Use 'lat_dim' and 'lon_dim' instead.} - \item{avg_dim}{A character string indicating the name of the dimension to be averaged, which is usually the time dimension. If no need to calculate mean ACC, set as NULL. The default value is 'sdate'.} diff --git a/man/RMS.Rd b/man/RMS.Rd index b7c044f65ae7c3abfd6a3f0e14996600791237a0..57473544cacaaa0f10629dd331dd830d2de79b38 100644 --- a/man/RMS.Rd +++ b/man/RMS.Rd @@ -99,6 +99,6 @@ res1 <- RMS(exp1, obs1, comp_dim = 'ftime', dat_dim = 'dat') exp2 <- array(rnorm(20), dim = c(sdate = 5, member = 4)) obs2 <- array(rnorm(10), dim = c(sdate = 5, member = 2)) -res2 <- RMS(exp3, obs3, memb_dim = 'member') +res2 <- RMS(exp2, obs2, memb_dim = 'member') } diff --git a/man/RatioPredictableComponents.Rd b/man/RatioPredictableComponents.Rd index 3e7fbad6c000b42fc6fb1bd689db8007d250b853..8e6dbb7cf38e642b56194b2c0618cbae53ed458b 100644 --- a/man/RatioPredictableComponents.Rd +++ b/man/RatioPredictableComponents.Rd @@ -8,22 +8,22 @@ RatioPredictableComponents( exp, obs, time_dim = "year", - member_dim = "member", + memb_dim = "member", na.rm = FALSE, ncores = NULL ) } \arguments{ -\item{exp}{A numerical array with, at least, 'time_dim' and 'member_dim' +\item{exp}{A numerical array with, at least, 'time_dim' and 'memb_dim' dimensions.} \item{obs}{A numerical array with the same dimensions than 'exp' except the -'member_dim' dimension.} +'memb_dim' dimension.} \item{time_dim}{A character string indicating the name of the time dimension. The default value is 'year'.} -\item{member_dim}{A character string indicating the name of the member +\item{memb_dim}{A character string indicating the name of the member dimension. The default value is 'member'.} \item{na.rm}{A logical value indicating whether to remove NA values during @@ -34,7 +34,7 @@ computation. The default value is NULL.} } \value{ An array of the ratio of the predictable components. it has the same - dimensions as 'exp' except 'time_dim' and 'member_dim' dimensions. + dimensions as 'exp' except 'time_dim' and 'memb_dim' dimensions. } \description{ This function computes the ratio of predictable components (RPC; Eade et al., 2014). diff --git a/tests/testthat/test-ACC.R b/tests/testthat/test-ACC.R index c9e986ddb5d444ddc6c9d62d5b92a6695c861c2e..544a23551c4fcd5d94cba55aefb3e9f9538fb025 100644 --- a/tests/testthat/test-ACC.R +++ b/tests/testthat/test-ACC.R @@ -11,6 +11,10 @@ ftime = 1, lat = 2, lon = 3)) lat1 <- c(30, 35) lon1 <- c(0, 5, 10) + + set.seed(2) + obs1_2 <- array(rnorm(30), dim = c(sdate = 5, ftime = 1, lat = 2, lon = 3)) + # dat2 set.seed(1) exp2 <- array(rnorm(60), dim = c(dataset = 2, sdate = 5, @@ -24,6 +28,13 @@ lat2 <- c(30, 35) lon2 <- c(0, 5, 10) + # dat3 + set.seed(1) + exp3 <- array(rnorm(72), dim = c(dat = 2, member = 3, sdate = 3, lat = 2, lon = 2)) + set.seed(2) + obs3 <- array(rnorm(12), dim = c(dat = 1, sdate = 3, lat = 2, lon = 2)) + lat3 <- c(0, 10) + ############################################## test_that("1. Input checks", { # exp and obs (1) @@ -44,10 +55,6 @@ test_that("1. Input checks", { ACC(array(1:10, dim = c(2, 5)), array(1:4, dim = c(2, 2))), "Parameter 'exp' and 'obs' must have dimension names." ) - expect_error( - ACC(array(1:10, dim = c(a = 2, c = 5)), array(1:4, dim = c(a = 2, b = 2))), - "Parameter 'exp' and 'obs' must have same dimension name" - ) # dat_dim expect_error( ACC(exp1, obs1, dat_dim = 1), @@ -57,11 +64,6 @@ test_that("1. Input checks", { ACC(exp1, obs1, dat_dim = 'a'), "Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension." ) - # space_dim (deprecated) - expect_warning( - ACC(exp1, obs1, space_dim = c('lat', 'lon'), lat = c(1, 2)), - "! Warning: Parameter 'space_dim' is deprecated. Use 'lat_dim' and 'lon_dim'\n! instead." - ) # lat_dim expect_error( ACC(exp1, obs1, lat_dim = 1), @@ -96,7 +98,7 @@ test_that("1. Input checks", { ) expect_error( ACC(exp1, obs1, memb_dim = 'memb'), - "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." + "Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension. Set it as NULL if there is no member dimension." ) # lat expect_error( @@ -217,6 +219,46 @@ test_that("2. Output checks: dat1", { tolerance = 0.00001 ) + # bootstrap + expect_equal( + names(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap')), + c('acc', 'acc_conf.lower', 'acc_conf.upper', 'macc', 'macc_conf.lower', 'macc_conf.upper') + ) + expect_equal( + dim(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap')$acc), + c(sdate = 5, ftime = 1) + ) + expect_equal( + dim(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap')$acc_conf.lower), + c(sdate = 5, ftime = 1) + ) + expect_equal( + dim(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap')$macc_conf.lower), + c(ftime = 1) + ) + expect_equal( + dim(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap')$macc), + c(ftime = 1) + ) + # boostrap, avg_time is NULL + expect_equal( + names(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap', avg_dim = NULL)), + c('acc', 'acc_conf.lower', 'acc_conf.upper', 'macc', 'macc_conf.lower', 'macc_conf.upper') + ) + expect_equal( + dim(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap', avg_dim = NULL)$acc), + c(sdate = 5, ftime = 1) + ) + expect_equal( + dim(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap', avg_dim = NULL)$acc_conf.lower), + c(sdate = 5, ftime = 1) + ) + + # obs1_2, no memb_dim + expect_equal( + ACC(exp1, obs1, lat = lat1), + ACC(exp1, obs1_2, lat = lat1) + ) }) @@ -240,3 +282,66 @@ expect_equal( ) }) + + +############################################## + +test_that("4. Output checks: dat3", { + +expect_equal( +names(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat")), +c('acc', 'macc', 'conf.lower', 'conf.upper', 'p.val') +) +expect_equal( +names(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat", avg_dim = NULL)), +c('acc', 'conf.lower', 'conf.upper', 'p.val') +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat")$acc), +c(nexp = 2, nobs = 1, sdate = 3) +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat", avg_dim = NULL)$acc), +c(nexp = 2, nobs = 1, sdate = 3) +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat")$p.val), +c(nexp = 2, nobs = 1, sdate = 3) +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat")$conf.upper), +c(nexp = 2, nobs = 1, sdate = 3) +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat")$macc), +c(nexp = 2, nobs = 1) +) + +expect_equal( +ACC(exp3, array(obs3, c(member = 1, dim(obs3))), lat = lat3, memb_dim = "member", dat_dim = "dat"), +ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat") +) + +# bootstrap +expect_equal( +names(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat", conftype = 'bootstrap')), +c('acc', 'acc_conf.lower', 'acc_conf.upper', 'macc', 'macc_conf.lower', 'macc_conf.upper') +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat", conftype = 'bootstrap')$acc), +c(nexp = 2, nobs = 1, sdate = 3) +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat", conftype = 'bootstrap')$acc_conf.lower), +c(nexp = 2, nobs = 1, sdate = 3) +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat", conftype = 'bootstrap')$macc), +c(nexp = 2, nobs = 1) +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat", conftype = 'bootstrap')$macc_conf.upper), +c(nexp = 2, nobs = 1) +) + +}) diff --git a/tests/testthat/test-Corr.R b/tests/testthat/test-Corr.R index 6732c58595d34ead49c3030fab3d98455de4cb2d..4cc57d4c7a2d2efac22af729653dcda2ec72459a 100644 --- a/tests/testthat/test-Corr.R +++ b/tests/testthat/test-Corr.R @@ -11,6 +11,13 @@ na <- floor(runif(10, min = 1, max = 120)) obs1[na] <- NA + set.seed(2) + obs1_2 <- array(rnorm(120), dim = c(dataset = 1, sdate = 5, + ftime = 3, lat = 2, lon = 4)) + set.seed(2) + na <- floor(runif(10, min = 1, max = 120)) + obs1_2[na] <- NA + # dat2: memb_dim = member set.seed(1) exp2 <- array(rnorm(180), dim = c(member = 3, dataset = 2, sdate = 5, @@ -85,10 +92,6 @@ test_that("1. Input checks", { "Parameter 'exp' and 'obs' must have dimension names." ) expect_error( - Corr(array(1:10, dim = c(a = 2, c = 5)), array(1:4, dim = c(a = 2, b = 2))), - "Parameter 'exp' and 'obs' must have same dimension name" - ) - expect_error( Corr(exp1, obs1, dat_dim = 1), "Parameter 'dat_dim' must be a character string." ) @@ -135,7 +138,7 @@ test_that("1. Input checks", { ) expect_error( Corr(exp1, obs1, memb_dim = 'memb'), - "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." + "Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension. Set it as NULL if there is no member dimension." ) expect_error( Corr(exp2, obs2, memb_dim = 'member', memb = 1), @@ -244,6 +247,19 @@ suppressWarnings( tolerance = 0.001 ) ) +# obs1_2, no memb_dim +suppressWarnings( + expect_equal( + Corr(exp1, obs1, dat_dim = 'dataset', memb_dim = 'member'), + Corr(exp1, obs1_2, dat_dim = 'dataset', memb_dim = 'member') + ) +) +suppressWarnings( + expect_equal( + Corr(exp1, obs1, dat_dim = 'dataset', memb_dim = 'member', memb = F), + Corr(exp1, obs1_2, dat_dim = 'dataset', memb_dim = 'member', memb = F) + ) +) }) diff --git a/tests/testthat/test-RatioPredictableComponents.R b/tests/testthat/test-RatioPredictableComponents.R index 54609b5b1d80fe84d9e09c2721744e71a5346dda..7edaf2012cafe12ffdd35bff9126e4aa18c50b82 100644 --- a/tests/testthat/test-RatioPredictableComponents.R +++ b/tests/testthat/test-RatioPredictableComponents.R @@ -35,8 +35,8 @@ test_that("1. Input checks", { "'exp' must have 'time_dim' dimension." ) expect_error( - RatioPredictableComponents(exp1, obs1, member_dim = 'ens'), - "'exp' must have 'member_dim' dimension." + RatioPredictableComponents(exp1, obs1, memb_dim = 'ens'), + "'exp' must have 'memb_dim' dimension." ) expect_error( RatioPredictableComponents(exp1, array(rnorm(6), dim = c(sdate = 3, time = 2))), diff --git a/tests/testthat/test-RatioSDRMS.R b/tests/testthat/test-RatioSDRMS.R index 78143cc57b69ffb6c2c127c59a562b80f19d8171..53be127b509d90e8197848718e45dc9da6800067 100644 --- a/tests/testthat/test-RatioSDRMS.R +++ b/tests/testthat/test-RatioSDRMS.R @@ -4,6 +4,8 @@ exp1 <- array(rnorm(40), dim = c(dataset = 2, member = 2, sdate = 5, ftime = 2)) set.seed(2) obs1 <- array(rnorm(10), dim = c(dataset = 1, member = 1, sdate = 5, ftime = 2)) + obs1_2 <- obs1 + dim(obs1_2) <- dim(obs1_2)[-2] # dat2 exp2 <- exp1 @@ -37,10 +39,6 @@ test_that("1. Input checks", { "Parameter 'exp' and 'obs' must have dimension names." ) expect_error( - RatioSDRMS(array(1:10, dim = c(a = 2, c = 5)), array(1:4, dim = c(a = 2, b = 2))), - "Parameter 'exp' and 'obs' must have the same dimension names." - ) - expect_error( RatioSDRMS(exp1, obs1, dat_dim = 1), "Parameter 'dat_dim' must be a character string." ) @@ -54,7 +52,7 @@ test_that("1. Input checks", { ) expect_error( RatioSDRMS(exp1, obs1, memb_dim = 'a', dat_dim = 'dataset'), - "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." + "Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension. Set it as NULL if there is no member dimension." ) expect_error( RatioSDRMS(exp1, obs1, time_dim = c('sdate', 'a'), dat_dim = 'dataset'), @@ -113,6 +111,10 @@ as.vector(RatioSDRMS(exp1, obs1, dat_dim = 'dataset')$ratio), as.vector(RatioSDRMS(exp1, obs1, pval = F, dat_dim = 'dataset')$ratio) ) +expect_equal( +RatioSDRMS(exp1, obs1, dat_dim = 'dataset'), +RatioSDRMS(exp1, obs1_2, dat_dim = 'dataset') +) }) ##############################################