From 24fa1eee9ee8fa058d6420227cce07dcff0d2b5f Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 2 Feb 2023 03:38:12 +0100 Subject: [PATCH] Remove param 'N.eff'; its value should always be length(skill_A) --- R/RandomWalkTest.R | 40 ++++------------------------ man/RandomWalkTest.Rd | 6 ----- man/clim.palette.Rd | 5 ++-- tests/testthat/test-RandomWalkTest.R | 40 ---------------------------- 4 files changed, 8 insertions(+), 83 deletions(-) diff --git a/R/RandomWalkTest.R b/R/RandomWalkTest.R index 7a222cd..8d5f67f 100644 --- a/R/RandomWalkTest.R +++ b/R/RandomWalkTest.R @@ -11,10 +11,6 @@ #' 'skill_A'. #'@param time_dim A character string indicating the name of the dimension along #' which the tests are computed. The default value is 'sdate'. -#'@param N.eff Effective sample size to be used in the statistical significance -#' test. It can be NA (to use the length of the "time_dim" dimension) or an -#' array with the same dimensions as "skill_A" except "time_dim" (for a -#' particular N.eff to be used for each case). The default value is NA. #'@param test.type A character string indicating the type of significance test. #' It can be "two.sided.approx" (to assess whether forecaster A and forecaster #' B are significantly different in terms of skill with a two-sided test using @@ -89,7 +85,7 @@ #'@import multiApply #'@importFrom ClimProjDiags Subset #'@export -RandomWalkTest <- function(skill_A, skill_B, time_dim = 'sdate', N.eff = NA, +RandomWalkTest <- function(skill_A, skill_B, time_dim = 'sdate', test.type = 'two.sided.approx', alpha = 0.05, pval = TRUE, sign = FALSE, ncores = NULL) { @@ -111,17 +107,6 @@ RandomWalkTest <- function(skill_A, skill_B, time_dim = 'sdate', N.eff = NA, if (!time_dim %in% names(dim(skill_A)) | !time_dim %in% names(dim(skill_B))) { stop("Parameter 'time_dim' is not found in 'skill_A' or 'skill_B' dimensions.") } - ## N.eff - if (is.array(N.eff)) { - if (!is.numeric(N.eff)) stop("Parameter 'N.eff' must be a numeric array or NA.") - if (!identical(dim(N.eff), dim(skill_A)[-which(names(dim(skill_A)) == time_dim)])) { - stop("If parameter 'N.eff' is provided with an array, it must ", - "have the same dimensions as 'skill_A' except 'time_dim'.") - } - } else if (!identical(N.eff, NA)) { - stop("Parameter 'N.eff' must be NA or an array with ", - "the same dimensions as 'skill_A' except 'time_dim'.") - } ## alpha if (any(!is.numeric(alpha) | alpha <= 0 | alpha >= 1 | length(alpha) > 1)) { stop("Parameter 'alpha' must be a number between 0 and 1.") @@ -149,38 +134,23 @@ RandomWalkTest <- function(skill_A, skill_B, time_dim = 'sdate', N.eff = NA, } ## Compute the Random Walk Test - if (is.array(N.eff)) { - res <- Apply(data = list(skill_A = skill_A, - skill_B = skill_B, - N.eff = N.eff), - target_dims = list(skill_A = time_dim, - skill_B = time_dim, - N.eff = NULL), - fun = .RandomWalkTest, - test.type = test.type, - alpha = alpha, pval = pval, sign = sign, - ncores = ncores) - } else { res <- Apply(data = list(skill_A = skill_A, skill_B = skill_B), target_dims = list(skill_A = time_dim, skill_B = time_dim), fun = .RandomWalkTest, - N.eff = N.eff, test.type = test.type, alpha = alpha, pval = pval, sign = sign, ncores = ncores) - } return(res) } -.RandomWalkTest <- function(skill_A, skill_B, N.eff = NA, test.type = 'two.sided.approx', +.RandomWalkTest <- function(skill_A, skill_B, test.type = 'two.sided.approx', alpha = 0.05, pval = TRUE, sign = FALSE) { - - if (is.na(N.eff)) { - N.eff <- length(skill_A) - } + #skill_A and skill_B: [sdate] + + N.eff <- length(skill_A) A_better <- sum(skill_B > skill_A) B_better <- sum(skill_B < skill_A) diff --git a/man/RandomWalkTest.Rd b/man/RandomWalkTest.Rd index cd02b4f..e123669 100644 --- a/man/RandomWalkTest.Rd +++ b/man/RandomWalkTest.Rd @@ -8,7 +8,6 @@ RandomWalkTest( skill_A, skill_B, time_dim = "sdate", - N.eff = NA, test.type = "two.sided.approx", alpha = 0.05, pval = TRUE, @@ -27,11 +26,6 @@ with the forecaster B. The dimensions should be identical as parameter \item{time_dim}{A character string indicating the name of the dimension along which the tests are computed. The default value is 'sdate'.} -\item{N.eff}{Effective sample size to be used in the statistical significance -test. It can be NA (to use the length of the "time_dim" dimension) or an -array with the same dimensions as "skill_A" except "time_dim" (for a -particular N.eff to be used for each case). The default value is NA.} - \item{test.type}{A character string indicating the type of significance test. It can be "two.sided.approx" (to assess whether forecaster A and forecaster B are significantly different in terms of skill with a two-sided test using diff --git a/man/clim.palette.Rd b/man/clim.palette.Rd index 5d17947..94c9055 100644 --- a/man/clim.palette.Rd +++ b/man/clim.palette.Rd @@ -12,8 +12,9 @@ clim.colors(n, palette = "bluered") \arguments{ \item{palette}{Which type of palette to generate: from blue through white to red ('bluered'), from red through white to blue ('redblue'), from -yellow through orange to red ('yellowred'), or from red through orange -to red ('redyellow').} +yellow through orange to red ('yellowred'), from red through orange to +red ('redyellow'), from purple through white to orange ('purpleorange'), +and from orange through white to purple ('orangepurple').} \item{n}{Number of colors to generate.} } diff --git a/tests/testthat/test-RandomWalkTest.R b/tests/testthat/test-RandomWalkTest.R index 1af1d19..a0462c8 100644 --- a/tests/testthat/test-RandomWalkTest.R +++ b/tests/testthat/test-RandomWalkTest.R @@ -11,7 +11,6 @@ context("s2dv::RandomWalkTest tests") dat2_A <- array(rnorm(8), dim = c(sdate = 4, ftime = 2)) set.seed(2) dat2_B <- array(rnorm(8), dim = c(sdate = 4, ftime = 2)) - N.eff2 <- array(3:4, dim = c(ftime = 2)) ############################################## test_that("1. Input checks", { @@ -37,18 +36,6 @@ test_that("1. Input checks", { "Parameter 'time_dim' is not found in 'skill_A' or 'skill_B' dimension." ) expect_error( - RandomWalkTest(dat1_A, dat1_B, N.eff = as.array(T)), - "Parameter 'N.eff' must be a numeric array or NA." - ) - expect_error( - RandomWalkTest(dat1_A, dat1_B, N.eff = array(1:4, dim = c(ftime = 4))), - "If parameter 'N.eff' is provided with an array, it must have the same dimensions as 'skill_A' except 'time_dim'." - ) - expect_error( - RandomWalkTest(dat1_A, dat1_B, N.eff = 1), - "Parameter 'N.eff' must be NA or an array with the same dimensions as 'skill_A' except 'time_dim'." - ) - expect_error( RandomWalkTest(dat1_A, dat1_B, alpha = 1), "Parameter 'alpha' must be a number between 0 and 1." ) @@ -171,33 +158,6 @@ test_that("3. Output checks: dat2", { c(F, T) ) -#------------------------------- - res4 <- RandomWalkTest(dat2_A, dat2_B - 2, sign = T, test.type = "less", alpha = 0.1, N.eff = N.eff2) - expect_equal( - dim(res4$score), - c(ftime = 2) - ) - expect_equal( - dim(res4$sign), - c(ftime = 2) - ) - expect_equal( - dim(res4$p.val), - c(ftime = 2) - ) - expect_equal( - as.vector(res4$score), - c(-2, -4) - ) - expect_equal( - as.vector(res4$p), - c(0.5000, 0.0625) - ) - expect_equal( - as.vector(res4$sign), - c(F, T) - ) - }) -- GitLab