From 574ce5898c6cb529fe959e40059370888448813f Mon Sep 17 00:00:00 2001 From: jcos Date: Wed, 22 Jun 2022 15:33:33 +0200 Subject: [PATCH 1/6] split weights into weights_ref and weights_exp --- R/RPSS.R | 56 ++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 36 insertions(+), 20 deletions(-) diff --git a/R/RPSS.R b/R/RPSS.R index 3b24777..50d4c3f 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -34,11 +34,13 @@ #'@param Fair A logical indicating whether to compute the FairRPSS (the #' potential RPSS that the forecast would have with an infinite ensemble size). #' The default value is FALSE. -#'@param weights A named two-dimensional numerical array of the weights for each -#' member and time. The dimension names should include 'memb_dim' and -#' 'time_dim'. The default value is NULL. The ensemble should have at least 70 -#' members or span at least 10 time steps and have more than 45 members if -#' consistency between the weighted and unweighted methodologies is desired. +#'@param weights_exp A named two-dimensional numerical array of the forecast +#' ensemble weights for each member and time. The dimension names should +#' include 'memb_dim' and 'time_dim'. The default value is NULL. The ensemble +#' should have at least 70 members or span at least 10 time steps and have +#' more than 45 members if consistency between the weighted and unweighted +#' methodologies is desired. +#'@param weights_ref Same as 'weights_exp' but for the reference ensemble. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -67,7 +69,7 @@ #'@export RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', prob_thresholds = c(1/3, 2/3), indices_for_clim = NULL, Fair = FALSE, - weights = NULL, ncores = NULL) { + weights_exp = NULL, weights_ref = NULL, ncores = NULL) { # Check inputs ## exp, obs, and ref (1) @@ -140,17 +142,29 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', if (!is.logical(Fair) | length(Fair) > 1) { stop("Parameter 'Fair' must be either TRUE or FALSE.") } - ## weights - if (!is.null(weights)) { - if (!is.array(weights) | !is.numeric(weights)) - stop('Parameter "weights" must be a two-dimensional numeric array.') - if (length(dim(weights)) != 2 | any(!names(dim(weights)) %in% c(memb_dim, time_dim))) - stop("Parameter 'weights' must have two dimensions with the names of memb_dim and time_dim.") - if (dim(weights)[memb_dim] != dim(exp)[memb_dim] | - dim(weights)[time_dim] != dim(exp)[time_dim]) { - stop("Parameter 'weights' must have the same dimension lengths as memb_dim and time_dim in 'exp'.") + ## weights_exp + if (!is.null(weights_exp)) { + if (!is.array(weights_exp) | !is.numeric(weights_exp)) + stop('Parameter "weights_exp" must be a two-dimensional numeric array.') + if (length(dim(weights_exp)) != 2 | any(!names(dim(weights_exp)) %in% c(memb_dim, time_dim))) + stop("Parameter 'weights_exp' must have two dimensions with the names of memb_dim and time_dim.") + if (dim(weights_exp)[memb_dim] != dim(exp)[memb_dim] | + dim(weights_exp)[time_dim] != dim(exp)[time_dim]) { + stop("Parameter 'weights_exp' must have the same dimension lengths as memb_dim and time_dim in 'exp'.") } - weights <- Reorder(weights, c(time_dim, memb_dim)) + weights_exp <- Reorder(weights_exp, c(time_dim, memb_dim)) + } + ## weights_ref + if (!is.null(weights_ref)) { + if (!is.array(weights_ref) | !is.numeric(weights_ref)) + stop('Parameter "weights_ref" must be a two-dimensional numeric array.') + if (length(dim(weights_ref)) != 2 | any(!names(dim(weights_ref)) %in% c(memb_dim, time_dim))) + stop("Parameter 'weights_ref' must have two dimensions with the names of memb_dim and time_dim.") + if (dim(weights_ref)[memb_dim] != dim(exp)[memb_dim] | + dim(weights_ref)[time_dim] != dim(exp)[time_dim]) { + stop("Parameter 'weights_ref' must have the same dimension lengths as memb_dim and time_dim in 'exp'.") + } + weights_ref <- Reorder(weights_ref, c(time_dim, memb_dim)) } ## ncores if (!is.null(ncores)) { @@ -184,21 +198,23 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', fun = .RPSS, prob_thresholds = prob_thresholds, indices_for_clim = indices_for_clim, Fair = Fair, - weights = weights, + weights_exp = weights_exp, + weights_ref = weights_ref, ncores = ncores) return(output) } .RPSS <- function(exp, obs, ref = NULL, prob_thresholds = c(1/3, 2/3), - indices_for_clim = NULL, Fair = FALSE, weights = NULL) { + indices_for_clim = NULL, Fair = FALSE, + weights_exp = NULL, weights_ref = NULL) { # exp: [sdate, memb] # obs: [sdate, (memb)] # ref: [sdate, memb] or NULL # RPS of the forecast rps_exp <- .RPS(exp = exp, obs = obs, prob_thresholds = prob_thresholds, - indices_for_clim = indices_for_clim, Fair = Fair, weights = weights) + indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_exp) # RPS of the reference forecast if (is.null(ref)) { ## using climatology as reference forecast @@ -227,7 +243,7 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', } else { # use "ref" as reference forecast rps_ref <- .RPS(exp = ref, obs = obs, prob_thresholds = prob_thresholds, - indices_for_clim = indices_for_clim, Fair = Fair, weights = weights) + indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_ref) } # RPSS -- GitLab From fdd671e373e80fa76c3970945eee1bd5813eb3a6 Mon Sep 17 00:00:00 2001 From: jcos Date: Wed, 22 Jun 2022 15:46:10 +0200 Subject: [PATCH 2/6] fix test --- tests/testthat/test-RPSS.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-RPSS.R b/tests/testthat/test-RPSS.R index c63add0..0e98320 100644 --- a/tests/testthat/test-RPSS.R +++ b/tests/testthat/test-RPSS.R @@ -168,7 +168,7 @@ c(0.5259259, 0.4771242), tolerance = 0.0001 ) expect_equal( -as.vector(RPSS(exp1, obs1, ref1, weights = weights1)$rpss), +as.vector(RPSS(exp1, obs1, ref1, weights_exp = weights1)$rpss), c(0.6596424, 0.4063579), tolerance = 0.0001 ) -- GitLab From 88114fd001130a1ae0d148df10fb6439c93c89ae Mon Sep 17 00:00:00 2001 From: jcos Date: Tue, 28 Jun 2022 13:02:07 +0200 Subject: [PATCH 3/6] fix test differences --- tests/testthat/test-RPSS.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-RPSS.R b/tests/testthat/test-RPSS.R index 0e98320..081cb56 100644 --- a/tests/testthat/test-RPSS.R +++ b/tests/testthat/test-RPSS.R @@ -168,7 +168,7 @@ c(0.5259259, 0.4771242), tolerance = 0.0001 ) expect_equal( -as.vector(RPSS(exp1, obs1, ref1, weights_exp = weights1)$rpss), +as.vector(RPSS(exp1, obs1, ref1, weights_exp = weights1, weights_ref = weights)$rpss), c(0.6596424, 0.4063579), tolerance = 0.0001 ) -- GitLab From 4c8a83b255897055f1cd5b4f245041a35b1e2b7b Mon Sep 17 00:00:00 2001 From: jcos Date: Tue, 28 Jun 2022 13:26:02 +0200 Subject: [PATCH 4/6] fix wrong weights array name in test --- tests/testthat/test-RPSS.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-RPSS.R b/tests/testthat/test-RPSS.R index 081cb56..2b80be3 100644 --- a/tests/testthat/test-RPSS.R +++ b/tests/testthat/test-RPSS.R @@ -168,7 +168,7 @@ c(0.5259259, 0.4771242), tolerance = 0.0001 ) expect_equal( -as.vector(RPSS(exp1, obs1, ref1, weights_exp = weights1, weights_ref = weights)$rpss), +as.vector(RPSS(exp1, obs1, ref1, weights_exp = weights1, weights_ref = weights1)$rpss), c(0.6596424, 0.4063579), tolerance = 0.0001 ) -- GitLab From 5e69a01ac18b067ca4d59feaae2592dfb93de5bb Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 1 Jul 2022 17:15:30 +0200 Subject: [PATCH 5/6] Add 'weights' back to remain compatibility. Update document. --- R/RPSS.R | 12 +++++++++++- man/RPSS.Rd | 18 +++++++++++++----- 2 files changed, 24 insertions(+), 6 deletions(-) diff --git a/R/RPSS.R b/R/RPSS.R index 50d4c3f..f97080c 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -34,6 +34,8 @@ #'@param Fair A logical indicating whether to compute the FairRPSS (the #' potential RPSS that the forecast would have with an infinite ensemble size). #' The default value is FALSE. +#'@param weights Deprecated and will be removed in the next release. Please use +#' 'weights_exp' and 'weights_ref' instead. #'@param weights_exp A named two-dimensional numerical array of the forecast #' ensemble weights for each member and time. The dimension names should #' include 'memb_dim' and 'time_dim'. The default value is NULL. The ensemble @@ -68,7 +70,7 @@ #'@import multiApply #'@export RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', - prob_thresholds = c(1/3, 2/3), indices_for_clim = NULL, Fair = FALSE, + prob_thresholds = c(1/3, 2/3), indices_for_clim = NULL, Fair = FALSE, weights = NULL, weights_exp = NULL, weights_ref = NULL, ncores = NULL) { # Check inputs @@ -142,6 +144,14 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', if (!is.logical(Fair) | length(Fair) > 1) { stop("Parameter 'Fair' must be either TRUE or FALSE.") } + ## weights + if (!is.null(weights)) { + warning(paste0("Parameter 'weights' is deprecated and will be removed in the next release. ", + "Use 'weights_exp' and 'weights_ref' instead. The value will be assigned ", + "to these two parameters now if they are NULL.")) + if (is.null(weights_exp)) weights_exp <- weights + if (is.null(weights_ref)) weights_ref <- weights + } ## weights_exp if (!is.null(weights_exp)) { if (!is.array(weights_exp) | !is.numeric(weights_exp)) diff --git a/man/RPSS.Rd b/man/RPSS.Rd index 5b8bd7e..893169d 100644 --- a/man/RPSS.Rd +++ b/man/RPSS.Rd @@ -14,6 +14,8 @@ RPSS( indices_for_clim = NULL, Fair = FALSE, weights = NULL, + weights_exp = NULL, + weights_ref = NULL, ncores = NULL ) } @@ -48,11 +50,17 @@ the whole period is used. The default value is NULL.} potential RPSS that the forecast would have with an infinite ensemble size). The default value is FALSE.} -\item{weights}{A named two-dimensional numerical array of the weights for each -member and time. The dimension names should include 'memb_dim' and -'time_dim'. The default value is NULL. The ensemble should have at least 70 -members or span at least 10 time steps and have more than 45 members if -consistency between the weighted and unweighted methodologies is desired.} +\item{weights}{Deprecated and will be removed in the next release. Please use +'weights_exp' and 'weights_ref' instead.} + +\item{weights_exp}{A named two-dimensional numerical array of the forecast +ensemble weights for each member and time. The dimension names should +include 'memb_dim' and 'time_dim'. The default value is NULL. The ensemble +should have at least 70 members or span at least 10 time steps and have +more than 45 members if consistency between the weighted and unweighted +methodologies is desired.} + +\item{weights_ref}{Same as 'weights_exp' but for the reference ensemble.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} -- GitLab From 6f555454ee541b9b383dec85a88263146b84876c Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 1 Jul 2022 17:17:18 +0200 Subject: [PATCH 6/6] Correct typo and update unit test --- tests/testthat/test-RPSS.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/tests/testthat/test-RPSS.R b/tests/testthat/test-RPSS.R index 2b80be3..6473b24 100644 --- a/tests/testthat/test-RPSS.R +++ b/tests/testthat/test-RPSS.R @@ -88,18 +88,18 @@ test_that("1. Input checks", { RPSS(exp1, obs1, Fair = 1), "Parameter 'Fair' must be either TRUE or FALSE." ) - # weights + # weights_exp and weights_ref expect_error( - RPS(exp1, obs1, weights = c(0, 1)), - 'Parameter "weights" must be a two-dimensional numeric array.' + RPSS(exp1, obs1, weights_exp = c(0, 1)), + 'Parameter "weights_exp" must be a two-dimensional numeric array.' ) expect_error( - RPS(exp1, obs1, weights = array(1, dim = c(member = 3, time = 10))), - "Parameter 'weights' must have two dimensions with the names of memb_dim and time_dim." + RPSS(exp1, obs1, weights_exp = array(1, dim = c(member = 3, time = 10))), + "Parameter 'weights_exp' must have two dimensions with the names of memb_dim and time_dim." ) expect_error( - RPS(exp1, obs1, weights = array(1, dim = c(member = 3, sdate = 1))), - "Parameter 'weights' must have the same dimension lengths as memb_dim and time_dim in 'exp'." + RPSS(exp1, obs1, weights_ref = array(1, dim = c(member = 3, sdate = 1))), + "Parameter 'weights_ref' must have the same dimension lengths as memb_dim and time_dim in 'exp'." ) # ncores expect_error( -- GitLab