From e0dbeb1a093fd7d014abe20470049031e926131c Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Fri, 5 Apr 2024 16:22:20 +0200 Subject: [PATCH 1/5] included na.rm option --- R/CRPS.R | 44 +++++++++- R/CRPSS.R | 237 +++++++++++++++++++++++++++++++----------------------- 2 files changed, 177 insertions(+), 104 deletions(-) diff --git a/R/CRPS.R b/R/CRPS.R index bb63095..e81a840 100644 --- a/R/CRPS.R +++ b/R/CRPS.R @@ -28,6 +28,11 @@ #'@param return_mean A logical indicating whether to return the temporal mean #' of the CRPS or not. If TRUE, the temporal mean is calculated along time_dim, #' if FALSE the time dimension is not aggregated. The default is TRUE. +#'@param na.rm A logical or numeric value between 0 and 1. If it is numeric, it +#' 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). +# 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 ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -50,7 +55,7 @@ #'@importFrom ClimProjDiags Subset #'@export CRPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NULL, - Fair = FALSE, return_mean = TRUE, ncores = NULL) { + Fair = FALSE, return_mean = TRUE, na.rm = FALSE, ncores = NULL) { # Check inputs ## exp and obs (1) if (!is.array(exp) | !is.numeric(exp)) @@ -113,6 +118,10 @@ CRPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NU if (!is.logical(return_mean) | length(return_mean) > 1) { stop("Parameter 'return_mean' must be either TRUE or FALSE.") } + ## na.rm + 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') + } ## ncores if (!is.null(ncores)) { if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { @@ -129,6 +138,7 @@ CRPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NU fun = .CRPS, time_dim = time_dim, memb_dim = memb_dim, dat_dim = dat_dim, Fair = Fair, + na.rm = na.rm, ncores = ncores)$output1 if (return_mean) { @@ -141,7 +151,7 @@ CRPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NU } .CRPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NULL, - Fair = FALSE) { + Fair = FALSE, na.rm = FALSE) { # exp: [sdate, memb, (dat_dim)] # obs: [sdate, (dat_dim)] @@ -170,8 +180,34 @@ CRPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NU if (is.null(dim(exp_data))) dim(exp_data) <- c(dim(exp)[1:2]) if (is.null(dim(obs_data))) dim(obs_data) <- c(dim(obs)[1]) - crps <- SpecsVerification::enscrps_cpp(ens = exp_data, obs = obs_data, R_new = R_new) - CRPS[, i, j] <- crps + # Find the fraction of NAs + ## If any member/bin is NA at this time step, it is not good value. + exp_mean <- rowMeans(exp_data) + obs_mean <- rowMeans(obs_data) + good_values <- !is.na(exp_mean) & !is.na(obs_mean) + + if (isTRUE(na.rm)) { + f_NAs <- 0 + } else if (isFALSE(na.rm)) { + f_NAs <- 1 + } else { + f_NAs <- na.rm + } + + if (f_NAs <= sum(good_values) / length(obs_mean)) { + + exp_data <- exp_data[good_values, , drop = F] + obs_data <- obs_data[good_values, , drop = F] + + crps <- SpecsVerification::enscrps_cpp(ens = exp_data, obs = obs_data, R_new = R_new) + CRPS[, i, j] <- crps + + } else { ## not enough values different from NA + + CRPS[, i, j] <- NA_real_ + + } + } } diff --git a/R/CRPSS.R b/R/CRPSS.R index 5c901ac..b341efb 100644 --- a/R/CRPSS.R +++ b/R/CRPSS.R @@ -46,6 +46,11 @@ #' 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 na.rm A logical or numeric value between 0 and 1. If it is numeric, it +#' 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). +# 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 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 @@ -80,7 +85,7 @@ #'@export 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, ncores = NULL) { + na.rm = FALSE, alpha = 0.05, ncores = NULL) { # Check inputs ## exp, obs, and ref (1) @@ -179,6 +184,10 @@ 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.") } + ## na.rm + 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.") @@ -225,138 +234,166 @@ CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', dat_dim = dat_dim, Fair = Fair, clim.cross.val = clim.cross.val, sig_method.type = sig_method.type, alpha = alpha, - ncores = ncores) + na.rm = na.rm, 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, - sig_method.type = 'two.sided.approx', alpha = 0.05) { + sig_method.type = 'two.sided.approx', na.rm = FALSE, alpha = 0.05) { # exp: [sdate, memb, (dat)] # obs: [sdate, (dat)] # ref: [sdate, memb, (dat)] or NULL - - if (is.null(dat_dim)) { - nexp <- 1 - nobs <- 1 + + if (isTRUE(na.rm)) { + f_NAs <- 0 + } else if (isFALSE(na.rm)) { + f_NAs <- 1 } else { - nexp <- as.numeric(dim(exp)[dat_dim]) - nobs <- as.numeric(dim(obs)[dat_dim]) + f_NAs <- na.rm } - #----- CRPS of the forecast - # [sdate, (nexp), (nobs)] - crps_exp <- .CRPS(exp = exp, obs = obs, time_dim = time_dim, memb_dim = memb_dim, - dat_dim = dat_dim, Fair = Fair) + ## option of having several nexp and nobs missing?? + # Find good values then calculate RPS + exp_mean <- rowMeans(exp) + obs_mean <- rowMeans(obs) + if (!is.null(ref)){ + ref_mean <- rowMeans(ref) + good_values <- !is.na(exp_mean) & !is.na(obs_mean) & !is.na(ref_mean) + } else { + good_values <- !is.na(exp_mean) & !is.na(obs_mean) + } - #----- CRPS of the reference forecast - if (is.null(ref)) { - ## using climatology as reference forecast - ## all the time steps are used as if they were members - ## then, ref dimensions are [sdate, memb] - ## memb dimension has length(sdate) - 1 due to cross-validation - - obs_time_len <- dim(obs)[time_dim] + if (f_NAs <= sum(good_values) / length(good_values)) { + if (is.null(dat_dim)) { - - if (isFALSE(clim.cross.val)) { ## Without cross-validation - ref <- array(data = rep(obs, each = obs_time_len), dim = c(obs_time_len, obs_time_len)) - } else if (isTRUE(clim.cross.val)) { - # With cross-validation (excluding the value of that year to create ref for that year) - ref <- array(data = NA, dim = c(obs_time_len, obs_time_len - 1)) - for (i in 1:obs_time_len) { - ref[i, ] <- obs[-i] - } - } - - names(dim(ref)) <- c(time_dim, memb_dim) - # ref: [sdate, memb]; obs: [sdate] - crps_ref <- .CRPS(exp = ref, obs = obs, time_dim = time_dim, memb_dim = memb_dim, - dat_dim = dat_dim, Fair = Fair) - # crps_ref should be [sdate] - + nexp <- 1 + nobs <- 1 } else { - crps_ref <- array(dim = c(obs_time_len, nobs)) - names(dim(crps_ref)) <- c(time_dim, 'nobs') - for (i_obs in 1:nobs) { + nexp <- as.numeric(dim(exp)[dat_dim]) + nobs <- as.numeric(dim(obs)[dat_dim]) + } + + #----- CRPS of the forecast + # [sdate, (nexp), (nobs)] + crps_exp <- .CRPS(exp = exp, obs = obs, time_dim = time_dim, memb_dim = memb_dim, + dat_dim = dat_dim, Fair = Fair) + + #----- CRPS of the reference forecast + if (is.null(ref)) { + ## using climatology as reference forecast + ## all the time steps are used as if they were members + ## then, ref dimensions are [sdate, memb] + ## memb dimension has length(sdate) - 1 due to cross-validation + + obs_time_len <- dim(obs)[time_dim] + if (is.null(dat_dim)) { if (isFALSE(clim.cross.val)) { ## Without cross-validation - ref <- array(data = rep(obs[, i_obs], each = obs_time_len), - dim = c(obs_time_len, obs_time_len)) + ref <- array(data = rep(obs, each = obs_time_len), dim = c(obs_time_len, obs_time_len)) } else if (isTRUE(clim.cross.val)) { # With cross-validation (excluding the value of that year to create ref for that year) ref <- array(data = NA, dim = c(obs_time_len, obs_time_len - 1)) for (i in 1:obs_time_len) { - ref[i, ] <- obs[-i, i_obs] + ref[i, ] <- obs[-i] } } names(dim(ref)) <- c(time_dim, memb_dim) - crps_ref[, i_obs] <- - .CRPS(exp = ref, - obs = ClimProjDiags::Subset(obs, dat_dim, i_obs, drop = 'selected'), - time_dim = time_dim, memb_dim = memb_dim, dat_dim = NULL, Fair = Fair) + # ref: [sdate, memb]; obs: [sdate] + crps_ref <- .CRPS(exp = ref, obs = obs, time_dim = time_dim, memb_dim = memb_dim, + dat_dim = dat_dim, Fair = Fair) + # crps_ref should be [sdate] + + } else { + crps_ref <- array(dim = c(obs_time_len, nobs)) + names(dim(crps_ref)) <- c(time_dim, 'nobs') + for (i_obs in 1:nobs) { + + if (isFALSE(clim.cross.val)) { ## Without cross-validation + ref <- array(data = rep(obs[, i_obs], each = obs_time_len), + dim = c(obs_time_len, obs_time_len)) + } else if (isTRUE(clim.cross.val)) { + # With cross-validation (excluding the value of that year to create ref for that year) + ref <- array(data = NA, dim = c(obs_time_len, obs_time_len - 1)) + for (i in 1:obs_time_len) { + ref[i, ] <- obs[-i, i_obs] + } + } + + names(dim(ref)) <- c(time_dim, memb_dim) + crps_ref[, i_obs] <- + .CRPS(exp = ref, + obs = ClimProjDiags::Subset(obs, dat_dim, i_obs, drop = 'selected'), + time_dim = time_dim, memb_dim = memb_dim, dat_dim = NULL, Fair = Fair) + } + # crps_ref should be [sdate, nobs] } - # crps_ref should be [sdate, nobs] - } - - } else { # ref is not NULL - if (!is.null(dat_dim) && (!dat_dim %in% names(dim(ref)))) { - remove_dat_dim <- TRUE - ref <- InsertDim(data = ref, posdim = length(dim(ref)) + 1, lendim = 1, name = dat_dim) - } else { - remove_dat_dim <- FALSE - } - crps_ref <- .CRPS(exp = ref, obs = obs, time_dim = time_dim, memb_dim = memb_dim, - dat_dim = dat_dim, Fair = Fair) - # crps_ref should be [sdate, (nexp), (nobs)] - - if (!is.null(dat_dim)) { - if (isTRUE(remove_dat_dim)) { - dim(crps_ref) <- dim(crps_ref)[-2] + + } else { # ref is not NULL + if (!is.null(dat_dim) && (!dat_dim %in% names(dim(ref)))) { + remove_dat_dim <- TRUE + ref <- InsertDim(data = ref, posdim = length(dim(ref)) + 1, lendim = 1, name = dat_dim) + } else { + remove_dat_dim <- FALSE } - } - } - - #----- CRPSS - if (!is.null(dat_dim)) { - # If ref != NULL & ref has dat_dim, crps_ref = [sdate, nexp, nobs]; - # else, crps_ref = [sdate, nobs] - - crps_exp_mean <- MeanDims(crps_exp, time_dim, na.rm = FALSE) - crps_ref_mean <- MeanDims(crps_ref, time_dim, na.rm = FALSE) - crpss <- array(dim = c(nexp = nexp, nobs = nobs)) - sign <- array(dim = c(nexp = nexp, nobs = nobs)) - - if (length(dim(crps_ref_mean)) == 1) { - 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], - test.type = sig_method.type, alpha = alpha, - sign = T, pval = F)$sign + crps_ref <- .CRPS(exp = ref, obs = obs, time_dim = time_dim, memb_dim = memb_dim, + dat_dim = dat_dim, Fair = Fair) + # crps_ref should be [sdate, (nexp), (nobs)] + + if (!is.null(dat_dim)) { + if (isTRUE(remove_dat_dim)) { + dim(crps_ref) <- dim(crps_ref)[-2] } } - } 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], - test.type = sig_method.type, alpha = alpha, - sign = T, pval = F)$sign + } + + #----- CRPSS + if (!is.null(dat_dim)) { + # If ref != NULL & ref has dat_dim, crps_ref = [sdate, nexp, nobs]; + # else, crps_ref = [sdate, nobs] + + crps_exp_mean <- MeanDims(crps_exp, time_dim, na.rm = FALSE) + crps_ref_mean <- MeanDims(crps_ref, time_dim, na.rm = FALSE) + crpss <- array(dim = c(nexp = nexp, nobs = nobs)) + sign <- array(dim = c(nexp = nexp, nobs = nobs)) + + if (length(dim(crps_ref_mean)) == 1) { + 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], + 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], + test.type = sig_method.type, alpha = alpha, + sign = T, pval = F)$sign + } } } + + } else { + crpss <- 1 - mean(crps_exp) / mean(crps_ref) + # Significance + sign <- .RandomWalkTest(skill_A = crps_exp, skill_B = crps_ref, + test.type = sig_method.type, alpha = alpha, + sign = T, pval = F)$sign } - - } else { - crpss <- 1 - mean(crps_exp) / mean(crps_ref) - # Significance - sign <- .RandomWalkTest(skill_A = crps_exp, skill_B = crps_ref, - test.type = sig_method.type, alpha = alpha, - sign = T, pval = F)$sign + + } else { ## not enough values different from NA + + crpss = NA_real_ + sign = NA_real_ + } return(list(crpss = crpss, sign = sign)) -- GitLab From de922296da5d5446e8ccb8ea7c26b58de7934d77 Mon Sep 17 00:00:00 2001 From: Paloma Trascasa-Castro Date: Fri, 5 Apr 2024 18:19:00 +0200 Subject: [PATCH 2/5] Update CRPSS.R --- R/CRPSS.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/CRPSS.R b/R/CRPSS.R index b341efb..a4e6dfd 100644 --- a/R/CRPSS.R +++ b/R/CRPSS.R @@ -258,7 +258,11 @@ CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', ## option of having several nexp and nobs missing?? # Find good values then calculate RPS exp_mean <- rowMeans(exp) - obs_mean <- rowMeans(obs) + if (length(dim(obs)) == 1){ + obs_mean <- obs + } else { + obs_mean <- rowMeans(obs) + } if (!is.null(ref)){ ref_mean <- rowMeans(ref) good_values <- !is.na(exp_mean) & !is.na(obs_mean) & !is.na(ref_mean) -- GitLab From 26aeae49d93981b30763ea47a60931941e9e29c8 Mon Sep 17 00:00:00 2001 From: Paloma Trascasa-Castro Date: Fri, 5 Apr 2024 18:23:11 +0200 Subject: [PATCH 3/5] Update CRPS.R --- R/CRPS.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/CRPS.R b/R/CRPS.R index e81a840..86cd201 100644 --- a/R/CRPS.R +++ b/R/CRPS.R @@ -183,7 +183,11 @@ CRPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NU # Find the fraction of NAs ## If any member/bin is NA at this time step, it is not good value. exp_mean <- rowMeans(exp_data) - obs_mean <- rowMeans(obs_data) + if (length(dim(obs_data)) == 1){ + obs_mean <- obs_data + } else { + obs_mean <- rowMeans(obs_data) + } good_values <- !is.na(exp_mean) & !is.na(obs_mean) if (isTRUE(na.rm)) { -- GitLab From 1eeca84b72924c46e564428407daeb91d7cdea92 Mon Sep 17 00:00:00 2001 From: vagudets Date: Mon, 19 Aug 2024 13:32:27 +0200 Subject: [PATCH 4/5] Add unit tests for na.rm parameter, fix pipeline --- R/CRPS.R | 10 +++++----- R/CRPSS.R | 15 ++++++++------- tests/testthat/test-CRPS.R | 7 ++++++- tests/testthat/test-CRPSS.R | 5 +++++ 4 files changed, 24 insertions(+), 13 deletions(-) diff --git a/R/CRPS.R b/R/CRPS.R index 86cd201..c69def7 100644 --- a/R/CRPS.R +++ b/R/CRPS.R @@ -119,8 +119,8 @@ CRPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NU stop("Parameter 'return_mean' must be either TRUE or FALSE.") } ## na.rm - 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') + if (!is.logical(na.rm) && !(is.numeric(na.rm) & na.rm >= 0 & na.rm <= 1)) { + stop("Parameter 'na.rm' should be TRUE, FALSE or a numeric between 0 and 1.") } ## ncores if (!is.null(ncores)) { @@ -183,8 +183,8 @@ CRPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NU # Find the fraction of NAs ## If any member/bin is NA at this time step, it is not good value. exp_mean <- rowMeans(exp_data) - if (length(dim(obs_data)) == 1){ - obs_mean <- obs_data + if (length(dim(obs_data)) == 1) { + obs_mean <- as.vector(obs_data) } else { obs_mean <- rowMeans(obs_data) } @@ -201,7 +201,7 @@ CRPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NU if (f_NAs <= sum(good_values) / length(obs_mean)) { exp_data <- exp_data[good_values, , drop = F] - obs_data <- obs_data[good_values, , drop = F] + obs_data <- obs_data[good_values, drop = F] crps <- SpecsVerification::enscrps_cpp(ens = exp_data, obs = obs_data, R_new = R_new) CRPS[, i, j] <- crps diff --git a/R/CRPSS.R b/R/CRPSS.R index a4e6dfd..49cf2e5 100644 --- a/R/CRPSS.R +++ b/R/CRPSS.R @@ -83,9 +83,10 @@ #'@import multiApply #'@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, sig_method.type = 'two.sided.approx', - na.rm = FALSE, alpha = 0.05, ncores = NULL) { +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', na.rm = FALSE, alpha = 0.05, + ncores = NULL) { # Check inputs ## exp, obs, and ref (1) @@ -185,8 +186,8 @@ CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', stop("Parameter 'clim.cross.val' must be either TRUE or FALSE.") } ## na.rm - 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') + if (!is.logical(na.rm) && !(is.numeric(na.rm) & na.rm >= 0 & na.rm <= 1)) { + stop("Parameter '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)) { @@ -258,8 +259,8 @@ CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', ## option of having several nexp and nobs missing?? # Find good values then calculate RPS exp_mean <- rowMeans(exp) - if (length(dim(obs)) == 1){ - obs_mean <- obs + if (length(dim(obs)) == 1) { + obs_mean <- as.vector(obs) } else { obs_mean <- rowMeans(obs) } diff --git a/tests/testthat/test-CRPS.R b/tests/testthat/test-CRPS.R index 417b3be..c6ade53 100644 --- a/tests/testthat/test-CRPS.R +++ b/tests/testthat/test-CRPS.R @@ -55,7 +55,12 @@ test_that("1. Input checks", { expect_error( CRPS(exp1, array(1:9, dim = c(sdate = 9))), "Parameter 'exp' and 'obs' must have same length of all dimensions except 'memb_dim' and 'dat_dim'." - ) + ) + # na.rm + expect_error( + CRPS(exp1, obs1, na.rm = 2), + "Parameter 'na.rm' should be TRUE, FALSE or a numeric between 0 and 1." + ) # Fair expect_error( CRPS(exp1, obs1, Fair = 1), diff --git a/tests/testthat/test-CRPSS.R b/tests/testthat/test-CRPSS.R index f069191..3c62682 100644 --- a/tests/testthat/test-CRPSS.R +++ b/tests/testthat/test-CRPSS.R @@ -101,6 +101,11 @@ test_that("1. Input checks", { CRPSS(exp1, obs1, Fair = 1), "Parameter 'Fair' must be either TRUE or FALSE." ) + # na.rm + expect_error( + CRPSS(exp1, obs1, na.rm = 2), + "Parameter 'na.rm' should be TRUE, FALSE or a numeric between 0 and 1." + ) # clim.cross.val expect_error( CRPSS(exp1, obs1, clim.cross.val = NA), -- GitLab From 14986e8beb8556a0a32cfe1c13f1b409b7f1510d Mon Sep 17 00:00:00 2001 From: vagudets Date: Mon, 19 Aug 2024 15:05:33 +0200 Subject: [PATCH 5/5] Update description --- DESCRIPTION | 2 +- man/CRPS.Rd | 6 ++++++ man/CRPSS.Rd | 6 ++++++ man/SprErr.Rd | 2 +- 4 files changed, 14 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c5a8139..bd6fe2d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,5 +50,5 @@ BugReports: https://earth.bsc.es/gitlab/es/s2dv/-/issues LazyData: true SystemRequirements: cdo Encoding: UTF-8 -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Config/testthat/edition: 3 diff --git a/man/CRPS.Rd b/man/CRPS.Rd index 97e6a48..2ddcf61 100644 --- a/man/CRPS.Rd +++ b/man/CRPS.Rd @@ -12,6 +12,7 @@ CRPS( dat_dim = NULL, Fair = FALSE, return_mean = TRUE, + na.rm = FALSE, ncores = NULL ) } @@ -41,6 +42,11 @@ The default value is FALSE.} of the CRPS or not. If TRUE, the temporal mean is calculated along time_dim, if FALSE the time dimension is not aggregated. The default is TRUE.} +\item{na.rm}{A logical or numeric value between 0 and 1. If it is numeric, it +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{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } diff --git a/man/CRPSS.Rd b/man/CRPSS.Rd index b609188..c05c449 100644 --- a/man/CRPSS.Rd +++ b/man/CRPSS.Rd @@ -14,6 +14,7 @@ CRPSS( Fair = FALSE, clim.cross.val = TRUE, sig_method.type = "two.sided.approx", + na.rm = FALSE, alpha = 0.05, ncores = NULL ) @@ -62,6 +63,11 @@ 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{na.rm}{A logical or numeric value between 0 and 1. If it is numeric, it +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{alpha}{A numeric of the significance level to be used in the statistical significance test. The default value is 0.05.} diff --git a/man/SprErr.Rd b/man/SprErr.Rd index cdc647e..b9a0214 100644 --- a/man/SprErr.Rd +++ b/man/SprErr.Rd @@ -46,7 +46,7 @@ FALSE.} significance test. The default value is 0.05.} \item{na.rm}{A logical value indicating whether to remove NA values. The -default value is TRUE.} +default value is FALSE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} -- GitLab