diff --git a/R/AbsBiasSS.R b/R/AbsBiasSS.R index 8cb1bcee6edabb662aace1ba9e1aaa8da5e3ba82..e55d3d8f6a106a481f528c139d6e9b09c952e5d6 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 6b1ed171a681e3e2b790060f47db1c556969a1b8..159e2bdb2894ce509008da1cbe899d2bcdfe6e90 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 7e2b3ac8b6d7753f8eab108271c41a8e15357a4f..91ca8c21acd8a877f17d3d0cf5d1db5d67ea0d3c 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 029101d06d6c3f31b69d8936ef3852b2702e2c8c..ac4ca4a040e76731a61fbe16cf577ed12e1f0429 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 3fa66b0a7f17f70594f255faebbad42c2b592664..b6091880d4d632f724aa71bbbb1e2f6d459c69c1 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 0cf7ba56d30901ffed25af2a49d2fa703043b20c..4b5b52250ab32f830a289d8a3c47122cfffecd2a 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 b194ce2a5e64a3d07379c66819c2e4b12a158636..1df34c48ec6e0678cfb21b9f1ccbcee309dc73b3 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 06b1bdb187289e7d025c695883b952719e15d0b5..f06919140c68b691ba45dec492d536ece65c0e9c 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 f36e69b260b681b7aea0d397a0a98d0c97f02f19..5e90e954ff48770d4f1fd848ae27b082e196093c 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) + ) + }) ##############################################