From 336821b81657157fa7a7160eb497d976e2961550 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 20 Sep 2023 13:42:32 +0200 Subject: [PATCH] Add param 'sig_method.type' to choose RandomWalkTest test.type --- R/AbsBiasSS.R | 40 ++++++++++++++++++++++----- R/CRPSS.R | 49 ++++++++++++++++++++++++++------- R/RPSS.R | 46 +++++++++++++++++++++++++------ man/AbsBiasSS.Rd | 16 +++++++++-- man/CRPSS.Rd | 14 ++++++++-- man/RPSS.Rd | 19 +++++++++++-- tests/testthat/test-AbsBiasSS.R | 14 ++++++++++ tests/testthat/test-CRPSS.R | 33 ++++++++++++++++++++++ tests/testthat/test-RPSS.R | 41 +++++++++++++++++++++++++++ 9 files changed, 239 insertions(+), 33 deletions(-) diff --git a/R/AbsBiasSS.R b/R/AbsBiasSS.R index 8cb1bce..e55d3d8 100644 --- a/R/AbsBiasSS.R +++ b/R/AbsBiasSS.R @@ -10,9 +10,9 @@ #'of reference forecasts are the climatological forecast (average of the #'observations), a previous model version, or another model. It is computed as #'\code{AbsBiasSS = 1 - AbsBias_exp / AbsBias_ref}. The statistical significance -#'is obtained based on a Random Walk test at the 95% confidence level (DelSole -#'and Tippett, 2016). If there is more than one dataset, the result will be -#'computed for each pair of exp and obs data. +#'is obtained based on a Random Walk test at the confidence level specified +#'(DelSole and Tippett, 2016). If there is more than one dataset, the result +#'will be computed for each pair of exp and obs data. #' #'@param exp A named numerical array of the forecast with at least time #' dimension. @@ -36,6 +36,12 @@ #' The default value is NULL. #'@param na.rm A logical value indicating if NAs should be removed (TRUE) or #' kept (FALSE) for computation. The default value is FALSE. +#'@param sig_method.type A character string indicating the test type of the +#' significance method. Check \code{RandomWalkTest()} parameter +#' \code{test.type} for details. The default is 'two.sided.approx', which is +#' the default of \code{RandomWalkTest()}. +#'@param alpha A numeric of the significance level to be used in the statistical +#' significance test. The default value is 0.05. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -65,7 +71,8 @@ #'@import multiApply #'@export AbsBiasSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = NULL, - dat_dim = NULL, na.rm = FALSE, ncores = NULL) { + dat_dim = NULL, na.rm = FALSE, sig_method.type = 'two.sided.approx', + alpha = 0.05, ncores = NULL) { # Check inputs ## exp, obs, and ref (1) @@ -163,6 +170,22 @@ AbsBiasSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = NULL, if (!is.logical(na.rm) | length(na.rm) > 1) { stop("Parameter 'na.rm' must be one logical value.") } + ## alpha + if (any(!is.numeric(alpha) | alpha <= 0 | alpha >= 1 | length(alpha) > 1)) { + stop("Parameter 'alpha' must be a number between 0 and 1.") + } + ## sig_method.type + #NOTE: These are the types of RandomWalkTest() + if (!sig_method.type %in% c('two.sided.approx', 'two.sided', 'greater', 'less')) { + stop("Parameter 'sig_method.type' must be 'two.sided.approx', 'two.sided', 'greater', or 'less'.") + } + if (sig_method.type == 'two.sided.approx') { + if (alpha != 0.05) { + .warning("DelSole and Tippett (2016) aproximation is valid for alpha ", + "= 0.05 only. Returning the significance at the 0.05 significance level.") + } + } + ## ncores if (!is.null(ncores)) { if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | @@ -202,13 +225,14 @@ AbsBiasSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = NULL, target_dims = target_dims, fun = .AbsBiasSS, dat_dim = dat_dim, - na.rm = na.rm, + na.rm = na.rm, alpha = alpha, sig_method.type = sig_method.type, ncores = ncores) return(output) } -.AbsBiasSS <- function(exp, obs, ref = NULL, dat_dim = NULL, na.rm = FALSE) { +.AbsBiasSS <- function(exp, obs, ref = NULL, dat_dim = NULL, na.rm = FALSE, + sig_method.type = 'two.sided.approx', alpha = 0.05) { # exp and obs: [sdate, (dat_dim)] # ref: [sdate, (dat_dim)] or NULL @@ -267,7 +291,9 @@ AbsBiasSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = NULL, bias_ref <- .Bias(exp = ref_data, obs = obs_data, na.rm = na.rm, absolute = TRUE, time_mean = FALSE) ## Skill score and significance biasSS[i, j] <- 1 - mean(bias_exp) / mean(bias_ref) - sign[i, j] <- .RandomWalkTest(skill_A = bias_exp, skill_B = bias_ref, sign = T, pval = F)$sign + sign[i, j] <- .RandomWalkTest(skill_A = bias_exp, skill_B = bias_ref, + test.type = sig_method.type, alpha = alpha, + sign = T, pval = F)$sign } } diff --git a/R/CRPSS.R b/R/CRPSS.R index 6b1ed17..159e2bd 100644 --- a/R/CRPSS.R +++ b/R/CRPSS.R @@ -9,8 +9,8 @@ #'has a lower skill. Examples of reference forecasts are the climatological #'forecast, persistence, a previous model version, or another model. It is #'computed as 'CRPSS = 1 - CRPS_exp / CRPS_ref. The statistical significance is -#'obtained based on a Random Walk test at the 95% confidence level (DelSole and -#'Tippett, 2016). +#'obtained based on a Random Walk test at the specified confidence level +#'(DelSole and Tippett, 2016). #' #'@param exp A named numerical array of the forecast with at least time #' dimension. @@ -42,6 +42,12 @@ #' forecast in cross-validation (i.e. excluding the observed value of the time #' step when building the probabilistic distribution function for that #' particular time step). Only used if 'ref' is NULL. The default value is TRUE. +#'@param sig_method.type A character string indicating the test type of the +#' significance method. Check \code{RandomWalkTest()} parameter +#' \code{test.type} for details. The default is 'two.sided.approx', which is +#' the default of \code{RandomWalkTest()}. +#'@param alpha A numeric of the significance level to be used in the statistical +#' significance test. The default value is 0.05. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -73,7 +79,8 @@ #'@importFrom ClimProjDiags Subset #'@export CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', dat_dim = NULL, - Fair = FALSE, clim.cross.val = TRUE, ncores = NULL) { + Fair = FALSE, clim.cross.val = TRUE, sig_method.type = 'two.sided.approx', + alpha = 0.05, ncores = NULL) { # Check inputs ## exp, obs, and ref (1) @@ -172,6 +179,21 @@ CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', if (!is.logical(clim.cross.val) | is.na(clim.cross.val) | length(clim.cross.val) != 1) { stop("Parameter 'clim.cross.val' must be either TRUE or FALSE.") } + ## alpha + if (any(!is.numeric(alpha) | alpha <= 0 | alpha >= 1 | length(alpha) > 1)) { + stop("Parameter 'alpha' must be a number between 0 and 1.") + } + ## sig_method.type + #NOTE: These are the types of RandomWalkTest() + if (!sig_method.type %in% c('two.sided.approx', 'two.sided', 'greater', 'less')) { + stop("Parameter 'sig_method.type' must be 'two.sided.approx', 'two.sided', 'greater', or 'less'.") + } + if (sig_method.type == 'two.sided.approx') { + if (alpha != 0.05) { + .warning("DelSole and Tippett (2016) aproximation is valid for alpha ", + "= 0.05 only. Returning the significance at the 0.05 significance level.") + } + } ## ncores if (!is.null(ncores)) { if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { @@ -202,15 +224,16 @@ CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', fun = .CRPSS, time_dim = time_dim, memb_dim = memb_dim, dat_dim = dat_dim, - Fair = Fair, - clim.cross.val = clim.cross.val, + Fair = Fair, clim.cross.val = clim.cross.val, + sig_method.type = sig_method.type, alpha = alpha, ncores = ncores) return(output) } -.CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', dat_dim = NULL, - Fair = FALSE, clim.cross.val = TRUE) { +.CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', + dat_dim = NULL, Fair = FALSE, clim.cross.val = TRUE, + sig_method.type = 'two.sided.approx', alpha = 0.05) { # exp: [sdate, memb, (dat)] # obs: [sdate, (dat)] @@ -306,14 +329,18 @@ CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', for (i in 1:nexp) { for (j in 1:nobs) { crpss[i, j] <- 1 - crps_exp_mean[i, j] / crps_ref_mean[j] - sign[i, j] <- .RandomWalkTest(skill_A = crps_exp_mean[i, j], skill_B = crps_ref_mean[j], sign = T, pval = F)$sign + sign[i, j] <- .RandomWalkTest(skill_A = crps_exp_mean[i, j], skill_B = crps_ref_mean[j], + test.type = sig_method.type, alpha = alpha, + sign = T, pval = F)$sign } } } else { for (i in 1:nexp) { for (j in 1:nobs) { crpss[i, j] <- 1 - crps_exp_mean[i, j] / crps_ref_mean[i, j] - sign[i, j] <- .RandomWalkTest(skill_A = crps_exp_mean[i, j], skill_B = crps_ref_mean[i, j], sign = T, pval = F)$sign + sign[i, j] <- .RandomWalkTest(skill_A = crps_exp_mean[i, j], skill_B = crps_ref_mean[i, j], + test.type = sig_method.type, alpha = alpha, + sign = T, pval = F)$sign } } } @@ -321,7 +348,9 @@ CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', } else { crpss <- 1 - mean(crps_exp) / mean(crps_ref) # Significance - sign <- .RandomWalkTest(skill_A = crps_exp, skill_B = crps_ref, sign = T, pval = F)$sign + sign <- .RandomWalkTest(skill_A = crps_exp, skill_B = crps_ref, + test.type = sig_method.type, alpha = alpha, + sign = T, pval = F)$sign } return(list(crpss = crpss, sign = sign)) diff --git a/R/RPSS.R b/R/RPSS.R index 7e2b3ac..91ca8c2 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -10,8 +10,8 @@ #'probabilities for all categories for all time steps), persistence, a previous #'model version, and another model. It is computed as #'\code{RPSS = 1 - RPS_exp / RPS_ref}. The statistical significance is obtained -#'based on a Random Walk test at the 95% confidence level (DelSole and Tippett, -#'2016).\cr +#'based on a Random Walk test at the specified confidence level (DelSole and +#'Tippett, 2016).\cr #'The function accepts either the ensemble members or the probabilities of #'each data as inputs. If there is more than one dataset, RPSS will be #'computed for each pair of exp and obs data. The NA ratio of data will be @@ -73,6 +73,12 @@ #' FALSE (no NA is acceptable), 0 is equal to TRUE (all NAs are acceptable). # The function returns NA if the fraction of non-NA values in the data is less #' than na.rm. Otherwise, RPS will be calculated. The default value is FALSE. +#'@param sig_method.type A character string indicating the test type of the +#' significance method. Check \code{RandomWalkTest()} parameter +#' \code{test.type} for details. The default is 'two.sided.approx', which is +#' the default of \code{RandomWalkTest()}. +#'@param alpha A numeric of the significance level to be used in the statistical +#' significance test. The default value is 0.05. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -108,18 +114,22 @@ #'res <- RPSS(exp = exp, obs = obs) ## climatology as reference forecast #'res <- RPSS(exp = exp, obs = obs, ref = ref) ## ref as reference forecast #'res <- RPSS(exp = exp, obs = obs, ref = ref, weights_exp = weights, weights_ref = weights) +#'res <- RPSS(exp = exp, obs = obs, alpha = 0.01, sig_method.type = 'two.sided') +#' #'# Use probs as input #'exp_probs <- GetProbs(exp, memb_dim = 'member') #'obs_probs <- GetProbs(obs, memb_dim = NULL) #'ref_probs <- GetProbs(ref, memb_dim = 'member') -#'res <- RPSS(exp = exp_probs, obs = obs_probs, ref = ref_probs, memb_dim = NULL, cat_dim = 'bin') +#'res <- RPSS(exp = exp_probs, obs = obs_probs, ref = ref_probs, memb_dim = NULL, +#' cat_dim = 'bin') #' #'@import multiApply #'@export RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', cat_dim = NULL, dat_dim = NULL, prob_thresholds = c(1/3, 2/3), indices_for_clim = NULL, Fair = FALSE, weights_exp = NULL, weights_ref = NULL, - cross.val = FALSE, na.rm = FALSE, ncores = NULL) { + cross.val = FALSE, na.rm = FALSE, + sig_method.type = 'two.sided.approx', alpha = 0.05, ncores = NULL) { # Check inputs ## exp, obs, and ref (1) @@ -314,6 +324,21 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', if (!isTRUE(na.rm) & !isFALSE(na.rm) & !(is.numeric(na.rm) & na.rm >= 0 & na.rm <= 1)) { stop('"na.rm" should be TRUE, FALSE or a numeric between 0 and 1') } + ## alpha + if (any(!is.numeric(alpha) | alpha <= 0 | alpha >= 1 | length(alpha) > 1)) { + stop("Parameter 'alpha' must be a number between 0 and 1.") + } + ## sig_method.type + #NOTE: These are the types of RandomWalkTest() + if (!sig_method.type %in% c('two.sided.approx', 'two.sided', 'greater', 'less')) { + stop("Parameter 'sig_method.type' must be 'two.sided.approx', 'two.sided', 'greater', or 'less'.") + } + if (sig_method.type == 'two.sided.approx') { + if (alpha != 0.05) { + .warning("DelSole and Tippett (2016) aproximation is valid for alpha ", + "= 0.05 only. Returning the significance at the 0.05 significance level.") + } + } ## ncores if (!is.null(ncores)) { if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | @@ -368,7 +393,8 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', weights_exp = weights_exp, weights_ref = weights_ref, cross.val = cross.val, - na.rm = na.rm, ncores = ncores) + na.rm = na.rm, sig_method.type = sig_method.type, alpha = alpha, + ncores = ncores) return(output) @@ -377,7 +403,7 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', .RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', cat_dim = NULL, dat_dim = NULL, prob_thresholds = c(1/3, 2/3), indices_for_clim = NULL, Fair = FALSE, weights_exp = NULL, weights_ref = NULL, cross.val = FALSE, - na.rm = FALSE) { + na.rm = FALSE, sig_method.type = 'two.sided.approx', alpha = 0.05) { #--- if memb_dim: # exp: [sdate, memb, (dat)] # obs: [sdate, (memb), (dat)] @@ -552,7 +578,9 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', if (!any(ind_nonNA)) { sign[i, j] <- NA } else { - sign[i, j] <- .RandomWalkTest(skill_A = rps_exp[ind_nonNA, i, j], skill_B = rps_ref[ind_nonNA, i, j])$sign + sign[i, j] <- .RandomWalkTest(skill_A = rps_exp[ind_nonNA, i, j], skill_B = rps_ref[ind_nonNA, i, j], + test.type = sig_method.type, alpha = alpha, + sign = T, pval = F)$sign } } } @@ -570,7 +598,9 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', } else { # rps_exp and rps_ref: [sdate] rpss <- 1 - mean(rps_exp, na.rm = TRUE) / mean(rps_ref, na.rm = TRUE) - sign <- .RandomWalkTest(skill_A = rps_exp[ind_nonNA], skill_B = rps_ref[ind_nonNA], sign = T, pval = F)$sign + sign <- .RandomWalkTest(skill_A = rps_exp[ind_nonNA], skill_B = rps_ref[ind_nonNA], + test.type = sig_method.type, alpha = alpha, + sign = T, pval = F)$sign } } diff --git a/man/AbsBiasSS.Rd b/man/AbsBiasSS.Rd index 029101d..ac4ca4a 100644 --- a/man/AbsBiasSS.Rd +++ b/man/AbsBiasSS.Rd @@ -12,6 +12,8 @@ AbsBiasSS( memb_dim = NULL, dat_dim = NULL, na.rm = FALSE, + sig_method.type = "two.sided.approx", + alpha = 0.05, ncores = NULL ) } @@ -45,6 +47,14 @@ The default value is NULL.} \item{na.rm}{A logical value indicating if NAs should be removed (TRUE) or kept (FALSE) for computation. The default value is FALSE.} +\item{sig_method.type}{A character string indicating the test type of the +significance method. Check \code{RandomWalkTest()} parameter +\code{test.type} for details. The default is 'two.sided.approx', which is +the default of \code{RandomWalkTest()}.} + +\item{alpha}{A numeric of the significance level to be used in the statistical +significance test. The default value is 0.05.} + \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } @@ -71,9 +81,9 @@ forecast, while negative values indicate that it has a lower skill. Examples of reference forecasts are the climatological forecast (average of the observations), a previous model version, or another model. It is computed as \code{AbsBiasSS = 1 - AbsBias_exp / AbsBias_ref}. The statistical significance -is obtained based on a Random Walk test at the 95% confidence level (DelSole -and Tippett, 2016). If there is more than one dataset, the result will be -computed for each pair of exp and obs data. +is obtained based on a Random Walk test at the confidence level specified +(DelSole and Tippett, 2016). If there is more than one dataset, the result +will be computed for each pair of exp and obs data. } \examples{ exp <- array(rnorm(1000), dim = c(dat = 1, lat = 3, lon = 5, member = 10, sdate = 50)) diff --git a/man/CRPSS.Rd b/man/CRPSS.Rd index 3fa66b0..b609188 100644 --- a/man/CRPSS.Rd +++ b/man/CRPSS.Rd @@ -13,6 +13,8 @@ CRPSS( dat_dim = NULL, Fair = FALSE, clim.cross.val = TRUE, + sig_method.type = "two.sided.approx", + alpha = 0.05, ncores = NULL ) } @@ -55,6 +57,14 @@ forecast in cross-validation (i.e. excluding the observed value of the time step when building the probabilistic distribution function for that particular time step). Only used if 'ref' is NULL. The default value is TRUE.} +\item{sig_method.type}{A character string indicating the test type of the +significance method. Check \code{RandomWalkTest()} parameter +\code{test.type} for details. The default is 'two.sided.approx', which is +the default of \code{RandomWalkTest()}.} + +\item{alpha}{A numeric of the significance level to be used in the statistical +significance test. The default value is 0.05.} + \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } @@ -81,8 +91,8 @@ higher skill than the reference forecast, while a negative value means that it has a lower skill. Examples of reference forecasts are the climatological forecast, persistence, a previous model version, or another model. It is computed as 'CRPSS = 1 - CRPS_exp / CRPS_ref. The statistical significance is -obtained based on a Random Walk test at the 95% confidence level (DelSole and -Tippett, 2016). +obtained based on a Random Walk test at the specified confidence level +(DelSole and Tippett, 2016). } \examples{ exp <- array(rnorm(1000), dim = c(lat = 3, lon = 2, member = 10, sdate = 50)) diff --git a/man/RPSS.Rd b/man/RPSS.Rd index 0cf7ba5..4b5b522 100644 --- a/man/RPSS.Rd +++ b/man/RPSS.Rd @@ -19,6 +19,8 @@ RPSS( weights_ref = NULL, cross.val = FALSE, na.rm = FALSE, + sig_method.type = "two.sided.approx", + alpha = 0.05, ncores = NULL ) } @@ -89,6 +91,14 @@ means the lower limit for the fraction of the non-NA values. 1 is equal to FALSE (no NA is acceptable), 0 is equal to TRUE (all NAs are acceptable). than na.rm. Otherwise, RPS will be calculated. The default value is FALSE.} +\item{sig_method.type}{A character string indicating the test type of the +significance method. Check \code{RandomWalkTest()} parameter +\code{test.type} for details. The default is 'two.sided.approx', which is +the default of \code{RandomWalkTest()}.} + +\item{alpha}{A numeric of the significance level to be used in the statistical +significance test. The default value is 0.05.} + \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } @@ -115,8 +125,8 @@ Examples of reference forecasts are the climatological forecast (same probabilities for all categories for all time steps), persistence, a previous model version, and another model. It is computed as \code{RPSS = 1 - RPS_exp / RPS_ref}. The statistical significance is obtained -based on a Random Walk test at the 95% confidence level (DelSole and Tippett, -2016).\cr +based on a Random Walk test at the specified confidence level (DelSole and +Tippett, 2016).\cr The function accepts either the ensemble members or the probabilities of each data as inputs. If there is more than one dataset, RPSS will be computed for each pair of exp and obs data. The NA ratio of data will be @@ -141,11 +151,14 @@ dim(weights) <- c(member = 10, sdate = 50) res <- RPSS(exp = exp, obs = obs) ## climatology as reference forecast res <- RPSS(exp = exp, obs = obs, ref = ref) ## ref as reference forecast res <- RPSS(exp = exp, obs = obs, ref = ref, weights_exp = weights, weights_ref = weights) +res <- RPSS(exp = exp, obs = obs, alpha = 0.01, sig_method.type = 'two.sided') + # Use probs as input exp_probs <- GetProbs(exp, memb_dim = 'member') obs_probs <- GetProbs(obs, memb_dim = NULL) ref_probs <- GetProbs(ref, memb_dim = 'member') -res <- RPSS(exp = exp_probs, obs = obs_probs, ref = ref_probs, memb_dim = NULL, cat_dim = 'bin') +res <- RPSS(exp = exp_probs, obs = obs_probs, ref = ref_probs, memb_dim = NULL, + cat_dim = 'bin') } \references{ diff --git a/tests/testthat/test-AbsBiasSS.R b/tests/testthat/test-AbsBiasSS.R index b194ce2..1df34c4 100644 --- a/tests/testthat/test-AbsBiasSS.R +++ b/tests/testthat/test-AbsBiasSS.R @@ -261,6 +261,20 @@ test_that("5. Output checks: dat4", { c(-0.213733950, -0.214240924, 0.110399615, -0.009733463, 0.264602089) ) + # sig_method.type + expect_equal( + c(AbsBiasSS(exp4, obs4, memb_dim = 'member', dat_dim = 'dataset')$sign), + c(F, T, F, F, F, F, T, F, F, F, F, F) + ) + expect_equal( + c(AbsBiasSS(exp4, obs4, memb_dim = 'member', dat_dim = 'dataset', sig_method.type = 'two.sided', alpha = 0.01)$sign), + rep(F, 12) + ) + expect_equal( + c(AbsBiasSS(exp4, obs4, memb_dim = 'member', dat_dim = 'dataset', sig_method.type = 'less', alpha = 0.1)$sign), + c(F, T, F, T, F, F, T, rep(F, 5)) + ) + }) ############################################## diff --git a/tests/testthat/test-CRPSS.R b/tests/testthat/test-CRPSS.R index 06b1bdb..f069191 100644 --- a/tests/testthat/test-CRPSS.R +++ b/tests/testthat/test-CRPSS.R @@ -188,6 +188,28 @@ test_that("2. Output checks: dat1", { tolerance = 0.0001 ) + # sig_method.type + expect_equal( + as.vector(CRPSS(exp1, obs1, sig_method.type = "two.sided", alpha = 0.15)$sign), + c(FALSE, FALSE) + ) + expect_equal( + as.vector(CRPSS(exp1, obs1, sig_method.type = "two.sided", alpha = 0.4)$sign), + c(FALSE, TRUE) + ) + expect_equal( + as.vector(CRPSS(exp1, obs1, ref1, sig_method.type = "two.sided", alpha = 0.15)$sign), + c(TRUE, FALSE) + ) + expect_equal( + as.vector(CRPSS(exp1, obs1, ref1, sig_method.type = "two.sided", alpha = 0.4)$sign), + c(TRUE, FALSE) + ) + expect_equal( + as.vector(CRPSS(exp1, obs1, ref1, sig_method.type = "less", alpha = 0.15)$sign), + c(FALSE, FALSE) + ) + }) ############################################## @@ -308,6 +330,17 @@ test_that("4. Output checks: dat3", { as.vector(CRPSS(exp2, obs2)$crpss) ) + # sig_method.type + expect_equal( + as.vector(CRPSS(exp3, obs3, dat_dim = 'dataset', sig_method.type = "two.sided", alpha = 0.5)$sign), + rep(F, 6) + ) + expect_equal( + as.vector(CRPSS(exp3, obs3, dat_dim = 'dataset', sig_method.type = "less", alpha = 0.5)$sign), + rep(T, 6) + ) + + }) ############################################## diff --git a/tests/testthat/test-RPSS.R b/tests/testthat/test-RPSS.R index f36e69b..5e90e95 100644 --- a/tests/testthat/test-RPSS.R +++ b/tests/testthat/test-RPSS.R @@ -303,6 +303,32 @@ test_that("2. Output checks: dat1", { c(F, F) ) + # sig_method.type + expect_equal( + c(RPSS(exp1, obs1, alpha = 0.05, sig_method.type = "two.sided")$sign), + c(F, F) + ) + expect_equal( + c(RPSS(exp1 + 1:60, obs = obs1 + 1:20, alpha = 0.025, sig_method.type = "two.sided")$sign), + c(T, T) + ) + expect_equal( + c(RPSS(exp1 + 1:60, obs = obs1 + 1:20, alpha = 0.01, sig_method.type = "two.sided")$sign), + c(F, F) + ) + expect_equal( + c(RPSS(exp1, obs1, alpha = 0.01, sig_method.type = "greater")$sign), + c(F, F) + ) + expect_equal( + c(RPSS(exp1, obs1, alpha = 0.4, sig_method.type = "greater")$sign), + c(F, F) + ) + expect_equal( + c(RPSS(exp1, obs1, alpha = 0.4, sig_method.type = "less")$sign), + c(T, T) + ) + }) ############################################## @@ -440,6 +466,21 @@ test_that("4. Output checks: dat3", { RPSS(exp3, obs3, dat_dim = 'dataset')$rpss[1], RPSS(exp2, obs2)$rpss ) + + # sig_method.type + expect_equal( + c(RPSS(exp3, obs3, dat_dim = 'dataset', alpha = 0.05, sig_method.type = "two.sided")$sign), + c(F,F,T,F,F,F) + ) + expect_equal( + c(RPSS(exp3, obs3, dat_dim = 'dataset', alpha = 0.01, sig_method.type = "two.sided")$sign), + rep(F, 6) + ) + expect_equal( + c(RPSS(exp3, obs3, dat_dim = 'dataset', alpha = 0.05, sig_method.type = "greater")$sign), + rep(F, 6) + ) + }) ############################################## -- GitLab