From d2b5c786c57e4be602d624d1a7cd85cc40486a35 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 2 Jan 2023 15:25:03 +0100 Subject: [PATCH 01/64] Modify alpha, add 'pval' and 'sign' --- R/DiffCorr.R | 82 +++++++++++++++++++++------------- man/DiffCorr.Rd | 14 ++++-- tests/testthat/test-DiffCorr.R | 14 +++--- 3 files changed, 68 insertions(+), 42 deletions(-) diff --git a/R/DiffCorr.R b/R/DiffCorr.R index 1e07458..6aaa7df 100644 --- a/R/DiffCorr.R +++ b/R/DiffCorr.R @@ -30,8 +30,7 @@ #'@param method A character string indicating the correlation coefficient to be #' computed ("pearson" or "spearman"). The default value is "pearson". #'@param alpha A numeric of the significance level to be used in the statistical -#' significance test. If it is a numeric, "sign" will be returned. If NULL, the -#' p-value will be returned instead. The default value is NULL. +#' significance test (output "sign"). The default value is 0.05. #'@param handle.na A charcater string indicating how to handle missing values. #' If "return.na", NAs will be returned for the cases that contain at least one #' NA in "exp", "ref", or "obs". If "only.complete.triplets", only the time @@ -43,6 +42,11 @@ #' significantly different) or "one-sided" (to assess whether the skill of #' "exp" is significantly higher than that of "ref") following Steiger (1980). #' The default value is "two-sided". +#'@param pval A logical value indicating whether to return the p-value of the +#' significance test Ho: DiffCorr = 0. The default value is TRUE. +#'@param sign A logical value indicating whether to return the statistical +#' significance of the test Ho: DiffCorr = 0 based on 'alpha'. The default +#' value is FALSE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -79,8 +83,9 @@ #'@import multiApply #'@export DiffCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', - memb_dim = NULL, method = 'pearson', alpha = NULL, - handle.na = 'return.na', test.type = "two-sided", ncores = NULL) { + memb_dim = NULL, method = 'pearson', alpha = 0.05, + handle.na = 'return.na', test.type = "two-sided", + pval = TRUE, sign = FALSE, ncores = NULL) { # Check inputs ## exp, ref, and obs (1) @@ -141,11 +146,8 @@ DiffCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', "Monte-Carlo simulations that are done in Siegert et al., 2017")) } ## alpha - if (!is.null(alpha)) { - if (any(!is.numeric(alpha) | alpha <= 0 | alpha >= 1 | - length(alpha) > 1)) { - stop('Parameter "alpha" must be NULL or a number between 0 and 1.') - } + if (sign & any(!is.numeric(alpha) | alpha <= 0 | alpha >= 1 | length(alpha) > 1)) { + stop('Parameter "alpha" must be a number between 0 and 1.') } ## handle.na if (!handle.na %in% c('return.na', 'only.complete.triplets', 'na.fail')) { @@ -157,7 +159,14 @@ DiffCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', } #NOTE: warning can be removed in the next release .warning("The default significance test has changed after s2dv_1.2.0. The default method is 'two-sided'.") - + ## pval + if (!is.logical(pval) | length(pval) > 1) { + stop("Parameter 'pval' must be one logical value.") + } + ## sign + if (!is.logical(sign) | length(sign) > 1) { + stop("Parameter 'sign' must be one logical value.") + } ## ncores if (!is.null(ncores)) { if (any(!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | @@ -187,10 +196,12 @@ DiffCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', } # output_dims - if (is.null(alpha)) { - output_dims <- list(diff.corr = NULL, p.val = NULL) - } else { - output_dims <- list(diff.corr = NULL, sign = NULL) + output_dims <- list(diff.corr = NULL) + if (pval) { + output_dims <- c(output_dims, list(p.val = NULL)) + } + if (sign) { + output_dims <- c(output_dims, list(sign = NULL)) } # Correlation difference if (is.array(N.eff)) { @@ -201,7 +212,7 @@ DiffCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', output_dims = output_dims, fun = .DiffCorr, method = method, alpha = alpha, handle.na = handle.na, - test.type = test.type, ncores = ncores) + test.type = test.type, pval = pval, sign = sign, ncores = ncores) } else { output <- Apply(data = list(exp = exp, obs = obs, ref = ref), target_dims = list(exp = time_dim, obs = time_dim, @@ -209,16 +220,18 @@ DiffCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', output_dims = output_dims, N.eff = N.eff, fun = .DiffCorr, method = method, alpha = alpha, handle.na = handle.na, - test.type = test.type, ncores = ncores) + test.type = test.type, pval = pval, sign = sign, ncores = ncores) } return(output) } -.DiffCorr <- function(exp, obs, ref, N.eff = NA, method = 'pearson', alpha = NULL, - handle.na = 'return.na', test.type = 'two.sided') { +.DiffCorr <- function(exp, obs, ref, N.eff = NA, method = 'pearson', alpha = 0.05, + handle.na = 'return.na', test.type = 'two.sided', + pval = TRUE, sign = FALSE) { - .diff.corr <- function(exp, obs, ref, method = 'pearson', N.eff = NA, alpha = NULL, test.type = 'two.sided') { + .diff.corr <- function(exp, obs, ref, method = 'pearson', N.eff = NA, alpha = 0.05, + test.type = 'two.sided', pval = TRUE, sign = FALSE) { # Correlation difference cor.exp <- cor(x = exp, y = obs, method = method) cor.ref <- cor(x = ref, y = obs, method = method) @@ -239,12 +252,14 @@ DiffCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', ## H0: the skill of exp is not higher than that of ref ## H1: the skill of exp is higher than that of ref - - p.value <- pt(t, df = N.eff - 3, lower.tail = FALSE) - - if (is.null(alpha)) { + + if (pval | sign) { + p.value <- pt(t, df = N.eff - 3, lower.tail = FALSE) + } + if (pval) { output$p.val <- p.value - } else { + } + if (sign) { output$sign <- ifelse(!is.na(p.value) & p.value <= alpha & output$diff.corr > 0, TRUE, FALSE) } @@ -252,12 +267,14 @@ DiffCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', ## H0: the skill difference of exp and ref is zero ## H1: the skill difference of exp and ref is different from zero - - p.value <- pt(abs(t), df = N.eff - 3, lower.tail = FALSE) - if (is.null(alpha)) { + if (pval | sign) { + p.value <- pt(abs(t), df = N.eff - 3, lower.tail = FALSE) + } + if (pval) { output$p.val <- p.value - } else { + } + if (sign) { output$sign <- ifelse(!is.na(p.value) & p.value <= alpha / 2, TRUE, FALSE) } @@ -280,20 +297,21 @@ DiffCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', ref <- ref[!nna] output <- .diff.corr(exp = exp, obs = obs, ref = ref, method = method, - N.eff = N.eff, alpha = alpha, test.type = test.type) + N.eff = N.eff, alpha = alpha, pval = pval, sign = sign, test.type = test.type) } else if (handle.na == 'return.na') { # Data contain NA, return NAs directly without passing to .diff.corr - if (is.null(alpha)) { + if (pval) { output <- list(diff.corr = NA, p.val = NA) - } else { + } + if (sign) { output <- list(diff.corr = NA, sign = NA) } } } else { ## There is no NA output <- .diff.corr(exp = exp, obs = obs, ref = ref, method = method, - N.eff = N.eff, alpha = alpha, test.type = test.type) + N.eff = N.eff, alpha = alpha, pval = pval, sign = sign, test.type = test.type) } return(output) diff --git a/man/DiffCorr.Rd b/man/DiffCorr.Rd index d127af8..52171e8 100644 --- a/man/DiffCorr.Rd +++ b/man/DiffCorr.Rd @@ -12,9 +12,11 @@ DiffCorr( time_dim = "sdate", memb_dim = NULL, method = "pearson", - alpha = NULL, + alpha = 0.05, handle.na = "return.na", test.type = "two-sided", + pval = TRUE, + sign = FALSE, ncores = NULL ) } @@ -47,8 +49,7 @@ directly to the function.} computed ("pearson" or "spearman"). The default value is "pearson".} \item{alpha}{A numeric of the significance level to be used in the statistical -significance test. If it is a numeric, "sign" will be returned. If NULL, the -p-value will be returned instead. The default value is NULL.} +significance test (output "sign"). The default value is 0.05.} \item{handle.na}{A charcater string indicating how to handle missing values. If "return.na", NAs will be returned for the cases that contain at least one @@ -63,6 +64,13 @@ significantly different) or "one-sided" (to assess whether the skill of "exp" is significantly higher than that of "ref") following Steiger (1980). The default value is "two-sided".} +\item{pval}{A logical value indicating whether to return the p-value of the +significance test Ho: DiffCorr = 0. The default value is TRUE.} + +\item{sign}{A logical value indicating whether to return the statistical +significance of the test Ho: DiffCorr = 0 based on 'alpha'. 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/tests/testthat/test-DiffCorr.R b/tests/testthat/test-DiffCorr.R index f47ac1b..f7b771b 100644 --- a/tests/testthat/test-DiffCorr.R +++ b/tests/testthat/test-DiffCorr.R @@ -82,8 +82,8 @@ test_that("1. Input checks", { ) # alpha expect_error( - DiffCorr(exp2, obs2, ref2, alpha = 1), - 'Parameter "alpha" must be NULL or a number between 0 and 1.' + DiffCorr(exp2, obs2, ref2, alpha = 1, sign = T), + 'Parameter "alpha" must be a number between 0 and 1.' ) # handle.na expect_error( @@ -130,7 +130,7 @@ c(0.26166060, 0.15899774, 0.39264452, 0.27959883, 0.34736305, 0.07479832), tolerance = 0.0001 ) expect_equal( -names(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05)), +names(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05, sign = T, pval = F)), c("diff.corr", "sign") ) expect_equal( @@ -143,11 +143,11 @@ as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05, test.type as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05, test.type = "two-sided")$diff.corr) ) expect_equal( -as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05)$sign), +as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05, sign = T)$sign), rep(FALSE, 6) ) expect_equal( -as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05, test.type = "one-sided")$sign), +as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05, sign = T, test.type = "one-sided")$sign), rep(FALSE, 6) ) expect_equal( @@ -228,11 +228,11 @@ DiffCorr(exp2, obs2, ref2, test.type = 'one-sided')$p, tolerance = 0.0001 ) expect_equal( -DiffCorr(exp2, obs2, ref2, test.type = 'one-sided', alpha = 0.7)$sign, +DiffCorr(exp2, obs2, ref2, test.type = 'one-sided', alpha = 0.7, sign = T)$sign, FALSE ) expect_equal( -DiffCorr(exp2, obs2, ref2, test.type = 'two-sided', alpha = 0.7)$sign, +DiffCorr(exp2, obs2, ref2, test.type = 'two-sided', alpha = 0.7, sign = T)$sign, TRUE ) expect_equal( -- GitLab From 9a7c19fc0e48d3d83f0c27fdadbd79d07fac7813 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 3 Jan 2023 09:39:55 +0100 Subject: [PATCH 02/64] Add param 'sign' and 'pval'; modify 'alpha' --- R/DiffCorr.R | 11 ++-- R/ResidualCorr.R | 84 ++++++++++++++++++------------ man/DiffCorr.Rd | 6 +-- man/ResidualCorr.Rd | 20 ++++--- tests/testthat/test-ResidualCorr.R | 8 +-- 5 files changed, 79 insertions(+), 50 deletions(-) diff --git a/R/DiffCorr.R b/R/DiffCorr.R index 6aaa7df..4c6ffa0 100644 --- a/R/DiffCorr.R +++ b/R/DiffCorr.R @@ -58,12 +58,12 @@ #'\item{$sign}{ #' A logical array of the statistical significance of the correlation #' differences with the same dimensions as the input arrays except "time_dim" -#' (and "memb_dim" if provided). Returned only if "alpha" is a numeric. +#' (and "memb_dim" if provided). Returned only if "sign" is TRUE. #'} #'\item{$p.val}{ #' A numeric array of the p-values with the same dimensions as the input arrays -#' except "time_dim" (and "memb_dim" if provided). Returned only if "alpha" is -#' NULL. +#' except "time_dim" (and "memb_dim" if provided). Returned only if "pval" is +#' TRUE. #'} #' #'@references @@ -301,11 +301,12 @@ DiffCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', } else if (handle.na == 'return.na') { # Data contain NA, return NAs directly without passing to .diff.corr + output <- list(diff.corr = NA) if (pval) { - output <- list(diff.corr = NA, p.val = NA) + output <- c(output, list(p.val = NA)) } if (sign) { - output <- list(diff.corr = NA, sign = NA) + output <- c(output, list(sign = NA)) } } diff --git a/R/ResidualCorr.R b/R/ResidualCorr.R index 8d9f040..18ca539 100644 --- a/R/ResidualCorr.R +++ b/R/ResidualCorr.R @@ -37,14 +37,18 @@ #' computed ("pearson", "kendall", or "spearman"). The default value is #' "pearson". #'@param alpha A numeric of the significance level to be used in the statistical -#' significance test. If it is a numeric, "sign" will be returned. If NULL, the -#' p-value will be returned instead. The default value is NULL. +#' significance test (output "sign"). The default value is 0.05. #'@param handle.na A charcater string indicating how to handle missing values. #' If "return.na", NAs will be returned for the cases that contain at least one #' NA in "exp", "ref", or "obs". If "only.complete.triplets", only the time #' steps with no missing values in all "exp", "ref", and "obs" will be used. If #' "na.fail", an error will arise if any of "exp", "ref", or "obs" contains any #' NA. The default value is "return.na". +#'@param pval A logical value indicating whether to return the p-value of the +#' significance test Ho: DiffCorr = 0. The default value is TRUE. +#'@param sign A logical value indicating whether to return the statistical +#' significance of the test Ho: DiffCorr = 0 based on 'alpha'. The default +#' value is FALSE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -56,12 +60,12 @@ #'\item{$sign}{ #' A logical array indicating whether the residual correlation is statistically #' significant or not with the same dimensions as the input arrays except "time_dim" -#' (and "memb_dim" if provided). Returned only if "alpha" is a numeric. +#' (and "memb_dim" if provided). Returned only if "sign" is TRUE. #'} #'\item{$p.val}{ #' A numeric array of the p-values with the same dimensions as the input arrays -#' except "time_dim" (and "memb_dim" if provided). Returned only if "alpha" is -#' NULL. +#' except "time_dim" (and "memb_dim" if provided). Returned only if "pval" is +#' TRUE. #'} #' #'@examples @@ -73,8 +77,8 @@ #'@import multiApply #'@export ResidualCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', - memb_dim = NULL, method = 'pearson', alpha = NULL, - handle.na = 'return.na', ncores = NULL) { + memb_dim = NULL, method = 'pearson', alpha = 0.05, + handle.na = 'return.na', pval = TRUE, sign = FALSE, ncores = NULL) { # Check inputs ## exp, ref, and obs (1) @@ -132,16 +136,21 @@ ResidualCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', stop('Parameter "method" must be "pearson", "kendall", or "spearman".') } ## alpha - if (!is.null(alpha)) { - if (any(!is.numeric(alpha) | alpha <= 0 | alpha >= 1 | - length(alpha) > 1)) { - stop('Parameter "alpha" must be NULL or a number between 0 and 1.') - } + if (sign & any(!is.numeric(alpha) | alpha <= 0 | alpha >= 1 | length(alpha) > 1)) { + stop('Parameter "alpha" must be a number between 0 and 1.') } ## handle.na if (!handle.na %in% c('return.na', 'only.complete.triplets', 'na.fail')) { stop('Parameter "handle.na" must be "return.na", "only.complete.triplets" or "na.fail".') } + ## pval + if (!is.logical(pval) | length(pval) > 1) { + stop("Parameter 'pval' must be one logical value.") + } + ## sign + if (!is.logical(sign) | length(sign) > 1) { + stop("Parameter 'sign' must be one logical value.") + } ## ncores if (!is.null(ncores)) { if (any(!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | @@ -169,14 +178,15 @@ ResidualCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', if (is.null(dim(exp))) exp <- array(exp, dim = c(dim_exp[time_dim])) if (is.null(dim(ref))) ref <- array(ref, dim = c(dim_ref[time_dim])) } - + # output_dims - if (is.null(alpha)) { - output_dims <- list(res.corr = NULL, p.val = NULL) - } else { - output_dims <- list(res.corr = NULL, sign = NULL) + output_dims <- list(res.corr = NULL) + if (pval) { + output_dims <- c(output_dims, list(p.val = NULL)) } - + if (sign) { + output_dims <- c(output_dims, list(sign = NULL)) + } # Residual correlation if (is.array(N.eff)) { @@ -186,22 +196,26 @@ ResidualCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', ref = time_dim, N.eff = NULL), output_dims = output_dims, fun = .ResidualCorr, method = method, - alpha = alpha, handle.na = handle.na, ncores = ncores) + alpha = alpha, handle.na = handle.na, pval = pval, sign = sign, + ncores = ncores) } else { output <- Apply(data = list(exp = exp, obs = obs, ref = ref), target_dims = list(exp = time_dim, obs = time_dim, ref = time_dim), output_dims = output_dims, N.eff = N.eff, fun = .ResidualCorr, method = method, - alpha = alpha, handle.na = handle.na, ncores = ncores) + alpha = alpha, handle.na = handle.na, pval = pval, sign = sign, + ncores = ncores) } return(output) } -.ResidualCorr <- function(exp, obs, ref, N.eff, method, alpha, handle.na) { +.ResidualCorr <- function(exp, obs, ref, N.eff = NA, method = 'pearson', alpha = 0.05, + handle.na = 'return.na', pval = TRUE, sign = FALSE) { # exp and ref and obs: [time] - .residual.corr <- function(exp, obs, ref, method, N.eff, alpha) { + .residual.corr <- function(exp, obs, ref, N.eff = NA, method = 'pearson', alpha = 0.05, + pval = TRUE, sign = FALSE) { # Residuals of 'exp' and 'obs' (regressing 'ref' out in both 'exp' and 'obs') exp_res <- lm(formula = y ~ x, data = list(y = exp, x = ref), na.action = NULL)$residuals @@ -217,9 +231,13 @@ ResidualCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', } t <- abs(output$res.corr) * sqrt(N.eff - 2) / sqrt(1 - output$res.corr^2) - if (is.null(alpha)) { # p-value - output$p.val <- pt(q = t, df = N.eff - 2, lower.tail = FALSE) - } else { + if (pval | sign) { # p-value + p.value <- pt(q = t, df = N.eff - 2, lower.tail = FALSE) + } + if (pval) { + output$p.val <- p.value + } + if (sign) { t_alpha2_n2 <- qt(p = alpha / 2, df = N.eff - 2, lower.tail = FALSE) if (!anyNA(c(t, t_alpha2_n2)) & t >= t_alpha2_n2) { output$sign <- TRUE @@ -244,20 +262,22 @@ ResidualCorr <- function(exp, obs, ref, N.eff = NA, time_dim = 'sdate', ref <- ref[!nna] output <- .residual.corr(exp = exp, obs = obs, ref = ref, method = method, - N.eff = N.eff, alpha = alpha) + N.eff = N.eff, alpha = alpha, pval = pval, sign = sign) } else if (handle.na == 'return.na') { - # Data contain NA, return NAs directly without passing to .diff.corr - if (is.null(alpha)) { - output <- list(res.corr = NA, p.val = NA) - } else { - output <- list(res.corr = NA, sign = NA) + # Data contain NA, return NAs directly without passing to .residual.corr + output <- list(res.corr = NA) + if (pval) { + output <- c(output, list(p.val = NA)) + } + if (sign) { + output <- c(output, list(sign = NA)) } } } else { ## There is no NA output <- .residual.corr(exp = exp, obs = obs, ref = ref, method = method, - N.eff = N.eff, alpha = alpha) + N.eff = N.eff, alpha = alpha, pval = pval, sign = sign) } return(output) diff --git a/man/DiffCorr.Rd b/man/DiffCorr.Rd index 52171e8..44bd52b 100644 --- a/man/DiffCorr.Rd +++ b/man/DiffCorr.Rd @@ -83,12 +83,12 @@ A list with: \item{$sign}{ A logical array of the statistical significance of the correlation differences with the same dimensions as the input arrays except "time_dim" - (and "memb_dim" if provided). Returned only if "alpha" is a numeric. + (and "memb_dim" if provided). Returned only if "sign" is TRUE. } \item{$p.val}{ A numeric array of the p-values with the same dimensions as the input arrays - except "time_dim" (and "memb_dim" if provided). Returned only if "alpha" is - NULL. + except "time_dim" (and "memb_dim" if provided). Returned only if "pval" is + TRUE. } } \description{ diff --git a/man/ResidualCorr.Rd b/man/ResidualCorr.Rd index fe7dd10..ad40f63 100644 --- a/man/ResidualCorr.Rd +++ b/man/ResidualCorr.Rd @@ -12,8 +12,10 @@ ResidualCorr( time_dim = "sdate", memb_dim = NULL, method = "pearson", - alpha = NULL, + alpha = 0.05, handle.na = "return.na", + pval = TRUE, + sign = FALSE, ncores = NULL ) } @@ -47,8 +49,7 @@ computed ("pearson", "kendall", or "spearman"). The default value is "pearson".} \item{alpha}{A numeric of the significance level to be used in the statistical -significance test. If it is a numeric, "sign" will be returned. If NULL, the -p-value will be returned instead. The default value is NULL.} +significance test (output "sign"). The default value is 0.05.} \item{handle.na}{A charcater string indicating how to handle missing values. If "return.na", NAs will be returned for the cases that contain at least one @@ -57,6 +58,13 @@ steps with no missing values in all "exp", "ref", and "obs" will be used. If "na.fail", an error will arise if any of "exp", "ref", or "obs" contains any NA. The default value is "return.na".} +\item{pval}{A logical value indicating whether to return the p-value of the +significance test Ho: DiffCorr = 0. The default value is TRUE.} + +\item{sign}{A logical value indicating whether to return the statistical +significance of the test Ho: DiffCorr = 0 based on 'alpha'. The default +value is FALSE.} + \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } @@ -69,12 +77,12 @@ A list with: \item{$sign}{ A logical array indicating whether the residual correlation is statistically significant or not with the same dimensions as the input arrays except "time_dim" - (and "memb_dim" if provided). Returned only if "alpha" is a numeric. + (and "memb_dim" if provided). Returned only if "sign" is TRUE. } \item{$p.val}{ A numeric array of the p-values with the same dimensions as the input arrays - except "time_dim" (and "memb_dim" if provided). Returned only if "alpha" is - NULL. + except "time_dim" (and "memb_dim" if provided). Returned only if "pval" is + TRUE. } } \description{ diff --git a/tests/testthat/test-ResidualCorr.R b/tests/testthat/test-ResidualCorr.R index be71b47..61c677e 100644 --- a/tests/testthat/test-ResidualCorr.R +++ b/tests/testthat/test-ResidualCorr.R @@ -75,8 +75,8 @@ test_that("1. Input checks", { ) # alpha expect_error( - ResidualCorr(exp2, obs2, ref2, alpha = 1), - 'Parameter "alpha" must be NULL or a number between 0 and 1.' + ResidualCorr(exp2, obs2, ref2, alpha = 1, sign = T), + 'Parameter "alpha" must be a number between 0 and 1.' ) # handle.na expect_error( @@ -116,7 +116,7 @@ c(0.49695468, 0.05446055, 0.25203961, 0.23522967, 0.16960864, 0.10618145), tolerance = 0.0001 ) expect_equal( -names(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05)), +names(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05, sign = T, pval = F)), c("res.corr", "sign") ) expect_equal( @@ -125,7 +125,7 @@ c(0.002784318, 0.537697647, -0.240071018, 0.258706464, 0.338160748, 0.432107476) tolerance = 0.0001 ) expect_equal( -as.vector(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05)$sign), +as.vector(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05, sign = T)$sign), rep(FALSE, 6) ) expect_equal( -- GitLab From 7034991fd39a4c2c49e09bd9c3bf94bd25c00505 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 3 Jan 2023 14:03:41 +0100 Subject: [PATCH 03/64] Change conf.lev to alpha; add sign --- R/ACC.R | 155 +++++++++++++++++++------------------- man/ACC.Rd | 34 +++++---- tests/testthat/test-ACC.R | 14 ++-- 3 files changed, 104 insertions(+), 99 deletions(-) diff --git a/R/ACC.R b/R/ACC.R index 64036f4..9da53aa 100644 --- a/R/ACC.R +++ b/R/ACC.R @@ -42,6 +42,13 @@ #'@param lonlatbox A numeric vector of 4 indicating the corners of the domain of #' interested: c(lonmin, lonmax, latmin, latmax). The default value is NULL #' and the whole data will be used. +#'@param alpha A numeric indicating the significance level for the statistical +#' significance test. The default value is 0.05. +#'@param pval A logical value indicating whether to compute the p-value or not. +#' The default value is TRUE. +#'@param sign A logical value indicating whether to retrieve the statistical +#' significance of the test Ho: ACC = 0 based on 'alpha'. The default value is +#' FALSE. #'@param conf A logical value indicating whether to retrieve the confidence #' intervals or not. The default value is TRUE. #'@param conftype A charater string of "parametric" or "bootstrap". @@ -53,10 +60,6 @@ #' make sure that your experiment and observation always have the same number #' of members. "bootstrap" requires 'memb_dim' has value. The default value is #' 'parametric'. -#'@param conf.lev A numeric indicating the confidence level for the -#' regression computation. The default value is 0.95. -#'@param pval A logical value indicating whether to compute the p-value or not. -#' The default value is TRUE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -68,6 +71,12 @@ #' exp), and nobs is the number of observation (i.e., dat_dim in obs). If #' dat_dim is NULL, nexp and nobs are omitted. #'} +#'\item{macc}{ +#' The mean anomaly correlation coefficient with dimensions +#' c(nexp, nobs, the rest of the dimension except lat_dim, lon_dim, memb_dim, and +#' avg_dim). Only present if 'avg_dim' is not NULL. If dat_dim is NULL, nexp +#' and nobs are omitted. +#'} #'\item{conf.lower (if conftype = "parametric") or acc_conf.lower (if #' conftype = "bootstrap")}{ #' The lower confidence interval of ACC with the same dimensions as ACC. Only @@ -82,11 +91,8 @@ #' The p-value with the same dimensions as ACC. Only present if #' \code{pval = TRUE} and code{conftype = "parametric"}. #'} -#'\item{macc}{ -#' The mean anomaly correlation coefficient with dimensions -#' c(nexp, nobs, the rest of the dimension except lat_dim, lon_dim, memb_dim, and -#' avg_dim). Only present if 'avg_dim' is not NULL. If dat_dim is NULL, nexp -#' and nobs are omitted. +#'\item{$sign}{ +#' The statistical significance. Only present if \code{sign = TRUE}. #'} #'\item{macc_conf.lower}{ #' The lower confidence interval of MACC with the same dimensions as MACC. @@ -134,8 +140,8 @@ #'@export ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', space_dim = c('lat', 'lon'), avg_dim = 'sdate', memb_dim = 'member', - lat = NULL, lon = NULL, lonlatbox = NULL, - conf = TRUE, conftype = "parametric", conf.lev = 0.95, pval = TRUE, + lat = NULL, lon = NULL, lonlatbox = NULL, alpha = 0.05, + pval = TRUE, sign = FALSE, conf = TRUE, conftype = "parametric", ncores = NULL) { # Check inputs @@ -234,6 +240,18 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', } else { select_lonlat <- FALSE } + ## alpha + if (!is.numeric(alpha) | any(alpha < 0) | any(alpha > 1) | length(alpha) > 1) { + stop("Parameter 'alpha' must be a numeric number between 0 and 1.") + } + ## pval + if (!is.logical(pval) | length(pval) > 1) { + stop("Parameter 'pval' must be one logical value.") + } + ## sign + if (!is.logical(sign) | length(sign) > 1) { + stop("Parameter 'sign' must be one logical value.") + } ## conf if (!is.logical(conf) | length(conf) > 1) { stop("Parameter 'conf' must be one logical value.") @@ -246,15 +264,6 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', if (conftype == 'bootstrap' & is.null(memb_dim)) { stop("Parameter 'memb_dim' cannot be NULL when parameter 'conftype' is 'bootstrap'.") } - ## conf.lev - if (!is.numeric(conf.lev) | any(conf.lev < 0) | any(conf.lev > 1) | - length(conf.lev) > 1) { - stop("Parameter 'conf.lev' must be a numeric number between 0 and 1.") - } - } - ## pval - if (!is.logical(pval) | length(pval) > 1) { - stop("Parameter 'pval' must be one logical value.") } ## ncores if (!is.null(ncores)) { @@ -329,8 +338,8 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', fun = .ACC, dat_dim = dat_dim, avg_dim = avg_dim, lat = lat, - conftype = conftype, pval = pval, conf = conf, conf.lev = conf.lev, - ncores = ncores) + conftype = conftype, pval = pval, conf = conf, alpha = alpha, + sign = sign, ncores = ncores) # If bootstrap, calculate confidence level if (conftype == 'bootstrap') { @@ -346,8 +355,8 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', fun = .ACC_bootstrap, dat_dim = dat_dim, memb_dim = memb_dim, avg_dim = avg_dim, lat = lat, - conftype = conftype, pval = pval, conf = conf, conf.lev = conf.lev, - ncores = ncores) + conftype = conftype, pval = pval, conf = conf, alpha = alpha, + sign = sign, ncores = ncores) #NOTE: pval? res <- list(acc = res$acc, acc_conf.lower = res_conf$acc_conf.lower, @@ -360,8 +369,8 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', return(res) } -.ACC <- function(exp, obs, dat_dim = 'dataset', avg_dim = 'sdate', lat, - conf = TRUE, conftype = "parametric", conf.lev = 0.95, pval = TRUE) { +.ACC <- function(exp, obs, dat_dim = 'dataset', avg_dim = 'sdate', lat, alpha = 0.05, + pval = TRUE, sign = FALSE, conf = TRUE, conftype = "parametric") { # .ACC() should use all the spatial points to calculate ACC. It returns [nexp, nobs]. # If dat_dim = NULL, it returns a number. @@ -384,6 +393,7 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', if (is.null(avg_dim)) { acc <- array(dim = c(nexp = nexp, nobs = nobs)) if (pval) p.val <- array(dim = c(nexp = nexp, nobs = nobs)) + if (sign) signif <- array(dim = c(nexp = nexp, nobs = nobs)) if (conf) { conf.upper <- array(dim = c(nexp = nexp, nobs = nobs)) conf.lower <- array(dim = c(nexp = nexp, nobs = nobs)) @@ -394,6 +404,7 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', names(dim(acc))[3] <- avg_dim macc <- array(dim = c(nexp = nexp, nobs = nobs)) if (pval) p.val <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[avg_dim])) + if (sign) signif <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[avg_dim])) if (conf) { conf.upper <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[avg_dim])) conf.lower <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[avg_dim])) @@ -452,19 +463,21 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', # handle bottom = 0 if (is.infinite(acc[iexp, iobs])) acc[iexp, iobs] <- NA - # pval and conf - if (pval | conf) { + # pval, sign, and conf + if (pval | conf | sign) { if (conftype == "parametric") { # calculate effective sample size eno <- .Eno(as.vector(obs_sub), na.action = na.pass) - if (pval) { - t <- qt(conf.lev, eno - 2) # a number - p.val[iexp, iobs] <- sqrt(t^2 / (t^2 + eno - 2)) + if (pval | sign) { + t <- qt(1 - alpha, eno - 2) # a number + p.value <- sqrt(t^2 / (t^2 + eno - 2)) + if (pval) p.val[iexp, iobs] <- p.value + if (sign) signif[iexp, iobs] <- !is.na(p.value) & p.value <= alpha } if (conf) { - conf.upper[iexp, iobs] <- tanh(atanh(acc[iexp, iobs]) + qnorm(1 - (1 - conf.lev) / 2) / sqrt(eno - 3)) - conf.lower[iexp, iobs] <- tanh(atanh(acc[iexp, iobs]) + qnorm((1 - conf.lev) / 2) / sqrt(eno - 3)) + conf.upper[iexp, iobs] <- tanh(atanh(acc[iexp, iobs]) + qnorm(1 - alpha / 2) / sqrt(eno - 3)) + conf.lower[iexp, iobs] <- tanh(atanh(acc[iexp, iobs]) + qnorm(alpha / 2) / sqrt(eno - 3)) } } } @@ -491,8 +504,8 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', if (is.infinite(acc[iexp, iobs, i])) acc[iexp, iobs, i] <- NA } - # pval and conf - if (pval | conf) { + # pval, sign, and conf + if (pval | sign | conf) { if (conftype == "parametric") { # calculate effective sample size along lat_dim and lon_dim # combine lat_dim and lon_dim into one dim first @@ -500,15 +513,17 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', dim = c(space = prod(dim(obs_sub)[1:2]), dim(obs_sub)[3])) eno <- apply(obs_tmp, 2, .Eno, na.action = na.pass) # a vector of avg_dim - if (pval) { - t <- qt(conf.lev, eno - 2) # a vector of avg_dim - p.val[iexp, iobs, ] <- sqrt(t^2 / (t^2 + eno - 2)) + if (pval | sign) { + t <- qt(1 - alpha, eno - 2) # a vector of avg_dim + p.value <- sqrt(t^2 / (t^2 + eno - 2)) + if (pval) p.val[iexp, iobs, ] <- p.value + if (sign) signif[iexp, iobs, ] <- !is.na(p.value) & p.value <= alpha } if (conf) { conf.upper[iexp, iobs, ] <- tanh(atanh(acc[iexp, iobs, ]) + - qnorm(1 - (1 - conf.lev) / 2) / sqrt(eno - 3)) + qnorm(1 - alpha / 2) / sqrt(eno - 3)) conf.lower[iexp, iobs, ] <- tanh(atanh(acc[iexp, iobs, ]) + - qnorm((1 - conf.lev) / 2) / sqrt(eno - 3)) + qnorm(alpha / 2) / sqrt(eno - 3)) } } } @@ -527,9 +542,9 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', conf.lower <- as.vector(conf.lower) conf.upper <- as.vector(conf.upper) } - if (pval) { - p.val <- as.vector(p.val) - } + if (pval) p.val <- as.vector(p.val) + if (sign) signif <- as.vector(signif) + } else { dim(acc) <- dim(acc)[3:length(dim(acc))] macc <- as.vector(macc) @@ -537,46 +552,28 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', dim(conf.lower) <- dim(conf.lower)[3:length(dim(conf.lower))] dim(conf.upper) <- dim(conf.upper)[3:length(dim(conf.upper))] } - if (pval) { - dim(p.val) <- dim(p.val)[3:length(dim(p.val))] - } + if (pval) dim(p.val) <- dim(p.val)[3:length(dim(p.val))] + if (sign) dim(signif) <- dim(signif)[3:length(dim(signif))] } } # Return output if (is.null(avg_dim)) { - if (conf & pval) { - return(list(acc = acc, conf.lower = conf.lower, conf.upper = conf.upper, - p.val = p.val)) - } else if (conf & !pval) { - return(list(acc = acc, conf.lower = conf.lower, conf.upper = conf.upper, - macc = macc)) - } else if (!conf & pval) { - return(list(acc = acc, p.val = p.val)) - } else { - return(list(acc = acc)) - } + output <- list(acc = acc) } else { - if (conf & pval) { - return(list(acc = acc, conf.lower = conf.lower, conf.upper = conf.upper, - p.val = p.val, macc = macc)) - } else if (conf & !pval) { - return(list(acc = acc, conf.lower = conf.lower, conf.upper = conf.upper, - macc = macc)) - } else if (!conf & pval) { - return(list(acc = acc, p.val = p.val, macc = macc)) - } else { - return(list(acc = acc, macc = macc)) - } + output <- list(acc = acc, macc = macc) } + if (conf) output <- c(output, list(conf.lower = conf.lower, conf.upper = conf.upper)) + if (pval) output <- c(output, list(p.val = p.val)) + if (sign) output <- c(output, list(sign = signif)) + return(output) } .ACC_bootstrap <- function(exp, obs, dat_dim = 'dataset', - avg_dim = 'sdate', memb_dim = NULL, lat, - conf = TRUE, conftype = "parametric", conf.lev = 0.95, - pval = TRUE) { + avg_dim = 'sdate', memb_dim = NULL, lat, alpha = 0.05, + pval = TRUE, sign = FALSE, conf = TRUE, conftype = "parametric") { # if (is.null(avg_dim)) # exp: [memb_exp, dat_exp, lat, lon] # obs: [memb_obs, dat_obs, lat, lon] @@ -633,8 +630,8 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', } #calculate the ACC of the randomized field - tmpACC <- .ACC(drawexp, drawobs, conf = FALSE, pval = FALSE, avg_dim = avg_dim, - lat = lat) + tmpACC <- .ACC(drawexp, drawobs, conf = FALSE, pval = FALSE, sign = FALSE, + avg_dim = avg_dim, lat = lat) if (is.null(avg_dim)) { acc_draw[, , jdraw] <- tmpACC$acc } else { @@ -647,24 +644,24 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', if (is.null(avg_dim)) { acc_conf.upper <- apply(acc_draw, c(1, 2), function (x) { - quantile(x, 1 - (1 - conf.lev) / 2, na.rm = TRUE)}) + quantile(x, 1 - alpha / 2, na.rm = TRUE)}) acc_conf.lower <- apply(acc_draw, c(1, 2), function (x) { - quantile(x, (1 - conf.lev) / 2, na.rm = TRUE)}) + quantile(x, alpha / 2, na.rm = TRUE)}) } else { acc_conf.upper <- apply(acc_draw, c(1, 2, 3), function (x) { - quantile(x, 1 - (1 - conf.lev) / 2, na.rm = TRUE)}) + quantile(x, 1 - alpha / 2, na.rm = TRUE)}) acc_conf.lower <- apply(acc_draw, c(1, 2, 3), function (x) { - quantile(x, (1 - conf.lev) / 2, na.rm = TRUE)}) + quantile(x, alpha / 2, na.rm = TRUE)}) macc_conf.upper <- apply(macc_draw, c(1, 2), function (x) { - quantile(x, 1 - (1 - conf.lev) / 2, na.rm = TRUE)}) + quantile(x, 1 - alpha / 2, na.rm = TRUE)}) macc_conf.lower <- apply(macc_draw, c(1, 2), function (x) { - quantile(x, (1 - conf.lev) / 2, na.rm = TRUE)}) + quantile(x, alpha / 2, na.rm = TRUE)}) } # Return output diff --git a/man/ACC.Rd b/man/ACC.Rd index 7df6abb..522843a 100644 --- a/man/ACC.Rd +++ b/man/ACC.Rd @@ -16,10 +16,11 @@ ACC( lat = NULL, lon = NULL, lonlatbox = NULL, + alpha = 0.05, + pval = TRUE, + sign = FALSE, conf = TRUE, conftype = "parametric", - conf.lev = 0.95, - pval = TRUE, ncores = NULL ) } @@ -67,6 +68,16 @@ NULL.} interested: c(lonmin, lonmax, latmin, latmax). The default value is NULL and the whole data will be used.} +\item{alpha}{A numeric indicating the significance level for the statistical +significance test. The default value is 0.05.} + +\item{pval}{A logical value indicating whether to compute the p-value or not. +The default value is TRUE.} + +\item{sign}{A logical value indicating whether to retrieve the statistical +significance of the test Ho: ACC = 0 based on 'alpha'. The default value is +FALSE.} + \item{conf}{A logical value indicating whether to retrieve the confidence intervals or not. The default value is TRUE.} @@ -80,12 +91,6 @@ make sure that your experiment and observation always have the same number of members. "bootstrap" requires 'memb_dim' has value. The default value is 'parametric'.} -\item{conf.lev}{A numeric indicating the confidence level for the -regression computation. The default value is 0.95.} - -\item{pval}{A logical value indicating whether to compute the p-value or not. -The default value is TRUE.} - \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } @@ -97,6 +102,12 @@ A list containing the numeric arrays:\cr exp), and nobs is the number of observation (i.e., dat_dim in obs). If dat_dim is NULL, nexp and nobs are omitted. } +\item{macc}{ + The mean anomaly correlation coefficient with dimensions + c(nexp, nobs, the rest of the dimension except lat_dim, lon_dim, memb_dim, and + avg_dim). Only present if 'avg_dim' is not NULL. If dat_dim is NULL, nexp + and nobs are omitted. +} \item{conf.lower (if conftype = "parametric") or acc_conf.lower (if conftype = "bootstrap")}{ The lower confidence interval of ACC with the same dimensions as ACC. Only @@ -111,11 +122,8 @@ A list containing the numeric arrays:\cr The p-value with the same dimensions as ACC. Only present if \code{pval = TRUE} and code{conftype = "parametric"}. } -\item{macc}{ - The mean anomaly correlation coefficient with dimensions - c(nexp, nobs, the rest of the dimension except lat_dim, lon_dim, memb_dim, and - avg_dim). Only present if 'avg_dim' is not NULL. If dat_dim is NULL, nexp - and nobs are omitted. +\item{$sign}{ + The statistical significance. Only present if \code{sign = TRUE}. } \item{macc_conf.lower}{ The lower confidence interval of MACC with the same dimensions as MACC. diff --git a/tests/testthat/test-ACC.R b/tests/testthat/test-ACC.R index 6431a9c..9753922 100644 --- a/tests/testthat/test-ACC.R +++ b/tests/testthat/test-ACC.R @@ -131,10 +131,10 @@ test_that("1. Input checks", { ACC(exp1, obs1, lat = c(1, 2), lon = c(1, 2, 3), memb_dim = NULL, conftype = 'bootstrap'), "Parameter 'memb_dim' cannot be NULL when parameter 'conftype' is 'bootstrap'." ) - # conf.lev + # alpha expect_error( - ACC(exp1, obs1, lat = c(1, 2), lon = c(1, 2, 3), conf.lev = -1), - "Parameter 'conf.lev' must be a numeric number between 0 and 1." + ACC(exp1, obs1, lat = c(1, 2), lon = c(1, 2, 3), alpha = -1), + "Parameter 'alpha' must be a numeric number between 0 and 1." ) # pval expect_error( @@ -166,7 +166,7 @@ test_that("2. Output checks: dat1", { ) expect_equal( names(ACC(exp1, obs1, lat = lat1)), - c("acc", "conf.lower", "conf.upper", "p.val", "macc") + c("acc", "macc", "conf.lower", "conf.upper", "p.val") ) expect_equal( as.vector(ACC(exp1, obs1, lat = lat1)$acc), @@ -198,18 +198,18 @@ test_that("2. Output checks: dat1", { ) expect_equal( names(ACC(exp1, obs1, lat = lat1, conf = FALSE)), - c("acc", "p.val", "macc") + c("acc", "macc", "p.val") ) expect_equal( names(ACC(exp1, obs1, lat = lat1, pval = FALSE)), - c("acc", "conf.lower", "conf.upper", "macc") + c("acc", "macc", "conf.lower", "conf.upper") ) expect_equal( names(ACC(exp1, obs1, lat = lat1, conf = FALSE, pval = FALSE)), c("acc", "macc") ) expect_equal( - as.vector(ACC(exp1, obs1, lat = lat1, conf = FALSE, avg_dim = NULL, conf.lev = 0.9)$p.val), + as.vector(ACC(exp1, obs1, lat = lat1, conf = FALSE, avg_dim = NULL, alpha = 0.1)$p.val), c(0.6083998, 0.6083998, 0.6083998, 0.6083998, 0.6083998), tolerance = 0.00001 ) -- GitLab From 0b8e38b864d0fdc0dd2af28cfcf83f54caa31892 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 3 Jan 2023 14:49:05 +0100 Subject: [PATCH 04/64] Change conf.lev to alpha; add sign. Wait for Trend sig bug to merge --- R/Trend.R | 87 +++++++++++++++++++------------------ man/Trend.Rd | 19 +++++--- tests/testthat/test-Trend.R | 8 ++-- 3 files changed, 61 insertions(+), 53 deletions(-) diff --git a/R/Trend.R b/R/Trend.R index 1f714a6..a901082 100644 --- a/R/Trend.R +++ b/R/Trend.R @@ -15,12 +15,14 @@ #' points along 'time_dim' dimension. The default value is 1. #'@param polydeg A positive integer indicating the degree of polynomial #' regression. The default value is 1. +#'@param alpha A numeric indicating the significance level for the statistical +#' significance test. The default value is 0.05. #'@param conf A logical value indicating whether to retrieve the confidence #' intervals or not. The default value is TRUE. -#'@param conf.lev A numeric indicating the confidence level for the -#' regression computation. The default value is 0.95. #'@param pval A logical value indicating whether to compute the p-value or not. #' The default value is TRUE. +#'@param sign A logical value indicating whether to retrieve the statistical +#' significance based on 'alpha'. The default value is FALSE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -37,7 +39,7 @@ #' A numeric array with the first dimension 'stats', followed by the same #' dimensions as parameter 'data' except the 'time_dim' dimension. The length #' of the 'stats' dimension should be \code{polydeg + 1}, containing the -#' lower limit of the \code{conf.lev}\% confidence interval for all the +#' lower limit of the \code{(1-alpha)}\% confidence interval for all the #' regression coefficients with the same order as \code{$trend}. Only present #' \code{conf = TRUE}. #'} @@ -45,13 +47,16 @@ #' A numeric array with the first dimension 'stats', followed by the same #' dimensions as parameter 'data' except the 'time_dim' dimension. The length #' of the 'stats' dimension should be \code{polydeg + 1}, containing the -#' upper limit of the \code{conf.lev}\% confidence interval for all the +#' upper limit of the \code{(1-alpha)}\% confidence interval for all the #' regression coefficients with the same order as \code{$trend}. Only present #' \code{conf = TRUE}. #'} #'\item{$p.val}{ #' The p-value calculated by anova(). Only present if \code{pval = TRUE}. #'} +#'\item{$sign}{ +#' The statistical significance. Only present if \code{sign = TRUE}. +#'} #'\item{$detrended}{ #' A numeric array with the same dimensions as paramter 'data', containing the #' detrended values along the 'time_dim' dimension. @@ -67,8 +72,8 @@ #'@import multiApply #'@importFrom stats anova #'@export -Trend <- function(data, time_dim = 'ftime', interval = 1, polydeg = 1, - conf = TRUE, conf.lev = 0.95, pval = TRUE, ncores = NULL) { +Trend <- function(data, time_dim = 'ftime', interval = 1, polydeg = 1, alpha = 0.05, + conf = TRUE, pval = TRUE, sign = FALSE, ncores = NULL) { # Check inputs ## data @@ -101,18 +106,22 @@ Trend <- function(data, time_dim = 'ftime', interval = 1, polydeg = 1, length(polydeg) > 1) { stop("Parameter 'polydeg' must be a positive integer.") } + ## alpha + if (!is.numeric(alpha) | any(alpha < 0) | any(alpha > 1) | length(alpha) > 1) { + stop("Parameter 'alpha' must be a numeric number between 0 and 1.") + } ## conf if (!is.logical(conf) | length(conf) > 1) { stop("Parameter 'conf' must be one logical value.") } - ## conf.lev - if (!is.numeric(conf.lev) | conf.lev < 0 | conf.lev > 1 | length(conf.lev) > 1) { - stop("Parameter 'conf.lev' must be a numeric number between 0 and 1.") - } ## pval if (!is.logical(pval) | length(pval) > 1) { stop("Parameter 'pval' must be one logical value.") } + ## sign + if (!is.logical(sign) | length(sign) > 1) { + stop("Parameter 'sign' must be one logical value.") + } ## ncores if (!is.null(ncores)) { if (!is.numeric(ncores)) { @@ -124,32 +133,27 @@ Trend <- function(data, time_dim = 'ftime', interval = 1, polydeg = 1, ############################### # Calculate Trend - if (conf & pval) { - output_dims <- list(trend = 'stats', conf.lower = 'stats', - conf.upper = 'stats', p.val = 'stats', detrended = time_dim) - } else if (conf & !pval) { - output_dims <- list(trend = 'stats', conf.lower = 'stats', - conf.upper = 'stats', detrended = time_dim) - } else if (!conf & pval) { - output_dims <- list(trend = 'stats', p.val = 'stats', detrended = time_dim) - } else { - output_dims <- list(trend = 'stats', detrended = time_dim) - } + + ## output_dims + output_dims <- list(trend = 'stats') + if (conf) output_dims <- c(output_dims, list(conf.lower = 'stats', conf.upper = 'stats')) + if (pval) output_dims <- c(output_dims, list(p.val = 'stats')) + output_dims <- c(output_dims, list(detrended = time_dim)) output <- Apply(list(data), target_dims = time_dim, fun = .Trend, output_dims = output_dims, interval = interval, - polydeg = polydeg, conf = conf, - conf.lev = conf.lev, pval = pval, + polydeg = polydeg, alpha = alpha, conf = conf, + pval = pval, sign = sign, ncores = ncores) return(invisible(output)) } -.Trend <- function(x, interval = 1, polydeg = 1, - conf = TRUE, conf.lev = 0.95, pval = TRUE) { +.Trend <- function(x, interval = 1, polydeg = 1, alpha = 0.05, + conf = TRUE, pval = TRUE, sign = FALSE) { # x: [ftime] mon <- seq(x) * interval @@ -166,12 +170,14 @@ Trend <- function(data, time_dim = 'ftime', interval = 1, polydeg = 1, trend <- lm.out$coefficients #intercept, slope1, slope2,... if (conf) { - conf.lower <- confint(lm.out, level = conf.lev)[, 1] - conf.upper <- confint(lm.out, level = conf.lev)[, 2] + conf.lower <- confint(lm.out, level = (1 - alpha))[, 1] + conf.upper <- confint(lm.out, level = (1 - alpha))[, 2] } - if (pval) { - p.val <- as.array(stats::anova(lm.out)$'Pr(>F)'[1]) + if (pval | sign) { + p.value <- as.array(stats::anova(lm.out)$'Pr(>F)'[1]) + if (pval) p.val <- p.value + if (sign) signif <- !is.na(p.value) & p.value <= alpha } detrended <- c() @@ -187,21 +193,16 @@ Trend <- function(data, time_dim = 'ftime', interval = 1, polydeg = 1, conf.upper <- rep(NA, polydeg + 1) } - if (pval) { - p.val <- rep(NA, polydeg + 1) - } + if (pval) p.val <- rep(NA, polydeg + 1) + if (sign) signif <- rep(FALSE, polydeg + 1) } - if (conf & pval) { - return(list(trend = trend, conf.lower = conf.lower, conf.upper = conf.upper, - p.val = p.val, detrended = detrended)) - } else if (conf & !pval) { - return(list(trend = trend, conf.lower = conf.lower, conf.upper = conf.upper, - detrended = detrended)) - } else if (!conf & pval) { - return(list(trend = trend, p.val = p.val, detrended = detrended)) - } else { - return(list(trend = trend, detrended = detrended)) - } + output <- list(trend = trend) + if (conf) output <- c(output, list(conf.lower = conf.lower, conf.upper = conf.upper)) + if (pval) output <- c(output, list(p.val = p.val)) + if (sign) output <- c(output, list(sign = signif)) + output <- c(output, list(detrended = detrended)) + + return(output) } diff --git a/man/Trend.Rd b/man/Trend.Rd index d283ee6..9400205 100644 --- a/man/Trend.Rd +++ b/man/Trend.Rd @@ -9,9 +9,10 @@ Trend( time_dim = "ftime", interval = 1, polydeg = 1, + alpha = 0.05, conf = TRUE, - conf.lev = 0.95, pval = TRUE, + sign = FALSE, ncores = NULL ) } @@ -28,15 +29,18 @@ points along 'time_dim' dimension. The default value is 1.} \item{polydeg}{A positive integer indicating the degree of polynomial regression. The default value is 1.} +\item{alpha}{A numeric indicating the significance level for the statistical +significance test. The default value is 0.05.} + \item{conf}{A logical value indicating whether to retrieve the confidence intervals or not. The default value is TRUE.} -\item{conf.lev}{A numeric indicating the confidence level for the -regression computation. The default value is 0.95.} - \item{pval}{A logical value indicating whether to compute the p-value or not. The default value is TRUE.} +\item{sign}{A logical value indicating whether to retrieve the statistical +significance based on 'alpha'. The default value is FALSE.} + \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } @@ -53,7 +57,7 @@ A list containing: A numeric array with the first dimension 'stats', followed by the same dimensions as parameter 'data' except the 'time_dim' dimension. The length of the 'stats' dimension should be \code{polydeg + 1}, containing the - lower limit of the \code{conf.lev}\% confidence interval for all the + lower limit of the \code{(1-alpha)}\% confidence interval for all the regression coefficients with the same order as \code{$trend}. Only present \code{conf = TRUE}. } @@ -61,13 +65,16 @@ A list containing: A numeric array with the first dimension 'stats', followed by the same dimensions as parameter 'data' except the 'time_dim' dimension. The length of the 'stats' dimension should be \code{polydeg + 1}, containing the - upper limit of the \code{conf.lev}\% confidence interval for all the + upper limit of the \code{(1-alpha)}\% confidence interval for all the regression coefficients with the same order as \code{$trend}. Only present \code{conf = TRUE}. } \item{$p.val}{ The p-value calculated by anova(). Only present if \code{pval = TRUE}. } +\item{$sign}{ + The statistical significance. Only present if \code{sign = TRUE}. +} \item{$detrended}{ A numeric array with the same dimensions as paramter 'data', containing the detrended values along the 'time_dim' dimension. diff --git a/tests/testthat/test-Trend.R b/tests/testthat/test-Trend.R index 49a9982..a86f122 100644 --- a/tests/testthat/test-Trend.R +++ b/tests/testthat/test-Trend.R @@ -65,12 +65,12 @@ test_that("1. Input checks", { "Parameter 'conf' must be one logical value." ) expect_error( - Trend(dat1, conf.lev = 3), - "Parameter 'conf.lev' must be a numeric number between 0 and 1." + Trend(dat1, alpha = 3), + "Parameter 'alpha' must be a numeric number between 0 and 1." ) expect_error( - Trend(dat1, conf.lev = TRUE), - "Parameter 'conf.lev' must be a numeric number between 0 and 1." + Trend(dat1, alpha = TRUE), + "Parameter 'alpha' must be a numeric number between 0 and 1." ) expect_error( Trend(dat1, pval = 0.95), -- GitLab From a8094b5161c7f88ec134dc40e6cd96cd564bcb70 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 17 Jan 2023 10:56:18 +0100 Subject: [PATCH 05/64] Update doc --- man/clim.palette.Rd | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) 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.} } -- GitLab From 644d3aa94fc102dc34f5d80b8df7c2ee0b5b9bde Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 17 Jan 2023 10:56:36 +0100 Subject: [PATCH 06/64] Add unit test for sign; correct output --- R/Trend.R | 2 ++ tests/testthat/test-Trend.R | 13 ++++++++++++- 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/R/Trend.R b/R/Trend.R index 63f71d5..e10fe19 100644 --- a/R/Trend.R +++ b/R/Trend.R @@ -140,6 +140,8 @@ Trend <- function(data, time_dim = 'ftime', interval = 1, polydeg = 1, alpha = 0 output_dims <- list(trend = 'stats') if (conf) output_dims <- c(output_dims, list(conf.lower = 'stats', conf.upper = 'stats')) if (pval) output_dims <- c(output_dims, list(p.val = 'stats')) + if (sign) output_dims <- c(output_dims, list(sign = 'stats')) + output_dims <- c(output_dims, list(detrended = time_dim)) output <- Apply(list(data), diff --git a/tests/testthat/test-Trend.R b/tests/testthat/test-Trend.R index aedcbac..b47a202 100644 --- a/tests/testthat/test-Trend.R +++ b/tests/testthat/test-Trend.R @@ -88,7 +88,14 @@ test_that("1. Input checks", { ############################################## test_that("2. Output checks: dat1", { - + expect_equal( + names(Trend(dat1)), + c('trend', 'conf.lower', 'conf.upper', 'p.val', 'detrended') + ) + expect_equal( + names(Trend(dat1, conf = F, sign = T)), + c('trend', 'p.val', 'sign', 'detrended') + ) expect_equal( Trend(dat1)$trend, array(c(-9.7692308, 0.6593407, 0.9615385, 0.7967033), @@ -107,6 +114,10 @@ test_that("2. Output checks: dat1", { dim = c(stats = 1, dat = 1, sdate = 2)), tolerance = 0.0001 ) + expect_equal( + Trend(dat1, sign = T)$sign, + array(c(T, T), dim = c(stats = 1, dat = 1, sdate = 2)) + ) expect_equal( median(Trend(dat1)$detrended, na.rm = TRUE), 0.1153846, -- GitLab From dc9b16cfee93e08cd339a97166280a6c19fbd820 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Wed, 22 Feb 2023 12:25:08 +0100 Subject: [PATCH 07/64] included paralelisation but does not reduce the computational time --- R/CDORemap.R | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/R/CDORemap.R b/R/CDORemap.R index 927b107..9e16011 100644 --- a/R/CDORemap.R +++ b/R/CDORemap.R @@ -77,6 +77,8 @@ #' files for CDO to work. By default, the R session temporary directory is #' used (\code{tempdir()}). #' +#'@param ncores Number of theats used for interpolation. +#' #'@return A list with the following components: #' \item{'data_array'}{The interpolated data array (if an input array #' is provided at all, NULL otherwise).} @@ -223,7 +225,8 @@ #'@export CDORemap <- function(data_array = NULL, lons, lats, grid, method, avoid_writes = TRUE, crop = TRUE, - force_remap = FALSE, write_dir = tempdir()) { #, mask = NULL) { + force_remap = FALSE, write_dir = tempdir(), + ncores = NULL) { #, mask = NULL) { .isRegularVector <- function(x, tol = 0.1) { if (length(x) < 2) { #stop("The provided vector must be of length 2 or greater.") @@ -564,6 +567,12 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, if (!dir.exists(write_dir)) { stop("Parameter 'write_dir' must point to an existing directory.") } + # Check ncores + if (is.null(ncores)) { + ncores <- 1 + } else if (!is.integer(ncores) | ncores < 1) + stop("Parameter 'ncores' must be NULL or an integer equal or greater than 1") + } # if (!is.null(mask)) { # if (!is.numeric(mask) || !is.array(mask)) { # stop("Parameter 'mask' must be a numeric array.") @@ -814,7 +823,7 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, ',', format(lat_extremes[2], scientific = FALSE), ' -') } err <- try({ - system(paste0("cdo -s ", sellonlatbox, "remap", method, ",", grid, " ", tmp_file, " ", tmp_file2), ignore.stdout = T, ignore.stderr = T) + system(paste0("cdo -P ", ncores," -s ", sellonlatbox, "remap", method, ",", grid, " ", tmp_file, " ", tmp_file2), ignore.stdout = T, ignore.stderr = T) }) file.remove(tmp_file) if (is(err, 'try-error') || err > 0) { -- GitLab From e90115e54c3a894a4422144b3353307d9ca6202b Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 28 Mar 2023 17:34:26 +0200 Subject: [PATCH 08/64] Create GetProbs() --- NAMESPACE | 1 + R/GetProbs.R | 251 ++++++++++++++++++++++++++++++++ R/ROCSS.R | 8 +- R/RPS.R | 4 +- R/RPSS.R | 2 +- R/Utils.R | 86 ----------- man/GetProbs.Rd | 67 +++++++++ tests/testthat/test-GetProbs.R | 259 +++++++++++++++++++++++++++++++++ 8 files changed, 585 insertions(+), 93 deletions(-) create mode 100644 R/GetProbs.R create mode 100644 man/GetProbs.Rd create mode 100644 tests/testthat/test-GetProbs.R diff --git a/NAMESPACE b/NAMESPACE index 6224a15..d74cc97 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,6 +36,7 @@ export(EuroAtlanticTC) export(Filter) export(GMST) export(GSAT) +export(GetProbs) export(Histo2Hindcast) export(InsertDim) export(LeapYear) diff --git a/R/GetProbs.R b/R/GetProbs.R new file mode 100644 index 0000000..1f7651d --- /dev/null +++ b/R/GetProbs.R @@ -0,0 +1,251 @@ +#'Compute forecast probability +#' +#'Compute the forecast probability based on the relative thresholds. A certain +#'period can be specified to calculate the quantiles between each probabilistic +#'category. If data has ensemble, all the members are used together to +#'calculate the probabilities. Weights of each member and time can be provided. +#'Cross-validation can be chosen when absolute threshold is calculated. +#' +#'@param data A named numerical array of the forecast or observation with at +#' least time dimension. +#'@param time_dim A character string indicating the name of the time dimension. +#' The default value is 'sdate'. +#'@param memb_dim A character string indicating the name of the member dimension +#' to compute the probabilities of the forecast. The default value is 'member'. +#'@param dat_dim A character string indicating the name of dataset dimension. +#' The default value is NULL, which means no dataset dimension. +#'@param prob_thresholds A numeric vector of the relative thresholds (from 0 to +#' 1) between the categories. The default value is c(1/3, 2/3), which +#' corresponds to tercile equiprobable categories. +#'@param indices_for_quantiles A vector of the indices to be taken along 'time_dim' +#' for computing the thresholds between the probabilistic categories. If NULL, +#' the whole period is used. The default value is NULL. +#'@param weights A named numerical array of the weights for 'data' with +#' dimensions 'time_dim' and 'memb_dim' (if 'data' has it). 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 cross.val A logical indicating whether to compute the thresholds between +#' probabilistic categories in cross-validation. The default value is FALSE. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' +#'@return +#'A numerical array of probabilities with dimensions c(bin, the rest dimensions +#'of 'data' except 'memb_dim'). 'bin' dimension has the length of categories, +#'i.e., \code{length(prob_thresholds) + 1}. +#' +#'@examples +#'data <- array(rnorm(2000), dim = c(ensemble = 25, sdate = 20, time = 4)) +#'res <- GetProbs(data = data, time_dim = 'sdate', memb_dim = 'ensemble', indices_for_quantiles = 4:17) +#' +#'@import multiApply +#'@importFrom easyVerification convert2prob +#'@export +GetProbs <- function(data, time_dim = 'sdate', memb_dim = 'member', indices_for_quantiles = NULL, + prob_thresholds = c(1/3, 2/3), weights = NULL, cross.val = FALSE, ncores = NULL) { + + # Check inputs + ## data + if (is.null(data)) { + stop("Parameter 'data' cannot be NULL.") + } + if (!is.numeric(data)) { + stop("Parameter 'data' must be a numeric array.") + } + if (any(is.null(names(dim(data)))) | any(nchar(names(dim(data))) == 0)) { + stop("Parameter 'data' must have dimension names.") + } + ## time_dim + if (!is.character(time_dim) | length(time_dim) != 1) + stop('Parameter "time_dim" must be a character string.') + if (!time_dim %in% names(dim(data))) { + stop("Parameter 'time_dim' is not found in 'data' dimensions.") + } + ## memb_dim + if (!is.null(memb_dim)) { + if (!is.character(memb_dim) | length(memb_dim) > 1) { + stop("Parameter 'memb_dim' must be a character string.") + } + if (!memb_dim %in% names(dim(data))) { + stop("Parameter 'memb_dim' is not found in 'data' dimensions. If no member ", + "dimension exists, set it as NULL.") + } + } + ## prob_thresholds + if (!is.numeric(prob_thresholds) | !is.vector(prob_thresholds) | + any(prob_thresholds <= 0) | any(prob_thresholds >= 1)) { + stop("Parameter 'prob_thresholds' must be a numeric vector between 0 and 1.") + } + ## indices_for_quantiles + if (is.null(indices_for_quantiles)) { + indices_for_quantiles <- 1:dim(data)[time_dim] + } else { + if (!is.numeric(indices_for_quantiles) | !is.vector(indices_for_quantiles)) { + stop("Parameter 'indices_for_quantiles' must be NULL or a numeric vector.") + } else if (length(indices_for_quantiles) > dim(data)[time_dim] | + max(indices_for_quantiles) > dim(data)[time_dim] | + any(indices_for_quantiles) < 1) { + stop("Parameter 'indices_for_quantiles' should be the indices of 'time_dim'.") + } + } + ## weights + if (!is.null(weights)) { + if (!is.array(weights) | !is.numeric(weights)) + stop("Parameter 'weights' must be a named numeric array.") + +# if (is.null(dat_dim)) { + if (!is.null(memb_dim)) { + lendim_weights <- 2 + namesdim_weights <- c(time_dim, memb_dim) + } else { + lendim_weights <- 1 + namesdim_weights <- c(time_dim) + } + if (length(dim(weights)) != lendim_weights | + any(!names(dim(weights)) %in% namesdim_weights)) { + stop(paste0("Parameter 'weights' must have dimension ", + paste0(namesdim_weights, collapse = ' and '), ".")) + } + if (any(dim(weights)[namesdim_weights] != dim(data)[namesdim_weights])) { + stop(paste0("Parameter 'weights' must have the same dimension length as ", + paste0(namesdim_weights, collapse = ' and '), " dimension in 'data'.")) + } + weights <- Reorder(weights, namesdim_weights) + +# } else { +# if (length(dim(weights)) != 3 | any(!names(dim(weights)) %in% c(memb_dim, time_dim, dat_dim))) +# stop("Parameter 'weights' must have three dimensions with the names of 'memb_dim', 'time_dim' and 'dat_dim'.") +# if (dim(weights)[memb_dim] != dim(exp)[memb_dim] | +# dim(weights)[time_dim] != dim(exp)[time_dim] | +# dim(weights)[dat_dim] != dim(exp)[dat_dim]) { +# stop(paste0("Parameter 'weights' must have the same dimension lengths ", +# "as 'memb_dim', 'time_dim' and 'dat_dim' in 'exp'.")) +# } +# weights <- Reorder(weights, c(time_dim, memb_dim, dat_dim)) +# } + } + ## cross.val + if (!is.logical(cross.val) | length(cross.val) > 1) { + stop("Parameter 'cross.val' must be either TRUE or FALSE.") + } + ## ncores + if (!is.null(ncores)) { + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | + length(ncores) > 1) { + stop("Parameter 'ncores' must be either NULL or a positive integer.") + } + } + + ############################### + + res <- Apply(data = list(data = data), + target_dims = c(time_dim, memb_dim), #, dat_dim), + output_dims = c("bin", time_dim), + fun = .GetProbs, +# dat_dim = dat_dim, + time_dim = time_dim, + memb_dim = memb_dim, + prob_thresholds = prob_thresholds, + indices_for_quantiles = indices_for_quantiles, + weights = weights, cross.val = cross.val, ncores = ncores)$output1 + + return(res) +} + +.GetProbs <- function(data, time_dim = 'sdate', memb_dim = 'member', indices_for_quantiles = NULL, + prob_thresholds = c(1/3, 2/3), weights = NULL, cross.val = FALSE) { + # .GetProbs() is used in RPS, RPSS, ROCSS + # data + ## if data is exp: [sdate, memb] + ## if data is obs: [sdate, (memb)] + # weights: [sdate, (memb)], same as data + + # Add dim [memb = 1] to data if it doesn't have memb_dim + if (length(dim(data)) == 1) { + dim(data) <- c(dim(data), 1) + if (!is.null(weights)) dim(weights) <- c(dim(weights), 1) + } + # Absolute thresholds + if (cross.val) { + quantiles <- array(NA, dim = c(bin = length(prob_thresholds), sdate = dim(data)[1])) + for (i_time in 1:dim(data)[1]) { + if (is.null(weights)) { + quantiles[, i_time] <- quantile(x = as.vector(data[indices_for_quantiles[which(indices_for_quantiles != i_time)], ]), + probs = prob_thresholds, type = 8, na.rm = TRUE) + } else { + # weights: [sdate, memb] + sorted_arrays <- .sorted_distributions(data[indices_for_quantiles[which(indices_for_quantiles != i_time)], ], + weights[indices_for_quantiles[which(indices_for_quantiles != i_time)], ]) + sorted_data <- sorted_arrays$data + cumulative_weights <- sorted_arrays$cumulative_weights + quantiles[, i_time] <- approx(cumulative_weights, sorted_data, prob_thresholds, "linear")$y + } + } + + } else { + if (is.null(weights)) { + quantiles <- quantile(x = as.vector(data[indices_for_quantiles, ]), + probs = prob_thresholds, type = 8, na.rm = TRUE) + } else { + # weights: [sdate, memb] + sorted_arrays <- .sorted_distributions(data[indices_for_quantiles, ], + weights[indices_for_quantiles, ]) + sorted_data <- sorted_arrays$data + cumulative_weights <- sorted_arrays$cumulative_weights + quantiles <- approx(cumulative_weights, sorted_data, prob_thresholds, "linear")$y + } + quantiles <- array(rep(quantiles, dim(data)[1]), dim = c(bin = length(quantiles), dim(data)[1])) + } + # quantiles: [bin-1, sdate] + + # Probabilities + probs <- array(dim = c(dim(quantiles)[1] + 1, dim(data)[1])) # [bin, sdate] + for (i_time in 1:dim(data)[1]) { + if (anyNA(data[i_time, ])) { + probs[, i_time] <- rep(NA, dim = dim(quantiles)[1] + 1) + } else { + if (is.null(weights)) { + probs[, i_time] <- colMeans(easyVerification::convert2prob(data[i_time, ], + threshold = quantiles[, i_time])) + } else { + sorted_arrays <- .sorted_distributions(data[i_time, ], weights[i_time, ]) + sorted_data <- sorted_arrays$data + cumulative_weights <- sorted_arrays$cumulative_weights + # find any quantiles that are outside the data range + integrated_probs <- array(dim = dim(quantiles)) + for (i_quant in 1:dim(quantiles)[1]) { + # for thresholds falling under the distribution + if (quantiles[i_quant, i_time] < min(sorted_data)) { + integrated_probs[i_quant, i_time] <- 0 + # for thresholds falling over the distribution + } else if (max(sorted_data) < quantiles[i_quant, i_time]) { + integrated_probs[i_quant, i_time] <- 1 + } else { + integrated_probs[i_quant, i_time] <- approx(sorted_data, cumulative_weights, + quantiles[i_quant, i_time], "linear")$y + } + } + probs[, i_time] <- append(integrated_probs[, i_time], 1) - append(0, integrated_probs[, i_time]) + if (min(probs[, i_time]) < 0 | max(probs[, i_time]) > 1) { + stop(paste0("Probability in i_time = ", i_time, " is out of [0, 1].")) + } + } + } + } + + return(probs) +} + +.sorted_distributions <- function(data_vector, weights_vector) { + weights_vector <- as.vector(weights_vector) + data_vector <- as.vector(data_vector) + weights_vector <- weights_vector / sum(weights_vector) # normalize to 1 + sorter <- order(data_vector) + sorted_weights <- weights_vector[sorter] + cumulative_weights <- cumsum(sorted_weights) - 0.5 * sorted_weights + cumulative_weights <- cumulative_weights - cumulative_weights[1] # fix the 0 + cumulative_weights <- cumulative_weights / cumulative_weights[length(cumulative_weights)] # fix the 1 + return(list("data" = data_vector[sorter], "cumulative_weights" = cumulative_weights)) +} + diff --git a/R/ROCSS.R b/R/ROCSS.R index 7831a88..1e9f5e2 100644 --- a/R/ROCSS.R +++ b/R/ROCSS.R @@ -262,13 +262,13 @@ ROCSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', for (exp_i in 1:nexp) { for (obs_i in 1:nobs) { - # Input dim for .get_probs + # Input dim for .GetProbs ## if exp: [sdate, memb] ## if obs: [sdate, (memb)] - exp_probs <- .get_probs(ClimProjDiags::Subset(exp, dat_dim, exp_i, drop = 'selected'), + exp_probs <- .GetProbs(ClimProjDiags::Subset(exp, dat_dim, exp_i, drop = 'selected'), indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds, cross.val = cross.val) - obs_probs <- .get_probs(data = ClimProjDiags::Subset(obs, dat_dim, obs_i, drop = 'selected'), + obs_probs <- .GetProbs(data = ClimProjDiags::Subset(obs, dat_dim, obs_i, drop = 'selected'), indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds, cross.val = cross.val) ## exp_probs and obs_probs: [bin, sdate] @@ -278,7 +278,7 @@ ROCSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', obs = Reorder(obs_probs, c(time_dim, 'bin')))[1:ncats]) if (!is.null(ref)) { - ref_probs <- .get_probs(ClimProjDiags::Subset(ref, dat_dim, exp_i, drop = 'selected'), + ref_probs <- .GetProbs(ClimProjDiags::Subset(ref, dat_dim, exp_i, drop = 'selected'), indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds, cross.val = cross.val) rocs_ref[exp_i, obs_i, ] <- unlist(EnsRoca(ens = Reorder(ref_probs, c(time_dim, 'bin')), diff --git a/R/RPS.R b/R/RPS.R index 32d88a4..a12f6a5 100644 --- a/R/RPS.R +++ b/R/RPS.R @@ -239,10 +239,10 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NUL weights_data <- weights } - exp_probs <- .get_probs(data = exp_data, indices_for_quantiles = indices_for_clim, + exp_probs <- .GetProbs(data = exp_data, indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds, weights = weights_data, cross.val = cross.val) # exp_probs: [bin, sdate] - obs_probs <- .get_probs(data = obs_data, indices_for_quantiles = indices_for_clim, + obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) # obs_probs: [bin, sdate] probs_exp_cumsum <- apply(exp_probs, 2, cumsum) diff --git a/R/RPSS.R b/R/RPSS.R index efd7950..16d038f 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -351,7 +351,7 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', obs_data <- obs[ , , j] if (is.null(dim(obs_data))) dim(obs_data) <- c(dim(obs)[1:2]) # obs_probs: [bin, sdate] - obs_probs <- .get_probs(data = obs_data, indices_for_quantiles = indices_for_clim, + obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) # clim_probs: [bin, sdate] clim_probs <- c(prob_thresholds[1], diff(prob_thresholds), 1 - prob_thresholds[length(prob_thresholds)]) diff --git a/R/Utils.R b/R/Utils.R index 8770af9..cb6eb34 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -1809,89 +1809,3 @@ GradientCatsColorBar <- function(nmap, brks = NULL, cols = NULL, vertical = TRUE } -.get_probs <- function(data, indices_for_quantiles, prob_thresholds, weights = NULL, cross.val = FALSE) { - # if exp: [sdate, memb] - # if obs: [sdate, (memb)] - - # Add dim [memb = 1] to obs if it doesn't have memb_dim - if (length(dim(data)) == 1) dim(data) <- c(dim(data), 1) - - # Absolute thresholds - if (cross.val) { - quantiles <- array(NA, dim = c(bin = length(prob_thresholds), sdate = dim(data)[1])) - for (i in 1:dim(data)[1]) { - if (is.null(weights)) { - quantiles[,i] <- quantile(x = as.vector(data[indices_for_quantiles[which(indices_for_quantiles != i)], ]), - probs = prob_thresholds, type = 8, na.rm = TRUE) - } else { - # weights: [sdate, memb] - sorted_arrays <- .sorted_distributions(data[indices_for_quantiles[which(indices_for_quantiles != i)], ], - weights[indices_for_quantiles[which(indices_for_quantiles != i)], ]) - sorted_data <- sorted_arrays$data - cumulative_weights <- sorted_arrays$cumulative_weights - quantiles[,i] <- approx(cumulative_weights, sorted_data, prob_thresholds, "linear")$y - } - } - } else { - if (is.null(weights)) { - quantiles <- quantile(x = as.vector(data[indices_for_quantiles, ]), probs = prob_thresholds, type = 8, na.rm = TRUE) - } else { - # weights: [sdate, memb] - sorted_arrays <- .sorted_distributions(data[indices_for_quantiles, ], weights[indices_for_quantiles, ]) - sorted_data <- sorted_arrays$data - cumulative_weights <- sorted_arrays$cumulative_weights - quantiles <- approx(cumulative_weights, sorted_data, prob_thresholds, "linear")$y - } - quantiles <- array(rep(quantiles, dim(data)[1]),dim = c(bin = length(quantiles), dim(data)[1])) - } - - # quantiles: [bin-1, sdate] - # Probabilities - probs <- array(dim = c(dim(quantiles)[1] + 1, dim(data)[1])) # [bin, sdate] - for (i_time in 1:dim(data)[1]) { - if (anyNA(data[i_time, ])) { - probs[, i_time] <- rep(NA, dim = dim(quantiles)[1] + 1) - } else { - if (is.null(weights)) { - probs[, i_time] <- colMeans(easyVerification::convert2prob(data[i_time, ], - threshold = quantiles[,i_time])) - } else { - sorted_arrays <- .sorted_distributions(data[i_time, ], weights[i_time, ]) - sorted_data <- sorted_arrays$data - cumulative_weights <- sorted_arrays$cumulative_weights - # find any quantiles that are outside the data range - integrated_probs <- array(dim = dim(quantiles)) - for (i_quant in 1:dim(quantiles)[1]) { - # for thresholds falling under the distribution - if (quantiles[i_quant, i_time] < min(sorted_data)) { - integrated_probs[i_quant, i_time] <- 0 - # for thresholds falling over the distribution - } else if (max(sorted_data) < quantiles[i_quant, i_time]) { - integrated_probs[i_quant, i_time] <- 1 - } else { - integrated_probs[i_quant, i_time] <- approx(sorted_data, cumulative_weights, quantiles[i_quant, i_time], - "linear")$y - } - } - probs[, i_time] <- append(integrated_probs[,i_time], 1) - append(0, integrated_probs[,i_time]) - if (min(probs[, i_time]) < 0 | max(probs[, i_time]) > 1) { - stop(paste0("Probability in i_time = ", i_time, " is out of [0, 1].")) - } - } - } - } - return(probs) -} - -.sorted_distributions <- function(data_vector, weights_vector) { - weights_vector <- as.vector(weights_vector) - data_vector <- as.vector(data_vector) - weights_vector <- weights_vector / sum(weights_vector) # normalize to 1 - sorter <- order(data_vector) - sorted_weights <- weights_vector[sorter] - cumulative_weights <- cumsum(sorted_weights) - 0.5 * sorted_weights - cumulative_weights <- cumulative_weights - cumulative_weights[1] # fix the 0 - cumulative_weights <- cumulative_weights / cumulative_weights[length(cumulative_weights)] # fix the 1 - return(list("data" = data_vector[sorter], "cumulative_weights" = cumulative_weights)) -} - diff --git a/man/GetProbs.Rd b/man/GetProbs.Rd new file mode 100644 index 0000000..c967a2e --- /dev/null +++ b/man/GetProbs.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/GetProbs.R +\name{GetProbs} +\alias{GetProbs} +\title{Compute forecast probability} +\usage{ +GetProbs( + data, + time_dim = "sdate", + memb_dim = "member", + indices_for_quantiles = NULL, + prob_thresholds = c(1/3, 2/3), + weights = NULL, + cross.val = FALSE, + ncores = NULL +) +} +\arguments{ +\item{data}{A named numerical array of the forecast or observation with at +least time dimension.} + +\item{time_dim}{A character string indicating the name of the time dimension. +The default value is 'sdate'.} + +\item{memb_dim}{A character string indicating the name of the member dimension +to compute the probabilities of the forecast. The default value is 'member'.} + +\item{indices_for_quantiles}{A vector of the indices to be taken along 'time_dim' +for computing the thresholds between the probabilistic categories. If NULL, +the whole period is used. The default value is NULL.} + +\item{prob_thresholds}{A numeric vector of the relative thresholds (from 0 to +1) between the categories. The default value is c(1/3, 2/3), which +corresponds to tercile equiprobable categories.} + +\item{weights}{A named numerical array of the weights for 'data' with +dimensions 'time_dim' and 'memb_dim' (if 'data' has it). 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{cross.val}{A logical indicating whether to compute the thresholds between +probabilistic categories in cross-validation. The default value is FALSE.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} + +\item{dat_dim}{A character string indicating the name of dataset dimension. +The default value is NULL, which means no dataset dimension.} +} +\value{ +A numerical array of probabilities with dimensions c(bin, the rest dimensions +of 'data' except 'memb_dim'). 'bin' dimension has the length of categories, +i.e., \code{length(prob_thresholds) + 1}. +} +\description{ +Compute the forecast probability based on the relative thresholds. A certain +period can be specified to calculate the quantiles between each probabilistic +category. If data has ensemble, all the members are used together to +calculate the probabilities. Weights of each member and time can be provided. +Cross-validation can be chosen when absolute threshold is calculated. +} +\examples{ +data <- array(rnorm(2000), dim = c(ensemble = 25, sdate = 20, time = 4)) +res <- GetProbs(data = data, time_dim = 'sdate', memb_dim = 'ensemble', indices_for_quantiles = 4:17) + +} diff --git a/tests/testthat/test-GetProbs.R b/tests/testthat/test-GetProbs.R new file mode 100644 index 0000000..252dd29 --- /dev/null +++ b/tests/testthat/test-GetProbs.R @@ -0,0 +1,259 @@ +context("s2dv::GetProbs tests") + +############################################## + +# dat1 +set.seed(1) +data1 <- array(rnorm(60), dim = c(member = 3, sdate = 10, time = 2)) +set.seed(2) +weights1 <- array(abs(rnorm(30)), dim = c(member = 3, sdate = 10)) + +# dat2 +set.seed(1) +data2 <- array(rnorm(20), dim = c(sdate = 10, time = 2)) +set.seed(2) +weights2 <- array(abs(rnorm(10)), dim = c(sdate = 10)) + +############################################## + +test_that("1. Input checks", { + # data + expect_error( + GetProbs(c()), + "Parameter 'data' cannot be NULL." + ) + expect_error( + GetProbs(c(data2)), + "Parameter 'data' must have dimension names." + ) + # time_dim + expect_error( + GetProbs(data1, time_dim = 1), + 'Parameter "time_dim" must be a character string.' + ) + expect_error( + GetProbs(data1, time_dim = 'ftime'), + "Parameter 'time_dim' is not found in 'data' dimensions." + ) + # memb_dim + expect_error( + GetProbs(data1, memb_dim = TRUE), + "Parameter 'memb_dim' must be a character string." + ) + expect_error( + GetProbs(data1, memb_dim = 'memb'), + "Parameter 'memb_dim' is not found in 'data' dimensions." + ) + # prob_thresholds + expect_error( + GetProbs(data1, prob_thresholds = 1), + "Parameter 'prob_thresholds' must be a numeric vector between 0 and 1." + ) + # indices_for_clim + expect_error( + GetProbs(data1, indices_for_quantiles = array(1:6, dim = c(2, 3))), + "Parameter 'indices_for_quantiles' must be NULL or a numeric vector." + ) + expect_error( + GetProbs(data1, indices_for_quantiles = 3:11), + "Parameter 'indices_for_quantiles' should be the indices of 'time_dim'." + ) + # cross.val + expect_error( + GetProbs(data1, cross.val = 1), + "Parameter 'cross.val' must be either TRUE or FALSE." + ) + # weights + expect_error( + GetProbs(data1, weights = c(0, 1)), + "Parameter 'weights' must be a named numeric array." + ) + expect_error( + GetProbs(data1, weights = array(1, dim = c(member = 3, time = 10))), + "Parameter 'weights' must have dimension sdate and member." + ) + expect_error( + GetProbs(data1, weights = array(1, dim = c(member = 3, sdate = 1))), + "Parameter 'weights' must have the same dimension length as sdate and member dimension in 'data'." + ) +# expect_error( +# GetProbs(data3, weights = array(1, dim = c(member = 3, time = 10, dataset = 3)), dat_dim = 'dataset'), +# "Parameter 'weights' must have three dimensions with the names of 'memb_dim', 'time_dim' and 'dat_dim'." +# ) + # ncores + expect_error( + GetProbs(data1, ncores = 1.5), + "Parameter 'ncores' must be either NULL or a positive integer." + ) + +}) + +############################################## +test_that("2. Output checks: dat1", { + +expect_equal( +dim(GetProbs(data1)), +c(bin = 3, sdate = 10, time = 2) +) +expect_equal( +c(GetProbs(data1)[, 10, 2]), +c(0.3333333, 0.3333333, 0.3333333), +tolerance = 0.0001 +) +expect_equal( +c(GetProbs(data1)[, 2, 2]), +c(0.6666667, 0.3333333, 0.0000000), +tolerance = 0.0001 +) + +# indices_for_quantiles +expect_equal( +dim(GetProbs(data1, indices_for_quantiles = 4:7)), +c(bin = 3, sdate = 10, time = 2) +) +expect_equal( +c(GetProbs(data1, indices_for_quantiles = 4:7)[, 10, 2]), +c(0.3333333, 0.6666667, 0.0000000), +tolerance = 0.0001 +) + +# prob_thresholds +expect_equal( +dim(GetProbs(data1, prob_thresholds = c(0.25, 0.5, 0.75))), +c(bin = 4, sdate = 10, time = 2) +) +expect_equal( +c(GetProbs(data1, prob_thresholds = c(0.25, 0.5, 0.75))[, 10, 2]), +c(0.3333333, 0.3333333, 0.3333333, 0.0000000), +tolerance = 0.0001 +) +expect_equal( +c(GetProbs(data1, prob_thresholds = c(0.25, 0.5, 0.75))[, 3, 2]), +c(0.0000000, 0.6666667, 0.0000000, 0.3333333), +tolerance = 0.0001 +) + +# weights +expect_equal( +dim(GetProbs(data1, weights = weights1)), +c(bin = 3, sdate = 10, time = 2) +) +expect_equal( +c(GetProbs(data1, weights = weights1)[, 10, 2]), +c(0.3327220, 0.5296149, 0.1376631), +tolerance = 0.0001 +) +expect_equal( +sum(c(GetProbs(data1, weights = weights1))), +20 +) + +# cross.val +expect_equal( +dim(GetProbs(data1, cross.val = T)), +c(bin = 3, sdate = 10, time = 2) +) +expect_equal( +c(GetProbs(data1, cross.val = T)[, 10, 2]), +c(0.3333333, 0.3333333, 0.3333333), +tolerance = 0.0001 +) +expect_equal( +c(GetProbs(data1, cross.val = T)[, 4, 2]), +c(0.0000000, 0.6666667, 0.3333333), +tolerance = 0.0001 +) + +# cross.val + weights +expect_equal( +dim(GetProbs(data1, cross.val = T, weights = weights1)), +c(bin = 3, sdate = 10, time = 2) +) +expect_equal( +c(GetProbs(data1, cross.val = T, weights = weights1)[, 10, 2]), +c(0.3335612, 0.5277459, 0.1386929), +tolerance = 0.0001 +) + +}) + + +############################################## +test_that("3. Output checks: dat2", { + +expect_equal( +dim(GetProbs(data2, memb_dim = NULL)), +c(bin = 3, sdate = 10, time = 2) +) +expect_equal( +c(GetProbs(data2, memb_dim = NULL)[, 10, 2]), +c(0, 1, 0) +) +expect_equal( +unique(c(GetProbs(data2, memb_dim = NULL))), +c(1, 0) +) + +# indices_for_quantiles +expect_equal( +dim(GetProbs(data2, memb_dim = NULL, indices_for_quantiles = 4:7)), +c(bin = 3, sdate = 10, time = 2) +) +expect_equal( +c(GetProbs(data2, memb_dim = NULL, indices_for_quantiles = 4:7)[, 10, 2]), +c(0, 0, 1) +) + +# prob_thresholds +expect_equal( +dim(GetProbs(data2, memb_dim = NULL, prob_thresholds = c(0.25, 0.5, 0.75))), +c(bin = 4, sdate = 10, time = 2) +) +expect_equal( +c(GetProbs(data2, memb_dim = NULL, prob_thresholds = c(0.25, 0.5, 0.75))[, 10, 2]), +c(0, 0, 1, 0) +) +expect_equal( +c(GetProbs(data2, memb_dim = NULL, prob_thresholds = c(0.25, 0.5, 0.75))[, 3, 2]), +c(1, 0, 0, 0) +) + +# weights +expect_equal( +dim(GetProbs(data2, memb_dim = NULL, weights = weights2)), +c(bin = 3, sdate = 10, time = 2) +) +expect_equal( +c(GetProbs(data2, memb_dim = NULL, weights = weights2)[, 10, 2]), +c(0, 1, 0) +) +expect_equal( +sum(c(GetProbs(data2, memb_dim = NULL, weights = weights2))), +20 +) + +# cross.val +expect_equal( +dim(GetProbs(data2, memb_dim = NULL, cross.val = T)), +c(bin = 3, sdate = 10, time = 2) +) +expect_equal( +c(GetProbs(data2, memb_dim = NULL, cross.val = T)[, 10, 2]), +c(0, 1, 0) +) +expect_equal( +c(GetProbs(data2, memb_dim = NULL, cross.val = T)[, 4, 2]), +c(1, 0, 0) +) + +# cross.val + weights +expect_equal( +dim(GetProbs(data2, memb_dim = NULL, cross.val = T, weights = weights2)), +c(bin = 3, sdate = 10, time = 2) +) +expect_equal( +c(GetProbs(data2, memb_dim = NULL, cross.val = T, weights = weights2)[, 10, 2]), +c(0, 1, 0) +) + +}) -- GitLab From f49d8a1102cb1d1609ccafd79dad9933b7c75189 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 28 Mar 2023 17:35:01 +0200 Subject: [PATCH 09/64] Don't ignore unit tests in pipeline --- .Rbuildignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.Rbuildignore b/.Rbuildignore index 6008b57..4212858 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -10,7 +10,7 @@ README\.md$ vignettes .gitlab-ci.yml # unit tests should be ignored when building the package for CRAN -^tests$ +#^tests$ # CDO is not in windbuilder, so we can test the unit tests by winbuilder # but test-CDORemap.R and test-Load.R needs to be hidden #tests/testthat/test-CDORemap.R -- GitLab From 92d5776f89b56508a08980dd59ed0740d5bd91fc Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Wed, 29 Mar 2023 09:24:40 +0200 Subject: [PATCH 10/64] corrected indices_for_quantiles check to avoid warning --- R/GetProbs.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/GetProbs.R b/R/GetProbs.R index 1f7651d..351654c 100644 --- a/R/GetProbs.R +++ b/R/GetProbs.R @@ -85,7 +85,7 @@ GetProbs <- function(data, time_dim = 'sdate', memb_dim = 'member', indices_for_ stop("Parameter 'indices_for_quantiles' must be NULL or a numeric vector.") } else if (length(indices_for_quantiles) > dim(data)[time_dim] | max(indices_for_quantiles) > dim(data)[time_dim] | - any(indices_for_quantiles) < 1) { + any(indices_for_quantiles < 1)) { stop("Parameter 'indices_for_quantiles' should be the indices of 'time_dim'.") } } -- GitLab From d1c4feebe53be356b3a6bf3dfa55d3d052c05b79 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Wed, 29 Mar 2023 11:05:08 +0200 Subject: [PATCH 11/64] documentation --- R/GetProbs.R | 36 +++++++++++++++++++++--------------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/R/GetProbs.R b/R/GetProbs.R index 351654c..6a4dcfe 100644 --- a/R/GetProbs.R +++ b/R/GetProbs.R @@ -1,39 +1,45 @@ -#'Compute forecast probability +#'Compute probabilistic forecasts or the corresponding observations #' -#'Compute the forecast probability based on the relative thresholds. A certain -#'period can be specified to calculate the quantiles between each probabilistic -#'category. If data has ensemble, all the members are used together to -#'calculate the probabilities. Weights of each member and time can be provided. -#'Cross-validation can be chosen when absolute threshold is calculated. +#'Compute probabilistic forecasts from an ensemble based on the relative thresholds, +#'or the probabilistic observations (i.e., which probabilistic category was observed). +#'A reference period can be specified to calculate the absolute thresholds between +#'each probabilistic category. The absolute thresholds can be computed in cross-validation +#'mode. If data is an ensemble, the probabilities are calculated as the percentage of +#'members that fall into each category. For observations (or forecast without member +#'dimension), 1 means that the event happened, while 0 indicates that the event did +#'not happen. Weighted probabilities can be computed if the weights are provided for +#'each ensemble member and time step. #' -#'@param data A named numerical array of the forecast or observation with at -#' least time dimension. +#'@param data A named numerical array of the forecasts or observations with, at +#' least, time dimension. #'@param time_dim A character string indicating the name of the time dimension. #' The default value is 'sdate'. #'@param memb_dim A character string indicating the name of the member dimension -#' to compute the probabilities of the forecast. The default value is 'member'. +#' to compute the probabilities of the forecast, or NULL if there is no member +#' dimension (e.g., for observations, or for forecast with only one ensemble +#' member). The default value is 'member'. #'@param dat_dim A character string indicating the name of dataset dimension. #' The default value is NULL, which means no dataset dimension. #'@param prob_thresholds A numeric vector of the relative thresholds (from 0 to #' 1) between the categories. The default value is c(1/3, 2/3), which #' corresponds to tercile equiprobable categories. #'@param indices_for_quantiles A vector of the indices to be taken along 'time_dim' -#' for computing the thresholds between the probabilistic categories. If NULL, -#' the whole period is used. The default value is NULL. +#' for computing the absolute thresholds between the probabilistic categories. +#' If NULL, the whole period is used. The default value is NULL. #'@param weights A named numerical array of the weights for 'data' with -#' dimensions 'time_dim' and 'memb_dim' (if 'data' has it). The default value is +#' dimensions 'time_dim' and 'memb_dim' (if 'data' has them). 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 cross.val A logical indicating whether to compute the thresholds between -#' probabilistic categories in cross-validation. The default value is FALSE. +#' probabilistic categories in cross-validation mode. The default value is FALSE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' #'@return #'A numerical array of probabilities with dimensions c(bin, the rest dimensions -#'of 'data' except 'memb_dim'). 'bin' dimension has the length of categories, -#'i.e., \code{length(prob_thresholds) + 1}. +#'of 'data' except 'memb_dim'). 'bin' dimension has the length of probabilistic +#'categories, i.e., \code{length(prob_thresholds) + 1}. #' #'@examples #'data <- array(rnorm(2000), dim = c(ensemble = 25, sdate = 20, time = 4)) -- GitLab From 2a67bbc0a7fa08dbd05ad9df1037f203591b2659 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 30 Mar 2023 11:39:44 +0200 Subject: [PATCH 12/64] Update the document --- man/GetProbs.Rd | 36 +++++++++++++++++++++--------------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/man/GetProbs.Rd b/man/GetProbs.Rd index c967a2e..27fe68c 100644 --- a/man/GetProbs.Rd +++ b/man/GetProbs.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/GetProbs.R \name{GetProbs} \alias{GetProbs} -\title{Compute forecast probability} +\title{Compute probabilistic forecasts or the corresponding observations} \usage{ GetProbs( data, @@ -16,31 +16,33 @@ GetProbs( ) } \arguments{ -\item{data}{A named numerical array of the forecast or observation with at -least time dimension.} +\item{data}{A named numerical array of the forecasts or observations with, at +least, time dimension.} \item{time_dim}{A character string indicating the name of the time dimension. The default value is 'sdate'.} \item{memb_dim}{A character string indicating the name of the member dimension -to compute the probabilities of the forecast. The default value is 'member'.} +to compute the probabilities of the forecast, or NULL if there is no member +dimension (e.g., for observations, or for forecast with only one ensemble +member). The default value is 'member'.} \item{indices_for_quantiles}{A vector of the indices to be taken along 'time_dim' -for computing the thresholds between the probabilistic categories. If NULL, -the whole period is used. The default value is NULL.} +for computing the absolute thresholds between the probabilistic categories. +If NULL, the whole period is used. The default value is NULL.} \item{prob_thresholds}{A numeric vector of the relative thresholds (from 0 to 1) between the categories. The default value is c(1/3, 2/3), which corresponds to tercile equiprobable categories.} \item{weights}{A named numerical array of the weights for 'data' with -dimensions 'time_dim' and 'memb_dim' (if 'data' has it). The default value is +dimensions 'time_dim' and 'memb_dim' (if 'data' has them). 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{cross.val}{A logical indicating whether to compute the thresholds between -probabilistic categories in cross-validation. The default value is FALSE.} +probabilistic categories in cross-validation mode. The default value is FALSE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} @@ -50,15 +52,19 @@ The default value is NULL, which means no dataset dimension.} } \value{ A numerical array of probabilities with dimensions c(bin, the rest dimensions -of 'data' except 'memb_dim'). 'bin' dimension has the length of categories, -i.e., \code{length(prob_thresholds) + 1}. +of 'data' except 'memb_dim'). 'bin' dimension has the length of probabilistic +categories, i.e., \code{length(prob_thresholds) + 1}. } \description{ -Compute the forecast probability based on the relative thresholds. A certain -period can be specified to calculate the quantiles between each probabilistic -category. If data has ensemble, all the members are used together to -calculate the probabilities. Weights of each member and time can be provided. -Cross-validation can be chosen when absolute threshold is calculated. +Compute probabilistic forecasts from an ensemble based on the relative thresholds, +or the probabilistic observations (i.e., which probabilistic category was observed). +A reference period can be specified to calculate the absolute thresholds between +each probabilistic category. The absolute thresholds can be computed in cross-validation +mode. If data is an ensemble, the probabilities are calculated as the percentage of +members that fall into each category. For observations (or forecast without member +dimension), 1 means that the event happened, while 0 indicates that the event did +not happen. Weighted probabilities can be computed if the weights are provided for +each ensemble member and time step. } \examples{ data <- array(rnorm(2000), dim = c(ensemble = 25, sdate = 20, time = 4)) -- GitLab From bbfdd566fe444e9695c437e55f2ae6ff01a56704 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 30 Mar 2023 16:49:17 +0200 Subject: [PATCH 13/64] Avoid using apply(,sum) to improve efficiency --- R/RPS.R | 5 ++--- R/RPSS.R | 3 +-- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/R/RPS.R b/R/RPS.R index a12f6a5..75619b6 100644 --- a/R/RPS.R +++ b/R/RPS.R @@ -249,14 +249,13 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NUL probs_obs_cumsum <- apply(obs_probs, 2, cumsum) # rps: [sdate, nexp, nobs] - rps[ , i, j] <- apply((probs_exp_cumsum - probs_obs_cumsum)^2, 2, sum) - + rps[ , i, j] <- colSums((probs_exp_cumsum - probs_obs_cumsum)^2) if (Fair) { # FairRPS ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1)) [formula taken from SpecsVerification::EnsRps] R <- dim(exp)[2] #memb R_new <- Inf adjustment <- (-1) / (R - 1) * probs_exp_cumsum * (1 - probs_exp_cumsum) - adjustment <- apply(adjustment, 2, sum) + adjustment <- colSums(adjustment) rps[ , i, j] <- rps[ , i, j] + adjustment } } diff --git a/R/RPSS.R b/R/RPSS.R index 16d038f..ab433e9 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -360,8 +360,7 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', # Calculate RPS for each time step probs_clim_cumsum <- apply(clim_probs, 2, cumsum) probs_obs_cumsum <- apply(obs_probs, 2, cumsum) - rps_ref[ , j] <- apply((probs_clim_cumsum - probs_obs_cumsum)^2, 2, sum) - + rps_ref[ , j] <- colSums((probs_clim_cumsum - probs_obs_cumsum)^2) # if (Fair) { # FairRPS # ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1)) [formula taken from SpecsVerification::EnsRps] # R <- dim(exp)[2] #memb -- GitLab From a7817a68340ef873b5815535e3937a346b2b202a Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 3 Apr 2023 12:52:27 +0200 Subject: [PATCH 14/64] Add pval and sign to RMS.R --- R/RMS.R | 112 +++++++++++++++++++++++++------------- R/RMSSS.R | 19 +++---- man/RMS.Rd | 37 +++++++++---- man/RMSSS.Rd | 17 +++--- tests/testthat/test-RMS.R | 56 +++++++++++++------ 5 files changed, 155 insertions(+), 86 deletions(-) diff --git a/R/RMS.R b/R/RMS.R index 645e34b..8a1899a 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -20,17 +20,23 @@ #' 'dat_dim' will be 1. #'@param time_dim A character string indicating the name of dimension along #' which the correlations are computed. The default value is 'sdate'. -#'@param dat_dim A character string indicating the name of member (nobs/nexp) -#' dimension. The default value is 'dataset'. +#'@param dat_dim A character string indicating the name of dataset or member +#' (nobs/nexp) dimension. The datasets of exp and obs will be paired and +#' computed RMS for each pair. The default value is NULL. #'@param comp_dim A character string indicating the name of dimension along which #' obs is taken into account only if it is complete. The default value #' is NULL. #'@param limits A vector of two integers indicating the range along comp_dim to #' be completed. The default value is c(1, length(comp_dim dimension)). +#'@param pval A logical value indicating whether to return or not the p-value +#' of the test Ho: Corr = 0. The default value is TRUE. #'@param conf A logical value indicating whether to retrieve the confidence #' intervals or not. The default value is TRUE. -#'@param conf.lev A numeric indicating the confidence level for the -#' regression computation. The default value is 0.95. +#'@param sign A logical value indicating whether to retrieve the statistical +#' significance of the test Ho: Corr = 0 based on 'alpha'. The default value is +#' FALSE. +#'@param alpha A numeric indicating the significance level for 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. #' @@ -38,37 +44,43 @@ #'A list containing the numeric arrays with dimension:\cr #' c(nexp, nobs, all other dimensions of exp except time_dim).\cr #'nexp is the number of experiment (i.e., dat_dim in exp), and nobs is the -#'number of observation (i.e., dat_dim in obs).\cr +#'number of observation (i.e., dat_dim in obs). If dat_dim is NULL, nexp and +#'nobs are omitted.\cr #'\item{$rms}{ #' The root mean square error. #'} +#'\item{$p.val}{ +#' The p-value. Only present if \code{pval = TRUE}. +#'} #'\item{$conf.lower}{ #' The lower confidence interval. Only present if \code{conf = TRUE}. #'} #'\item{$conf.upper}{ #' The upper confidence interval. Only present if \code{conf = TRUE}. #'} +#'\item{$sign}{ +#' The statistical significance. Only present if \code{sign = TRUE}. +#'} #' #'@examples #'# Load sample data as in Load() example: #' set.seed(1) -#' exp1 <- array(rnorm(120), dim = c(dataset = 3, sdate = 5, ftime = 2, lon = 1, lat = 4)) +#' exp1 <- array(rnorm(120), dim = c(dat = 3, sdate = 5, ftime = 2, lon = 1, lat = 4)) #' set.seed(2) -#' obs1 <- array(rnorm(80), dim = c(dataset = 2, sdate = 5, ftime = 2, lon = 1, lat = 4)) +#' obs1 <- array(rnorm(80), dim = c(dat = 2, sdate = 5, ftime = 2, lon = 1, lat = 4)) #' set.seed(2) #' na <- floor(runif(10, min = 1, max = 80)) #' obs1[na] <- NA -#' res <- RMS(exp1, obs1, comp_dim = 'ftime') +#' res <- RMS(exp1, obs1, comp_dim = 'ftime', dat_time = 'dat') #' # Renew example when Ano and Smoothing are ready #' -#'@rdname RMS #'@import multiApply #'@importFrom ClimProjDiags Subset #'@importFrom stats qchisq #'@export -RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', - comp_dim = NULL, limits = NULL, - conf = TRUE, conf.lev = 0.95, ncores = NULL) { +RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, + comp_dim = NULL, limits = NULL, pval = TRUE, conf = TRUE, + sign = FALSE, alpha = 0.05, ncores = NULL) { # Check inputs ## exp and obs (1) if (is.null(exp) | is.null(obs)) { @@ -79,13 +91,13 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', } if (is.null(dim(exp)) & is.null(dim(obs))) { #is vector if (length(exp) == length(obs)) { - exp <- array(exp, dim = c(length(exp), 1)) - names(dim(exp)) <- c(time_dim, dat_dim) - obs <- array(obs, dim = c(length(obs), 1)) - names(dim(obs)) <- c(time_dim, dat_dim) + exp <- array(exp, dim = c(length(exp))) + names(dim(exp)) <- c(time_dim) + obs <- array(obs, dim = c(length(obs))) + names(dim(obs)) <- c(time_dim) } else { - stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", - "dimensions time_dim and dat_dim, or vector of same length.")) + stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", + "dimensions time_dim and dat_dim, or vector of same length.")) } } else if (is.null(dim(exp)) | is.null(dim(obs))) { stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", @@ -136,13 +148,21 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', "integers smaller than the length of paramter 'comp_dim'.")) } } + ## pval + if (!is.logical(pval) | length(pval) > 1) { + stop("Parameter 'pval' must be one logical value.") + } ## conf if (!is.logical(conf) | length(conf) > 1) { stop("Parameter 'conf' must be one logical value.") } - ## conf.lev - if (!is.numeric(conf.lev) | conf.lev < 0 | conf.lev > 1 | length(conf.lev) > 1) { - stop("Parameter 'conf.lev' must be a numeric number between 0 and 1.") + ## sign + if (!is.logical(sign) | length(sign) > 1) { + stop("Parameter 'sign' must be one logical value.") + } + ## alpha + if (!is.numeric(alpha) | alpha < 0 | alpha > 1 | length(alpha) > 1) { + stop("Parameter 'alpha' must be a numeric number between 0 and 1.") } ## ncores if (!is.null(ncores)) { @@ -195,21 +215,21 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', c(time_dim, dat_dim)), fun = .RMS, time_dim = time_dim, dat_dim = dat_dim, - conf = conf, conf.lev = conf.lev, ncores_input = ncores, + pval = pval, conf = conf, sign = sign, alpha = alpha, ncores = ncores) return(res) } -.RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', - conf = TRUE, conf.lev = 0.95, ncores_input = NULL) { +.RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, + pval = TRUE, conf = TRUE, sign = FALSE, alpha = 0.05) { if (is.null(dat_dim)) { # exp: [sdate] # obs: [sdate] nexp <- 1 nobs <- 1 ini_dims <- dim(exp) - dim(exp) <- c(ini_dims, dat_dim = 1) - dim(obs) <- c(ini_dims, dat_dim = 1) + dim(exp) <- c(ini_dims, dat = 1) + dim(obs) <- c(ini_dims, dat = 1) } else { # exp: [sdate, dat_exp] # obs: [sdate, dat_obs] @@ -218,10 +238,9 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', } dif <- array(dim = c(dim(exp)[1], nexp = nexp, nobs = nobs)) - chi <- array(dim = c(nexp = nexp, nobs = nobs)) if (conf) { - conflow <- (1 - conf.lev) / 2 + conflow <- alpha / 2 confhigh <- 1 - conflow conf.lower <- array(dim = c(nexp = nexp, nobs = nobs)) conf.upper <- array(dim = c(nexp = nexp, nobs = nobs)) @@ -232,11 +251,17 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', dif[, , i] <- sapply(1:nexp, function(x) {exp[, x] - obs[, i]}) } - rms <- apply(dif^2, c(2, 3), mean, na.rm = TRUE)^0.5 #array(dim = c(_exp, nobs)) + rms <- colMeans(dif^2, na.rm = TRUE)^0.5 #array(dim = c(nexp, nobs)) - if (conf) { - #eno <- Eno(dif, 1) #count effective sample along sdate. dim = c(nexp, nobs) - eno <- Eno(dif, time_dim, ncores = ncores_input) #change to this line when Eno() is done + if (conf | pval | sign) { + #count effective sample along sdate. eno: c(nexp, nobs) +# eno <- Eno(dif, time_dim) # slower than for loop below? + eno <- array(dim = c(nexp = nexp, nobs = nobs)) + for (n_obs in 1:nobs) { + for (n_exp in 1:nexp) { + eno[n_exp, n_obs] <- .Eno(dif[, n_exp, n_obs], na.action = na.pass) + } + } # conf.lower chi <- sapply(1:nobs, function(i) { @@ -251,6 +276,15 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', conf.upper <- (eno * rms ** 2 / chi) ** 0.5 } + if (pval | sign) { + chi <- array(dim = c(nexp = nexp, nobs = nobs)) + for (i in 1:nobs) { + chi[, i] <- sapply(1:nexp, function(x) {sum((exp[, x] - obs[, i])^2 / exp[, x])}) + } + p_val <- pchisq(chi, eno - 1, lower.tail = FALSE) + if (sign) signif <- p_val <= alpha + } + ################################### # Remove nexp and nobs if dat_dim = NULL if (is.null(dat_dim)) { @@ -259,16 +293,16 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', dim(conf.lower) <- NULL dim(conf.upper) <- NULL } + if (pval) dim(p_val) <- NULL + if (sign) dim(signif) <- NULL } ################################### - - if (conf) { - res <- list(rms = rms, conf.lower = conf.lower, conf.upper = conf.upper) - } else { - res <- list(rms = rms) - } + res <- list(rms = rms) + if (pval) res <- c(res, list(p.val = p_val)) + if (sign) res <- c(res, list(sign = signif)) + if (conf) res <- c(res, list(conf.lower = conf.lower, conf.upper = conf.upper)) return(res) -} \ No newline at end of file +} diff --git a/R/RMSSS.R b/R/RMSSS.R index b8b3cc0..d81b81d 100644 --- a/R/RMSSS.R +++ b/R/RMSSS.R @@ -14,15 +14,12 @@ #'Fisher test or Random Walk test.\cr #' #'@param exp A named numeric array of experimental data which contains at least -#' two dimensions for dat_dim and time_dim. It can also be a vector with the -#' same length as 'obs', then the vector will automatically be 'time_dim' and -#' 'dat_dim' will be 1. +#' time dimension (time_dim). It can also be a vector with the same length as +#' 'obs', then the vector will automatically be 'time_dim'. #'@param obs A named numeric array of observational data which contains at least -#' two dimensions for dat_dim and time_dim. The dimensions should be the same -#' as paramter 'exp' except the length of 'dat_dim' dimension. The order of -#' dimension can be different. It can also be a vector with the same length as -#' 'exp', then the vector will automatically be 'time_dim' and 'dat_dim' will -#' be 1. +#' time dimension (time_dim). The dimensions should be the same as parameter +#' 'exp' except the length of 'dat_dim' dimension. It can also be a vector with +#' the same length as 'exp', then the vector will automatically be 'time_dim'. #'@param ref A named numerical array of the reference forecast data with at #' least time dimension, or 0 (typical climatological forecast) or 1 #' (normalized climatological forecast). If it is an array, the dimensions must @@ -33,7 +30,7 @@ #' climatological forecast is used as reference forecast (equivelant to 0.) #' The default value is NULL. #'@param dat_dim A character string indicating the name of dataset (nobs/nexp) -#' dimension. The default value is 'dataset'. +#' dimension. The default value is NULL. #'@param time_dim A character string indicating the name of dimension along #' which the RMSSS are computed. The default value is 'sdate'. #'@param memb_dim A character string indicating the name of the member dimension @@ -80,7 +77,7 @@ #'@import multiApply #'@importFrom stats pf #'@export -RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = 'dataset', +RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, memb_dim = NULL, pval = TRUE, sign = FALSE, alpha = 0.05, sig_method = 'one-sided Fisher', ncores = NULL) { @@ -297,7 +294,7 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = 'dataset', return(res) } -.RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = 'dataset', pval = TRUE, +.RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, pval = TRUE, sign = FALSE, alpha = 0.05, sig_method = 'one-sided Fisher') { # exp: [sdate, (dat)] # obs: [sdate, (dat)] diff --git a/man/RMS.Rd b/man/RMS.Rd index 4391df4..f5e46f6 100644 --- a/man/RMS.Rd +++ b/man/RMS.Rd @@ -8,11 +8,13 @@ RMS( exp, obs, time_dim = "sdate", - dat_dim = "dataset", + dat_dim = NULL, comp_dim = NULL, limits = NULL, + pval = TRUE, conf = TRUE, - conf.lev = 0.95, + sign = FALSE, + alpha = 0.05, ncores = NULL ) } @@ -30,8 +32,9 @@ length as 'exp', then the vector will automatically be 'time_dim' and \item{time_dim}{A character string indicating the name of dimension along which the correlations are computed. The default value is 'sdate'.} -\item{dat_dim}{A character string indicating the name of member (nobs/nexp) -dimension. The default value is 'dataset'.} +\item{dat_dim}{A character string indicating the name of dataset or member +(nobs/nexp) dimension. The datasets of exp and obs will be paired and +computed RMS for each pair. The default value is NULL.} \item{comp_dim}{A character string indicating the name of dimension along which obs is taken into account only if it is complete. The default value @@ -40,11 +43,18 @@ is NULL.} \item{limits}{A vector of two integers indicating the range along comp_dim to be completed. The default value is c(1, length(comp_dim dimension)).} +\item{pval}{A logical value indicating whether to return or not the p-value +of the test Ho: Corr = 0. The default value is TRUE.} + \item{conf}{A logical value indicating whether to retrieve the confidence intervals or not. The default value is TRUE.} -\item{conf.lev}{A numeric indicating the confidence level for the -regression computation. The default value is 0.95.} +\item{sign}{A logical value indicating whether to retrieve the statistical +significance of the test Ho: Corr = 0 based on 'alpha'. The default value is +FALSE.} + +\item{alpha}{A numeric indicating the significance level for 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.} @@ -53,16 +63,23 @@ computation. The default value is NULL.} A list containing the numeric arrays with dimension:\cr c(nexp, nobs, all other dimensions of exp except time_dim).\cr nexp is the number of experiment (i.e., dat_dim in exp), and nobs is the -number of observation (i.e., dat_dim in obs).\cr +number of observation (i.e., dat_dim in obs). If dat_dim is NULL, nexp and +nobs are omitted.\cr \item{$rms}{ The root mean square error. } +\item{$p.val}{ + The p-value. Only present if \code{pval = TRUE}. +} \item{$conf.lower}{ The lower confidence interval. Only present if \code{conf = TRUE}. } \item{$conf.upper}{ The upper confidence interval. Only present if \code{conf = TRUE}. } +\item{$sign}{ + The statistical significance. Only present if \code{sign = TRUE}. +} } \description{ Compute the root mean square error for an array of forecasts and an array of @@ -78,13 +95,13 @@ The confidence interval is computed by the chi2 distribution.\cr \examples{ # Load sample data as in Load() example: set.seed(1) - exp1 <- array(rnorm(120), dim = c(dataset = 3, sdate = 5, ftime = 2, lon = 1, lat = 4)) + exp1 <- array(rnorm(120), dim = c(dat = 3, sdate = 5, ftime = 2, lon = 1, lat = 4)) set.seed(2) - obs1 <- array(rnorm(80), dim = c(dataset = 2, sdate = 5, ftime = 2, lon = 1, lat = 4)) + obs1 <- array(rnorm(80), dim = c(dat = 2, sdate = 5, ftime = 2, lon = 1, lat = 4)) set.seed(2) na <- floor(runif(10, min = 1, max = 80)) obs1[na] <- NA - res <- RMS(exp1, obs1, comp_dim = 'ftime') + res <- RMS(exp1, obs1, comp_dim = 'ftime', dat_time = 'dat') # Renew example when Ano and Smoothing are ready } diff --git a/man/RMSSS.Rd b/man/RMSSS.Rd index bcf221c..c647c71 100644 --- a/man/RMSSS.Rd +++ b/man/RMSSS.Rd @@ -9,7 +9,7 @@ RMSSS( obs, ref = NULL, time_dim = "sdate", - dat_dim = "dataset", + dat_dim = NULL, memb_dim = NULL, pval = TRUE, sign = FALSE, @@ -20,16 +20,13 @@ RMSSS( } \arguments{ \item{exp}{A named numeric array of experimental data which contains at least -two dimensions for dat_dim and time_dim. It can also be a vector with the -same length as 'obs', then the vector will automatically be 'time_dim' and -'dat_dim' will be 1.} +time dimension (time_dim). It can also be a vector with the same length as +'obs', then the vector will automatically be 'time_dim'.} \item{obs}{A named numeric array of observational data which contains at least -two dimensions for dat_dim and time_dim. The dimensions should be the same -as paramter 'exp' except the length of 'dat_dim' dimension. The order of -dimension can be different. It can also be a vector with the same length as -'exp', then the vector will automatically be 'time_dim' and 'dat_dim' will -be 1.} +time dimension (time_dim). The dimensions should be the same as parameter +'exp' except the length of 'dat_dim' dimension. It can also be a vector with +the same length as 'exp', then the vector will automatically be 'time_dim'.} \item{ref}{A named numerical array of the reference forecast data with at least time dimension, or 0 (typical climatological forecast) or 1 @@ -45,7 +42,7 @@ The default value is NULL.} which the RMSSS are computed. The default value is 'sdate'.} \item{dat_dim}{A character string indicating the name of dataset (nobs/nexp) -dimension. The default value is 'dataset'.} +dimension. The default value is NULL.} \item{memb_dim}{A character string indicating the name of the member dimension to compute the ensemble mean; it should be set to NULL if the parameter 'exp' diff --git a/tests/testthat/test-RMS.R b/tests/testthat/test-RMS.R index bf059ef..d45d59c 100644 --- a/tests/testthat/test-RMS.R +++ b/tests/testthat/test-RMS.R @@ -88,8 +88,8 @@ test_that("1. Input checks", { "integers smaller than the length of paramter 'comp_dim'.") ) expect_error( - RMS(exp1, obs1, conf.lev = -1), - "Parameter 'conf.lev' must be a numeric number between 0 and 1." + RMS(exp1, obs1, alpha = -1), + "Parameter 'alpha' must be a numeric number between 0 and 1." ) expect_error( RMS(exp1, obs1, conf = 1), @@ -106,7 +106,7 @@ test_that("1. Input checks", { ) expect_error( RMS(exp = array(1:5, dim = c(sdate = 1, dataset = 5, a = 1)), - obs = array(1:2, dim = c(a = 1, sdate = 1, dataset = 2))), + obs = array(1:2, dim = c(a = 1, sdate = 1, dataset = 2)), dat_dim = "dataset"), "The length of time_dim must be at least 2 to compute RMS." ) @@ -118,65 +118,65 @@ test_that("1. Input checks", { test_that("2. Output checks: dat1", { suppressWarnings( expect_equal( - dim(RMS(exp1, obs1)$rms), + dim(RMS(exp1, obs1, dat_dim = 'dataset')$rms), c(nexp = 3, nobs = 2, ftime = 2, lon = 1, lat = 4) ) ) suppressWarnings( expect_equal( - RMS(exp1, obs1)$rms[1:6], + RMS(exp1, obs1, dat_dim = 'dataset')$rms[1:6], c(1.2815677, 2.0832803, 1.1894637, 1.3000403, 1.4053807, 0.8157563), tolerance = 0.001 ) ) suppressWarnings( expect_equal( - length(which(is.na(RMS(exp1, obs1)$conf.lower))), + length(which(is.na(RMS(exp1, obs1, dat_dim = 'dataset')$conf.lower))), 4 ) ) suppressWarnings( expect_equal( - max(RMS(exp1, obs1)$conf.lower, na.rm = T), + max(RMS(exp1, obs1, dat_dim = 'dataset')$conf.lower, na.rm = T), 1.399509, tolerance = 0.001 ) ) suppressWarnings( expect_equal( - length(which(is.na(RMS(exp1, obs1, comp_dim = 'ftime')$rms))), + length(which(is.na(RMS(exp1, obs1, dat_dim = 'dataset', comp_dim = 'ftime')$rms))), 0 ) ) suppressWarnings( expect_equal( - length(which(is.na(RMS(exp1, obs1, comp_dim = 'ftime')$conf.upper))), + length(which(is.na(RMS(exp1, obs1, dat_dim = 'dataset', comp_dim = 'ftime')$conf.upper))), 8 ) ) suppressWarnings( expect_equal( - length(which(is.na(RMS(exp1, obs1, comp_dim = 'lat')$conf.lower))), + length(which(is.na(RMS(exp1, obs1, dat_dim = 'dataset', comp_dim = 'lat')$conf.lower))), 36 ) ) suppressWarnings( expect_equal( - length(which(is.na(RMS(exp1, obs1, comp_dim = 'lat', limits = c(1, 2))$conf.lower))), + length(which(is.na(RMS(exp1, obs1, dat_dim = 'dataset', comp_dim = 'lat', limits = c(1, 2))$conf.lower))), 21 ) ) suppressWarnings( expect_equal( - min(RMS(exp1, obs1, conf.lev = 0.99)$conf.upper, na.rm = TRUE), + min(RMS(exp1, obs1, dat_dim = 'dataset', alpha = 0.01)$conf.upper, na.rm = TRUE), 1.406368, tolerance = 0.0001 ) ) suppressWarnings( expect_equal( - length(RMS(exp1, obs1, conf = FALSE)), - 1 + length(RMS(exp1, obs1, dat_dim = 'dataset', conf = FALSE)), + 2 ) ) @@ -188,7 +188,7 @@ test_that("3. Output checks: dat2", { expect_equal( dim(RMS(exp2, obs2)$rms), - c(nexp = 1, nobs = 1) + NULL ) expect_equal( @@ -219,6 +219,30 @@ test_that("4. Output checks: dat3", { dim(RMS(exp4, obs4, time_dim = 'sdates', dat_dim = NULL, conf = TRUE)$rms), c(ftimes = 2, lon = 1, lat = 1) ) + expect_equal( + length(RMS(exp3, obs3, dat_dim = NULL, sign = T, conf = F)), + 3 + ) + expect_equal( + c(RMS(exp3, obs3, dat_dim = NULL, sign = T, conf = F)$sign[1,1,]), + c(FALSE, FALSE, TRUE, FALSE) + ) + expect_equal( + c(RMS(exp3, obs3, dat_dim = NULL, sign = T, conf = F)$p.val[1,1,]), + c(1, 0.8498872, 4.686846e-06, 1), + tolerance = 0.0001 + ) + expect_equal( + c(RMS(exp3, obs3, dat_dim = NULL, pval = F)$conf.lower[1,1,]), + c(1.1024490, 0.5533838, 1.4531443, 0.3606632), + tolerance = 0.0001 + ) + expect_equal( + c(RMS(exp3, obs3, dat_dim = NULL, pval = F)$conf.upper[1,1,]), + c(5.287554, 2.654133, 6.969554, 1.729809), + tolerance = 0.0001 + ) + }) -############################################## \ No newline at end of file +############################################## -- GitLab From b10b2e7d892dc5b477907c7175dc499e0798c5b1 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 3 Apr 2023 13:23:15 +0200 Subject: [PATCH 15/64] Add sign; change conf.lev to alpha --- R/Regression.R | 83 +++++++++++++++----------------- man/Regression.Rd | 16 ++++-- tests/testthat/test-Regression.R | 14 ++++-- 3 files changed, 63 insertions(+), 50 deletions(-) diff --git a/R/Regression.R b/R/Regression.R index 1cd12e6..535f179 100644 --- a/R/Regression.R +++ b/R/Regression.R @@ -19,8 +19,10 @@ #' or not. The default value is TRUE. #'@param conf A logical value indicating whether to retrieve the confidence #' intervals or not. The default value is TRUE. -#'@param conf.lev A numeric indicating the confidence level for the -#' regression computation. The default value is 0.95. +#'@param sign A logical value indicating whether to compute or not the +#' statistical significance of the test 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 na.action A function or an integer. A function (e.g., na.omit, #' na.exclude, na.fail, na.pass) indicates what should happen when the data #' contain NAs. A numeric indicates the maximum number of NA position (it @@ -60,6 +62,10 @@ #' A numeric array with same dimensions as parameter 'daty' and 'datax' except #' the 'reg_dim' dimension, The array contains the p-value. #'} +#'\item{sign}{ +#' A logical array of the statistical significance of the regression with the +#' same dimensions as $regression. Only present if \code{sign = TRUE}. +#'} #'\item{$filtered}{ #' A numeric array with the same dimension as paramter 'datay' and 'datax', #' the filtered datay from the regression onto datax along the 'reg_dim' @@ -74,13 +80,13 @@ #'datax <- sampleData$obs[, 1, , ] #'names(dim(datax)) <- c('sdate', 'ftime') #'res1 <- Regression(datay, datax, formula = y~poly(x, 2, raw = TRUE)) -#'res2 <- Regression(datay, datax, conf.lev = 0.9) +#'res2 <- Regression(datay, datax, alpha = 0.1) #' #'@importFrom stats lm na.omit confint #'@import multiApply #'@export Regression <- function(datay, datax, reg_dim = 'sdate', formula = y ~ x, - pval = TRUE, conf = TRUE, conf.lev = 0.95, + pval = TRUE, conf = TRUE, sign = FALSE, alpha = 0.05, na.action = na.omit, ncores = NULL) { # Check inputs @@ -134,9 +140,13 @@ Regression <- function(datay, datax, reg_dim = 'sdate', formula = y ~ x, if (!is.logical(conf) | length(conf) > 1) { stop("Parameter 'conf' must be one logical value.") } - ##conf.lev - if (!is.numeric(conf.lev) | conf.lev < 0 | conf.lev > 1 | length(conf.lev) > 1) { - stop("Parameter 'conf.lev' must be a numeric number between 0 and 1.") + ## sign + if (!is.logical(sign) | length(sign) > 1) { + stop("Parameter 'sign' must be one logical value.") + } + ## alpha + if (!is.numeric(alpha) | alpha < 0 | alpha > 1 | length(alpha) > 1) { + stop("Parameter 'alpha' must be a numeric number between 0 and 1.") } ## na.action if (!is.function(na.action) & !is.numeric(na.action)) { @@ -169,33 +179,27 @@ Regression <- function(datay, datax, reg_dim = 'sdate', formula = y ~ x, ############################### # Calculate Regression - if (conf & pval) { - output_dims <- list(regression = 'stats', conf.lower = 'stats', - conf.upper = 'stats', p.val = NULL, filtered = reg_dim) - } else if (conf & !pval) { - output_dims <- list(regression = 'stats', conf.lower = 'stats', - conf.upper = 'stats', filtered = reg_dim) - } else if (!conf & pval) { - output_dims <- list(regression = 'stats', - p.val = NULL, filtered = reg_dim) - } else if (!conf & !pval) { - output_dims <- list(regression = 'stats', filtered = reg_dim) - } - + + ## output_dims + output_dims <- list(regression = 'stats', filtered = reg_dim) + if (conf) output_dims <- c(output_dims, list(conf.lower = 'stats', conf.upper = 'stats')) + if (pval) output_dims <- c(output_dims, list(p.val = NULL)) + if (sign) output_dims <- c(output_dims, list(sign = NULL)) + res <- Apply(list(datay, datax), target_dims = reg_dim, output_dims = output_dims, fun = .Regression, - formula = formula, pval = pval, conf = conf, - conf.lev = conf.lev, na.action = na.action, + formula = formula, pval = pval, conf = conf, sign = sign, + alpha = alpha, na.action = na.action, ncores = ncores) return(invisible(res)) } -.Regression <- function(y, x, formula = y~x, pval = TRUE, conf = TRUE, - conf.lev = 0.95, na.action = na.omit) { +.Regression <- function(y, x, formula = y~x, pval = TRUE, conf = TRUE, + sign = FALSE, alpha = 0.05, na.action = na.omit) { NApos <- 1:length(x) NApos[which(is.na(x) | is.na(y))] <- NA @@ -211,12 +215,13 @@ Regression <- function(datay, datax, reg_dim = 'sdate', formula = y ~ x, lm.out <- lm(formula, data = data.frame(x = x, y = y), na.action = na.action) coeff <- lm.out$coefficients if (conf) { - conf.lower <- confint(lm.out, level = conf.lev)[, 1] - conf.upper <- confint(lm.out, level = conf.lev)[, 2] + conf.lower <- confint(lm.out, level = 1 - alpha)[, 1] + conf.upper <- confint(lm.out, level = 1 - alpha)[, 2] } - if (pval) { + if (pval | sign) { f <- summary(lm.out)$fstatistic - p.val <- pf(f[1], f[2], f[3],lower.tail = F) + p.val <- pf(f[1], f[2], f[3], lower.tail = F) + if (sign) signif <- !is.na(p.val) & p.val <= alpha } filtered[!is.na(NApos)] <- y[!is.na(NApos)] - lm.out$fitted.values @@ -228,25 +233,17 @@ Regression <- function(datay, datax, reg_dim = 'sdate', formula = y ~ x, conf.lower[which(!is.na(conf.lower))] <- NA conf.upper[which(!is.na(conf.upper))] <- NA } - if (pval) { - p.val[which(!is.na(p.val))] <- NA - } + if (pval) p.val[which(!is.na(p.val))] <- NA + if (sign) signif[which(!is.na(signif))] <- NA filtered[which(!is.na(filtered))] <- NA } } - if (conf & pval) { - return(list(regression = coeff, conf.lower = conf.lower, conf.upper = conf.upper, - p.val = p.val, filtered = filtered)) - } else if (conf & !pval) { - return(list(regression = coeff, conf.lower = conf.lower, conf.upper = conf.upper, - filtered = filtered)) - } else if (!conf & pval) { - return(list(regression = coeff, - p.val = p.val, filtered = filtered)) - } else if (!conf & !pval) { - return(list(regression = coeff, filtered = filtered)) - } + res <- list(regression = coeff, filtered = filtered) + if (conf) res <- c(res, list(conf.lower = conf.lower, conf.upper = conf.upper)) + if (pval) res <- c(res, list(p.val = p.val)) + if (sign) res <- c(res, list(sign = signif)) + return(res) } diff --git a/man/Regression.Rd b/man/Regression.Rd index 8e27295..9ac0c94 100644 --- a/man/Regression.Rd +++ b/man/Regression.Rd @@ -11,7 +11,8 @@ Regression( formula = y ~ x, pval = TRUE, conf = TRUE, - conf.lev = 0.95, + sign = FALSE, + alpha = 0.05, na.action = na.omit, ncores = NULL ) @@ -34,8 +35,11 @@ or not. The default value is TRUE.} \item{conf}{A logical value indicating whether to retrieve the confidence intervals or not. The default value is TRUE.} -\item{conf.lev}{A numeric indicating the confidence level for the -regression computation. The default value is 0.95.} +\item{sign}{A logical value indicating whether to compute or not the +statistical significance of the test 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.} \item{na.action}{A function or an integer. A function (e.g., na.omit, na.exclude, na.fail, na.pass) indicates what should happen when the data @@ -75,6 +79,10 @@ A list containing: A numeric array with same dimensions as parameter 'daty' and 'datax' except the 'reg_dim' dimension, The array contains the p-value. } +\item{sign}{ + A logical array of the statistical significance of the regression with the + same dimensions as $regression. Only present if \code{sign = TRUE}. +} \item{$filtered}{ A numeric array with the same dimension as paramter 'datay' and 'datax', the filtered datay from the regression onto datax along the 'reg_dim' @@ -98,6 +106,6 @@ names(dim(datay)) <- c('sdate', 'ftime') datax <- sampleData$obs[, 1, , ] names(dim(datax)) <- c('sdate', 'ftime') res1 <- Regression(datay, datax, formula = y~poly(x, 2, raw = TRUE)) -res2 <- Regression(datay, datax, conf.lev = 0.9) +res2 <- Regression(datay, datax, alpha = 0.1) } diff --git a/tests/testthat/test-Regression.R b/tests/testthat/test-Regression.R index a29076f..d0898bf 100644 --- a/tests/testthat/test-Regression.R +++ b/tests/testthat/test-Regression.R @@ -83,8 +83,8 @@ test_that("1. Input checks", { "Parameter 'conf' must be one logical value." ) expect_error( - Regression(datay1, datax1, conf.lev = 1.5), - "Parameter 'conf.lev' must be a numeric number between 0 and 1." + Regression(datay1, datax1, alpha = 2), + "Parameter 'alpha' must be a numeric number between 0 and 1." ) expect_error( Regression(datay1, datax1, ncores = T), @@ -127,7 +127,11 @@ test_that("2. Output checks: dat1", { 2 ) expect_equal( - range(Regression(datay1, datax1, conf.lev = 0.99)$conf.low, na.rm = T), + length(Regression(datay1, datax1, pval = F, sign = T)), + 5 + ) + expect_equal( + range(Regression(datay1, datax1, alpha = 0.01)$conf.low, na.rm = T), c(-380.888744, 0.220794), tolerance = 0.001 ) @@ -136,6 +140,10 @@ test_that("2. Output checks: dat1", { 0.005335, tolerance = 0.0001 ) + expect_equal( + c(Regression(datay1, datax1, sign = T, conf = F)$sign[1, 2, ]), + c(TRUE, FALSE, FALSE, FALSE) + ) expect_equal( mean(Regression(datay1, datax1, formula = y~poly(x, 2, raw = T))$p.val, na.rm = TRUE), 0.3407307, -- GitLab From ac5903b0d90ff8fc6d253056d804554a6d070fe6 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 3 Apr 2023 14:22:56 +0200 Subject: [PATCH 16/64] Change conf.lev to alpha --- R/Spread.R | 36 ++++++++++++++++++------------------ man/Spread.Rd | 6 +++--- tests/testthat/test-Spread.R | 6 +++--- 3 files changed, 24 insertions(+), 24 deletions(-) diff --git a/R/Spread.R b/R/Spread.R index d1d8f6d..09bbe05 100644 --- a/R/Spread.R +++ b/R/Spread.R @@ -16,8 +16,8 @@ #' kept (FALSE) for computation. The default value is TRUE. #'@param conf A logical value indicating whether to compute the confidence #' intervals or not. The default value is TRUE. -#'@param conf.lev A numeric value of the confidence level for the computation. -#' The default value is 0.95. +#'@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. #' @@ -81,7 +81,7 @@ #'@importFrom stats IQR sd mad runif quantile #'@export Spread <- function(data, compute_dim = 'member', na.rm = TRUE, - conf = TRUE, conf.lev = 0.95, ncores = NULL) { + conf = TRUE, alpha = 0.05, ncores = NULL) { # Check inputs ## data @@ -113,9 +113,9 @@ Spread <- function(data, compute_dim = 'member', na.rm = TRUE, if (!is.logical(conf) | length(conf) > 1) { stop("Parameter 'conf' must be one logical value.") } - ## conf.lev - if (!is.numeric(conf.lev) | any(conf.lev < 0) | any(conf.lev > 1) | length(conf.lev) > 1) { - stop("Parameter 'conf.lev' must be a numeric number between 0 and 1.") + ## alpha + if (any(!is.numeric(alpha) | alpha < 0 | alpha > 1) | length(alpha) > 1) { + stop("Parameter 'alpha' must be a numeric number between 0 and 1.") } ## ncores if (!is.null(ncores)) { @@ -134,14 +134,14 @@ Spread <- function(data, compute_dim = 'member', na.rm = TRUE, output_dims = list(iqr = 'stats', maxmin = 'stats', sd = 'stats', mad = 'stats'), na.rm = na.rm, - conf = conf, conf.lev = conf.lev, + conf = conf, alpha = alpha, ncores = ncores) return(output) } .Spread <- function(data, compute_dim = 'member', na.rm = TRUE, - conf = TRUE, conf.lev = 0.95) { + conf = TRUE, alpha = 0.05) { # data: compute_dim. [member] or [member, sdate] for example @@ -159,24 +159,24 @@ Spread <- function(data, compute_dim = 'member', na.rm = TRUE, res_sd <- rep(res_sd, 3) res_mad <- rep(res_mad, 3) - conf_low <- (1 - conf.lev) / 2 + conf_low <- alpha / 2 conf_high <- 1 - conf_low # Create vector for saving bootstrap result - iqr_bs <- c() - maxmin_bs <- c() - sd_bs <- c() - mad_bs <- c() + iqr_bs <- rep(NA, 100) + maxmin_bs <- rep(NA, 100) + sd_bs <- rep(NA, 100) + mad_bs <- rep(NA, 100) # bootstrapping for 100 times num <- length(data) for (jmix in 1:100) { drawings <- round(runif(num, 0.5, num + 0.5)) - iqr_bs <- c(iqr_bs, IQR(data[drawings], na.rm = na.rm)) - maxmin_bs <- c(maxmin_bs, max(data[drawings], na.rm = na.rm) - - min(data[drawings], na.rm = na.rm)) - sd_bs <- c(sd_bs, sd(data[drawings], na.rm = na.rm)) - mad_bs <- c(mad_bs, mad(data[drawings], na.rm = na.rm)) + iqr_bs[jmix] <- IQR(data[drawings], na.rm = na.rm) + maxmin_bs[jmix] <- max(data[drawings], na.rm = na.rm) - + min(data[drawings], na.rm = na.rm) + sd_bs[jmix] <- sd(data[drawings], na.rm = na.rm) + mad_bs[jmix] <- mad(data[drawings], na.rm = na.rm) } # Calculate confidence interval with the bootstrapping results diff --git a/man/Spread.Rd b/man/Spread.Rd index e26bc14..c5fc4d1 100644 --- a/man/Spread.Rd +++ b/man/Spread.Rd @@ -10,7 +10,7 @@ Spread( compute_dim = "member", na.rm = TRUE, conf = TRUE, - conf.lev = 0.95, + alpha = 0.05, ncores = NULL ) } @@ -27,8 +27,8 @@ kept (FALSE) for computation. The default value is TRUE.} \item{conf}{A logical value indicating whether to compute the confidence intervals or not. The default value is TRUE.} -\item{conf.lev}{A numeric value of the confidence level for the computation. -The default value is 0.95.} +\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.} diff --git a/tests/testthat/test-Spread.R b/tests/testthat/test-Spread.R index 1d299a6..d0d55cd 100644 --- a/tests/testthat/test-Spread.R +++ b/tests/testthat/test-Spread.R @@ -45,10 +45,10 @@ test_that("1. Input checks", { Spread(dat1, conf = 0.1), "Parameter 'conf' must be one logical value." ) - # conf.lev + # alpha expect_error( - Spread(dat1, conf.lev = c(0.05, 0.95)), - "Parameter 'conf.lev' must be a numeric number between 0 and 1." + Spread(dat1, alpha = c(0.05, 0.95)), + "Parameter 'alpha' must be a numeric number between 0 and 1." ) # ncores expect_error( -- GitLab From 91d11c2c8b01f2253a95675ff80ca15b5a0f79fd Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 3 Apr 2023 15:44:49 +0200 Subject: [PATCH 17/64] dat_dim default change to NULL --- R/RMS.R | 23 ++++++++++++----------- R/RMSSS.R | 12 ++++++------ tests/testthat/test-RMSSS.R | 10 +++++----- 3 files changed, 23 insertions(+), 22 deletions(-) diff --git a/R/RMS.R b/R/RMS.R index 8a1899a..3f4ae1f 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -262,18 +262,19 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, eno[n_exp, n_obs] <- .Eno(dif[, n_exp, n_obs], na.action = na.pass) } } + if (conf) { + # conf.lower + chi <- sapply(1:nobs, function(i) { + qchisq(confhigh, eno[, i] - 1) + }) + conf.lower <- (eno * rms ** 2 / chi) ** 0.5 - # conf.lower - chi <- sapply(1:nobs, function(i) { - qchisq(confhigh, eno[, i] - 1) - }) - conf.lower <- (eno * rms ** 2 / chi) ** 0.5 - - # conf.upper - chi <- sapply(1:nobs, function(i) { - qchisq(conflow, eno[, i] - 1) - }) - conf.upper <- (eno * rms ** 2 / chi) ** 0.5 + # conf.upper + chi <- sapply(1:nobs, function(i) { + qchisq(conflow, eno[, i] - 1) + }) + conf.upper <- (eno * rms ** 2 / chi) ** 0.5 + } } if (pval | sign) { diff --git a/R/RMSSS.R b/R/RMSSS.R index d81b81d..0124b4a 100644 --- a/R/RMSSS.R +++ b/R/RMSSS.R @@ -91,10 +91,10 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, } if (is.null(dim(exp)) & is.null(dim(obs))) { #is vector if (length(exp) == length(obs)) { - exp <- array(exp, dim = c(length(exp), 1)) - names(dim(exp)) <- c(time_dim, dat_dim) - obs <- array(obs, dim = c(length(obs), 1)) - names(dim(obs)) <- c(time_dim, dat_dim) + exp <- array(exp, dim = c(length(exp))) + names(dim(exp)) <- c(time_dim) + obs <- array(obs, dim = c(length(obs))) + names(dim(obs)) <- c(time_dim) } else { stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", "dimensions time_dim and dat_dim, or vector of same length.")) @@ -103,8 +103,8 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", "dimensions time_dim and dat_dim, or vector of same length.")) } - if(any(is.null(names(dim(exp))))| any(nchar(names(dim(exp))) == 0) | - any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { + if(any(is.null(names(dim(exp)))) | any(nchar(names(dim(exp))) == 0) | + any(is.null(names(dim(obs)))) | any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } if(!all(names(dim(exp)) %in% names(dim(obs))) | diff --git a/tests/testthat/test-RMSSS.R b/tests/testthat/test-RMSSS.R index fa019e6..5619f46 100644 --- a/tests/testthat/test-RMSSS.R +++ b/tests/testthat/test-RMSSS.R @@ -110,7 +110,7 @@ test_that("1. Input checks", { ) expect_error( RMSSS(exp = array(1:10, dim = c(sdate = 1, dataset = 5, a = 1)), - obs = array(1:4, dim = c(a = 1, sdate = 1, dataset = 2))), + obs = array(1:4, dim = c(a = 1, sdate = 1, dataset = 2)), dat_dim = "dataset"), "The length of time_dim must be more than 2 to compute RMSSS." ) }) @@ -221,16 +221,16 @@ test_that("2. Output checks: case 1", { test_that("3. Output checks: case 2", { expect_equal( - dim(RMSSS(exp2, obs2, time_dim = 'time')$rmsss), + dim(RMSSS(exp2, obs2, time_dim = 'time', dat_dim = "dataset")$rmsss), c(nexp = 2, nobs = 1, dat = 1, lon = 3, lat = 2) ) expect_equal( - mean(RMSSS(exp2, obs2, time_dim = 'time')$rmsss), + mean(RMSSS(exp2, obs2, time_dim = 'time', dat_dim = "dataset")$rmsss), -0.3912208, tolerance = 0.00001 ) expect_equal( - range(RMSSS(exp2, obs2, time_dim = 'time')$p.val), + range(RMSSS(exp2, obs2, time_dim = 'time', dat_dim = "dataset")$p.val), c(0.2627770, 0.9868412), tolerance = 0.00001 ) @@ -243,7 +243,7 @@ test_that("4. Output checks: case 3", { expect_equal( dim(RMSSS(exp3, obs3)$rmsss), - c(nexp = 1, nobs = 1) + NULL ) expect_equal( as.vector(RMSSS(exp3, obs3)$rmsss), -- GitLab From 4ab1b5efab53f7572d12f6f2a3d9742dbe14b3ce Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 3 Apr 2023 15:51:18 +0200 Subject: [PATCH 18/64] Modification for conf.lev --- R/Corr.R | 9 +-------- R/RMSSS.R | 2 +- R/Spectrum.R | 18 +++++++++--------- man/Corr.Rd | 3 --- man/Spectrum.Rd | 6 +++--- tests/testthat/test-Spectrum.R | 6 +++--- 6 files changed, 17 insertions(+), 27 deletions(-) diff --git a/R/Corr.R b/R/Corr.R index 3430647..76a1af4 100644 --- a/R/Corr.R +++ b/R/Corr.R @@ -47,7 +47,6 @@ #' FALSE. #'@param alpha A numeric indicating the significance level for the statistical #' significance test. The default value is 0.05. -#'@param conf.lev Deprecated. Use alpha now instead. alpha = 1 - conf.lev. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -108,7 +107,7 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', comp_dim = NULL, limits = NULL, method = 'pearson', memb_dim = NULL, memb = TRUE, pval = TRUE, conf = TRUE, sign = FALSE, - alpha = 0.05, conf.lev = NULL, ncores = NULL) { + alpha = 0.05, ncores = NULL) { # Check inputs ## exp and obs (1) @@ -196,12 +195,6 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', if (!is.logical(sign) | length(sign) > 1) { stop("Parameter 'sign' must be one logical value.") } - ## conf.lev - ##NOTE: remove the parameter and the warning after v1.4.0 - if (!missing("conf.lev")) { - .warning(paste0("Argument 'conf.lev' is deprecated. Please use 'alpha' instead. ", - "'alpha' = ", 1 - conf.lev, " is used."), tag = '! Deprecation: ') - } ## alpha if (!is.numeric(alpha) | alpha < 0 | alpha > 1 | length(alpha) > 1) { stop("Parameter 'alpha' must be a numeric number between 0 and 1.") diff --git a/R/RMSSS.R b/R/RMSSS.R index 0124b4a..cf45fa6 100644 --- a/R/RMSSS.R +++ b/R/RMSSS.R @@ -368,7 +368,7 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, ################################################# # if (conf) { -# conflow <- (1 - conf.lev) / 2 +# conflow <- alpha / 2 # confhigh <- 1 - conflow # conf_low <- array(dim = c(nexp = nexp, nobs = nobs)) # conf_high <- array(dim = c(nexp = nexp, nobs = nobs)) diff --git a/R/Spectrum.R b/R/Spectrum.R index 2cbb167..a75ead6 100644 --- a/R/Spectrum.R +++ b/R/Spectrum.R @@ -15,8 +15,8 @@ #' evenly spaced in time. #'@param time_dim A character string indicating the dimension along which to #' compute the frequency spectrum. The default value is 'ftime'. -#'@param conf.lev A numeric indicating the confidence level for the Monte-Carlo -#' significance test. The default value is 0.95. +#'@param alpha A numeric indicating the significance level for the Monte-Carlo +#' 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. #' @@ -45,7 +45,7 @@ #'@import multiApply #'@importFrom stats spectrum cor rnorm sd quantile #'@export -Spectrum <- function(data, time_dim = 'ftime', conf.lev = 0.95, ncores = NULL) { +Spectrum <- function(data, time_dim = 'ftime', alpha = 0.05, ncores = NULL) { # Check inputs ## data @@ -69,9 +69,9 @@ Spectrum <- function(data, time_dim = 'ftime', conf.lev = 0.95, ncores = NULL) { if (!time_dim %in% names(dim(data))) { stop("Parameter 'time_dim' is not found in 'data' dimension.") } - ## conf.lev - if (!is.numeric(conf.lev) | conf.lev < 0 | conf.lev > 1 | length(conf.lev) > 1) { - stop("Parameter 'conf.lev' must be a numeric number between 0 and 1.") + ## alpha + if (!is.numeric(alpha) | alpha < 0 | alpha > 1 | length(alpha) > 1) { + stop("Parameter 'alpha' must be a numeric number between 0 and 1.") } ## ncores if (!is.null(ncores)) { @@ -88,13 +88,13 @@ Spectrum <- function(data, time_dim = 'ftime', conf.lev = 0.95, ncores = NULL) { target_dims = time_dim, fun = .Spectrum, output_dims = c(time_dim, 'stats'), - conf.lev = conf.lev, + alpha = alpha, ncores = ncores)$output1 return(output) } -.Spectrum <- function(data, conf.lev = 0.95) { +.Spectrum <- function(data, alpha = 0.05) { # data: [time] data <- data[is.na(data) == FALSE] @@ -119,7 +119,7 @@ Spectrum <- function(data, time_dim = 'ftime', conf.lev = 0.95, ncores = NULL) { store[jt, ] <- toto2$spec } for (jx in 1:length(tmp$spec)) { - output[jx, 3] <- quantile(store[, jx], conf.lev) + output[jx, 3] <- quantile(store[, jx], 1 - alpha) } } else { output <- NA diff --git a/man/Corr.Rd b/man/Corr.Rd index bbb1e34..10bdf71 100644 --- a/man/Corr.Rd +++ b/man/Corr.Rd @@ -18,7 +18,6 @@ Corr( conf = TRUE, sign = FALSE, alpha = 0.05, - conf.lev = NULL, ncores = NULL ) } @@ -67,8 +66,6 @@ FALSE.} \item{alpha}{A numeric indicating the significance level for the statistical significance test. The default value is 0.05.} -\item{conf.lev}{Deprecated. Use alpha now instead. alpha = 1 - conf.lev.} - \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } diff --git a/man/Spectrum.Rd b/man/Spectrum.Rd index 84b39c0..18671e5 100644 --- a/man/Spectrum.Rd +++ b/man/Spectrum.Rd @@ -4,7 +4,7 @@ \alias{Spectrum} \title{Estimate frequency spectrum} \usage{ -Spectrum(data, time_dim = "ftime", conf.lev = 0.95, ncores = NULL) +Spectrum(data, time_dim = "ftime", alpha = 0.05, ncores = NULL) } \arguments{ \item{data}{A vector or numeric array of which the frequency spectrum is @@ -15,8 +15,8 @@ evenly spaced in time.} \item{time_dim}{A character string indicating the dimension along which to compute the frequency spectrum. The default value is 'ftime'.} -\item{conf.lev}{A numeric indicating the confidence level for the Monte-Carlo -significance test. The default value is 0.95.} +\item{alpha}{A numeric indicating the significance level for the Monte-Carlo +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.} diff --git a/tests/testthat/test-Spectrum.R b/tests/testthat/test-Spectrum.R index caf53d3..9c64259 100644 --- a/tests/testthat/test-Spectrum.R +++ b/tests/testthat/test-Spectrum.R @@ -38,10 +38,10 @@ test_that("1. Input checks", { Spectrum(dat1, time_dim = 2), "Parameter 'time_dim' must be a character string." ) - # conf.lev + # alpha expect_error( - Spectrum(dat1, conf.lev = -1), - "Parameter 'conf.lev' must be a numeric number between 0 and 1.", + Spectrum(dat1, alpha = -1), + "Parameter 'alpha' must be a numeric number between 0 and 1.", fixed = T ) # ncores -- GitLab From 9342c5b047e0322d08313f7d098fc87a9fdab6fc Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 5 Apr 2023 17:48:41 +0200 Subject: [PATCH 19/64] Change dat_dim default to NULL; fix examples --- R/ACC.R | 44 ++++++----- R/Corr.R | 14 ++-- R/GetProbs.R | 41 +++++----- R/Plot2VarsVsLTime.R | 6 +- R/PlotACC.R | 8 +- R/PlotVsLTime.R | 5 +- R/RMS.R | 2 +- R/RatioSDRMS.R | 14 ++-- R/Spread.R | 2 + R/UltimateBrier.R | 10 +-- man/ACC.Rd | 10 +-- man/Corr.Rd | 12 +-- man/GetProbs.Rd | 42 +++++----- man/Plot2VarsVsLTime.Rd | 6 +- man/PlotACC.Rd | 5 +- man/PlotVsLTime.Rd | 5 +- man/RMS.Rd | 2 +- man/RatioSDRMS.Rd | 14 ++-- man/Spread.Rd | 2 + man/UltimateBrier.Rd | 8 +- tests/testthat/test-ACC.R | 14 ++-- tests/testthat/test-Corr.R | 114 ++++++++++++++-------------- tests/testthat/test-RatioSDRMS.R | 36 ++++----- tests/testthat/test-UltimateBrier.R | 76 +++++++++---------- 24 files changed, 254 insertions(+), 238 deletions(-) diff --git a/R/ACC.R b/R/ACC.R index 9da53aa..fcd1735 100644 --- a/R/ACC.R +++ b/R/ACC.R @@ -16,8 +16,7 @@ #' The dimension should be the same as 'exp' except the length of 'dat_dim' #' and 'memb_dim'. #'@param dat_dim A character string indicating the name of dataset (nobs/nexp) -#' dimension. The default value is 'dataset'. If there is no dataset -#' dimension, set NULL. +#' dimension. The default value is NULL (no dataset). #'@param lat_dim A character string indicating the name of the latitude #' dimension of 'exp' and 'obs' along which ACC is computed. The default value #' is 'lat'. @@ -119,8 +118,9 @@ #'clim <- Clim(sampleData$mod, sampleData$obs) #'ano_exp <- Ano(sampleData$mod, clim$clim_exp) #'ano_obs <- Ano(sampleData$obs, clim$clim_obs) -#'acc <- ACC(ano_exp, ano_obs, lat = sampleData$lat) -#'acc_bootstrap <- ACC(ano_exp, ano_obs, conftype = 'bootstrap', lat = sampleData$lat) +#'acc <- ACC(ano_exp, ano_obs, lat = sampleData$lat, dat_dim = 'dataset') +#'acc_bootstrap <- ACC(ano_exp, ano_obs, conftype = 'bootstrap', +#' lat = sampleData$lat, dat_dim = 'dataset') #'# Combine acc results for PlotACC #'res <- array(c(acc$conf.lower, acc$acc, acc$conf.upper, acc$p.val), #' dim = c(dim(acc$acc), 4)) @@ -138,7 +138,7 @@ #'@importFrom stats qt qnorm quantile #'@importFrom ClimProjDiags Subset #'@export -ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', +ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', space_dim = c('lat', 'lon'), avg_dim = 'sdate', memb_dim = 'member', lat = NULL, lon = NULL, lonlatbox = NULL, alpha = 0.05, pval = TRUE, sign = FALSE, conf = TRUE, conftype = "parametric", @@ -369,7 +369,7 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', return(res) } -.ACC <- function(exp, obs, dat_dim = 'dataset', avg_dim = 'sdate', lat, alpha = 0.05, +.ACC <- function(exp, obs, dat_dim = NULL, avg_dim = 'sdate', lat, alpha = 0.05, pval = TRUE, sign = FALSE, conf = TRUE, conftype = "parametric") { # .ACC() should use all the spatial points to calculate ACC. It returns [nexp, nobs]. # If dat_dim = NULL, it returns a number. @@ -386,8 +386,8 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', nexp <- 1 nobs <- 1 } else { - nexp <- as.numeric(dim(exp)[length(dim(exp))]) - nobs <- as.numeric(dim(obs)[length(dim(obs))]) + nexp <- as.numeric(dim(exp)[dat_dim]) + nobs <- as.numeric(dim(obs)[dat_dim]) } if (is.null(avg_dim)) { @@ -427,12 +427,12 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', } else { # [lat, lon, dat], [lat, lon, avg_dim], or [lat, lon, avg_dim, dat] # exp exp <- array(exp, dim = c(prod(dim_exp[1:2]), dim_exp[3:length(dim_exp)])) - mean_exp <- apply(exp, 2:length(dim(exp)), mean, na.rm = TRUE) # [avg_dim, (dat)] + mean_exp <- colMeans(exp, na.rm = TRUE) # [avg_dim, (dat)] mean_exp <- rep(as.vector(mean_exp), each = prod(dim_exp[1:2])) exp <- array(sqrt(wt) * (as.vector(exp) - mean_exp), dim = dim_exp) # obs obs <- array(obs, dim = c(prod(dim_obs[1:2]), dim_obs[3:length(dim_obs)])) - mean_obs <- apply(obs, 2:length(dim(obs)), mean, na.rm = TRUE) # [avg_dim, (dat)] + mean_obs <- colMeans(obs, na.rm = TRUE) # [avg_dim, (dat)] mean_obs <- rep(as.vector(mean_obs), each = prod(dim_obs[1:2])) obs <- array(sqrt(wt) * (as.vector(obs) - mean_obs), dim = dim_obs) } @@ -571,18 +571,26 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', } -.ACC_bootstrap <- function(exp, obs, dat_dim = 'dataset', +.ACC_bootstrap <- function(exp, obs, dat_dim = NULL, avg_dim = 'sdate', memb_dim = NULL, lat, alpha = 0.05, pval = TRUE, sign = FALSE, conf = TRUE, conftype = "parametric") { # if (is.null(avg_dim)) - # exp: [memb_exp, dat_exp, lat, lon] - # obs: [memb_obs, dat_obs, lat, lon] + # exp: [memb_exp, (dat_exp), lat, lon] + # obs: [memb_obs, (dat_obs), lat, lon] # if (!is.null(avg_dim)) - # exp: [memb_exp, dat_exp, avg_dim, lat, lon] - # obs: [memb_obs, dat_obs, avg_dim, lat, lon] + # exp: [memb_exp, (dat_exp), avg_dim, lat, lon] + # obs: [memb_obs, (dat_obs), avg_dim, lat, lon] + + if (is.null(dat_dim)) { + nexp <- 1 + nobs <- 1 + dim(exp) <- c(dim(exp)[1], dat = 1, dim(exp)[-1]) + dim(obs) <- c(dim(obs)[1], dat = 1, dim(obs)[-1]) + } else { + nexp <- as.numeric(dim(exp)[dat_dim]) + nobs <- as.numeric(dim(obs)[dat_dim]) + } - nexp <- as.numeric(dim(exp)[2]) - nobs <- as.numeric(dim(obs)[2]) nmembexp <- as.numeric(dim(exp)[1]) nmembobs <- as.numeric(dim(obs)[1]) @@ -631,7 +639,7 @@ ACC <- function(exp, obs, dat_dim = 'dataset', lat_dim = 'lat', lon_dim = 'lon', #calculate the ACC of the randomized field tmpACC <- .ACC(drawexp, drawobs, conf = FALSE, pval = FALSE, sign = FALSE, - avg_dim = avg_dim, lat = lat) + avg_dim = avg_dim, lat = lat, dat_dim = dat_dim) if (is.null(avg_dim)) { acc_draw[, , jdraw] <- tmpACC$acc } else { diff --git a/R/Corr.R b/R/Corr.R index 76a1af4..d00f755 100644 --- a/R/Corr.R +++ b/R/Corr.R @@ -23,8 +23,7 @@ #'@param time_dim A character string indicating the name of dimension along #' which the correlations are computed. The default value is 'sdate'. #'@param dat_dim A character string indicating the name of dataset (nobs/nexp) -#' dimension. The default value is 'dataset'. If there is no dataset -#' dimension, set NULL. +#' dimension. The default value is NULL (no dataset). #'@param comp_dim A character string indicating the name of dimension along which #' obs is taken into account only if it is complete. The default value #' is NULL. @@ -90,20 +89,21 @@ #'leadtimes_per_startdate <- 60 #'corr <- Corr(MeanDims(smooth_ano_exp, 'member'), #' MeanDims(smooth_ano_obs, 'member'), -#' comp_dim = 'ftime', +#' comp_dim = 'ftime', dat_dim = 'dataset', #' limits = c(ceiling((runmean_months + 1) / 2), #' leadtimes_per_startdate - floor(runmean_months / 2))) #' #'# Case 2: Keep member dimension -#'corr <- Corr(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member') +#'corr <- Corr(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member', dat_dim = 'dataset') #'# ensemble mean -#'corr <- Corr(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member', memb = FALSE) +#'corr <- Corr(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member', memb = FALSE, +#' dat_dim = 'dataset') #' #'@import multiApply #'@importFrom ClimProjDiags Subset #'@importFrom stats cor pt qnorm #'@export -Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', +Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, comp_dim = NULL, limits = NULL, method = 'pearson', memb_dim = NULL, memb = TRUE, pval = TRUE, conf = TRUE, sign = FALSE, @@ -275,7 +275,7 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', return(res) } -.Corr <- function(exp, obs, dat_dim = 'dataset', memb_dim = 'member', +.Corr <- function(exp, obs, dat_dim = NULL, memb_dim = 'member', time_dim = 'sdate', method = 'pearson', conf = TRUE, pval = TRUE, sign = FALSE, alpha = 0.05) { if (is.null(memb_dim)) { diff --git a/R/GetProbs.R b/R/GetProbs.R index 6a4dcfe..59304b4 100644 --- a/R/GetProbs.R +++ b/R/GetProbs.R @@ -1,13 +1,14 @@ #'Compute probabilistic forecasts or the corresponding observations #' -#'Compute probabilistic forecasts from an ensemble based on the relative thresholds, -#'or the probabilistic observations (i.e., which probabilistic category was observed). -#'A reference period can be specified to calculate the absolute thresholds between -#'each probabilistic category. The absolute thresholds can be computed in cross-validation -#'mode. If data is an ensemble, the probabilities are calculated as the percentage of -#'members that fall into each category. For observations (or forecast without member -#'dimension), 1 means that the event happened, while 0 indicates that the event did -#'not happen. Weighted probabilities can be computed if the weights are provided for +#'Compute probabilistic forecasts from an ensemble based on the relative +#'thresholds, or the probabilistic observations (i.e., which probabilistic +#'category was observed). A reference period can be specified to calculate the +#'absolute thresholds between each probabilistic category. The absolute +#'thresholds can be computed in cross-validation mode. If data is an ensemble, +#'the probabilities are calculated as the percentage of members that fall into +#'each category. For observations (or forecast without member dimension), 1 +#'means that the event happened, while 0 indicates that the event did not +#'happen. Weighted probabilities can be computed if the weights are provided for #'each ensemble member and time step. #' #'@param data A named numerical array of the forecasts or observations with, at @@ -18,21 +19,20 @@ #' to compute the probabilities of the forecast, or NULL if there is no member #' dimension (e.g., for observations, or for forecast with only one ensemble #' member). The default value is 'member'. -#'@param dat_dim A character string indicating the name of dataset dimension. -#' The default value is NULL, which means no dataset dimension. #'@param prob_thresholds A numeric vector of the relative thresholds (from 0 to #' 1) between the categories. The default value is c(1/3, 2/3), which #' corresponds to tercile equiprobable categories. -#'@param indices_for_quantiles A vector of the indices to be taken along 'time_dim' -#' for computing the absolute thresholds between the probabilistic categories. -#' If NULL, the whole period is used. The default value is NULL. +#'@param indices_for_quantiles A vector of the indices to be taken along +#' 'time_dim' for computing the absolute thresholds between the probabilistic +#' categories. If NULL, the whole period is used. The default value is NULL. #'@param weights A named numerical array of the weights for 'data' with -#' dimensions 'time_dim' and 'memb_dim' (if 'data' has them). 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 cross.val A logical indicating whether to compute the thresholds between -#' probabilistic categories in cross-validation mode. The default value is FALSE. +#' dimensions 'time_dim' and 'memb_dim' (if 'data' has them). 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 cross.val A logical indicating whether to compute the thresholds +#' between probabilistic categories in cross-validation mode. The default value +#' is FALSE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -43,7 +43,8 @@ #' #'@examples #'data <- array(rnorm(2000), dim = c(ensemble = 25, sdate = 20, time = 4)) -#'res <- GetProbs(data = data, time_dim = 'sdate', memb_dim = 'ensemble', indices_for_quantiles = 4:17) +#'res <- GetProbs(data = data, time_dim = 'sdate', memb_dim = 'ensemble', +#' indices_for_quantiles = 4:17) #' #'@import multiApply #'@importFrom easyVerification convert2prob diff --git a/R/Plot2VarsVsLTime.R b/R/Plot2VarsVsLTime.R index 1c784dd..12e04ae 100644 --- a/R/Plot2VarsVsLTime.R +++ b/R/Plot2VarsVsLTime.R @@ -63,15 +63,17 @@ #'leadtimes_per_startdate <- 60 #'rms <- RMS(MeanDims(smooth_ano_exp, dim_to_mean), #' MeanDims(smooth_ano_obs, dim_to_mean), -#' comp_dim = required_complete_row, +#' comp_dim = required_complete_row, dat_dim = 'dataset', #' limits = c(ceiling((runmean_months + 1) / 2), -#' leadtimes_per_startdate - floor(runmean_months / 2))) +#' leadtimes_per_startdate - floor(runmean_months / 2))) #'smooth_ano_exp_m_sub <- smooth_ano_exp - InsertDim(MeanDims(smooth_ano_exp, 'member', #' na.rm = TRUE), #' posdim = 3, #' lendim = dim(smooth_ano_exp)['member'], #' name = 'member') +#'suppressWarnings({ #'spread <- Spread(smooth_ano_exp_m_sub, compute_dim = c('member', 'sdate')) +#'}) #'#Combine rms outputs into one array #'rms_combine <- abind::abind(rms$conf.lower, rms$rms, rms$conf.upper, along = 0) #'rms_combine <- Reorder(rms_combine, c(2, 3, 1, 4)) diff --git a/R/PlotACC.R b/R/PlotACC.R index a674ff6..6ea5182 100644 --- a/R/PlotACC.R +++ b/R/PlotACC.R @@ -65,8 +65,9 @@ #'ano_exp <- Ano(sampleData$mod, clim$clim_exp) #'ano_obs <- Ano(sampleData$obs, clim$clim_obs) -#'acc <- ACC(ano_exp, ano_obs, lat = sampleData$lat) -#'acc_bootstrap <- ACC(ano_exp, ano_obs, lat = sampleData$lat, conftype = 'bootstrap') +#'acc <- ACC(ano_exp, ano_obs, lat = sampleData$lat, dat_dim = 'dataset') +#'acc_bootstrap <- ACC(ano_exp, ano_obs, lat = sampleData$lat, conftype = 'bootstrap', +#' dat_dim = 'dataset') #'# Combine acc results for PlotACC #'res <- array(c(acc$conf.lower, acc$acc, acc$conf.upper, acc$p.val), #' dim = c(dim(acc$acc), 4)) @@ -86,7 +87,8 @@ PlotACC <- function(ACC, sdates, toptitle = "", sizetit = 1, ytitle = "", width = 8, height = 5, size_units = 'in', res = 100, ...) { # Process the user graphical parameters that may be passed in the call ## Graphical parameters to exclude - excludedArgs <- c("cex", "cex.axis", "cex.lab", "cex.main", "col", "lab", "las", "lty", "lwd", "mai", "mgp", "new", "pch", "pin", "ps", "pty") + excludedArgs <- c("cex", "cex.axis", "cex.lab", "cex.main", "col", "lab", "las", "lty", + "lwd", "mai", "mgp", "new", "pch", "pin", "ps", "pty") userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) # If there is any filenames to store the graphics, process them diff --git a/R/PlotVsLTime.R b/R/PlotVsLTime.R index 94c82e0..c51e31b 100644 --- a/R/PlotVsLTime.R +++ b/R/PlotVsLTime.R @@ -79,11 +79,12 @@ #'leadtimes_per_startdate <- 60 #'corr <- Corr(MeanDims(smooth_ano_exp, dim_to_mean), #' MeanDims(smooth_ano_obs, dim_to_mean), -#' comp_dim = required_complete_row, +#' comp_dim = required_complete_row, dat_dim = 'dataset', #' limits = c(ceiling((runmean_months + 1) / 2), #' leadtimes_per_startdate - floor(runmean_months / 2))) #'# Combine corr results for plotting -#'corr_combine <- abind::abind(corr$conf.lower, corr$corr, corr$conf.upper, corr$p.val, along = 0) +#'corr_combine <- abind::abind(corr$conf.lower, corr$corr, corr$conf.upper, corr$p.val, +#' along = 0) #'corr_combine <- Reorder(corr_combine, c(2, 3, 1, 4)) #'\donttest{ #'PlotVsLTime(corr_combine, toptitle = "correlations", ytitle = "correlation", diff --git a/R/RMS.R b/R/RMS.R index 3f4ae1f..7664d97 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -71,7 +71,7 @@ #' set.seed(2) #' na <- floor(runif(10, min = 1, max = 80)) #' obs1[na] <- NA -#' res <- RMS(exp1, obs1, comp_dim = 'ftime', dat_time = 'dat') +#' res <- RMS(exp1, obs1, comp_dim = 'ftime', dat_dim = 'dat') #' # Renew example when Ano and Smoothing are ready #' #'@import multiApply diff --git a/R/RatioSDRMS.R b/R/RatioSDRMS.R index d527625..2fe259c 100644 --- a/R/RatioSDRMS.R +++ b/R/RatioSDRMS.R @@ -3,7 +3,7 @@ #'Compute the ratio between the standard deviation of the members around the #'ensemble mean in experimental data and the RMSE between the ensemble mean of #'experimental and observational data. The p-value is provided by a one-sided -#'Fischer test. +#'Fisher's test. #' #'@param exp A named numeric array of experimental data with at least two #' dimensions 'memb_dim' and 'time_dim'. @@ -11,8 +11,7 @@ #' dimensions 'memb_dim' and 'time_dim'. It should have the same dimensions as #' parameter 'exp' except along 'dat_dim' and 'memb_dim'. #'@param dat_dim A character string indicating the name of dataset (nobs/nexp) -#' dimension. If there is no dataset dimension, set as NULL. The default value -#' is 'dataset'. +#' dimension. The default value is NULL (no dataset). #'@param memb_dim A character string indicating the name of the member #' dimension. It must be one dimension in 'exp' and 'obs'. The default value #' is 'member'. @@ -26,20 +25,19 @@ #'@return A list of two arrays with dimensions c(nexp, nobs, the rest of #' dimensions of 'exp' and 'obs' except memb_dim and time_dim), which nexp is #' the length of dat_dim of 'exp' and nobs is the length of dat_dim of 'obs'. -#' (only present if \code{pval = TRUE}) of the one-sided Fisher test with -#'Ho: SD/RMSE = 1.\cr\cr +#' If dat_dim is NULL, nexp and nobs are omitted. \cr #'\item{$ratio}{ #' The ratio of the ensemble spread and RMSE. #'} #'\item{$p_val}{ -#' The p-value of the one-sided Fisher test with Ho: SD/RMSE = 1. Only present +#' The p-value of the one-sided Fisher's test with Ho: SD/RMSE = 1. Only present #' if \code{pval = TRUE}. #'} #' #'@examples #'# Load sample data as in Load() example: #'example(Load) -#'rsdrms <- RatioSDRMS(sampleData$mod, sampleData$obs) +#'rsdrms <- RatioSDRMS(sampleData$mod, sampleData$obs, dat_dim = 'dataset') #'# Reorder the data in order to plot it with PlotVsLTime #'rsdrms_plot <- array(dim = c(dim(rsdrms$ratio)[1:2], 4, dim(rsdrms$ratio)[3])) #'rsdrms_plot[, , 2, ] <- rsdrms$ratio @@ -52,7 +50,7 @@ #' #'@import multiApply #'@export -RatioSDRMS <- function(exp, obs, dat_dim = 'dataset', memb_dim = 'member', +RatioSDRMS <- function(exp, obs, dat_dim = NULL, memb_dim = 'member', time_dim = 'sdate', pval = TRUE, ncores = NULL) { # Check inputs diff --git a/R/Spread.R b/R/Spread.R index 09bbe05..5fba8ca 100644 --- a/R/Spread.R +++ b/R/Spread.R @@ -52,7 +52,9 @@ #' posdim = 3, #' lendim = dim(smooth_ano_exp)['member'], #' name = 'member') +#'suppressWarnings({ #'spread <- Spread(smooth_ano_exp_m_sub, compute_dim = c('member', 'sdate')) +#'}) #' #'\dontrun{ #'PlotVsLTime(Reorder(spread$iqr, c('dataset', 'stats', 'ftime')), diff --git a/R/UltimateBrier.R b/R/UltimateBrier.R index d2c4ac9..44498a3 100644 --- a/R/UltimateBrier.R +++ b/R/UltimateBrier.R @@ -12,7 +12,7 @@ #' 'memb_dim', the length must be 1. The dimensions should be consistent with #' 'exp' except 'dat_dim' and 'memb_dim'. It can be provided by \code{Ano()}. #'@param dat_dim A character string indicating the name of the dataset -#' dimension in 'exp' and 'obs'. The default value is 'dataset'. If there is no dataset +#' dimension in 'exp' and 'obs'. The default value is NULL (no dataset). #' dimension, set NULL. #'@param memb_dim A character string indicating the name of the member #' dimension in 'exp' (and 'obs') for ensemble mean calculation. The default @@ -81,12 +81,12 @@ #'clim <- Clim(sampleData$mod, sampleData$obs) #'exp <- Ano(sampleData$mod, clim$clim_exp) #'obs <- Ano(sampleData$obs, clim$clim_obs) -#'bs <- UltimateBrier(exp, obs) -#'bss <- UltimateBrier(exp, obs, type = 'BSS') +#'bs <- UltimateBrier(exp, obs, dat_dim = 'dataset') +#'bss <- UltimateBrier(exp, obs, type = 'BSS', dat_dim = 'dataset') #' #'@import SpecsVerification plyr multiApply #'@export -UltimateBrier <- function(exp, obs, dat_dim = 'dataset', memb_dim = 'member', time_dim = 'sdate', +UltimateBrier <- function(exp, obs, dat_dim = NULL, memb_dim = 'member', time_dim = 'sdate', quantile = TRUE, thr = c(5/100, 95/100), type = 'BS', decomposition = TRUE, ncores = NULL) { @@ -223,7 +223,7 @@ UltimateBrier <- function(exp, obs, dat_dim = 'dataset', memb_dim = 'member', ti return(res) } -.UltimateBrier <- function(exp, obs, dat_dim = 'dataset', memb_dim = 'member', thr = c(5/100, 95/100), +.UltimateBrier <- function(exp, obs, dat_dim = NULL, memb_dim = 'member', thr = c(5/100, 95/100), type = 'BS', decomposition = TRUE) { # If exp and obs are probablistics # exp: [sdate, nexp] diff --git a/man/ACC.Rd b/man/ACC.Rd index 522843a..840f01f 100644 --- a/man/ACC.Rd +++ b/man/ACC.Rd @@ -7,7 +7,7 @@ ACC( exp, obs, - dat_dim = "dataset", + dat_dim = NULL, lat_dim = "lat", lon_dim = "lon", space_dim = c("lat", "lon"), @@ -33,8 +33,7 @@ The dimension should be the same as 'exp' except the length of 'dat_dim' and 'memb_dim'.} \item{dat_dim}{A character string indicating the name of dataset (nobs/nexp) -dimension. The default value is 'dataset'. If there is no dataset -dimension, set NULL.} +dimension. The default value is NULL (no dataset).} \item{lat_dim}{A character string indicating the name of the latitude dimension of 'exp' and 'obs' along which ACC is computed. The default value @@ -161,8 +160,9 @@ sampleData$obs <- Season(sampleData$obs, monini = 11, moninf = 12, monsup = 2) clim <- Clim(sampleData$mod, sampleData$obs) ano_exp <- Ano(sampleData$mod, clim$clim_exp) ano_obs <- Ano(sampleData$obs, clim$clim_obs) -acc <- ACC(ano_exp, ano_obs, lat = sampleData$lat) -acc_bootstrap <- ACC(ano_exp, ano_obs, conftype = 'bootstrap', lat = sampleData$lat) +acc <- ACC(ano_exp, ano_obs, lat = sampleData$lat, dat_dim = 'dataset') +acc_bootstrap <- ACC(ano_exp, ano_obs, conftype = 'bootstrap', + lat = sampleData$lat, dat_dim = 'dataset') # Combine acc results for PlotACC res <- array(c(acc$conf.lower, acc$acc, acc$conf.upper, acc$p.val), dim = c(dim(acc$acc), 4)) diff --git a/man/Corr.Rd b/man/Corr.Rd index 10bdf71..9fc2d31 100644 --- a/man/Corr.Rd +++ b/man/Corr.Rd @@ -8,7 +8,7 @@ Corr( exp, obs, time_dim = "sdate", - dat_dim = "dataset", + dat_dim = NULL, comp_dim = NULL, limits = NULL, method = "pearson", @@ -32,8 +32,7 @@ parameter 'exp' except along 'dat_dim' and 'memb_dim'.} which the correlations are computed. The default value is 'sdate'.} \item{dat_dim}{A character string indicating the name of dataset (nobs/nexp) -dimension. The default value is 'dataset'. If there is no dataset -dimension, set NULL.} +dimension. The default value is NULL (no dataset).} \item{comp_dim}{A character string indicating the name of dimension along which obs is taken into account only if it is complete. The default value @@ -126,13 +125,14 @@ required_complete_row <- 3 # Discard start dates which contain any NA lead-time leadtimes_per_startdate <- 60 corr <- Corr(MeanDims(smooth_ano_exp, 'member'), MeanDims(smooth_ano_obs, 'member'), - comp_dim = 'ftime', + comp_dim = 'ftime', dat_dim = 'dataset', limits = c(ceiling((runmean_months + 1) / 2), leadtimes_per_startdate - floor(runmean_months / 2))) # Case 2: Keep member dimension -corr <- Corr(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member') +corr <- Corr(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member', dat_dim = 'dataset') # ensemble mean -corr <- Corr(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member', memb = FALSE) +corr <- Corr(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member', memb = FALSE, + dat_dim = 'dataset') } diff --git a/man/GetProbs.Rd b/man/GetProbs.Rd index 27fe68c..fd84d2f 100644 --- a/man/GetProbs.Rd +++ b/man/GetProbs.Rd @@ -27,28 +27,26 @@ to compute the probabilities of the forecast, or NULL if there is no member dimension (e.g., for observations, or for forecast with only one ensemble member). The default value is 'member'.} -\item{indices_for_quantiles}{A vector of the indices to be taken along 'time_dim' -for computing the absolute thresholds between the probabilistic categories. -If NULL, the whole period is used. The default value is NULL.} +\item{indices_for_quantiles}{A vector of the indices to be taken along +'time_dim' for computing the absolute thresholds between the probabilistic +categories. If NULL, the whole period is used. The default value is NULL.} \item{prob_thresholds}{A numeric vector of the relative thresholds (from 0 to 1) between the categories. The default value is c(1/3, 2/3), which corresponds to tercile equiprobable categories.} \item{weights}{A named numerical array of the weights for 'data' with -dimensions 'time_dim' and 'memb_dim' (if 'data' has them). 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.} +dimensions 'time_dim' and 'memb_dim' (if 'data' has them). 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{cross.val}{A logical indicating whether to compute the thresholds between -probabilistic categories in cross-validation mode. The default value is FALSE.} +\item{cross.val}{A logical indicating whether to compute the thresholds +between probabilistic categories in cross-validation mode. The default value +is FALSE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} - -\item{dat_dim}{A character string indicating the name of dataset dimension. -The default value is NULL, which means no dataset dimension.} } \value{ A numerical array of probabilities with dimensions c(bin, the rest dimensions @@ -56,18 +54,20 @@ of 'data' except 'memb_dim'). 'bin' dimension has the length of probabilistic categories, i.e., \code{length(prob_thresholds) + 1}. } \description{ -Compute probabilistic forecasts from an ensemble based on the relative thresholds, -or the probabilistic observations (i.e., which probabilistic category was observed). -A reference period can be specified to calculate the absolute thresholds between -each probabilistic category. The absolute thresholds can be computed in cross-validation -mode. If data is an ensemble, the probabilities are calculated as the percentage of -members that fall into each category. For observations (or forecast without member -dimension), 1 means that the event happened, while 0 indicates that the event did -not happen. Weighted probabilities can be computed if the weights are provided for +Compute probabilistic forecasts from an ensemble based on the relative +thresholds, or the probabilistic observations (i.e., which probabilistic +category was observed). A reference period can be specified to calculate the +absolute thresholds between each probabilistic category. The absolute +thresholds can be computed in cross-validation mode. If data is an ensemble, +the probabilities are calculated as the percentage of members that fall into +each category. For observations (or forecast without member dimension), 1 +means that the event happened, while 0 indicates that the event did not +happen. Weighted probabilities can be computed if the weights are provided for each ensemble member and time step. } \examples{ data <- array(rnorm(2000), dim = c(ensemble = 25, sdate = 20, time = 4)) -res <- GetProbs(data = data, time_dim = 'sdate', memb_dim = 'ensemble', indices_for_quantiles = 4:17) +res <- GetProbs(data = data, time_dim = 'sdate', memb_dim = 'ensemble', + indices_for_quantiles = 4:17) } diff --git a/man/Plot2VarsVsLTime.Rd b/man/Plot2VarsVsLTime.Rd index 46b9cd5..9eeb928 100644 --- a/man/Plot2VarsVsLTime.Rd +++ b/man/Plot2VarsVsLTime.Rd @@ -115,15 +115,17 @@ required_complete_row <- 'ftime' # discard startdates for which there are NA le leadtimes_per_startdate <- 60 rms <- RMS(MeanDims(smooth_ano_exp, dim_to_mean), MeanDims(smooth_ano_obs, dim_to_mean), - comp_dim = required_complete_row, + comp_dim = required_complete_row, dat_dim = 'dataset', limits = c(ceiling((runmean_months + 1) / 2), - leadtimes_per_startdate - floor(runmean_months / 2))) + leadtimes_per_startdate - floor(runmean_months / 2))) smooth_ano_exp_m_sub <- smooth_ano_exp - InsertDim(MeanDims(smooth_ano_exp, 'member', na.rm = TRUE), posdim = 3, lendim = dim(smooth_ano_exp)['member'], name = 'member') +suppressWarnings({ spread <- Spread(smooth_ano_exp_m_sub, compute_dim = c('member', 'sdate')) +}) #Combine rms outputs into one array rms_combine <- abind::abind(rms$conf.lower, rms$rms, rms$conf.upper, along = 0) rms_combine <- Reorder(rms_combine, c(2, 3, 1, 4)) diff --git a/man/PlotACC.Rd b/man/PlotACC.Rd index 2764de3..9a32f8b 100644 --- a/man/PlotACC.Rd +++ b/man/PlotACC.Rd @@ -110,8 +110,9 @@ sampleData$obs <- Season(sampleData$obs, monini = 11, moninf = 12, monsup = 2) clim <- Clim(sampleData$mod, sampleData$obs) ano_exp <- Ano(sampleData$mod, clim$clim_exp) ano_obs <- Ano(sampleData$obs, clim$clim_obs) -acc <- ACC(ano_exp, ano_obs, lat = sampleData$lat) -acc_bootstrap <- ACC(ano_exp, ano_obs, lat = sampleData$lat, conftype = 'bootstrap') +acc <- ACC(ano_exp, ano_obs, lat = sampleData$lat, dat_dim = 'dataset') +acc_bootstrap <- ACC(ano_exp, ano_obs, lat = sampleData$lat, conftype = 'bootstrap', + dat_dim = 'dataset') # Combine acc results for PlotACC res <- array(c(acc$conf.lower, acc$acc, acc$conf.upper, acc$p.val), dim = c(dim(acc$acc), 4)) diff --git a/man/PlotVsLTime.Rd b/man/PlotVsLTime.Rd index 05e2b42..21cfe53 100644 --- a/man/PlotVsLTime.Rd +++ b/man/PlotVsLTime.Rd @@ -129,11 +129,12 @@ required_complete_row <- 'ftime' # discard startdates for which there are NA le leadtimes_per_startdate <- 60 corr <- Corr(MeanDims(smooth_ano_exp, dim_to_mean), MeanDims(smooth_ano_obs, dim_to_mean), - comp_dim = required_complete_row, + comp_dim = required_complete_row, dat_dim = 'dataset', limits = c(ceiling((runmean_months + 1) / 2), leadtimes_per_startdate - floor(runmean_months / 2))) # Combine corr results for plotting -corr_combine <- abind::abind(corr$conf.lower, corr$corr, corr$conf.upper, corr$p.val, along = 0) +corr_combine <- abind::abind(corr$conf.lower, corr$corr, corr$conf.upper, corr$p.val, + along = 0) corr_combine <- Reorder(corr_combine, c(2, 3, 1, 4)) \donttest{ PlotVsLTime(corr_combine, toptitle = "correlations", ytitle = "correlation", diff --git a/man/RMS.Rd b/man/RMS.Rd index f5e46f6..241fbd5 100644 --- a/man/RMS.Rd +++ b/man/RMS.Rd @@ -101,7 +101,7 @@ The confidence interval is computed by the chi2 distribution.\cr set.seed(2) na <- floor(runif(10, min = 1, max = 80)) obs1[na] <- NA - res <- RMS(exp1, obs1, comp_dim = 'ftime', dat_time = 'dat') + res <- RMS(exp1, obs1, comp_dim = 'ftime', dat_dim = 'dat') # Renew example when Ano and Smoothing are ready } diff --git a/man/RatioSDRMS.Rd b/man/RatioSDRMS.Rd index f1f6f3d..07afc46 100644 --- a/man/RatioSDRMS.Rd +++ b/man/RatioSDRMS.Rd @@ -7,7 +7,7 @@ RatioSDRMS( exp, obs, - dat_dim = "dataset", + dat_dim = NULL, memb_dim = "member", time_dim = "sdate", pval = TRUE, @@ -23,8 +23,7 @@ dimensions 'memb_dim' and 'time_dim'. It should have the same dimensions as parameter 'exp' except along 'dat_dim' and 'memb_dim'.} \item{dat_dim}{A character string indicating the name of dataset (nobs/nexp) -dimension. If there is no dataset dimension, set as NULL. The default value -is 'dataset'.} +dimension. The default value is NULL (no dataset).} \item{memb_dim}{A character string indicating the name of the member dimension. It must be one dimension in 'exp' and 'obs'. The default value @@ -43,13 +42,12 @@ computation. The default value is NULL.} A list of two arrays with dimensions c(nexp, nobs, the rest of dimensions of 'exp' and 'obs' except memb_dim and time_dim), which nexp is the length of dat_dim of 'exp' and nobs is the length of dat_dim of 'obs'. -(only present if \code{pval = TRUE}) of the one-sided Fisher test with -Ho: SD/RMSE = 1.\cr\cr + If dat_dim is NULL, nexp and nobs are omitted. \cr \item{$ratio}{ The ratio of the ensemble spread and RMSE. } \item{$p_val}{ - The p-value of the one-sided Fisher test with Ho: SD/RMSE = 1. Only present + The p-value of the one-sided Fisher's test with Ho: SD/RMSE = 1. Only present if \code{pval = TRUE}. } } @@ -57,12 +55,12 @@ Ho: SD/RMSE = 1.\cr\cr Compute the ratio between the standard deviation of the members around the ensemble mean in experimental data and the RMSE between the ensemble mean of experimental and observational data. The p-value is provided by a one-sided -Fischer test. +Fisher's test. } \examples{ # Load sample data as in Load() example: example(Load) -rsdrms <- RatioSDRMS(sampleData$mod, sampleData$obs) +rsdrms <- RatioSDRMS(sampleData$mod, sampleData$obs, dat_dim = 'dataset') # Reorder the data in order to plot it with PlotVsLTime rsdrms_plot <- array(dim = c(dim(rsdrms$ratio)[1:2], 4, dim(rsdrms$ratio)[3])) rsdrms_plot[, , 2, ] <- rsdrms$ratio diff --git a/man/Spread.Rd b/man/Spread.Rd index c5fc4d1..d3f93bb 100644 --- a/man/Spread.Rd +++ b/man/Spread.Rd @@ -72,7 +72,9 @@ smooth_ano_exp_m_sub <- smooth_ano_exp - InsertDim(MeanDims(smooth_ano_exp, 'mem posdim = 3, lendim = dim(smooth_ano_exp)['member'], name = 'member') +suppressWarnings({ spread <- Spread(smooth_ano_exp_m_sub, compute_dim = c('member', 'sdate')) +}) \dontrun{ PlotVsLTime(Reorder(spread$iqr, c('dataset', 'stats', 'ftime')), diff --git a/man/UltimateBrier.Rd b/man/UltimateBrier.Rd index 0dfa772..a20412e 100644 --- a/man/UltimateBrier.Rd +++ b/man/UltimateBrier.Rd @@ -7,7 +7,7 @@ UltimateBrier( exp, obs, - dat_dim = "dataset", + dat_dim = NULL, memb_dim = "member", time_dim = "sdate", quantile = TRUE, @@ -28,7 +28,7 @@ dimensions that at least include 'time_dim'. If it has 'exp' except 'dat_dim' and 'memb_dim'. It can be provided by \code{Ano()}.} \item{dat_dim}{A character string indicating the name of the dataset -dimension in 'exp' and 'obs'. The default value is 'dataset'. If there is no dataset +dimension in 'exp' and 'obs'. The default value is NULL (no dataset). dimension, set NULL.} \item{memb_dim}{A character string indicating the name of the member @@ -109,7 +109,7 @@ sampleData$obs <- Season(sampleData$obs, monini = 11, moninf = 12, monsup = 2) clim <- Clim(sampleData$mod, sampleData$obs) exp <- Ano(sampleData$mod, clim$clim_exp) obs <- Ano(sampleData$obs, clim$clim_obs) -bs <- UltimateBrier(exp, obs) -bss <- UltimateBrier(exp, obs, type = 'BSS') +bs <- UltimateBrier(exp, obs, dat_dim = 'dataset') +bss <- UltimateBrier(exp, obs, type = 'BSS', dat_dim = 'dataset') } diff --git a/tests/testthat/test-ACC.R b/tests/testthat/test-ACC.R index 9753922..ab5f8be 100644 --- a/tests/testthat/test-ACC.R +++ b/tests/testthat/test-ACC.R @@ -5,11 +5,11 @@ context("s2dv::ACC tests") # dat1 set.seed(1) - exp1 <- array(rnorm(60), dim = c(dataset = 1, member = 2, sdate = 5, + exp1 <- array(rnorm(60), dim = c(member = 2, sdate = 5, ftime = 1, lat = 2, lon = 3)) set.seed(2) - obs1 <- array(rnorm(30), dim = c(dataset = 1, member = 1, sdate = 5, + obs1 <- array(rnorm(30), dim = c(member = 1, sdate = 5, ftime = 1, lat = 2, lon = 3)) lat1 <- c(30, 35) lon1 <- c(0, 5, 10) @@ -162,7 +162,7 @@ test_that("2. Output checks: dat1", { expect_equal( dim(ACC(exp1, obs1, lat = lat1, lon = lon1)$acc), - c(nexp = 1, nobs = 1, sdate = 5, ftime = 1) + c(sdate = 5, ftime = 1) ) expect_equal( names(ACC(exp1, obs1, lat = lat1)), @@ -194,7 +194,7 @@ test_that("2. Output checks: dat1", { ) expect_equal( dim(ACC(exp1, obs1, lat = lat1, dat_dim = 'member', memb_dim = NULL)$acc), - c(nexp = 2, nobs = 1, sdate = 5, dataset = 1, ftime = 1) + c(nexp = 2, nobs = 1, sdate = 5, ftime = 1) ) expect_equal( names(ACC(exp1, obs1, lat = lat1, conf = FALSE)), @@ -227,16 +227,16 @@ test_that("2. Output checks: dat1", { test_that("3. Output checks: dat2", { expect_equal( - dim(ACC(exp2, obs2, lat = lat2, lon = lon2, memb_dim = NULL)$acc), + dim(ACC(exp2, obs2, lat = lat2, lon = lon2, memb_dim = NULL, dat_dim = 'dataset')$acc), c(nexp = 2, nobs = 1, sdate = 5, ftime = 1) ) expect_equal( - as.vector(ACC(exp2, obs2, lat = lat2, memb_dim = NULL)$acc)[3:7], + as.vector(ACC(exp2, obs2, lat = lat2, memb_dim = NULL, dat_dim = 'dataset')$acc)[3:7], c(-0.3601880, -0.5624773, -0.4603762, -0.6997169, -0.1336961), tolerance = 0.00001 ) expect_equal( - mean(ACC(exp2, obs2, lat = lat2, memb_dim = NULL)$acc), + mean(ACC(exp2, obs2, lat = lat2, memb_dim = NULL, dat_dim = 'dataset')$acc), -0.1484762, tolerance = 0.00001 ) diff --git a/tests/testthat/test-Corr.R b/tests/testthat/test-Corr.R index ef013ca..f4172be 100644 --- a/tests/testthat/test-Corr.R +++ b/tests/testthat/test-Corr.R @@ -47,12 +47,10 @@ context("s2dv::Corr tests") # dat5: exp and obs have memb_dim and dataset = NULL set.seed(1) - exp5 <- array(rnorm(90), dim = c(member = 3, sdate = 5, - lat = 2, lon = 3)) + exp5 <- array(rnorm(90), dim = c(member = 3, sdate = 5, lat = 2, lon = 3)) set.seed(2) - obs5 <- array(rnorm(30), dim = c(member = 1, sdate = 5, - lat = 2, lon = 3)) + obs5 <- array(rnorm(30), dim = c(member = 1, sdate = 5, lat = 2, lon = 3)) # dat6: exp and obs have memb_dim = NULL and dataset = NULL set.seed(1) @@ -164,7 +162,7 @@ test_that("1. Input checks", { ) expect_error( Corr(exp = array(1:10, dim = c(sdate = 2, dataset = 5, a = 1)), - obs = array(1:4, dim = c(a = 1, sdate = 2, dataset = 2))), + obs = array(1:4, dim = c(a = 1, sdate = 2, dataset = 2)), dat_dim = 'dataset'), "The length of time_dim must be at least 3 to compute correlation." ) @@ -174,76 +172,76 @@ test_that("1. Input checks", { test_that("2. Output checks: dat1", { suppressWarnings( expect_equal( - dim(Corr(exp1, obs1)$corr), + dim(Corr(exp1, obs1, dat_dim = 'dataset')$corr), c(nexp = 2, nobs = 1, member = 1, ftime = 3, lat = 2, lon = 4) ) ) suppressWarnings( expect_equal( - Corr(exp1, obs1)$corr[1:6], + Corr(exp1, obs1, dat_dim = 'dataset')$corr[1:6], c(0.11503859, -0.46959987, -0.64113021, 0.09776572, -0.32393603, 0.27565829), tolerance = 0.001 ) ) suppressWarnings( expect_equal( - length(which(is.na(Corr(exp1, obs1)$p.val))), + length(which(is.na(Corr(exp1, obs1, dat_dim = 'dataset')$p.val))), 2 ) ) suppressWarnings( expect_equal( - max(Corr(exp1, obs1)$conf.lower, na.rm = T), + max(Corr(exp1, obs1, dat_dim = 'dataset')$conf.lower, na.rm = T), 0.6332941, tolerance = 0.001 ) ) suppressWarnings( expect_equal( - length(which(is.na(Corr(exp1, obs1, comp_dim = 'ftime')$corr))), + length(which(is.na(Corr(exp1, obs1, dat_dim = 'dataset', comp_dim = 'ftime')$corr))), 6 ) ) suppressWarnings( expect_equal( - length(which(is.na(Corr(exp1, obs1, comp_dim = 'ftime', limits = c(2, 3))$corr))), + length(which(is.na(Corr(exp1, obs1, dat_dim = 'dataset', comp_dim = 'ftime', limits = c(2, 3))$corr))), 2 ) ) suppressWarnings( expect_equal( - min(Corr(exp1, obs1, alpha = 0.01)$conf.upper, na.rm = TRUE), + min(Corr(exp1, obs1, alpha = 0.01, dat_dim = 'dataset')$conf.upper, na.rm = TRUE), 0.2747904, tolerance = 0.0001 ) ) suppressWarnings( expect_equal( - length(Corr(exp1, obs1, conf = FALSE, pval = FALSE)), + length(Corr(exp1, obs1, conf = FALSE, pval = FALSE, dat_dim = 'dataset')), 1 ) ) suppressWarnings( expect_equal( - length(Corr(exp1, obs1, conf = FALSE)), + length(Corr(exp1, obs1, conf = FALSE, dat_dim = 'dataset')), 2 ) ) suppressWarnings( expect_equal( - length(Corr(exp1, obs1, pval = FALSE)), + length(Corr(exp1, obs1, pval = FALSE, dat_dim = 'dataset')), 3 ) ) suppressWarnings( expect_equal( - Corr(exp1, obs1, method = 'spearman')$corr[1:6], + Corr(exp1, obs1, method = 'spearman', dat_dim = 'dataset')$corr[1:6], c(-0.3, -0.4, -0.6, 0.3, -0.3, 0.2) ) ) suppressWarnings( expect_equal( - range(Corr(exp1, obs1, method = 'spearman', comp_dim = 'ftime')$p.val, na.rm = T), + range(Corr(exp1, obs1, method = 'spearman', comp_dim = 'ftime', dat_dim = 'dataset')$p.val, na.rm = T), c(0.0, 0.5), tolerance = 0.001 ) @@ -255,113 +253,113 @@ suppressWarnings( test_that("3. Output checks: dat2", { # individual member expect_equal( - dim(Corr(exp2, obs2, memb_dim = 'member')$corr), + dim(Corr(exp2, obs2, memb_dim = 'member', dat_dim = 'dataset')$corr), c(nexp = 2, nobs = 1, exp_memb = 3, obs_memb = 1, lat = 2, lon = 3) ) expect_equal( - dim(Corr(exp2, obs2, memb_dim = 'member')$corr), - dim(Corr(exp2, obs2, memb_dim = 'member')$p) + dim(Corr(exp2, obs2, memb_dim = 'member', dat_dim = 'dataset')$corr), + dim(Corr(exp2, obs2, memb_dim = 'member', dat_dim = 'dataset')$p) ) expect_equal( - names(Corr(exp2, obs2, memb_dim = 'member')), + names(Corr(exp2, obs2, memb_dim = 'member', dat_dim = 'dataset')), c("corr", "p.val", "conf.lower", "conf.upper") ) expect_equal( - names(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)), + names(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE, dat_dim = 'dataset')), c("corr") ) expect_equal( - names(Corr(exp2, obs2, memb_dim = 'member', conf = FALSE)), + names(Corr(exp2, obs2, memb_dim = 'member', conf = FALSE, dat_dim = 'dataset')), c("corr", "p.val") ) expect_equal( - names(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE)), + names(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, dat_dim = 'dataset')), c("corr", "conf.lower", "conf.upper") ) expect_equal( - names(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, sign = T)), + names(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, sign = T, dat_dim = 'dataset')), c("corr", "conf.lower", "conf.upper", "sign") ) expect_equal( - mean(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + mean(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), 0.01645575, tolerance = 0.0001 ) expect_equal( - median(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + median(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), 0.03024513, tolerance = 0.0001 ) expect_equal( - max(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + max(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), 0.9327993, tolerance = 0.0001 ) expect_equal( - min(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + min(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), -0.9361258, tolerance = 0.0001 ) expect_equal( - Corr(exp2, obs2, memb_dim = 'member', conf = FALSE)$p.val[1:5], + Corr(exp2, obs2, memb_dim = 'member', conf = FALSE, dat_dim = 'dataset')$p.val[1:5], c(0.24150854, 0.21790352, 0.04149139, 0.49851332, 0.19859843), tolerance = 0.0001 ) expect_equal( - Corr(exp2, obs2, memb_dim = 'member', pval = FALSE)$conf.lower[1:5], + Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, dat_dim = 'dataset')$conf.lower[1:5], c(-0.9500121, -0.9547642, -0.9883400, -0.8817478, -0.6879465), tolerance = 0.0001 ) expect_equal( - which(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = F, sign = T)$sign), + which(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = F, sign = T, dat_dim = 'dataset')$sign), c(3, 6, 12, 17, 23, 34) ) # ensemble mean expect_equal( - dim(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE)$corr), + dim(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, dat_dim = 'dataset')$corr), c(nexp = 2, nobs = 1, lat = 2, lon = 3) ) expect_equal( - mean(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), + mean(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), 0.02939929, tolerance = 0.0001 ) expect_equal( - median(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), + median(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), 0.03147432, tolerance = 0.0001 ) expect_equal( - max(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), + max(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), 0.8048901, tolerance = 0.0001 ) expect_equal( - min(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), + min(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), -0.6839388, tolerance = 0.0001 ) expect_equal( - Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, conf = FALSE)$p.val[1:5], + Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, conf = FALSE, dat_dim = 'dataset')$p.val[1:5], c(0.1999518, 0.2776874, 0.3255444, 0.2839667, 0.1264518), tolerance = 0.0001 ) expect_equal( - Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE)$conf.lower[1:5], + Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, dat_dim = 'dataset')$conf.lower[1:5], c(-0.9582891, -0.7668065, -0.9316879, -0.9410621, -0.5659657), tolerance = 0.0001 ) # exp2_2 expect_equal( - which(is.na(Corr(exp2_2, obs2_2, memb_dim = 'member', memb = FALSE, pval = FALSE)$corr)), + which(is.na(Corr(exp2_2, obs2_2, memb_dim = 'member', memb = FALSE, pval = FALSE, dat_dim = 'dataset')$corr)), 1:2 ) expect_equal( - Corr(exp2_2, obs2_2, memb_dim = 'member', memb = FALSE, pval = FALSE)$corr[-c(1:2)], - Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE)$corr[-c(1:2)] + Corr(exp2_2, obs2_2, memb_dim = 'member', memb = FALSE, pval = FALSE, dat_dim = 'dataset')$corr[-c(1:2)], + Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, dat_dim = 'dataset')$corr[-c(1:2)] ) }) @@ -370,56 +368,56 @@ test_that("3. Output checks: dat2", { test_that("4. Output checks: dat3", { # individual member expect_equal( - dim(Corr(exp3, obs3, memb_dim = 'member')$corr), + dim(Corr(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')$corr), c(nexp = 2, nobs = 2, exp_memb = 3, obs_memb = 2, lat = 2, lon = 3) ) expect_equal( - names(Corr(exp3, obs3, memb_dim = 'member')), + names(Corr(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')), c("corr", "p.val", "conf.lower", "conf.upper") ) expect_equal( - mean(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + mean(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), 0.006468017, tolerance = 0.0001 ) expect_equal( - median(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + median(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), 0.03662394, tolerance = 0.0001 ) expect_equal( - max(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + max(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), 0.9798228, tolerance = 0.0001 ) expect_equal( - min(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + min(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), -0.9464891, tolerance = 0.0001 ) # ensemble mean expect_equal( - dim(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE)$corr), + dim(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, dat_dim = 'dataset')$corr), c(nexp = 2, nobs = 2, lat = 2, lon = 3) ) expect_equal( - mean(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), + mean(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), -0.01001896, tolerance = 0.0001 ) expect_equal( - median(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), + median(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), -0.01895816, tolerance = 0.0001 ) expect_equal( - max(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), + max(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), 0.798233, tolerance = 0.0001 ) expect_equal( - min(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), + min(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), -0.6464809, tolerance = 0.0001 ) @@ -429,17 +427,17 @@ test_that("4. Output checks: dat3", { test_that("5. Output checks: dat4", { # no member expect_equal( - dim(Corr(exp4, obs4)$corr), + dim(Corr(exp4, obs4, dat_dim = 'dataset')$corr), c(nexp = 1, nobs = 1, member = 1, lat = 2) ) # individual member expect_equal( - dim(Corr(exp4, obs4, memb_dim = 'member')$corr), + dim(Corr(exp4, obs4, memb_dim = 'member', dat_dim = 'dataset')$corr), c(nexp = 1, nobs = 1, exp_memb = 1, obs_memb = 1, lat = 2) ) # ensemble expect_equal( - dim(Corr(exp4, obs4, memb_dim = 'member', memb = FALSE)$corr), + dim(Corr(exp4, obs4, memb_dim = 'member', memb = FALSE, dat_dim = 'dataset')$corr), c(nexp = 1, nobs = 1, lat = 2) ) @@ -460,7 +458,7 @@ test_that("6. Output checks: dat5", { c("corr") ) expect_equal( - mean(Corr(exp5, obs5, dat_dim = NULL, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + mean(Corr(exp5, obs5, dat_dim = NULL, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr, dat_dim = 'dataset'), 0.1880204, tolerance = 0.0001 ) @@ -506,7 +504,7 @@ test_that("7. Output checks: dat6", { test_that("8. Output checks: dat6 and dat7", { expect_equal( mean(Corr(exp6, obs6, dat_dim = NULL, memb_dim = NULL, pval = FALSE, conf = FALSE)$corr), - mean(Corr(exp7, obs7, memb_dim = NULL, pval = FALSE, conf = FALSE)$corr), + mean(Corr(exp7, obs7, memb_dim = NULL, pval = FALSE, conf = FALSE, dat_dim = 'dataset')$corr), tolerance = 0.0001 ) }) diff --git a/tests/testthat/test-RatioSDRMS.R b/tests/testthat/test-RatioSDRMS.R index 5dbc171..3086c87 100644 --- a/tests/testthat/test-RatioSDRMS.R +++ b/tests/testthat/test-RatioSDRMS.R @@ -51,27 +51,27 @@ test_that("1. Input checks", { "Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension." ) expect_error( - RatioSDRMS(exp1, obs1, memb_dim = 1), + RatioSDRMS(exp1, obs1, memb_dim = 1, dat_dim = 'dataset'), "Parameter 'memb_dim' must be a character string." ) expect_error( - RatioSDRMS(exp1, obs1, memb_dim = 'a'), + RatioSDRMS(exp1, obs1, memb_dim = 'a', dat_dim = 'dataset'), "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." ) expect_error( - RatioSDRMS(exp1, obs1, time_dim = c('sdate', 'a')), + RatioSDRMS(exp1, obs1, time_dim = c('sdate', 'a'), dat_dim = 'dataset'), "Parameter 'time_dim' must be a character string." ) expect_error( - RatioSDRMS(exp1, obs1, time_dim = 'a'), + RatioSDRMS(exp1, obs1, time_dim = 'a', dat_dim = 'dataset'), "Parameter 'time_dim' is not found in 'exp' or 'obs' dimension." ) expect_error( - RatioSDRMS(exp1, obs1, pval = 1), + RatioSDRMS(exp1, obs1, pval = 1, dat_dim = 'dataset'), "Parameter 'pval' must be one logical value." ) expect_error( - RatioSDRMS(exp1, obs1, ncores = 1.5), + RatioSDRMS(exp1, obs1, ncores = 1.5, dat_dim = 'dataset'), "Parameter 'ncores' must be a positive integer." ) expect_error( @@ -85,34 +85,34 @@ test_that("1. Input checks", { ############################################## test_that("2. Output checks: dat1", { expect_equal( -names(RatioSDRMS(exp1, obs1)), +names(RatioSDRMS(exp1, obs1, dat_dim = 'dataset')), c('ratio', 'p.val') ) expect_equal( -dim(RatioSDRMS(exp1, obs1)$ratio), +dim(RatioSDRMS(exp1, obs1, dat_dim = 'dataset')$ratio), c(nexp = 2, nobs = 1, ftime = 2) ) expect_equal( -dim(RatioSDRMS(exp1, obs1)$p.val), +dim(RatioSDRMS(exp1, obs1, dat_dim = 'dataset')$p.val), c(nexp = 2, nobs = 1, ftime = 2) ) expect_equal( -as.vector(RatioSDRMS(exp1, obs1)$ratio), +as.vector(RatioSDRMS(exp1, obs1, dat_dim = 'dataset')$ratio), c(0.7198164, 0.6525068, 0.6218262, 0.6101527), tolerance = 0.0001 ) expect_equal( -as.vector(RatioSDRMS(exp1, obs1)$p.val), +as.vector(RatioSDRMS(exp1, obs1, dat_dim = 'dataset')$p.val), c(0.8464094, 0.8959219, 0.9155102, 0.9224119), tolerance = 0.0001 ) expect_equal( -names(RatioSDRMS(exp1, obs1, pval = F)), +names(RatioSDRMS(exp1, obs1, pval = F, dat_dim = 'dataset')), c('ratio') ) expect_equal( -as.vector(RatioSDRMS(exp1, obs1)$ratio), -as.vector(RatioSDRMS(exp1, obs1, pval = F)$ratio) +as.vector(RatioSDRMS(exp1, obs1, dat_dim = 'dataset')$ratio), +as.vector(RatioSDRMS(exp1, obs1, pval = F, dat_dim = 'dataset')$ratio) ) }) @@ -120,17 +120,17 @@ as.vector(RatioSDRMS(exp1, obs1, pval = F)$ratio) ############################################## test_that("3. Output checks: dat2", { expect_equal( -dim(RatioSDRMS(exp2, obs2)$ratio), +dim(RatioSDRMS(exp2, obs2, dat_dim = 'dataset')$ratio), c(nexp = 2, nobs = 1, ftime = 2) ) expect_equal( -as.vector(RatioSDRMS(exp2, obs2)$ratio), +as.vector(RatioSDRMS(exp2, obs2, dat_dim = 'dataset')$ratio), c(0.7635267, 0.6525068, 0.6218262, 0.6101527), tolerance = 0.0001 ) expect_equal( -as.vector(RatioSDRMS(exp1, obs1)$p.val), -c(0.8464094, 0.8959219, 0.9155102, 0.9224119), +as.vector(RatioSDRMS(exp2, obs2, dat_dim = 'dataset')$p.val), +c(0.7970868, 0.8959219, 0.9155102, 0.9224119), tolerance = 0.0001 ) diff --git a/tests/testthat/test-UltimateBrier.R b/tests/testthat/test-UltimateBrier.R index 09412f0..6ce8866 100644 --- a/tests/testthat/test-UltimateBrier.R +++ b/tests/testthat/test-UltimateBrier.R @@ -60,46 +60,46 @@ test_that("1. Input checks", { ) # exp and obs (2) expect_error( - UltimateBrier(exp1, array(1:10, dim = c(dataset = 1, sdate = 6, ftime = 2))), + UltimateBrier(exp1, array(1:10, dim = c(dataset = 1, sdate = 6, ftime = 2)), dat_dim = 'dataset'), paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", "of all the dimensions except 'dat_dim' and 'memb_dim'.") ) expect_error( - UltimateBrier(exp1, array(1:10, dim = c(dataset = 1, sdate = 5, time = 2))), + UltimateBrier(exp1, array(1:10, dim = c(dataset = 1, sdate = 5, time = 2)), dat_dim = 'dataset'), paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", "of all the dimensions except 'dat_dim' and 'memb_dim'.") ) # quantile expect_error( - UltimateBrier(exp1, obs1, quantile = c(0.05, 0.95)), + UltimateBrier(exp1, obs1, quantile = c(0.05, 0.95), dat_dim = 'dataset'), "Parameter 'quantile' must be one logical value." ) expect_error( - UltimateBrier(exp1, obs1, quantile = FALSE, thr = 1:3, type = 'FairEnsembleBS'), + UltimateBrier(exp1, obs1, quantile = FALSE, thr = 1:3, type = 'FairEnsembleBS', dat_dim = 'dataset'), "Parameter 'quantile' must be TRUE if 'type' is 'FairEnsembleBSS' or 'FairEnsembleBS'." ) # thr expect_error( - UltimateBrier(exp1, obs1, thr = TRUE), + UltimateBrier(exp1, obs1, thr = TRUE, dat_dim = 'dataset'), "Parameter 'thr' must be a numeric vector." ) expect_error( - UltimateBrier(exp1, obs1, quantile = TRUE, thr = 1:3), + UltimateBrier(exp1, obs1, quantile = TRUE, thr = 1:3, dat_dim = 'dataset'), "Parameter 'thr' must be between 0 and 1 when quantile is TRUE." ) # type expect_error( - UltimateBrier(exp1, obs1, type = 'UltimateBrier'), + UltimateBrier(exp1, obs1, type = 'UltimateBrier', dat_dim = 'dataset'), "Parameter 'type' must be one of 'BS', 'BSS', 'FairEnsembleBS', 'FairEnsembleBSS', 'FairStartDatesBS' or 'FairStartDatesBSS'." ) # decomposition expect_error( - UltimateBrier(exp1, obs1, decomposition = 1), + UltimateBrier(exp1, obs1, decomposition = 1, dat_dim = 'dataset'), "Parameter 'decomposition' must be one logical value." ) # ncores expect_error( - UltimateBrier(exp1, obs1, ncores = 0), + UltimateBrier(exp1, obs1, ncores = 0, dat_dim = 'dataset'), "Parameter 'ncores' must be a positive integer." ) @@ -111,130 +111,130 @@ test_that("2. Output checks: dat1", { # 'BS' expect_equal( - is.list(UltimateBrier(exp1, obs1)), + is.list(UltimateBrier(exp1, obs1, dat_dim = 'dataset')), TRUE ) expect_equal( - names(UltimateBrier(exp1, obs1)), + names(UltimateBrier(exp1, obs1, dat_dim = 'dataset')), c('bs', 'rel', 'res', 'unc') ) expect_equal( - is.list(UltimateBrier(exp1, obs1, decomposition = FALSE)), + is.list(UltimateBrier(exp1, obs1, decomposition = FALSE, dat_dim = 'dataset')), FALSE ) expect_equal( - dim(UltimateBrier(exp1, obs1, decomposition = FALSE)), + dim(UltimateBrier(exp1, obs1, decomposition = FALSE, dat_dim = 'dataset')), c(nexp = 1, nobs = 1, bin = 3, ftime = 2) ) expect_equal( - dim(UltimateBrier(exp1, obs1, decomposition = FALSE, thr = c(0.25, 0.5, 0.75))), + dim(UltimateBrier(exp1, obs1, dat_dim = 'dataset', decomposition = FALSE, thr = c(0.25, 0.5, 0.75))), c(nexp = 1, nobs = 1, bin = 4, ftime = 2) ) expect_equal( - UltimateBrier(exp1, obs1)$bs, - UltimateBrier(exp1, obs1, decomposition = FALSE) + UltimateBrier(exp1, obs1, dat_dim = 'dataset')$bs, + UltimateBrier(exp1, obs1, decomposition = FALSE, dat_dim = 'dataset') ) expect_equal( - as.vector(UltimateBrier(exp1, obs1)$bs), + as.vector(UltimateBrier(exp1, obs1, dat_dim = 'dataset')$bs), c(0.42222222, 0.44444444, 0.02222222, 0.48888889, 0.37777778, 0.02222222), tolerance = 0.0001 ) expect_equal( - as.vector(UltimateBrier(exp1, obs1)$rel), + as.vector(UltimateBrier(exp1, obs1, dat_dim = 'dataset')$rel), c(0.22222222, 0.31111111, 0.02222222, 0.28888889, 0.24444444, 0.02222222), tolerance = 0.0001 ) expect_equal( - as.vector(UltimateBrier(exp1, obs1)$res), + as.vector(UltimateBrier(exp1, obs1, dat_dim = 'dataset')$res), c(0.0400000, 0.1066667, 0.0000000, 0.0400000, 0.1066667, 0.0000000), tolerance = 0.0001 ) expect_equal( - as.vector(UltimateBrier(exp1, obs1)$unc), + as.vector(UltimateBrier(exp1, obs1, dat_dim = 'dataset')$unc), c(0.24, 0.24, 0.00, 0.24, 0.24, 0.00), tolerance = 0.0001 ) # 'BSS' expect_equal( - dim(UltimateBrier(exp1, obs1, type = 'BSS')), + dim(UltimateBrier(exp1, obs1, type = 'BSS', dat_dim = 'dataset')), c(nexp = 1, nobs = 1, bin = 3, ftime = 2) ) expect_equal( - as.vector(UltimateBrier(exp1, obs1, type = 'BSS')), + as.vector(UltimateBrier(exp1, obs1, type = 'BSS', dat_dim = 'dataset')), c(-0.7592593, -0.8518519, -Inf, -1.0370370, -0.5740741, -Inf), tolerance = 0.0001 ) # 'FairStartDatesBS' expect_equal( - is.list(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS')), + is.list(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS', dat_dim = 'dataset')), TRUE ) expect_equal( - names(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS')), + names(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS', dat_dim = 'dataset')), c('bs', 'rel', 'res', 'unc') ) expect_equal( - is.list(UltimateBrier(exp1, obs1, decomposition = FALSE, type = 'FairStartDatesBS')), + is.list(UltimateBrier(exp1, obs1, decomposition = FALSE, type = 'FairStartDatesBS', dat_dim = 'dataset')), FALSE ) expect_equal( - dim(UltimateBrier(exp1, obs1, decomposition = FALSE, type = 'FairStartDatesBS')), + dim(UltimateBrier(exp1, obs1, decomposition = FALSE, type = 'FairStartDatesBS', dat_dim = 'dataset')), c(nexp = 1, nobs = 1, bin = 3, ftime = 2) ) expect_equal( - UltimateBrier(exp1, obs1, type = 'FairStartDatesBS')$bs, - UltimateBrier(exp1, obs1, decomposition = FALSE, type = 'FairStartDatesBS') + UltimateBrier(exp1, obs1, type = 'FairStartDatesBS', dat_dim = 'dataset')$bs, + UltimateBrier(exp1, obs1, decomposition = FALSE, type = 'FairStartDatesBS', dat_dim = 'dataset') ) expect_equal( - as.vector(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS')$bs), + as.vector(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS', dat_dim = 'dataset')$bs), c(0.42222222, 0.44444444, 0.02222222, 0.48888889, 0.37777778, 0.02222222), tolerance = 0.0001 ) expect_equal( - as.vector(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS')$rel), + as.vector(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS', dat_dim = 'dataset')$rel), c(0.22222222, 0.31111111, 0.02222222, 0.28888889, 0.24444444, 0.02222222), tolerance = 0.0001 ) expect_equal( - as.vector(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS')$res), + as.vector(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS', dat_dim = 'dataset')$res), c(0.0400000, 0.1066667, 0.0000000, 0.0400000, 0.1066667, 0.0000000), tolerance = 0.0001 ) expect_equal( - as.vector(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS')$unc), + as.vector(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS', dat_dim = 'dataset')$unc), c(0.24, 0.24, 0.00, 0.24, 0.24, 0.00), tolerance = 0.0001 ) # 'FairStartDatesBSS' expect_equal( - dim(UltimateBrier(exp1, obs1, type = 'FairStartDatesBSS')), + dim(UltimateBrier(exp1, obs1, type = 'FairStartDatesBSS', dat_dim = 'dataset')), c(nexp = 1, nobs = 1, bin = 3, ftime = 2) ) expect_equal( - as.vector(UltimateBrier(exp1, obs1, type = 'FairStartDatesBSS')), + as.vector(UltimateBrier(exp1, obs1, type = 'FairStartDatesBSS', dat_dim = 'dataset')), c(-0.7592593, -0.8518519, -Inf, -1.0370370, -0.5740741, -Inf), tolerance = 0.0001 ) # 'FairEnsembleBS' expect_equal( - dim(UltimateBrier(exp1, obs1, type = 'FairEnsembleBS')), + dim(UltimateBrier(exp1, obs1, type = 'FairEnsembleBS', dat_dim = 'dataset')), c(nexp = 1, nobs = 1, bin = 3, ftime = 2) ) expect_equal( - as.vector(UltimateBrier(exp1, obs1, type = 'FairEnsembleBS')), + as.vector(UltimateBrier(exp1, obs1, type = 'FairEnsembleBS', dat_dim = 'dataset')), c(0.1333333, 0.2000000, 0.2000000, 0.1333333, 0.4000000, 0.2000000), tolerance = 0.0001 ) # 'FairEnsembleBSS' expect_equal( - dim(UltimateBrier(exp1, obs1, type = 'FairEnsembleBSS')), + dim(UltimateBrier(exp1, obs1, type = 'FairEnsembleBSS', dat_dim = 'dataset')), c(nexp = 1, nobs = 1, bin = 3, ftime = 2) ) expect_equal( - as.vector(UltimateBrier(exp1, obs1, type = 'FairEnsembleBSS')), + as.vector(UltimateBrier(exp1, obs1, type = 'FairEnsembleBSS', dat_dim = 'dataset')), c(-0.1111111, -0.6666667, -0.6666667, 0.2592593, -1.2222222, -0.6666667), tolerance = 0.0001 ) -- GitLab From 177eaf37826f4000b4a46385f72401f0a0691406 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 11 Apr 2023 14:04:02 +0200 Subject: [PATCH 20/64] Remove pval and sign in RMS() --- R/RMS.R | 74 +++++++++++++-------------------------- man/RMS.Rd | 15 -------- tests/testthat/test-RMS.R | 19 +++------- 3 files changed, 29 insertions(+), 79 deletions(-) diff --git a/R/RMS.R b/R/RMS.R index 7664d97..164167f 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -28,13 +28,8 @@ #' is NULL. #'@param limits A vector of two integers indicating the range along comp_dim to #' be completed. The default value is c(1, length(comp_dim dimension)). -#'@param pval A logical value indicating whether to return or not the p-value -#' of the test Ho: Corr = 0. The default value is TRUE. #'@param conf A logical value indicating whether to retrieve the confidence #' intervals or not. The default value is TRUE. -#'@param sign A logical value indicating whether to retrieve the statistical -#' significance of the test Ho: Corr = 0 based on 'alpha'. The default value is -#' FALSE. #'@param alpha A numeric indicating the significance level for the statistical #' significance test. The default value is 0.05. #'@param ncores An integer indicating the number of cores to use for parallel @@ -49,18 +44,12 @@ #'\item{$rms}{ #' The root mean square error. #'} -#'\item{$p.val}{ -#' The p-value. Only present if \code{pval = TRUE}. -#'} #'\item{$conf.lower}{ #' The lower confidence interval. Only present if \code{conf = TRUE}. #'} #'\item{$conf.upper}{ #' The upper confidence interval. Only present if \code{conf = TRUE}. #'} -#'\item{$sign}{ -#' The statistical significance. Only present if \code{sign = TRUE}. -#'} #' #'@examples #'# Load sample data as in Load() example: @@ -78,9 +67,8 @@ #'@importFrom ClimProjDiags Subset #'@importFrom stats qchisq #'@export -RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, - comp_dim = NULL, limits = NULL, pval = TRUE, conf = TRUE, - sign = FALSE, alpha = 0.05, ncores = NULL) { +RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, comp_dim = NULL, + limits = NULL, conf = TRUE, alpha = 0.05, ncores = NULL) { # Check inputs ## exp and obs (1) if (is.null(exp) | is.null(obs)) { @@ -148,18 +136,10 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, "integers smaller than the length of paramter 'comp_dim'.")) } } - ## pval - if (!is.logical(pval) | length(pval) > 1) { - stop("Parameter 'pval' must be one logical value.") - } ## conf if (!is.logical(conf) | length(conf) > 1) { stop("Parameter 'conf' must be one logical value.") } - ## sign - if (!is.logical(sign) | length(sign) > 1) { - stop("Parameter 'sign' must be one logical value.") - } ## alpha if (!is.numeric(alpha) | alpha < 0 | alpha > 1 | length(alpha) > 1) { stop("Parameter 'alpha' must be a numeric number between 0 and 1.") @@ -215,13 +195,12 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, c(time_dim, dat_dim)), fun = .RMS, time_dim = time_dim, dat_dim = dat_dim, - pval = pval, conf = conf, sign = sign, alpha = alpha, + conf = conf, alpha = alpha, ncores = ncores) return(res) } -.RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, - pval = TRUE, conf = TRUE, sign = FALSE, alpha = 0.05) { +.RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, conf = TRUE, alpha = 0.05) { if (is.null(dat_dim)) { # exp: [sdate] # obs: [sdate] @@ -253,7 +232,7 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, rms <- colMeans(dif^2, na.rm = TRUE)^0.5 #array(dim = c(nexp, nobs)) - if (conf | pval | sign) { + if (conf) { #NOTE: pval and sign also need #count effective sample along sdate. eno: c(nexp, nobs) # eno <- Eno(dif, time_dim) # slower than for loop below? eno <- array(dim = c(nexp = nexp, nobs = nobs)) @@ -262,29 +241,28 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, eno[n_exp, n_obs] <- .Eno(dif[, n_exp, n_obs], na.action = na.pass) } } - if (conf) { - # conf.lower - chi <- sapply(1:nobs, function(i) { - qchisq(confhigh, eno[, i] - 1) - }) - conf.lower <- (eno * rms ** 2 / chi) ** 0.5 + # conf.lower + chi <- sapply(1:nobs, function(i) { + qchisq(confhigh, eno[, i] - 1) + }) + conf.lower <- (eno * rms ** 2 / chi) ** 0.5 - # conf.upper - chi <- sapply(1:nobs, function(i) { - qchisq(conflow, eno[, i] - 1) - }) - conf.upper <- (eno * rms ** 2 / chi) ** 0.5 - } + # conf.upper + chi <- sapply(1:nobs, function(i) { + qchisq(conflow, eno[, i] - 1) + }) + conf.upper <- (eno * rms ** 2 / chi) ** 0.5 } - if (pval | sign) { - chi <- array(dim = c(nexp = nexp, nobs = nobs)) - for (i in 1:nobs) { - chi[, i] <- sapply(1:nexp, function(x) {sum((exp[, x] - obs[, i])^2 / exp[, x])}) - } - p_val <- pchisq(chi, eno - 1, lower.tail = FALSE) - if (sign) signif <- p_val <= alpha - } +#NOTE: Not sure if the calculation is correct. p_val is reasonable compared to the chi-square chart though. +# if (pval | sign) { +# chi <- array(dim = c(nexp = nexp, nobs = nobs)) +# for (i in 1:nobs) { +# chi[, i] <- sapply(1:nexp, function(x) {sum((obs[, i] - exp[, x])^2 / exp[, x])}) +# } +# p_val <- pchisq(chi, eno - 1, lower.tail = FALSE) +# if (sign) signif <- p_val <= alpha +# } ################################### # Remove nexp and nobs if dat_dim = NULL @@ -294,14 +272,10 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, dim(conf.lower) <- NULL dim(conf.upper) <- NULL } - if (pval) dim(p_val) <- NULL - if (sign) dim(signif) <- NULL } ################################### res <- list(rms = rms) - if (pval) res <- c(res, list(p.val = p_val)) - if (sign) res <- c(res, list(sign = signif)) if (conf) res <- c(res, list(conf.lower = conf.lower, conf.upper = conf.upper)) return(res) diff --git a/man/RMS.Rd b/man/RMS.Rd index 241fbd5..9d02d82 100644 --- a/man/RMS.Rd +++ b/man/RMS.Rd @@ -11,9 +11,7 @@ RMS( dat_dim = NULL, comp_dim = NULL, limits = NULL, - pval = TRUE, conf = TRUE, - sign = FALSE, alpha = 0.05, ncores = NULL ) @@ -43,16 +41,9 @@ is NULL.} \item{limits}{A vector of two integers indicating the range along comp_dim to be completed. The default value is c(1, length(comp_dim dimension)).} -\item{pval}{A logical value indicating whether to return or not the p-value -of the test Ho: Corr = 0. The default value is TRUE.} - \item{conf}{A logical value indicating whether to retrieve the confidence intervals or not. The default value is TRUE.} -\item{sign}{A logical value indicating whether to retrieve the statistical -significance of the test Ho: Corr = 0 based on 'alpha'. The default value is -FALSE.} - \item{alpha}{A numeric indicating the significance level for the statistical significance test. The default value is 0.05.} @@ -68,18 +59,12 @@ nobs are omitted.\cr \item{$rms}{ The root mean square error. } -\item{$p.val}{ - The p-value. Only present if \code{pval = TRUE}. -} \item{$conf.lower}{ The lower confidence interval. Only present if \code{conf = TRUE}. } \item{$conf.upper}{ The upper confidence interval. Only present if \code{conf = TRUE}. } -\item{$sign}{ - The statistical significance. Only present if \code{sign = TRUE}. -} } \description{ Compute the root mean square error for an array of forecasts and an array of diff --git a/tests/testthat/test-RMS.R b/tests/testthat/test-RMS.R index d45d59c..2a97466 100644 --- a/tests/testthat/test-RMS.R +++ b/tests/testthat/test-RMS.R @@ -176,7 +176,7 @@ suppressWarnings( suppressWarnings( expect_equal( length(RMS(exp1, obs1, dat_dim = 'dataset', conf = FALSE)), - 2 + 1 ) ) @@ -220,25 +220,16 @@ test_that("4. Output checks: dat3", { c(ftimes = 2, lon = 1, lat = 1) ) expect_equal( - length(RMS(exp3, obs3, dat_dim = NULL, sign = T, conf = F)), - 3 + length(RMS(exp3, obs3, dat_dim = NULL, conf = F)), + 1 ) expect_equal( - c(RMS(exp3, obs3, dat_dim = NULL, sign = T, conf = F)$sign[1,1,]), - c(FALSE, FALSE, TRUE, FALSE) - ) - expect_equal( - c(RMS(exp3, obs3, dat_dim = NULL, sign = T, conf = F)$p.val[1,1,]), - c(1, 0.8498872, 4.686846e-06, 1), - tolerance = 0.0001 - ) - expect_equal( - c(RMS(exp3, obs3, dat_dim = NULL, pval = F)$conf.lower[1,1,]), + c(RMS(exp3, obs3, dat_dim = NULL)$conf.lower[1,1,]), c(1.1024490, 0.5533838, 1.4531443, 0.3606632), tolerance = 0.0001 ) expect_equal( - c(RMS(exp3, obs3, dat_dim = NULL, pval = F)$conf.upper[1,1,]), + c(RMS(exp3, obs3, dat_dim = NULL)$conf.upper[1,1,]), c(5.287554, 2.654133, 6.969554, 1.729809), tolerance = 0.0001 ) -- GitLab From 70e76751692a8d54dddccb09a8b9f4dbd5ffd196 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 14 Apr 2023 17:09:10 +0200 Subject: [PATCH 21/64] exp and obs can be probabilities --- R/RPS.R | 155 ++++++++++++++++++++++++++------------ man/RPS.Rd | 45 +++++++---- tests/testthat/test-RPS.R | 14 ++++ 3 files changed, 152 insertions(+), 62 deletions(-) diff --git a/R/RPS.R b/R/RPS.R index 75619b6..31f12c6 100644 --- a/R/RPS.R +++ b/R/RPS.R @@ -9,21 +9,30 @@ #'categories. In the case of a forecast divided into two categories (the lowest #'number of categories that a probabilistic forecast can have), the RPS #'corresponds to the Brier Score (BS; Wilks, 2011), therefore, ranges between 0 -#'and 1. If there is more than one dataset, RPS will be computed for each pair -#'of exp and obs data. +#'and 1.\cr +#'The function first calculates the probabilities for forecast and observation, +#'then use them to calculate RPS. Or, the probabilities of exp and obs can be +#'provided directly to compute the score. If there is more than one dataset, RPS +#'will be computed for each pair of exp and obs data. #' -#'@param exp A named numerical array of the forecast with at least time and -#' member dimension. -#'@param obs A named numerical array of the observation with at least time -#' dimension. The dimensions must be the same as 'exp' except 'memb_dim' and -#' 'dat_dim'. +#'@param exp A named numerical array of either the forecast with at least time +#' and member dimensions, or the probability with at least time and category +#' dimensions. The probability can be generated by \code{s2dv::GetProbs}. +#'@param obs A named numerical array of either the observation with at least +#' time dimension, or the probability with at least time and category +#' dimensions. The probability can be generated by \code{s2dv::GetProbs}. The +#' dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'. #'@param time_dim A character string indicating the name of the time dimension. #' The default value is 'sdate'. +#'@param memb_dim A character string indicating the name of the member dimension +#' to compute the probabilities of the forecast. The default value is 'member'. +#' If the data are probabilistics, set memb_dim as NULL. +#'@param cat_dim A character string indicating the name of the category +#' dimension that is needed when the exp and obs are probabilities. The default +#' value is NULL, which means that the data are not probabilities. #'@param dat_dim A character string indicating the name of dataset dimension. #' The length of this dimension can be different between 'exp' and 'obs'. #' The default value is NULL. -#'@param memb_dim A character string indicating the name of the member dimension -#' to compute the probabilities of the forecast. The default value is 'member'. #'@param prob_thresholds A numeric vector of the relative thresholds (from 0 to #' 1) between the categories. The default value is c(1/3, 2/3), which #' corresponds to tercile equiprobable categories. @@ -33,12 +42,12 @@ #'@param Fair A logical indicating whether to compute the FairRPS (the #' potential RPS that the forecast would have with an infinite ensemble size). #' The default value is FALSE. -#'@param weights A named numerical array of the weights for 'exp'. If 'dat_dim' -#' is NULL, the dimension should include 'memb_dim' and 'time_dim'. Else, the -#' dimension should also include 'dat_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 A named numerical array of the weights for 'exp' probability +#' calculation. If 'dat_dim' is NULL, the dimensions should include 'memb_dim' +#' and 'time_dim'. Else, the dimension should also include 'dat_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 cross.val A logical indicating whether to compute the thresholds between #' probabilistic categories in cross-validation. #' The default value is FALSE. @@ -55,16 +64,22 @@ #'Wilks, 2011; https://doi.org/10.1016/B978-0-12-385022-5.00008-7 #' #'@examples +#'# Use synthetic data #'exp <- array(rnorm(1000), dim = c(lat = 3, lon = 2, member = 10, sdate = 50)) #'obs <- array(rnorm(1000), dim = c(lat = 3, lon = 2, sdate = 50)) #'res <- RPS(exp = exp, obs = obs) +#'# Use probabilities as inputs +#'exp_probs <- GetProbs(exp, time_dim = 'sdate', memb_dim = 'member') +#'obs_probs <- GetProbs(obs, time_dim = 'sdate', memb_dim = NULL) +#'res2 <- RPS(exp = exp_probs, obs = obs_probs, memb_dim = NULL, cat_dim = 'bin') +#' #' #'@import multiApply #'@importFrom easyVerification convert2prob #'@export -RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NULL, - prob_thresholds = c(1/3, 2/3), indices_for_clim = NULL, Fair = FALSE, - weights = NULL, cross.val = FALSE, ncores = NULL) { +RPS <- function(exp, obs, 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 = NULL, cross.val = FALSE, ncores = NULL) { # Check inputs ## exp and obs (1) @@ -82,12 +97,27 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NUL if (!time_dim %in% names(dim(exp)) | !time_dim %in% names(dim(obs))) { stop("Parameter 'time_dim' is not found in 'exp' or 'obs' dimension.") } + ## memb_dim & cat_dim + if (is.null(memb_dim) + is.null(cat_dim) != 1) { + stop("Only one of the two parameters 'memb_dim' and 'cat_dim' can have value.") + } ## memb_dim - if (!is.character(memb_dim) | length(memb_dim) > 1) { - stop("Parameter 'memb_dim' must be a character string.") + if (!is.null(memb_dim)) { + if (!is.character(memb_dim) | length(memb_dim) > 1) { + stop("Parameter 'memb_dim' must be a character string.") + } + if (!memb_dim %in% names(dim(exp))) { + stop("Parameter 'memb_dim' is not found in 'exp' dimension.") + } } - if (!memb_dim %in% names(dim(exp))) { - stop("Parameter 'memb_dim' is not found in 'exp' dimension.") + ## cat_dim + if (!is.null(cat_dim)) { + if (!is.character(cat_dim) | length(cat_dim) > 1) { + stop("Parameter 'cat_dim' must be a character string.") + } + if (!cat_dim %in% names(dim(exp)) | !cat_dim %in% names(dim(obs))) { + stop("Parameter 'cat_dim' is not found in 'exp' or 'obs' dimension.") + } } ## dat_dim if (!is.null(dat_dim)) { @@ -102,9 +132,11 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NUL ## exp and obs (2) name_exp <- sort(names(dim(exp))) name_obs <- sort(names(dim(obs))) - name_exp <- name_exp[-which(name_exp == memb_dim)] - if (memb_dim %in% name_obs) { - name_obs <- name_obs[-which(name_obs == memb_dim)] + if (!is.null(memb_dim)) { + name_exp <- name_exp[-which(name_exp == memb_dim)] + if (memb_dim %in% name_obs) { + name_obs <- name_obs[-which(name_obs == memb_dim)] + } } if (!is.null(dat_dim)) { name_exp <- name_exp[-which(name_exp == dat_dim)] @@ -141,7 +173,7 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NUL stop("Parameter 'cross.val' must be either TRUE or FALSE.") } ## weights - if (!is.null(weights)) { + if (!is.null(weights) & is.null(cat_dim)) { if (!is.array(weights) | !is.numeric(weights)) stop("Parameter 'weights' must be a named numeric array.") if (is.null(dat_dim)) { @@ -166,6 +198,10 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NUL weights <- Reorder(weights, c(time_dim, memb_dim, dat_dim)) } + } else if (!is.null(weights) & !is.null(cat_dim)) { + .warning(paste0("Parameter 'exp' and 'obs' are probabilities already, so parameter ", + "'weights' is not used. Change 'weights' to NULL.")) + weights <- NULL } ## ncores if (!is.null(ncores)) { @@ -178,17 +214,25 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NUL ############################### # Compute RPS - if (!memb_dim %in% names(dim(obs))) { - target_dims_obs <- c(time_dim, dat_dim) - } else { - target_dims_obs <- c(time_dim, memb_dim, dat_dim) + + ## Decide target_dims + if (!is.null(memb_dim)) { + target_dims_exp <- c(time_dim, memb_dim, dat_dim) + if (!memb_dim %in% names(dim(obs))) { + target_dims_obs <- c(time_dim, dat_dim) + } else { + target_dims_obs <- c(time_dim, memb_dim, dat_dim) + } + } else { # cat_dim + target_dims_exp <- target_dims_obs <- c(time_dim, cat_dim, dat_dim) } + rps <- Apply(data = list(exp = exp, obs = obs), - target_dims = list(exp = c(time_dim, memb_dim, dat_dim), + target_dims = list(exp = target_dims_exp, obs = target_dims_obs), fun = .RPS, dat_dim = dat_dim, time_dim = time_dim, - memb_dim = memb_dim, + memb_dim = memb_dim, cat_dim = cat_dim, prob_thresholds = prob_thresholds, indices_for_clim = indices_for_clim, Fair = Fair, weights = weights, cross.val = cross.val, ncores = ncores)$output1 @@ -200,16 +244,23 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NUL } -.RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NULL, - prob_thresholds = c(1/3, 2/3), indices_for_clim = NULL, Fair = FALSE, weights = NULL, - cross.val = FALSE) { - +.RPS <- function(exp, obs, 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 = NULL, cross.val = FALSE) { + #--- if memb_dim: # exp: [sdate, memb, (dat)] # obs: [sdate, (memb), (dat)] # weights: NULL or same as exp + #--- if cat_dim: + # exp: [sdate, bin, (dat)] + # obs: [sdate, bin, (dat)] # Adjust dimensions to be [sdate, memb, dat] for both exp and obs - if (!memb_dim %in% names(dim(obs))) obs <- InsertDim(obs, posdim = 2, lendim = 1, name = memb_dim) + if (!is.null(memb_dim)) { + if (!memb_dim %in% names(dim(obs))) { + obs <- InsertDim(obs, posdim = 2, lendim = 1, name = memb_dim) + } + } if (is.null(dat_dim)) { nexp <- 1 @@ -232,19 +283,27 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', dat_dim = NUL 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:2]) - if (!is.null(weights)) { - weights_data <- weights[ , , i] - if (is.null(dim(weights_data))) dim(weights_data) <- c(dim(weights)[1:2]) - } else { - weights_data <- weights + # If the data inputs are forecast/observation, calculate probabilities + if (is.null(cat_dim)) { + if (!is.null(weights)) { + weights_data <- weights[ , , i] + if (is.null(dim(weights_data))) dim(weights_data) <- c(dim(weights)[1:2]) + } else { + weights_data <- weights + } + + exp_probs <- .GetProbs(data = exp_data, indices_for_quantiles = indices_for_clim, + prob_thresholds = prob_thresholds, weights = weights_data, cross.val = cross.val) + # exp_probs: [bin, sdate] + obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, + prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) + # obs_probs: [bin, sdate] + + } else { # inputs are probabilities already + exp_probs <- t(exp_data) + obs_probs <- t(obs_data) } - exp_probs <- .GetProbs(data = exp_data, indices_for_quantiles = indices_for_clim, - prob_thresholds = prob_thresholds, weights = weights_data, cross.val = cross.val) - # exp_probs: [bin, sdate] - obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, - prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) - # obs_probs: [bin, sdate] probs_exp_cumsum <- apply(exp_probs, 2, cumsum) probs_obs_cumsum <- apply(obs_probs, 2, cumsum) diff --git a/man/RPS.Rd b/man/RPS.Rd index 813c12f..c08b109 100644 --- a/man/RPS.Rd +++ b/man/RPS.Rd @@ -9,6 +9,7 @@ RPS( obs, time_dim = "sdate", memb_dim = "member", + cat_dim = NULL, dat_dim = NULL, prob_thresholds = c(1/3, 2/3), indices_for_clim = NULL, @@ -19,18 +20,25 @@ RPS( ) } \arguments{ -\item{exp}{A named numerical array of the forecast with at least time and -member dimension.} +\item{exp}{A named numerical array of either the forecast with at least time +and member dimensions, or the probability with at least time and category +dimensions. The probability can be generated by \code{s2dv::GetProbs}.} -\item{obs}{A named numerical array of the observation with at least time -dimension. The dimensions must be the same as 'exp' except 'memb_dim' and -'dat_dim'.} +\item{obs}{A named numerical array of either the observation with at least +time dimension, or the probability with at least time and category +dimensions. The probability can be generated by \code{s2dv::GetProbs}. The +dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'.} \item{time_dim}{A character string indicating the name of the time dimension. The default value is 'sdate'.} \item{memb_dim}{A character string indicating the name of the member dimension -to compute the probabilities of the forecast. The default value is 'member'.} +to compute the probabilities of the forecast. The default value is 'member'. +If the data are probabilistics, set memb_dim as NULL.} + +\item{cat_dim}{A character string indicating the name of the category +dimension that is needed when the exp and obs are probabilities. The default +value is NULL, which means that the data are not probabilities.} \item{dat_dim}{A character string indicating the name of dataset dimension. The length of this dimension can be different between 'exp' and 'obs'. @@ -48,12 +56,12 @@ the whole period is used. The default value is NULL.} potential RPS that the forecast would have with an infinite ensemble size). The default value is FALSE.} -\item{weights}{A named numerical array of the weights for 'exp'. If 'dat_dim' -is NULL, the dimension should include 'memb_dim' and 'time_dim'. Else, the -dimension should also include 'dat_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}{A named numerical array of the weights for 'exp' probability +calculation. If 'dat_dim' is NULL, the dimensions should include 'memb_dim' +and 'time_dim'. Else, the dimension should also include 'dat_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{cross.val}{A logical indicating whether to compute the thresholds between probabilistic categories in cross-validation. @@ -78,13 +86,22 @@ of multi-categorical probabilistic forecasts. The RPS ranges between 0 categories. In the case of a forecast divided into two categories (the lowest number of categories that a probabilistic forecast can have), the RPS corresponds to the Brier Score (BS; Wilks, 2011), therefore, ranges between 0 -and 1. If there is more than one dataset, RPS will be computed for each pair -of exp and obs data. +and 1.\cr +The function first calculates the probabilities for forecast and observation, +then use them to calculate RPS. Or, the probabilities of exp and obs can be +provided directly to compute the score. If there is more than one dataset, RPS +will be computed for each pair of exp and obs data. } \examples{ +# Use synthetic data exp <- array(rnorm(1000), dim = c(lat = 3, lon = 2, member = 10, sdate = 50)) obs <- array(rnorm(1000), dim = c(lat = 3, lon = 2, sdate = 50)) res <- RPS(exp = exp, obs = obs) +# Use probabilities as inputs +exp_probs <- GetProbs(exp, time_dim = 'sdate', memb_dim = 'member') +obs_probs <- GetProbs(obs, time_dim = 'sdate', memb_dim = NULL) +res2 <- RPS(exp = exp_probs, obs = obs_probs, memb_dim = NULL, cat_dim = 'bin') + } \references{ diff --git a/tests/testthat/test-RPS.R b/tests/testthat/test-RPS.R index 51ba992..2040c09 100644 --- a/tests/testthat/test-RPS.R +++ b/tests/testthat/test-RPS.R @@ -10,6 +10,10 @@ obs1 <- array(rnorm(20), dim = c(sdate = 10, lat = 2)) set.seed(3) weights1 <- array(abs(rnorm(30)), dim = c(member = 3, sdate = 10)) +# dat1_2: probabilites +exp1_2 <- GetProbs(exp1, memb_dim = 'member') +obs1_2 <- GetProbs(obs1, memb_dim = NULL) + # dat2 set.seed(1) exp2 <- array(rnorm(20), dim = c(member = 2, sdate = 10)) @@ -60,6 +64,12 @@ test_that("1. Input checks", { RPS(exp1, obs1, memb_dim = 'memb'), "Parameter 'memb_dim' is not found in 'exp' dimension." ) + # cat_dim + expect_error( + RPS(exp1_2, obs1_2, memb_dim = NULL), + "Only one of the two parameters 'memb_dim' and 'cat_dim' can have value." + ) + # exp, ref, and obs (2) expect_error( RPS(exp1, array(1:9, dim = c(sdate = 9))), @@ -160,6 +170,10 @@ test_that("2. Output checks: dat1", { c(0.3559286, 0.6032109), tolerance = 0.0001 ) + expect_equal( + as.vector(RPS(exp1, obs1)), + as.vector(RPS(exp1_2, obs1_2, memb_dim = NULL, cat_dim = 'bin')) + ) }) -- GitLab From 5001e4cef933a5d4f587a7a8724072d0aee94822 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 17 Apr 2023 15:18:39 +0200 Subject: [PATCH 22/64] Allow inputs to be probabilities --- R/RPSS.R | 208 +++++++++++++++++++++++-------------- man/RPSS.Rd | 58 ++++++----- tests/testthat/test-RPSS.R | 15 +++ 3 files changed, 178 insertions(+), 103 deletions(-) diff --git a/R/RPSS.R b/R/RPSS.R index ab433e9..7a18afe 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -11,26 +11,36 @@ #'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). If there is more than one dataset, RPS will be computed for each pair +#'2016).\cr +#'The function accepts either the data 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. #' -#'@param exp A named numerical array of the forecast with at least time and -#' member dimension. -#'@param obs A named numerical array of the observation with at least time -#' dimension. The dimensions must be the same as 'exp' except 'memb_dim' and -#' 'dat_dim'. -#'@param ref A named numerical array of the reference forecast data with at -#' least time and member dimension. The dimensions must be the same as 'exp' -#' except 'memb_dim' and 'dat_dim'. If there is only one reference dataset, -#' it should not have dataset dimension. If there is corresponding reference -#' for each experiement, the dataset dimension must have the same length as in -#' 'exp'. If 'ref' is NULL, the climatological forecast is used as reference -#' forecast. The default value is NULL. +#'@param exp A named numerical array of either the forecast with at least time +#' and member dimensions, or the probability with at least time and category +#' dimensions. The probability can be generated by \code{s2dv::GetProbs}. +#'@param obs A named numerical array of either the observation with at least +#' time dimension, or the probability with at least time and category +#' dimensions. The probability can be generated by \code{s2dv::GetProbs}. The +#' dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'. +#'@param ref A named numerical array of either the reference forecast with at +#' least time and member dimensions, or the probability with at least time and +#' category dimensions. The probability can be generated by +#' \code{s2dv::GetProbs}. The dimensions must be the same as 'exp' except +#' 'memb_dim' and 'dat_dim'. If there is only one reference dataset, it should +#' not have dataset dimension. If there is corresponding reference for each +#' experiement, the dataset dimension must have the same length as in 'exp'. If +#' 'ref' is NULL, the climatological forecast is used as reference forecast. +#' The default value is NULL. #'@param time_dim A character string indicating the name of the time dimension. #' The default value is 'sdate'. #'@param memb_dim A character string indicating the name of the member dimension #' to compute the probabilities of the forecast and the reference forecast. The -#' default value is 'member'. +#' default value is 'member'. If the data are probabilistics, set memb_dim as +#' NULL. +#'@param cat_dim A character string indicating the name of the category +#' dimension that is needed when the exp and obs are probabilities. The default +#' value is NULL, which means that the data are not probabilities. #'@param dat_dim A character string indicating the name of dataset dimension. #' The length of this dimension can be different between 'exp' and 'obs'. #' The default value is NULL. @@ -43,15 +53,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 Deprecated and will be removed in the next release. Please use -#' 'weights_exp' and 'weights_ref' instead. -#'@param weights_exp A named numerical array of the forecast ensemble weights. -#' The dimension should include 'memb_dim', 'time_dim' and 'dat_dim' if there -#' are multiple datasets. All dimension lengths must be equal to 'exp' -#' dimension lengths. The default value is NULL, which means no weighting is -#' applied. 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 numerical array of the forecast ensemble weights +#' for probability calculation. The dimension should include 'memb_dim', +#' 'time_dim' and 'dat_dim' if there are multiple datasets. All dimension +#' lengths must be equal to 'exp' dimension lengths. The default value is NULL, +#' which means no weighting is applied. 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 forecast. #'@param cross.val A logical indicating whether to compute the thresholds between #' probabilistics categories in cross-validation. @@ -92,9 +100,9 @@ #'res <- RPSS(exp = exp, obs = obs, ref = ref, weights_exp = weights, weights_ref = weights) #'@import multiApply #'@export -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 = NULL, weights_exp = NULL, weights_ref = NULL, + Fair = FALSE, weights_exp = NULL, weights_ref = NULL, cross.val = FALSE, ncores = NULL) { # Check inputs @@ -126,15 +134,31 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', if (!is.null(ref) & !time_dim %in% names(dim(ref))) { stop("Parameter 'time_dim' is not found in 'ref' dimension.") } - ## memb_dim - if (!is.character(memb_dim) | length(memb_dim) > 1) { - stop("Parameter 'memb_dim' must be a character string.") + ## memb_dim & cat_dim + if (is.null(memb_dim) + is.null(cat_dim) != 1) { + stop("Only one of the two parameters 'memb_dim' and 'cat_dim' can have value.") } - if (!memb_dim %in% names(dim(exp))) { - stop("Parameter 'memb_dim' is not found in 'exp' dimension.") + ## memb_dim + if (!is.null(memb_dim)) { + if (!is.character(memb_dim) | length(memb_dim) > 1) { + stop("Parameter 'memb_dim' must be a character string.") + } + if (!memb_dim %in% names(dim(exp))) { + stop("Parameter 'memb_dim' is not found in 'exp' dimension.") + } + if (!is.null(ref) & !memb_dim %in% names(dim(ref))) { + stop("Parameter 'memb_dim' is not found in 'ref' dimension.") + } } - if (!is.null(ref) & !memb_dim %in% names(dim(ref))) { - stop("Parameter 'memb_dim' is not found in 'ref' dimension.") + ## cat_dim + if (!is.null(cat_dim)) { + if (!is.character(cat_dim) | length(cat_dim) > 1) { + stop("Parameter 'cat_dim' must be a character string.") + } + if (!cat_dim %in% names(dim(exp)) | !cat_dim %in% names(dim(obs)) | + !cat_dim %in% names(dim(obs))) { + stop("Parameter 'cat_dim' is not found in 'exp', 'obs', or 'ref' dimension.") + } } ## dat_dim if (!is.null(dat_dim)) { @@ -149,9 +173,11 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', ## exp, obs, and ref (2) name_exp <- sort(names(dim(exp))) name_obs <- sort(names(dim(obs))) - name_exp <- name_exp[-which(name_exp == memb_dim)] - if (memb_dim %in% name_obs) { - name_obs <- name_obs[-which(name_obs == memb_dim)] + if (!is.null(memb_dim)) { + name_exp <- name_exp[-which(name_exp == memb_dim)] + if (memb_dim %in% name_obs) { + name_obs <- name_obs[-which(name_obs == memb_dim)] + } } if (!is.null(dat_dim)) { name_exp <- name_exp[-which(name_exp == dat_dim)] @@ -164,7 +190,9 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', } if (!is.null(ref)) { name_ref <- sort(names(dim(ref))) - name_ref <- name_ref[-which(name_ref == memb_dim)] + if (!is.null(memb_dim)) { + name_ref <- name_ref[-which(name_ref == memb_dim)] + } if (!is.null(dat_dim)) { if (dat_dim %in% name_ref) { if (!identical(dim(exp)[dat_dim], dim(ref)[dat_dim])) { @@ -206,16 +234,8 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', if (!is.logical(cross.val) | length(cross.val) > 1) { stop("Parameter 'cross.val' 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."), tag = '! Deprecation: ') - 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.null(weights_exp) & is.null(cat_dim)) { if (!is.array(weights_exp) | !is.numeric(weights_exp)) stop("Parameter 'weights_exp' must be a named numeric array.") @@ -238,13 +258,16 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', "as 'memb_dim', 'time_dim' and 'dat_dim' in 'exp'.")) } weights_exp <- Reorder(weights_exp, c(time_dim, memb_dim, dat_dim)) - } - + } + } else if (!is.null(weights_exp) & !is.null(cat_dim)) { + .warning(paste0("Parameter 'exp' is probability already, so parameter ", + "'weights_exp' is not used. Change 'weights_exp' to NULL.")) + weights_exp <- NULL } ## weights_ref - if (!is.null(weights_ref)) { + if (!is.null(weights_ref) & is.null(cat_dim)) { if (!is.array(weights_ref) | !is.numeric(weights_ref)) - stop('Parameter "weights_ref" must be a named numeric array.') + stop("Parameter 'weights_ref' must be a named numeric array.") if (is.null(dat_dim) | ((!is.null(dat_dim)) && (!dat_dim %in% names(dim(ref))))) { if (length(dim(weights_ref)) != 2 | any(!names(dim(weights_ref)) %in% c(memb_dim, time_dim))) @@ -266,7 +289,10 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', } weights_ref <- Reorder(weights_ref, c(time_dim, memb_dim, dat_dim)) } - + } else if (!is.null(weights_ref) & !is.null(cat_dim)) { + .warning(paste0("Parameter 'ref' is probability already, so parameter ", + "'weights_ref' is not used. Change 'weights_ref' to NULL.")) + weights_ref <- NULL } ## ncores if (!is.null(ncores)) { @@ -279,32 +305,44 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', ############################### # Compute RPSS - if (!memb_dim %in% names(dim(obs))) { - target_dims_obs <- c(time_dim, dat_dim) - } else { - target_dims_obs <- c(time_dim, memb_dim, dat_dim) + + ## Decide target_dims + if (!is.null(memb_dim)) { + target_dims_exp <- c(time_dim, memb_dim, dat_dim) + if (!memb_dim %in% names(dim(obs))) { + target_dims_obs <- c(time_dim, dat_dim) + } else { + target_dims_obs <- c(time_dim, memb_dim, dat_dim) + } + } else { # cat_dim + target_dims_exp <- target_dims_obs <- c(time_dim, cat_dim, dat_dim) } if (!is.null(ref)) { # use "ref" as reference forecast - if (!is.null(dat_dim) && (dat_dim %in% names(dim(ref)))) { - target_dims_ref <- c(time_dim, memb_dim, dat_dim) - } else { + if (!is.null(memb_dim)) { + if (!is.null(dat_dim) && (dat_dim %in% names(dim(ref)))) { + target_dims_ref <- c(time_dim, memb_dim, dat_dim) + } else { target_dims_ref <- c(time_dim, memb_dim) + } + } else { + target_dims_ref <- c(time_dim, cat_dim, dat_dim) } data <- list(exp = exp, obs = obs, ref = ref) - target_dims = list(exp = c(time_dim, memb_dim, dat_dim), + target_dims = list(exp = target_dims_exp, obs = target_dims_obs, ref = target_dims_ref) } else { data <- list(exp = exp, obs = obs) - target_dims = list(exp = c(time_dim, memb_dim, dat_dim), + target_dims = list(exp = target_dims_exp, obs = target_dims_obs) } + output <- Apply(data, target_dims = target_dims, fun = .RPSS, time_dim = time_dim, memb_dim = memb_dim, - dat_dim = dat_dim, + cat_dim = cat_dim, dat_dim = dat_dim, prob_thresholds = prob_thresholds, indices_for_clim = indices_for_clim, Fair = Fair, weights_exp = weights_exp, @@ -316,13 +354,18 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', } -.RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', 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) { +.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) { + #--- if memb_dim: # exp: [sdate, memb, (dat)] # obs: [sdate, (memb), (dat)] # ref: [sdate, memb, (dat)] or NULL + #--- if cat_dim: + # exp: [sdate, bin, (dat)] + # obs: [sdate, bin, (dat)] + # ref: [sdate, bin, (dat)] or NULL if (is.null(dat_dim)) { nexp <- 1 @@ -333,14 +376,17 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', } # RPS of the forecast - rps_exp <- .RPS(exp = exp, obs = obs, time_dim = time_dim, memb_dim = memb_dim, dat_dim = dat_dim, - prob_thresholds = prob_thresholds, indices_for_clim = indices_for_clim, - Fair = Fair, weights = weights_exp, cross.val = cross.val) + rps_exp <- .RPS(exp = exp, obs = obs, time_dim = time_dim, memb_dim = memb_dim, + cat_dim = cat_dim, dat_dim = dat_dim, prob_thresholds = prob_thresholds, + indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_exp, + cross.val = cross.val) # RPS of the reference forecast if (is.null(ref)) { ## using climatology as reference forecast - if (!memb_dim %in% names(dim(obs))) { - obs <- InsertDim(obs, posdim = 2, lendim = 1, name = memb_dim) + if (!is.null(memb_dim)) { + if (!memb_dim %in% names(dim(obs))) { + obs <- InsertDim(obs, posdim = 2, lendim = 1, name = memb_dim) + } } if (is.null(dat_dim)) { dim(obs) <- c(dim(obs), nobs = nobs) @@ -348,14 +394,19 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', rps_ref <- array(dim = c(dim(obs)[time_dim], nobs = nobs)) for (j in 1:nobs) { - obs_data <- obs[ , , j] - if (is.null(dim(obs_data))) dim(obs_data) <- c(dim(obs)[1:2]) - # obs_probs: [bin, sdate] - obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, - prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) - # clim_probs: [bin, sdate] - clim_probs <- c(prob_thresholds[1], diff(prob_thresholds), 1 - prob_thresholds[length(prob_thresholds)]) + if (is.null(cat_dim)) { # calculate probs + obs_data <- obs[ , , j] + if (is.null(dim(obs_data))) dim(obs_data) <- c(dim(obs)[1:2]) + obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, + prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) + # obs_probs: [bin, sdate] + } else { + obs_probs <- t(obs[ , , j]) + } + clim_probs <- c(prob_thresholds[1], diff(prob_thresholds), + 1 - prob_thresholds[length(prob_thresholds)]) clim_probs <- array(clim_probs, dim = dim(obs_probs)) + # clim_probs: [bin, sdate] # Calculate RPS for each time step probs_clim_cumsum <- apply(clim_probs, 2, cumsum) @@ -386,9 +437,10 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', remove_dat_dim <- FALSE } - rps_ref <- .RPS(exp = ref, obs = obs, time_dim = time_dim, memb_dim = memb_dim, dat_dim = dat_dim, - prob_thresholds = prob_thresholds, indices_for_clim = indices_for_clim, - Fair = Fair, weights = weights_ref, cross.val = cross.val) + rps_ref <- .RPS(exp = ref, obs = obs, time_dim = time_dim, memb_dim = memb_dim, + cat_dim = cat_dim, dat_dim = dat_dim, prob_thresholds = prob_thresholds, + indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_ref, + cross.val = cross.val) if (!is.null(dat_dim)) { if (isTRUE(remove_dat_dim)) { dim(rps_ref) <- dim(rps_ref)[-2] diff --git a/man/RPSS.Rd b/man/RPSS.Rd index d70425e..a1e3e55 100644 --- a/man/RPSS.Rd +++ b/man/RPSS.Rd @@ -10,11 +10,11 @@ RPSS( 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 = NULL, weights_exp = NULL, weights_ref = NULL, cross.val = FALSE, @@ -22,27 +22,36 @@ RPSS( ) } \arguments{ -\item{exp}{A named numerical array of the forecast with at least time and -member dimension.} +\item{exp}{A named numerical array of either the forecast with at least time +and member dimensions, or the probability with at least time and category +dimensions. The probability can be generated by \code{s2dv::GetProbs}.} -\item{obs}{A named numerical array of the observation with at least time -dimension. The dimensions must be the same as 'exp' except 'memb_dim' and -'dat_dim'.} +\item{obs}{A named numerical array of either the observation with at least +time dimension, or the probability with at least time and category +dimensions. The probability can be generated by \code{s2dv::GetProbs}. The +dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'.} -\item{ref}{A named numerical array of the reference forecast data with at -least time and member dimension. The dimensions must be the same as 'exp' -except 'memb_dim' and 'dat_dim'. If there is only one reference dataset, -it should not have dataset dimension. If there is corresponding reference -for each experiement, the dataset dimension must have the same length as in -'exp'. If 'ref' is NULL, the climatological forecast is used as reference -forecast. The default value is NULL.} +\item{ref}{A named numerical array of either the reference forecast with at +least time and member dimensions, or the probability with at least time and +category dimensions. The probability can be generated by +\code{s2dv::GetProbs}. The dimensions must be the same as 'exp' except +'memb_dim' and 'dat_dim'. If there is only one reference dataset, it should +not have dataset dimension. If there is corresponding reference for each +experiement, the dataset dimension must have the same length as in 'exp'. If +'ref' is NULL, the climatological forecast is used as reference forecast. +The default value is NULL.} \item{time_dim}{A character string indicating the name of the time dimension. The default value is 'sdate'.} \item{memb_dim}{A character string indicating the name of the member dimension to compute the probabilities of the forecast and the reference forecast. The -default value is 'member'.} +default value is 'member'. If the data are probabilistics, set memb_dim as +NULL.} + +\item{cat_dim}{A character string indicating the name of the category +dimension that is needed when the exp and obs are probabilities. The default +value is NULL, which means that the data are not probabilities.} \item{dat_dim}{A character string indicating the name of dataset dimension. The length of this dimension can be different between 'exp' and 'obs'. @@ -60,16 +69,13 @@ 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}{Deprecated and will be removed in the next release. Please use -'weights_exp' and 'weights_ref' instead.} - -\item{weights_exp}{A named numerical array of the forecast ensemble weights. -The dimension should include 'memb_dim', 'time_dim' and 'dat_dim' if there -are multiple datasets. All dimension lengths must be equal to 'exp' -dimension lengths. The default value is NULL, which means no weighting is -applied. 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_exp}{A named numerical array of the forecast ensemble weights +for probability calculation. The dimension should include 'memb_dim', +'time_dim' and 'dat_dim' if there are multiple datasets. All dimension +lengths must be equal to 'exp' dimension lengths. The default value is NULL, +which means no weighting is applied. 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 forecast.} @@ -104,7 +110,9 @@ 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). If there is more than one dataset, RPS will be computed for each pair +2016).\cr +The function accepts either the data 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. } \examples{ diff --git a/tests/testthat/test-RPSS.R b/tests/testthat/test-RPSS.R index 36efee8..ce0deb3 100644 --- a/tests/testthat/test-RPSS.R +++ b/tests/testthat/test-RPSS.R @@ -12,6 +12,11 @@ ref1 <- array(rnorm(40), dim = c(member = 2, sdate = 10, lat = 2)) set.seed(4) weights1 <- array(abs(rnorm(30)), dim = c(member = 3, sdate = 10)) +# dat1_2 +exp1_2 <- GetProbs(exp1, memb_dim = 'member') +obs1_2 <- GetProbs(obs1, memb_dim = NULL) +ref1_2 <- GetProbs(ref1, memb_dim = 'member') + # dat2 set.seed(1) exp2 <- array(rnorm(20), dim = c(member = 2, sdate = 10)) @@ -255,6 +260,16 @@ test_that("2. Output checks: dat1", { tolerance = 0.0001 ) + # dat1_2 + expect_equal( + RPSS(exp1, obs1), + RPSS(exp1_2, obs1_2, memb_dim = NULL, cat_dim = 'bin') + ) + expect_equal( + RPSS(exp1, obs1, ref1), + RPSS(exp1_2, obs1_2, ref1_2, memb_dim = NULL, cat_dim = 'bin') + ) + }) -- GitLab From 7dd2d002955f8c681d4d19ce7b77d112720c30e7 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 17 Apr 2023 16:34:33 +0200 Subject: [PATCH 23/64] Allow input to be probabilities; correct document and sanity checks --- R/ROCSS.R | 189 ++++++++++++++++++++++++------------ R/RPSS.R | 13 ++- man/ROCSS.Rd | 58 +++++++---- man/RPSS.Rd | 11 ++- tests/testthat/test-ROCSS.R | 15 +++ 5 files changed, 201 insertions(+), 85 deletions(-) diff --git a/R/ROCSS.R b/R/ROCSS.R index 1e9f5e2..3ac67e6 100644 --- a/R/ROCSS.R +++ b/R/ROCSS.R @@ -6,24 +6,36 @@ #'curve can be summarized with the area under the ROC curve, known as the ROC #'score, to provide a skill value for each category. The ROCSS ranges between #'minus infinite and 1. A positive ROCSS value indicates that the forecast has -#'higher skill than the reference forecasts, meaning the contrary otherwise. -#'@param exp A named numerical array of the forecast with at least time and -#' member dimension. -#'@param obs A named numerical array of the observation with at least time -#' dimension. The dimensions must be the same as 'exp' except 'memb_dim' and -#' 'dat_dim'. -#'@param ref A named numerical array of the reference forecast data with at -#' least time and member dimension. The dimensions must be the same as 'exp' -#' except 'memb_dim' and 'dat_dim'. If there is only one reference dataset, -#' it should not have dataset dimension. If there is corresponding reference -#' for each experiement, the dataset dimension must have the same length as in -#' 'exp'. If 'ref' is NULL, the random forecast is used as reference forecast. -#' The default value is NULL. +#'higher skill than the reference forecasts, meaning the contrary otherwise.\cr +#'The function accepts either the data 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. +#' +#'@param exp A named numerical array of either the forecast with at least time +#' and member dimensions, or the probability with at least time and category +#' dimensions. The probability can be generated by \code{s2dv::GetProbs}. +#'@param obs A named numerical array of either the observation with at least +#' time dimension, or the probability with at least time and category +#' dimensions. The probability can be generated by \code{s2dv::GetProbs}. The +#' dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'. +#'@param ref A named numerical array of the reference forecast with at least +#' time and member dimensions, or the probability with at least time and +#' category dimensions. The probability can be generated by +#' \code{s2dv::GetProbs}. The dimensions must be the same as 'exp' except +#' 'memb_dim' and 'dat_dim'. If there is only one reference dataset, it should +#' not have dataset dimension. If there is corresponding reference for each +#' experiement, the dataset dimension must have the same length as in 'exp'. +#' If 'ref' is NULL, the random forecast is used as reference forecast. The +#' default value is NULL. #'@param time_dim A character string indicating the name of the time dimension. #' The default value is 'sdate'. #'@param memb_dim A character string indicating the name of the member dimension #' to compute the probabilities of the forecast and the reference forecast. The -#' default value is 'member'. +#' default value is 'member'. If the data are probabilistics, set memb_dim as +#' NULL. +#'@param cat_dim A character string indicating the name of the category +#' dimension that is needed when exp, obs, and ref are probabilities. The +#' default value is NULL, which means that the data are not probabilities. #'@param dat_dim A character string indicating the name of dataset dimension. #' The length of this dimension can be different between 'exp' and 'obs'. #' The default value is NULL. @@ -40,27 +52,34 @@ #' computation. The default value is NULL. #' #'@return -#'A numerical array of ROCSS with the same dimensions as 'exp' excluding -#''time_dim' and 'memb_dim' dimensions and including 'cat' dimension, which is -#'each category. The length if 'cat' dimension corresponds to the number of -#'probabilistic categories, i.e., 1 + length(prob_thresholds). If there are -#'multiple datasets, two additional dimensions 'nexp' and 'nobs' are added. +#'A numerical array of ROCSS with dimensions c(nexp, nobs, cat, the rest +#'dimensions of 'exp' except 'time_dim' and 'memb_dim' dimensions). nexp is the +#'number of experiment (i.e., dat_dim in exp), and nobs is the number of +#'observation (i.e., dat_dim in obs). If dat_dim is NULL, nexp and nobs are +#'omitted. dimension 'cat' refers to the probabilistic category, i.e., +#'\code{1 + length(prob_thresholds)}. #' #'@references #'Kharin, V. V. and Zwiers, F. W. (2003): #' https://doi.org/10.1175/1520-0442(2003)016%3C4145:OTRSOP%3E2.0.CO;2 #' #'@examples +#'# Use data as input #'exp <- array(rnorm(1000), dim = c(lon = 3, lat = 2, sdate = 60, member = 10)) #'ref <- array(rnorm(1000), dim = c(lon = 3, lat = 2, sdate = 60, member = 10)) #'obs <- array(rnorm(1000), dim = c(lon = 3, lat = 2, sdate = 60)) #'ROCSS(exp = exp, obs = obs) ## random forecast as reference forecast #'ROCSS(exp = exp, obs = obs, ref = ref) ## ref as reference forecast +#'# 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') +#'ROCSS(exp = exp_probs, obs = obs_probs, ref = ref_probs, memb_dim = NULL, cat_dim = 'bin') #' #'@import multiApply #'@importFrom easyVerification EnsRoca #'@export -ROCSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', +ROCSS <- 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, cross.val = FALSE, ncores = NULL) { @@ -93,15 +112,31 @@ ROCSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', if (!is.null(ref) & !time_dim %in% names(dim(ref))) { stop("Parameter 'time_dim' is not found in 'ref' dimension.") } - ## memb_dim - if (!is.character(memb_dim) | length(memb_dim) > 1) { - stop("Parameter 'memb_dim' must be a character string.") + ## memb_dim & cat_dim + if (is.null(memb_dim) + is.null(cat_dim) != 1) { + stop("Only one of the two parameters 'memb_dim' and 'cat_dim' can have value.") } - if (!memb_dim %in% names(dim(exp))) { - stop("Parameter 'memb_dim' is not found in 'exp' dimension.") + ## memb_dim + if (!is.null(memb_dim)) { + if (!is.character(memb_dim) | length(memb_dim) > 1) { + stop("Parameter 'memb_dim' must be a character string.") + } + if (!memb_dim %in% names(dim(exp))) { + stop("Parameter 'memb_dim' is not found in 'exp' dimension.") + } + if (!is.null(ref) & !memb_dim %in% names(dim(ref))) { + stop("Parameter 'memb_dim' is not found in 'ref' dimension.") + } } - if (!is.null(ref) & !memb_dim %in% names(dim(ref))) { - stop("Parameter 'memb_dim' is not found in 'ref' dimension.") + ## cat_dim + if (!is.null(cat_dim)) { + if (!is.character(cat_dim) | length(cat_dim) > 1) { + stop("Parameter 'cat_dim' must be a character string.") + } + if (!cat_dim %in% names(dim(exp)) | !cat_dim %in% names(dim(obs)) | + (!is.null(ref) & !cat_dim %in% names(dim(ref)))) { + stop("Parameter 'cat_dim' is not found in 'exp', 'obs', or 'ref' dimension.") + } } ## dat_dim if (!is.null(dat_dim)) { @@ -116,9 +151,11 @@ ROCSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', ## exp, obs, and ref (2) name_exp <- sort(names(dim(exp))) name_obs <- sort(names(dim(obs))) - name_exp <- name_exp[-which(name_exp == memb_dim)] - if (memb_dim %in% name_obs) { - name_obs <- name_obs[-which(name_obs == memb_dim)] + if (!is.null(memb_dim)) { + name_exp <- name_exp[-which(name_exp == memb_dim)] + if (memb_dim %in% name_obs) { + name_obs <- name_obs[-which(name_obs == memb_dim)] + } } if (!is.null(dat_dim)) { name_exp <- name_exp[-which(name_exp == dat_dim)] @@ -131,7 +168,9 @@ ROCSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', } if (!is.null(ref)) { name_ref <- sort(names(dim(ref))) - name_ref <- name_ref[-which(name_ref == memb_dim)] + if (!is.null(memb_dim)) { + name_ref <- name_ref[-which(name_ref == memb_dim)] + } if (!is.null(dat_dim)) { if (dat_dim %in% name_ref) { if (!identical(dim(exp)[dat_dim], dim(ref)[dat_dim])) { @@ -187,41 +226,54 @@ ROCSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', output_dims <- c('nexp', 'nobs', 'cat') } ## target_dims - if (!memb_dim %in% names(dim(obs))) { - target_dims_obs <- c(time_dim, dat_dim) - } else { - target_dims_obs <- c(time_dim, memb_dim, dat_dim) + if (!is.null(memb_dim)) { + target_dims_exp <- c(time_dim, memb_dim, dat_dim) + if (!memb_dim %in% names(dim(obs))) { + target_dims_obs <- c(time_dim, dat_dim) + } else { + target_dims_obs <- c(time_dim, memb_dim, dat_dim) + } + } else { # cat_dim + target_dims_exp <- target_dims_obs <- c(time_dim, cat_dim, dat_dim) } - ## If ref doesn't have & dat_dim is not NULL - if (!is.null(ref) && !is.null(dat_dim) &&!dat_dim %in% names(dim(ref))) { - target_dims_ref <- c(time_dim, memb_dim) - } else { - target_dims_ref <- c(time_dim, memb_dim, dat_dim) + + if (!is.null(ref)) { # use "ref" as reference forecast + if (!is.null(memb_dim)) { + if (!is.null(dat_dim) && (dat_dim %in% names(dim(ref)))) { + target_dims_ref <- c(time_dim, memb_dim, dat_dim) + } else { + target_dims_ref <- c(time_dim, memb_dim) + } + } else { + target_dims_ref <- c(time_dim, cat_dim, dat_dim) + } } if (!is.null(ref)) { ## reference forecast is provided res <- Apply(data = list(exp = exp, obs = obs, ref = ref), - target_dims = list(exp = c(time_dim, memb_dim, dat_dim), + target_dims = list(exp = target_dims_exp, obs = target_dims_obs, ref = target_dims_ref), output_dims = output_dims, fun = .ROCSS, prob_thresholds = prob_thresholds, indices_for_clim = indices_for_clim, - time_dim = time_dim, dat_dim = dat_dim, + time_dim = time_dim, memb_dim = memb_dim, + cat_dim = cat_dim, dat_dim = dat_dim, cross.val = cross.val, ncores = ncores)$output1 } else { ## Random forecast as reference forecast res <- Apply(data = list(exp = exp, obs = obs), - target_dims = list(exp = c(time_dim, memb_dim, dat_dim), + target_dims = list(exp = target_dims_exp, obs = target_dims_obs), output_dims = output_dims, fun = .ROCSS, ref = ref, prob_thresholds = prob_thresholds, indices_for_clim = indices_for_clim, - time_dim = time_dim, dat_dim = dat_dim, + time_dim = time_dim, memb_dim = memb_dim, + cat_dim = cat_dim, dat_dim = dat_dim, cross.val = cross.val, ncores = ncores)$output1 } @@ -229,13 +281,19 @@ ROCSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', return(res) } -.ROCSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, prob_thresholds = c(1/3, 2/3), +.ROCSS <- 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, cross.val = FALSE) { + #--- if memb_dim: # exp: [sdate, memb, (dat)] # obs: [sdate, (dat)] - # ref: [sdate, memb, (dat)] or NULL - + # ref: [sdate, memb, (dat)] or NULL + #--- if cat_dim: + # exp: [sdate, bin, (dat)] + # obs: [sdate, bin, (dat)] + # ref: [sdate, bin, (dat)] or NULL + if (is.null(dat_dim)) { nexp <- 1 nobs <- 1 @@ -262,25 +320,34 @@ ROCSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', for (exp_i in 1:nexp) { for (obs_i in 1:nobs) { - # Input dim for .GetProbs - ## if exp: [sdate, memb] - ## if obs: [sdate, (memb)] - exp_probs <- .GetProbs(ClimProjDiags::Subset(exp, dat_dim, exp_i, drop = 'selected'), - indices_for_quantiles = indices_for_clim, - prob_thresholds = prob_thresholds, cross.val = cross.val) - obs_probs <- .GetProbs(data = ClimProjDiags::Subset(obs, dat_dim, obs_i, drop = 'selected'), - indices_for_quantiles = indices_for_clim, - prob_thresholds = prob_thresholds, cross.val = cross.val) - ## exp_probs and obs_probs: [bin, sdate] - + if (is.null(cat_dim)) { # calculate probs + # Input dim for .GetProbs + ## if exp: [sdate, memb] + ## if obs: [sdate, (memb)] + exp_probs <- .GetProbs(data = ClimProjDiags::Subset(exp, dat_dim, exp_i, drop = 'selected'), + indices_for_quantiles = indices_for_clim, + prob_thresholds = prob_thresholds, cross.val = cross.val) + obs_probs <- .GetProbs(data = ClimProjDiags::Subset(obs, dat_dim, obs_i, drop = 'selected'), + indices_for_quantiles = indices_for_clim, + prob_thresholds = prob_thresholds, cross.val = cross.val) + ## exp_probs and obs_probs: [bin, sdate] + } else { + exp_probs <- exp[, , exp_i] + obs_probs <- obs[, , obs_i] + } + ## ROCS (exp) rocs_exp[exp_i, obs_i, ] <- unlist(EnsRoca(ens = Reorder(exp_probs, c(time_dim, 'bin')), obs = Reorder(obs_probs, c(time_dim, 'bin')))[1:ncats]) if (!is.null(ref)) { - ref_probs <- .GetProbs(ClimProjDiags::Subset(ref, dat_dim, exp_i, drop = 'selected'), - indices_for_quantiles = indices_for_clim, - prob_thresholds = prob_thresholds, cross.val = cross.val) + if (is.null(cat_dim)) { # calculate probs + ref_probs <- .GetProbs(ClimProjDiags::Subset(ref, dat_dim, exp_i, drop = 'selected'), + indices_for_quantiles = indices_for_clim, + prob_thresholds = prob_thresholds, cross.val = cross.val) + } else { + ref_probs <- ref[, , exp_i] + } rocs_ref[exp_i, obs_i, ] <- unlist(EnsRoca(ens = Reorder(ref_probs, c(time_dim, 'bin')), obs = Reorder(obs_probs, c(time_dim, 'bin')))[1:ncats]) } diff --git a/R/RPSS.R b/R/RPSS.R index 7a18afe..5ad8e0e 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -39,8 +39,8 @@ #' default value is 'member'. If the data are probabilistics, set memb_dim as #' NULL. #'@param cat_dim A character string indicating the name of the category -#' dimension that is needed when the exp and obs are probabilities. The default -#' value is NULL, which means that the data are not probabilities. +#' dimension that is needed when exp, obs, and ref are probabilities. The +#' default value is NULL, which means that the data are not probabilities. #'@param dat_dim A character string indicating the name of dataset dimension. #' The length of this dimension can be different between 'exp' and 'obs'. #' The default value is NULL. @@ -95,9 +95,16 @@ #' n/sum(n) #' }) #'dim(weights) <- c(member = 10, sdate = 50) +#'# Use data as input #'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) +#'# 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') +#' #'@import multiApply #'@export RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', cat_dim = NULL, @@ -156,7 +163,7 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', stop("Parameter 'cat_dim' must be a character string.") } if (!cat_dim %in% names(dim(exp)) | !cat_dim %in% names(dim(obs)) | - !cat_dim %in% names(dim(obs))) { + (!is.null(ref) & !cat_dim %in% names(dim(ref)))) { stop("Parameter 'cat_dim' is not found in 'exp', 'obs', or 'ref' dimension.") } } diff --git a/man/ROCSS.Rd b/man/ROCSS.Rd index 1f49517..4514164 100644 --- a/man/ROCSS.Rd +++ b/man/ROCSS.Rd @@ -10,6 +10,7 @@ ROCSS( 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, @@ -18,27 +19,36 @@ ROCSS( ) } \arguments{ -\item{exp}{A named numerical array of the forecast with at least time and -member dimension.} +\item{exp}{A named numerical array of either the forecast with at least time +and member dimensions, or the probability with at least time and category +dimensions. The probability can be generated by \code{s2dv::GetProbs}.} -\item{obs}{A named numerical array of the observation with at least time -dimension. The dimensions must be the same as 'exp' except 'memb_dim' and -'dat_dim'.} +\item{obs}{A named numerical array of either the observation with at least +time dimension, or the probability with at least time and category +dimensions. The probability can be generated by \code{s2dv::GetProbs}. The +dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'.} -\item{ref}{A named numerical array of the reference forecast data with at -least time and member dimension. The dimensions must be the same as 'exp' -except 'memb_dim' and 'dat_dim'. If there is only one reference dataset, -it should not have dataset dimension. If there is corresponding reference -for each experiement, the dataset dimension must have the same length as in -'exp'. If 'ref' is NULL, the random forecast is used as reference forecast. -The default value is NULL.} +\item{ref}{A named numerical array of the reference forecast with at least +time and member dimensions, or the probability with at least time and +category dimensions. The probability can be generated by +\code{s2dv::GetProbs}. The dimensions must be the same as 'exp' except +'memb_dim' and 'dat_dim'. If there is only one reference dataset, it should +not have dataset dimension. If there is corresponding reference for each +experiement, the dataset dimension must have the same length as in 'exp'. +If 'ref' is NULL, the random forecast is used as reference forecast. The +default value is NULL.} \item{time_dim}{A character string indicating the name of the time dimension. The default value is 'sdate'.} \item{memb_dim}{A character string indicating the name of the member dimension to compute the probabilities of the forecast and the reference forecast. The -default value is 'member'.} +default value is 'member'. If the data are probabilistics, set memb_dim as +NULL.} + +\item{cat_dim}{A character string indicating the name of the category +dimension that is needed when exp, obs, and ref are probabilities. The +default value is NULL, which means that the data are not probabilities.} \item{dat_dim}{A character string indicating the name of dataset dimension. The length of this dimension can be different between 'exp' and 'obs'. @@ -60,11 +70,12 @@ FALSE.} computation. The default value is NULL.} } \value{ -A numerical array of ROCSS with the same dimensions as 'exp' excluding -'time_dim' and 'memb_dim' dimensions and including 'cat' dimension, which is -each category. The length if 'cat' dimension corresponds to the number of -probabilistic categories, i.e., 1 + length(prob_thresholds). If there are -multiple datasets, two additional dimensions 'nexp' and 'nobs' are added. +A numerical array of ROCSS with dimensions c(nexp, nobs, cat, the rest +dimensions of 'exp' except 'time_dim' and 'memb_dim' dimensions). nexp is the +number of experiment (i.e., dat_dim in exp), and nobs is the number of +observation (i.e., dat_dim in obs). If dat_dim is NULL, nexp and nobs are +omitted. dimension 'cat' refers to the probabilistic category, i.e., +\code{1 + length(prob_thresholds)}. } \description{ The Relative Operating Characteristic Skill Score (ROCSS; Kharin and Zwiers, @@ -73,14 +84,23 @@ against the false-alarm rates for a particular category or event. The ROC curve can be summarized with the area under the ROC curve, known as the ROC score, to provide a skill value for each category. The ROCSS ranges between minus infinite and 1. A positive ROCSS value indicates that the forecast has -higher skill than the reference forecasts, meaning the contrary otherwise. +higher skill than the reference forecasts, meaning the contrary otherwise.\cr +The function accepts either the data 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. } \examples{ +# Use data as input exp <- array(rnorm(1000), dim = c(lon = 3, lat = 2, sdate = 60, member = 10)) ref <- array(rnorm(1000), dim = c(lon = 3, lat = 2, sdate = 60, member = 10)) obs <- array(rnorm(1000), dim = c(lon = 3, lat = 2, sdate = 60)) ROCSS(exp = exp, obs = obs) ## random forecast as reference forecast ROCSS(exp = exp, obs = obs, ref = ref) ## ref as reference forecast +# 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') +ROCSS(exp = exp_probs, obs = obs_probs, ref = ref_probs, memb_dim = NULL, cat_dim = 'bin') } \references{ diff --git a/man/RPSS.Rd b/man/RPSS.Rd index a1e3e55..cda05a4 100644 --- a/man/RPSS.Rd +++ b/man/RPSS.Rd @@ -50,8 +50,8 @@ default value is 'member'. If the data are probabilistics, set memb_dim as NULL.} \item{cat_dim}{A character string indicating the name of the category -dimension that is needed when the exp and obs are probabilities. The default -value is NULL, which means that the data are not probabilities.} +dimension that is needed when exp, obs, and ref are probabilities. The +default value is NULL, which means that the data are not probabilities.} \item{dat_dim}{A character string indicating the name of dataset dimension. The length of this dimension can be different between 'exp' and 'obs'. @@ -127,9 +127,16 @@ weights <- sapply(1:dim(exp)['sdate'], function(i) { n/sum(n) }) dim(weights) <- c(member = 10, sdate = 50) +# Use data as input 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) +# 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') + } \references{ Wilks, 2011; https://doi.org/10.1016/B978-0-12-385022-5.00008-7 diff --git a/tests/testthat/test-ROCSS.R b/tests/testthat/test-ROCSS.R index a95d0ba..130cfa2 100644 --- a/tests/testthat/test-ROCSS.R +++ b/tests/testthat/test-ROCSS.R @@ -10,6 +10,11 @@ obs1 <- array(rnorm(20), dim = c(sdate = 10, lat = 2)) set.seed(3) ref1 <- array(rnorm(40), dim = c(member = 2, sdate = 10, lat = 2)) +# dat1_2 +exp1_2 <- GetProbs(exp1, memb_dim = 'member') +obs1_2 <- GetProbs(obs1, memb_dim = NULL) +ref1_2 <- GetProbs(ref1, memb_dim = 'member') + # dat2 set.seed(1) exp2 <- array(rnorm(30), dim = c(member = 3, sdate = 10)) @@ -151,6 +156,16 @@ c(0.5238095, 0.5357143), tolerance = 0.0001 ) +# dat1_2 +expect_equal( + ROCSS(exp1, obs1), + ROCSS(exp1_2, obs1_2, memb_dim = NULL, cat_dim = 'bin') +) +expect_equal( + ROCSS(exp1, obs1, ref1), + ROCSS(exp1_2, obs1_2, ref1_2, memb_dim = NULL, cat_dim = 'bin') +) + }) ############################################## -- GitLab From 5195a268d16adff2320a8019a45df98088e9268c Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Tue, 25 Apr 2023 12:07:20 +0200 Subject: [PATCH 24/64] slightly modified documentation --- R/ROCSS.R | 18 +++++++++--------- R/RPS.R | 16 ++++++++-------- R/RPSS.R | 22 +++++++++++----------- 3 files changed, 28 insertions(+), 28 deletions(-) diff --git a/R/ROCSS.R b/R/ROCSS.R index 3ac67e6..2ca0782 100644 --- a/R/ROCSS.R +++ b/R/ROCSS.R @@ -6,32 +6,32 @@ #'curve can be summarized with the area under the ROC curve, known as the ROC #'score, to provide a skill value for each category. The ROCSS ranges between #'minus infinite and 1. A positive ROCSS value indicates that the forecast has -#'higher skill than the reference forecasts, meaning the contrary otherwise.\cr +#'higher skill than the reference forecast, meaning the contrary otherwise.\cr #'The function accepts either the data 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. #' #'@param exp A named numerical array of either the forecast with at least time -#' and member dimensions, or the probability with at least time and category -#' dimensions. The probability can be generated by \code{s2dv::GetProbs}. -#'@param obs A named numerical array of either the observation with at least -#' time dimension, or the probability with at least time and category -#' dimensions. The probability can be generated by \code{s2dv::GetProbs}. The +#' and member dimensions, or the probabilities with at least time and category +#' dimensions. The probabilities can be generated by \code{s2dv::GetProbs}. +#'@param obs A named numerical array of either the observations with at least +#' time dimension, or the probabilities with at least time and category +#' dimensions. The probabilities can be generated by \code{s2dv::GetProbs}. The #' dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'. #'@param ref A named numerical array of the reference forecast with at least -#' time and member dimensions, or the probability with at least time and +#' time and member dimensions, or the probabilities with at least time and #' category dimensions. The probability can be generated by #' \code{s2dv::GetProbs}. The dimensions must be the same as 'exp' except #' 'memb_dim' and 'dat_dim'. If there is only one reference dataset, it should #' not have dataset dimension. If there is corresponding reference for each -#' experiement, the dataset dimension must have the same length as in 'exp'. +#' experiment, the dataset dimension must have the same length as in 'exp'. #' If 'ref' is NULL, the random forecast is used as reference forecast. The #' default value is NULL. #'@param time_dim A character string indicating the name of the time dimension. #' The default value is 'sdate'. #'@param memb_dim A character string indicating the name of the member dimension #' to compute the probabilities of the forecast and the reference forecast. The -#' default value is 'member'. If the data are probabilistics, set memb_dim as +#' default value is 'member'. If the data are probabilities, set memb_dim as #' NULL. #'@param cat_dim A character string indicating the name of the category #' dimension that is needed when exp, obs, and ref are probabilities. The diff --git a/R/RPS.R b/R/RPS.R index 31f12c6..826c03a 100644 --- a/R/RPS.R +++ b/R/RPS.R @@ -8,25 +8,25 @@ #'(perfect forecast) and n-1 (worst possible forecast), where n is the number of #'categories. In the case of a forecast divided into two categories (the lowest #'number of categories that a probabilistic forecast can have), the RPS -#'corresponds to the Brier Score (BS; Wilks, 2011), therefore, ranges between 0 +#'corresponds to the Brier Score (BS; Wilks, 2011), therefore ranging between 0 #'and 1.\cr -#'The function first calculates the probabilities for forecast and observation, +#'The function first calculates the probabilities for forecasts and observations, #'then use them to calculate RPS. Or, the probabilities of exp and obs can be #'provided directly to compute the score. If there is more than one dataset, RPS #'will be computed for each pair of exp and obs data. #' -#'@param exp A named numerical array of either the forecast with at least time -#' and member dimensions, or the probability with at least time and category -#' dimensions. The probability can be generated by \code{s2dv::GetProbs}. +#'@param exp A named numerical array of either the forecasts with at least time +#' and member dimensions, or the probabilities with at least time and category +#' dimensions. The probabilities can be generated by \code{s2dv::GetProbs}. #'@param obs A named numerical array of either the observation with at least -#' time dimension, or the probability with at least time and category -#' dimensions. The probability can be generated by \code{s2dv::GetProbs}. The +#' time dimension, or the probabilities with at least time and category +#' dimensions. The probabilities can be generated by \code{s2dv::GetProbs}. The #' dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'. #'@param time_dim A character string indicating the name of the time dimension. #' The default value is 'sdate'. #'@param memb_dim A character string indicating the name of the member dimension #' to compute the probabilities of the forecast. The default value is 'member'. -#' If the data are probabilistics, set memb_dim as NULL. +#' If the data are probabilities, set memb_dim as NULL. #'@param cat_dim A character string indicating the name of the category #' dimension that is needed when the exp and obs are probabilities. The default #' value is NULL, which means that the data are not probabilities. diff --git a/R/RPSS.R b/R/RPSS.R index 5ad8e0e..6299eb8 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -12,31 +12,31 @@ #'\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 -#'The function accepts either the data 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 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. #' #'@param exp A named numerical array of either the forecast with at least time -#' and member dimensions, or the probability with at least time and category -#' dimensions. The probability can be generated by \code{s2dv::GetProbs}. +#' and member dimensions, or the probabilities with at least time and category +#' dimensions. The probabilities can be generated by \code{s2dv::GetProbs}. #'@param obs A named numerical array of either the observation with at least -#' time dimension, or the probability with at least time and category -#' dimensions. The probability can be generated by \code{s2dv::GetProbs}. The +#' time dimension, or the probabilities with at least time and category +#' dimensions. The probabilities can be generated by \code{s2dv::GetProbs}. The #' dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'. #'@param ref A named numerical array of either the reference forecast with at -#' least time and member dimensions, or the probability with at least time and -#' category dimensions. The probability can be generated by +#' least time and member dimensions, or the probabilities with at least time and +#' category dimensions. The probabilities can be generated by #' \code{s2dv::GetProbs}. The dimensions must be the same as 'exp' except #' 'memb_dim' and 'dat_dim'. If there is only one reference dataset, it should #' not have dataset dimension. If there is corresponding reference for each -#' experiement, the dataset dimension must have the same length as in 'exp'. If +#' experiment, the dataset dimension must have the same length as in 'exp'. If #' 'ref' is NULL, the climatological forecast is used as reference forecast. #' The default value is NULL. #'@param time_dim A character string indicating the name of the time dimension. #' The default value is 'sdate'. #'@param memb_dim A character string indicating the name of the member dimension #' to compute the probabilities of the forecast and the reference forecast. The -#' default value is 'member'. If the data are probabilistics, set memb_dim as +#' default value is 'member'. If the data are probabilities, set memb_dim as #' NULL. #'@param cat_dim A character string indicating the name of the category #' dimension that is needed when exp, obs, and ref are probabilities. The -- GitLab From 03d677dd68eeb39ca11cdba63af81dbce363b910 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 25 Apr 2023 12:41:49 +0200 Subject: [PATCH 25/64] Update man files --- R/RPS.R | 2 +- man/ROCSS.Rd | 18 +++++++++--------- man/RPS.Rd | 16 ++++++++-------- man/RPSS.Rd | 22 +++++++++++----------- 4 files changed, 29 insertions(+), 29 deletions(-) diff --git a/R/RPS.R b/R/RPS.R index 826c03a..c5ff5ba 100644 --- a/R/RPS.R +++ b/R/RPS.R @@ -8,7 +8,7 @@ #'(perfect forecast) and n-1 (worst possible forecast), where n is the number of #'categories. In the case of a forecast divided into two categories (the lowest #'number of categories that a probabilistic forecast can have), the RPS -#'corresponds to the Brier Score (BS; Wilks, 2011), therefore ranging between 0 +#'corresponds to the Brier Score (BS; Wilks, 2011), therefore ranging between 0 #'and 1.\cr #'The function first calculates the probabilities for forecasts and observations, #'then use them to calculate RPS. Or, the probabilities of exp and obs can be diff --git a/man/ROCSS.Rd b/man/ROCSS.Rd index 4514164..7480f63 100644 --- a/man/ROCSS.Rd +++ b/man/ROCSS.Rd @@ -20,21 +20,21 @@ ROCSS( } \arguments{ \item{exp}{A named numerical array of either the forecast with at least time -and member dimensions, or the probability with at least time and category -dimensions. The probability can be generated by \code{s2dv::GetProbs}.} +and member dimensions, or the probabilities with at least time and category +dimensions. The probabilities can be generated by \code{s2dv::GetProbs}.} -\item{obs}{A named numerical array of either the observation with at least -time dimension, or the probability with at least time and category -dimensions. The probability can be generated by \code{s2dv::GetProbs}. The +\item{obs}{A named numerical array of either the observations with at least +time dimension, or the probabilities with at least time and category +dimensions. The probabilities can be generated by \code{s2dv::GetProbs}. The dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'.} \item{ref}{A named numerical array of the reference forecast with at least -time and member dimensions, or the probability with at least time and +time and member dimensions, or the probabilities with at least time and category dimensions. The probability can be generated by \code{s2dv::GetProbs}. The dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'. If there is only one reference dataset, it should not have dataset dimension. If there is corresponding reference for each -experiement, the dataset dimension must have the same length as in 'exp'. +experiment, the dataset dimension must have the same length as in 'exp'. If 'ref' is NULL, the random forecast is used as reference forecast. The default value is NULL.} @@ -43,7 +43,7 @@ The default value is 'sdate'.} \item{memb_dim}{A character string indicating the name of the member dimension to compute the probabilities of the forecast and the reference forecast. The -default value is 'member'. If the data are probabilistics, set memb_dim as +default value is 'member'. If the data are probabilities, set memb_dim as NULL.} \item{cat_dim}{A character string indicating the name of the category @@ -84,7 +84,7 @@ against the false-alarm rates for a particular category or event. The ROC curve can be summarized with the area under the ROC curve, known as the ROC score, to provide a skill value for each category. The ROCSS ranges between minus infinite and 1. A positive ROCSS value indicates that the forecast has -higher skill than the reference forecasts, meaning the contrary otherwise.\cr +higher skill than the reference forecast, meaning the contrary otherwise.\cr The function accepts either the data 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. diff --git a/man/RPS.Rd b/man/RPS.Rd index c08b109..2e21227 100644 --- a/man/RPS.Rd +++ b/man/RPS.Rd @@ -20,13 +20,13 @@ RPS( ) } \arguments{ -\item{exp}{A named numerical array of either the forecast with at least time -and member dimensions, or the probability with at least time and category -dimensions. The probability can be generated by \code{s2dv::GetProbs}.} +\item{exp}{A named numerical array of either the forecasts with at least time +and member dimensions, or the probabilities with at least time and category +dimensions. The probabilities can be generated by \code{s2dv::GetProbs}.} \item{obs}{A named numerical array of either the observation with at least -time dimension, or the probability with at least time and category -dimensions. The probability can be generated by \code{s2dv::GetProbs}. The +time dimension, or the probabilities with at least time and category +dimensions. The probabilities can be generated by \code{s2dv::GetProbs}. The dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'.} \item{time_dim}{A character string indicating the name of the time dimension. @@ -34,7 +34,7 @@ The default value is 'sdate'.} \item{memb_dim}{A character string indicating the name of the member dimension to compute the probabilities of the forecast. The default value is 'member'. -If the data are probabilistics, set memb_dim as NULL.} +If the data are probabilities, set memb_dim as NULL.} \item{cat_dim}{A character string indicating the name of the category dimension that is needed when the exp and obs are probabilities. The default @@ -85,9 +85,9 @@ of multi-categorical probabilistic forecasts. The RPS ranges between 0 (perfect forecast) and n-1 (worst possible forecast), where n is the number of categories. In the case of a forecast divided into two categories (the lowest number of categories that a probabilistic forecast can have), the RPS -corresponds to the Brier Score (BS; Wilks, 2011), therefore, ranges between 0 +corresponds to the Brier Score (BS; Wilks, 2011), therefore ranging between 0 and 1.\cr -The function first calculates the probabilities for forecast and observation, +The function first calculates the probabilities for forecasts and observations, then use them to calculate RPS. Or, the probabilities of exp and obs can be provided directly to compute the score. If there is more than one dataset, RPS will be computed for each pair of exp and obs data. diff --git a/man/RPSS.Rd b/man/RPSS.Rd index cda05a4..a6abe34 100644 --- a/man/RPSS.Rd +++ b/man/RPSS.Rd @@ -23,21 +23,21 @@ RPSS( } \arguments{ \item{exp}{A named numerical array of either the forecast with at least time -and member dimensions, or the probability with at least time and category -dimensions. The probability can be generated by \code{s2dv::GetProbs}.} +and member dimensions, or the probabilities with at least time and category +dimensions. The probabilities can be generated by \code{s2dv::GetProbs}.} \item{obs}{A named numerical array of either the observation with at least -time dimension, or the probability with at least time and category -dimensions. The probability can be generated by \code{s2dv::GetProbs}. The +time dimension, or the probabilities with at least time and category +dimensions. The probabilities can be generated by \code{s2dv::GetProbs}. The dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'.} \item{ref}{A named numerical array of either the reference forecast with at -least time and member dimensions, or the probability with at least time and -category dimensions. The probability can be generated by +least time and member dimensions, or the probabilities with at least time and +category dimensions. The probabilities can be generated by \code{s2dv::GetProbs}. The dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'. If there is only one reference dataset, it should not have dataset dimension. If there is corresponding reference for each -experiement, the dataset dimension must have the same length as in 'exp'. If +experiment, the dataset dimension must have the same length as in 'exp'. If 'ref' is NULL, the climatological forecast is used as reference forecast. The default value is NULL.} @@ -46,7 +46,7 @@ The default value is 'sdate'.} \item{memb_dim}{A character string indicating the name of the member dimension to compute the probabilities of the forecast and the reference forecast. The -default value is 'member'. If the data are probabilistics, set memb_dim as +default value is 'member'. If the data are probabilities, set memb_dim as NULL.} \item{cat_dim}{A character string indicating the name of the category @@ -111,9 +111,9 @@ 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 -The function accepts either the data 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 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. } \examples{ set.seed(1) -- GitLab From 2e84d312e2e4feeed8be3bd3856816078b16480f Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 16 May 2023 18:23:54 +0200 Subject: [PATCH 26/64] Use testthat edition 3; remove context() --- DESCRIPTION | 1 + tests/testthat/test-ACC.R | 2 -- tests/testthat/test-AMV.R | 2 -- tests/testthat/test-AbsBiasSS.R | 2 -- tests/testthat/test-Ano.R | 2 -- tests/testthat/test-Ano_CrossValid.R | 2 -- tests/testthat/test-Bias.R | 2 -- tests/testthat/test-BrierScore.R | 2 -- tests/testthat/test-CDORemap.R | 2 -- tests/testthat/test-CRPS.R | 2 -- tests/testthat/test-CRPSS.R | 2 -- tests/testthat/test-Clim.R | 2 -- tests/testthat/test-Cluster.R | 2 -- tests/testthat/test-Composite.R | 2 -- tests/testthat/test-Consist_Trend.R | 2 -- tests/testthat/test-Corr.R | 2 -- tests/testthat/test-DiffCorr.R | 2 -- tests/testthat/test-EOF.R | 2 -- tests/testthat/test-Eno.R | 2 -- tests/testthat/test-EuroAtlanticTC.R | 2 -- tests/testthat/test-Filter.R | 2 -- tests/testthat/test-GMST.R | 2 -- tests/testthat/test-GSAT.R | 2 -- tests/testthat/test-GetProbs.R | 2 -- tests/testthat/test-Histo2Hindcast.R | 2 -- tests/testthat/test-InsertDim.R | 2 -- tests/testthat/test-Load.R | 2 -- tests/testthat/test-MeanDims.R | 2 -- tests/testthat/test-NAO.R | 2 -- tests/testthat/test-Persistence.R | 2 -- tests/testthat/test-ProbBins.R | 2 -- tests/testthat/test-ProjectField.R | 2 -- tests/testthat/test-REOF.R | 2 -- tests/testthat/test-RMS.R | 2 -- tests/testthat/test-RMSSS.R | 2 -- tests/testthat/test-ROCSS.R | 2 -- tests/testthat/test-RPS.R | 2 -- tests/testthat/test-RPSS.R | 2 -- tests/testthat/test-RandomWalkTest.R | 2 -- tests/testthat/test-RatioPredictableComponents.R | 2 -- tests/testthat/test-RatioRMS.R | 2 -- tests/testthat/test-RatioSDRMS.R | 2 -- tests/testthat/test-Regression.R | 2 -- tests/testthat/test-Reorder.R | 2 -- tests/testthat/test-ResidualCorr.R | 2 -- tests/testthat/test-SPOD.R | 2 -- tests/testthat/test-Season.R | 2 -- tests/testthat/test-SignalNoiseRatio.R | 3 --- tests/testthat/test-Smoothing.R | 2 -- tests/testthat/test-Spectrum.R | 2 -- tests/testthat/test-Spread.R | 2 -- tests/testthat/test-StatSeasAtlHurr.R | 2 -- tests/testthat/test-TPI.R | 2 -- tests/testthat/test-Trend.R | 2 -- tests/testthat/test-UltimateBrier.R | 2 -- 55 files changed, 1 insertion(+), 109 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index eee31d4..fe86337 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -51,3 +51,4 @@ LazyData: true SystemRequirements: cdo Encoding: UTF-8 RoxygenNote: 7.2.0 +Config/testthat/edition: 3 diff --git a/tests/testthat/test-ACC.R b/tests/testthat/test-ACC.R index ab5f8be..c9e986d 100644 --- a/tests/testthat/test-ACC.R +++ b/tests/testthat/test-ACC.R @@ -1,5 +1,3 @@ -context("s2dv::ACC tests") - ############################################## ##NOTE: bootstrap is not tested because sample() is used inside. diff --git a/tests/testthat/test-AMV.R b/tests/testthat/test-AMV.R index 9adfaef..f2cc6d0 100644 --- a/tests/testthat/test-AMV.R +++ b/tests/testthat/test-AMV.R @@ -1,5 +1,3 @@ -context("s2dv::AMV tests") - ############################################## lat <- seq(-90, 90, 10) lon <- seq(0, 360, 10) diff --git a/tests/testthat/test-AbsBiasSS.R b/tests/testthat/test-AbsBiasSS.R index 08a4a83..b194ce2 100644 --- a/tests/testthat/test-AbsBiasSS.R +++ b/tests/testthat/test-AbsBiasSS.R @@ -1,5 +1,3 @@ -context("s2dv::AbsBiasSS tests") - ############################################## # dat1 diff --git a/tests/testthat/test-Ano.R b/tests/testthat/test-Ano.R index a74c7c9..bfcf0cb 100644 --- a/tests/testthat/test-Ano.R +++ b/tests/testthat/test-Ano.R @@ -1,5 +1,3 @@ -context("s2dv::Ano test") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-Ano_CrossValid.R b/tests/testthat/test-Ano_CrossValid.R index 2d7c00c..c5eea59 100644 --- a/tests/testthat/test-Ano_CrossValid.R +++ b/tests/testthat/test-Ano_CrossValid.R @@ -1,5 +1,3 @@ -context("s2dv::Ano_CrossValid tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-Bias.R b/tests/testthat/test-Bias.R index 842ecc2..4c6cc99 100644 --- a/tests/testthat/test-Bias.R +++ b/tests/testthat/test-Bias.R @@ -1,5 +1,3 @@ -context("s2dv::Bias tests") - ############################################## # dat1 diff --git a/tests/testthat/test-BrierScore.R b/tests/testthat/test-BrierScore.R index e2c34f9..3f02ac5 100644 --- a/tests/testthat/test-BrierScore.R +++ b/tests/testthat/test-BrierScore.R @@ -1,5 +1,3 @@ -context("s2dv::BrierScore tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-CDORemap.R b/tests/testthat/test-CDORemap.R index 1ace086..5492d51 100644 --- a/tests/testthat/test-CDORemap.R +++ b/tests/testthat/test-CDORemap.R @@ -1,5 +1,3 @@ -context("s2dv::CDORemap tests") - # data1: regular grid data1 <- array(1:360*181*2, dim = c(lon = 360, lat = 181, time = 2)) lons1 <- seq(0, 359) diff --git a/tests/testthat/test-CRPS.R b/tests/testthat/test-CRPS.R index 972eb45..417b3be 100644 --- a/tests/testthat/test-CRPS.R +++ b/tests/testthat/test-CRPS.R @@ -1,5 +1,3 @@ -context("s2dv::CRPS tests") - ############################################## # dat1 diff --git a/tests/testthat/test-CRPSS.R b/tests/testthat/test-CRPSS.R index db0eecd..505f3d4 100644 --- a/tests/testthat/test-CRPSS.R +++ b/tests/testthat/test-CRPSS.R @@ -1,5 +1,3 @@ -context("s2dv::CRPSS tests") - ############################################## # dat1 diff --git a/tests/testthat/test-Clim.R b/tests/testthat/test-Clim.R index f5e288e..1a04437 100644 --- a/tests/testthat/test-Clim.R +++ b/tests/testthat/test-Clim.R @@ -1,5 +1,3 @@ -context("s2dv::Clim tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-Cluster.R b/tests/testthat/test-Cluster.R index 13297d8..b5fe6cf 100644 --- a/tests/testthat/test-Cluster.R +++ b/tests/testthat/test-Cluster.R @@ -1,5 +1,3 @@ -context("s2dv::Cluster tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-Composite.R b/tests/testthat/test-Composite.R index acc7fe6..cb948ef 100644 --- a/tests/testthat/test-Composite.R +++ b/tests/testthat/test-Composite.R @@ -1,5 +1,3 @@ -context("s2dv::Composite tests") - ############################################## # dat1 x1 <- array(0, dim = c(20, 10, 30)) diff --git a/tests/testthat/test-Consist_Trend.R b/tests/testthat/test-Consist_Trend.R index 91dacf7..7f5b5ab 100644 --- a/tests/testthat/test-Consist_Trend.R +++ b/tests/testthat/test-Consist_Trend.R @@ -1,5 +1,3 @@ -context("s2dv::Consist_Trend tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-Corr.R b/tests/testthat/test-Corr.R index f4172be..6732c58 100644 --- a/tests/testthat/test-Corr.R +++ b/tests/testthat/test-Corr.R @@ -1,5 +1,3 @@ -context("s2dv::Corr tests") - ############################################## # dat1: memb_dim is NULL set.seed(1) diff --git a/tests/testthat/test-DiffCorr.R b/tests/testthat/test-DiffCorr.R index f7b771b..32f6625 100644 --- a/tests/testthat/test-DiffCorr.R +++ b/tests/testthat/test-DiffCorr.R @@ -1,5 +1,3 @@ -context("s2dv::DiffCorr tests") - ############################################## # dat1 diff --git a/tests/testthat/test-EOF.R b/tests/testthat/test-EOF.R index 01428e6..4e95aa3 100644 --- a/tests/testthat/test-EOF.R +++ b/tests/testthat/test-EOF.R @@ -1,5 +1,3 @@ -context("s2dv::EOF tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-Eno.R b/tests/testthat/test-Eno.R index 08fda85..b69d11f 100644 --- a/tests/testthat/test-Eno.R +++ b/tests/testthat/test-Eno.R @@ -1,5 +1,3 @@ -context("s2dv::Eno tests") - ############################################## set.seed(1) dat1 <- array(rnorm(800), dim = c(dataset = 1, member = 2, sdate = 4, diff --git a/tests/testthat/test-EuroAtlanticTC.R b/tests/testthat/test-EuroAtlanticTC.R index 6e3ac4b..c689994 100644 --- a/tests/testthat/test-EuroAtlanticTC.R +++ b/tests/testthat/test-EuroAtlanticTC.R @@ -1,5 +1,3 @@ -context("s2dv::EuroAtlanticTC tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-Filter.R b/tests/testthat/test-Filter.R index cf271e1..b387cfc 100644 --- a/tests/testthat/test-Filter.R +++ b/tests/testthat/test-Filter.R @@ -1,5 +1,3 @@ -context("s2dv::Filter tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-GMST.R b/tests/testthat/test-GMST.R index 01ab792..0fbfa41 100644 --- a/tests/testthat/test-GMST.R +++ b/tests/testthat/test-GMST.R @@ -1,5 +1,3 @@ -context("s2dv::GMST tests") - ############################################## lat <- seq(-90, 90, 10) lon <- seq(0, 360, 10) diff --git a/tests/testthat/test-GSAT.R b/tests/testthat/test-GSAT.R index 2d7d7e0..2eb5d68 100644 --- a/tests/testthat/test-GSAT.R +++ b/tests/testthat/test-GSAT.R @@ -1,5 +1,3 @@ -context("s2dv::GSAT tests") - ############################################## lat <- seq(-90, 90, 10) lon <- seq(0, 360, 10) diff --git a/tests/testthat/test-GetProbs.R b/tests/testthat/test-GetProbs.R index 252dd29..f1958dc 100644 --- a/tests/testthat/test-GetProbs.R +++ b/tests/testthat/test-GetProbs.R @@ -1,5 +1,3 @@ -context("s2dv::GetProbs tests") - ############################################## # dat1 diff --git a/tests/testthat/test-Histo2Hindcast.R b/tests/testthat/test-Histo2Hindcast.R index 025f003..1bd69da 100644 --- a/tests/testthat/test-Histo2Hindcast.R +++ b/tests/testthat/test-Histo2Hindcast.R @@ -1,5 +1,3 @@ -context("s2dv::Histo2Hindcast tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-InsertDim.R b/tests/testthat/test-InsertDim.R index 876e7e3..1e401a9 100644 --- a/tests/testthat/test-InsertDim.R +++ b/tests/testthat/test-InsertDim.R @@ -1,5 +1,3 @@ -context("s2dv::InsertDim tests") - ############################################## dat1 <- array(c(1:26), dim = c(dat = 1, sdate = 13, ftime = 2)) dat2 <- array(c(1:24), dim = c(2, 3, c = 4)) diff --git a/tests/testthat/test-Load.R b/tests/testthat/test-Load.R index 8266139..c87beac 100644 --- a/tests/testthat/test-Load.R +++ b/tests/testthat/test-Load.R @@ -1,5 +1,3 @@ -context("s2dv::Load tests") - ############################################## test_that("1-1.", { diff --git a/tests/testthat/test-MeanDims.R b/tests/testthat/test-MeanDims.R index c043c78..502c828 100644 --- a/tests/testthat/test-MeanDims.R +++ b/tests/testthat/test-MeanDims.R @@ -1,5 +1,3 @@ -context("s2dv::MeanDims tests") - ############################################## # dat1 dat1 <- array(c(1:20), diff --git a/tests/testthat/test-NAO.R b/tests/testthat/test-NAO.R index 05fcd22..91b9943 100644 --- a/tests/testthat/test-NAO.R +++ b/tests/testthat/test-NAO.R @@ -1,5 +1,3 @@ -context("s2dv::NAO tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-Persistence.R b/tests/testthat/test-Persistence.R index 4eabe83..a28a2f3 100644 --- a/tests/testthat/test-Persistence.R +++ b/tests/testthat/test-Persistence.R @@ -1,5 +1,3 @@ -context("s2dv::Persistence tests") - ############################################## #dat1: year set.seed(1) diff --git a/tests/testthat/test-ProbBins.R b/tests/testthat/test-ProbBins.R index 4b3d0ec..5b286e0 100644 --- a/tests/testthat/test-ProbBins.R +++ b/tests/testthat/test-ProbBins.R @@ -1,5 +1,3 @@ -context("s2dv::ProbBins tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-ProjectField.R b/tests/testthat/test-ProjectField.R index f3f05ce..8781c08 100644 --- a/tests/testthat/test-ProjectField.R +++ b/tests/testthat/test-ProjectField.R @@ -1,5 +1,3 @@ -context("s2dv::ProjectField tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-REOF.R b/tests/testthat/test-REOF.R index 39747e2..862e10a 100644 --- a/tests/testthat/test-REOF.R +++ b/tests/testthat/test-REOF.R @@ -1,5 +1,3 @@ -context("s2dv::REOF tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-RMS.R b/tests/testthat/test-RMS.R index 2a97466..c24a2a9 100644 --- a/tests/testthat/test-RMS.R +++ b/tests/testthat/test-RMS.R @@ -1,5 +1,3 @@ -context("s2dv::RMS tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-RMSSS.R b/tests/testthat/test-RMSSS.R index 5619f46..7f38373 100644 --- a/tests/testthat/test-RMSSS.R +++ b/tests/testthat/test-RMSSS.R @@ -1,5 +1,3 @@ -context("s2dv::RMSSS tests") - ############################################## # case 1 set.seed(1) diff --git a/tests/testthat/test-ROCSS.R b/tests/testthat/test-ROCSS.R index 130cfa2..5b35246 100644 --- a/tests/testthat/test-ROCSS.R +++ b/tests/testthat/test-ROCSS.R @@ -1,5 +1,3 @@ -context("s2dv::ROCSS tests") - ############################################## # dat1 diff --git a/tests/testthat/test-RPS.R b/tests/testthat/test-RPS.R index 2040c09..624eb37 100644 --- a/tests/testthat/test-RPS.R +++ b/tests/testthat/test-RPS.R @@ -1,5 +1,3 @@ -context("s2dv::RPS tests") - ############################################## # dat1 diff --git a/tests/testthat/test-RPSS.R b/tests/testthat/test-RPSS.R index ce0deb3..f054325 100644 --- a/tests/testthat/test-RPSS.R +++ b/tests/testthat/test-RPSS.R @@ -1,5 +1,3 @@ -context("s2dv::RPSS tests") - ############################################## # dat1 diff --git a/tests/testthat/test-RandomWalkTest.R b/tests/testthat/test-RandomWalkTest.R index a0462c8..7ef24b5 100644 --- a/tests/testthat/test-RandomWalkTest.R +++ b/tests/testthat/test-RandomWalkTest.R @@ -1,5 +1,3 @@ -context("s2dv::RandomWalkTest tests") - ############################################## #dat1 set.seed(1) diff --git a/tests/testthat/test-RatioPredictableComponents.R b/tests/testthat/test-RatioPredictableComponents.R index b6a0808..54609b5 100644 --- a/tests/testthat/test-RatioPredictableComponents.R +++ b/tests/testthat/test-RatioPredictableComponents.R @@ -1,5 +1,3 @@ -context("RatioPredictableComponents test") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-RatioRMS.R b/tests/testthat/test-RatioRMS.R index 11df46c..35bb651 100644 --- a/tests/testthat/test-RatioRMS.R +++ b/tests/testthat/test-RatioRMS.R @@ -1,5 +1,3 @@ -context("s2dv::RatioRMS tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-RatioSDRMS.R b/tests/testthat/test-RatioSDRMS.R index 3086c87..78143cc 100644 --- a/tests/testthat/test-RatioSDRMS.R +++ b/tests/testthat/test-RatioSDRMS.R @@ -1,5 +1,3 @@ -context("s2dv::RatioSDRMS tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-Regression.R b/tests/testthat/test-Regression.R index d0898bf..a94a864 100644 --- a/tests/testthat/test-Regression.R +++ b/tests/testthat/test-Regression.R @@ -1,5 +1,3 @@ -context("s2dv::Regression tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-Reorder.R b/tests/testthat/test-Reorder.R index b17259e..7401b2a 100644 --- a/tests/testthat/test-Reorder.R +++ b/tests/testthat/test-Reorder.R @@ -1,5 +1,3 @@ -context("s2dv::Reorder tests") - ############################################## # dat1 dat1 <- array(c(1:30), dim = c(dat = 1, sdate = 3, ftime = 2, lon = 5)) diff --git a/tests/testthat/test-ResidualCorr.R b/tests/testthat/test-ResidualCorr.R index 61c677e..f4b6a49 100644 --- a/tests/testthat/test-ResidualCorr.R +++ b/tests/testthat/test-ResidualCorr.R @@ -1,5 +1,3 @@ -context("s2dv::ResidualCorr tests") - ############################################## # dat1 diff --git a/tests/testthat/test-SPOD.R b/tests/testthat/test-SPOD.R index 8b56c72..91fe8cc 100644 --- a/tests/testthat/test-SPOD.R +++ b/tests/testthat/test-SPOD.R @@ -1,5 +1,3 @@ -context("s2dv::SPOD tests") - ############################################## lat <- seq(-90, 90, 10) lon <- seq(0, 360, 10) diff --git a/tests/testthat/test-Season.R b/tests/testthat/test-Season.R index f9bfc43..f33a962 100644 --- a/tests/testthat/test-Season.R +++ b/tests/testthat/test-Season.R @@ -1,5 +1,3 @@ -context("s2dv::Season tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-SignalNoiseRatio.R b/tests/testthat/test-SignalNoiseRatio.R index 9fc5ce3..be47492 100644 --- a/tests/testthat/test-SignalNoiseRatio.R +++ b/tests/testthat/test-SignalNoiseRatio.R @@ -1,6 +1,3 @@ - -context("SignalNoiseRatio test") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-Smoothing.R b/tests/testthat/test-Smoothing.R index ad3dcb9..51a956a 100644 --- a/tests/testthat/test-Smoothing.R +++ b/tests/testthat/test-Smoothing.R @@ -1,5 +1,3 @@ -context("s2dv::Smoothing test") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-Spectrum.R b/tests/testthat/test-Spectrum.R index 9c64259..721c9b1 100644 --- a/tests/testthat/test-Spectrum.R +++ b/tests/testthat/test-Spectrum.R @@ -1,5 +1,3 @@ -context("s2dv::Spectrum tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-Spread.R b/tests/testthat/test-Spread.R index d0d55cd..dab8744 100644 --- a/tests/testthat/test-Spread.R +++ b/tests/testthat/test-Spread.R @@ -1,5 +1,3 @@ -context("s2dv::Spread test") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-StatSeasAtlHurr.R b/tests/testthat/test-StatSeasAtlHurr.R index 82ef308..448eadf 100644 --- a/tests/testthat/test-StatSeasAtlHurr.R +++ b/tests/testthat/test-StatSeasAtlHurr.R @@ -1,5 +1,3 @@ -context("s2dv::StatSeaAtlHurr tests") - ############################################## # dat1 set.seed(1) diff --git a/tests/testthat/test-TPI.R b/tests/testthat/test-TPI.R index b663c40..bef5ef6 100644 --- a/tests/testthat/test-TPI.R +++ b/tests/testthat/test-TPI.R @@ -1,5 +1,3 @@ -context("s2dv::TPI tests") - ############################################## lat <- seq(-90, 90, 10) lon <- seq(0, 360, 10) diff --git a/tests/testthat/test-Trend.R b/tests/testthat/test-Trend.R index b47a202..385534b 100644 --- a/tests/testthat/test-Trend.R +++ b/tests/testthat/test-Trend.R @@ -1,5 +1,3 @@ -context("s2dv::Trend tests") - ############################################## # dat1 dat1 <- array(c(-5, -7, -10:10, 12, 11, 7, 16), diff --git a/tests/testthat/test-UltimateBrier.R b/tests/testthat/test-UltimateBrier.R index 6ce8866..28ccb79 100644 --- a/tests/testthat/test-UltimateBrier.R +++ b/tests/testthat/test-UltimateBrier.R @@ -1,5 +1,3 @@ -context("s2dv::UltimateBrier tests") - ############################################## # dat1 set.seed(1) -- GitLab From fa323427879dcd6d7b7b142f259b237d82d8c0ea Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 22 May 2023 09:33:21 +0200 Subject: [PATCH 27/64] Refine ncores --- R/CDORemap.R | 28 +++++++++++++++++++--------- man/CDORemap.Rd | 7 ++++++- 2 files changed, 25 insertions(+), 10 deletions(-) diff --git a/R/CDORemap.R b/R/CDORemap.R index f67c70f..4ea14fd 100644 --- a/R/CDORemap.R +++ b/R/CDORemap.R @@ -76,8 +76,9 @@ #'@param write_dir Path to the directory where to create the intermediate #' files for CDO to work. By default, the R session temporary directory is #' used (\code{tempdir()}). -#' -#'@param ncores Number of theats used for interpolation. +#'@param ncores An integer indicating the number of theads used for +#' interpolation (i.e., \code{-P} in cdo command.) The default value is NULL +#' and \code{-P} is not used. #' #'@return A list with the following components: #' \item{'data_array'}{The interpolated data array (if an input array @@ -568,10 +569,11 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, stop("Parameter 'write_dir' must point to an existing directory.") } # Check ncores - if (is.null(ncores)) { - ncores <- 1 - } else if (!is.integer(ncores) | ncores < 1) - stop("Parameter 'ncores' must be NULL or an integer equal or greater than 1") + if (!is.null(ncores)) { + if (!is.numeric(ncores) | any(ncores %% 1 != 0) | any(ncores < 0) | + length(ncores) > 1) { + stop("Parameter 'ncores' must be a positive integer.") + } } # if (!is.null(mask)) { # if (!is.numeric(mask) || !is.array(mask)) { @@ -823,9 +825,17 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, ',', format(lat_extremes[1], scientific = FALSE), ',', format(lat_extremes[2], scientific = FALSE), ' -') } - err <- try({ - system(paste0("cdo -P ", ncores," -s ", sellonlatbox, "remap", method, ",", grid, " ", tmp_file, " ", tmp_file2), ignore.stdout = T, ignore.stderr = T) - }) + if (is.null(ncores)) { + err <- try({ + system(paste0("cdo -s ", sellonlatbox, "remap", method, ",", grid, " ", + tmp_file, " ", tmp_file2), ignore.stdout = T, ignore.stderr = T) + }) + } else { + err <- try({ + system(paste0("cdo -P ", ncores," -s ", sellonlatbox, "remap", method, ",", + grid, " ", tmp_file, " ", tmp_file2), ignore.stdout = T, ignore.stderr = T) + }) + } file.remove(tmp_file) if (is(err, 'try-error') || err > 0) { stop("CDO remap failed. Possible problem: parameter 'grid'.") diff --git a/man/CDORemap.Rd b/man/CDORemap.Rd index 61f6101..d7eee21 100644 --- a/man/CDORemap.Rd +++ b/man/CDORemap.Rd @@ -13,7 +13,8 @@ CDORemap( avoid_writes = TRUE, crop = TRUE, force_remap = FALSE, - write_dir = tempdir() + write_dir = tempdir(), + ncores = NULL ) } \arguments{ @@ -85,6 +86,10 @@ is already on the target grid.} \item{write_dir}{Path to the directory where to create the intermediate files for CDO to work. By default, the R session temporary directory is used (\code{tempdir()}).} + +\item{ncores}{An integer indicating the number of theads used for +interpolation (i.e., \code{-P} in cdo command.) The default value is NULL +and \code{-P} is not used.} } \value{ A list with the following components: -- GitLab From a6929305e8d8da9c135d3a927b2f1f7e40149699 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 9 Jun 2023 16:16:39 +0200 Subject: [PATCH 28/64] Add warning for automatic detected grid type --- R/Load.R | 4 ++++ R/Utils.R | 4 ++++ man/Load.Rd | 4 ++++ tests/testthat/test-Load.R | 40 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 52 insertions(+) diff --git a/R/Load.R b/R/Load.R index cca99bf..47da2b3 100644 --- a/R/Load.R +++ b/R/Load.R @@ -395,6 +395,10 @@ #' If not specified and the selected output type is 'lon', 'lat' or 'lonlat', #' this parameter takes as default value the grid of the first experimental #' dataset, which is read automatically from the source files.\cr +#' Note that the auto-detected grid type is not guarenteed to be correct, and +#' it won't be correct if the netCDF file doesn't contain global domain. +#' Please check the warning carefully to ensure the detected grid type is +#' expected, or assign this parameter even regridding is not needed. #' The grid must be supported by 'cdo' tools. Now only supported: rNXxNY #' or tTRgrid.\cr #' Both rNXxNY and tRESgrid yield rectangular regular grids. rNXxNY yields diff --git a/R/Utils.R b/R/Utils.R index cb6eb34..adcded6 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -291,6 +291,10 @@ } else { grid_name <- paste0('t', .nlat2t(grid_lats), 'grid') } + if (is.null(work_piece[['grid']])) { + .warning(paste0("Detect the grid type to be '", grid_name, "'. ", + "If it is not expected, assign parameter 'grid' to avoid wrong result.")) + } } # If a common grid is requested, we will also calculate its size which we will use # later on. diff --git a/man/Load.Rd b/man/Load.Rd index 10c03f9..f91c315 100644 --- a/man/Load.Rd +++ b/man/Load.Rd @@ -273,6 +273,10 @@ interpolating to the specified grid.\cr If not specified and the selected output type is 'lon', 'lat' or 'lonlat', this parameter takes as default value the grid of the first experimental dataset, which is read automatically from the source files.\cr +Note that the auto-detected grid type is not guarenteed to be correct, and +it won't be correct if the netCDF file doesn't contain global domain. +Please check the warning carefully to ensure the detected grid type is +expected, or assign this parameter even regridding is not needed. The grid must be supported by 'cdo' tools. Now only supported: rNXxNY or tTRgrid.\cr Both rNXxNY and tRESgrid yield rectangular regular grids. rNXxNY yields diff --git a/tests/testthat/test-Load.R b/tests/testthat/test-Load.R index c87beac..5e2e723 100644 --- a/tests/testthat/test-Load.R +++ b/tests/testthat/test-Load.R @@ -176,5 +176,45 @@ c(rep(NA, 4), 101250, rep(NA, 5), 100940, NA), tolerance = 0.0001 ) +}) + +test_that("1-4.", { + +exp <- list(list( + name = "system5_m1", + path = file.path("/esarchive/exp/ecmwf/system5_m1/monthly_mean/$VAR_NAME$_f6h/$VAR_NAME$_$START_DATE$.nc") + )) + +suppressWarnings( +res <- Load( + var = "tas", + exp = exp, + obs = NULL, + sdates = c('19930201'), + output = "lonlat", + leadtimemin = 1, + leadtimemax = 1, + nmember = 2, + latmin = -90, #10, + latmax = 90, #12, + lonmin = 0, + lonmax = 359.9, + grid = 'r1296x640', #'t426grid', + dimnames = list(lon='longitude', lat='latitude', member='ensemble'), + nprocs = 1) +) +expect_equal( +dim(res$mod), +c(dataset = 1, member = 2, sdate = 1, ftime = 1, lat = 640, lon = 1296) +) +expect_equal( +as.vector(res$mod[1, 1, 1, 1, 100, 1:4]), +c(277.38, 277.38, 277.37, 277.37), +tolerance = 0.0001 +) +expect_equal( +any(is.na(res$mod)), +FALSE +) }) -- GitLab From 6b5e39cd38785382126926846dc56441d87d787c Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Tue, 20 Jun 2023 12:34:13 +0200 Subject: [PATCH 29/64] new functions --- R/MSE.R | 300 ++++++++++++++++++++++++++++++++++++ R/MSSS.R | 454 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 754 insertions(+) create mode 100644 R/MSE.R create mode 100644 R/MSSS.R diff --git a/R/MSE.R b/R/MSE.R new file mode 100644 index 0000000..1218904 --- /dev/null +++ b/R/MSE.R @@ -0,0 +1,300 @@ +#'Compute mean square error +#' +#'Compute the mean square error for an array of forecasts and an array of +#'observations. The MSEs are computed along time_dim, the dimension which +#'corresponds to the startdate dimension. If comp_dim is given, the MSEs are +#'computed only if obs along the comp_dim dimension are complete between +#'limits[1] and limits[2], i.e. there are no NAs between limits[1] and +#'limits[2]. This option can be activated if the user wishes to account only +#'for the forecasts for which the corresponding observations are available at +#'all leadtimes.\cr +#'The confidence interval is computed by the chi2 distribution.\cr +#' +#'@param exp A named numeric array of experimental data, with at least two +#' dimensions 'time_dim' and 'dat_dim'. It can also be a vector with the +#' same length as 'obs', then the vector will automatically be 'time_dim' and +#' 'dat_dim' will be 1. +#'@param obs A named numeric array of observational data, same dimensions as +#' parameter 'exp' except along dat_dim. It can also be a vector with the same +#' length as 'exp', then the vector will automatically be 'time_dim' and +#' 'dat_dim' will be 1. +#'@param time_dim A character string indicating the name of dimension along +#' which the correlations are computed. The default value is 'sdate'. +#'@param memb_dim A character string indicating the name of the member dimension +#' to compute the ensemble mean; it should be set to NULL if the parameter 'exp' +#' and 'ref' are already the ensemble mean. The default value is NULL. +#'@param dat_dim A character string indicating the name of member (nobs/nexp) +#' dimension. The default value is 'dataset'. +#'@param comp_dim A character string indicating the name of dimension along which +#' obs is taken into account only if it is complete. The default value +#' is NULL. +#'@param limits A vector of two integers indicating the range along comp_dim to +#' be completed. The default value is c(1, length(comp_dim dimension)). +#'@param conf A logical value indicating whether to retrieve the confidence +#' intervals or not. The default value is TRUE. +#'@param conf.lev A numeric indicating the confidence level for the +#' regression computation. The default value is 0.95. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' +#'@return +#'A list containing the numeric arrays with dimension:\cr +#' c(nexp, nobs, all other dimensions of exp except time_dim).\cr +#'nexp is the number of experiment (i.e., dat_dim in exp), and nobs is the +#'number of observation (i.e., dat_dim in obs).\cr +#'\item{$mse}{ +#' The mean square error. +#'} +#'\item{$conf.lower}{ +#' The lower confidence interval. Only present if \code{conf = TRUE}. +#'} +#'\item{$conf.upper}{ +#' The upper confidence interval. Only present if \code{conf = TRUE}. +#'} +#' +#'@examples +#'# Load sample data as in Load() example: +#' set.seed(1) +#' exp1 <- array(rnorm(120), dim = c(dataset = 3, sdate = 5, ftime = 2, lon = 1, lat = 4)) +#' set.seed(2) +#' obs1 <- array(rnorm(80), dim = c(dataset = 2, sdate = 5, ftime = 2, lon = 1, lat = 4)) +#' res1 <- MSE(exp1, obs1) +#' +#' exp2 <- array(rnorm(120), dim = c(dataset = 3, sdate = 5, ftime = 2, lon = 1, lat = 4, memb = 5)) +#' obs2 <- array(rnorm(80), dim = c(dataset = 2, sdate = 5, ftime = 2, lon = 1, lat = 4)) +#' res2 <- MSE(exp2, obs2, memb_dim = 'memb') +#' +#' # Renew example when Ano and Smoothing are ready +#' +#'@rdname MSE +#'@import multiApply +#'@importFrom ClimProjDiags Subset +#'@importFrom stats qchisq +#'@export +MSE <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, + dat_dim = 'dataset', comp_dim = NULL, limits = NULL, + conf = TRUE, conf.lev = 0.95, ncores = NULL) { + # Check inputs + ## exp and obs (1) + if (is.null(exp) | is.null(obs)) { + stop("Parameter 'exp' and 'obs' cannot be NULL.") + } + if (!is.numeric(exp) | !is.numeric(obs)) { + stop("Parameter 'exp' and 'obs' must be a numeric array.") + } + if (is.null(dim(exp)) & is.null(dim(obs))) { #is vector + if (length(exp) == length(obs)) { + exp <- array(exp, dim = c(length(exp), 1)) + names(dim(exp)) <- c(time_dim, dat_dim) + obs <- array(obs, dim = c(length(obs), 1)) + names(dim(obs)) <- c(time_dim, dat_dim) + } else { + stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", + "dimensions time_dim and dat_dim, or vector of same length.")) + } + } else if (is.null(dim(exp)) | is.null(dim(obs))) { + stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", + "dimensions time_dim and dat_dim, or vector of same length.")) + } + if(any(is.null(names(dim(exp))))| any(nchar(names(dim(exp))) == 0) | + any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { + stop("Parameter 'exp' and 'obs' must have dimension names.") + } + if(!all(names(dim(exp))[-which(names(dim(exp))==memb_dim)] %in% names(dim(obs))[-which(names(dim(exp))==memb_dim)]) | + !all(names(dim(obs))[-which(names(dim(exp))==memb_dim)] %in% names(dim(exp))[-which(names(dim(exp))==memb_dim)])) { + stop("Parameter 'exp' and 'obs' must have same dimension name.") + } + ## time_dim + if (!is.character(time_dim) | length(time_dim) > 1) { + stop("Parameter 'time_dim' must be a character string.") + } + if (!time_dim %in% names(dim(exp)) | !time_dim %in% names(dim(obs))) { + stop("Parameter 'time_dim' is not found in 'exp' or 'obs' dimension.") + } + ## memb_dim + if (!is.null(memb_dim)) { + if (!is.character(memb_dim) | length(memb_dim) > 1) { + stop("Parameter 'memb_dim' must be a character string.") + } + if (!memb_dim %in% names(dim(exp))) { + stop("Parameter 'memb_dim' is not found in 'exp' dimension.") + } + if (memb_dim %in% names(dim(obs))) { + if (identical(as.numeric(dim(obs)[memb_dim]), 1)) { + obs <- ClimProjDiags::Subset(x = obs, along = memb_dim, indices = 1, drop = 'selected') + } else { + stop("Not implemented for observations with members ('obs' can have 'memb_dim', ", + "but it should be of length = 1).") + } + } + } + ## dat_dim + if (!is.null(dat_dim)) { + if (!is.character(dat_dim) | length(dat_dim) > 1) { + stop("Parameter 'dat_dim' must be a character string or NULL.") + } + if (!dat_dim %in% names(dim(exp)) | !dat_dim %in% names(dim(obs))) { + stop("Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension.", + "Set it as NULL if there is no dataset dimension.") + } + } + ## comp_dim + if (!is.null(comp_dim)) { + if (!is.character(comp_dim) | length(comp_dim) > 1) { + stop("Parameter 'comp_dim' must be a character string.") + } + if (!comp_dim %in% names(dim(exp)) | !comp_dim %in% names(dim(obs))) { + stop("Parameter 'comp_dim' is not found in 'exp' or 'obs' dimension.") + } + } + ## limits + if (!is.null(limits)) { + if (is.null(comp_dim)) { + stop("Paramter 'comp_dim' cannot be NULL if 'limits' is assigned.") + } + if (!is.numeric(limits) | any(limits %% 1 != 0) | any(limits < 0) | + length(limits) != 2 | any(limits > dim(exp)[comp_dim])) { + stop(paste0("Parameter 'limits' must be a vector of two positive ", + "integers smaller than the length of paramter 'comp_dim'.")) + } + } + ## conf + if (!is.logical(conf) | length(conf) > 1) { + stop("Parameter 'conf' must be one logical value.") + } + ## conf.lev + if (!is.numeric(conf.lev) | conf.lev < 0 | conf.lev > 1 | length(conf.lev) > 1) { + stop("Parameter 'conf.lev' must be a numeric number between 0 and 1.") + } + ## ncores + if (!is.null(ncores)) { + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | + length(ncores) > 1) { + stop("Parameter 'ncores' must be a positive integer.") + } + } + ## exp and obs (2) + name_exp <- sort(names(dim(exp))) + name_obs <- sort(names(dim(obs))) + if (!is.null(memb_dim)) { + name_exp <- name_exp[-which(name_exp == memb_dim)] + } + if (!is.null(dat_dim)) { + name_exp <- name_exp[-which(name_exp == dat_dim)] + name_obs <- name_obs[-which(name_obs == dat_dim)] + } + if(!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + stop(paste0("Parameter 'exp' and 'obs' must have same length of ", + "all dimension except 'memb_dim' and 'dat_dim'.")) + } + + ############################### + ## Ensemble mean + if (!is.null(memb_dim)) { + exp <- MeanDims(exp, memb_dim, na.rm = T) + } + + ############################### + # Sort dimension + name_exp <- names(dim(exp)) + name_obs <- names(dim(obs)) + order_obs <- match(name_exp, name_obs) + obs <- Reorder(obs, order_obs) + + ############################### + # Calculate MSE + + # Remove data along comp_dim dim if there is at least one NA between limits + if (!is.null(comp_dim)) { + if (is.null(limits)) { + limits <- c(1, dim(obs)[comp_dim]) + } + pos <- which(names(dim(obs)) == comp_dim) + obs_sub <- Subset(obs, pos, list(limits[1]:limits[2])) + outrows <- is.na(MeanDims(obs_sub, pos, na.rm = FALSE)) + outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim]) + obs[which(outrows)] <- NA + } + + res <- Apply(list(exp, obs), + target_dims = list(c(time_dim, dat_dim), + c(time_dim, dat_dim)), + fun = .MSE, + time_dim = time_dim, dat_dim = dat_dim, + conf = conf, conf.lev = conf.lev, ncores_input = ncores, + ncores = ncores) + return(res) +} + +.MSE <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', + conf = TRUE, conf.lev = 0.95, ncores_input = NULL) { + if (is.null(dat_dim)) { + # exp: [sdate] + # obs: [sdate] + nexp <- 1 + nobs <- 1 + ini_dims <- dim(exp) + dim(exp) <- c(ini_dims, dat_dim = 1) + dim(obs) <- c(ini_dims, dat_dim = 1) + } else { + # exp: [sdate, dat_exp] + # obs: [sdate, dat_obs] + nexp <- as.numeric(dim(exp)[2]) + nobs <- as.numeric(dim(obs)[2]) + } + + dif <- array(dim = c(dim(exp)[1], nexp = nexp, nobs = nobs)) + chi <- array(dim = c(nexp = nexp, nobs = nobs)) + + if (conf) { + conflow <- (1 - conf.lev) / 2 + confhigh <- 1 - conflow + conf.lower <- array(dim = c(nexp = nexp, nobs = nobs)) + conf.upper <- array(dim = c(nexp = nexp, nobs = nobs)) + } + + # dif + for (i in 1:nobs) { + dif[, , i] <- sapply(1:nexp, function(x) {exp[, x] - obs[, i]}) + } + + mse <- apply(dif^2, c(2, 3), mean, na.rm = TRUE) #array(dim = c(_exp, nobs)) + + if (conf) { + #eno <- Eno(dif, 1) #count effective sample along sdate. dim = c(nexp, nobs) + eno <- Eno(dif, time_dim, ncores = ncores_input) #change to this line when Eno() is done + + # conf.lower + chi <- sapply(1:nobs, function(i) { + qchisq(confhigh, eno[, i] - 1) + }) + conf.lower <- (eno * mse ** 2 / chi) ** 0.5 + + # conf.upper + chi <- sapply(1:nobs, function(i) { + qchisq(conflow, eno[, i] - 1) + }) + conf.upper <- (eno * mse ** 2 / chi) ** 0.5 + } + + ################################### + # Remove nexp and nobs if dat_dim = NULL + if (is.null(dat_dim)) { + dim(mse) <- NULL + if (conf) { + dim(conf.lower) <- NULL + dim(conf.upper) <- NULL + } + } + + ################################### + + if (conf) { + res <- list(mse = mse, conf.lower = conf.lower, conf.upper = conf.upper) + } else { + res <- list(mse = mse) + } + + return(res) + +} diff --git a/R/MSSS.R b/R/MSSS.R new file mode 100644 index 0000000..b784027 --- /dev/null +++ b/R/MSSS.R @@ -0,0 +1,454 @@ +#'Compute mean square error skill score +#' +#'Compute the mean square error skill score (MSSS) between an array of +#'forecast 'exp' and an array of observation 'obs'. The two arrays should +#'have the same dimensions except along dat_dim, where the length can be +#'different, with the number of experiments/models (nexp) and the number of +#'observational datasets (nobs).\cr +#'MSSS computes the mean square error skill score of each jexp in 1:nexp +#'against each job in 1:nobs which gives nexp * nobs MSSS for each grid point +#'of the array.\cr +#'The MSSS are computed along the time_dim dimension which should correspond +#'to the start date dimension.\cr +#'The p-value and significance test are optionally provided by an one-sided +#'Fisher test or Random Walk test.\cr +#' +#'@param exp A named numeric array of experimental data which contains at least +#' two dimensions for dat_dim and time_dim. It can also be a vector with the +#' same length as 'obs', then the vector will automatically be 'time_dim' and +#' 'dat_dim' will be 1. +#'@param obs A named numeric array of observational data which contains at least +#' two dimensions for dat_dim and time_dim. The dimensions should be the same +#' as paramter 'exp' except the length of 'dat_dim' dimension. The order of +#' dimension can be different. It can also be a vector with the same length as +#' 'exp', then the vector will automatically be 'time_dim' and 'dat_dim' will +#' be 1. +#'@param ref A named numerical array of the reference forecast data with at +#' least time dimension, or 0 (typical climatological forecast) or 1 +#' (normalized climatological forecast). If it is an array, the dimensions must +#' be the same as 'exp' except 'memb_dim' and 'dat_dim'. If there is only one +#' reference dataset, it should not have dataset dimension. If there is +#' corresponding reference for each experiment, the dataset dimension must +#' have the same length as in 'exp'. If 'ref' is NULL, the typical +#' climatological forecast is used as reference forecast (equivalant to 0.) +#' The default value is NULL. +#'@param dat_dim A character string indicating the name of dataset (nobs/nexp) +#' dimension. The default value is NULL. +#'@param time_dim A character string indicating the name of dimension along +#' which the MSSS are computed. The default value is 'sdate'. +#'@param memb_dim A character string indicating the name of the member dimension +#' to compute the ensemble mean; it should be set to NULL if the parameter 'exp' +#' and 'ref' are already the ensemble mean. The default value is NULL. +#'@param pval A logical value indicating whether to compute or not the p-value +#' of the test Ho: MSSS = 0. The default value is TRUE. +#'@param sign A logical value indicating whether to compute or not the +#' statistical significance of the test Ho: MSSS = 0. 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 sig_method A character string indicating the significance method. The +#' options are "one-sided Fisher" (default) and "Random Walk". +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' +#'@return +#'A list containing the numeric arrays with dimension:\cr +#' c(nexp, nobs, all other dimensions of exp except time_dim).\cr +#'nexp is the number of experiment (i.e., dat_dim in exp), and nobs is the +#'number of observation (i.e., dat_dim in obs). If dat_dim is NULL, nexp and +#'nobs are omitted.\cr +#'\item{$msss}{ +#' A numerical array of the mean square error skill score. +#'} +#'\item{$p.val}{ +#' A numerical array of the p-value with the same dimensions as $msss. +#' Only present if \code{pval = TRUE}. +#'} +#'\item{sign}{ +#' A logical array of the statistical significance of the MSSS with the same +#' dimensions as $msss. Only present if \code{sign = TRUE}. +#'} +#' +#'@examples +#' set.seed(1) +#' exp <- array(rnorm(30), dim = c(dataset = 2, time = 3, memb = 5)) +#' set.seed(2) +#' obs <- array(rnorm(15), dim = c(time = 3, dataset = 1)) +#' res <- MSSS(exp, obs, time_dim = 'time', dat_dim = 'dataset', memb_dim = 'memb') +#' +#'@rdname MSSS +#'@import multiApply +#'@importFrom stats pf +#'@export +MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, + memb_dim = NULL, pval = TRUE, sign = FALSE, alpha = 0.05, + sig_method = 'one-sided Fisher', ncores = NULL) { + + # Check inputs + ## exp, obs, and ref (1) + if (is.null(exp) | is.null(obs)) { + stop("Parameter 'exp' and 'obs' cannot be NULL.") + } + if (!is.numeric(exp) | !is.numeric(obs)) { + stop("Parameter 'exp' and 'obs' must be a numeric array.") + } + if (is.null(dim(exp)) & is.null(dim(obs))) { #is vector + if (length(exp) == length(obs)) { + exp <- array(exp, dim = c(length(exp), 1)) + names(dim(exp)) <- c(time_dim, dat_dim) + obs <- array(obs, dim = c(length(obs), 1)) + names(dim(obs)) <- c(time_dim, dat_dim) + } else { + stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", + "dimensions time_dim and dat_dim, or vector of same length.")) + } + } else if (is.null(dim(exp)) | is.null(dim(obs))) { + stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", + "dimensions time_dim and dat_dim, or vector of same length.")) + } + if(any(is.null(names(dim(exp))))| any(nchar(names(dim(exp))) == 0) | + any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { + stop("Parameter 'exp' and 'obs' must have dimension names.") + } + if(!all(names(dim(exp))[-which(names(dim(exp))==memb_dim)] %in% names(dim(obs))[-which(names(dim(exp))==memb_dim)]) | + !all(names(dim(obs))[-which(names(dim(exp))==memb_dim)] %in% names(dim(exp))[-which(names(dim(exp))==memb_dim)])) { + stop("Parameter 'exp' and 'obs' must have same dimension name.") + } + if (!is.null(ref)) { + if (!is.numeric(ref)) { + stop("Parameter 'ref' must be numeric.") + } + if (is.array(ref)) { + if (any(is.null(names(dim(ref))))| any(nchar(names(dim(ref))) == 0)) { + stop("Parameter 'ref' must have dimension names.") + } + } else if (length(ref) != 1 | any(!ref %in% c(0, 1))) { + stop("Parameter 'ref' must be a numeric array or number 0 or 1.") + } + } + + ## time_dim + if (!is.character(time_dim) | length(time_dim) > 1) { + stop("Parameter 'time_dim' must be a character string.") + } + if (!time_dim %in% names(dim(exp)) | !time_dim %in% names(dim(obs))) { + stop("Parameter 'time_dim' is not found in 'exp' or 'obs' dimension.") + } + ## dat_dim + if (!is.null(dat_dim)) { + if (!is.character(dat_dim) | length(dat_dim) > 1) { + stop("Parameter 'dat_dim' must be a character string or NULL.") + } + if (!dat_dim %in% names(dim(exp)) | !dat_dim %in% names(dim(obs))) { + stop("Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension.", + " Set it as NULL if there is no dataset dimension.") + } + } + ## memb_dim + if (!is.null(memb_dim)) { + if (!is.character(memb_dim) | length(memb_dim) > 1) { + stop("Parameter 'memb_dim' must be a character string.") + } + if (!memb_dim %in% names(dim(exp))) { + stop("Parameter 'memb_dim' is not found in 'exp' dimension.") + } + if (memb_dim %in% names(dim(obs))) { + if (identical(as.numeric(dim(obs)[memb_dim]), 1)) { + obs <- ClimProjDiags::Subset(x = obs, along = memb_dim, indices = 1, drop = 'selected') + } else { + stop("Not implemented for observations with members ('obs' can have 'memb_dim', ", + "but it should be of length = 1).") + } + } + } + ## pval + if (!is.logical(pval) | length(pval) > 1) { + stop("Parameter 'pval' must be one logical value.") + } + ## sign + if (!is.logical(sign) | length(sign) > 1) { + stop("Parameter 'sign' must be one logical value.") + } + ## alpha + if (!is.numeric(alpha) | length(alpha) > 1) { + stop("Parameter 'alpha' must be one numeric value.") + } + ## sig_method + if (length(sig_method) != 1 | !any(sig_method %in% c('one-sided Fisher', 'Random Walk'))) { + stop("Parameter 'sig_method' must be one of 'one-sided Fisher' or 'Random Walk'.") + } + if (sig_method == "Random Walk" & pval == T) { + warning("p-value cannot be calculated by significance method 'Random Walk'.") + pval <- FALSE + } + ## ncores + if (!is.null(ncores)) { + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | + length(ncores) > 1) { + stop("Parameter 'ncores' must be a positive integer.") + } + } + ## exp and obs (2) + name_exp <- sort(names(dim(exp))) + name_obs <- sort(names(dim(obs))) + if (!is.null(memb_dim)) { + name_exp <- name_exp[-which(name_exp == memb_dim)] + name_obs <- name_obs[-which(name_obs == memb_dim)] + } + if (!is.null(dat_dim)) { + name_exp <- name_exp[-which(name_exp == dat_dim)] + name_obs <- name_obs[-which(name_obs == dat_dim)] + } + if(!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + stop(paste0("Parameter 'exp' and 'obs' must have same length of ", + "all dimension except 'memb_dim' and 'dat_dim'.")) + } + + ############################### + # Create ref array if needed + if (is.null(ref)) ref <- 0 + if (!is.array(ref)) { + ref <- array(data = ref, dim = dim(exp)) + } + + if (!is.null(ref)) { + name_ref <- sort(names(dim(ref))) + if (!is.null(memb_dim) && memb_dim %in% name_ref) { + name_ref <- name_ref[-which(name_ref == memb_dim)] + } + if (!is.null(dat_dim)) { + if (dat_dim %in% name_ref) { + if (!identical(dim(exp)[dat_dim], dim(ref)[dat_dim])) { + stop(paste0("If parameter 'ref' has dataset dimension, it must be ", + "equal to dataset dimension of 'exp'.")) + } + name_ref <- name_ref[-which(name_ref == dat_dim)] + } + } + if (!identical(length(name_exp), length(name_ref)) | + !identical(dim(exp)[name_exp], dim(ref)[name_ref])) { + stop(paste0("Parameter 'exp' and 'ref' must have the same length of ", + "all dimensions except 'memb_dim' and 'dat_dim' if there is ", + "only one reference dataset.")) + } + } + + if (dim(exp)[time_dim] <= 2) { + stop("The length of time_dim must be more than 2 to compute MSSS.") + } + + ############################### + # # Sort dimension + # name_exp <- names(dim(exp)) + # name_obs <- names(dim(obs)) + # order_obs <- match(name_exp, name_obs) + # obs <- Reorder(obs, order_obs) + + ############################### + ## Ensemble mean + if (!is.null(memb_dim)) { + exp <- MeanDims(exp, memb_dim, na.rm = T) + if (!is.null(ref) & memb_dim %in% names(dim(ref))) { + ref <- MeanDims(ref, memb_dim, na.rm = T) + } + } + + ############################### + # Calculate MSSS + + # if (!is.null(ref)) { # use "ref" as reference forecast + # if (!is.null(dat_dim) && dat_dim %in% names(dim(ref))) { + # target_dims_ref <- c(time_dim, dat_dim) + # } else { + # target_dims_ref <- c(time_dim) + # } + # data <- list(exp = exp, obs = obs, ref = ref) + # target_dims = list(exp = c(time_dim, dat_dim), + # obs = c(time_dim, dat_dim), + # ref = target_dims_ref) + # } else { + # data <- list(exp = exp, obs = obs) + # target_dims = list(exp = c(time_dim, dat_dim), + # obs = c(time_dim, dat_dim)) + # } + data <- list(exp = exp, obs = obs, ref = ref) + if (!is.null(dat_dim)) { + if (dat_dim %in% names(dim(ref))) { + target_dims <- list(exp = c(time_dim, dat_dim), + obs = c(time_dim, dat_dim), + ref = c(time_dim, dat_dim)) + } else { + target_dims <- list(exp = c(time_dim, dat_dim), + obs = c(time_dim, dat_dim), + ref = c(time_dim)) + } + } else { + target_dims <- list(exp = time_dim, obs = time_dim, ref = time_dim) + } + + res <- Apply(data, + target_dims = target_dims, + fun = .MSSS, + time_dim = time_dim, dat_dim = dat_dim, + pval = pval, sign = sign, alpha = alpha, + sig_method = sig_method, + ncores = ncores) + + return(res) +} + +.MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = 'dataset', pval = TRUE, + sign = FALSE, alpha = 0.05, sig_method = 'one-sided Fisher') { + # exp: [sdate, (dat)] + # obs: [sdate, (dat)] + # ref: [sdate, (dat)] or NULL + + if (is.null(ref)) { + ref <- array(data = 0, dim = dim(obs)) + } else if (identical(ref, 0) | identical(ref, 1)) { + ref <- array(ref, dim = dim(exp)) + } + + if (is.null(dat_dim)) { + # exp: [sdate] + # obs: [sdate] + nexp <- 1 + nobs <- 1 + nref <- 1 + # Add dat dim back temporarily + dim(exp) <- c(dim(exp), dat = 1) + dim(obs) <- c(dim(obs), dat = 1) + dim(ref) <- c(dim(ref), dat = 1) + + } else { + # exp: [sdate, dat_exp] + # obs: [sdate, dat_obs] + nexp <- as.numeric(dim(exp)[2]) + nobs <- as.numeric(dim(obs)[2]) + if (dat_dim %in% names(dim(ref))) { + nref <- as.numeric(dim(ref)[2]) + } else { + dim(ref) <- c(dim(ref), dat = 1) + nref <- 1 + } + } + + nsdate <- as.numeric(dim(exp)[1]) + + # MSE of forecast + dif1 <- array(dim = c(nsdate, nexp, nobs)) + names(dim(dif1)) <- c(time_dim, 'nexp', 'nobs') + + for (i in 1:nobs) { + dif1[, , i] <- sapply(1:nexp, function(x) {exp[, x] - obs[, i]}) + } + + mse_exp <- apply(dif1^2, c(2, 3), mean, na.rm = TRUE) #array(dim = c(nexp, nobs)) + + # MSE of reference + # if (!is.null(ref)) { + dif2 <- array(dim = c(nsdate, nref, nobs)) + names(dim(dif2)) <- c(time_dim, 'nexp', 'nobs') + for (i in 1:nobs) { + dif2[, , i] <- sapply(1:nref, function(x) {ref[, x] - obs[, i]}) + } + mse_ref <- apply(dif2^2, c(2, 3), mean, na.rm = TRUE) #array(dim = c(nref, nobs)) + if (nexp != nref) { + # expand mse_ref to nexp (nref is 1) + mse_ref <- array(mse_ref, dim = c(nobs = nobs, nexp = nexp)) + mse_ref <- Reorder(mse_ref, c(2, 1)) + } + # } else { + # mse_ref <- array(colMeans(obs^2, na.rm = TRUE)^0.5, dim = c(nobs = nobs, nexp = nexp)) + ## mse_ref[which(abs(mse_ref) <= (max(abs(mse_ref), na.rm = TRUE) / 1000))] <- max(abs( + ## mse_ref), na.rm = TRUE) / 1000 + # mse_ref <- Reorder(mse_ref, c(2, 1)) + # #mse_ref above: [nexp, nobs] + # } + + msss <- 1 - mse_exp / mse_ref + + ################################################# + + # if (conf) { + # conflow <- (1 - conf.lev) / 2 + # confhigh <- 1 - conflow + # conf_low <- array(dim = c(nexp = nexp, nobs = nobs)) + # conf_high <- array(dim = c(nexp = nexp, nobs = nobs)) + # } + + if (sig_method == 'one-sided Fisher') { + p_val <- array(dim = c(nexp = nexp, nobs = nobs)) + ## pval and sign + if (pval || sign) { + eno1 <- Eno(dif1, time_dim) + if (is.null(ref)) { + eno2 <- Eno(obs, time_dim) + eno2 <- array(eno2, dim = c(nobs = nobs, nexp = nexp)) + eno2 <- Reorder(eno2, c(2, 1)) + } else { + eno2 <- Eno(dif2, time_dim) + if (nref != nexp) { + eno2 <- array(eno2, dim = c(nobs = nobs, nexp = nexp)) + eno2 <- Reorder(eno2, c(2, 1)) + } + } + + F.stat <- (eno2 * mse_ref^2 / (eno2 - 1)) / ((eno1 * mse_exp^2 / (eno1- 1))) + tmp <- !is.na(eno1) & !is.na(eno2) & eno1 > 2 & eno2 > 2 + p_val <- 1 - pf(F.stat, eno1 - 1, eno2 - 1) + if (sign) signif <- p_val <= alpha + # If there isn't enough valid data, return NA + p_val[which(!tmp)] <- NA + if (sign) signif[which(!tmp)] <- NA + + # change not enough valid data msss to NA + msss[which(!tmp)] <- NA + } + + } else if (sig_method == "Random Walk") { + signif <- array(dim = c(nexp = nexp, nobs = nobs)) + p_val <- array(dim = c(nexp = nexp, nobs = nobs)) + for (i in 1:nexp) { + for (j in 1:nobs) { + + # Error + error_exp <- array(data = abs(exp[, i] - obs[, j]), dim = c(time = nsdate)) + if (nref == nexp) { + error_ref <- array(data = abs(ref[, i] - obs[, j]), dim = c(time = nsdate)) + } else { + # nref = 1 + error_ref <- array(data = abs(ref - obs[, j]), dim = c(time = nsdate)) + } + # signif[i, j] <- .RandomWalkTest(skill_A = error_exp, skill_B = error_ref)$sign + aux <- s2dv:::.RandomWalkTest(skill_A = error_exp, skill_B = error_ref, + test.type = 'two.sided', + pval = TRUE, sign = TRUE, alpha = alpha) + signif[i, j] <- aux$sign + p_val[i, j] <- aux$p.val + } + } + } + + ################################### + # Remove extra dimensions if dat_dim = NULL + if (is.null(dat_dim)) { + dim(msss) <- NULL + dim(p_val) <- NULL + if (sign) dim(signif) <- NULL + } + ################################### + + # output + res <- list(msss = msss) + if (pval) { + p.val <- list(p.val = p_val) + res <- c(res, p.val) + } + if (sign) { + signif <- list(sign = signif) + res <- c(res, signif) + } + + return(res) +} -- GitLab From ab88f80c2ed0d9827abb04c0bc4e11c78b876232 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Tue, 20 Jun 2023 12:50:39 +0200 Subject: [PATCH 30/64] included memb_dim --- R/RMS.R | 54 ++++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 46 insertions(+), 8 deletions(-) diff --git a/R/RMS.R b/R/RMS.R index 164167f..9f011ec 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -20,6 +20,9 @@ #' 'dat_dim' will be 1. #'@param time_dim A character string indicating the name of dimension along #' which the correlations are computed. The default value is 'sdate'. +#'@param memb_dim A character string indicating the name of the member dimension +#' to compute the ensemble mean; it should be set to NULL if the parameter 'exp' +#' and 'ref' are already the ensemble mean. The default value is NULL. #'@param dat_dim A character string indicating the name of dataset or member #' (nobs/nexp) dimension. The datasets of exp and obs will be paired and #' computed RMS for each pair. The default value is NULL. @@ -60,15 +63,23 @@ #' set.seed(2) #' na <- floor(runif(10, min = 1, max = 80)) #' obs1[na] <- NA -#' res <- RMS(exp1, obs1, comp_dim = 'ftime', dat_dim = 'dat') +#' res1 <- RMS(exp1, obs1, comp_dim = 'ftime', dat_dim = 'dat') #' # Renew example when Ano and Smoothing are ready #' +#' exp2 <- array(rnorm(120), dim = c(sdate = 5, ftime = 2, lon = 1, lat = 4)) +#' obs2 <- array(rnorm(80), dim = c(sdate = 5, ftime = 2, lon = 1, lat = 4)) +#' res2 <- RMS(exp2, obs2, comp_dim = 'ftime') +#' +#' exp3 <- array(rnorm(120), dim = c(sdate = 5, ftime = 2, lon = 1, lat = 4, memb = 4)) +#' obs3 <- array(rnorm(80), dim = c(sdate = 5, ftime = 2, lon = 1, lat = 4)) +#' res3 <- RMS(exp3, obs3, comp_dim = 'ftime', memb_dim = 'memb') +#' #'@import multiApply #'@importFrom ClimProjDiags Subset #'@importFrom stats qchisq #'@export -RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, comp_dim = NULL, - limits = NULL, conf = TRUE, alpha = 0.05, ncores = NULL) { +RMS <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, dat_dim = NULL, + comp_dim = NULL, limits = NULL, conf = TRUE, alpha = 0.05, ncores = NULL) { # Check inputs ## exp and obs (1) if (is.null(exp) | is.null(obs)) { @@ -95,8 +106,8 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, comp_dim = NULL, any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } - if(!all(names(dim(exp)) %in% names(dim(obs))) | - !all(names(dim(obs)) %in% names(dim(exp)))) { + if(!all(names(dim(exp))[-which(names(dim(exp))==memb_dim)] %in% names(dim(obs))[-which(names(dim(exp))==memb_dim)]) | + !all(names(dim(obs))[-which(names(dim(exp))==memb_dim)] %in% names(dim(exp))[-which(names(dim(exp))==memb_dim)])) { stop("Parameter 'exp' and 'obs' must have same dimension name") } ## time_dim @@ -106,6 +117,23 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, comp_dim = NULL, if (!time_dim %in% names(dim(exp)) | !time_dim %in% names(dim(obs))) { stop("Parameter 'time_dim' is not found in 'exp' or 'obs' dimension.") } + ## memb_dim + if (!is.null(memb_dim)) { + if (!is.character(memb_dim) | length(memb_dim) > 1) { + stop("Parameter 'memb_dim' must be a character string.") + } + if (!memb_dim %in% names(dim(exp))) { + stop("Parameter 'memb_dim' is not found in 'exp' dimension.") + } + if (memb_dim %in% names(dim(obs))) { + if (identical(as.numeric(dim(obs)[memb_dim]), 1)) { + obs <- ClimProjDiags::Subset(x = obs, along = memb_dim, indices = 1, drop = 'selected') + } else { + stop("Not implemented for observations with members ('obs' can have 'memb_dim', ", + "but it should be of length = 1).") + } + } + } ## dat_dim if (!is.null(dat_dim)) { if (!is.character(dat_dim) | length(dat_dim) > 1) { @@ -151,22 +179,32 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, comp_dim = NULL, stop("Parameter 'ncores' must be a positive integer.") } } + ## exp and obs (2) name_exp <- sort(names(dim(exp))) name_obs <- sort(names(dim(obs))) + if (!is.null(memb_dim)) { + name_exp <- name_exp[-which(name_exp == memb_dim)] + name_obs <- name_obs[-which(name_obs == memb_dim)] + } if (!is.null(dat_dim)) { name_exp <- name_exp[-which(name_exp == dat_dim)] name_obs <- name_obs[-which(name_obs == dat_dim)] } if(!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { stop(paste0("Parameter 'exp' and 'obs' must have same length of ", - "all dimension except 'dat_dim'.")) + "all dimension except 'dat_dim' and 'memb_dim'.")) } if (dim(exp)[time_dim] < 2) { stop("The length of time_dim must be at least 2 to compute RMS.") } - - + + ############################### + ## Ensemble mean + if (!is.null(memb_dim)) { + exp <- MeanDims(exp, memb_dim, na.rm = T) + } + ############################### # Sort dimension name_exp <- names(dim(exp)) -- GitLab From f9fa3819f493d77664a0cb713b7e05f148803f00 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Tue, 20 Jun 2023 12:51:37 +0200 Subject: [PATCH 31/64] fixed place to create ref-array if ref is provided as a number --- R/RMSSS.R | 53 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 31 insertions(+), 22 deletions(-) diff --git a/R/RMSSS.R b/R/RMSSS.R index cf45fa6..00ccc21 100644 --- a/R/RMSSS.R +++ b/R/RMSSS.R @@ -27,7 +27,7 @@ #' reference dataset, it should not have dataset dimension. If there is #' corresponding reference for each experiment, the dataset dimension must #' have the same length as in 'exp'. If 'ref' is NULL, the typical -#' climatological forecast is used as reference forecast (equivelant to 0.) +#' climatological forecast is used as reference forecast (equivalent to 0.) #' The default value is NULL. #'@param dat_dim A character string indicating the name of dataset (nobs/nexp) #' dimension. The default value is NULL. @@ -68,10 +68,18 @@ #' #'@examples #' set.seed(1) -#' exp <- array(rnorm(30), dim = c(dataset = 2, time = 3, memb = 5)) +#' exp1 <- array(rnorm(30), dim = c(dataset = 2, time = 3, memb = 5)) #' set.seed(2) -#' obs <- array(rnorm(15), dim = c(time = 3, memb = 5, dataset = 1)) -#' res <- RMSSS(exp, obs, time_dim = 'time', dat_dim = 'dataset') +#' obs1 <- array(rnorm(15), dim = c(time = 3, memb = 5, dataset = 1)) +#' res1 <- RMSSS(exp1, obs1, time_dim = 'time', dat_dim = 'dataset') +#' +#' exp2 <- array(rnorm(30), dim = c(lat = 2, time = 3, memb = 5)) +#' obs2 <- array(rnorm(15), dim = c(time = 3, lat = 2)) +#' res2 <- RMSSS(exp2, obs2, time_dim = 'time', memb_dim = 'memb') +#' +#' exp3 <- array(rnorm(30), dim = c(lat = 2, time = 3)) +#' obs3 <- array(rnorm(15), dim = c(time = 3, lat = 2)) +#' res3 <- RMSSS(exp3, obs3, time_dim = 'time') #' #'@rdname RMSSS #'@import multiApply @@ -107,8 +115,8 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, any(is.null(names(dim(obs)))) | any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } - if(!all(names(dim(exp)) %in% names(dim(obs))) | - !all(names(dim(obs)) %in% names(dim(exp)))) { + if(!all(names(dim(exp))[-which(names(dim(exp))==memb_dim)] %in% names(dim(obs))[-which(names(dim(exp))==memb_dim)]) | + !all(names(dim(obs))[-which(names(dim(exp))==memb_dim)] %in% names(dim(exp))[-which(names(dim(exp))==memb_dim)])) { stop("Parameter 'exp' and 'obs' must have same dimension name.") } if (!is.null(ref)) { @@ -190,6 +198,7 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, name_obs <- sort(names(dim(obs))) if (!is.null(memb_dim)) { name_exp <- name_exp[-which(name_exp == memb_dim)] + name_obs <- name_obs[-which(name_obs == memb_dim)] } if (!is.null(dat_dim)) { name_exp <- name_exp[-which(name_exp == dat_dim)] @@ -199,6 +208,14 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, stop(paste0("Parameter 'exp' and 'obs' must have same length of ", "all dimension except 'memb_dim' and 'dat_dim'.")) } + + ############################### + # Create ref array if needed + if (is.null(ref)) ref <- 0 + if (!is.array(ref)) { + ref <- array(data = ref, dim = dim(exp)) + } + if (!is.null(ref)) { name_ref <- sort(names(dim(ref))) if (!is.null(memb_dim) && memb_dim %in% name_ref) { @@ -224,23 +241,15 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, if (dim(exp)[time_dim] <= 2) { stop("The length of time_dim must be more than 2 to compute RMSSS.") } - - - ############################### -# # Sort dimension -# name_exp <- names(dim(exp)) -# name_obs <- names(dim(obs)) -# order_obs <- match(name_exp, name_obs) -# obs <- Reorder(obs, order_obs) - - + + ############################### - # Create ref array if needed - if (is.null(ref)) ref <- 0 - if (!is.array(ref)) { - ref <- array(data = ref, dim = dim(exp)) - } - + # # Sort dimension + # name_exp <- names(dim(exp)) + # name_obs <- names(dim(obs)) + # order_obs <- match(name_exp, name_obs) + # obs <- Reorder(obs, order_obs) + ############################### ## Ensemble mean if (!is.null(memb_dim)) { -- GitLab From 5c453082c8a9e63204d802ac2f4f4e21d2de867b Mon Sep 17 00:00:00 2001 From: eduzenli Date: Thu, 6 Jul 2023 18:05:56 +0200 Subject: [PATCH 32/64] removing NA first version --- R/RPS.R | 128 +++++++++++++++++++++----------------- R/RPSS.R | 184 ++++++++++++++++++++++++++++++------------------------- 2 files changed, 175 insertions(+), 137 deletions(-) diff --git a/R/RPS.R b/R/RPS.R index c5ff5ba..b641439 100644 --- a/R/RPS.R +++ b/R/RPS.R @@ -256,74 +256,92 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL # obs: [sdate, bin, (dat)] # Adjust dimensions to be [sdate, memb, dat] for both exp and obs - if (!is.null(memb_dim)) { - if (!memb_dim %in% names(dim(obs))) { - obs <- InsertDim(obs, posdim = 2, lendim = 1, name = memb_dim) - } - } - if (is.null(dat_dim)) { - nexp <- 1 - nobs <- 1 - dim(exp) <- c(dim(exp), nexp = nexp) - dim(obs) <- c(dim(obs), nobs = nobs) - if (!is.null(weights)) dim(weights) <- c(dim(weights), nexp = nexp) - } else { - nexp <- as.numeric(dim(exp)[dat_dim]) - nobs <- as.numeric(dim(obs)[dat_dim]) - } + # compute skill if there are less than 40% NAs in the data + f_NAs <- 0.4 + good_values <- !is.na(exp) & !as.numeric(is.na(obs)) + + if (f_NAs <= sum(good_values)/length(obs)) { - rps <- array(dim = c(dim(exp)[time_dim], nexp = nexp, nobs = nobs)) + ens_num <- dim(exp)[names(dim(exp))==memb_dim] + dim_names <- names(dim(exp)) + exp <- array(exp[good_values],dim=c(length(exp[good_values])/ens_num,ens_num)) + obs <- array(obs[good_values],dim=c(length(exp[good_values])/ens_num,ens_num)) + obs <- obs [,!apply(obs,2,function (x) all(is.na(x)))] + names(dim(exp)) <- dim_names - for (i in 1:nexp) { - for (j in 1:nobs) { - exp_data <- exp[ , , i] - obs_data <- obs[ , , j] - 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:2]) + if (!is.null(memb_dim)) { + if (!memb_dim %in% names(dim(obs))) { + obs <- InsertDim(obs, posdim = 2, lendim = 1, name = memb_dim) + } + } - # If the data inputs are forecast/observation, calculate probabilities - if (is.null(cat_dim)) { - if (!is.null(weights)) { - weights_data <- weights[ , , i] - if (is.null(dim(weights_data))) dim(weights_data) <- c(dim(weights)[1:2]) - } else { - weights_data <- weights - } + if (is.null(dat_dim)) { + nexp <- 1 + nobs <- 1 + dim(exp) <- c(dim(exp), nexp = nexp) + dim(obs) <- c(dim(obs), nobs = nobs) + if (!is.null(weights)) dim(weights) <- c(dim(weights), nexp = nexp) + } else { + nexp <- as.numeric(dim(exp)[dat_dim]) + nobs <- as.numeric(dim(obs)[dat_dim]) + } - exp_probs <- .GetProbs(data = exp_data, indices_for_quantiles = indices_for_clim, - prob_thresholds = prob_thresholds, weights = weights_data, cross.val = cross.val) - # exp_probs: [bin, sdate] - obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, - prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) - # obs_probs: [bin, sdate] + rps <- array(dim = c(dim(exp)[time_dim], nexp = nexp, nobs = nobs)) + indices_for_clim <- 1:nrow(exp) - } else { # inputs are probabilities already - exp_probs <- t(exp_data) - obs_probs <- t(obs_data) - } + for (i in 1:nexp) { + for (j in 1:nobs) { + exp_data <- exp[ , , i] + obs_data <- obs[ , , j] + + 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:2]) + + # If the data inputs are forecast/observation, calculate probabilities + if (is.null(cat_dim)) { + if (!is.null(weights)) { + weights_data <- weights[ , , i] + if (is.null(dim(weights_data))) dim(weights_data) <- c(dim(weights)[1:2]) + } else { + weights_data <- weights + } + exp_probs <- .GetProbs(data = exp_data, indices_for_quantiles = indices_for_clim, + prob_thresholds = prob_thresholds, weights = weights_data, cross.val = cross.val) + # exp_probs: [bin, sdate] + obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, + prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) + # obs_probs: [bin, sdate] + + } else { # inputs are probabilities already + exp_probs <- t(exp_data) + obs_probs <- t(obs_data) + } - probs_exp_cumsum <- apply(exp_probs, 2, cumsum) - probs_obs_cumsum <- apply(obs_probs, 2, cumsum) + probs_exp_cumsum <- apply(exp_probs, 2, cumsum) + probs_obs_cumsum <- apply(obs_probs, 2, cumsum) - # rps: [sdate, nexp, nobs] - rps[ , i, j] <- colSums((probs_exp_cumsum - probs_obs_cumsum)^2) - if (Fair) { # FairRPS - ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1)) [formula taken from SpecsVerification::EnsRps] - R <- dim(exp)[2] #memb - R_new <- Inf - adjustment <- (-1) / (R - 1) * probs_exp_cumsum * (1 - probs_exp_cumsum) - adjustment <- colSums(adjustment) - rps[ , i, j] <- rps[ , i, j] + adjustment + # rps: [sdate, nexp, nobs] + rps[ , i, j] <- colSums((probs_exp_cumsum - probs_obs_cumsum)^2) + if (Fair) { # FairRPS + ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1)) [formula taken from SpecsVerification::EnsRps] + R <- dim(exp)[2] #memb + R_new <- Inf + adjustment <- (-1) / (R - 1) * probs_exp_cumsum * (1 - probs_exp_cumsum) + adjustment <- colSums(adjustment) + rps[ , i, j] <- rps[ , i, j] + adjustment + } } } - } - if (is.null(dat_dim)) { - dim(rps) <- dim(exp)[time_dim] - } + if (is.null(dat_dim)) { + dim(rps) <- dim(exp)[time_dim] + } + } else { + rps<-NA + } return(rps) } diff --git a/R/RPSS.R b/R/RPSS.R index 6299eb8..c243997 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -382,106 +382,126 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', nobs <- as.numeric(dim(obs)[dat_dim]) } - # RPS of the forecast - rps_exp <- .RPS(exp = exp, obs = obs, time_dim = time_dim, memb_dim = memb_dim, + + # compute skill if there are less than 40% NAs in the data + f_NAs <- 0.4 + good_values <- !is.na(exp) & !as.numeric(is.na(obs)) + + if (f_NAs <= sum(good_values)/length(obs)) { + + ens_num <- dim(exp)[names(dim(exp))==memb_dim] + dim_names <- names(dim(exp)) + exp <- array(exp[good_values],dim=c(length(exp[good_values])/ens_num,ens_num)) + obs <- array(obs[good_values],dim=c(length(exp[good_values])/ens_num,ens_num)) + obs <- obs [,!apply(obs,2,function (x) all(is.na(x)))] + names(dim(exp)) <- dim_names + + # RPS of the forecast + rps_exp <- .RPS(exp = exp, obs = obs, time_dim = time_dim, memb_dim = memb_dim, cat_dim = cat_dim, dat_dim = dat_dim, prob_thresholds = prob_thresholds, indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_exp, cross.val = cross.val) - - # RPS of the reference forecast - if (is.null(ref)) { ## using climatology as reference forecast - if (!is.null(memb_dim)) { - if (!memb_dim %in% names(dim(obs))) { - obs <- InsertDim(obs, posdim = 2, lendim = 1, name = memb_dim) - } - } - if (is.null(dat_dim)) { - dim(obs) <- c(dim(obs), nobs = nobs) - } - rps_ref <- array(dim = c(dim(obs)[time_dim], nobs = nobs)) - for (j in 1:nobs) { - if (is.null(cat_dim)) { # calculate probs - obs_data <- obs[ , , j] - if (is.null(dim(obs_data))) dim(obs_data) <- c(dim(obs)[1:2]) - obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, - prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) - # obs_probs: [bin, sdate] - } else { - obs_probs <- t(obs[ , , j]) + + # RPS of the reference forecast + if (is.null(ref)) { ## using climatology as reference forecast + if (!is.null(memb_dim)) { + if (!memb_dim %in% names(dim(obs))) { + obs <- InsertDim(obs, posdim = 2, lendim = 1, name = memb_dim) + } } - clim_probs <- c(prob_thresholds[1], diff(prob_thresholds), - 1 - prob_thresholds[length(prob_thresholds)]) - clim_probs <- array(clim_probs, dim = dim(obs_probs)) - # clim_probs: [bin, sdate] + names(dim(obs))[1] <- time_dim + if (is.null(dat_dim)) { + dim(obs) <- c(dim(obs), nobs = nobs) + } + rps_ref <- array(dim = c(dim(obs)[time_dim], nobs = nobs)) - # Calculate RPS for each time step - probs_clim_cumsum <- apply(clim_probs, 2, cumsum) - probs_obs_cumsum <- apply(obs_probs, 2, cumsum) - rps_ref[ , j] <- colSums((probs_clim_cumsum - probs_obs_cumsum)^2) - # if (Fair) { # FairRPS - # ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1)) [formula taken from SpecsVerification::EnsRps] - # R <- dim(exp)[2] #memb - # R_new <- Inf - # adjustment <- (-1) / (R - 1) * probs_clim_cumsum * (1 - probs_clim_cumsum) - # adjustment <- apply(adjustment, 2, sum) - # rps_ref <- rps_ref + adjustment - # } + indices_for_clim <- 1:nrow(obs) + for (j in 1:nobs) { + if (is.null(cat_dim)) { # calculate probs + obs_data <- obs[ , , j] + if (is.null(dim(obs_data))) dim(obs_data) <- c(dim(obs)[1:2]) + obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, + prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) + # obs_probs: [bin, sdate] + } else { + obs_probs <- t(obs[ , , j]) + } + clim_probs <- c(prob_thresholds[1], diff(prob_thresholds), + 1 - prob_thresholds[length(prob_thresholds)]) + clim_probs <- array(clim_probs, dim = dim(obs_probs)) + # clim_probs: [bin, sdate] - } - if (is.null(dat_dim)) { - dim(rps_ref) <- dim(exp)[time_dim] - } + # Calculate RPS for each time step + probs_clim_cumsum <- apply(clim_probs, 2, cumsum) + probs_obs_cumsum <- apply(obs_probs, 2, cumsum) + rps_ref[ , j] <- colSums((probs_clim_cumsum - probs_obs_cumsum)^2) + # if (Fair) { # FairRPS + # ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1)) [formula taken from SpecsVerification::EnsRps] + # R <- dim(exp)[2] #memb + # R_new <- Inf + # adjustment <- (-1) / (R - 1) * probs_clim_cumsum * (1 - probs_clim_cumsum) + # adjustment <- apply(adjustment, 2, sum) + # rps_ref <- rps_ref + adjustment + # } - } else { # use "ref" as reference forecast - if (!is.null(dat_dim) && (!dat_dim %in% names(dim(ref)))) { - remove_dat_dim <- TRUE - ref <- InsertDim(ref, posdim = 3, lendim = 1, name = dat_dim) - if (!is.null(weights_ref)) { - weights_ref <- InsertDim(weights_ref, posdim = 3, lendim = 1, name = dat_dim) - } - } else { - remove_dat_dim <- FALSE - } + } + if (is.null(dat_dim)) { + dim(rps_ref) <- dim(exp)[time_dim] + } - rps_ref <- .RPS(exp = ref, obs = obs, time_dim = time_dim, memb_dim = memb_dim, - cat_dim = cat_dim, dat_dim = dat_dim, prob_thresholds = prob_thresholds, - indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_ref, - cross.val = cross.val) - if (!is.null(dat_dim)) { - if (isTRUE(remove_dat_dim)) { - dim(rps_ref) <- dim(rps_ref)[-2] + } else { # use "ref" as reference forecast + if (!is.null(dat_dim) && (!dat_dim %in% names(dim(ref)))) { + remove_dat_dim <- TRUE + ref <- InsertDim(ref, posdim = 3, lendim = 1, name = dat_dim) + if (!is.null(weights_ref)) { + weights_ref <- InsertDim(weights_ref, posdim = 3, lendim = 1, name = dat_dim) + } + } else { + remove_dat_dim <- FALSE + } + + rps_ref <- .RPS(exp = ref, obs = obs, time_dim = time_dim, memb_dim = memb_dim, + cat_dim = cat_dim, dat_dim = dat_dim, prob_thresholds = prob_thresholds, + indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_ref, + cross.val = cross.val) + if (!is.null(dat_dim)) { + if (isTRUE(remove_dat_dim)) { + dim(rps_ref) <- dim(rps_ref)[-2] + } } } - } - if (!is.null(dat_dim)) { + if (!is.null(dat_dim)) { - rps_exp_mean <- MeanDims(rps_exp, time_dim, na.rm = FALSE) - rps_ref_mean <- MeanDims(rps_ref, time_dim, na.rm = FALSE) - rpss <- array(dim = c(nexp = nexp, nobs = nobs)) - sign <- array(dim = c(nexp = nexp, nobs = nobs)) + rps_exp_mean <- MeanDims(rps_exp, time_dim, na.rm = FALSE) + rps_ref_mean <- MeanDims(rps_ref, time_dim, na.rm = FALSE) + rpss <- array(dim = c(nexp = nexp, nobs = nobs)) + sign <- array(dim = c(nexp = nexp, nobs = nobs)) - if (length(dim(rps_ref_mean)) == 1) { - for (i in 1:nexp) { - for (j in 1:nobs) { - rpss[i, j] <- 1 - rps_exp_mean[i, j] / rps_ref_mean[j] - sign[i, j] <- .RandomWalkTest(skill_A = rps_exp[, i, j], skill_B = rps_ref[, j])$sign + if (length(dim(rps_ref_mean)) == 1) { + for (i in 1:nexp) { + for (j in 1:nobs) { + rpss[i, j] <- 1 - rps_exp_mean[i, j] / rps_ref_mean[j] + sign[i, j] <- .RandomWalkTest(skill_A = rps_exp[, i, j], skill_B = rps_ref[, j])$sign + } } - } - } else { - for (i in 1:nexp) { - for (j in 1:nobs) { - rpss[i, j] <- 1 - rps_exp_mean[i, j] / rps_ref_mean[i, j] - sign[i, j] <- .RandomWalkTest(skill_A = rps_exp[, i, j], skill_B = rps_ref[, i, j])$sign + } else { + for (i in 1:nexp) { + for (j in 1:nobs) { + rpss[i, j] <- 1 - rps_exp_mean[i, j] / rps_ref_mean[i, j] + sign[i, j] <- .RandomWalkTest(skill_A = rps_exp[, i, j], skill_B = rps_ref[, i, j])$sign + } } } + } else { + rpss <- 1 - mean(rps_exp) / mean(rps_ref) + # Significance + sign <- .RandomWalkTest(skill_A = rps_exp, skill_B = rps_ref, sign = T, pval = F)$sign } } else { - rpss <- 1 - mean(rps_exp) / mean(rps_ref) - # Significance - sign <- .RandomWalkTest(skill_A = rps_exp, skill_B = rps_ref, sign = T, pval = F)$sign - } - + rpss <- NA + sign <- NA + } return(list(rpss = rpss, sign = sign)) } -- GitLab From c4aa1f9ebb07a3708a534d9ac46f8dcd66960499 Mon Sep 17 00:00:00 2001 From: eduzenli Date: Fri, 7 Jul 2023 18:29:27 +0200 Subject: [PATCH 33/64] f_NAs argument is added. Compatible with both memb_dim and cat_dim cases but only compatible with dat_dim = 1 --- R/RPS.R | 43 ++++++++++++++++++++++++++++++------------- R/RPSS.R | 44 +++++++++++++++++++++++++++++++------------- 2 files changed, 61 insertions(+), 26 deletions(-) diff --git a/R/RPS.R b/R/RPS.R index b641439..0e9abcc 100644 --- a/R/RPS.R +++ b/R/RPS.R @@ -53,6 +53,8 @@ #' The default value is FALSE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. +#'@param Lower limit for the fraction of the non-NA values. The function returns NA +#' if the fraction of non-NA values in the provided data is less than f_NAs. #' #'@return #'A numerical array of RPS with dimensions c(nexp, nobs, the rest dimensions of @@ -79,7 +81,7 @@ #'@export RPS <- function(exp, obs, 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 = NULL, cross.val = FALSE, ncores = NULL) { + Fair = FALSE, weights = NULL, cross.val = FALSE, ncores = NULL, f_NAs=1) { # Check inputs ## exp and obs (1) @@ -210,6 +212,10 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL stop("Parameter 'ncores' must be either NULL or a positive integer.") } } + ## f_NAs + if (!is.numeric(f_NAs) | !(f_NAs >= 0 & f_NAs <= 1)) { + stop("Parameter 'f_NAs' must be a numeric vector between 0 and 1.") + } ############################### @@ -235,7 +241,7 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL memb_dim = memb_dim, cat_dim = cat_dim, prob_thresholds = prob_thresholds, indices_for_clim = indices_for_clim, Fair = Fair, - weights = weights, cross.val = cross.val, ncores = ncores)$output1 + weights = weights, cross.val = cross.val, ncores = ncores, f_NAs=f_NAs)$output1 # Return only the mean RPS rps <- MeanDims(rps, time_dim, na.rm = FALSE) @@ -246,7 +252,7 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL .RPS <- function(exp, obs, 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 = NULL, cross.val = FALSE) { + Fair = FALSE, weights = NULL, cross.val = FALSE, f_NAs=1) { #--- if memb_dim: # exp: [sdate, memb, (dat)] # obs: [sdate, (memb), (dat)] @@ -257,19 +263,30 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL # Adjust dimensions to be [sdate, memb, dat] for both exp and obs - # compute skill if there are less than 40% NAs in the data - f_NAs <- 0.4 + # compute skill if the the percentage of the NAs are less than f_NAs good_values <- !is.na(exp) & !as.numeric(is.na(obs)) - - if (f_NAs <= sum(good_values)/length(obs)) { + good_values <- apply(good_values,1,all) - ens_num <- dim(exp)[names(dim(exp))==memb_dim] - dim_names <- names(dim(exp)) - exp <- array(exp[good_values],dim=c(length(exp[good_values])/ens_num,ens_num)) - obs <- array(obs[good_values],dim=c(length(exp[good_values])/ens_num,ens_num)) - obs <- obs [,!apply(obs,2,function (x) all(is.na(x)))] - names(dim(exp)) <- dim_names + if(!is.null(memb_dim)) { + frac <- sum(good_values)/length(obs) + col_num <- as.numeric(dim(exp)[memb_dim]) + } else { + frac <- sum(good_values)/nrow(obs) + col_num <- ncol(obs) + } + if (f_NAs <= frac) { + + dim_names_exp <- names(dim(exp)) + dim_names_obs <- names(dim(obs)) + exp <- array(exp[good_values,],dim=c(length(good_values[good_values]),col_num)) + if(!is.null(memb_dim)) { + obs <- array(obs[good_values],dim=c(length(good_values[good_values]))) + } else { + obs <- array(obs[good_values],dim=c(length(good_values[good_values]),col_num)) + } + names(dim(exp)) <- dim_names_exp + names(dim(obs)) <- dim_names_obs if (!is.null(memb_dim)) { if (!memb_dim %in% names(dim(obs))) { diff --git a/R/RPSS.R b/R/RPSS.R index c243997..6a9a9fd 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -66,6 +66,8 @@ #' The default value is FALSE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. +#'@param Lower limit for the fraction of the non-NA values. The function returns NA +#' if the fraction of non-NA values in the provided data is less than f_NAs. #' #'@return #'\item{$rpss}{ @@ -110,7 +112,7 @@ 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, ncores = NULL) { + cross.val = FALSE, ncores = NULL, f_NAs = 1) { # Check inputs ## exp, obs, and ref (1) @@ -308,6 +310,10 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', stop("Parameter 'ncores' must be either NULL or a positive integer.") } } + ## f_NAs + if (!is.numeric(f_NAs) | !(f_NAs >= 0 & f_NAs <= 1)) { + stop("Parameter 'f_NAs' must be a numeric vector between 0 and 1.") + } ############################### @@ -355,7 +361,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, - ncores = ncores) + ncores = ncores, + f_NAs=f_NAs) return(output) @@ -363,7 +370,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) { + Fair = FALSE, weights_exp = NULL, weights_ref = NULL, cross.val = FALSE, f_NAs=1) { #--- if memb_dim: # exp: [sdate, memb, (dat)] @@ -383,18 +390,30 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', } - # compute skill if there are less than 40% NAs in the data - f_NAs <- 0.4 + # compute skill if the the percentage of the NAs are less than f_NAs good_values <- !is.na(exp) & !as.numeric(is.na(obs)) + good_values <- apply(good_values,1,all) + + if(!is.null(memb_dim)) { + frac <- sum(good_values)/length(obs) + col_num <- as.numeric(dim(exp)[memb_dim]) + } else { + frac <- sum(good_values)/nrow(obs) + col_num <- ncol(obs) + } - if (f_NAs <= sum(good_values)/length(obs)) { + if (f_NAs <= frac) { - ens_num <- dim(exp)[names(dim(exp))==memb_dim] - dim_names <- names(dim(exp)) - exp <- array(exp[good_values],dim=c(length(exp[good_values])/ens_num,ens_num)) - obs <- array(obs[good_values],dim=c(length(exp[good_values])/ens_num,ens_num)) - obs <- obs [,!apply(obs,2,function (x) all(is.na(x)))] - names(dim(exp)) <- dim_names + dim_names_exp <- names(dim(exp)) + dim_names_obs <- names(dim(obs)) + exp <- array(exp[good_values,],dim=c(length(good_values[good_values]),col_num)) + if(!is.null(memb_dim)) { + obs <- array(obs[good_values],dim=c(length(good_values[good_values]))) + } else { + obs <- array(obs[good_values],dim=c(length(good_values[good_values]),col_num)) + } + names(dim(exp)) <- dim_names_exp + names(dim(obs)) <- dim_names_obs # RPS of the forecast rps_exp <- .RPS(exp = exp, obs = obs, time_dim = time_dim, memb_dim = memb_dim, @@ -410,7 +429,6 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', obs <- InsertDim(obs, posdim = 2, lendim = 1, name = memb_dim) } } - names(dim(obs))[1] <- time_dim if (is.null(dat_dim)) { dim(obs) <- c(dim(obs), nobs = nobs) } -- GitLab From 1e763b8632e3930e6320304eb05d223a5757ff10 Mon Sep 17 00:00:00 2001 From: eduzenli Date: Sun, 9 Jul 2023 16:47:21 +0200 Subject: [PATCH 34/64] minor correction --- R/RPS.R | 2 +- R/RPSS.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/RPS.R b/R/RPS.R index 0e9abcc..c28dd71 100644 --- a/R/RPS.R +++ b/R/RPS.R @@ -281,7 +281,7 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL dim_names_obs <- names(dim(obs)) exp <- array(exp[good_values,],dim=c(length(good_values[good_values]),col_num)) if(!is.null(memb_dim)) { - obs <- array(obs[good_values],dim=c(length(good_values[good_values]))) + obs <- array(obs[good_values],dim=c(length(good_values[good_values]),1)) ## dat_dim=1 } else { obs <- array(obs[good_values],dim=c(length(good_values[good_values]),col_num)) } diff --git a/R/RPSS.R b/R/RPSS.R index 6a9a9fd..6dc7bab 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -408,7 +408,7 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', dim_names_obs <- names(dim(obs)) exp <- array(exp[good_values,],dim=c(length(good_values[good_values]),col_num)) if(!is.null(memb_dim)) { - obs <- array(obs[good_values],dim=c(length(good_values[good_values]))) + obs <- array(obs[good_values],dim=c(length(good_values[good_values]),1)) ## dat_dim=1 } else { obs <- array(obs[good_values],dim=c(length(good_values[good_values]),col_num)) } -- GitLab From 9c16296cb17fa68febae00c0c4a8c5f7f6d2b6d7 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Mon, 10 Jul 2023 16:44:25 +0200 Subject: [PATCH 35/64] first version; not working because .GetProbs --- R/RPS.R | 112 ++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 76 insertions(+), 36 deletions(-) diff --git a/R/RPS.R b/R/RPS.R index c5ff5ba..70e693f 100644 --- a/R/RPS.R +++ b/R/RPS.R @@ -79,7 +79,7 @@ #'@export RPS <- function(exp, obs, 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 = NULL, cross.val = FALSE, ncores = NULL) { + Fair = FALSE, weights = NULL, cross.val = FALSE, na.rm = FALSE, ncores = NULL) { # Check inputs ## exp and obs (1) @@ -203,6 +203,10 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL "'weights' is not used. Change 'weights' to NULL.")) weights <- NULL } + ## 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 | @@ -235,7 +239,8 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL memb_dim = memb_dim, cat_dim = cat_dim, prob_thresholds = prob_thresholds, indices_for_clim = indices_for_clim, Fair = Fair, - weights = weights, cross.val = cross.val, ncores = ncores)$output1 + weights = weights, cross.val = cross.val, + na.rm = na.rm, ncores = ncores)$output1 # Return only the mean RPS rps <- MeanDims(rps, time_dim, na.rm = FALSE) @@ -246,7 +251,7 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL .RPS <- function(exp, obs, 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 = NULL, cross.val = FALSE) { + Fair = FALSE, weights = NULL, cross.val = FALSE, na.rm = FALSE) { #--- if memb_dim: # exp: [sdate, memb, (dat)] # obs: [sdate, (memb), (dat)] @@ -283,40 +288,76 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL 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:2]) - # If the data inputs are forecast/observation, calculate probabilities - if (is.null(cat_dim)) { - if (!is.null(weights)) { - weights_data <- weights[ , , i] - if (is.null(dim(weights_data))) dim(weights_data) <- c(dim(weights)[1:2]) - } else { - weights_data <- weights - } - - exp_probs <- .GetProbs(data = exp_data, indices_for_quantiles = indices_for_clim, - prob_thresholds = prob_thresholds, weights = weights_data, cross.val = cross.val) - # exp_probs: [bin, sdate] - obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, - prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) - # obs_probs: [bin, sdate] - - } else { # inputs are probabilities already - exp_probs <- t(exp_data) - obs_probs <- t(obs_data) + ################# + + if (memb_dim %in% names(dim(exp_data))){ + exp_mean <- apply(exp_data, 1, mean) + } else {exp_mean <- exp_data} + if (memb_dim %in% names(dim(obs_data))){ + obs_mean <- apply(obs_data, 1, mean) + } else {obs_mean <- obs_data} + + if (cat_dim %in% names(dim(exp_data))){ + exp_mean <- apply(exp_data, 1, mean) + obs_mean <- apply(obs_data, 1, mean) + } else {exp_mean <- exp_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 } - - probs_exp_cumsum <- apply(exp_probs, 2, cumsum) - probs_obs_cumsum <- apply(obs_probs, 2, cumsum) - - # rps: [sdate, nexp, nobs] - rps[ , i, j] <- colSums((probs_exp_cumsum - probs_obs_cumsum)^2) - if (Fair) { # FairRPS - ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1)) [formula taken from SpecsVerification::EnsRps] - R <- dim(exp)[2] #memb - R_new <- Inf - adjustment <- (-1) / (R - 1) * probs_exp_cumsum * (1 - probs_exp_cumsum) - adjustment <- colSums(adjustment) - rps[ , i, j] <- rps[ , i, j] + adjustment + + if (f_NAs <= sum(good_values)/length(obs_mean)){ + + exp_data <- exp_data[good_values] + obs_data <- obs_data[good_values] + + # If the data inputs are forecast/observation, calculate probabilities + if (is.null(cat_dim)) { + if (!is.null(weights)) { + weights_data <- weights[ , , i] + if (is.null(dim(weights_data))) dim(weights_data) <- c(dim(weights)[1:2]) + } else { + weights_data <- weights + } + + exp_probs <- .GetProbs(data = exp_data, indices_for_quantiles = indices_for_clim, + prob_thresholds = prob_thresholds, weights = weights_data, cross.val = cross.val) + # exp_probs: [bin, sdate] + obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, + prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) + # obs_probs: [bin, sdate] + + } else { # inputs are probabilities already + exp_probs <- t(exp_data) + obs_probs <- t(obs_data) + } + + probs_exp_cumsum <- apply(exp_probs, 2, cumsum) + probs_obs_cumsum <- apply(obs_probs, 2, cumsum) + + # rps: [sdate, nexp, nobs] + rps[ , i, j] <- colSums((probs_exp_cumsum - probs_obs_cumsum)^2) + if (Fair) { # FairRPS + ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1)) [formula taken from SpecsVerification::EnsRps] + R <- dim(exp)[2] #memb + R_new <- Inf + adjustment <- (-1) / (R - 1) * probs_exp_cumsum * (1 - probs_exp_cumsum) + adjustment <- colSums(adjustment) + rps[ , i, j] <- rps[ , i, j] + adjustment + } + + } else { ## not enough values different from NA + + rps[ , i, j] <- NA + } + } } @@ -326,4 +367,3 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL return(rps) } - -- GitLab From abd2660319312c2acce8ad55f24834ac0c5048f1 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 11 Jul 2023 16:24:59 +0200 Subject: [PATCH 36/64] Improve MSSS and MSE, build unit tests; fix minor mistakes; Add RandomWalkTest test.type options --- NAMESPACE | 2 + R/MSE.R | 157 +++++++++++---------- R/MSSS.R | 257 ++++++++++++++++------------------ R/RMS.R | 93 +++++++------ R/RMSSS.R | 235 ++++++++++++++++---------------- man/MSE.Rd | 102 ++++++++++++++ man/MSSS.Rd | 117 ++++++++++++++++ man/RMS.Rd | 46 ++++--- man/RMSSS.Rd | 51 +++++-- tests/testthat/test-CRPSS.R | 6 +- tests/testthat/test-EOF.R | 2 +- tests/testthat/test-MSE.R | 259 +++++++++++++++++++++++++++++++++++ tests/testthat/test-MSSS.R | 265 ++++++++++++++++++++++++++++++++++++ tests/testthat/test-RMS.R | 80 +++++++---- tests/testthat/test-RMSSS.R | 176 ++++++++++-------------- tests/testthat/test-RPSS.R | 6 +- 16 files changed, 1309 insertions(+), 545 deletions(-) create mode 100644 man/MSE.Rd create mode 100644 man/MSSS.Rd create mode 100644 tests/testthat/test-MSE.R create mode 100644 tests/testthat/test-MSSS.R diff --git a/NAMESPACE b/NAMESPACE index d74cc97..9214a1a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -41,6 +41,8 @@ export(Histo2Hindcast) export(InsertDim) export(LeapYear) export(Load) +export(MSE) +export(MSSS) export(MeanDims) export(NAO) export(Persistence) diff --git a/R/MSE.R b/R/MSE.R index 1218904..97e4e82 100644 --- a/R/MSE.R +++ b/R/MSE.R @@ -2,29 +2,26 @@ #' #'Compute the mean square error for an array of forecasts and an array of #'observations. The MSEs are computed along time_dim, the dimension which -#'corresponds to the startdate dimension. If comp_dim is given, the MSEs are +#'corresponds to the start date dimension. If comp_dim is given, the MSEs are #'computed only if obs along the comp_dim dimension are complete between #'limits[1] and limits[2], i.e. there are no NAs between limits[1] and -#'limits[2]. This option can be activated if the user wishes to account only +#'limits[2]. This option can be activated if the user wants to account only #'for the forecasts for which the corresponding observations are available at #'all leadtimes.\cr #'The confidence interval is computed by the chi2 distribution.\cr #' -#'@param exp A named numeric array of experimental data, with at least two -#' dimensions 'time_dim' and 'dat_dim'. It can also be a vector with the -#' same length as 'obs', then the vector will automatically be 'time_dim' and -#' 'dat_dim' will be 1. +#'@param exp A named numeric array of experimental data, with at least #' 'time_dim' dimension. It can also be a vector with the same length as 'obs'. #'@param obs A named numeric array of observational data, same dimensions as -#' parameter 'exp' except along dat_dim. It can also be a vector with the same -#' length as 'exp', then the vector will automatically be 'time_dim' and -#' 'dat_dim' will be 1. +#' parameter 'exp' except along 'dat_dim' and 'memb_dim'. It can also be a +#' vector with the same length as 'exp'. #'@param time_dim A character string indicating the name of dimension along #' which the correlations are computed. The default value is 'sdate'. #'@param memb_dim A character string indicating the name of the member dimension -#' to compute the ensemble mean; it should be set to NULL if the parameter 'exp' -#' and 'ref' are already the ensemble mean. The default value is NULL. -#'@param dat_dim A character string indicating the name of member (nobs/nexp) -#' dimension. The default value is 'dataset'. +#' to compute the ensemble mean; it should be set to NULL if the input data are +#' already the ensemble mean. The default value is NULL. +#'@param dat_dim A character string indicating the name of dataset or member +#' (nobs/nexp) dimension. The datasets of exp and obs will be paired and +#' computed MSE for each pair. The default value is NULL. #'@param comp_dim A character string indicating the name of dimension along which #' obs is taken into account only if it is complete. The default value #' is NULL. @@ -32,8 +29,8 @@ #' be completed. The default value is c(1, length(comp_dim dimension)). #'@param conf A logical value indicating whether to retrieve the confidence #' intervals or not. The default value is TRUE. -#'@param conf.lev A numeric indicating the confidence level for the -#' regression computation. The default value is 0.95. +#'@param alpha A numeric indicating the significance level for 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. #' @@ -54,26 +51,33 @@ #' #'@examples #'# Load sample data as in Load() example: -#' set.seed(1) -#' exp1 <- array(rnorm(120), dim = c(dataset = 3, sdate = 5, ftime = 2, lon = 1, lat = 4)) -#' set.seed(2) -#' obs1 <- array(rnorm(80), dim = c(dataset = 2, sdate = 5, ftime = 2, lon = 1, lat = 4)) -#' res1 <- MSE(exp1, obs1) -#' -#' exp2 <- array(rnorm(120), dim = c(dataset = 3, sdate = 5, ftime = 2, lon = 1, lat = 4, memb = 5)) -#' obs2 <- array(rnorm(80), dim = c(dataset = 2, sdate = 5, ftime = 2, lon = 1, lat = 4)) -#' res2 <- MSE(exp2, obs2, memb_dim = 'memb') +#'example(Load) +#'clim <- Clim(sampleData$mod, sampleData$obs) +#'ano_exp <- Ano(sampleData$mod, clim$clim_exp) +#'ano_obs <- Ano(sampleData$obs, clim$clim_obs) +#'smooth_ano_exp <- Smoothing(ano_exp, runmeanlen = 12, time_dim = 'ftime') +#'smooth_ano_obs <- Smoothing(ano_obs, runmeanlen = 12, time_dim = 'ftime') +#'res <- MSE(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member', +#' comp_dim = 'ftime', limits = c(7, 54)) +#' +#'# Synthetic data: +#'exp1 <- array(rnorm(120), dim = c(dat = 3, sdate = 10, ftime = 4)) +#'obs1 <- array(rnorm(80), dim = c(dat = 2, sdate = 10, ftime = 4)) +#'na <- floor(runif(10, min = 1, max = 80)) +#'obs1[na] <- NA +#'res1 <- MSE(exp1, obs1, comp_dim = 'ftime', dat_dim = 'dat') #' -#' # Renew example when Ano and Smoothing are ready +#'exp2 <- array(rnorm(20), dim = c(sdate = 5, member = 4)) +#'obs2 <- array(rnorm(10), dim = c(sdate = 5, member = 2)) +#'res2 <- MSE(exp3, obs3, memb_dim = 'member') #' -#'@rdname MSE #'@import multiApply #'@importFrom ClimProjDiags Subset #'@importFrom stats qchisq #'@export -MSE <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, - dat_dim = 'dataset', comp_dim = NULL, limits = NULL, - conf = TRUE, conf.lev = 0.95, ncores = NULL) { +MSE <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, memb_dim = NULL, + comp_dim = NULL, limits = NULL, conf = TRUE, alpha = 0.05, ncores = NULL) { + # Check inputs ## exp and obs (1) if (is.null(exp) | is.null(obs)) { @@ -84,10 +88,10 @@ MSE <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, } if (is.null(dim(exp)) & is.null(dim(obs))) { #is vector if (length(exp) == length(obs)) { - exp <- array(exp, dim = c(length(exp), 1)) - names(dim(exp)) <- c(time_dim, dat_dim) - obs <- array(obs, dim = c(length(obs), 1)) - names(dim(obs)) <- c(time_dim, dat_dim) + exp <- array(exp, dim = c(length(exp))) + names(dim(exp)) <- c(time_dim) + obs <- array(obs, dim = c(length(obs))) + names(dim(obs)) <- c(time_dim) } else { stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", "dimensions time_dim and dat_dim, or vector of same length.")) @@ -100,10 +104,6 @@ MSE <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } - if(!all(names(dim(exp))[-which(names(dim(exp))==memb_dim)] %in% names(dim(obs))[-which(names(dim(exp))==memb_dim)]) | - !all(names(dim(obs))[-which(names(dim(exp))==memb_dim)] %in% names(dim(exp))[-which(names(dim(exp))==memb_dim)])) { - stop("Parameter 'exp' and 'obs' must have same dimension name.") - } ## time_dim if (!is.character(time_dim) | length(time_dim) > 1) { stop("Parameter 'time_dim' must be a character string.") @@ -116,17 +116,9 @@ MSE <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, if (!is.character(memb_dim) | length(memb_dim) > 1) { stop("Parameter 'memb_dim' must be a character string.") } - if (!memb_dim %in% names(dim(exp))) { + if (!memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { stop("Parameter 'memb_dim' is not found in 'exp' dimension.") } - if (memb_dim %in% names(dim(obs))) { - if (identical(as.numeric(dim(obs)[memb_dim]), 1)) { - obs <- ClimProjDiags::Subset(x = obs, along = memb_dim, indices = 1, drop = 'selected') - } else { - stop("Not implemented for observations with members ('obs' can have 'memb_dim', ", - "but it should be of length = 1).") - } - } } ## dat_dim if (!is.null(dat_dim)) { @@ -162,9 +154,9 @@ MSE <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, if (!is.logical(conf) | length(conf) > 1) { stop("Parameter 'conf' must be one logical value.") } - ## conf.lev - if (!is.numeric(conf.lev) | conf.lev < 0 | conf.lev > 1 | length(conf.lev) > 1) { - stop("Parameter 'conf.lev' must be a numeric number between 0 and 1.") + ## alpha + if (!is.numeric(alpha) | alpha < 0 | alpha > 1 | length(alpha) > 1) { + stop("Parameter 'alpha' must be a numeric number between 0 and 1.") } ## ncores if (!is.null(ncores)) { @@ -177,23 +169,39 @@ MSE <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, name_exp <- sort(names(dim(exp))) name_obs <- sort(names(dim(obs))) if (!is.null(memb_dim)) { - name_exp <- name_exp[-which(name_exp == memb_dim)] + if (memb_dim %in% name_exp) { + name_exp <- name_exp[-which(name_exp == memb_dim)] + } + if (memb_dim %in% name_obs) { + name_obs <- name_obs[-which(name_obs == memb_dim)] + } } if (!is.null(dat_dim)) { name_exp <- name_exp[-which(name_exp == dat_dim)] name_obs <- name_obs[-which(name_obs == dat_dim)] } - if(!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + if (!all(name_exp == name_obs)) { + stop("Parameter 'exp' and 'obs' must have the same dimension names.") + } + if (!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { stop(paste0("Parameter 'exp' and 'obs' must have same length of ", - "all dimension except 'memb_dim' and 'dat_dim'.")) + "all dimensions except 'dat_dim' and 'memb_dim'.")) } - + if (dim(exp)[time_dim] < 2) { + stop("The length of time_dim must be at least 2 to compute MSE.") + } + ############################### ## Ensemble mean if (!is.null(memb_dim)) { - exp <- MeanDims(exp, memb_dim, na.rm = T) + if (memb_dim %in% names(dim(exp))) { + exp <- MeanDims(exp, memb_dim, na.rm = T) + } + if (memb_dim %in% names(dim(obs))) { + obs <- MeanDims(obs, memb_dim, na.rm = T) + } } - + ############################### # Sort dimension name_exp <- names(dim(exp)) @@ -221,13 +229,13 @@ MSE <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, c(time_dim, dat_dim)), fun = .MSE, time_dim = time_dim, dat_dim = dat_dim, - conf = conf, conf.lev = conf.lev, ncores_input = ncores, + conf = conf, alpha = alpha, ncores = ncores) return(res) } -.MSE <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', - conf = TRUE, conf.lev = 0.95, ncores_input = NULL) { +.MSE <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, conf = TRUE, alpha = 0.05) { + if (is.null(dat_dim)) { # exp: [sdate] # obs: [sdate] @@ -247,7 +255,7 @@ MSE <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, chi <- array(dim = c(nexp = nexp, nobs = nobs)) if (conf) { - conflow <- (1 - conf.lev) / 2 + conflow <- alpha / 2 confhigh <- 1 - conflow conf.lower <- array(dim = c(nexp = nexp, nobs = nobs)) conf.upper <- array(dim = c(nexp = nexp, nobs = nobs)) @@ -258,22 +266,28 @@ MSE <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, dif[, , i] <- sapply(1:nexp, function(x) {exp[, x] - obs[, i]}) } - mse <- apply(dif^2, c(2, 3), mean, na.rm = TRUE) #array(dim = c(_exp, nobs)) + mse <- colMeans(dif^2, na.rm = TRUE) # array(dim = c(nexp, nobs)) if (conf) { - #eno <- Eno(dif, 1) #count effective sample along sdate. dim = c(nexp, nobs) - eno <- Eno(dif, time_dim, ncores = ncores_input) #change to this line when Eno() is done + #count effective sample along sdate. eno: c(nexp, nobs) +# eno <- Eno(dif, time_dim) # slower than for loop below? + eno <- array(dim = c(nexp = nexp, nobs = nobs)) + for (n_obs in 1:nobs) { + for (n_exp in 1:nexp) { + eno[n_exp, n_obs] <- .Eno(dif[, n_exp, n_obs], na.action = na.pass) + } + } # conf.lower chi <- sapply(1:nobs, function(i) { - qchisq(confhigh, eno[, i] - 1) - }) + qchisq(confhigh, eno[, i] - 1) + }) conf.lower <- (eno * mse ** 2 / chi) ** 0.5 # conf.upper chi <- sapply(1:nobs, function(i) { - qchisq(conflow, eno[, i] - 1) - }) + qchisq(conflow, eno[, i] - 1) + }) conf.upper <- (eno * mse ** 2 / chi) ** 0.5 } @@ -288,13 +302,10 @@ MSE <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, } ################################### - - if (conf) { - res <- list(mse = mse, conf.lower = conf.lower, conf.upper = conf.upper) - } else { - res <- list(mse = mse) - } - + + res <- list(mse = mse) + if (conf) res <- c(res, list(conf.lower = conf.lower, conf.upper = conf.upper)) + return(res) } diff --git a/R/MSSS.R b/R/MSSS.R index b784027..a11c50c 100644 --- a/R/MSSS.R +++ b/R/MSSS.R @@ -1,28 +1,23 @@ #'Compute mean square error skill score #' -#'Compute the mean square error skill score (MSSS) between an array of -#'forecast 'exp' and an array of observation 'obs'. The two arrays should -#'have the same dimensions except along dat_dim, where the length can be -#'different, with the number of experiments/models (nexp) and the number of -#'observational datasets (nobs).\cr -#'MSSS computes the mean square error skill score of each jexp in 1:nexp -#'against each job in 1:nobs which gives nexp * nobs MSSS for each grid point +#'Compute the mean square error skill score (MSSS) between an array of forecast +#''exp' and an array of observation 'obs'. The two arrays should have the same +#'dimensions except along 'dat_dim' and 'memb_dim'. The MSSSs are computed along +#''time_dim', the dimension which corresponds to the start date dimension. +#'MSSS computes the mean square error skill score of each exp in 1:nexp +#'against each obs in 1:nobs which gives nexp * nobs MSSS for each grid point #'of the array.\cr -#'The MSSS are computed along the time_dim dimension which should correspond -#'to the start date dimension.\cr #'The p-value and significance test are optionally provided by an one-sided #'Fisher test or Random Walk test.\cr #' #'@param exp A named numeric array of experimental data which contains at least -#' two dimensions for dat_dim and time_dim. It can also be a vector with the -#' same length as 'obs', then the vector will automatically be 'time_dim' and -#' 'dat_dim' will be 1. +#' time dimension (time_dim). It can also be a vector with the same length as +#' 'obs', then the vector will automatically be 'time_dim'. #'@param obs A named numeric array of observational data which contains at least -#' two dimensions for dat_dim and time_dim. The dimensions should be the same -#' as paramter 'exp' except the length of 'dat_dim' dimension. The order of -#' dimension can be different. It can also be a vector with the same length as -#' 'exp', then the vector will automatically be 'time_dim' and 'dat_dim' will -#' be 1. +#' time dimension (time_dim). The dimensions should be the same as parameter +#' 'exp' except the length of 'dat_dim' and 'memb_dim' dimension. It can also +#' be a vector with the same length as 'exp', then the vector will +#' automatically be 'time_dim'. #'@param ref A named numerical array of the reference forecast data with at #' least time dimension, or 0 (typical climatological forecast) or 1 #' (normalized climatological forecast). If it is an array, the dimensions must @@ -30,15 +25,15 @@ #' reference dataset, it should not have dataset dimension. If there is #' corresponding reference for each experiment, the dataset dimension must #' have the same length as in 'exp'. If 'ref' is NULL, the typical -#' climatological forecast is used as reference forecast (equivalant to 0.) +#' climatological forecast is used as reference forecast (equivalent to 0.) #' The default value is NULL. #'@param dat_dim A character string indicating the name of dataset (nobs/nexp) #' dimension. The default value is NULL. #'@param time_dim A character string indicating the name of dimension along #' which the MSSS are computed. The default value is 'sdate'. #'@param memb_dim A character string indicating the name of the member dimension -#' to compute the ensemble mean; it should be set to NULL if the parameter 'exp' -#' and 'ref' are already the ensemble mean. The default value is NULL. +#' to compute the ensemble mean; it should be set to NULL if the data are +#' already the ensemble mean. The default value is NULL. #'@param pval A logical value indicating whether to compute or not the p-value #' of the test Ho: MSSS = 0. The default value is TRUE. #'@param sign A logical value indicating whether to compute or not the @@ -48,6 +43,11 @@ #' statistical significance test. The default value is 0.05. #'@param sig_method A character string indicating the significance method. The #' options are "one-sided Fisher" (default) and "Random Walk". +#'@param sig_method.type A character string indicating the test type of the +#' significance method. Check \code{RandomWalkTest()} parameter +#' \code{test.type} for details if parameter "sig_method" is "Random Walk". The +#' default is NULL (since "one-sided Fisher" doesn't have different test +#' types.) #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -70,11 +70,17 @@ #'} #' #'@examples -#' set.seed(1) -#' exp <- array(rnorm(30), dim = c(dataset = 2, time = 3, memb = 5)) -#' set.seed(2) -#' obs <- array(rnorm(15), dim = c(time = 3, dataset = 1)) -#' res <- MSSS(exp, obs, time_dim = 'time', dat_dim = 'dataset', memb_dim = 'memb') +#'# Load sample data as in Load() example: +#'example(Load) +#'clim <- Clim(sampleData$mod, sampleData$obs) +#'ano_exp <- Ano(sampleData$mod, clim$clim_exp) +#'ano_obs <- Ano(sampleData$obs, clim$clim_obs) +#'rmsss <- MSSS(ano_exp, ano_obs, dat_dim = 'dataset', memb_dim = 'member') +#' +#'# Synthetic data: +#'exp <- array(rnorm(30), dim = c(dataset = 2, time = 3, memb = 5)) +#'obs <- array(rnorm(15), dim = c(time = 3, dataset = 1)) +#'res <- MSSS(exp, obs, time_dim = 'time', dat_dim = 'dataset', memb_dim = 'memb') #' #'@rdname MSSS #'@import multiApply @@ -82,7 +88,7 @@ #'@export MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, memb_dim = NULL, pval = TRUE, sign = FALSE, alpha = 0.05, - sig_method = 'one-sided Fisher', ncores = NULL) { + sig_method = 'one-sided Fisher', sig_method.type = NULL, ncores = NULL) { # Check inputs ## exp, obs, and ref (1) @@ -94,10 +100,10 @@ MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, } if (is.null(dim(exp)) & is.null(dim(obs))) { #is vector if (length(exp) == length(obs)) { - exp <- array(exp, dim = c(length(exp), 1)) - names(dim(exp)) <- c(time_dim, dat_dim) - obs <- array(obs, dim = c(length(obs), 1)) - names(dim(obs)) <- c(time_dim, dat_dim) + exp <- array(exp, dim = c(length(exp))) + names(dim(exp)) <- c(time_dim) + obs <- array(obs, dim = c(length(obs))) + names(dim(obs)) <- c(time_dim) } else { stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", "dimensions time_dim and dat_dim, or vector of same length.")) @@ -106,14 +112,10 @@ MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", "dimensions time_dim and dat_dim, or vector of same length.")) } - if(any(is.null(names(dim(exp))))| any(nchar(names(dim(exp))) == 0) | - any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { + if (any(is.null(names(dim(exp))))| any(nchar(names(dim(exp))) == 0) | + any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } - if(!all(names(dim(exp))[-which(names(dim(exp))==memb_dim)] %in% names(dim(obs))[-which(names(dim(exp))==memb_dim)]) | - !all(names(dim(obs))[-which(names(dim(exp))==memb_dim)] %in% names(dim(exp))[-which(names(dim(exp))==memb_dim)])) { - stop("Parameter 'exp' and 'obs' must have same dimension name.") - } if (!is.null(ref)) { if (!is.numeric(ref)) { stop("Parameter 'ref' must be numeric.") @@ -125,6 +127,11 @@ MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, } else if (length(ref) != 1 | any(!ref %in% c(0, 1))) { stop("Parameter 'ref' must be a numeric array or number 0 or 1.") } + } else { + ref <- 0 + } + if (!is.array(ref)) { # 0 or 1 + ref <- array(data = ref, dim = dim(exp)) } ## time_dim @@ -152,14 +159,6 @@ MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, if (!memb_dim %in% names(dim(exp))) { stop("Parameter 'memb_dim' is not found in 'exp' dimension.") } - if (memb_dim %in% names(dim(obs))) { - if (identical(as.numeric(dim(obs)[memb_dim]), 1)) { - obs <- ClimProjDiags::Subset(x = obs, along = memb_dim, indices = 1, drop = 'selected') - } else { - stop("Not implemented for observations with members ('obs' can have 'memb_dim', ", - "but it should be of length = 1).") - } - } } ## pval if (!is.logical(pval) | length(pval) > 1) { @@ -177,66 +176,79 @@ MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, if (length(sig_method) != 1 | !any(sig_method %in% c('one-sided Fisher', 'Random Walk'))) { stop("Parameter 'sig_method' must be one of 'one-sided Fisher' or 'Random Walk'.") } - if (sig_method == "Random Walk" & pval == T) { - warning("p-value cannot be calculated by significance method 'Random Walk'.") - pval <- FALSE + ## sig_method.type + if (sig_method == 'Random Walk') { + if (is.null(sig_method.type)) { + .warning("Parameter 'sig_method.type' must be specified if 'sig_method' is ", + "Random Walk. Assign it as 'two.sided'.") + sig_method.type <- "two.sided" + } + if (!any(sig_method.type %in% c('two.sided.approx', 'two.sided', 'greater', 'less'))) { + stop("Parameter 'sig_method.type' must be a method accepted by RandomWalkTest() parameter 'test.type'.") + } + if (sig_method.type == 'two.sided.approx' & pval == T) { + .warning("p-value cannot be calculated by Random Walk 'two.sided.approx' method.") + pval <- FALSE + 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.") + alpha <- 0.05 + } + } } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | - length(ncores) > 1) { + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } } - ## exp and obs (2) + ## exp, obs, and ref (2) name_exp <- sort(names(dim(exp))) name_obs <- sort(names(dim(obs))) if (!is.null(memb_dim)) { - name_exp <- name_exp[-which(name_exp == memb_dim)] - name_obs <- name_obs[-which(name_obs == memb_dim)] + if (memb_dim %in% name_exp) { + name_exp <- name_exp[-which(name_exp == memb_dim)] + } + if (memb_dim %in% name_obs) { + name_obs <- name_obs[-which(name_obs == memb_dim)] + } } if (!is.null(dat_dim)) { name_exp <- name_exp[-which(name_exp == dat_dim)] name_obs <- name_obs[-which(name_obs == dat_dim)] } - if(!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + if (!all(name_exp == name_obs)) { + stop("Parameter 'exp' and 'obs' must have the same dimension names.") + } + if (!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { stop(paste0("Parameter 'exp' and 'obs' must have same length of ", - "all dimension except 'memb_dim' and 'dat_dim'.")) + "all dimensions except 'dat_dim' and 'memb_dim'.")) } - ############################### - # Create ref array if needed - if (is.null(ref)) ref <- 0 - if (!is.array(ref)) { - ref <- array(data = ref, dim = dim(exp)) + name_ref <- sort(names(dim(ref))) + if (!is.null(memb_dim) && memb_dim %in% name_ref) { + name_ref <- name_ref[-which(name_ref == memb_dim)] } - - if (!is.null(ref)) { - name_ref <- sort(names(dim(ref))) - if (!is.null(memb_dim) && memb_dim %in% name_ref) { - name_ref <- name_ref[-which(name_ref == memb_dim)] - } - if (!is.null(dat_dim)) { - if (dat_dim %in% name_ref) { - if (!identical(dim(exp)[dat_dim], dim(ref)[dat_dim])) { - stop(paste0("If parameter 'ref' has dataset dimension, it must be ", - "equal to dataset dimension of 'exp'.")) - } - name_ref <- name_ref[-which(name_ref == dat_dim)] + if (!is.null(dat_dim)) { + if (dat_dim %in% name_ref) { + if (!identical(dim(exp)[dat_dim], dim(ref)[dat_dim])) { + stop(paste0("If parameter 'ref' has dataset dimension, it must be ", + "equal to dataset dimension of 'exp'.")) } - } - if (!identical(length(name_exp), length(name_ref)) | - !identical(dim(exp)[name_exp], dim(ref)[name_ref])) { - stop(paste0("Parameter 'exp' and 'ref' must have the same length of ", - "all dimensions except 'memb_dim' and 'dat_dim' if there is ", - "only one reference dataset.")) + name_ref <- name_ref[-which(name_ref == dat_dim)] } } - + if (!identical(length(name_exp), length(name_ref)) | + !identical(dim(exp)[name_exp], dim(ref)[name_ref])) { + stop(paste0("Parameter 'exp' and 'ref' must have the same length of ", + "all dimensions except 'memb_dim' and 'dat_dim' if there is ", + "only one reference dataset.")) + } + if (dim(exp)[time_dim] <= 2) { stop("The length of time_dim must be more than 2 to compute MSSS.") } - + ############################### # # Sort dimension # name_exp <- names(dim(exp)) @@ -247,8 +259,13 @@ MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, ############################### ## Ensemble mean if (!is.null(memb_dim)) { - exp <- MeanDims(exp, memb_dim, na.rm = T) - if (!is.null(ref) & memb_dim %in% names(dim(ref))) { + if (memb_dim %in% names(dim(exp))) { + exp <- MeanDims(exp, memb_dim, na.rm = T) + } + if (memb_dim %in% names(dim(obs))) { + obs <- MeanDims(obs, memb_dim, na.rm = T) + } + if (memb_dim %in% names(dim(ref))) { ref <- MeanDims(ref, memb_dim, na.rm = T) } } @@ -256,21 +273,6 @@ MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, ############################### # Calculate MSSS - # if (!is.null(ref)) { # use "ref" as reference forecast - # if (!is.null(dat_dim) && dat_dim %in% names(dim(ref))) { - # target_dims_ref <- c(time_dim, dat_dim) - # } else { - # target_dims_ref <- c(time_dim) - # } - # data <- list(exp = exp, obs = obs, ref = ref) - # target_dims = list(exp = c(time_dim, dat_dim), - # obs = c(time_dim, dat_dim), - # ref = target_dims_ref) - # } else { - # data <- list(exp = exp, obs = obs) - # target_dims = list(exp = c(time_dim, dat_dim), - # obs = c(time_dim, dat_dim)) - # } data <- list(exp = exp, obs = obs, ref = ref) if (!is.null(dat_dim)) { if (dat_dim %in% names(dim(ref))) { @@ -291,14 +293,15 @@ MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, fun = .MSSS, time_dim = time_dim, dat_dim = dat_dim, pval = pval, sign = sign, alpha = alpha, - sig_method = sig_method, + sig_method = sig_method, sig_method.type = sig_method.type, ncores = ncores) return(res) } -.MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = 'dataset', pval = TRUE, - sign = FALSE, alpha = 0.05, sig_method = 'one-sided Fisher') { +.MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, pval = TRUE, + sign = FALSE, alpha = 0.05, sig_method = 'one-sided Fisher', + sig_method.type = NULL) { # exp: [sdate, (dat)] # obs: [sdate, (dat)] # ref: [sdate, (dat)] or NULL @@ -343,40 +346,25 @@ MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, dif1[, , i] <- sapply(1:nexp, function(x) {exp[, x] - obs[, i]}) } - mse_exp <- apply(dif1^2, c(2, 3), mean, na.rm = TRUE) #array(dim = c(nexp, nobs)) + mse_exp <- colMeans(dif1^2, na.rm = TRUE) # [nexp, nobs] # MSE of reference - # if (!is.null(ref)) { dif2 <- array(dim = c(nsdate, nref, nobs)) names(dim(dif2)) <- c(time_dim, 'nexp', 'nobs') for (i in 1:nobs) { dif2[, , i] <- sapply(1:nref, function(x) {ref[, x] - obs[, i]}) } - mse_ref <- apply(dif2^2, c(2, 3), mean, na.rm = TRUE) #array(dim = c(nref, nobs)) + mse_ref <- colMeans(dif2^2, na.rm = TRUE) # [nref, nobs] if (nexp != nref) { # expand mse_ref to nexp (nref is 1) mse_ref <- array(mse_ref, dim = c(nobs = nobs, nexp = nexp)) mse_ref <- Reorder(mse_ref, c(2, 1)) } - # } else { - # mse_ref <- array(colMeans(obs^2, na.rm = TRUE)^0.5, dim = c(nobs = nobs, nexp = nexp)) - ## mse_ref[which(abs(mse_ref) <= (max(abs(mse_ref), na.rm = TRUE) / 1000))] <- max(abs( - ## mse_ref), na.rm = TRUE) / 1000 - # mse_ref <- Reorder(mse_ref, c(2, 1)) - # #mse_ref above: [nexp, nobs] - # } - + msss <- 1 - mse_exp / mse_ref ################################################# - # if (conf) { - # conflow <- (1 - conf.lev) / 2 - # confhigh <- 1 - conflow - # conf_low <- array(dim = c(nexp = nexp, nobs = nobs)) - # conf_high <- array(dim = c(nexp = nexp, nobs = nobs)) - # } - if (sig_method == 'one-sided Fisher') { p_val <- array(dim = c(nexp = nexp, nobs = nobs)) ## pval and sign @@ -407,12 +395,12 @@ MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, } } else if (sig_method == "Random Walk") { - signif <- array(dim = c(nexp = nexp, nobs = nobs)) - p_val <- array(dim = c(nexp = nexp, nobs = nobs)) + + if (sign) signif <- array(dim = c(nexp = nexp, nobs = nobs)) + if (pval) p_val <- array(dim = c(nexp = nexp, nobs = nobs)) + for (i in 1:nexp) { - for (j in 1:nobs) { - - # Error + for (j in 1:nobs) { error_exp <- array(data = abs(exp[, i] - obs[, j]), dim = c(time = nsdate)) if (nref == nexp) { error_ref <- array(data = abs(ref[, i] - obs[, j]), dim = c(time = nsdate)) @@ -420,12 +408,11 @@ MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, # nref = 1 error_ref <- array(data = abs(ref - obs[, j]), dim = c(time = nsdate)) } - # signif[i, j] <- .RandomWalkTest(skill_A = error_exp, skill_B = error_ref)$sign - aux <- s2dv:::.RandomWalkTest(skill_A = error_exp, skill_B = error_ref, - test.type = 'two.sided', - pval = TRUE, sign = TRUE, alpha = alpha) - signif[i, j] <- aux$sign - p_val[i, j] <- aux$p.val + aux <- .RandomWalkTest(skill_A = error_exp, skill_B = error_ref, + test.type = sig_method.type, + pval = pval, sign = sign, alpha = alpha) + if (sign) signif[i, j] <- aux$sign + if (pval) p_val[i, j] <- aux$p.val } } } @@ -434,21 +421,15 @@ MSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, # Remove extra dimensions if dat_dim = NULL if (is.null(dat_dim)) { dim(msss) <- NULL - dim(p_val) <- NULL + if (pval) dim(p_val) <- NULL if (sign) dim(signif) <- NULL } ################################### # output res <- list(msss = msss) - if (pval) { - p.val <- list(p.val = p_val) - res <- c(res, p.val) - } - if (sign) { - signif <- list(sign = signif) - res <- c(res, signif) - } + if (pval) res <- c(res, list(p.val = p_val)) + if (sign) res <- c(res, list(sign = signif)) return(res) } diff --git a/R/RMS.R b/R/RMS.R index 9f011ec..4e6bfeb 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -2,7 +2,7 @@ #' #'Compute the root mean square error for an array of forecasts and an array of #'observations. The RMSEs are computed along time_dim, the dimension which -#'corresponds to the startdate dimension. If comp_dim is given, the RMSEs are +#'corresponds to the start date dimension. If comp_dim is given, the RMSEs are #'computed only if obs along the comp_dim dimension are complete between #'limits[1] and limits[2], i.e. there are no NAs between limits[1] and #'limits[2]. This option can be activated if the user wishes to account only @@ -10,19 +10,16 @@ #'all leadtimes.\cr #'The confidence interval is computed by the chi2 distribution.\cr #' -#'@param exp A named numeric array of experimental data, with at least two -#' dimensions 'time_dim' and 'dat_dim'. It can also be a vector with the -#' same length as 'obs', then the vector will automatically be 'time_dim' and -#' 'dat_dim' will be 1. +#'@param exp A named numeric array of experimental data, with at least +#' 'time_dim' dimension. It can also be a vector with the same length as 'obs'. #'@param obs A named numeric array of observational data, same dimensions as -#' parameter 'exp' except along dat_dim. It can also be a vector with the same -#' length as 'exp', then the vector will automatically be 'time_dim' and -#' 'dat_dim' will be 1. +#' parameter 'exp' except along 'dat_dim' and 'memb_dim'. It can also be a +#' vector with the same length as 'exp'. #'@param time_dim A character string indicating the name of dimension along #' which the correlations are computed. The default value is 'sdate'. #'@param memb_dim A character string indicating the name of the member dimension -#' to compute the ensemble mean; it should be set to NULL if the parameter 'exp' -#' and 'ref' are already the ensemble mean. The default value is NULL. +#' to compute the ensemble mean; it should be set to NULL if the input data are +#' already the ensemble mean. The default value is NULL. #'@param dat_dim A character string indicating the name of dataset or member #' (nobs/nexp) dimension. The datasets of exp and obs will be paired and #' computed RMS for each pair. The default value is NULL. @@ -56,23 +53,25 @@ #' #'@examples #'# Load sample data as in Load() example: -#' set.seed(1) -#' exp1 <- array(rnorm(120), dim = c(dat = 3, sdate = 5, ftime = 2, lon = 1, lat = 4)) -#' set.seed(2) -#' obs1 <- array(rnorm(80), dim = c(dat = 2, sdate = 5, ftime = 2, lon = 1, lat = 4)) -#' set.seed(2) -#' na <- floor(runif(10, min = 1, max = 80)) -#' obs1[na] <- NA -#' res1 <- RMS(exp1, obs1, comp_dim = 'ftime', dat_dim = 'dat') -#' # Renew example when Ano and Smoothing are ready +#'example(Load) +#'clim <- Clim(sampleData$mod, sampleData$obs) +#'ano_exp <- Ano(sampleData$mod, clim$clim_exp) +#'ano_obs <- Ano(sampleData$obs, clim$clim_obs) +#'smooth_ano_exp <- Smoothing(ano_exp, runmeanlen = 12, time_dim = 'ftime') +#'smooth_ano_obs <- Smoothing(ano_obs, runmeanlen = 12, time_dim = 'ftime') +#'res <- RMS(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member', +#' comp_dim = 'ftime', limits = c(7, 54)) #' -#' exp2 <- array(rnorm(120), dim = c(sdate = 5, ftime = 2, lon = 1, lat = 4)) -#' obs2 <- array(rnorm(80), dim = c(sdate = 5, ftime = 2, lon = 1, lat = 4)) -#' res2 <- RMS(exp2, obs2, comp_dim = 'ftime') +#'# Synthetic data: +#'exp1 <- array(rnorm(120), dim = c(dat = 3, sdate = 10, ftime = 4)) +#'obs1 <- array(rnorm(80), dim = c(dat = 2, sdate = 10, ftime = 4)) +#'na <- floor(runif(10, min = 1, max = 80)) +#'obs1[na] <- NA +#'res1 <- RMS(exp1, obs1, comp_dim = 'ftime', dat_dim = 'dat') #' -#' exp3 <- array(rnorm(120), dim = c(sdate = 5, ftime = 2, lon = 1, lat = 4, memb = 4)) -#' obs3 <- array(rnorm(80), dim = c(sdate = 5, ftime = 2, lon = 1, lat = 4)) -#' res3 <- RMS(exp3, obs3, comp_dim = 'ftime', memb_dim = 'memb') +#'exp2 <- array(rnorm(20), dim = c(sdate = 5, member = 4)) +#'obs2 <- array(rnorm(10), dim = c(sdate = 5, member = 2)) +#'res2 <- RMS(exp3, obs3, memb_dim = 'member') #' #'@import multiApply #'@importFrom ClimProjDiags Subset @@ -102,14 +101,10 @@ RMS <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, dat_dim = NULL, stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", "dimensions time_dim and dat_dim, or vector of same length.")) } - if(any(is.null(names(dim(exp))))| any(nchar(names(dim(exp))) == 0) | - any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { + if (any(is.null(names(dim(exp)))) | any(nchar(names(dim(exp))) == 0) | + any(is.null(names(dim(obs)))) | any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } - if(!all(names(dim(exp))[-which(names(dim(exp))==memb_dim)] %in% names(dim(obs))[-which(names(dim(exp))==memb_dim)]) | - !all(names(dim(obs))[-which(names(dim(exp))==memb_dim)] %in% names(dim(exp))[-which(names(dim(exp))==memb_dim)])) { - stop("Parameter 'exp' and 'obs' must have same dimension name") - } ## time_dim if (!is.character(time_dim) | length(time_dim) > 1) { stop("Parameter 'time_dim' must be a character string.") @@ -122,16 +117,8 @@ RMS <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, dat_dim = NULL, if (!is.character(memb_dim) | length(memb_dim) > 1) { stop("Parameter 'memb_dim' must be a character string.") } - if (!memb_dim %in% names(dim(exp))) { - stop("Parameter 'memb_dim' is not found in 'exp' dimension.") - } - if (memb_dim %in% names(dim(obs))) { - if (identical(as.numeric(dim(obs)[memb_dim]), 1)) { - obs <- ClimProjDiags::Subset(x = obs, along = memb_dim, indices = 1, drop = 'selected') - } else { - stop("Not implemented for observations with members ('obs' can have 'memb_dim', ", - "but it should be of length = 1).") - } + if (!memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { + stop("Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension.") } } ## dat_dim @@ -184,16 +171,23 @@ RMS <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, dat_dim = NULL, name_exp <- sort(names(dim(exp))) name_obs <- sort(names(dim(obs))) if (!is.null(memb_dim)) { - name_exp <- name_exp[-which(name_exp == memb_dim)] - name_obs <- name_obs[-which(name_obs == memb_dim)] + if (memb_dim %in% name_exp) { + name_exp <- name_exp[-which(name_exp == memb_dim)] + } + if (memb_dim %in% name_obs) { + name_obs <- name_obs[-which(name_obs == memb_dim)] + } } if (!is.null(dat_dim)) { name_exp <- name_exp[-which(name_exp == dat_dim)] name_obs <- name_obs[-which(name_obs == dat_dim)] } - if(!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + if (!all(name_exp == name_obs)) { + stop("Parameter 'exp' and 'obs' must have the same dimension names.") + } + if (!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { stop(paste0("Parameter 'exp' and 'obs' must have same length of ", - "all dimension except 'dat_dim' and 'memb_dim'.")) + "all dimensions except 'dat_dim' and 'memb_dim'.")) } if (dim(exp)[time_dim] < 2) { stop("The length of time_dim must be at least 2 to compute RMS.") @@ -202,7 +196,12 @@ RMS <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, dat_dim = NULL, ############################### ## Ensemble mean if (!is.null(memb_dim)) { - exp <- MeanDims(exp, memb_dim, na.rm = T) + if (memb_dim %in% names(dim(exp))) { + exp <- MeanDims(exp, memb_dim, na.rm = T) + } + if (memb_dim %in% names(dim(obs))) { + obs <- MeanDims(obs, memb_dim, na.rm = T) + } } ############################### @@ -268,7 +267,7 @@ RMS <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, dat_dim = NULL, dif[, , i] <- sapply(1:nexp, function(x) {exp[, x] - obs[, i]}) } - rms <- colMeans(dif^2, na.rm = TRUE)^0.5 #array(dim = c(nexp, nobs)) + rms <- colMeans(dif^2, na.rm = TRUE)^0.5 # [nexp, nobs] if (conf) { #NOTE: pval and sign also need #count effective sample along sdate. eno: c(nexp, nobs) diff --git a/R/RMSSS.R b/R/RMSSS.R index 00ccc21..c33a40e 100644 --- a/R/RMSSS.R +++ b/R/RMSSS.R @@ -2,14 +2,12 @@ #' #'Compute the root mean square error skill score (RMSSS) between an array of #'forecast 'exp' and an array of observation 'obs'. The two arrays should -#'have the same dimensions except along dat_dim, where the length can be -#'different, with the number of experiments/models (nexp) and the number of -#'observational datasets (nobs).\cr -#'RMSSS computes the root mean square error skill score of each jexp in 1:nexp -#'against each job in 1:nobs which gives nexp * nobs RMSSS for each grid point +#'have the same dimensions except along 'dat_dim' and 'memb_dim'. The RMSSSs +#'are computed along 'time_dim', the dimension which corresponds to the start +#'date dimension. +#'RMSSS computes the root mean square error skill score of each exp in 1:nexp +#'against each obs in 1:nobs which gives nexp * nobs RMSSS for each grid point #'of the array.\cr -#'The RMSSS are computed along the time_dim dimension which should correspond -#'to the start date dimension.\cr #'The p-value and significance test are optionally provided by an one-sided #'Fisher test or Random Walk test.\cr #' @@ -18,8 +16,9 @@ #' 'obs', then the vector will automatically be 'time_dim'. #'@param obs A named numeric array of observational data which contains at least #' time dimension (time_dim). The dimensions should be the same as parameter -#' 'exp' except the length of 'dat_dim' dimension. It can also be a vector with -#' the same length as 'exp', then the vector will automatically be 'time_dim'. +#' 'exp' except the length of 'dat_dim' and 'memb_dim' dimension. It can also +#' be a vector with the same length as 'exp', then the vector will +#' automatically be 'time_dim'. #'@param ref A named numerical array of the reference forecast data with at #' least time dimension, or 0 (typical climatological forecast) or 1 #' (normalized climatological forecast). If it is an array, the dimensions must @@ -34,8 +33,8 @@ #'@param time_dim A character string indicating the name of dimension along #' which the RMSSS are computed. The default value is 'sdate'. #'@param memb_dim A character string indicating the name of the member dimension -#' to compute the ensemble mean; it should be set to NULL if the parameter 'exp' -#' and 'ref' are already the ensemble mean. The default value is NULL. +#' to compute the ensemble mean; it should be set to NULL if the data are +#' already the ensemble mean. The default value is NULL. #'@param pval A logical value indicating whether to compute or not the p-value #' of the test Ho: RMSSS = 0. The default value is TRUE. #'@param sign A logical value indicating whether to compute or not the @@ -45,6 +44,11 @@ #' statistical significance test. The default value is 0.05. #'@param sig_method A character string indicating the significance method. The #' options are "one-sided Fisher" (default) and "Random Walk". +#'@param sig_method.type A character string indicating the test type of the +#' significance method. Check \code{RandomWalkTest()} parameter +#' \code{test.type} for details if parameter "sig_method" is "Random Walk". The +#' default is NULL (since "one-sided Fisher" doesn't have different test +#' types.) #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -67,6 +71,13 @@ #'} #' #'@examples +#'# Load sample data as in Load() example: +#'example(Load) +#'clim <- Clim(sampleData$mod, sampleData$obs) +#'ano_exp <- Ano(sampleData$mod, clim$clim_exp) +#'ano_obs <- Ano(sampleData$obs, clim$clim_obs) +#'rmsss <- RMSSS(ano_exp, ano_obs, dat_dim = 'dataset', memb_dim = 'member') +#' #' set.seed(1) #' exp1 <- array(rnorm(30), dim = c(dataset = 2, time = 3, memb = 5)) #' set.seed(2) @@ -87,7 +98,7 @@ #'@export RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, memb_dim = NULL, pval = TRUE, sign = FALSE, alpha = 0.05, - sig_method = 'one-sided Fisher', ncores = NULL) { + sig_method = 'one-sided Fisher', sig_method.type = NULL, ncores = NULL) { # Check inputs ## exp, obs, and ref (1) @@ -104,21 +115,17 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, obs <- array(obs, dim = c(length(obs))) names(dim(obs)) <- c(time_dim) } else { - stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", - "dimensions time_dim and dat_dim, or vector of same length.")) + stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", + "dimensions time_dim and dat_dim, or vector of same length.")) } } else if (is.null(dim(exp)) | is.null(dim(obs))) { stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", "dimensions time_dim and dat_dim, or vector of same length.")) } - if(any(is.null(names(dim(exp)))) | any(nchar(names(dim(exp))) == 0) | - any(is.null(names(dim(obs)))) | any(nchar(names(dim(obs))) == 0)) { + if (any(is.null(names(dim(exp)))) | any(nchar(names(dim(exp))) == 0) | + any(is.null(names(dim(obs)))) | any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } - if(!all(names(dim(exp))[-which(names(dim(exp))==memb_dim)] %in% names(dim(obs))[-which(names(dim(exp))==memb_dim)]) | - !all(names(dim(obs))[-which(names(dim(exp))==memb_dim)] %in% names(dim(exp))[-which(names(dim(exp))==memb_dim)])) { - stop("Parameter 'exp' and 'obs' must have same dimension name.") - } if (!is.null(ref)) { if (!is.numeric(ref)) { stop("Parameter 'ref' must be numeric.") @@ -130,6 +137,11 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, } else if (length(ref) != 1 | any(!ref %in% c(0, 1))) { stop("Parameter 'ref' must be a numeric array or number 0 or 1.") } + } else { + ref <- 0 + } + if (!is.array(ref)) { # 0 or 1 + ref <- array(data = ref, dim = dim(exp)) } ## time_dim @@ -157,14 +169,6 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, if (!memb_dim %in% names(dim(exp))) { stop("Parameter 'memb_dim' is not found in 'exp' dimension.") } - if (memb_dim %in% names(dim(obs))) { - if (identical(as.numeric(dim(obs)[memb_dim]), 1)) { - obs <- ClimProjDiags::Subset(x = obs, along = memb_dim, indices = 1, drop = 'selected') - } else { - stop("Not implemented for observations with members ('obs' can have 'memb_dim', ", - "but it should be of length = 1).") - } - } } ## pval if (!is.logical(pval) | length(pval) > 1) { @@ -182,60 +186,76 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, if (length(sig_method) != 1 | !any(sig_method %in% c('one-sided Fisher', 'Random Walk'))) { stop("Parameter 'sig_method' must be one of 'one-sided Fisher' or 'Random Walk'.") } - if (sig_method == "Random Walk" & pval == T) { - warning("p-value cannot be calculated by significance method 'Random Walk'.") - pval <- FALSE + ## sig_method.type + if (sig_method == 'Random Walk') { + if (is.null(sig_method.type)) { + .warning("Parameter 'sig_method.type' must be specified if 'sig_method' is ", + "Random Walk. Assign it as 'two.sided'.") + .warning("Note that in s2dv <= 1.4.1, Random Walk uses 'two.sided.approx' method.", + "If you want to retain the same functionality, please specify parameter ", + "'sig_method.type' as 'two.sided.approx'.") + sig_method.type <- "two.sided" + } + if (!any(sig_method.type %in% c('two.sided.approx', 'two.sided', 'greater', 'less'))) { + stop("Parameter 'sig_method.type' must be a method accepted by RandomWalkTest() parameter 'test.type'.") + } + if (sig_method.type == 'two.sided.approx' & pval == T) { + .warning("p-value cannot be calculated by Random Walk 'two.sided.approx' method.") + pval <- FALSE + 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.") + alpha <- 0.05 + } + } } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | - length(ncores) > 1) { + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } } - ## exp and obs (2) + ## exp, obs, and ref (2) name_exp <- sort(names(dim(exp))) name_obs <- sort(names(dim(obs))) if (!is.null(memb_dim)) { - name_exp <- name_exp[-which(name_exp == memb_dim)] - name_obs <- name_obs[-which(name_obs == memb_dim)] + if (memb_dim %in% name_exp) { + name_exp <- name_exp[-which(name_exp == memb_dim)] + } + if (memb_dim %in% name_obs) { + name_obs <- name_obs[-which(name_obs == memb_dim)] + } } if (!is.null(dat_dim)) { - name_exp <- name_exp[-which(name_exp == dat_dim)] - name_obs <- name_obs[-which(name_obs == dat_dim)] + name_exp <- name_exp[-which(name_exp == dat_dim)] + name_obs <- name_obs[-which(name_obs == dat_dim)] + } + if (!all(name_exp == name_obs)) { + stop("Parameter 'exp' and 'obs' must have the same dimension names.") } - if(!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + if (!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { stop(paste0("Parameter 'exp' and 'obs' must have same length of ", - "all dimension except 'memb_dim' and 'dat_dim'.")) + "all dimensions except 'dat_dim' and 'memb_dim'.")) } - ############################### - # Create ref array if needed - if (is.null(ref)) ref <- 0 - if (!is.array(ref)) { - ref <- array(data = ref, dim = dim(exp)) + name_ref <- sort(names(dim(ref))) + if (!is.null(memb_dim) && memb_dim %in% name_ref) { + name_ref <- name_ref[-which(name_ref == memb_dim)] } - - if (!is.null(ref)) { - name_ref <- sort(names(dim(ref))) - if (!is.null(memb_dim) && memb_dim %in% name_ref) { - name_ref <- name_ref[-which(name_ref == memb_dim)] - } - if (!is.null(dat_dim)) { - if (dat_dim %in% name_ref) { - if (!identical(dim(exp)[dat_dim], dim(ref)[dat_dim])) { - stop(paste0("If parameter 'ref' has dataset dimension, it must be ", - "equal to dataset dimension of 'exp'.")) - } - name_ref <- name_ref[-which(name_ref == dat_dim)] + if (!is.null(dat_dim)) { + if (dat_dim %in% name_ref) { + if (!identical(dim(exp)[dat_dim], dim(ref)[dat_dim])) { + stop(paste0("If parameter 'ref' has dataset dimension, it must be ", + "equal to dataset dimension of 'exp'.")) } + name_ref <- name_ref[-which(name_ref == dat_dim)] } - if (!identical(length(name_exp), length(name_ref)) | - !identical(dim(exp)[name_exp], dim(ref)[name_ref])) { - stop(paste0("Parameter 'exp' and 'ref' must have the same length of ", - "all dimensions except 'memb_dim' and 'dat_dim' if there is ", - "only one reference dataset.")) - } + } + if (!identical(length(name_exp), length(name_ref)) | + !identical(dim(exp)[name_exp], dim(ref)[name_ref])) { + stop(paste0("Parameter 'exp' and 'ref' must have the same length of ", + "all dimensions except 'memb_dim' and 'dat_dim' if there is ", + "only one reference dataset.")) } if (dim(exp)[time_dim] <= 2) { @@ -253,8 +273,13 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, ############################### ## Ensemble mean if (!is.null(memb_dim)) { - exp <- MeanDims(exp, memb_dim, na.rm = T) - if (!is.null(ref) & memb_dim %in% names(dim(ref))) { + if (memb_dim %in% names(dim(exp))) { + exp <- MeanDims(exp, memb_dim, na.rm = T) + } + if (memb_dim %in% names(dim(obs))) { + obs <- MeanDims(obs, memb_dim, na.rm = T) + } + if (memb_dim %in% names(dim(ref))) { ref <- MeanDims(ref, memb_dim, na.rm = T) } } @@ -262,21 +287,6 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, ############################### # Calculate RMSSS -# if (!is.null(ref)) { # use "ref" as reference forecast -# if (!is.null(dat_dim) && dat_dim %in% names(dim(ref))) { -# target_dims_ref <- c(time_dim, dat_dim) -# } else { -# target_dims_ref <- c(time_dim) -# } -# data <- list(exp = exp, obs = obs, ref = ref) -# target_dims = list(exp = c(time_dim, dat_dim), -# obs = c(time_dim, dat_dim), -# ref = target_dims_ref) -# } else { -# data <- list(exp = exp, obs = obs) -# target_dims = list(exp = c(time_dim, dat_dim), -# obs = c(time_dim, dat_dim)) -# } data <- list(exp = exp, obs = obs, ref = ref) if (!is.null(dat_dim)) { if (dat_dim %in% names(dim(ref))) { @@ -297,14 +307,15 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, fun = .RMSSS, time_dim = time_dim, dat_dim = dat_dim, pval = pval, sign = sign, alpha = alpha, - sig_method = sig_method, + sig_method = sig_method, sig_method.type = sig_method.type, ncores = ncores) return(res) } .RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, pval = TRUE, - sign = FALSE, alpha = 0.05, sig_method = 'one-sided Fisher') { + sign = FALSE, alpha = 0.05, sig_method = 'one-sided Fisher', + sig_method.type = NULL) { # exp: [sdate, (dat)] # obs: [sdate, (dat)] # ref: [sdate, (dat)] or NULL @@ -327,8 +338,8 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, dim(ref) <- c(dim(ref), dat = 1) } else { - # exp: [sdate, dat_exp] - # obs: [sdate, dat_obs] + # exp: [sdate, dat_exp] + # obs: [sdate, dat_obs] nexp <- as.numeric(dim(exp)[2]) nobs <- as.numeric(dim(obs)[2]) if (dat_dim %in% names(dim(ref))) { @@ -349,40 +360,25 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, dif1[, , i] <- sapply(1:nexp, function(x) {exp[, x] - obs[, i]}) } - rms_exp <- apply(dif1^2, c(2, 3), mean, na.rm = TRUE)^0.5 #array(dim = c(nexp, nobs)) + rms_exp <- colMeans(dif1^2, na.rm = TRUE)^0.5 # [nexp, nobs] # RMS of reference -# if (!is.null(ref)) { - dif2 <- array(dim = c(nsdate, nref, nobs)) - names(dim(dif2)) <- c(time_dim, 'nexp', 'nobs') - for (i in 1:nobs) { - dif2[, , i] <- sapply(1:nref, function(x) {ref[, x] - obs[, i]}) - } - rms_ref <- apply(dif2^2, c(2, 3), mean, na.rm = TRUE)^0.5 #array(dim = c(nref, nobs)) - if (nexp != nref) { - # expand rms_ref to nexp (nref is 1) - rms_ref <- array(rms_ref, dim = c(nobs = nobs, nexp = nexp)) - rms_ref <- Reorder(rms_ref, c(2, 1)) - } -# } else { -# rms_ref <- array(colMeans(obs^2, na.rm = TRUE)^0.5, dim = c(nobs = nobs, nexp = nexp)) -## rms_ref[which(abs(rms_ref) <= (max(abs(rms_ref), na.rm = TRUE) / 1000))] <- max(abs( -## rms_ref), na.rm = TRUE) / 1000 -# rms_ref <- Reorder(rms_ref, c(2, 1)) -# #rms_ref above: [nexp, nobs] -# } + dif2 <- array(dim = c(nsdate, nref, nobs)) + names(dim(dif2)) <- c(time_dim, 'nexp', 'nobs') + for (i in 1:nobs) { + dif2[, , i] <- sapply(1:nref, function(x) {ref[, x] - obs[, i]}) + } + rms_ref <- colMeans(dif2^2, na.rm = TRUE)^0.5 # [nref, nobs] + if (nexp != nref) { + # expand rms_ref to nexp (nref is 1) + rms_ref <- array(rms_ref, dim = c(nobs = nobs, nexp = nexp)) + rms_ref <- Reorder(rms_ref, c(2, 1)) + } rmsss <- 1 - rms_exp / rms_ref ################################################# -# if (conf) { -# conflow <- alpha / 2 -# confhigh <- 1 - conflow -# conf_low <- array(dim = c(nexp = nexp, nobs = nobs)) -# conf_high <- array(dim = c(nexp = nexp, nobs = nobs)) -# } - if (sig_method == 'one-sided Fisher') { p_val <- array(dim = c(nexp = nexp, nobs = nobs)) ## pval and sign @@ -413,11 +409,12 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, } } else if (sig_method == "Random Walk") { - signif <- array(dim = c(nexp = nexp, nobs = nobs)) + + if (sign) signif <- array(dim = c(nexp = nexp, nobs = nobs)) + if (pval) p_val <- array(dim = c(nexp = nexp, nobs = nobs)) + for (i in 1:nexp) { for (j in 1:nobs) { - - # Error error_exp <- array(data = abs(exp[, i] - obs[, j]), dim = c(time = nsdate)) if (nref == nexp) { error_ref <- array(data = abs(ref[, i] - obs[, j]), dim = c(time = nsdate)) @@ -425,7 +422,11 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, # nref = 1 error_ref <- array(data = abs(ref - obs[, j]), dim = c(time = nsdate)) } - signif[i, j] <- .RandomWalkTest(skill_A = error_exp, skill_B = error_ref)$sign + aux <- .RandomWalkTest(skill_A = error_exp, skill_B = error_ref, + test.type = sig_method.type, + pval = pval, sign = sign, alpha = alpha) + if (sign) signif[i, j] <- aux$sign + if (pval) p_val[i, j] <- aux$p.val } } } @@ -434,7 +435,7 @@ RMSSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', dat_dim = NULL, # Remove extra dimensions if dat_dim = NULL if (is.null(dat_dim)) { dim(rmsss) <- NULL - dim(p_val) <- NULL + if (pval) dim(p_val) <- NULL if (sign) dim(signif) <- NULL } ################################### diff --git a/man/MSE.Rd b/man/MSE.Rd new file mode 100644 index 0000000..291d08c --- /dev/null +++ b/man/MSE.Rd @@ -0,0 +1,102 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/MSE.R +\name{MSE} +\alias{MSE} +\title{Compute mean square error} +\usage{ +MSE( + exp, + obs, + time_dim = "sdate", + dat_dim = NULL, + memb_dim = NULL, + comp_dim = NULL, + limits = NULL, + conf = TRUE, + alpha = 0.05, + ncores = NULL +) +} +\arguments{ +\item{exp}{A named numeric array of experimental data, with at least #' 'time_dim' dimension. It can also be a vector with the same length as 'obs'.} + +\item{obs}{A named numeric array of observational data, same dimensions as +parameter 'exp' except along 'dat_dim' and 'memb_dim'. It can also be a +vector with the same length as 'exp'.} + +\item{time_dim}{A character string indicating the name of dimension along +which the correlations are computed. The default value is 'sdate'.} + +\item{dat_dim}{A character string indicating the name of dataset or member +(nobs/nexp) dimension. The datasets of exp and obs will be paired and +computed MSE for each pair. The default value is NULL.} + +\item{memb_dim}{A character string indicating the name of the member dimension +to compute the ensemble mean; it should be set to NULL if the input data are +already the ensemble mean. The default value is NULL.} + +\item{comp_dim}{A character string indicating the name of dimension along which +obs is taken into account only if it is complete. The default value +is NULL.} + +\item{limits}{A vector of two integers indicating the range along comp_dim to +be completed. The default value is c(1, length(comp_dim dimension)).} + +\item{conf}{A logical value indicating whether to retrieve the confidence +intervals or not. The default value is TRUE.} + +\item{alpha}{A numeric indicating the significance level for 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.} +} +\value{ +A list containing the numeric arrays with dimension:\cr + c(nexp, nobs, all other dimensions of exp except time_dim).\cr +nexp is the number of experiment (i.e., dat_dim in exp), and nobs is the +number of observation (i.e., dat_dim in obs).\cr +\item{$mse}{ + The mean square error. +} +\item{$conf.lower}{ + The lower confidence interval. Only present if \code{conf = TRUE}. +} +\item{$conf.upper}{ + The upper confidence interval. Only present if \code{conf = TRUE}. +} +} +\description{ +Compute the mean square error for an array of forecasts and an array of +observations. The MSEs are computed along time_dim, the dimension which +corresponds to the start date dimension. If comp_dim is given, the MSEs are +computed only if obs along the comp_dim dimension are complete between +limits[1] and limits[2], i.e. there are no NAs between limits[1] and +limits[2]. This option can be activated if the user wants to account only +for the forecasts for which the corresponding observations are available at +all leadtimes.\cr +The confidence interval is computed by the chi2 distribution.\cr +} +\examples{ +# Load sample data as in Load() example: +example(Load) +clim <- Clim(sampleData$mod, sampleData$obs) +ano_exp <- Ano(sampleData$mod, clim$clim_exp) +ano_obs <- Ano(sampleData$obs, clim$clim_obs) +smooth_ano_exp <- Smoothing(ano_exp, runmeanlen = 12, time_dim = 'ftime') +smooth_ano_obs <- Smoothing(ano_obs, runmeanlen = 12, time_dim = 'ftime') +res <- MSE(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member', + comp_dim = 'ftime', limits = c(7, 54)) + +# Synthetic data: +exp1 <- array(rnorm(120), dim = c(dat = 3, sdate = 10, ftime = 4)) +obs1 <- array(rnorm(80), dim = c(dat = 2, sdate = 10, ftime = 4)) +na <- floor(runif(10, min = 1, max = 80)) +obs1[na] <- NA +res1 <- MSE(exp1, obs1, comp_dim = 'ftime', dat_dim = 'dat') + +exp2 <- array(rnorm(20), dim = c(sdate = 5, member = 4)) +obs2 <- array(rnorm(10), dim = c(sdate = 5, member = 2)) +res2 <- MSE(exp3, obs3, memb_dim = 'member') + +} diff --git a/man/MSSS.Rd b/man/MSSS.Rd new file mode 100644 index 0000000..33df450 --- /dev/null +++ b/man/MSSS.Rd @@ -0,0 +1,117 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/MSSS.R +\name{MSSS} +\alias{MSSS} +\title{Compute mean square error skill score} +\usage{ +MSSS( + exp, + obs, + ref = NULL, + time_dim = "sdate", + dat_dim = NULL, + memb_dim = NULL, + pval = TRUE, + sign = FALSE, + alpha = 0.05, + sig_method = "one-sided Fisher", + sig_method.type = NULL, + ncores = NULL +) +} +\arguments{ +\item{exp}{A named numeric array of experimental data which contains at least +time dimension (time_dim). It can also be a vector with the same length as +'obs', then the vector will automatically be 'time_dim'.} + +\item{obs}{A named numeric array of observational data which contains at least +time dimension (time_dim). The dimensions should be the same as parameter +'exp' except the length of 'dat_dim' and 'memb_dim' dimension. It can also +be a vector with the same length as 'exp', then the vector will +automatically be 'time_dim'.} + +\item{ref}{A named numerical array of the reference forecast data with at +least time dimension, or 0 (typical climatological forecast) or 1 +(normalized climatological forecast). If it is an array, the dimensions must +be the same as 'exp' except 'memb_dim' and 'dat_dim'. If there is only one +reference dataset, it should not have dataset dimension. If there is +corresponding reference for each experiment, the dataset dimension must +have the same length as in 'exp'. If 'ref' is NULL, the typical +climatological forecast is used as reference forecast (equivalent to 0.) +The default value is NULL.} + +\item{time_dim}{A character string indicating the name of dimension along +which the MSSS are computed. The default value is 'sdate'.} + +\item{dat_dim}{A character string indicating the name of dataset (nobs/nexp) +dimension. The default value is NULL.} + +\item{memb_dim}{A character string indicating the name of the member dimension +to compute the ensemble mean; it should be set to NULL if the data are +already the ensemble mean. The default value is NULL.} + +\item{pval}{A logical value indicating whether to compute or not the p-value +of the test Ho: MSSS = 0. The default value is TRUE.} + +\item{sign}{A logical value indicating whether to compute or not the +statistical significance of the test Ho: MSSS = 0. 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.} + +\item{sig_method}{A character string indicating the significance method. The +options are "one-sided Fisher" (default) and "Random Walk".} + +\item{sig_method.type}{A character string indicating the test type of the +significance method. Check \code{RandomWalkTest()} parameter +\code{test.type} for details if parameter "sig_method" is "Random Walk". The +default is NULL (since "one-sided Fisher" doesn't have different test +types.)} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A list containing the numeric arrays with dimension:\cr + c(nexp, nobs, all other dimensions of exp except time_dim).\cr +nexp is the number of experiment (i.e., dat_dim in exp), and nobs is the +number of observation (i.e., dat_dim in obs). If dat_dim is NULL, nexp and +nobs are omitted.\cr +\item{$msss}{ + A numerical array of the mean square error skill score. +} +\item{$p.val}{ + A numerical array of the p-value with the same dimensions as $msss. + Only present if \code{pval = TRUE}. +} +\item{sign}{ + A logical array of the statistical significance of the MSSS with the same + dimensions as $msss. Only present if \code{sign = TRUE}. +} +} +\description{ +Compute the mean square error skill score (MSSS) between an array of forecast +'exp' and an array of observation 'obs'. The two arrays should have the same +dimensions except along 'dat_dim' and 'memb_dim'. The MSSSs are computed along +'time_dim', the dimension which corresponds to the start date dimension. +MSSS computes the mean square error skill score of each exp in 1:nexp +against each obs in 1:nobs which gives nexp * nobs MSSS for each grid point +of the array.\cr +The p-value and significance test are optionally provided by an one-sided +Fisher test or Random Walk test.\cr +} +\examples{ +# Load sample data as in Load() example: +example(Load) +clim <- Clim(sampleData$mod, sampleData$obs) +ano_exp <- Ano(sampleData$mod, clim$clim_exp) +ano_obs <- Ano(sampleData$obs, clim$clim_obs) +rmsss <- MSSS(ano_exp, ano_obs, dat_dim = 'dataset', memb_dim = 'member') + +# Synthetic data: +exp <- array(rnorm(30), dim = c(dataset = 2, time = 3, memb = 5)) +obs <- array(rnorm(15), dim = c(time = 3, dataset = 1)) +res <- MSSS(exp, obs, time_dim = 'time', dat_dim = 'dataset', memb_dim = 'memb') + +} diff --git a/man/RMS.Rd b/man/RMS.Rd index 9d02d82..b7c044f 100644 --- a/man/RMS.Rd +++ b/man/RMS.Rd @@ -8,6 +8,7 @@ RMS( exp, obs, time_dim = "sdate", + memb_dim = NULL, dat_dim = NULL, comp_dim = NULL, limits = NULL, @@ -17,19 +18,20 @@ RMS( ) } \arguments{ -\item{exp}{A named numeric array of experimental data, with at least two -dimensions 'time_dim' and 'dat_dim'. It can also be a vector with the -same length as 'obs', then the vector will automatically be 'time_dim' and -'dat_dim' will be 1.} +\item{exp}{A named numeric array of experimental data, with at least +'time_dim' dimension. It can also be a vector with the same length as 'obs'.} \item{obs}{A named numeric array of observational data, same dimensions as -parameter 'exp' except along dat_dim. It can also be a vector with the same -length as 'exp', then the vector will automatically be 'time_dim' and -'dat_dim' will be 1.} +parameter 'exp' except along 'dat_dim' and 'memb_dim'. It can also be a +vector with the same length as 'exp'.} \item{time_dim}{A character string indicating the name of dimension along which the correlations are computed. The default value is 'sdate'.} +\item{memb_dim}{A character string indicating the name of the member dimension +to compute the ensemble mean; it should be set to NULL if the input data are +already the ensemble mean. The default value is NULL.} + \item{dat_dim}{A character string indicating the name of dataset or member (nobs/nexp) dimension. The datasets of exp and obs will be paired and computed RMS for each pair. The default value is NULL.} @@ -69,7 +71,7 @@ nobs are omitted.\cr \description{ Compute the root mean square error for an array of forecasts and an array of observations. The RMSEs are computed along time_dim, the dimension which -corresponds to the startdate dimension. If comp_dim is given, the RMSEs are +corresponds to the start date dimension. If comp_dim is given, the RMSEs are computed only if obs along the comp_dim dimension are complete between limits[1] and limits[2], i.e. there are no NAs between limits[1] and limits[2]. This option can be activated if the user wishes to account only @@ -79,14 +81,24 @@ The confidence interval is computed by the chi2 distribution.\cr } \examples{ # Load sample data as in Load() example: - set.seed(1) - exp1 <- array(rnorm(120), dim = c(dat = 3, sdate = 5, ftime = 2, lon = 1, lat = 4)) - set.seed(2) - obs1 <- array(rnorm(80), dim = c(dat = 2, sdate = 5, ftime = 2, lon = 1, lat = 4)) - set.seed(2) - na <- floor(runif(10, min = 1, max = 80)) - obs1[na] <- NA - res <- RMS(exp1, obs1, comp_dim = 'ftime', dat_dim = 'dat') - # Renew example when Ano and Smoothing are ready +example(Load) +clim <- Clim(sampleData$mod, sampleData$obs) +ano_exp <- Ano(sampleData$mod, clim$clim_exp) +ano_obs <- Ano(sampleData$obs, clim$clim_obs) +smooth_ano_exp <- Smoothing(ano_exp, runmeanlen = 12, time_dim = 'ftime') +smooth_ano_obs <- Smoothing(ano_obs, runmeanlen = 12, time_dim = 'ftime') +res <- RMS(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member', + comp_dim = 'ftime', limits = c(7, 54)) +# Synthetic data: +exp1 <- array(rnorm(120), dim = c(dat = 3, sdate = 10, ftime = 4)) +obs1 <- array(rnorm(80), dim = c(dat = 2, sdate = 10, ftime = 4)) +na <- floor(runif(10, min = 1, max = 80)) +obs1[na] <- NA +res1 <- RMS(exp1, obs1, comp_dim = 'ftime', dat_dim = 'dat') + +exp2 <- array(rnorm(20), dim = c(sdate = 5, member = 4)) +obs2 <- array(rnorm(10), dim = c(sdate = 5, member = 2)) +res2 <- RMS(exp3, obs3, memb_dim = 'member') + } diff --git a/man/RMSSS.Rd b/man/RMSSS.Rd index c647c71..7b31e26 100644 --- a/man/RMSSS.Rd +++ b/man/RMSSS.Rd @@ -15,6 +15,7 @@ RMSSS( sign = FALSE, alpha = 0.05, sig_method = "one-sided Fisher", + sig_method.type = NULL, ncores = NULL ) } @@ -25,8 +26,9 @@ time dimension (time_dim). It can also be a vector with the same length as \item{obs}{A named numeric array of observational data which contains at least time dimension (time_dim). The dimensions should be the same as parameter -'exp' except the length of 'dat_dim' dimension. It can also be a vector with -the same length as 'exp', then the vector will automatically be 'time_dim'.} +'exp' except the length of 'dat_dim' and 'memb_dim' dimension. It can also +be a vector with the same length as 'exp', then the vector will +automatically be 'time_dim'.} \item{ref}{A named numerical array of the reference forecast data with at least time dimension, or 0 (typical climatological forecast) or 1 @@ -35,7 +37,7 @@ be the same as 'exp' except 'memb_dim' and 'dat_dim'. If there is only one reference dataset, it should not have dataset dimension. If there is corresponding reference for each experiment, the dataset dimension must have the same length as in 'exp'. If 'ref' is NULL, the typical -climatological forecast is used as reference forecast (equivelant to 0.) +climatological forecast is used as reference forecast (equivalent to 0.) The default value is NULL.} \item{time_dim}{A character string indicating the name of dimension along @@ -45,8 +47,8 @@ which the RMSSS are computed. The default value is 'sdate'.} dimension. The default value is NULL.} \item{memb_dim}{A character string indicating the name of the member dimension -to compute the ensemble mean; it should be set to NULL if the parameter 'exp' -and 'ref' are already the ensemble mean. The default value is NULL.} +to compute the ensemble mean; it should be set to NULL if the data are +already the ensemble mean. The default value is NULL.} \item{pval}{A logical value indicating whether to compute or not the p-value of the test Ho: RMSSS = 0. The default value is TRUE.} @@ -61,6 +63,12 @@ statistical significance test. The default value is 0.05.} \item{sig_method}{A character string indicating the significance method. The options are "one-sided Fisher" (default) and "Random Walk".} +\item{sig_method.type}{A character string indicating the test type of the +significance method. Check \code{RandomWalkTest()} parameter +\code{test.type} for details if parameter "sig_method" is "Random Walk". The +default is NULL (since "one-sided Fisher" doesn't have different test +types.)} + \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } @@ -85,22 +93,35 @@ nobs are omitted.\cr \description{ Compute the root mean square error skill score (RMSSS) between an array of forecast 'exp' and an array of observation 'obs'. The two arrays should -have the same dimensions except along dat_dim, where the length can be -different, with the number of experiments/models (nexp) and the number of -observational datasets (nobs).\cr -RMSSS computes the root mean square error skill score of each jexp in 1:nexp -against each job in 1:nobs which gives nexp * nobs RMSSS for each grid point +have the same dimensions except along 'dat_dim' and 'memb_dim'. The RMSSSs +are computed along 'time_dim', the dimension which corresponds to the start +date dimension. +RMSSS computes the root mean square error skill score of each exp in 1:nexp +against each obs in 1:nobs which gives nexp * nobs RMSSS for each grid point of the array.\cr -The RMSSS are computed along the time_dim dimension which should correspond -to the start date dimension.\cr The p-value and significance test are optionally provided by an one-sided Fisher test or Random Walk test.\cr } \examples{ +# Load sample data as in Load() example: +example(Load) +clim <- Clim(sampleData$mod, sampleData$obs) +ano_exp <- Ano(sampleData$mod, clim$clim_exp) +ano_obs <- Ano(sampleData$obs, clim$clim_obs) +rmsss <- RMSSS(ano_exp, ano_obs, dat_dim = 'dataset', memb_dim = 'member') + set.seed(1) -exp <- array(rnorm(30), dim = c(dataset = 2, time = 3, memb = 5)) +exp1 <- array(rnorm(30), dim = c(dataset = 2, time = 3, memb = 5)) set.seed(2) -obs <- array(rnorm(15), dim = c(time = 3, memb = 5, dataset = 1)) -res <- RMSSS(exp, obs, time_dim = 'time', dat_dim = 'dataset') +obs1 <- array(rnorm(15), dim = c(time = 3, memb = 5, dataset = 1)) +res1 <- RMSSS(exp1, obs1, time_dim = 'time', dat_dim = 'dataset') + +exp2 <- array(rnorm(30), dim = c(lat = 2, time = 3, memb = 5)) +obs2 <- array(rnorm(15), dim = c(time = 3, lat = 2)) +res2 <- RMSSS(exp2, obs2, time_dim = 'time', memb_dim = 'memb') + +exp3 <- array(rnorm(30), dim = c(lat = 2, time = 3)) +obs3 <- array(rnorm(15), dim = c(time = 3, lat = 2)) +res3 <- RMSSS(exp3, obs3, time_dim = 'time') } diff --git a/tests/testthat/test-CRPSS.R b/tests/testthat/test-CRPSS.R index 505f3d4..5311724 100644 --- a/tests/testthat/test-CRPSS.R +++ b/tests/testthat/test-CRPSS.R @@ -144,7 +144,7 @@ test_that("2. Output checks: dat1", { ) expect_equal( as.vector(CRPSS(exp1, obs1)$sign), - c(FALSE, FALSE), + c(FALSE, FALSE) ) expect_equal( as.vector(CRPSS(exp1, obs1, Fair = T)$crpss), @@ -220,7 +220,7 @@ test_that("3. Output checks: dat2", { expect_equal( as.vector(CRPSS(exp2, obs2)$sign), - FALSE, + FALSE ) expect_equal( as.vector(CRPSS(exp2, obs2, Fair = T)$crpss), @@ -273,7 +273,7 @@ test_that("4. Output checks: dat3", { ) expect_equal( as.vector(CRPSS(exp3, obs3, dat_dim = 'dataset')$sign), - rep(FALSE, 6), + rep(FALSE, 6) ) expect_equal( mean(CRPSS(exp3, obs3, dat_dim = 'dataset', Fair = T)$crpss), diff --git a/tests/testthat/test-EOF.R b/tests/testthat/test-EOF.R index 4e95aa3..828bd52 100644 --- a/tests/testthat/test-EOF.R +++ b/tests/testthat/test-EOF.R @@ -72,7 +72,7 @@ test_that("1. Input checks", { "length as the longitude dimension of 'ano'.") ) expect_warning( - EOF(dat1, lat = lat1, lon = c(350, 370)), + EOF(dat1, lat = lat1, lon = c(350, 370), neofs = 8), "Some 'lon' is out of the range \\[-360, 360\\]." ) # neofs diff --git a/tests/testthat/test-MSE.R b/tests/testthat/test-MSE.R new file mode 100644 index 0000000..05bba2d --- /dev/null +++ b/tests/testthat/test-MSE.R @@ -0,0 +1,259 @@ +############################################## + # dat1 + set.seed(1) + exp1 <- array(rnorm(120), dim = c(dataset = 3, sdate = 5, ftime = 2, lon = 1, lat = 4)) + set.seed(2) + obs1 <- array(rnorm(80), dim = c(dataset = 2, sdate = 5, ftime = 2, lon = 1, lat = 4)) + set.seed(2) + na <- floor(runif(10, min = 1, max = 80)) + obs1[na] <- NA + + # dat 2: vector + set.seed(5) + exp2 <- rnorm(10) + set.seed(6) + obs2 <- rnorm(10) + + # dat3 + set.seed(1) + exp3 <- array(rnorm(120), dim = c(sdate = 5, ftime = 2, member = 3)) + set.seed(2) + obs3 <- array(rnorm(80), dim = c(sdate = 5, ftime = 2, member = 2)) + + # dat4 + set.seed(1) + exp4 <- array(rnorm(120), dim = c(dataset = 2, sdate = 5, time = 1)) + set.seed(2) + obs4 <- array(rnorm(80), dim = c(dataset = 1, sdate = 5, member = 2, time = 1)) + +############################################## +test_that("1. Input checks", { + + expect_error( + MSE(c(), c()), + "Parameter 'exp' and 'obs' cannot be NULL." + ) + expect_error( + MSE(c('b'), c('a')), + "Parameter 'exp' and 'obs' must be a numeric array." + ) + expect_error( + MSE(c(1:10), c(2:4)), + "Parameter 'exp' and 'obs' must be array with as least two dimensions time_dim and dat_dim, or vector of same length." + ) + expect_error( + MSE(array(1:10, dim = c(2, 5)), array(1:4, dim = c(2, 2))), + "Parameter 'exp' and 'obs' must have dimension names." + ) + expect_error( + MSE(array(1:20, dim = c(dat = 2, sdate = 5, member = 2)), + array(1:10, dim = c(dat = 2, sdate = 5, time = 1))), + "Parameter 'exp' and 'obs' must have the same dimension names." + ) + expect_error( + MSE(exp1, obs1, dat_dim = 1), + "Parameter 'dat_dim' must be a character string." + ) + expect_error( + MSE(exp1, obs1, dat_dim = 'a'), + "Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension." + ) + expect_error( + MSE(exp1, obs1, time_dim = c('sdate', 'a')), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + MSE(exp1, obs1, time_dim = 'a'), + "Parameter 'time_dim' is not found in 'exp' or 'obs' dimension." + ) + expect_error( + MSE(exp1, obs1, comp_dim = c('sdate', 'ftime')), + "Parameter 'comp_dim' must be a character string." + ) + expect_error( + MSE(exp1, obs1, comp_dim = 'a'), + "Parameter 'comp_dim' is not found in 'exp' or 'obs' dimension." + ) + expect_error( + MSE(exp1, obs1, limits = c(1,3)), + "Paramter 'comp_dim' cannot be NULL if 'limits' is assigned." + ) + expect_error( + MSE(exp1, obs1, comp_dim = 'ftime', limits = c(1)), + paste0("Parameter 'limits' must be a vector of two positive ", + "integers smaller than the length of paramter 'comp_dim'.") + ) + expect_error( + MSE(exp1, obs1, alpha = -1), + "Parameter 'alpha' must be a numeric number between 0 and 1." + ) + expect_error( + MSE(exp1, obs1, conf = 1), + "Parameter 'conf' must be one logical value." + ) + expect_error( + MSE(exp1, obs1, ncores = 1.5), + "Parameter 'ncores' must be a positive integer." + ) + expect_error( + MSE(exp = array(1:10, dim = c(dataset = 1, member = 5, sdate = 1)), + obs = array(1:4, dim = c(dataset = 2, member = 2, sdate = 2))), + "Parameter 'exp' and 'obs' must have same length of all dimensions except 'dat_dim' and 'memb_dim'." + ) + expect_error( + MSE(exp = array(1:5, dim = c(sdate = 1, dataset = 5, a = 1)), + obs = array(1:2, dim = c(a = 1, sdate = 1, dataset = 2)), dat_dim = "dataset"), + "The length of time_dim must be at least 2 to compute MSE." + ) + + + +}) + +############################################## +test_that("2. Output checks: dat1", { +suppressWarnings( + expect_equal( + dim(MSE(exp1, obs1, dat_dim = 'dataset')$mse), + c(nexp = 3, nobs = 2, ftime = 2, lon = 1, lat = 4) + ) +) +suppressWarnings( + expect_equal( + MSE(exp1, obs1, dat_dim = 'dataset')$mse[1:6], + c(1.2815677, 2.0832803, 1.1894637, 1.3000403, 1.4053807, 0.8157563)^2, + tolerance = 0.001 + ) +) +suppressWarnings( + expect_equal( + length(which(is.na(MSE(exp1, obs1, dat_dim = 'dataset')$conf.lower))), + 4 + ) +) +suppressWarnings( + expect_equal( + c(MSE(exp1, obs1, dat_dim = 'dataset')$conf.lower[2,1,,1,2:3]), + c(1.8869268, 0.4418298, 0.2694637, 0.8215383), + tolerance = 0.001 + ) +) +suppressWarnings( + expect_equal( + length(which(is.na(MSE(exp1, obs1, dat_dim = 'dataset', comp_dim = 'ftime')$mse))), + 0 + ) +) +suppressWarnings( + expect_equal( + length(which(is.na(MSE(exp1, obs1, dat_dim = 'dataset', comp_dim = 'ftime')$conf.upper))), + 8 + ) +) +suppressWarnings( + expect_equal( + length(which(is.na(MSE(exp1, obs1, dat_dim = 'dataset', comp_dim = 'lat')$conf.lower))), + 36 + ) +) +suppressWarnings( + expect_equal( + length(which(is.na(MSE(exp1, obs1, dat_dim = 'dataset', comp_dim = 'lat', limits = c(1, 2))$conf.lower))), + 21 + ) +) +suppressWarnings( + expect_equal( + c(MSE(exp1, obs1, dat_dim = 'dataset', alpha = 0.01)$conf.upper[2,1,,1,2:3]), + c(13.844841, 5.044269, 1.977121, 6.027826), + tolerance = 0.0001 + ) +) +suppressWarnings( + expect_equal( + length(MSE(exp1, obs1, dat_dim = 'dataset', conf = FALSE)), + 1 + ) +) + + +}) + +############################################## +test_that("3. Output checks: dat2", { + + expect_equal( + dim(MSE(exp2, obs2)$mse), + NULL + ) + + expect_equal( + as.vector(MSE(exp2, obs2)$mse), + 1.429815^2, + tolerance = 0.00001 + ) +}) + +############################################## +test_that("4. Output checks: dat3", { + + expect_equal( + dim(MSE(exp3, obs3, dat_dim = NULL, memb_dim = 'member')$mse), + c(ftime = 2) + ) + + expect_equal( + as.vector(MSE(exp3, obs3, dat_dim = NULL, memb_dim = 'member')$mse), + c(0.6191331, 0.7133894)^2, + tolerance = 0.00001 + ) + expect_equal( + names(MSE(exp3, obs3, dat_dim = NULL, memb_dim = 'member', conf = FALSE)), + c("mse") + ) + expect_equal( + names(MSE(exp3, obs3, dat_dim = NULL, memb_dim = 'member', conf = TRUE)), + c('mse', 'conf.lower', 'conf.upper') + ) + expect_equal( + c(MSE(exp3, obs3, dat_dim = NULL, memb_dim = 'member')$conf.lower), + c(0.2567713, 0.3409037), + tolerance = 0.0001 + ) + expect_equal( + c(MSE(exp3, obs3, dat_dim = NULL, memb_dim = 'member')$conf.upper), + c(1.231523, 1.635038), + tolerance = 0.0001 + ) + +}) + +############################################## + +test_that("5. Output checks: dat4", { + + expect_equal( + dim(MSE(exp4, obs4, dat_dim = 'dataset', memb_dim = 'member')$mse), + c(nexp = 2, nobs = 1, time = 1) + ) + expect_equal( + c(MSE(exp4, obs4, dat_dim = 'dataset', memb_dim = 'member')$mse), + c(0.6775320, 0.8954404)^2, + tolerance = 0.0001 + ) + expect_equal( + c(MSE(exp4, obs4, dat_dim = 'dataset', memb_dim = 'member')$conf.lower), + c(0.3074949, 0.5370958), + tolerance = 0.0001 + ) + expect_equal( + c(MSE(exp4, obs4, dat_dim = 'dataset', memb_dim = 'member')$conf.upper), + c(1.474804, 2.576013), + tolerance = 0.0001 + ) + + +}) + +############################################## + diff --git a/tests/testthat/test-MSSS.R b/tests/testthat/test-MSSS.R new file mode 100644 index 0000000..29952fa --- /dev/null +++ b/tests/testthat/test-MSSS.R @@ -0,0 +1,265 @@ +############################################## + # case 1 + set.seed(1) + exp1 <- array(rnorm(15), dim = c(sdate = 3, dataset = 5)) + set.seed(2) + obs1 <- array(rnorm(6), dim = c(sdate = 3, dataset = 2)) + set.seed(3) + ref1_1 <- array(rnorm(15), dim = c(sdate = 3, dataset = 5)) + ref1_2 <- exp1[, 3] + dim(ref1_2) <- c(sdate = 3) + + # case 2 + set.seed(3) + exp2 <- array(rnorm(30), dim = c(dataset = 3, sdate = 5, member = 3)) + set.seed(4) + obs2 <- array(rnorm(20), dim = c(dataset = 2, sdate = 5, member = 2)) + set.seed(5) + ref2 <- array(rnorm(15), dim = c(sdate = 5, member = 3)) + + # case 3: vector + set.seed(5) + exp3 <- rnorm(10) + set.seed(6) + obs3 <- rnorm(10) + + +############################################## + +test_that("1. Input checks", { + ## exp and obs (1) + expect_error( + MSSS(c(), c()), + "Parameter 'exp' and 'obs' cannot be NULL." + ) + expect_error( + MSSS('exp', 'obs'), + "Parameter 'exp' and 'obs' must be a numeric array." + ) + expect_error( + MSSS(c(1:10), c(2:4)), + paste0("Parameter 'exp' and 'obs' must be array with as least two dimensions ", + "time_dim and dat_dim, or vector of same length.") + ) + expect_error( + MSSS(array(1:10, dim = c(2, 5)), array(1:10, dim = c(2, 5))), + "Parameter 'exp' and 'obs' must have dimension names." + ) + expect_error( + MSSS(array(1:20, dim = c(dat = 2, sdate = 5, member = 2)), + array(1:10, dim = c(dat = 2, sdate = 5, time = 1))), + "Parameter 'exp' and 'obs' must have the same dimension names." + ) + ## time_dim + expect_error( + MSSS(exp1, obs1, time_dim = 1), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + MSSS(exp1, obs1, time_dim = 'a'), + "Parameter 'time_dim' is not found in 'exp' or 'obs' dimension." + ) + ## dat_dim + expect_error( + MSSS(exp1, obs1, dat_dim = NA), + "Parameter 'dat_dim' must be a character string." + ) + expect_error( + MSSS(exp1, obs1, dat_dim = 'memb'), + paste0("Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension.", + " Set it as NULL if there is no dataset dimension.") + ) + ## pval + expect_error( + MSSS(exp1, obs1, pval = c(T, T)), + "Parameter 'pval' must be one logical value." + ) + ## sign + expect_error( + MSSS(exp1, obs1, sign = 0.05), + "Parameter 'sign' must be one logical value." + ) + ## alpha + expect_error( + MSSS(exp1, obs1, alpha = T), + "Parameter 'alpha' must be one numeric value." + ) + ## ncores + expect_error( + MSSS(exp1, obs1, ncores = 1.4), + "Parameter 'ncores' must be a positive integer." + ) + ## exp and obs (2) + expect_error( + MSSS(exp = array(1:10, dim = c(dataset = 1, member = 5, sdate = 1)), + obs = array(1:4, dim = c(dataset = 2, member = 2, sdate = 2))), + "Parameter 'exp' and 'obs' must have same length of all dimensions except 'dat_dim' and 'memb_dim'." + ) + expect_error( + MSSS(exp = array(1:10, dim = c(sdate = 1, dataset = 5, a = 1)), + obs = array(1:4, dim = c(a = 1, sdate = 1, dataset = 2)), dat_dim = "dataset"), + "The length of time_dim must be more than 2 to compute MSSS." + ) +}) + +############################################## +test_that("2. Output checks: case 1", { + + res1_1 <- MSSS(exp1, obs1, dat_dim = 'dataset') + expect_equal( + dim(res1_1$msss), + c(nexp = 5, nobs = 2) + ) + expect_equal( + dim(res1_1$p.val), + c(nexp = 5, nobs = 2) + ) + expect_equal( + c(res1_1$msss)[3:8], + c(0.03359106, -0.05535409, -0.80010171, 0.03151828, -5.53371892, -1.67639444), + tolerance = 0.00001 + ) + expect_equal( + as.vector(res1_1$p.val)[3:7], + c(0.4829225, 0.5269121, 0.7641713, 0.4839926, 0.9771112), + tolerance = 0.001 + ) + + exp1_2 <- exp1; exp1_2[2:4] <- NA + obs1_2 <- obs1; obs1_2[1:2] <- NA + res1_2 <- MSSS(exp1_2, obs1_2, dat_dim = 'dataset', pval = T, sign = T) + + expect_equal( + names(res1_2), + c("msss", "p.val", "sign") + ) + expect_equal( + c(res1_2$msss), + c(rep(NA, 7), -1.676394, -1.520840, -3.455754), + tolerance = 0.0001 + ) + expect_equal( + c(res1_2$p.val), + c(rep(NA, 7), 0.8774973, 0.8640313, 0.9520470), + tolerance = 0.0001 + ) + expect_equal( + c(res1_2$sign), + c(rep(NA, 7), rep(FALSE, 3)) + ) + + #ref + res1_3 <- MSSS(exp1, obs1, ref = ref1_1, dat_dim = 'dataset') + expect_equal( + dim(res1_3$msss), + c(nexp = 5, nobs = 2) + ) + expect_equal( + dim(res1_3$p.val), + c(nexp = 5, nobs = 2) + ) + expect_equal( + as.vector(res1_3$msss[2, ]), + c(-3.828708, -96.610622), + tolerance = 0.0001 + ) + expect_equal( + as.vector(res1_3$p.val[2, ]), + c(0.9588755, 0.9998951), + tolerance = 0.0001 + ) + res1_4 <- MSSS(exp1, obs1, ref = ref1_2, dat_dim = 'dataset', sign = T, alpha = 0.3) + expect_equal( + dim(res1_4$msss), + c(nexp = 5, nobs = 2) + ) + expect_equal( + dim(res1_4$sign), + c(nexp = 5, nobs = 2) + ) + expect_equal( + as.vector(res1_4$msss[2, ]), + c(-2.705537, -1.441239), + tolerance = 0.0001 + ) + expect_equal( + as.vector(res1_4$p[2, ]), + c(0.9321160, 0.8563146), + tolerance = 0.0001 + ) + expect_equal( + as.vector(res1_4$sign), + c(rep(F, 5), T, rep(F, 4)) + ) + + # Random Walk + suppressWarnings({ + res1_5 <- MSSS(exp1, obs1, ref = ref1_1, dat_dim = 'dataset', sig_method = "Random Walk", pval = F, sign = T, sig_method.type = 'two.sided') + }) + expect_equal( + as.vector(res1_5$sign), + rep(F, 10) + ) + suppressWarnings({ + res1_6 <- MSSS(exp1, obs1, ref = NULL, dat_dim = 'dataset', sig_method = "Random Walk", pval = T, sign = T, sig_method.type = 'two.sided') + }) + expect_equal( + as.vector(res1_6$p), + c(1, 1, 1, 1, 1, 1, 0.25, 0.25, 1, 1) + ) + expect_equal( + as.vector(res1_6$sign), + rep(F, 10) + ) + +}) + + +############################################## +test_that("3. Output checks: case 2", { + res1 <- MSSS(exp2, obs2, ref2, dat_dim = "dataset", memb_dim = 'member', sign = T) + expect_equal( + dim(res1$msss), + c(nexp = 3, nobs = 2) + ) + expect_equal( + dim(res1$sign), + c(nexp = 3, nobs = 2) + ) + expect_equal( + dim(res1$p), + c(nexp = 3, nobs = 2) + ) + expect_equal( + c(res1$msss), + c(-0.18155696, 0.51980557, -0.66121915, -0.08753543, 0.62908575, -0.95419385), + tolerance = 0.0001 + ) + expect_equal( + c(res1$p), + c(0.62284746, 0.09217502, 0.82539496, 0.56264155, 0.04034091, 0.88868245), + tolerance = 0.0001 + ) + + res2 <- MSSS(apply(exp2, 1:2, mean), apply(obs2, 1:2, mean), array(apply(ref2, 1, mean), dim = c(sdate = 5)), dat_dim = "dataset", sign = T) + expect_equal( + res1, res2 + ) + +}) + +############################################## + +test_that("4. Output checks: case 3", { + + expect_equal( + dim(MSSS(exp3, obs3)$msss), + NULL + ) + expect_equal( + as.vector(MSSS(exp3, obs3)$msss), + -1.653613, + tolerance = 0.00001 + ) + +}) diff --git a/tests/testthat/test-RMS.R b/tests/testthat/test-RMS.R index c24a2a9..660f4e7 100644 --- a/tests/testthat/test-RMS.R +++ b/tests/testthat/test-RMS.R @@ -2,7 +2,6 @@ # dat1 set.seed(1) exp1 <- array(rnorm(120), dim = c(dataset = 3, sdate = 5, ftime = 2, lon = 1, lat = 4)) - set.seed(2) obs1 <- array(rnorm(80), dim = c(dataset = 2, sdate = 5, ftime = 2, lon = 1, lat = 4)) set.seed(2) @@ -17,17 +16,15 @@ # dat3 set.seed(1) - exp3 <- array(rnorm(120), dim = c(sdate = 5, ftime = 2, lon = 1, lat = 4)) - + exp3 <- array(rnorm(120), dim = c(sdate = 5, ftime = 2, member = 3)) set.seed(2) - obs3 <- array(rnorm(80), dim = c(sdate = 5, ftime = 2, lon = 1, lat = 4)) + obs3 <- array(rnorm(80), dim = c(sdate = 5, ftime = 2, member = 2)) # dat4 set.seed(1) - exp4 <- array(rnorm(120), dim = c(sdates = 5, ftimes = 2, lon = 1, lat = 1)) - + exp4 <- array(rnorm(120), dim = c(dataset = 2, sdate = 5, time = 1)) set.seed(2) - obs4 <- array(rnorm(80), dim = c(sdates = 5, ftimes = 2, lon = 1, lat = 1)) + obs4 <- array(rnorm(80), dim = c(dataset = 1, sdate = 5, member = 2, time = 1)) ############################################## test_that("1. Input checks", { @@ -49,8 +46,9 @@ test_that("1. Input checks", { "Parameter 'exp' and 'obs' must have dimension names." ) expect_error( - RMS(array(1:10, dim = c(a = 2, c = 5)), array(1:4, dim = c(a = 2, b = 2))), - "Parameter 'exp' and 'obs' must have same dimension name" + RMS(array(1:20, dim = c(dat = 2, sdate = 5, member = 2)), + array(1:10, dim = c(dat = 2, sdate = 5, time = 1))), + "Parameter 'exp' and 'obs' must have the same dimension names." ) expect_error( RMS(exp1, obs1, dat_dim = 1), @@ -98,13 +96,13 @@ test_that("1. Input checks", { "Parameter 'ncores' must be a positive integer." ) expect_error( - RMS(exp = array(1:10, dim = c(sdate = 1, dataset = 5, a = 1)), - obs = array(1:4, dim = c(a = 1, sdate = 2, dataset = 2))), - "Parameter 'exp' and 'obs' must have same length of all dimension except 'dat_dim'." + RMS(exp = array(1:10, dim = c(dataset = 1, member = 5, sdate = 1)), + obs = array(1:4, dim = c(dataset = 2, member = 2, sdate = 2))), + "Parameter 'exp' and 'obs' must have same length of all dimensions except 'dat_dim' and 'memb_dim'." ) expect_error( RMS(exp = array(1:5, dim = c(sdate = 1, dataset = 5, a = 1)), - obs = array(1:2, dim = c(a = 1, sdate = 1, dataset = 2)), dat_dim = "dataset"), + obs = array(1:2, dim = c(a = 1, sdate = 1, dataset = 2)), dat_dim = "dataset"), "The length of time_dim must be at least 2 to compute RMS." ) @@ -200,38 +198,62 @@ test_that("3. Output checks: dat2", { test_that("4. Output checks: dat3", { expect_equal( - dim(RMS(exp3, obs3, dat_dim = NULL)$rms), - c(ftime = 2, lon = 1, lat = 4) + dim(RMS(exp3, obs3, dat_dim = NULL, memb_dim = 'member')$rms), + c(ftime = 2) ) expect_equal( - as.vector(RMS(exp3, obs3, dat_dim = NULL)$rms), - c(1.6458118, 0.8860392, 0.8261295, 1.1681939, 2.1693538, 1.3064454, 0.5384229, 1.1215333), + as.vector(RMS(exp3, obs3, dat_dim = NULL, memb_dim = 'member')$rms), + c(0.6191331, 0.7133894), tolerance = 0.00001 ) expect_equal( - dim(RMS(exp3, obs3, dat_dim = NULL, conf = FALSE)$rms), - c(ftime = 2, lon = 1, lat = 4) + names(RMS(exp3, obs3, dat_dim = NULL, memb_dim = 'member', conf = FALSE)), + c("rms") ) expect_equal( - dim(RMS(exp4, obs4, time_dim = 'sdates', dat_dim = NULL, conf = TRUE)$rms), - c(ftimes = 2, lon = 1, lat = 1) + names(RMS(exp3, obs3, dat_dim = NULL, memb_dim = 'member', conf = TRUE)), + c('rms', 'conf.lower', 'conf.upper') ) expect_equal( - length(RMS(exp3, obs3, dat_dim = NULL, conf = F)), - 1 + c(RMS(exp3, obs3, dat_dim = NULL, memb_dim = 'member')$conf.lower), + c(0.4147271, 0.4778648), + tolerance = 0.0001 ) expect_equal( - c(RMS(exp3, obs3, dat_dim = NULL)$conf.lower[1,1,]), - c(1.1024490, 0.5533838, 1.4531443, 0.3606632), - tolerance = 0.0001 + c(RMS(exp3, obs3, dat_dim = NULL, memb_dim = 'member')$conf.upper), + c(1.989109, 2.291930), + tolerance = 0.0001 + ) + +}) + +############################################## + +test_that("5. Output checks: dat4", { + + expect_equal( + dim(RMS(exp4, obs4, dat_dim = 'dataset', memb_dim = 'member')$rms), + c(nexp = 2, nobs = 1, time = 1) ) expect_equal( - c(RMS(exp3, obs3, dat_dim = NULL)$conf.upper[1,1,]), - c(5.287554, 2.654133, 6.969554, 1.729809), - tolerance = 0.0001 + c(RMS(exp4, obs4, dat_dim = 'dataset', memb_dim = 'member')$rms), + c(0.6775320, 0.8954404), + tolerance = 0.0001 + ) + expect_equal( + c(RMS(exp4, obs4, dat_dim = 'dataset', memb_dim = 'member')$conf.lower), + c(0.4538456, 0.5998118), + tolerance = 0.0001 + ) + expect_equal( + c(RMS(exp4, obs4, dat_dim = 'dataset', memb_dim = 'member')$conf.upper), + c(2.176729, 2.876811), + tolerance = 0.0001 ) + }) ############################################## + diff --git a/tests/testthat/test-RMSSS.R b/tests/testthat/test-RMSSS.R index 7f38373..a364b40 100644 --- a/tests/testthat/test-RMSSS.R +++ b/tests/testthat/test-RMSSS.R @@ -11,9 +11,11 @@ # case 2 set.seed(3) - exp2 <- array(rnorm(120), dim = c(time = 10, dat = 1, lon = 3, lat = 2, dataset = 2)) + exp2 <- array(rnorm(30), dim = c(dataset = 3, sdate = 5, member = 3)) set.seed(4) - obs2 <- array(rnorm(60), dim = c(dat = 1, time = 10, dataset = 1, lat = 2, lon = 3)) + obs2 <- array(rnorm(20), dim = c(dataset = 2, sdate = 5, member = 2)) + set.seed(5) + ref2 <- array(rnorm(15), dim = c(sdate = 5, member = 3)) # case 3: vector set.seed(5) @@ -21,20 +23,6 @@ set.seed(6) obs3 <- rnorm(10) - # case 4 - set.seed(7) - exp4 <- array(rnorm(60), dim = c(sdate = 10, lon = 3, lat = 2)) - set.seed(8) - obs4 <- array(exp4 + rnorm(60) / 2, dim = dim(exp4)) - - # case 5: memb_dim - set.seed(1) - exp5 <- array(rnorm(45), dim = c(sdate = 3, dataset = 5, member = 3)) - set.seed(2) - obs5 <- array(rnorm(3), dim = c(sdate = 3, dataset = 1, member = 1)) - set.seed(3) - ref5 <- array(rnorm(6), dim = c(sdate = 3, member = 2)) - ############################################## @@ -58,8 +46,9 @@ test_that("1. Input checks", { "Parameter 'exp' and 'obs' must have dimension names." ) expect_error( - RMSSS(array(1:10, dim = c(a = 3, c = 5)), array(1:4, dim = c(a = 3, b = 5)), time_dim = 'a', dat_dim = NULL), - "Parameter 'exp' and 'obs' must have same dimension name" + RMSSS(array(1:20, dim = c(dat = 2, sdate = 5, member = 2)), + array(1:10, dim = c(dat = 2, sdate = 5, time = 1))), + "Parameter 'exp' and 'obs' must have the same dimension names." ) ## time_dim expect_error( @@ -102,9 +91,9 @@ test_that("1. Input checks", { ) ## exp and obs (2) expect_error( - RMSSS(exp = array(1:10, dim = c(sdate = 1, dataset = 5, a = 1)), - obs = array(1:4, dim = c(a = 1, sdate = 2, dataset = 2))), - "Parameter 'exp' and 'obs' must have same length of all dimension except 'memb_dim' and 'dat_dim'." + RMSSS(exp = array(1:10, dim = c(dataset = 1, member = 5, sdate = 1)), + obs = array(1:4, dim = c(dataset = 2, member = 2, sdate = 2))), + "Parameter 'exp' and 'obs' must have same length of all dimensions except 'dat_dim' and 'memb_dim'." ) expect_error( RMSSS(exp = array(1:10, dim = c(sdate = 1, dataset = 5, a = 1)), @@ -126,8 +115,8 @@ test_that("2. Output checks: case 1", { c(nexp = 5, nobs = 2) ) expect_equal( - mean(res1_1$rmsss), - -0.5449538, + c(res1_1$rmsss)[3:8], + c(0.01693900, -0.02730428, -0.34167869, 0.01588531, -1.55611403, -0.63596896), tolerance = 0.00001 ) expect_equal( @@ -136,20 +125,27 @@ test_that("2. Output checks: case 1", { tolerance = 0.001 ) - exp1_2 <- exp1 - exp1_2[2:4] <- NA - obs1_2 <- obs1 - obs1_2[1:2] <- NA - res1_2 <- RMSSS(exp1_2, obs1_2, dat_dim = 'dataset', pval = TRUE) + exp1_2 <- exp1; exp1_2[2:4] <- NA + obs1_2 <- obs1; obs1_2[1:2] <- NA + res1_2 <- RMSSS(exp1_2, obs1_2, dat_dim = 'dataset', pval = T, sign = T) expect_equal( - length(res1_2$rmsss[which(is.na(res1_2$rmsss))]), - 7 + names(res1_2), + c("rmsss", "p.val", "sign") ) expect_equal( - range(res1_2$p.val, na.rm = T), - c(0.7159769, 0.8167073), - tolerance = 0.00001 + c(res1_2$rmsss), + c(rep(NA, 7), -0.6359690, -0.5877153, -1.1108657), + tolerance = 0.0001 + ) + expect_equal( + c(res1_2$p.val), + c(rep(NA, 7), 0.7279944, 0.7159769, 0.8167073), + tolerance = 0.0001 + ) + expect_equal( + c(res1_2$sign), + c(rep(NA, 7), rep(FALSE, 3)) ) #ref @@ -198,39 +194,73 @@ test_that("2. Output checks: case 1", { # Random Walk suppressWarnings({ - res1_5 <- RMSSS(exp1, obs1, ref = ref1_1, dat_dim = 'dataset', sig_method = "Random Walk", pval = F, sign = T) + res1_5 <- RMSSS(exp1, obs1, ref = ref1_1, dat_dim = 'dataset', sig_method = "Random Walk", pval = F, sign = T, sig_method.type = 'two.sided.approx') }) expect_equal( as.vector(res1_5$sign), rep(F, 10) ) suppressWarnings({ - res1_6 <- RMSSS(exp1, obs1, ref = NULL, dat_dim = 'dataset', sig_method = "Random Walk", pval = F, sign = T) + res1_6 <- RMSSS(exp1, obs1, ref = NULL, dat_dim = 'dataset', sig_method = "Random Walk", pval = F, sign = T, sig_method.type = 'two.sided.approx') }) expect_equal( as.vector(res1_6$sign), rep(F, 10) ) + suppressWarnings({ + res1_7 <- RMSSS(exp1, obs1, ref = NULL, dat_dim = 'dataset', sig_method = "Random Walk", pval = T, sign = T, sig_method.type = 'two.sided', alpha = 0.4) + }) + expect_equal( + names(res1_7), + c('rmsss', 'p.val', 'sign') + ) + expect_equal( + res1_7$rmsss, + res1_6$rmsss + ) + expect_equal( + c(res1_7$p[, 2]), + c(1, 0.25, 0.25, 1, 1), + tolerance = 0.0001 + ) + expect_equal( + c(res1_7$sign[, 2]), + c(F, T, T, F, F) + ) }) ############################################## test_that("3. Output checks: case 2", { - + res1 <- RMSSS(exp2, obs2, ref2, dat_dim = "dataset", memb_dim = 'member', sign = T) expect_equal( - dim(RMSSS(exp2, obs2, time_dim = 'time', dat_dim = "dataset")$rmsss), - c(nexp = 2, nobs = 1, dat = 1, lon = 3, lat = 2) + dim(res1$rmsss), + c(nexp = 3, nobs = 2) ) expect_equal( - mean(RMSSS(exp2, obs2, time_dim = 'time', dat_dim = "dataset")$rmsss), - -0.3912208, - tolerance = 0.00001 + dim(res1$sign), + c(nexp = 3, nobs = 2) + ) + expect_equal( + dim(res1$p), + c(nexp = 3, nobs = 2) ) expect_equal( - range(RMSSS(exp2, obs2, time_dim = 'time', dat_dim = "dataset")$p.val), - c(0.2627770, 0.9868412), - tolerance = 0.00001 + c(res1$rmsss), + c(-0.08699446, 0.30703938, -0.28888291, -0.04284967, 0.39097270, -0.39792484), + tolerance = 0.0001 + ) + expect_equal( + c(res1$p), + c(0.5622736, 0.2474466, 0.6825138, 0.5314309, 0.1799964, 0.7338230), + tolerance = 0.0001 + ) + + + res2 <- RMSSS(apply(exp2, 1:2, mean), apply(obs2, 1:2, mean), array(apply(ref2, 1, mean), dim = c(sdate = 5)),dat_dim = "dataset", sign = T) + expect_equal( + res1, res2 ) }) @@ -250,61 +280,3 @@ test_that("4. Output checks: case 3", { ) }) - -############################################## -test_that("5. Output checks: case 4", { - - expect_equal( - dim(RMSSS(exp4, obs4, dat_dim = NULL)$rmsss), - c(lon = 3, lat = 2) - ) - expect_equal( - dim(RMSSS(exp4, obs4, dat_dim = NULL)$p.val), - c(lon = 3, lat = 2) - ) - expect_equal( - as.vector(RMSSS(exp4, obs4, dat_dim = NULL)$rmsss), - c(0.5393823, 0.6818405, 0.4953423, 0.4093817, 0.5972085, 0.5861135), - tolerance = 0.00001 - ) - expect_equal( - as.vector(RMSSS(exp4, obs4, dat_dim = NULL)$p.val), - c(0.015203983, 0.001091360, 0.026987112, 0.066279877, 0.006161059, 0.007437649), - tolerance = 0.00001 - ) - expect_equal( - names(RMSSS(exp4, obs4, dat_dim = NULL)), - c('rmsss', 'p.val') - ) - expect_equal( - names(RMSSS(exp4, obs4, dat_dim = NULL, sign = T, pval = F)), - c('rmsss', 'sign') - ) - expect_equal( - names(RMSSS(exp4, obs4, dat_dim = NULL, sign = T, pval = T)), - c('rmsss', 'p.val', 'sign') - ) - expect_equal( - as.vector(RMSSS(exp4, obs4, dat_dim = NULL, sign = T, pval = F)$sign), - c(T, T, T, F, T, T) - ) - expect_equal( - as.vector(RMSSS(exp4, obs4, dat_dim = NULL, sign = T, pval = F, alpha = 0.01)$sign), - c(F, T, F, F, T, T) - ) - -}) - -############################################## -test_that("6. Output checks: case 5", { - res5_1 <- RMSSS(exp5, obs5, ref = ref5, dat_dim = 'dataset', memb_dim = 'member') - res5_2 <- RMSSS(s2dv::MeanDims(exp5, 'member'), s2dv::MeanDims(obs5, 'member'), - ref = s2dv::MeanDims(ref5, 'member'), dat_dim = 'dataset') - expect_equal( - res5_1, - res5_2 - ) - - -}) - diff --git a/tests/testthat/test-RPSS.R b/tests/testthat/test-RPSS.R index f054325..8df2d90 100644 --- a/tests/testthat/test-RPSS.R +++ b/tests/testthat/test-RPSS.R @@ -188,7 +188,7 @@ test_that("2. Output checks: dat1", { ) expect_equal( as.vector(RPSS(exp1, obs1)$sign), - c(FALSE, FALSE), + c(FALSE, FALSE) ) expect_equal( as.vector(RPSS(exp1, obs1, Fair = T)$rpss), @@ -306,7 +306,7 @@ test_that("3. Output checks: dat2", { ) expect_equal( as.vector(RPSS(exp2, obs2)$sign), - FALSE, + FALSE ) expect_equal( as.vector(RPSS(exp2, obs2, Fair = T)$rpss), @@ -376,7 +376,7 @@ test_that("4. Output checks: dat3", { ) expect_equal( as.vector(RPSS(exp3, obs3, dat_dim = 'dataset')$sign)[1:3], - c(FALSE, FALSE, TRUE), + c(FALSE, FALSE, TRUE) ) expect_equal( mean(RPSS(exp3, obs3, dat_dim = 'dataset', weights_exp = weights3, Fair = T)$rpss), -- GitLab From b5d566e70bd5d88d4887bd774149bde113fba14a Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 11 Jul 2023 17:39:48 +0200 Subject: [PATCH 37/64] Move vignette figures to a folder; minor fix --- R/PlotEquiMap.R | 2 +- R/Utils.R | 37 ------- man/PlotEquiMap.Rd | 2 +- vignettes/{ => Figures}/NAOindex_81to91.png | Bin vignettes/{ => Figures}/NAOpredictions.png | Bin .../{ => Figures}/RMSSSforNAOprediction.png | Bin vignettes/{ => Figures}/ex_ano_expA_obsX.png | Bin vignettes/{ => Figures}/ex_ano_expB_obsX.png | Bin .../{ => Figures}/ex_clim_expA_expB_obsX.png | Bin .../{ => Figures}/ex_corr_expA_expB_obsX.png | Bin vignettes/{ => Figures}/ex_raw_expA_obsX.png | Bin vignettes/{ => Figures}/ex_raw_expB_obsX.png | Bin vignettes/{ => Figures}/s2dv_modules.png | Bin .../{ => Figures}/snip1_equi_map_raw_all.png | Bin .../snip2_anim_corr_expA_obsX.gif | Bin .../snip2_anim_corr_expB_obsX.gif | Bin .../snip2_equimap_corr_raw_expA_obsX.png | Bin .../snip2_equimap_corr_raw_expB_obsX.png | Bin .../{ => Figures}/stat_ano_expA_Y_obsX.png | Bin .../{ => Figures}/stat_ano_expA_obsX.png | Bin .../{ => Figures}/stat_ano_expB_obsX.png | Bin .../stat_clim_expA_expB_obsX.png | Bin .../{ => Figures}/stat_detr_ano_expA_obsX.png | Bin .../{ => Figures}/stat_filter_ano_expA.png | Bin .../{ => Figures}/stat_raw_expA_obsX.png | Bin .../{ => Figures}/stat_raw_expB_obsX.png | Bin .../{ => Figures}/stat_season_mam_expA.png | Bin .../{ => Figures}/stat_season_mam_obsX.png | Bin .../stat_smooth_ano_expA_obsX.png | Bin .../{ => Figures}/stat_toy_forecast_ano.png | Bin .../{ => Figures}/stat_trend_expA_expB.png | Bin .../{ => Figures}/vis_acc_expA_expB_obsX.png | Bin .../{ => Figures}/vis_anim_clim_expA.gif | Bin .../vis_anim_clim_expA_world.gif | Bin .../{ => Figures}/vis_anim_clim_expB.gif | Bin .../{ => Figures}/vis_anim_clim_obsX.gif | Bin .../vis_anim_clim_obsX_world.gif | Bin vignettes/{ => Figures}/vis_ano_exp_obs.png | Bin .../{ => Figures}/vis_ano_exp_points.png | Bin .../{ => Figures}/vis_clim_expA_expB_obsX.png | Bin .../{ => Figures}/vis_conf_interval_exp.png | Bin .../{ => Figures}/vis_corr_expA_expB_obsX.png | Bin .../vis_corr_rms_expA_expB_obsX.png | Bin vignettes/{ => Figures}/vis_eno_expA_expB.png | Bin .../{ => Figures}/vis_equimap_box_expA.png | Bin .../vis_equimap_cols_raw_expA.png | Bin .../vis_equimap_cols_raw_obsX.png | Bin .../vis_equimap_contour_raw_expA.png | Bin .../vis_equimap_contour_raw_obsX.png | Bin .../{ => Figures}/vis_equimap_raw_expA.png | Bin .../{ => Figures}/vis_equimap_raw_obsX.png | Bin vignettes/{ => Figures}/vis_error_bar.png | Bin vignettes/{ => Figures}/vis_iqr_expA_expB.png | Bin .../{ => Figures}/vis_layout_complex.png | Bin .../{ => Figures}/vis_layout_equimap_expA.png | Bin vignettes/{ => Figures}/vis_mad_expA_expB.png | Bin .../{ => Figures}/vis_maxmin_expA_expB.png | Bin .../vis_ratiorms_expA_expB_obsX.png | Bin .../vis_ratiosdrms_expA_expB_obsX.png | Bin .../vis_ratiosdrms_expA_obsX_obsXrnorm.png | Bin vignettes/{ => Figures}/vis_raw_expA_obsX.png | Bin vignettes/{ => Figures}/vis_raw_expB_obsX.png | Bin .../vis_regression_expA_expB.png | Bin .../{ => Figures}/vis_rms_expA_expB_obsX.png | Bin .../vis_rmsss_expA_expB_obsX.png | Bin vignettes/{ => Figures}/vis_sd_expA_expB.png | Bin .../{ => Figures}/vis_stereomap_raw_expA.png | Bin .../{ => Figures}/vis_stereomap_raw_obsX.png | Bin .../{ => Figures}/vis_trend_expA_expB.png | Bin vignettes/ScoringForecast.md | 6 +- vignettes/example.md | 14 +-- vignettes/snippets.md | 10 +- vignettes/statistics.md | 26 ++--- vignettes/visualisation.md | 91 +++++++++--------- 74 files changed, 75 insertions(+), 113 deletions(-) rename vignettes/{ => Figures}/NAOindex_81to91.png (100%) rename vignettes/{ => Figures}/NAOpredictions.png (100%) rename vignettes/{ => Figures}/RMSSSforNAOprediction.png (100%) rename vignettes/{ => Figures}/ex_ano_expA_obsX.png (100%) rename vignettes/{ => Figures}/ex_ano_expB_obsX.png (100%) rename vignettes/{ => Figures}/ex_clim_expA_expB_obsX.png (100%) rename vignettes/{ => Figures}/ex_corr_expA_expB_obsX.png (100%) rename vignettes/{ => Figures}/ex_raw_expA_obsX.png (100%) rename vignettes/{ => Figures}/ex_raw_expB_obsX.png (100%) rename vignettes/{ => Figures}/s2dv_modules.png (100%) rename vignettes/{ => Figures}/snip1_equi_map_raw_all.png (100%) rename vignettes/{ => Figures}/snip2_anim_corr_expA_obsX.gif (100%) rename vignettes/{ => Figures}/snip2_anim_corr_expB_obsX.gif (100%) rename vignettes/{ => Figures}/snip2_equimap_corr_raw_expA_obsX.png (100%) rename vignettes/{ => Figures}/snip2_equimap_corr_raw_expB_obsX.png (100%) rename vignettes/{ => Figures}/stat_ano_expA_Y_obsX.png (100%) rename vignettes/{ => Figures}/stat_ano_expA_obsX.png (100%) rename vignettes/{ => Figures}/stat_ano_expB_obsX.png (100%) rename vignettes/{ => Figures}/stat_clim_expA_expB_obsX.png (100%) rename vignettes/{ => Figures}/stat_detr_ano_expA_obsX.png (100%) rename vignettes/{ => Figures}/stat_filter_ano_expA.png (100%) rename vignettes/{ => Figures}/stat_raw_expA_obsX.png (100%) rename vignettes/{ => Figures}/stat_raw_expB_obsX.png (100%) rename vignettes/{ => Figures}/stat_season_mam_expA.png (100%) rename vignettes/{ => Figures}/stat_season_mam_obsX.png (100%) rename vignettes/{ => Figures}/stat_smooth_ano_expA_obsX.png (100%) rename vignettes/{ => Figures}/stat_toy_forecast_ano.png (100%) rename vignettes/{ => Figures}/stat_trend_expA_expB.png (100%) rename vignettes/{ => Figures}/vis_acc_expA_expB_obsX.png (100%) rename vignettes/{ => Figures}/vis_anim_clim_expA.gif (100%) rename vignettes/{ => Figures}/vis_anim_clim_expA_world.gif (100%) rename vignettes/{ => Figures}/vis_anim_clim_expB.gif (100%) rename vignettes/{ => Figures}/vis_anim_clim_obsX.gif (100%) rename vignettes/{ => Figures}/vis_anim_clim_obsX_world.gif (100%) rename vignettes/{ => Figures}/vis_ano_exp_obs.png (100%) rename vignettes/{ => Figures}/vis_ano_exp_points.png (100%) rename vignettes/{ => Figures}/vis_clim_expA_expB_obsX.png (100%) rename vignettes/{ => Figures}/vis_conf_interval_exp.png (100%) rename vignettes/{ => Figures}/vis_corr_expA_expB_obsX.png (100%) rename vignettes/{ => Figures}/vis_corr_rms_expA_expB_obsX.png (100%) rename vignettes/{ => Figures}/vis_eno_expA_expB.png (100%) rename vignettes/{ => Figures}/vis_equimap_box_expA.png (100%) rename vignettes/{ => Figures}/vis_equimap_cols_raw_expA.png (100%) rename vignettes/{ => Figures}/vis_equimap_cols_raw_obsX.png (100%) rename vignettes/{ => Figures}/vis_equimap_contour_raw_expA.png (100%) rename vignettes/{ => Figures}/vis_equimap_contour_raw_obsX.png (100%) rename vignettes/{ => Figures}/vis_equimap_raw_expA.png (100%) rename vignettes/{ => Figures}/vis_equimap_raw_obsX.png (100%) rename vignettes/{ => Figures}/vis_error_bar.png (100%) rename vignettes/{ => Figures}/vis_iqr_expA_expB.png (100%) rename vignettes/{ => Figures}/vis_layout_complex.png (100%) rename vignettes/{ => Figures}/vis_layout_equimap_expA.png (100%) rename vignettes/{ => Figures}/vis_mad_expA_expB.png (100%) rename vignettes/{ => Figures}/vis_maxmin_expA_expB.png (100%) rename vignettes/{ => Figures}/vis_ratiorms_expA_expB_obsX.png (100%) rename vignettes/{ => Figures}/vis_ratiosdrms_expA_expB_obsX.png (100%) rename vignettes/{ => Figures}/vis_ratiosdrms_expA_obsX_obsXrnorm.png (100%) rename vignettes/{ => Figures}/vis_raw_expA_obsX.png (100%) rename vignettes/{ => Figures}/vis_raw_expB_obsX.png (100%) rename vignettes/{ => Figures}/vis_regression_expA_expB.png (100%) rename vignettes/{ => Figures}/vis_rms_expA_expB_obsX.png (100%) rename vignettes/{ => Figures}/vis_rmsss_expA_expB_obsX.png (100%) rename vignettes/{ => Figures}/vis_sd_expA_expB.png (100%) rename vignettes/{ => Figures}/vis_stereomap_raw_expA.png (100%) rename vignettes/{ => Figures}/vis_stereomap_raw_obsX.png (100%) rename vignettes/{ => Figures}/vis_trend_expA_expB.png (100%) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 2c98430..16f42b5 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -253,7 +253,7 @@ #' } #'PlotEquiMap(sampleData$mod[1, 1, 1, 1, , ], sampleData$lon, sampleData$lat, #' toptitle = 'Predicted sea surface temperature for Nov 1960 from 1st Nov', -#' sizetit = 0.5) +#' title_scale = 0.5) #'@import graphics maps #'@importFrom grDevices dev.cur dev.new dev.off gray #'@importFrom stats cor diff --git a/R/Utils.R b/R/Utils.R index adcded6..362bdf8 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -100,44 +100,7 @@ } position } - .t2nlatlon <- function(t) { - ## As seen in cdo's griddes.c: ntr2nlat() - nlats <- (t * 3 + 1) / 2 - if ((nlats > 0) && (nlats - trunc(nlats) >= 0.5)) { - nlats <- ceiling(nlats) - } else { - nlats <- round(nlats) - } - if (nlats %% 2 > 0) { - nlats <- nlats + 1 - } - ## As seen in cdo's griddes.c: compNlon(), and as specified in ECMWF - nlons <- 2 * nlats - keep_going <- TRUE - while (keep_going) { - n <- nlons - if (n %% 8 == 0) n <- trunc(n / 8) - while (n %% 6 == 0) n <- trunc(n / 6) - while (n %% 5 == 0) n <- trunc(n / 5) - while (n %% 4 == 0) n <- trunc(n / 4) - while (n %% 3 == 0) n <- trunc(n / 3) - if (n %% 2 == 0) n <- trunc(n / 2) - if (n <= 8) { - keep_going <- FALSE - } else { - nlons <- nlons + 2 - if (nlons > 9999) { - stop("Error: pick another gaussian grid truncation. It doesn't fulfill the standards to apply FFT.") - } - } - } - c(nlats, nlons) - } - .nlat2t <- function(nlats) { - trunc((nlats * 2 - 1) / 3) - } - found_file <- NULL dims <- NULL grid_name <- units <- var_long_name <- NULL diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index 19ff838..5d3739a 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -404,5 +404,5 @@ sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), } PlotEquiMap(sampleData$mod[1, 1, 1, 1, , ], sampleData$lon, sampleData$lat, toptitle = 'Predicted sea surface temperature for Nov 1960 from 1st Nov', - sizetit = 0.5) + title_scale = 0.5) } diff --git a/vignettes/NAOindex_81to91.png b/vignettes/Figures/NAOindex_81to91.png similarity index 100% rename from vignettes/NAOindex_81to91.png rename to vignettes/Figures/NAOindex_81to91.png diff --git a/vignettes/NAOpredictions.png b/vignettes/Figures/NAOpredictions.png similarity index 100% rename from vignettes/NAOpredictions.png rename to vignettes/Figures/NAOpredictions.png diff --git a/vignettes/RMSSSforNAOprediction.png b/vignettes/Figures/RMSSSforNAOprediction.png similarity index 100% rename from vignettes/RMSSSforNAOprediction.png rename to vignettes/Figures/RMSSSforNAOprediction.png diff --git a/vignettes/ex_ano_expA_obsX.png b/vignettes/Figures/ex_ano_expA_obsX.png similarity index 100% rename from vignettes/ex_ano_expA_obsX.png rename to vignettes/Figures/ex_ano_expA_obsX.png diff --git a/vignettes/ex_ano_expB_obsX.png b/vignettes/Figures/ex_ano_expB_obsX.png similarity index 100% rename from vignettes/ex_ano_expB_obsX.png rename to vignettes/Figures/ex_ano_expB_obsX.png diff --git a/vignettes/ex_clim_expA_expB_obsX.png b/vignettes/Figures/ex_clim_expA_expB_obsX.png similarity index 100% rename from vignettes/ex_clim_expA_expB_obsX.png rename to vignettes/Figures/ex_clim_expA_expB_obsX.png diff --git a/vignettes/ex_corr_expA_expB_obsX.png b/vignettes/Figures/ex_corr_expA_expB_obsX.png similarity index 100% rename from vignettes/ex_corr_expA_expB_obsX.png rename to vignettes/Figures/ex_corr_expA_expB_obsX.png diff --git a/vignettes/ex_raw_expA_obsX.png b/vignettes/Figures/ex_raw_expA_obsX.png similarity index 100% rename from vignettes/ex_raw_expA_obsX.png rename to vignettes/Figures/ex_raw_expA_obsX.png diff --git a/vignettes/ex_raw_expB_obsX.png b/vignettes/Figures/ex_raw_expB_obsX.png similarity index 100% rename from vignettes/ex_raw_expB_obsX.png rename to vignettes/Figures/ex_raw_expB_obsX.png diff --git a/vignettes/s2dv_modules.png b/vignettes/Figures/s2dv_modules.png similarity index 100% rename from vignettes/s2dv_modules.png rename to vignettes/Figures/s2dv_modules.png diff --git a/vignettes/snip1_equi_map_raw_all.png b/vignettes/Figures/snip1_equi_map_raw_all.png similarity index 100% rename from vignettes/snip1_equi_map_raw_all.png rename to vignettes/Figures/snip1_equi_map_raw_all.png diff --git a/vignettes/snip2_anim_corr_expA_obsX.gif b/vignettes/Figures/snip2_anim_corr_expA_obsX.gif similarity index 100% rename from vignettes/snip2_anim_corr_expA_obsX.gif rename to vignettes/Figures/snip2_anim_corr_expA_obsX.gif diff --git a/vignettes/snip2_anim_corr_expB_obsX.gif b/vignettes/Figures/snip2_anim_corr_expB_obsX.gif similarity index 100% rename from vignettes/snip2_anim_corr_expB_obsX.gif rename to vignettes/Figures/snip2_anim_corr_expB_obsX.gif diff --git a/vignettes/snip2_equimap_corr_raw_expA_obsX.png b/vignettes/Figures/snip2_equimap_corr_raw_expA_obsX.png similarity index 100% rename from vignettes/snip2_equimap_corr_raw_expA_obsX.png rename to vignettes/Figures/snip2_equimap_corr_raw_expA_obsX.png diff --git a/vignettes/snip2_equimap_corr_raw_expB_obsX.png b/vignettes/Figures/snip2_equimap_corr_raw_expB_obsX.png similarity index 100% rename from vignettes/snip2_equimap_corr_raw_expB_obsX.png rename to vignettes/Figures/snip2_equimap_corr_raw_expB_obsX.png diff --git a/vignettes/stat_ano_expA_Y_obsX.png b/vignettes/Figures/stat_ano_expA_Y_obsX.png similarity index 100% rename from vignettes/stat_ano_expA_Y_obsX.png rename to vignettes/Figures/stat_ano_expA_Y_obsX.png diff --git a/vignettes/stat_ano_expA_obsX.png b/vignettes/Figures/stat_ano_expA_obsX.png similarity index 100% rename from vignettes/stat_ano_expA_obsX.png rename to vignettes/Figures/stat_ano_expA_obsX.png diff --git a/vignettes/stat_ano_expB_obsX.png b/vignettes/Figures/stat_ano_expB_obsX.png similarity index 100% rename from vignettes/stat_ano_expB_obsX.png rename to vignettes/Figures/stat_ano_expB_obsX.png diff --git a/vignettes/stat_clim_expA_expB_obsX.png b/vignettes/Figures/stat_clim_expA_expB_obsX.png similarity index 100% rename from vignettes/stat_clim_expA_expB_obsX.png rename to vignettes/Figures/stat_clim_expA_expB_obsX.png diff --git a/vignettes/stat_detr_ano_expA_obsX.png b/vignettes/Figures/stat_detr_ano_expA_obsX.png similarity index 100% rename from vignettes/stat_detr_ano_expA_obsX.png rename to vignettes/Figures/stat_detr_ano_expA_obsX.png diff --git a/vignettes/stat_filter_ano_expA.png b/vignettes/Figures/stat_filter_ano_expA.png similarity index 100% rename from vignettes/stat_filter_ano_expA.png rename to vignettes/Figures/stat_filter_ano_expA.png diff --git a/vignettes/stat_raw_expA_obsX.png b/vignettes/Figures/stat_raw_expA_obsX.png similarity index 100% rename from vignettes/stat_raw_expA_obsX.png rename to vignettes/Figures/stat_raw_expA_obsX.png diff --git a/vignettes/stat_raw_expB_obsX.png b/vignettes/Figures/stat_raw_expB_obsX.png similarity index 100% rename from vignettes/stat_raw_expB_obsX.png rename to vignettes/Figures/stat_raw_expB_obsX.png diff --git a/vignettes/stat_season_mam_expA.png b/vignettes/Figures/stat_season_mam_expA.png similarity index 100% rename from vignettes/stat_season_mam_expA.png rename to vignettes/Figures/stat_season_mam_expA.png diff --git a/vignettes/stat_season_mam_obsX.png b/vignettes/Figures/stat_season_mam_obsX.png similarity index 100% rename from vignettes/stat_season_mam_obsX.png rename to vignettes/Figures/stat_season_mam_obsX.png diff --git a/vignettes/stat_smooth_ano_expA_obsX.png b/vignettes/Figures/stat_smooth_ano_expA_obsX.png similarity index 100% rename from vignettes/stat_smooth_ano_expA_obsX.png rename to vignettes/Figures/stat_smooth_ano_expA_obsX.png diff --git a/vignettes/stat_toy_forecast_ano.png b/vignettes/Figures/stat_toy_forecast_ano.png similarity index 100% rename from vignettes/stat_toy_forecast_ano.png rename to vignettes/Figures/stat_toy_forecast_ano.png diff --git a/vignettes/stat_trend_expA_expB.png b/vignettes/Figures/stat_trend_expA_expB.png similarity index 100% rename from vignettes/stat_trend_expA_expB.png rename to vignettes/Figures/stat_trend_expA_expB.png diff --git a/vignettes/vis_acc_expA_expB_obsX.png b/vignettes/Figures/vis_acc_expA_expB_obsX.png similarity index 100% rename from vignettes/vis_acc_expA_expB_obsX.png rename to vignettes/Figures/vis_acc_expA_expB_obsX.png diff --git a/vignettes/vis_anim_clim_expA.gif b/vignettes/Figures/vis_anim_clim_expA.gif similarity index 100% rename from vignettes/vis_anim_clim_expA.gif rename to vignettes/Figures/vis_anim_clim_expA.gif diff --git a/vignettes/vis_anim_clim_expA_world.gif b/vignettes/Figures/vis_anim_clim_expA_world.gif similarity index 100% rename from vignettes/vis_anim_clim_expA_world.gif rename to vignettes/Figures/vis_anim_clim_expA_world.gif diff --git a/vignettes/vis_anim_clim_expB.gif b/vignettes/Figures/vis_anim_clim_expB.gif similarity index 100% rename from vignettes/vis_anim_clim_expB.gif rename to vignettes/Figures/vis_anim_clim_expB.gif diff --git a/vignettes/vis_anim_clim_obsX.gif b/vignettes/Figures/vis_anim_clim_obsX.gif similarity index 100% rename from vignettes/vis_anim_clim_obsX.gif rename to vignettes/Figures/vis_anim_clim_obsX.gif diff --git a/vignettes/vis_anim_clim_obsX_world.gif b/vignettes/Figures/vis_anim_clim_obsX_world.gif similarity index 100% rename from vignettes/vis_anim_clim_obsX_world.gif rename to vignettes/Figures/vis_anim_clim_obsX_world.gif diff --git a/vignettes/vis_ano_exp_obs.png b/vignettes/Figures/vis_ano_exp_obs.png similarity index 100% rename from vignettes/vis_ano_exp_obs.png rename to vignettes/Figures/vis_ano_exp_obs.png diff --git a/vignettes/vis_ano_exp_points.png b/vignettes/Figures/vis_ano_exp_points.png similarity index 100% rename from vignettes/vis_ano_exp_points.png rename to vignettes/Figures/vis_ano_exp_points.png diff --git a/vignettes/vis_clim_expA_expB_obsX.png b/vignettes/Figures/vis_clim_expA_expB_obsX.png similarity index 100% rename from vignettes/vis_clim_expA_expB_obsX.png rename to vignettes/Figures/vis_clim_expA_expB_obsX.png diff --git a/vignettes/vis_conf_interval_exp.png b/vignettes/Figures/vis_conf_interval_exp.png similarity index 100% rename from vignettes/vis_conf_interval_exp.png rename to vignettes/Figures/vis_conf_interval_exp.png diff --git a/vignettes/vis_corr_expA_expB_obsX.png b/vignettes/Figures/vis_corr_expA_expB_obsX.png similarity index 100% rename from vignettes/vis_corr_expA_expB_obsX.png rename to vignettes/Figures/vis_corr_expA_expB_obsX.png diff --git a/vignettes/vis_corr_rms_expA_expB_obsX.png b/vignettes/Figures/vis_corr_rms_expA_expB_obsX.png similarity index 100% rename from vignettes/vis_corr_rms_expA_expB_obsX.png rename to vignettes/Figures/vis_corr_rms_expA_expB_obsX.png diff --git a/vignettes/vis_eno_expA_expB.png b/vignettes/Figures/vis_eno_expA_expB.png similarity index 100% rename from vignettes/vis_eno_expA_expB.png rename to vignettes/Figures/vis_eno_expA_expB.png diff --git a/vignettes/vis_equimap_box_expA.png b/vignettes/Figures/vis_equimap_box_expA.png similarity index 100% rename from vignettes/vis_equimap_box_expA.png rename to vignettes/Figures/vis_equimap_box_expA.png diff --git a/vignettes/vis_equimap_cols_raw_expA.png b/vignettes/Figures/vis_equimap_cols_raw_expA.png similarity index 100% rename from vignettes/vis_equimap_cols_raw_expA.png rename to vignettes/Figures/vis_equimap_cols_raw_expA.png diff --git a/vignettes/vis_equimap_cols_raw_obsX.png b/vignettes/Figures/vis_equimap_cols_raw_obsX.png similarity index 100% rename from vignettes/vis_equimap_cols_raw_obsX.png rename to vignettes/Figures/vis_equimap_cols_raw_obsX.png diff --git a/vignettes/vis_equimap_contour_raw_expA.png b/vignettes/Figures/vis_equimap_contour_raw_expA.png similarity index 100% rename from vignettes/vis_equimap_contour_raw_expA.png rename to vignettes/Figures/vis_equimap_contour_raw_expA.png diff --git a/vignettes/vis_equimap_contour_raw_obsX.png b/vignettes/Figures/vis_equimap_contour_raw_obsX.png similarity index 100% rename from vignettes/vis_equimap_contour_raw_obsX.png rename to vignettes/Figures/vis_equimap_contour_raw_obsX.png diff --git a/vignettes/vis_equimap_raw_expA.png b/vignettes/Figures/vis_equimap_raw_expA.png similarity index 100% rename from vignettes/vis_equimap_raw_expA.png rename to vignettes/Figures/vis_equimap_raw_expA.png diff --git a/vignettes/vis_equimap_raw_obsX.png b/vignettes/Figures/vis_equimap_raw_obsX.png similarity index 100% rename from vignettes/vis_equimap_raw_obsX.png rename to vignettes/Figures/vis_equimap_raw_obsX.png diff --git a/vignettes/vis_error_bar.png b/vignettes/Figures/vis_error_bar.png similarity index 100% rename from vignettes/vis_error_bar.png rename to vignettes/Figures/vis_error_bar.png diff --git a/vignettes/vis_iqr_expA_expB.png b/vignettes/Figures/vis_iqr_expA_expB.png similarity index 100% rename from vignettes/vis_iqr_expA_expB.png rename to vignettes/Figures/vis_iqr_expA_expB.png diff --git a/vignettes/vis_layout_complex.png b/vignettes/Figures/vis_layout_complex.png similarity index 100% rename from vignettes/vis_layout_complex.png rename to vignettes/Figures/vis_layout_complex.png diff --git a/vignettes/vis_layout_equimap_expA.png b/vignettes/Figures/vis_layout_equimap_expA.png similarity index 100% rename from vignettes/vis_layout_equimap_expA.png rename to vignettes/Figures/vis_layout_equimap_expA.png diff --git a/vignettes/vis_mad_expA_expB.png b/vignettes/Figures/vis_mad_expA_expB.png similarity index 100% rename from vignettes/vis_mad_expA_expB.png rename to vignettes/Figures/vis_mad_expA_expB.png diff --git a/vignettes/vis_maxmin_expA_expB.png b/vignettes/Figures/vis_maxmin_expA_expB.png similarity index 100% rename from vignettes/vis_maxmin_expA_expB.png rename to vignettes/Figures/vis_maxmin_expA_expB.png diff --git a/vignettes/vis_ratiorms_expA_expB_obsX.png b/vignettes/Figures/vis_ratiorms_expA_expB_obsX.png similarity index 100% rename from vignettes/vis_ratiorms_expA_expB_obsX.png rename to vignettes/Figures/vis_ratiorms_expA_expB_obsX.png diff --git a/vignettes/vis_ratiosdrms_expA_expB_obsX.png b/vignettes/Figures/vis_ratiosdrms_expA_expB_obsX.png similarity index 100% rename from vignettes/vis_ratiosdrms_expA_expB_obsX.png rename to vignettes/Figures/vis_ratiosdrms_expA_expB_obsX.png diff --git a/vignettes/vis_ratiosdrms_expA_obsX_obsXrnorm.png b/vignettes/Figures/vis_ratiosdrms_expA_obsX_obsXrnorm.png similarity index 100% rename from vignettes/vis_ratiosdrms_expA_obsX_obsXrnorm.png rename to vignettes/Figures/vis_ratiosdrms_expA_obsX_obsXrnorm.png diff --git a/vignettes/vis_raw_expA_obsX.png b/vignettes/Figures/vis_raw_expA_obsX.png similarity index 100% rename from vignettes/vis_raw_expA_obsX.png rename to vignettes/Figures/vis_raw_expA_obsX.png diff --git a/vignettes/vis_raw_expB_obsX.png b/vignettes/Figures/vis_raw_expB_obsX.png similarity index 100% rename from vignettes/vis_raw_expB_obsX.png rename to vignettes/Figures/vis_raw_expB_obsX.png diff --git a/vignettes/vis_regression_expA_expB.png b/vignettes/Figures/vis_regression_expA_expB.png similarity index 100% rename from vignettes/vis_regression_expA_expB.png rename to vignettes/Figures/vis_regression_expA_expB.png diff --git a/vignettes/vis_rms_expA_expB_obsX.png b/vignettes/Figures/vis_rms_expA_expB_obsX.png similarity index 100% rename from vignettes/vis_rms_expA_expB_obsX.png rename to vignettes/Figures/vis_rms_expA_expB_obsX.png diff --git a/vignettes/vis_rmsss_expA_expB_obsX.png b/vignettes/Figures/vis_rmsss_expA_expB_obsX.png similarity index 100% rename from vignettes/vis_rmsss_expA_expB_obsX.png rename to vignettes/Figures/vis_rmsss_expA_expB_obsX.png diff --git a/vignettes/vis_sd_expA_expB.png b/vignettes/Figures/vis_sd_expA_expB.png similarity index 100% rename from vignettes/vis_sd_expA_expB.png rename to vignettes/Figures/vis_sd_expA_expB.png diff --git a/vignettes/vis_stereomap_raw_expA.png b/vignettes/Figures/vis_stereomap_raw_expA.png similarity index 100% rename from vignettes/vis_stereomap_raw_expA.png rename to vignettes/Figures/vis_stereomap_raw_expA.png diff --git a/vignettes/vis_stereomap_raw_obsX.png b/vignettes/Figures/vis_stereomap_raw_obsX.png similarity index 100% rename from vignettes/vis_stereomap_raw_obsX.png rename to vignettes/Figures/vis_stereomap_raw_obsX.png diff --git a/vignettes/vis_trend_expA_expB.png b/vignettes/Figures/vis_trend_expA_expB.png similarity index 100% rename from vignettes/vis_trend_expA_expB.png rename to vignettes/Figures/vis_trend_expA_expB.png diff --git a/vignettes/ScoringForecast.md b/vignettes/ScoringForecast.md index 37c53e0..275619c 100644 --- a/vignettes/ScoringForecast.md +++ b/vignettes/ScoringForecast.md @@ -103,7 +103,7 @@ PlotBoxWhisker(t(nao_exp_n), nao_obs_n, toptitle = "NAO index, DJF", legend(x = 3.8, y = 2.6, c('EUROSIP', 'EraInterim'), col = c(2, 4), pch = 15) ``` - + The figure above does not represent a good agreement between observations (blue line) and forecast (whisker boxes) due to the large dispersion through the 51 model members. The NAO signal is too weak due to the large dispersion among ensemble members thus almost disappearing (close to 0). @@ -149,7 +149,7 @@ legend(x = 4.95, y = 2.4, c('EUROSIP', 'EraInterim'), col = c(2, 4), pch = 15, cex = 0.9, lty = 0) ``` - + The above figure shows very different RMSSS for different members (left plot). Most of them have RMSSS close to 0, thus the prediction error is close to the system variability. **The RMSSS for the whole ensemble is 0.091**, what means a not very useful ensemble prediction. @@ -227,7 +227,7 @@ title('Predictions for selected-members ensemble') ``` - + For the all-members ensemble, the results are: diff --git a/vignettes/example.md b/vignettes/example.md index 9ac470d..3a71e98 100644 --- a/vignettes/example.md +++ b/vignettes/example.md @@ -130,7 +130,7 @@ PlotEquiMap(data$mod[1, 1, 1, 1, , ], data$lon, data$lat) PlotEquiMap(data$mod[2, 1, 1, 1, , ], data$lon, data$lat) PlotEquiMap(data$obs[1, 1, 1, 1, , ], data$lon, data$lat) ``` - + See the full code used to obtain this figure in [**Snippet 1**](snippets.md#snippet1). @@ -150,8 +150,8 @@ PlotAno(mod, obs, gsub('1101', '1201', sdates), fileout = c('ex_raw_expA_obsX.eps', 'ex_raw_expB_obsX.eps')) ``` - - + + Each coloured region represents data corresponding to a single starting date. The bold line represents the mean value and the thin lines represent the values @@ -205,7 +205,7 @@ PlotClim(clim$clim_exp, clim$clim_obs, monini = 12, ytitle = "K", fileout = 'ex_clim_expA_expB_obsX.eps') ``` - + Each line in this plot represents the climatology of each member of the corresponding dataset. A single climatology of the ensemble mean could be @@ -225,8 +225,8 @@ PlotAno(ano_mod, ano_obs, gsub('1101', '1201', sdates), fileout = c('ex_ano_expA_obsX.eps', 'ex_ano_expB_obsX.eps')) ``` - - + + To fulfill the bias correction we would need to add the observed climatologies to these anomalies. The working units of the package, however, are the @@ -255,7 +255,7 @@ PlotVsLTime(corr, toptitle = "Correlations with Observation X over North Pacific fileout = 'ex_corr_expA_expB_obsX.eps') ``` - + See [**Verification**](verification.md) for a detailed explanation of the available deterministic and probabilistic scores or diff --git a/vignettes/snippets.md b/vignettes/snippets.md index 40929c2..9f81a4b 100644 --- a/vignettes/snippets.md +++ b/vignettes/snippets.md @@ -56,7 +56,7 @@ PlotEquiMap(data$obs[1,1,1,1,,], data$lon, data$lat, brks = brks, cols = cols, d ColorBar(brks, cols, vert = FALSE, subsampleg = 5) dev.off() ``` - + Snippet 2 --------- @@ -94,8 +94,8 @@ PlotEquiMap(corr[2, 1, 2, 1, , ], map_data$lon, map_data$lat, dots = t(corr[2, 1, 2, 1, , ] > corr[2, 1, 4, 1, , ])) dev.off() ``` - - + + And generates the animations of the actual time correlations of Experiment A and B against Observation X over the Atlantic, with black dots on values that @@ -112,6 +112,6 @@ AnimVsLTime(corr, map_data$lon, map_data$lat, monini = 12, "snip2_anim_corr_expB_obsX")) ``` - - + + diff --git a/vignettes/statistics.md b/vignettes/statistics.md index ff127c4..e455d2c 100644 --- a/vignettes/statistics.md +++ b/vignettes/statistics.md @@ -138,14 +138,14 @@ PlotClim(clim$exp, clim$obs, monini = 12, listobs = c('Observation X'), fileout = "stat_clim_expA_expB_obsX.eps") ``` - - + + Each coloured curve in the `PlotAno()` figures corresponds to a starting date, with the various ensemble members and the ensemble mean in bold. The coloured area is delimited by the minimum and maximum ensemble values. - + Each plot in the `PlotClim()` figure corresponds to the climatology of a member of the corresponding experiment or observation. @@ -198,8 +198,8 @@ PlotAno(ano$exp, ano$obs, selected_sdates, ytitle = c("K", "K"), linezero = TRUE, fileout = paste0("stat_ano_exp", c("A", "B"), "_obsX.eps")) ``` - - + + To fulfill the bias correction of the forecasts, i.e. transforming the forecast data from the biased model mean state to the real observed mean state, the @@ -240,7 +240,7 @@ PlotVsLTime(trend_exp$trend, listexp = c('Experiment A', 'Experiment B'), fileout = 'stat_trend_expA_expB.eps') ``` - + In this case the slopes of the trends are nearly zero at all lead-times. The raw anomalies of the experiment A and observations are plotted next, side to @@ -261,8 +261,8 @@ PlotAno(InsertDim(plyr::take(trend_exp$detrended, 1, 1), 2, 1), ytitle = "K", linezero = TRUE, fileout = paste0("stat_detr_ano_expA_obsX.eps")) ``` - - + + Since the anomaly members have been averaged to compute the trend, the provided detrended data by `Trend()` is also an ensemble average. @@ -410,7 +410,7 @@ PlotAno(plyr::take(smoothed_ano_exp, 1, 1), smoothed_ano_obs, ytitle = "K", linezero = TRUE, fileout = "stat_smooth_ano_expA_obsX.eps") ``` - + ### Frequency filtering `Filter()` filters a specified frequency from the input data. The filtering is @@ -439,7 +439,7 @@ PlotAno(InsertDim(ens_mean_ano_expA, 2, 1), ano$obs, ytitle = "K", linezero = TRUE, fileout = "stat_filter_ano_expA.eps") ``` - + Generating derivative fields ---------------------------- @@ -487,8 +487,8 @@ PlotEquiMap(mam_clim_obs[1, 1, , ], data_map$lon, data_map$lat, units = "K", brks = brks, cols = cols, subsampleg = 10) dev.off() ``` - - + + ### Cathegorizing data `ProbBins()` @@ -545,7 +545,7 @@ PlotAno(ano_toy$ano_exp, ano_toy$ano_obs, sdates_toy, ytitle = "units", linezero = TRUE, fileout = "stat_toy_forecast_ano.eps") ``` - + It is possible, however, to generate model data from observational data from `Load()`. The only required parameters are, then, the predictability, error diff --git a/vignettes/visualisation.md b/vignettes/visualisation.md index 2c526ca..16a65f1 100644 --- a/vignettes/visualisation.md +++ b/vignettes/visualisation.md @@ -10,7 +10,7 @@ vignette: > Visualisation ============= -s2dverification contains a set of functions to plot data at every stage of the +s2dv contains a set of functions to plot data at every stage of the verification process, most based directly on R graphics plotting tools. These functions are essential to: - Quickly inspect the results of a newly produced experiment, i.e. to check @@ -28,7 +28,7 @@ The visualisation functions, most with a name following the pattern `PlotStereoMap()`, `AnimateMap()`, `PlotLayout()` and `PlotSection()`. To master these functions it is convenient to have in mind the common array -dimension structure used throughout in s2dverification and how it evolves as +dimension structure used throughout in s2dv and how it evolves as the data objects go through the statistics and verification stages. For that you can review the introduction in [**Data retrieval**](data_retrieval.md) and the sections [**Statistics**](statistics.md) and @@ -38,7 +38,7 @@ Next an explanation of which situations they fit the best, details of the options they provide and short examples of usage. The data used hereunder will be the same as in [**Data retrieval**](data_retrieval.md): ```r -library(s2dverification) +library(s2dv) expA <- list(name = 'experimentA', path = file.path('/path/to/experiments/$EXP_NAME$/monthly_mean', '$VAR_NAME$/$VAR_NAME$_$START_DATE$.nc')) @@ -79,7 +79,7 @@ the underlying R graphics `plot()` function for a fine tuning. **Note:** A general purpose time-series plotting function, `PlotTimeSeries()`, is currently being developed. This function will agglomerate all the functionality required to generate the plots resulting from all the currently -available functions in `s2dverification` and will be based on the `ggplot2` +available functions in `s2dv` and will be based on the `ggplot2` package. The current functions will be kept as they are but will simply be an interface to `PlotTimeSeries()`. See [**this report**](https://earth.bsc.es/gitlab/es/s2dverification/blob/develop-PlotTimeSeries/inst/doc/PlotTimeSeries/PlotTimeSeries.pdf) @@ -116,7 +116,7 @@ PlotClim(clim$exp, clim$obs, monini = 12, listobs = c('Observation X'), fileout = "vis_clim_expA_expB_obsX.png") ``` - + ### Plotting multi-member raw data or anomalies @@ -156,8 +156,8 @@ PlotAno(data$mod, data$obs, selected_sdates, ytitle = c("K", "K"), fileout = paste0("vis_raw_exp", c("A", "B"), "_obsX.png")) ``` - - + + ### Plotting statistics and scores @@ -216,8 +216,8 @@ PlotVsLTime(ano_expA_Y$regression, monini = 12, freq = 1, leg = FALSE, fileout = 'vis_regression_expA_expB.png') ``` - - + + - To plot the `Spread()` across ensemble members and starting dates of area averaged data (interquartile range, maximum minus minimum, standard deviation or median absolute deviation): @@ -249,10 +249,10 @@ PlotVsLTime(spread$iqr, listexp = c('Experiment A', 'Experiment B'), fileout = 'vis_mad_expA_expB.png') ``` - - - - + + + + - To plot the correlation (`Corr()`) and RMSE (`RMS()`) between experiments (averaged across ensemble members) and observations: @@ -274,8 +274,8 @@ PlotVsLTime(rms, listexp = c('Experiment A', 'Experiment B'), fileout = 'vis_rms_expA_expB_obsX.png') ``` - - + + - To plot the ratio between the RMSE of the ensemble mean of two experiments with a same observation at a single grid point or area averaged: @@ -291,7 +291,7 @@ PlotVsLTime(ratio_rms2, monini = 12, freq = 1, siglev = TRUE, leg = FALSE, fileout = 'vis_ratiorms_expA_expB_obsX.png') ``` - + - To plot the ratio between the ensemble spread of the experiments and their RMSE against the observations (`RatioSDRMS()`) at a single grid point or area averaged: @@ -307,7 +307,7 @@ PlotVsLTime(ratio_sdrms2, listexp = c('Experiment A', 'Experiment B'), fileout = 'vis_ratiosdrms_expA_expB_obsX.png') ``` - + In this example, the ratio SD / RMS is calculated for the experiment A only but against two observational datasets: @@ -327,7 +327,7 @@ PlotVsLTime(ratio_sdrms2, listobs = c('Observation X', 'Observation X + rnorm(n, 0, 0.1)'), fileout = 'vis_ratiosdrms_expA_obsX_obsXrnorm.png') ``` - + - To plot `RMSSS()` of ensemble mean at a single grid point or area averaged: ```r @@ -341,7 +341,7 @@ PlotVsLTime(rmsss2, listexp = c('Experiment A', 'Experiment B'), fileout = 'vis_rmsss_expA_expB_obsX.png') ``` - + - To plot effective number of independent data (`Eno()`): ```r @@ -355,7 +355,7 @@ PlotVsLTime(eno2, listexp = c('Experiment A', 'Experiment B'), fileout = 'vis_eno_expA_expB.png') ``` - + `Plot2VarsVsLTime()` allows to plot two indices or scores at a time on the same plot, each with its confidence intervals. It accepts as inputs arrays of only @@ -377,7 +377,7 @@ Plot2VarsVsLTime(corr[, 1, 1:3, ], rms[, 1, , ], listvars = c('Corr', 'RMSE'), fileout = 'vis_corr_rms_expA_expB_obsX.png') ``` - + `PlotACC()`, in contrast to `PlotVsLTime()`, accepts an additional dimension for the starting dates in the input and the dimension of the confidence @@ -416,7 +416,7 @@ PlotACC(acc$ACC, selected_sdates, legends = c('Experiment A', 'Experiment B'), fileout = 'vis_acc_expA_expB_obsX.png') ``` - + `PlotBoxWhisker()` @@ -443,7 +443,7 @@ PlotTimeSeries(ano_exp) + PlotTimeSeries(ano_obs, add = T) ``` - + -------------------- The `PlotTimeSeries` function has read the x- and y- axis labels, the title and the legend from the metadata automatically. By default, a horizontal line is plotted along `y = 0`, and this line can be shifted or removed with `intercept`. Layers can be added by selecting `add = TRUE`, as in the above example, where the dataset of observations have been added to the plot. The user can plot the geometric objects (the mean, confidence intervals, curves etc.) along any of the dimensions, as well as adding points, changing the linestyles and removing any of the objects. For example the curves for the individual members can be replaced with points, with different shapes for the different members, and the shading between the minimum and maximum can be removed as follows. @@ -453,7 +453,7 @@ PlotTimeSeries(ano_exp, minmax_along = NA, points = T, shape_along = 2, curves_a ``` - + ### Plotting scores and sample statistics @@ -466,8 +466,8 @@ PlotTimeSeries(Corr, interval_type = "line") ``` - - + + ### Conclusions @@ -482,8 +482,7 @@ Plotting maps This group of functions allows to plot grid data (i.e. defined over latitudes and longitudes) on a rectangular equidistant projection or on a stereographic -projection (as of s2dverification v2.5.0) as well as depth sections (i.e. -defined over latitudes/longitudes and depth levels). +projection as well as depth sections (i.e. defined over latitudes/longitudes and depth levels). Regarding the functions to plot maps, by default each grid point is drawn on a world map with a colour as a function of the magnitude of the provided field, @@ -523,8 +522,8 @@ PlotEquiMap(MeanDims(map_data$obs, 2)[1, 1, 1, , ], map_data$lon, map_data$lat, toptitle = "Obs. X: 'tas', 1990-12-01", units = "K", filled.continents = FALSE, fileout = 'vis_equimap_raw_obsX.png') ``` - - + + ```r PlotEquiMap(Mean1Dim(map_data$mod, 2)[1, 1, 1, , ], map_data$lon, map_data$lat, @@ -539,14 +538,14 @@ PlotEquiMap(Mean1Dim(map_data$obs, 2)[1, 1, 1, , ], map_data$lon, map_data$lat, filled.continents = FALSE, fileout = 'vis_equimap_cols_raw_obsX.png') ``` - - + + Or, as seen in the example from [**Snippet 2**](snippets.md#snippet2): - - + + `PlotEquiMap()` has some other additional features: @@ -572,8 +571,8 @@ PlotEquiMap(MeanDims(map_data$obs, 2)[1, 1, 1, , ], map_data$lon, map_data$lat, fileout = 'vis_equimap_contour_raw_obsX.png') ``` - - + + - Drawing boxes on the map: `boxlim`, `boxcol` and `boxlwd` allow to specify the position of the corners, colour and thickness of a box to be drawn @@ -589,7 +588,7 @@ PlotEquiMap(MeanDims(map_data$obs, 2)[1, 1, 1, , ], map_data$lon, map_data$lat, fileout = 'vis_equimap_box_expA.png') ``` - + - Ticks on the longitude/latitude axes can be adjusted with `axelab`, `labW`, `intylat` and `intxlon`. @@ -632,8 +631,8 @@ PlotStereoMap(MeanDims(world_data$obs, 2)[1, 1, 10, , ], units = "K", fileout = 'vis_stereomap_raw_obsX.png') ``` - - + + ### AnimateMap() @@ -688,15 +687,15 @@ AnimateMap(Subset(map_clim$exp, 'dataset', 1), units = "K", brks = brks, cols = cols, fileout = "vis_anim_clim_expA.gif") ``` - + And, as seen in [**Snippet 2**](snippets.md#snippet2), the animations of the actual time correlations of Experiment A and B against Observation X over the Atlantic, with black dots on values that reach a 95% significance level: - + - + Also the entire globe and stereographic projection maps can be animated: @@ -716,9 +715,9 @@ AnimateMap(world_clim$obs, fileout = "vis_anim_clim_obsX_world.gif") ``` - + - + ### PlotLayout() @@ -740,7 +739,7 @@ PlotLayout(PlotEquiMap, c('lat', 'lon'), fileout = "vis_layout_equimap_expA.png") ``` - + But really complex layouts can be achieved thanks to the great number of available parameters: @@ -765,7 +764,7 @@ layout <- PlotLayout(fun = c('PlotEquiMap', 'plot', 'plot', 'PlotStereoMap'), fileout = 'vis_layout_complex.png') ``` - + ### PlotSection() -- GitLab From 7f5a02205ea00a7fd0fb5c64dd9cbbe028a86da8 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 11 Jul 2023 17:43:28 +0200 Subject: [PATCH 38/64] format fix --- vignettes/visualisation.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/vignettes/visualisation.md b/vignettes/visualisation.md index 16a65f1..07e04fc 100644 --- a/vignettes/visualisation.md +++ b/vignettes/visualisation.md @@ -276,6 +276,7 @@ PlotVsLTime(rms, ``` + - To plot the ratio between the RMSE of the ensemble mean of two experiments with a same observation at a single grid point or area averaged: @@ -292,6 +293,7 @@ PlotVsLTime(ratio_rms2, fileout = 'vis_ratiorms_expA_expB_obsX.png') ``` + - To plot the ratio between the ensemble spread of the experiments and their RMSE against the observations (`RatioSDRMS()`) at a single grid point or area averaged: @@ -328,6 +330,7 @@ PlotVsLTime(ratio_sdrms2, fileout = 'vis_ratiosdrms_expA_obsX_obsXrnorm.png') ``` + - To plot `RMSSS()` of ensemble mean at a single grid point or area averaged: ```r @@ -342,6 +345,7 @@ PlotVsLTime(rmsss2, fileout = 'vis_rmsss_expA_expB_obsX.png') ``` + - To plot effective number of independent data (`Eno()`): ```r -- GitLab From f871545e1dc17f0c9a66bf0de9bbb08d657f0d71 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 14 Jul 2023 14:56:20 +0200 Subject: [PATCH 39/64] RPS na.rm feature done --- R/RPS.R | 64 +++++++++++----------------- R/RPSS.R | 44 +++++++++++++------- man/RPS.Rd | 15 +++++-- man/RPSS.Rd | 6 +++ tests/testthat/test-RPS.R | 87 ++++++++++++++++++++++++++++++++++++--- 5 files changed, 150 insertions(+), 66 deletions(-) diff --git a/R/RPS.R b/R/RPS.R index 8c5e6f2..c385f10 100644 --- a/R/RPS.R +++ b/R/RPS.R @@ -13,7 +13,8 @@ #'The function first calculates the probabilities for forecasts and observations, #'then use them to calculate RPS. Or, the probabilities of exp and obs can be #'provided directly to compute the score. If there is more than one dataset, RPS -#'will be computed for each pair of exp and obs data. +#'will be computed for each pair of exp and obs data. The fraction of acceptable +#'NAs can be adjusted. #' #'@param exp A named numerical array of either the forecasts with at least time #' and member dimensions, or the probabilities with at least time and category @@ -48,13 +49,14 @@ #' 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 cross.val A logical indicating whether to compute the thresholds between -#' probabilistic categories in cross-validation. -#' The default value is FALSE. -#'@param na.rm A logical or numeric value between 0 and 1. If it is numeric, -#' it shows the lower limit for the fraction of the non-NA values. The function -#' returns NA, if the fraction of non-NA values in the provided data is less than -#' na.rm. Otherwise, RPS will be calculated. +#'@param cross.val A logical indicating whether to compute the thresholds +#' between probabilistic categories in cross-validation. The default value is +#' FALSE. +#'@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. #' @@ -292,22 +294,10 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL 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:2]) - ################# - if (!is.null(memb_dim)) { - if (memb_dim %in% names(dim(exp_data))) { - exp_mean <- apply(exp_data, 1, mean) - } else { - exp_mean <- exp_data - } - if (memb_dim %in% names(dim(obs_data))) { - obs_mean <- apply(obs_data, 1, mean) - } else { - obs_mean <- obs_data - } - } else if (!is.null(cat_dim)) { - exp_mean <- apply(exp_data, 1, mean) - obs_mean <- apply(obs_data, 1, mean) - } + # 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)) { @@ -318,33 +308,24 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL f_NAs <- na.rm } - if (f_NAs <= sum(good_values)/length(obs_mean)) { + if (f_NAs <= sum(good_values) / length(obs_mean)) { - exp_data <- exp_data[good_values,] - obs_data <- obs_data[good_values,] - - if (is.null(dim(exp_data))) { - exp_data <- array(exp_data, c(sum(good_values), dim(exp)[2])) - names(dim(exp_data)) <- names(dim(exp)[1:2]) - } - - if (is.null(dim(obs_data))) { - obs_data <- array(obs_data, c(sum(good_values), dim(obs)[2])) - names(dim(obs_data)) <- names(dim(obs)[1:2]) - } + exp_data <- exp_data[good_values, , drop = F] + obs_data <- obs_data[good_values, , drop = F] # If the data inputs are forecast/observation, calculate probabilities if (is.null(cat_dim)) { if (!is.null(weights)) { - weights_data <- weights[ , , i] + weights_data <- weights[which(good_values) , , i] if (is.null(dim(weights_data))) dim(weights_data) <- c(dim(weights)[1:2]) } else { - weights_data <- weights + weights_data <- weights #NULL } - + + # Subset indices_for_clim dum <- match(indices_for_clim, which(good_values)) good_indices_for_clim <- dum[!is.na(dum)] - + exp_probs <- .GetProbs(data = exp_data, indices_for_quantiles = good_indices_for_clim, prob_thresholds = prob_thresholds, weights = weights_data, cross.val = cross.val) # exp_probs: [bin, sdate] @@ -362,6 +343,7 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL # rps: [sdate, nexp, nobs] rps [good_values, i, j] <- colSums((probs_exp_cumsum - probs_obs_cumsum)^2) + if (Fair) { # FairRPS ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1)) [formula taken from SpecsVerification::EnsRps] R <- dim(exp)[2] #memb diff --git a/R/RPSS.R b/R/RPSS.R index 5e7777e..642e888 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -61,13 +61,14 @@ #' 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 forecast. -#'@param cross.val A logical indicating whether to compute the thresholds between -#' probabilistics categories in cross-validation. -#' The default value is FALSE. -#'@param na.rm A logical or numeric value between 0 and 1. If it is numeric, -#' it shows the lower limit for the fraction of the non-NA values. The function -#' returns NA, if the fraction of non-NA values in the provided data is less than -#' na.rm. Otherwise, RPSS will be calculated. +#'@param cross.val A logical indicating whether to compute the thresholds +#' between probabilistics categories in cross-validation. The default value is +#' FALSE. +#'@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. #' @@ -114,7 +115,7 @@ 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, ncores = NULL) { # Check inputs ## exp, obs, and ref (1) @@ -371,7 +372,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) { + Fair = FALSE, weights_exp = NULL, weights_ref = NULL, cross.val = FALSE, na.rm = FALSE) { #--- if memb_dim: # exp: [sdate, memb, (dat)] @@ -390,6 +391,9 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', nobs <- as.numeric(dim(obs)[dat_dim]) } +#---------------------------------------------- + # Calculate RPS + # RPS of the forecast rps_exp <- .RPS(exp = exp, obs = obs, time_dim = time_dim, memb_dim = memb_dim, cat_dim = cat_dim, dat_dim = dat_dim, prob_thresholds = prob_thresholds, @@ -455,29 +459,33 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', rps_ref <- .RPS(exp = ref, obs = obs, time_dim = time_dim, memb_dim = memb_dim, cat_dim = cat_dim, dat_dim = dat_dim, prob_thresholds = prob_thresholds, indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_ref, - na.rm=na.rm, cross.val = cross.val) + na.rm = na.rm, cross.val = cross.val) if (!is.null(dat_dim)) { if (isTRUE(remove_dat_dim)) { dim(rps_ref) <- dim(rps_ref)[-2] } } } - - if (!is.null(dat_dim)) { +#---------------------------------------------- + # Calculate RPSS + + if (!is.null(dat_dim)) { + # rps_exp: [sdate, nexp, nobs] + # rps_ref: [sdate, (nexp), nobs] rps_exp_mean <- MeanDims(rps_exp, time_dim, na.rm = TRUE) rps_ref_mean <- MeanDims(rps_ref, time_dim, na.rm = TRUE) rpss <- array(dim = c(nexp = nexp, nobs = nobs)) sign <- array(dim = c(nexp = nexp, nobs = nobs)) - if (length(dim(rps_ref_mean)) == 1) { + if (length(dim(rps_ref_mean)) == 1) { # rps_ref: [sdate, nobs] for (i in 1:nexp) { for (j in 1:nobs) { rpss[i, j] <- 1 - rps_exp_mean[i, j] / rps_ref_mean[j] sign[i, j] <- .RandomWalkTest(skill_A = rps_exp[, i, j], skill_B = rps_ref[, j])$sign } } - } else { + } else { # rps_ref: [sdate, nexp, nobs] for (i in 1:nexp) { for (j in 1:nobs) { rpss[i, j] <- 1 - rps_exp_mean[i, j] / rps_ref_mean[i, j] @@ -490,8 +498,12 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', } } } - } else { - rpss <- 1 - mean(rps_exp,na.rm=TRUE) / mean(rps_ref,na.rm=TRUE) + + } else { # dat_dim is NULL + + # rps_exp and rps_ref: [sdate] + rpss <- 1 - mean(rps_exp, na.rm = TRUE) / mean(rps_ref, na.rm = TRUE) + # Significance good_values <- !is.na(rps_exp) & !is.na(rps_ref) if (!(na.rm <= sum(good_values)/length(good_values))) { diff --git a/man/RPS.Rd b/man/RPS.Rd index 2e21227..041ca07 100644 --- a/man/RPS.Rd +++ b/man/RPS.Rd @@ -16,6 +16,7 @@ RPS( Fair = FALSE, weights = NULL, cross.val = FALSE, + na.rm = FALSE, ncores = NULL ) } @@ -63,9 +64,14 @@ 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{cross.val}{A logical indicating whether to compute the thresholds between -probabilistic categories in cross-validation. -The default value is FALSE.} +\item{cross.val}{A logical indicating whether to compute the thresholds +between probabilistic categories in cross-validation. The default value is +FALSE.} + +\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.} @@ -90,7 +96,8 @@ and 1.\cr The function first calculates the probabilities for forecasts and observations, then use them to calculate RPS. Or, the probabilities of exp and obs can be provided directly to compute the score. If there is more than one dataset, RPS -will be computed for each pair of exp and obs data. +will be computed for each pair of exp and obs data. The fraction of acceptable +NAs can be adjusted. } \examples{ # Use synthetic data diff --git a/man/RPSS.Rd b/man/RPSS.Rd index a6abe34..a9dd7d7 100644 --- a/man/RPSS.Rd +++ b/man/RPSS.Rd @@ -18,6 +18,7 @@ RPSS( weights_exp = NULL, weights_ref = NULL, cross.val = FALSE, + na.rm = FALSE, ncores = NULL ) } @@ -83,6 +84,11 @@ consistency between the weighted and unweighted methodologies is desired.} probabilistics categories in cross-validation. The default value is FALSE.} +\item{na.rm}{A logical or numeric value between 0 and 1. If it is numeric, +it shows the lower limit for the fraction of the non-NA values. The function +returns NA, if the fraction of non-NA values in the provided data is less than +na.rm. Otherwise, RPSS will be calculated.} + \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } diff --git a/tests/testthat/test-RPS.R b/tests/testthat/test-RPS.R index 624eb37..d87da87 100644 --- a/tests/testthat/test-RPS.R +++ b/tests/testthat/test-RPS.R @@ -28,10 +28,18 @@ obs2_1 <- array(rnorm(10), dim = c(member = 1, sdate = 10)) set.seed(1) exp3 <- array(rnorm(40), dim = c(member = 2, sdate = 10, dataset = 2)) set.seed(2) -obs3 <- array(rnorm(30), dim = c(member = 1, sdate = 10, dataset = 3)) +obs3 <- array(rnorm(60), dim = c(member = 3, sdate = 10, dataset = 3)) set.seed(3) weights3 <- array(abs(rnorm(30)), dim = c(member = 2, sdate = 10, dataset = 2)) +# dat4 +exp4 <- exp3 +obs4 <- obs3 +obs4[2, 1, 1] <- NA +obs4[3, 2, 1] <- NA +exp4[1, 1, 2] <- NA +weights4 <- weights3 + ############################################## test_that("1. Input checks", { # exp and obs (1) @@ -199,7 +207,7 @@ test_that("3. Output checks: dat2", { }) ############################################## -test_that("3. Output checks: dat3", { +test_that("4. Output checks: dat3", { expect_equal( dim(RPS(exp3, obs3, dat_dim = 'dataset')), @@ -207,12 +215,12 @@ test_that("3. Output checks: dat3", { ) expect_equal( as.vector(RPS(exp3, obs3, dat_dim = 'dataset')), - c(0.75, 0.65, 0.75, 0.85, 0.75, 0.55), + c(0.3388889, 0.3388889, 0.2944444, 0.3277778, 0.3388889, 0.3388889), tolerance = 0.0001 ) expect_equal( as.vector(RPS(exp3, obs3, dat_dim = 'dataset', indices_for_clim = 2:5, prob_thresholds = seq(0.1, 0.9, 0.1))), - c(2.75, 2.45, 2.55, 2.55, 2.65, 2.15), + c(1.394444, 1.394444, 1.250000, 1.316667, 1.394444, 1.394444), tolerance = 0.0001 ) # weights @@ -222,8 +230,77 @@ test_that("3. Output checks: dat3", { ) expect_equal( as.vector(RPS(exp3, obs3, weights = weights3, dat_dim = 'dataset')), - c(0.7365024, 0.8316852, 0.6778686, 1.0256509, 0.8406320, 0.6385640), + c(0.3255765, 0.4290578, 0.2917297, 0.3554689, 0.3255765, 0.4290578), tolerance = 0.0001 ) }) + +############################################## +test_that("5. Output checks: dat4", { + + res1 <- RPS(exp4, obs4, dat_dim = 'dataset') + + expect_equal( + which(is.na(res1)), + c(1, 2, 4, 6) + ) + expect_equal( + res1[1, 2:3], + RPS(exp3, obs3, dat_dim = 'dataset')[1, 2:3] + ) + + res2 <- RPS(exp4, obs4, dat_dim = 'dataset', na.rm = T) + + expect_equal( + res2, + RPS(exp4, obs4, dat_dim = 'dataset', na.rm = 0) + ) + expect_equal( + which(is.na(res2)), + integer(0) + ) + expect_equal( + c(res2), + c(0.3472222, 0.3680556, 0.2944444, 0.3333333, 0.3388889, 0.2222222), + tolerance = 0.0001 + ) + + expect_equal( + RPS(exp4, obs4, dat_dim = 'dataset', na.rm = 0.8), + res2 + ) + expect_equal( + RPS(exp4, obs4, dat_dim = 'dataset', na.rm = 0.95), + res1 + ) + expect_equal( + which(is.na(RPS(exp4, obs4, dat_dim = 'dataset', na.rm = 0.9))), + c(1, 2) + ) + + # weights + res3 <- RPS(exp4, obs4, weights = weights4, dat_dim = 'dataset') + expect_equal( + which(is.na(res3)), + c(1, 2, 4, 6) + ) + expect_equal( + res3[1, 2:3], + RPS(exp3, obs3, dat_dim = 'dataset',weights = weights3)[1, 2:3] + ) + + res4 <- RPS(exp4, obs4, weights = weights4, dat_dim = 'dataset', na.rm = 0) + expect_equal( + c(res4), + c(0.3865228, 0.4885273, 0.2917297, 0.4143631, 0.3255765, 0.4028817), + tolerance = 0.0001 + ) + + expect_equal( + which(is.na(RPS(exp4, obs4, weights = weights4, dat_dim = 'dataset', na.rm = 0.9))), + c(1, 2) + ) + +}) + -- GitLab From 9776cd9b84e90be93374b285ac2cde60fa056b69 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 17 Jul 2023 11:55:16 +0200 Subject: [PATCH 40/64] Make function work when all NAs --- R/PlotEquiMap.R | 17 ++++++++++++++++- R/PlotLayout.R | 18 +++++++++++++++--- 2 files changed, 31 insertions(+), 4 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 16f42b5..e553d62 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -530,7 +530,22 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, title_scale <- sizetit } - var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) + if (!all(is.na(var))) { + var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) + } else { + if (!is.null(brks)) { + #NOTE: var_limits be like this to avoid warnings from ColorBar + var_limits <- c(min(brks, na.rm = TRUE) + diff(brks)[1], + max(brks, na.rm = TRUE)) + } else { + var_limits <- c(-0.5, 0.5) # random range since colorbar is not going to be plotted + if (drawleg) { + drawleg <- FALSE + .warning("All data are NAs. Color bar won't be drawn. If you want to have color bar still, define parameter 'brks'.") + } + } + } + # Check: brks, cols, subsampleg, bar_limits, color_fun, bar_extra_labels, draw_bar_ticks # draw_separators, triangle_ends_scale, label_scale, units, units_scale, # bar_label_digits diff --git a/R/PlotLayout.R b/R/PlotLayout.R index c442bf7..5f757c2 100644 --- a/R/PlotLayout.R +++ b/R/PlotLayout.R @@ -346,13 +346,25 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, } # Check the rest of parameters (unless the user simply wants to build an empty layout) - var_limits <- NULL if (!all(sapply(var, is_single_na))) { + + if (!all(is.na(unlist(var)))) { var_limits <- c(min(unlist(var), na.rm = TRUE), max(unlist(var), na.rm = TRUE)) - if ((any(is.infinite(var_limits)) || var_limits[1] == var_limits[2])) { - stop("Arrays in parameter 'var' must contain at least 2 different values.") + } else { + if (!is.null(brks)) { + #NOTE: var_limits be like this to avoid warnings from ColorBar + var_limits <- c(min(brks, na.rm = TRUE) + diff(brks)[1], + max(brks, na.rm = TRUE)) + } else { + var_limits <- c(-0.5, 0.5) # random range since colorbar is not going to be plotted + if (!isFALSE(drawleg)) { + drawleg <- FALSE + .warning("All data are NAs. Color bar won't be drawn. If you want to have color bar still, define parameter 'brks'.") + } } } + } + colorbar <- ColorBar(brks, cols, FALSE, subsampleg, bar_limits, var_limits, triangle_ends, col_inf, col_sup, color_fun, plot = FALSE, draw_bar_ticks, -- GitLab From b550f5a3bfec16f23a99d13c01376a4a3219c185 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 17 Jul 2023 12:34:41 +0200 Subject: [PATCH 41/64] Consider using bar_limits when all data are NAs --- R/PlotEquiMap.R | 5 ++++- R/PlotLayout.R | 4 +++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index e553d62..0af9759 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -537,11 +537,14 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, #NOTE: var_limits be like this to avoid warnings from ColorBar var_limits <- c(min(brks, na.rm = TRUE) + diff(brks)[1], max(brks, na.rm = TRUE)) + } else if (!is.null(bar_limits)) { + var_limits <- c(bar_limits[1] + 0.01, bar_limits[2]) } else { var_limits <- c(-0.5, 0.5) # random range since colorbar is not going to be plotted if (drawleg) { drawleg <- FALSE - .warning("All data are NAs. Color bar won't be drawn. If you want to have color bar still, define parameter 'brks'.") + .warning("All data are NAs. Color bar won't be drawn. If you want to have ", + "color bar still, define parameter 'brks' or 'bar_limits'.") } } } diff --git a/R/PlotLayout.R b/R/PlotLayout.R index 5f757c2..81d751b 100644 --- a/R/PlotLayout.R +++ b/R/PlotLayout.R @@ -355,11 +355,13 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, #NOTE: var_limits be like this to avoid warnings from ColorBar var_limits <- c(min(brks, na.rm = TRUE) + diff(brks)[1], max(brks, na.rm = TRUE)) + } else if (!is.null(bar_limits)) { + var_limits <- c(bar_limits[1] + 0.01, bar_limits[2]) } else { var_limits <- c(-0.5, 0.5) # random range since colorbar is not going to be plotted if (!isFALSE(drawleg)) { drawleg <- FALSE - .warning("All data are NAs. Color bar won't be drawn. If you want to have color bar still, define parameter 'brks'.") + .warning("All data are NAs. Color bar won't be drawn. If you want to have color bar still, define parameter 'brks' or 'bar_limits'.") } } } -- GitLab From 52bea1abfa2f8be198de9d5dbc034f8c948aca33 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 17 Jul 2023 12:36:17 +0200 Subject: [PATCH 42/64] indentation --- R/PlotLayout.R | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/R/PlotLayout.R b/R/PlotLayout.R index 81d751b..6553f8a 100644 --- a/R/PlotLayout.R +++ b/R/PlotLayout.R @@ -347,25 +347,24 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, # Check the rest of parameters (unless the user simply wants to build an empty layout) if (!all(sapply(var, is_single_na))) { - - if (!all(is.na(unlist(var)))) { - var_limits <- c(min(unlist(var), na.rm = TRUE), max(unlist(var), na.rm = TRUE)) - } else { - if (!is.null(brks)) { - #NOTE: var_limits be like this to avoid warnings from ColorBar - var_limits <- c(min(brks, na.rm = TRUE) + diff(brks)[1], - max(brks, na.rm = TRUE)) - } else if (!is.null(bar_limits)) { - var_limits <- c(bar_limits[1] + 0.01, bar_limits[2]) + if (!all(is.na(unlist(var)))) { + var_limits <- c(min(unlist(var), na.rm = TRUE), max(unlist(var), na.rm = TRUE)) } else { - var_limits <- c(-0.5, 0.5) # random range since colorbar is not going to be plotted - if (!isFALSE(drawleg)) { - drawleg <- FALSE - .warning("All data are NAs. Color bar won't be drawn. If you want to have color bar still, define parameter 'brks' or 'bar_limits'.") + if (!is.null(brks)) { + #NOTE: var_limits be like this to avoid warnings from ColorBar + var_limits <- c(min(brks, na.rm = TRUE) + diff(brks)[1], + max(brks, na.rm = TRUE)) + } else if (!is.null(bar_limits)) { + var_limits <- c(bar_limits[1] + 0.01, bar_limits[2]) + } else { + var_limits <- c(-0.5, 0.5) # random range since colorbar is not going to be plotted + if (!isFALSE(drawleg)) { + drawleg <- FALSE + .warning("All data are NAs. Color bar won't be drawn. If you want to have color bar still, define parameter 'brks' or 'bar_limits'.") + } } } } - } colorbar <- ColorBar(brks, cols, FALSE, subsampleg, bar_limits, var_limits, triangle_ends, col_inf, col_sup, color_fun, -- GitLab From c025876bd29679e14322b708d5093e059b3cabfa Mon Sep 17 00:00:00 2001 From: eduzenli Date: Tue, 18 Jul 2023 08:34:56 +0200 Subject: [PATCH 43/64] RPSS.R na.rm feature --- R/RPSS.R | 75 ++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 49 insertions(+), 26 deletions(-) diff --git a/R/RPSS.R b/R/RPSS.R index 642e888..9b19c54 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -417,30 +417,48 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', obs_data <- obs[ , , j] if (is.null(dim(obs_data))) dim(obs_data) <- c(dim(obs)[1:2]) obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, - prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) + prob_thresholds = prob_thresholds, + weights = NULL, cross.val = cross.val) # obs_probs: [bin, sdate] } else { obs_probs <- t(obs[ , , j]) } - clim_probs <- c(prob_thresholds[1], diff(prob_thresholds), - 1 - prob_thresholds[length(prob_thresholds)]) - clim_probs <- array(clim_probs, dim = dim(obs_probs)) - # clim_probs: [bin, sdate] - - # Calculate RPS for each time step - probs_clim_cumsum <- apply(clim_probs, 2, cumsum) - probs_obs_cumsum <- apply(obs_probs, 2, cumsum) - rps_ref[ , j] <- colSums((probs_clim_cumsum - probs_obs_cumsum)^2) - # if (Fair) { # FairRPS - # ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1)) [formula taken from SpecsVerification::EnsRps] - # R <- dim(exp)[2] #memb - # R_new <- Inf - # adjustment <- (-1) / (R - 1) * probs_clim_cumsum * (1 - probs_clim_cumsum) - # adjustment <- apply(adjustment, 2, sum) - # rps_ref <- rps_ref + adjustment - # } + good_values <- !is.na(colMeans(obs_probs)) + + 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(good_values)) { + + clim_probs <- c(prob_thresholds[1], diff(prob_thresholds), + 1 - prob_thresholds[length(prob_thresholds)]) + clim_probs <- array(clim_probs, dim = dim(obs_probs)) + # clim_probs: [bin, sdate] + + # Calculate RPS for each time step + probs_clim_cumsum <- apply(clim_probs, 2, cumsum) + probs_obs_cumsum <- apply(obs_probs, 2, cumsum) + rps_ref[ , j] <- colSums((probs_clim_cumsum - probs_obs_cumsum)^2) + # if (Fair) { # FairRPS + # ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1)) [formula taken from SpecsVerification::EnsRps] + # R <- dim(exp)[2] #memb + # R_new <- Inf + # adjustment <- (-1) / (R - 1) * probs_clim_cumsum * (1 - probs_clim_cumsum) + # adjustment <- apply(adjustment, 2, sum) + # rps_ref <- rps_ref + adjustment + # } + + } else { + rps_ref[ , j] <- as.numeric(NA) + } } + if (is.null(dat_dim)) { dim(rps_ref) <- dim(exp)[time_dim] } @@ -482,18 +500,23 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', for (i in 1:nexp) { for (j in 1:nobs) { rpss[i, j] <- 1 - rps_exp_mean[i, j] / rps_ref_mean[j] - sign[i, j] <- .RandomWalkTest(skill_A = rps_exp[, i, j], skill_B = rps_ref[, j])$sign + ind_nonNA <- !is.na(rps_exp[, i, j]) & !is.na(rps_ref[, j]) + 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, j])$sign + } } } } else { # rps_ref: [sdate, nexp, nobs] for (i in 1:nexp) { for (j in 1:nobs) { rpss[i, j] <- 1 - rps_exp_mean[i, j] / rps_ref_mean[i, j] - good_values <- !is.na(rps_exp[, i, j]) & !is.na(rps_ref[, i, j]) - if (!(na.rm <= sum(good_values)/length(good_values))) { - sign <- NA + ind_nonNA <- !is.na(rps_exp[, i, j]) & !is.na(rps_ref[, i, j]) + if (!any(ind_nonNA)) { + sign[i, j] <- NA } else { - sign[i, j] <- .RandomWalkTest(skill_A = rps_exp[good_values, i, j], skill_B = rps_ref[good_values, i, j])$sign + sign[i, j] <- .RandomWalkTest(skill_A = rps_exp[ind_nonNA, i, j], skill_B = rps_ref[ind_nonNA, i, j])$sign } } } @@ -505,11 +528,11 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', rpss <- 1 - mean(rps_exp, na.rm = TRUE) / mean(rps_ref, na.rm = TRUE) # Significance - good_values <- !is.na(rps_exp) & !is.na(rps_ref) - if (!(na.rm <= sum(good_values)/length(good_values))) { + ind_nonNA <- !is.na(rps_exp) & !is.na(rps_ref) + if (!any(ind_nonNA)) { sign <- NA } else { - sign <- .RandomWalkTest(skill_A = rps_exp[good_values], skill_B = rps_ref[good_values], sign = T, pval = F)$sign + sign <- .RandomWalkTest(skill_A = rps_exp[ind_nonNA], skill_B = rps_ref[ind_nonNA], sign = T, pval = F)$sign } } -- GitLab From 04c5043c0501389806b709db475ef5ea5f2592d6 Mon Sep 17 00:00:00 2001 From: eduzenli Date: Tue, 25 Jul 2023 18:02:28 +0200 Subject: [PATCH 44/64] RPSS, NA removing before the obs prob calc and taking ref NAs into consideration --- R/RPSS.R | 201 +++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 136 insertions(+), 65 deletions(-) diff --git a/R/RPSS.R b/R/RPSS.R index 9b19c54..45d8a8a 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -372,7 +372,8 @@ 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) { + Fair = FALSE, weights_exp = NULL, weights_ref = NULL, cross.val = FALSE, + na.rm = FALSE) { #--- if memb_dim: # exp: [sdate, memb, (dat)] @@ -383,58 +384,126 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', # obs: [sdate, bin, (dat)] # ref: [sdate, bin, (dat)] or NULL - if (is.null(dat_dim)) { - nexp <- 1 - nobs <- 1 - } else { - nexp <- as.numeric(dim(exp)[dat_dim]) - nobs <- as.numeric(dim(obs)[dat_dim]) - } - #---------------------------------------------- # Calculate RPS # RPS of the forecast - rps_exp <- .RPS(exp = exp, obs = obs, time_dim = time_dim, memb_dim = memb_dim, - cat_dim = cat_dim, dat_dim = dat_dim, prob_thresholds = prob_thresholds, - indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_exp, - cross.val = cross.val, na.rm = na.rm) - + if (isTRUE(na.rm)) { + f_NAs <- 0 + } else if (isFALSE(na.rm)) { + f_NAs <- 1 + } else { + f_NAs <- na.rm + } + + if (!is.null(ref)) { + if (is.null(dat_dim)) { + nexp <- 1 + nobs <- 1 + nref <- 1 + dim(obs) <- c(dim(obs), nobs = nobs) + dim(exp) <- c(dim(exp), nexp = nexp) + dim(ref) <- c(dim(ref), nexp = nref) + } else { + nexp <- as.numeric(dim(exp)[dat_dim]) + nobs <- as.numeric(dim(obs)[dat_dim]) + nref <- as.numeric(dim(ref)[dat_dim]) + if (is.na(nref)) { + nref<-1 + dim(ref) <- c(dim(ref), nref = nref) + } + } + rps_exp <- array(NaN,dim = c(dim(exp)[time_dim], nexp = nexp, nobs = nobs)) + rps_ref <- array(NaN,dim = c(dim(exp)[time_dim], nexp = nexp, nobs = nobs)) + for (i in 1:nexp) { + for (j in 1:nobs) { + for (k in 1:nref) { + if (nref != 1 & k!=i) { #nref is allowed to be either 1 or equal to nexp + next + } + exp_data <- exp[ , , i] + obs_data <- obs[ , , j] + ref_data <- ref[ , , k] + exp_mean <- rowMeans(exp_data) + obs_mean <- rowMeans(obs_data) + ref_mean <- rowMeans(ref_data) + good_values <- !is.na(exp_mean) & !is.na(obs_mean) & !is.na(ref_mean) + dum <- match(indices_for_clim, which(good_values)) + good_indices_for_clim <- dum[!is.na(dum)] + if (f_NAs <= sum(good_values) / length(good_values)) { + rps_exp[good_values,i,j] <- .RPS(exp = exp[good_values,,i], obs = obs[good_values,,j], + time_dim = time_dim, memb_dim = memb_dim, + cat_dim = cat_dim, dat_dim = NULL, + prob_thresholds = prob_thresholds, + indices_for_clim = good_indices_for_clim, + Fair = Fair, weights = weights_exp, + cross.val = cross.val, na.rm = na.rm) + rps_ref[good_values,i,j] <- .RPS(exp = ref[good_values,,k], obs = obs[good_values,,j], + time_dim = time_dim, memb_dim = memb_dim, + cat_dim = cat_dim, dat_dim = NULL, + prob_thresholds = prob_thresholds, + indices_for_clim = good_indices_for_clim, + Fair = Fair, weights = weights_ref, + na.rm = na.rm, cross.val = cross.val) + } + } + } + } + if (is.null(dat_dim)) { + dim(rps_ref) <- dim(rps_exp) <- dim(exp)[time_dim] + } + } else if (is.null(ref)) { + rps_exp <- .RPS(exp = exp, obs = obs, time_dim = time_dim, memb_dim = memb_dim, + cat_dim = cat_dim, dat_dim = dat_dim, prob_thresholds = prob_thresholds, + indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_exp, + cross.val = cross.val, na.rm = na.rm) + + if (is.null(dat_dim)) { + nexp <- 1 + nobs <- 1 + } else { + nexp <- as.numeric(dim(exp)[dat_dim]) + nobs <- as.numeric(dim(obs)[dat_dim]) + } + # RPS of the reference forecast - if (is.null(ref)) { ## using climatology as reference forecast + +# if (is.null(ref)) { ## using climatology as reference forecast if (!is.null(memb_dim)) { if (!memb_dim %in% names(dim(obs))) { obs <- InsertDim(obs, posdim = 2, lendim = 1, name = memb_dim) } } + + rps_ref <- array(NaN,dim = c(dim(obs)[time_dim], nexp = nexp, nobs = nobs)) + if (is.null(dat_dim)) { dim(obs) <- c(dim(obs), nobs = nobs) + dim(exp) <- c(dim(exp), nexp = nexp) + dim(rps_exp) <- dim(rps_ref) } - rps_ref <- array(dim = c(dim(obs)[time_dim], nobs = nobs)) - - for (j in 1:nobs) { - if (is.null(cat_dim)) { # calculate probs - obs_data <- obs[ , , j] - if (is.null(dim(obs_data))) dim(obs_data) <- c(dim(obs)[1:2]) - obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, - prob_thresholds = prob_thresholds, - weights = NULL, cross.val = cross.val) - # obs_probs: [bin, sdate] - } else { - obs_probs <- t(obs[ , , j]) - } - good_values <- !is.na(colMeans(obs_probs)) + # Use good values only - if (isTRUE(na.rm)) { - f_NAs <- 0 - } else if (isFALSE(na.rm)) { - f_NAs <- 1 - } else { - f_NAs <- na.rm - } + for (i in 1:nexp) { + for (j in 1:nobs) { + # Use good values only + good_values <- !is.na(rps_exp[, i, j]) + if (f_NAs <= sum(good_values) / length(good_values)) { + obs_data <- obs[good_values, , j] + if (is.null(dim(obs_data))) dim(obs_data) <- c(dim(obs)[1:2]) + + if (is.null(cat_dim)) { # calculate probs - if (f_NAs <= sum(good_values) / length(good_values)) { + # Subset indices_for_clim + dum <- match(indices_for_clim, which(good_values)) + good_indices_for_clim <- dum[!is.na(dum)] + obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = good_indices_for_clim, + prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) + # obs_probs: [bin, sdate] + } else { + obs_probs <- t(obs_data) + } clim_probs <- c(prob_thresholds[1], diff(prob_thresholds), 1 - prob_thresholds[length(prob_thresholds)]) @@ -444,8 +513,11 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', # Calculate RPS for each time step probs_clim_cumsum <- apply(clim_probs, 2, cumsum) probs_obs_cumsum <- apply(obs_probs, 2, cumsum) - rps_ref[ , j] <- colSums((probs_clim_cumsum - probs_obs_cumsum)^2) - # if (Fair) { # FairRPS + rps_ref[good_values, i, j] <- colSums((probs_clim_cumsum - probs_obs_cumsum)^2) + } else { + rps_ref[, i, j] <- NA + } + # if (Fair) { # FairRPS # ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1)) [formula taken from SpecsVerification::EnsRps] # R <- dim(exp)[2] #memb # R_new <- Inf @@ -454,36 +526,35 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', # rps_ref <- rps_ref + adjustment # } - } else { - rps_ref[ , j] <- as.numeric(NA) } } if (is.null(dat_dim)) { - dim(rps_ref) <- dim(exp)[time_dim] + dim(rps_ref) <- dim(rps_exp) <- dim(exp)[time_dim] } - } else { # use "ref" as reference forecast - if (!is.null(dat_dim) && (!dat_dim %in% names(dim(ref)))) { - remove_dat_dim <- TRUE - ref <- InsertDim(ref, posdim = 3, lendim = 1, name = dat_dim) - if (!is.null(weights_ref)) { - weights_ref <- InsertDim(weights_ref, posdim = 3, lendim = 1, name = dat_dim) - } - } else { - remove_dat_dim <- FALSE - } - - rps_ref <- .RPS(exp = ref, obs = obs, time_dim = time_dim, memb_dim = memb_dim, - cat_dim = cat_dim, dat_dim = dat_dim, prob_thresholds = prob_thresholds, - indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_ref, - na.rm = na.rm, cross.val = cross.val) - if (!is.null(dat_dim)) { - if (isTRUE(remove_dat_dim)) { - dim(rps_ref) <- dim(rps_ref)[-2] - } - } } +# else { # use "ref" as reference forecast +# if (!is.null(dat_dim) && (!dat_dim %in% names(dim(ref)))) { +# remove_dat_dim <- TRUE +# ref <- InsertDim(ref, posdim = 3, lendim = 1, name = dat_dim) +# if (!is.null(weights_ref)) { +# weights_ref <- InsertDim(weights_ref, posdim = 3, lendim = 1, name = dat_dim) +# } +# } else { +# remove_dat_dim <- FALSE +# } + +# rps_ref <- .RPS(exp = ref, obs = obs, time_dim = time_dim, memb_dim = memb_dim, +# cat_dim = cat_dim, dat_dim = dat_dim, prob_thresholds = prob_thresholds, +# indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_ref, +# na.rm = na.rm, cross.val = cross.val) +# if (!is.null(dat_dim)) { +# if (isTRUE(remove_dat_dim)) { +# dim(rps_ref) <- dim(rps_ref)[-2] +# } +# } +# } #---------------------------------------------- # Calculate RPSS @@ -500,7 +571,7 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', for (i in 1:nexp) { for (j in 1:nobs) { rpss[i, j] <- 1 - rps_exp_mean[i, j] / rps_ref_mean[j] - ind_nonNA <- !is.na(rps_exp[, i, j]) & !is.na(rps_ref[, j]) + ind_nonNA <- !is.na(rps_exp[, i, j]) if (!any(ind_nonNA)) { sign[i, j] <- NA } else { @@ -512,7 +583,7 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', for (i in 1:nexp) { for (j in 1:nobs) { rpss[i, j] <- 1 - rps_exp_mean[i, j] / rps_ref_mean[i, j] - ind_nonNA <- !is.na(rps_exp[, i, j]) & !is.na(rps_ref[, i, j]) + ind_nonNA <- !is.na(rps_exp[, i, j]) if (!any(ind_nonNA)) { sign[i, j] <- NA } else { @@ -528,7 +599,7 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', rpss <- 1 - mean(rps_exp, na.rm = TRUE) / mean(rps_ref, na.rm = TRUE) # Significance - ind_nonNA <- !is.na(rps_exp) & !is.na(rps_ref) + ind_nonNA <- !is.na(rps_exp) if (!any(ind_nonNA)) { sign <- NA } else { -- GitLab From d1693cfc5bd0783fa4ae51c822cf04626d04899c Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 3 Aug 2023 14:02:29 +0200 Subject: [PATCH 45/64] check only when var_limits not NULL --- R/ColorBar.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ColorBar.R b/R/ColorBar.R index 286b115..b6da2bb 100644 --- a/R/ColorBar.R +++ b/R/ColorBar.R @@ -288,7 +288,7 @@ ColorBar <- function(brks = NULL, cols = NULL, vertical = TRUE, triangle_ends <- triangle_ends } } - if (plot) { + if (plot && !is.null(var_limits)) { if ((bar_limits[1] >= var_limits[1]) && !triangle_ends[1]) { .warning("There are variable values smaller or equal to the lower limit ", "of the colour bar and the lower triangle end has been ", -- GitLab From ad8cb2194f6a79e128168848363b9832df8a9480 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 11 Aug 2023 12:31:47 +0200 Subject: [PATCH 46/64] Create issue template --- .gitlab/issue_templates/Default.md | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) create mode 100644 .gitlab/issue_templates/Default.md diff --git a/.gitlab/issue_templates/Default.md b/.gitlab/issue_templates/Default.md new file mode 100644 index 0000000..30ba620 --- /dev/null +++ b/.gitlab/issue_templates/Default.md @@ -0,0 +1,26 @@ +(This is a template to report problems or suggest a new development. Please fill in the relevant information and remove the rest.) + +Hi @aho (and @erifarov), + +#### Summary +(Bug: Summarize the bug and explain briefly the expected and the current behavior.) +(New development: Summarize the development needed.) + +#### Example +(Bug: Provide a **minimal reproducible example** and the error message. See [How To Build A Minimal Reproducible Example](https://docs.google.com/document/d/1zRlmsRwFDJctDB94x6HGf6ezu3HFHhEjaBu0hVcrwTI/edit#heading=h.skblym4acpw5)) +(New development: Provide an example script or useful piece of code if appliable.) + +```r +#Example: +exp <- PlotEquiMap(...) +``` +> Error in ColorBar: &%$("!* + +#### Module and Package Version +(Which R version are you using? e.g., R/4.1.2) +(What other modules and their versions required to reproduce this issue? e.g., PROJ/4.8.0-foss-2015a) +(Which R package versions are you using? Check with sessionInfo(). e.g., s2dv_1.4.1) +(Which machine are you using? WS, Nord3, hub, others...) + +#### Other Relevant Information +(Additional information, e.g., the plots.) -- GitLab From b785beabdd75b1dd3b38c474fec9fa34f1ecf09c Mon Sep 17 00:00:00 2001 From: eduzenli Date: Mon, 21 Aug 2023 16:46:41 +0200 Subject: [PATCH 47/64] fine tuning --- R/RPSS.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/RPSS.R b/R/RPSS.R index 45d8a8a..fda2beb 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -491,7 +491,7 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', good_values <- !is.na(rps_exp[, i, j]) if (f_NAs <= sum(good_values) / length(good_values)) { obs_data <- obs[good_values, , j] - if (is.null(dim(obs_data))) dim(obs_data) <- c(dim(obs)[1:2]) + if (is.null(dim(obs_data))) dim(obs_data) <- c(length(obs_data),1) if (is.null(cat_dim)) { # calculate probs -- GitLab From 5b707cb2f11046d155b181568a716a10b79ffc17 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Mon, 28 Aug 2023 13:11:47 +0200 Subject: [PATCH 48/64] included possibility of building the climatological forecast when ref=NULL without cross-validation --- R/CRPSS.R | 57 ++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 35 insertions(+), 22 deletions(-) diff --git a/R/CRPSS.R b/R/CRPSS.R index e2b0df6..438079c 100644 --- a/R/CRPSS.R +++ b/R/CRPSS.R @@ -7,11 +7,10 @@ #'infinite and 1. If the CRPSS is positive, it indicates that the forecast has #'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 (same probabilities for all categories for all time steps), -#'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). +#'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). #' #'@param exp A named numerical array of the forecast with at least time #' dimension. @@ -22,9 +21,12 @@ #' least time and member dimension. The dimensions must be the same as 'exp' #' except 'memb_dim' and 'dat_dim'. If there is only one reference dataset, #' it should not have dataset dimension. If there is corresponding reference -#' for each experiement, the dataset dimension must have the same length as in +#' for each experiment, the dataset dimension must have the same length as in #' 'exp'. If 'ref' is NULL, the climatological forecast is used as reference -#' forecast. The default value is NULL. +#' forecast. To build the climatological forecast, the observed values along +#' the whole time period are used as different members for all time steps. The +#' parameter 'clim.cross.val' controls whether to build it using +#' cross-validation. The default value is NULL. #'@param time_dim A character string indicating the name of the time dimension. #' The default value is 'sdate'. #'@param memb_dim A character string indicating the name of the member dimension @@ -36,6 +38,10 @@ #'@param Fair A logical indicating whether to compute the FairCRPSS (the #' potential CRPSS that the forecast would have with an infinite ensemble #' size). The default value is FALSE. +#'@param clim.cross.val A logical indicating whether to build the climatological +#' 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 ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -67,7 +73,7 @@ #'@importFrom ClimProjDiags Subset #'@export CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', dat_dim = NULL, - Fair = FALSE, ncores = NULL) { + Fair = FALSE, clim.cross.val = TRUE, ncores = NULL) { # Check inputs ## exp, obs, and ref (1) @@ -159,9 +165,13 @@ CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', } } ## Fair - if (!is.logical(Fair) | length(Fair) > 1) { + if (!is.logical(Fair) | is.na(Fair) | length(Fair) > 1) { stop("Parameter 'Fair' must be either TRUE or FALSE.") } + ## clim.cross.val + 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.") + } ## ncores if (!is.null(ncores)) { if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { @@ -193,13 +203,14 @@ CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', time_dim = time_dim, memb_dim = memb_dim, dat_dim = dat_dim, Fair = Fair, + clim.cross.val = clim.cross.val, ncores = ncores) return(output) } .CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', dat_dim = NULL, - Fair = FALSE) { + Fair = FALSE, clim.cross.val = TRUE) { # exp: [sdate, memb, (dat)] # obs: [sdate, (dat)] @@ -228,12 +239,13 @@ CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', obs_time_len <- dim(obs)[time_dim] if (is.null(dat_dim)) { - ## Without cross-validation: - ## ref <- array(data = rep(obs, each = obs_time_len), dim = c(obs_time_len, obs_time_len)) - ## 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] + 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) @@ -247,12 +259,13 @@ CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', names(dim(crps_ref)) <- c(time_dim, 'nobs') for (i_obs in 1:nobs) { - ## Without cross-validation: - ## ref <- array(data = rep(obs[, i_obs], each = obs_time_len), dim = c(obs_time_len, obs_time_len)) - ## 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] + 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) -- GitLab From 8b28810a35f05c7bbeefb20f0d9264c4ccfffa9d Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 28 Aug 2023 17:06:48 +0200 Subject: [PATCH 49/64] add unit tests for clim.cross.val = F --- R/CRPSS.R | 2 +- man/CRPSS.Rd | 22 +++++++++++++++------- tests/testthat/test-CRPSS.R | 11 +++++++++++ 3 files changed, 27 insertions(+), 8 deletions(-) diff --git a/R/CRPSS.R b/R/CRPSS.R index 438079c..6b1ed17 100644 --- a/R/CRPSS.R +++ b/R/CRPSS.R @@ -169,7 +169,7 @@ CRPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', stop("Parameter 'Fair' must be either TRUE or FALSE.") } ## clim.cross.val - if (!is.logical(clim.cross.val) | is.na(clim.cross.val) | length(clim.cross.val) != 1){ + 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.") } ## ncores diff --git a/man/CRPSS.Rd b/man/CRPSS.Rd index 31bf501..3fa66b0 100644 --- a/man/CRPSS.Rd +++ b/man/CRPSS.Rd @@ -12,6 +12,7 @@ CRPSS( memb_dim = "member", dat_dim = NULL, Fair = FALSE, + clim.cross.val = TRUE, ncores = NULL ) } @@ -27,9 +28,12 @@ and 'dat_dim'.} least time and member dimension. The dimensions must be the same as 'exp' except 'memb_dim' and 'dat_dim'. If there is only one reference dataset, it should not have dataset dimension. If there is corresponding reference -for each experiement, the dataset dimension must have the same length as in +for each experiment, the dataset dimension must have the same length as in 'exp'. If 'ref' is NULL, the climatological forecast is used as reference -forecast. The default value is NULL.} +forecast. To build the climatological forecast, the observed values along +the whole time period are used as different members for all time steps. The +parameter 'clim.cross.val' controls whether to build it using +cross-validation. The default value is NULL.} \item{time_dim}{A character string indicating the name of the time dimension. The default value is 'sdate'.} @@ -46,6 +50,11 @@ The default value is NULL.} potential CRPSS that the forecast would have with an infinite ensemble size). The default value is FALSE.} +\item{clim.cross.val}{A logical indicating whether to build the climatological +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{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } @@ -70,11 +79,10 @@ worsening with respect to a reference forecast. The CRPSS ranges between minus infinite and 1. If the CRPSS is positive, it indicates that the forecast has 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 (same probabilities for all categories for all time steps), -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). +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). } \examples{ exp <- array(rnorm(1000), dim = c(lat = 3, lon = 2, member = 10, sdate = 50)) diff --git a/tests/testthat/test-CRPSS.R b/tests/testthat/test-CRPSS.R index 5311724..06b1bdb 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." ) + # clim.cross.val + expect_error( + CRPSS(exp1, obs1, clim.cross.val = NA), + "Parameter 'clim.cross.val' must be either TRUE or FALSE." + ) # ncores expect_error( CRPSS(exp2, obs2, ncores = 1.5), @@ -176,6 +181,12 @@ test_that("2. Output checks: dat1", { c(0.3491793, 0.3379610), tolerance = 0.0001 ) + # clim.cross.val + expect_equal( + as.vector(CRPSS(exp1, obs1, ref = NULL, clim.cross.val = F)$crpss), + c(-0.1582765, -0.2390707), + tolerance = 0.0001 + ) }) -- GitLab From e6d151c19320b90fb73ea481dd23e978bb40929a Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 30 Aug 2023 12:07:22 +0200 Subject: [PATCH 50/64] Add warning when all data is NA --- R/PlotEquiMap.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 0af9759..3b8f861 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -533,7 +533,8 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, if (!all(is.na(var))) { var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) } else { - if (!is.null(brks)) { + .warning("All the data are NAs. The map will be filled with colNA.") + if (!is.null(brks) && length(brks) > 1) { #NOTE: var_limits be like this to avoid warnings from ColorBar var_limits <- c(min(brks, na.rm = TRUE) + diff(brks)[1], max(brks, na.rm = TRUE)) -- GitLab From c5777a9ce4ca3b455aa38c4dc61badda9ad25dbc Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 6 Sep 2023 11:55:17 +0200 Subject: [PATCH 51/64] refine code --- R/RPSS.R | 75 ++++++++++++++++++++++++++++++-------------------------- 1 file changed, 40 insertions(+), 35 deletions(-) diff --git a/R/RPSS.R b/R/RPSS.R index fda2beb..9f41988 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -5,7 +5,7 @@ #'assess whether a forecast presents an improvement or worsening with respect to #'a reference forecast. The RPSS ranges between minus infinite and 1. If the #'RPSS is positive, it indicates that the forecast has higher skill than the -#'reference forecast, while a negative value means that it has a lower skill. +#'reference forecast, while a negative value means that it has a lower skill.\cr #'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 @@ -13,8 +13,10 @@ #'based on a Random Walk test at the 95% 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. +#'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 +#'examined before the calculation. If the ratio is higher than the threshold +#'(assigned by parameter \code{na.rm}), NA will be returned directly. #' #'@param exp A named numerical array of either the forecast with at least time #' and member dimensions, or the probabilities with at least time and category @@ -384,10 +386,6 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', # obs: [sdate, bin, (dat)] # ref: [sdate, bin, (dat)] or NULL -#---------------------------------------------- - # Calculate RPS - - # RPS of the forecast if (isTRUE(na.rm)) { f_NAs <- 0 } else if (isFALSE(na.rm)) { @@ -396,40 +394,53 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', f_NAs <- na.rm } + if (is.null(dat_dim)) { + nexp <- 1 + nobs <- 1 + } else { + nexp <- as.numeric(dim(exp)[dat_dim]) + nobs <- as.numeric(dim(obs)[dat_dim]) + } + + # Calculate RPS + if (!is.null(ref)) { + + # Adjust dimensions to be [sdate, memb, dat] for both exp, obs, and ref + ## Insert memb_dim in obs + if (!is.null(memb_dim)) { + if (!memb_dim %in% names(dim(obs))) { + obs <- InsertDim(obs, posdim = 2, lendim = 1, name = memb_dim) + } + } + ## Insert dat_dim if (is.null(dat_dim)) { - nexp <- 1 - nobs <- 1 + dim(exp) <- c(dim(exp), dat = nexp) + dim(obs) <- c(dim(obs), dat = nobs) + } + if (is.null(dat_dim) || (!is.null(dat_dim) && !dat_dim %in% names(dim(ref)))) { nref <- 1 - dim(obs) <- c(dim(obs), nobs = nobs) - dim(exp) <- c(dim(exp), nexp = nexp) - dim(ref) <- c(dim(ref), nexp = nref) + dim(ref) <- c(dim(ref), dat = nef) } else { - nexp <- as.numeric(dim(exp)[dat_dim]) - nobs <- as.numeric(dim(obs)[dat_dim]) - nref <- as.numeric(dim(ref)[dat_dim]) - if (is.na(nref)) { - nref<-1 - dim(ref) <- c(dim(ref), nref = nref) - } + nref <- as.numeric(dim(ref)[dat_dim]) # should be the same as nexp } - rps_exp <- array(NaN,dim = c(dim(exp)[time_dim], nexp = nexp, nobs = nobs)) - rps_ref <- array(NaN,dim = c(dim(exp)[time_dim], nexp = nexp, nobs = nobs)) + + # Find good values then calculate RPS + rps_exp <- array(NA, dim = c(dim(exp)[time_dim], nexp = nexp, nobs = nobs)) + rps_ref <- array(NA, dim = c(dim(exp)[time_dim], nexp = nexp, nobs = nobs)) for (i in 1:nexp) { for (j in 1:nobs) { for (k in 1:nref) { - if (nref != 1 & k!=i) { #nref is allowed to be either 1 or equal to nexp - next - } - exp_data <- exp[ , , i] - obs_data <- obs[ , , j] - ref_data <- ref[ , , k] + exp_data <- exp[, , i] + obs_data <- obs[, , j] + ref_data <- ref[, , k] exp_mean <- rowMeans(exp_data) obs_mean <- rowMeans(obs_data) ref_mean <- rowMeans(ref_data) good_values <- !is.na(exp_mean) & !is.na(obs_mean) & !is.na(ref_mean) dum <- match(indices_for_clim, which(good_values)) good_indices_for_clim <- dum[!is.na(dum)] + if (f_NAs <= sum(good_values) / length(good_values)) { rps_exp[good_values,i,j] <- .RPS(exp = exp[good_values,,i], obs = obs[good_values,,j], time_dim = time_dim, memb_dim = memb_dim, @@ -452,19 +463,13 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', if (is.null(dat_dim)) { dim(rps_ref) <- dim(rps_exp) <- dim(exp)[time_dim] } - } else if (is.null(ref)) { + + } else { # ref is NULL rps_exp <- .RPS(exp = exp, obs = obs, time_dim = time_dim, memb_dim = memb_dim, cat_dim = cat_dim, dat_dim = dat_dim, prob_thresholds = prob_thresholds, indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_exp, cross.val = cross.val, na.rm = na.rm) - if (is.null(dat_dim)) { - nexp <- 1 - nobs <- 1 - } else { - nexp <- as.numeric(dim(exp)[dat_dim]) - nobs <- as.numeric(dim(obs)[dat_dim]) - } # RPS of the reference forecast -- GitLab From 778c376967d5716bc2a95b77407138d37883bc47 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 7 Sep 2023 17:21:33 +0200 Subject: [PATCH 52/64] Clean code, create unit tests for na.rm, update doc --- R/RPSS.R | 149 ++++++++++++++----------------------- man/RPSS.Rd | 22 +++--- tests/testthat/test-RPSS.R | 68 +++++++++++++++++ 3 files changed, 135 insertions(+), 104 deletions(-) diff --git a/R/RPSS.R b/R/RPSS.R index 9f41988..7e2b3ac 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -16,7 +16,9 @@ #'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 #'examined before the calculation. If the ratio is higher than the threshold -#'(assigned by parameter \code{na.rm}), NA will be returned directly. +#'(assigned by parameter \code{na.rm}), NA will be returned directly. NAs are +#'counted by per-pair method, which means that only the time steps that all the +#'datasets have values count as non-NA values. #' #'@param exp A named numerical array of either the forecast with at least time #' and member dimensions, or the probabilities with at least time and category @@ -376,7 +378,6 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', 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) { - #--- if memb_dim: # exp: [sdate, memb, (dat)] # obs: [sdate, (memb), (dat)] @@ -413,14 +414,16 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', obs <- InsertDim(obs, posdim = 2, lendim = 1, name = memb_dim) } } - ## Insert dat_dim + ## Insert dat_dim if (is.null(dat_dim)) { - dim(exp) <- c(dim(exp), dat = nexp) dim(obs) <- c(dim(obs), dat = nobs) + dim(exp) <- c(dim(exp), dat = nexp) + if (!is.null(weights_exp)) dim(weights_exp) <- c(dim(weights_exp), dat = nexp) } if (is.null(dat_dim) || (!is.null(dat_dim) && !dat_dim %in% names(dim(ref)))) { nref <- 1 - dim(ref) <- c(dim(ref), dat = nef) + dim(ref) <- c(dim(ref), dat = nref) + if (!is.null(weights_ref)) dim(weights_ref) <- c(dim(weights_ref), dat = nref) } else { nref <- as.numeric(dim(ref)[dat_dim]) # should be the same as nexp } @@ -431,9 +434,12 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', for (i in 1:nexp) { for (j in 1:nobs) { for (k in 1:nref) { - exp_data <- exp[, , i] - obs_data <- obs[, , j] - ref_data <- ref[, , k] + if (nref != 1 & k!=i) { # if nref is 1 or equal to nexp, calculate rps + next + } + exp_data <- exp[, , i, drop = F] + obs_data <- obs[, , j, drop = F] + ref_data <- ref[, , k, drop = F] exp_mean <- rowMeans(exp_data) obs_mean <- rowMeans(obs_data) ref_mean <- rowMeans(ref_data) @@ -442,27 +448,24 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', good_indices_for_clim <- dum[!is.na(dum)] if (f_NAs <= sum(good_values) / length(good_values)) { - rps_exp[good_values,i,j] <- .RPS(exp = exp[good_values,,i], obs = obs[good_values,,j], + rps_exp[good_values,i,j] <- .RPS(exp = exp[good_values, , i], obs = obs[good_values, , j], time_dim = time_dim, memb_dim = memb_dim, cat_dim = cat_dim, dat_dim = NULL, prob_thresholds = prob_thresholds, indices_for_clim = good_indices_for_clim, - Fair = Fair, weights = weights_exp, + Fair = Fair, weights = weights_exp[good_values, , i], cross.val = cross.val, na.rm = na.rm) - rps_ref[good_values,i,j] <- .RPS(exp = ref[good_values,,k], obs = obs[good_values,,j], + rps_ref[good_values,i,j] <- .RPS(exp = ref[good_values, , k], obs = obs[good_values, , j], time_dim = time_dim, memb_dim = memb_dim, cat_dim = cat_dim, dat_dim = NULL, prob_thresholds = prob_thresholds, indices_for_clim = good_indices_for_clim, - Fair = Fair, weights = weights_ref, + Fair = Fair, weights = weights_ref[good_values, , k], na.rm = na.rm, cross.val = cross.val) } } } } - if (is.null(dat_dim)) { - dim(rps_ref) <- dim(rps_exp) <- dim(exp)[time_dim] - } } else { # ref is NULL rps_exp <- .RPS(exp = exp, obs = obs, time_dim = time_dim, memb_dim = memb_dim, @@ -470,121 +473,78 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_exp, cross.val = cross.val, na.rm = na.rm) - - # RPS of the reference forecast - -# if (is.null(ref)) { ## using climatology as reference forecast + # RPS of the reference forecast if (!is.null(memb_dim)) { if (!memb_dim %in% names(dim(obs))) { obs <- InsertDim(obs, posdim = 2, lendim = 1, name = memb_dim) } } - rps_ref <- array(NaN,dim = c(dim(obs)[time_dim], nexp = nexp, nobs = nobs)) + rps_ref <- array(NA, dim = c(dim(obs)[time_dim], nexp = nexp, nobs = nobs)) if (is.null(dat_dim)) { dim(obs) <- c(dim(obs), nobs = nobs) - dim(exp) <- c(dim(exp), nexp = nexp) + dim(exp) <- c(dim(exp), nexp = nexp) dim(rps_exp) <- dim(rps_ref) } - # Use good values only - for (i in 1:nexp) { for (j in 1:nobs) { # Use good values only good_values <- !is.na(rps_exp[, i, j]) if (f_NAs <= sum(good_values) / length(good_values)) { obs_data <- obs[good_values, , j] - if (is.null(dim(obs_data))) dim(obs_data) <- c(length(obs_data),1) + if (is.null(dim(obs_data))) dim(obs_data) <- c(length(obs_data), 1) if (is.null(cat_dim)) { # calculate probs - # Subset indices_for_clim dum <- match(indices_for_clim, which(good_values)) good_indices_for_clim <- dum[!is.na(dum)] obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = good_indices_for_clim, prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) - # obs_probs: [bin, sdate] } else { obs_probs <- t(obs_data) } + # obs_probs: [bin, sdate] - clim_probs <- c(prob_thresholds[1], diff(prob_thresholds), - 1 - prob_thresholds[length(prob_thresholds)]) - clim_probs <- array(clim_probs, dim = dim(obs_probs)) - # clim_probs: [bin, sdate] - - # Calculate RPS for each time step - probs_clim_cumsum <- apply(clim_probs, 2, cumsum) - probs_obs_cumsum <- apply(obs_probs, 2, cumsum) - rps_ref[good_values, i, j] <- colSums((probs_clim_cumsum - probs_obs_cumsum)^2) - } else { - rps_ref[, i, j] <- NA + clim_probs <- c(prob_thresholds[1], diff(prob_thresholds), + 1 - prob_thresholds[length(prob_thresholds)]) + clim_probs <- array(clim_probs, dim = dim(obs_probs)) + # clim_probs: [bin, sdate] + + # Calculate RPS for each time step + probs_clim_cumsum <- apply(clim_probs, 2, cumsum) + probs_obs_cumsum <- apply(obs_probs, 2, cumsum) + rps_ref[good_values, i, j] <- colSums((probs_clim_cumsum - probs_obs_cumsum)^2) } - # if (Fair) { # FairRPS - # ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1)) [formula taken from SpecsVerification::EnsRps] - # R <- dim(exp)[2] #memb - # R_new <- Inf - # adjustment <- (-1) / (R - 1) * probs_clim_cumsum * (1 - probs_clim_cumsum) - # adjustment <- apply(adjustment, 2, sum) - # rps_ref <- rps_ref + adjustment - # } + # if (Fair) { # FairRPS + # ## adjustment <- rowSums(-1 * (1/R - 1/R.new) * ens.cum * (R - ens.cum)/R/(R - 1)) [formula taken from SpecsVerification::EnsRps] + # R <- dim(exp)[2] #memb + # R_new <- Inf + # adjustment <- (-1) / (R - 1) * probs_clim_cumsum * (1 - probs_clim_cumsum) + # adjustment <- apply(adjustment, 2, sum) + # rps_ref <- rps_ref + adjustment + # } } } + } - if (is.null(dat_dim)) { - dim(rps_ref) <- dim(rps_exp) <- dim(exp)[time_dim] - } - + if (is.null(dat_dim)) { + dim(rps_ref) <- dim(rps_exp) <- dim(exp)[time_dim] } -# else { # use "ref" as reference forecast -# if (!is.null(dat_dim) && (!dat_dim %in% names(dim(ref)))) { -# remove_dat_dim <- TRUE -# ref <- InsertDim(ref, posdim = 3, lendim = 1, name = dat_dim) -# if (!is.null(weights_ref)) { -# weights_ref <- InsertDim(weights_ref, posdim = 3, lendim = 1, name = dat_dim) -# } -# } else { -# remove_dat_dim <- FALSE -# } - -# rps_ref <- .RPS(exp = ref, obs = obs, time_dim = time_dim, memb_dim = memb_dim, -# cat_dim = cat_dim, dat_dim = dat_dim, prob_thresholds = prob_thresholds, -# indices_for_clim = indices_for_clim, Fair = Fair, weights = weights_ref, -# na.rm = na.rm, cross.val = cross.val) -# if (!is.null(dat_dim)) { -# if (isTRUE(remove_dat_dim)) { -# dim(rps_ref) <- dim(rps_ref)[-2] -# } -# } -# } #---------------------------------------------- # Calculate RPSS if (!is.null(dat_dim)) { - # rps_exp: [sdate, nexp, nobs] - # rps_ref: [sdate, (nexp), nobs] - rps_exp_mean <- MeanDims(rps_exp, time_dim, na.rm = TRUE) - rps_ref_mean <- MeanDims(rps_ref, time_dim, na.rm = TRUE) + # rps_exp and rps_ref: [sdate, nexp, nobs] + rps_exp_mean <- colMeans(rps_exp, na.rm = TRUE) + rps_ref_mean <- colMeans(rps_ref, na.rm = TRUE) rpss <- array(dim = c(nexp = nexp, nobs = nobs)) sign <- array(dim = c(nexp = nexp, nobs = nobs)) - if (length(dim(rps_ref_mean)) == 1) { # rps_ref: [sdate, nobs] - for (i in 1:nexp) { - for (j in 1:nobs) { - rpss[i, j] <- 1 - rps_exp_mean[i, j] / rps_ref_mean[j] - ind_nonNA <- !is.na(rps_exp[, i, j]) - 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, j])$sign - } - } - } - } else { # rps_ref: [sdate, nexp, nobs] + if (any(!is.na(rps_exp_mean))) { for (i in 1:nexp) { for (j in 1:nobs) { rpss[i, j] <- 1 - rps_exp_mean[i, j] / rps_ref_mean[i, j] @@ -598,22 +558,21 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', } } - } else { # dat_dim is NULL + # Turn NaN into NA + if (any(is.nan(rpss))) rpss[which(is.nan(rpss))] <- NA - # rps_exp and rps_ref: [sdate] - rpss <- 1 - mean(rps_exp, na.rm = TRUE) / mean(rps_ref, na.rm = TRUE) + } else { # dat_dim is NULL - # Significance ind_nonNA <- !is.na(rps_exp) if (!any(ind_nonNA)) { + rpss <- NA sign <- NA } 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 } } - + return(list(rpss = rpss, sign = sign)) } - - - diff --git a/man/RPSS.Rd b/man/RPSS.Rd index a9dd7d7..0cf7ba5 100644 --- a/man/RPSS.Rd +++ b/man/RPSS.Rd @@ -80,14 +80,14 @@ consistency between the weighted and unweighted methodologies is desired.} \item{weights_ref}{Same as 'weights_exp' but for the reference forecast.} -\item{cross.val}{A logical indicating whether to compute the thresholds between -probabilistics categories in cross-validation. -The default value is FALSE.} +\item{cross.val}{A logical indicating whether to compute the thresholds +between probabilistics categories in cross-validation. The default value is +FALSE.} -\item{na.rm}{A logical or numeric value between 0 and 1. If it is numeric, -it shows the lower limit for the fraction of the non-NA values. The function -returns NA, if the fraction of non-NA values in the provided data is less than -na.rm. Otherwise, RPSS will be calculated.} +\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.} @@ -110,7 +110,7 @@ based on the Ranked Probability Score (RPS; Wilks, 2011). It can be used to assess whether a forecast presents an improvement or worsening with respect to a reference forecast. The RPSS ranges between minus infinite and 1. If the RPSS is positive, it indicates that the forecast has higher skill than the -reference forecast, while a negative value means that it has a lower skill. +reference forecast, while a negative value means that it has a lower skill.\cr 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 @@ -119,7 +119,11 @@ based on a Random Walk test at the 95% 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. +computed for each pair of exp and obs data. The NA ratio of data will be +examined before the calculation. If the ratio is higher than the threshold +(assigned by parameter \code{na.rm}), NA will be returned directly. NAs are +counted by per-pair method, which means that only the time steps that all the +datasets have values count as non-NA values. } \examples{ set.seed(1) diff --git a/tests/testthat/test-RPSS.R b/tests/testthat/test-RPSS.R index f054325..81c5a84 100644 --- a/tests/testthat/test-RPSS.R +++ b/tests/testthat/test-RPSS.R @@ -15,6 +15,11 @@ exp1_2 <- GetProbs(exp1, memb_dim = 'member') obs1_2 <- GetProbs(obs1, memb_dim = NULL) ref1_2 <- GetProbs(ref1, memb_dim = 'member') +# dat1_3: NAs +exp1_3 <- exp1; exp1_3[1, 2, 1] <- NA +obs1_3 <- obs1; obs1_3[2, 1] <- NA +ref1_3 <- ref1; ref1_3[1, 3, 1] <- NA + # dat2 set.seed(1) exp2 <- array(rnorm(20), dim = c(member = 2, sdate = 10)) @@ -49,6 +54,12 @@ weights_exp4 <- array(abs(rnorm(60)), dim = c(member = 2, sdate = 10, dataset = set.seed(5) weights_ref4 <- array(abs(rnorm(20)), dim = c(member = 2, sdate = 10)) +# dat4_2: NAs +exp4_2 <- exp4; exp4_2[1, 2, 1, 1] <- NA +obs4_2 <- obs4; obs4_2[1, 1:4, 1, 1] <- NA +ref4_2 <- ref4 + + ############################################## test_that("1. Input checks", { # exp and obs (1) @@ -268,6 +279,29 @@ test_that("2. Output checks: dat1", { RPSS(exp1_2, obs1_2, ref1_2, memb_dim = NULL, cat_dim = 'bin') ) + # dat1_3 + expect_equal( + as.vector(RPSS(exp1_3, obs1_3)$rpss), + c(NA, -0.05263158), + tolerance = 0.0001 + ) + expect_equal( + as.vector(RPSS(exp1_3, obs1_3)$sign), + c(NA, FALSE) + ) + expect_equal( + as.vector(RPSS(exp1_3, obs1_3, na.rm = T)$rpss), + c(0.16666667, -0.05263158), + tolerance = 0.0001 + ) + expect_equal( + as.vector(RPSS(exp1_3, obs1_3, na.rm = T)$sign), + c(F, F) + ) + expect_equal( + as.vector(RPSS(exp1_3, obs1_3, na.rm = 0.9)$sign), + c(F, F) + ) }) @@ -434,4 +468,38 @@ test_that("5. Output checks: dat4", { RPSS(exp3, obs3, weights_exp = weights3, dat_dim = 'dataset')$rpss ) + # dat4_2: NAs + expect_equal( + as.vector(RPSS(exp4_2, obs4_2, ref4_2, dat_dim = 'dataset')$rpss[, , 1]), + c(NA, NA, NA, NA, c(-0.3076923, 0.1538462)), + tolerance = 0.0001 + ) + expect_equal( + as.vector(RPSS(exp4_2, obs4_2, ref4_2, dat_dim = 'dataset')$rpss[, , 2]), + c(0, 0.1333333, -0.4, 0.1176471, 0, 0.3529412), + tolerance = 0.0001 + ) + expect_equal( + which(is.na(RPSS(exp4_2, obs4_2, ref4_2, dat_dim = 'dataset')$rpss)), + which(is.na(RPSS(exp4_2, obs4_2, ref4_2, dat_dim = 'dataset')$sign)) + ) + expect_equal( + as.vector(RPSS(exp4_2, obs4_2, ref4_2, dat_dim = 'dataset', na.rm = 0.9)$rpss[, , 1]), + c(NA, NA, NA, -0.3333333, -0.3076923, 0.1538462), + tolerance = 0.0001 + ) + expect_equal( + which(is.na(RPSS(exp4_2, obs4_2, ref4_2, dat_dim = 'dataset', na.rm = 0.9)$rpss)), + which(is.na(RPSS(exp4_2, obs4_2, ref4_2, dat_dim = 'dataset', na.rm = 0.9)$sign)) + ) + expect_equal( + as.vector(RPSS(exp4_2, obs4_2, ref4_2, dat_dim = 'dataset', na.rm = 0.6)$rpss[, , 1]), + c(0.25, 0.1666667, -0.1666667, -0.3333333, -0.3076923, 0.1538462), + tolerance = 0.0001 + ) + expect_equal( + which(is.na(RPSS(exp4_2, obs4_2, ref4_2, dat_dim = 'dataset', na.rm = 0.6)$rpss)), + which(is.na(RPSS(exp4_2, obs4_2, ref4_2, dat_dim = 'dataset', na.rm = 0.6)$sign)) + ) + }) -- GitLab From 33b82398e59b2649e370a81cc017faae70965577 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Fri, 8 Sep 2023 14:36:25 +0200 Subject: [PATCH 53/64] fixed indices_for_clim --- R/GetProbs.R | 4 +++- R/ROCSS.R | 3 +++ R/RPS.R | 4 +++- R/RPSS.R | 1 + 4 files changed, 10 insertions(+), 2 deletions(-) diff --git a/R/GetProbs.R b/R/GetProbs.R index 59304b4..fed15ca 100644 --- a/R/GetProbs.R +++ b/R/GetProbs.R @@ -167,7 +167,9 @@ GetProbs <- function(data, time_dim = 'sdate', memb_dim = 'member', indices_for_ ## if data is exp: [sdate, memb] ## if data is obs: [sdate, (memb)] # weights: [sdate, (memb)], same as data - + + if (is.null(indices_for_quantiles)){indices_for_quantiles <- 1:dim(data)[time_dim]} + # Add dim [memb = 1] to data if it doesn't have memb_dim if (length(dim(data)) == 1) { dim(data) <- c(dim(data), 1) diff --git a/R/ROCSS.R b/R/ROCSS.R index 2ca0782..022df85 100644 --- a/R/ROCSS.R +++ b/R/ROCSS.R @@ -325,9 +325,11 @@ ROCSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', ## if exp: [sdate, memb] ## if obs: [sdate, (memb)] exp_probs <- .GetProbs(data = ClimProjDiags::Subset(exp, dat_dim, exp_i, drop = 'selected'), + time_dim = time_dim, memb_dim = memb_dim, indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds, cross.val = cross.val) obs_probs <- .GetProbs(data = ClimProjDiags::Subset(obs, dat_dim, obs_i, drop = 'selected'), + time_dim = time_dim, memb_dim = memb_dim, indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds, cross.val = cross.val) ## exp_probs and obs_probs: [bin, sdate] @@ -343,6 +345,7 @@ ROCSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', if (!is.null(ref)) { if (is.null(cat_dim)) { # calculate probs ref_probs <- .GetProbs(ClimProjDiags::Subset(ref, dat_dim, exp_i, drop = 'selected'), + time_dim = time_dim, memb_dim = memb_dim, indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds, cross.val = cross.val) } else { diff --git a/R/RPS.R b/R/RPS.R index c5ff5ba..e0a006b 100644 --- a/R/RPS.R +++ b/R/RPS.R @@ -254,7 +254,7 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL #--- if cat_dim: # exp: [sdate, bin, (dat)] # obs: [sdate, bin, (dat)] - + # Adjust dimensions to be [sdate, memb, dat] for both exp and obs if (!is.null(memb_dim)) { if (!memb_dim %in% names(dim(obs))) { @@ -293,9 +293,11 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL } exp_probs <- .GetProbs(data = exp_data, indices_for_quantiles = indices_for_clim, + time_dim = time_dim, memb_dim = memb_dim, prob_thresholds = prob_thresholds, weights = weights_data, cross.val = cross.val) # exp_probs: [bin, sdate] obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, + time_dim = time_dim, memb_dim = memb_dim, prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) # obs_probs: [bin, sdate] diff --git a/R/RPSS.R b/R/RPSS.R index 6299eb8..f71a3d0 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -405,6 +405,7 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', obs_data <- obs[ , , j] if (is.null(dim(obs_data))) dim(obs_data) <- c(dim(obs)[1:2]) obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, + time_dim = time_dim, memb_dim = memb_dim, prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) # obs_probs: [bin, sdate] } else { -- GitLab From fd87f5bfb4fc15f695043c11dad18a6abbbe8c22 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Tue, 12 Sep 2023 11:04:16 +0200 Subject: [PATCH 54/64] Revert "fixed indices_for_clim" This reverts commit 33b82398e59b2649e370a81cc017faae70965577. --- R/GetProbs.R | 4 +--- R/ROCSS.R | 3 --- R/RPS.R | 4 +--- R/RPSS.R | 1 - 4 files changed, 2 insertions(+), 10 deletions(-) diff --git a/R/GetProbs.R b/R/GetProbs.R index fed15ca..59304b4 100644 --- a/R/GetProbs.R +++ b/R/GetProbs.R @@ -167,9 +167,7 @@ GetProbs <- function(data, time_dim = 'sdate', memb_dim = 'member', indices_for_ ## if data is exp: [sdate, memb] ## if data is obs: [sdate, (memb)] # weights: [sdate, (memb)], same as data - - if (is.null(indices_for_quantiles)){indices_for_quantiles <- 1:dim(data)[time_dim]} - + # Add dim [memb = 1] to data if it doesn't have memb_dim if (length(dim(data)) == 1) { dim(data) <- c(dim(data), 1) diff --git a/R/ROCSS.R b/R/ROCSS.R index 022df85..2ca0782 100644 --- a/R/ROCSS.R +++ b/R/ROCSS.R @@ -325,11 +325,9 @@ ROCSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', ## if exp: [sdate, memb] ## if obs: [sdate, (memb)] exp_probs <- .GetProbs(data = ClimProjDiags::Subset(exp, dat_dim, exp_i, drop = 'selected'), - time_dim = time_dim, memb_dim = memb_dim, indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds, cross.val = cross.val) obs_probs <- .GetProbs(data = ClimProjDiags::Subset(obs, dat_dim, obs_i, drop = 'selected'), - time_dim = time_dim, memb_dim = memb_dim, indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds, cross.val = cross.val) ## exp_probs and obs_probs: [bin, sdate] @@ -345,7 +343,6 @@ ROCSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', if (!is.null(ref)) { if (is.null(cat_dim)) { # calculate probs ref_probs <- .GetProbs(ClimProjDiags::Subset(ref, dat_dim, exp_i, drop = 'selected'), - time_dim = time_dim, memb_dim = memb_dim, indices_for_quantiles = indices_for_clim, prob_thresholds = prob_thresholds, cross.val = cross.val) } else { diff --git a/R/RPS.R b/R/RPS.R index e0a006b..c5ff5ba 100644 --- a/R/RPS.R +++ b/R/RPS.R @@ -254,7 +254,7 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL #--- if cat_dim: # exp: [sdate, bin, (dat)] # obs: [sdate, bin, (dat)] - + # Adjust dimensions to be [sdate, memb, dat] for both exp and obs if (!is.null(memb_dim)) { if (!memb_dim %in% names(dim(obs))) { @@ -293,11 +293,9 @@ RPS <- function(exp, obs, time_dim = 'sdate', memb_dim = 'member', cat_dim = NUL } exp_probs <- .GetProbs(data = exp_data, indices_for_quantiles = indices_for_clim, - time_dim = time_dim, memb_dim = memb_dim, prob_thresholds = prob_thresholds, weights = weights_data, cross.val = cross.val) # exp_probs: [bin, sdate] obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, - time_dim = time_dim, memb_dim = memb_dim, prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) # obs_probs: [bin, sdate] diff --git a/R/RPSS.R b/R/RPSS.R index f71a3d0..6299eb8 100644 --- a/R/RPSS.R +++ b/R/RPSS.R @@ -405,7 +405,6 @@ RPSS <- function(exp, obs, ref = NULL, time_dim = 'sdate', memb_dim = 'member', obs_data <- obs[ , , j] if (is.null(dim(obs_data))) dim(obs_data) <- c(dim(obs)[1:2]) obs_probs <- .GetProbs(data = obs_data, indices_for_quantiles = indices_for_clim, - time_dim = time_dim, memb_dim = memb_dim, prob_thresholds = prob_thresholds, weights = NULL, cross.val = cross.val) # obs_probs: [bin, sdate] } else { -- GitLab From a39d1518d36504719a320c90cf2fdc648f804302 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Tue, 12 Sep 2023 11:07:19 +0200 Subject: [PATCH 55/64] removed default value for indices_for_quantiles; also removed time_dim and memb_dim as arguments (they were not used) --- R/GetProbs.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/R/GetProbs.R b/R/GetProbs.R index 59304b4..9960c53 100644 --- a/R/GetProbs.R +++ b/R/GetProbs.R @@ -151,8 +151,6 @@ GetProbs <- function(data, time_dim = 'sdate', memb_dim = 'member', indices_for_ output_dims = c("bin", time_dim), fun = .GetProbs, # dat_dim = dat_dim, - time_dim = time_dim, - memb_dim = memb_dim, prob_thresholds = prob_thresholds, indices_for_quantiles = indices_for_quantiles, weights = weights, cross.val = cross.val, ncores = ncores)$output1 @@ -160,7 +158,7 @@ GetProbs <- function(data, time_dim = 'sdate', memb_dim = 'member', indices_for_ return(res) } -.GetProbs <- function(data, time_dim = 'sdate', memb_dim = 'member', indices_for_quantiles = NULL, +.GetProbs <- function(data, indices_for_quantiles, prob_thresholds = c(1/3, 2/3), weights = NULL, cross.val = FALSE) { # .GetProbs() is used in RPS, RPSS, ROCSS # data -- GitLab From 336821b81657157fa7a7160eb497d976e2961550 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 20 Sep 2023 13:42:32 +0200 Subject: [PATCH 56/64] 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 From 232b75080f405617e48887e731d4279c7e0edaeb Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 20 Sep 2023 18:00:12 +0200 Subject: [PATCH 57/64] Allow obs has no memb_dim; fix dat_dim bug when bootstrap is used --- R/ACC.R | 73 +++++++++++++++-------- tests/testthat/test-ACC.R | 120 ++++++++++++++++++++++++++++++++++++-- 2 files changed, 163 insertions(+), 30 deletions(-) diff --git a/R/ACC.R b/R/ACC.R index fcd1735..d5f2cb6 100644 --- a/R/ACC.R +++ b/R/ACC.R @@ -160,17 +160,13 @@ ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } - if(!all(names(dim(exp)) %in% names(dim(obs))) | - !all(names(dim(obs)) %in% names(dim(exp)))) { - stop("Parameter 'exp' and 'obs' must have same dimension names.") - } ## dat_dim if (!is.null(dat_dim)) { if (!is.character(dat_dim) | length(dat_dim) > 1) { stop("Parameter 'dat_dim' must be a character string or NULL.") } if (!dat_dim %in% names(dim(exp)) | !dat_dim %in% names(dim(obs))) { - stop("Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension.", + stop("Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension. ", "Set it as NULL if there is no dataset dimension.") } } @@ -208,10 +204,19 @@ ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', if (!is.character(memb_dim) | length(memb_dim) > 1) { stop("Parameter 'memb_dim' must be a character string.") } - if (!memb_dim %in% names(dim(exp)) | !memb_dim %in% names(dim(obs))) { - stop("Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension.", + if (!memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { + stop("Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension. ", "Set it as NULL if there is no member dimension.") } + # Add [member = 1] + if (memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { + dim(obs) <- c(dim(obs), 1) + names(dim(obs))[length(dim(obs))] <- memb_dim + } + if (!memb_dim %in% names(dim(exp)) & memb_dim %in% names(dim(obs))) { + dim(exp) <- c(dim(exp), 1) + names(dim(exp))[length(dim(exp))] <- memb_dim + } } ## lat if (is.null(lat)) { @@ -275,6 +280,9 @@ ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', ## exp and obs (2) name_exp <- sort(names(dim(exp))) name_obs <- sort(names(dim(obs))) + if(!all(name_exp %in% name_obs) | !all(name_obs %in% name_exp)) { + stop("Parameter 'exp' and 'obs' must have same dimension names.") + } if (!is.null(dat_dim)) { name_exp <- name_exp[-which(name_exp == dat_dim)] name_obs <- name_obs[-which(name_obs == dat_dim)] @@ -586,9 +594,12 @@ ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', nobs <- 1 dim(exp) <- c(dim(exp)[1], dat = 1, dim(exp)[-1]) dim(obs) <- c(dim(obs)[1], dat = 1, dim(obs)[-1]) + dat_dim <- 'dat' + remove_dat_dim <- TRUE } else { nexp <- as.numeric(dim(exp)[dat_dim]) nobs <- as.numeric(dim(obs)[dat_dim]) + remove_dat_dim <- FALSE } nmembexp <- as.numeric(dim(exp)[1]) @@ -650,26 +661,38 @@ ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', #calculate the confidence interval if (is.null(avg_dim)) { - acc_conf.upper <- apply(acc_draw, c(1, 2), - function (x) { - quantile(x, 1 - alpha / 2, na.rm = TRUE)}) - acc_conf.lower <- apply(acc_draw, c(1, 2), - function (x) { - quantile(x, alpha / 2, na.rm = TRUE)}) + acc_conf.upper <- apply(acc_draw, c(1, 2), + function (x) { + quantile(x, 1 - alpha / 2, na.rm = TRUE)}) + acc_conf.lower <- apply(acc_draw, c(1, 2), + function (x) { + quantile(x, alpha / 2, na.rm = TRUE)}) } else { - acc_conf.upper <- apply(acc_draw, c(1, 2, 3), - function (x) { - quantile(x, 1 - alpha / 2, na.rm = TRUE)}) - acc_conf.lower <- apply(acc_draw, c(1, 2, 3), - function (x) { - quantile(x, alpha / 2, na.rm = TRUE)}) - macc_conf.upper <- apply(macc_draw, c(1, 2), - function (x) { - quantile(x, 1 - alpha / 2, na.rm = TRUE)}) - macc_conf.lower <- apply(macc_draw, c(1, 2), - function (x) { - quantile(x, alpha / 2, na.rm = TRUE)}) + acc_conf.upper <- apply(acc_draw, c(1, 2, 3), + function (x) { + quantile(x, 1 - alpha / 2, na.rm = TRUE)}) + acc_conf.lower <- apply(acc_draw, c(1, 2, 3), + function (x) { + quantile(x, alpha / 2, na.rm = TRUE)}) + macc_conf.upper <- apply(macc_draw, c(1, 2), + function (x) { + quantile(x, 1 - alpha / 2, na.rm = TRUE)}) + macc_conf.lower <- apply(macc_draw, c(1, 2), + function (x) { + quantile(x, alpha / 2, na.rm = TRUE)}) + } + + if (remove_dat_dim) { + if (is.null(avg_dim)) { + dim(acc_conf.lower) <- NULL + dim(acc_conf.upper) <- NULL + } else { + dim(acc_conf.lower) <- dim(acc_conf.lower)[-c(1, 2)] + dim(acc_conf.upper) <- dim(acc_conf.upper)[-c(1, 2)] + dim(macc_conf.lower) <- NULL + dim(macc_conf.upper) <- NULL + } } # Return output diff --git a/tests/testthat/test-ACC.R b/tests/testthat/test-ACC.R index c9e986d..b34ed21 100644 --- a/tests/testthat/test-ACC.R +++ b/tests/testthat/test-ACC.R @@ -11,6 +11,10 @@ ftime = 1, lat = 2, lon = 3)) lat1 <- c(30, 35) lon1 <- c(0, 5, 10) + + set.seed(2) + obs1_2 <- array(rnorm(30), dim = c(sdate = 5, ftime = 1, lat = 2, lon = 3)) + # dat2 set.seed(1) exp2 <- array(rnorm(60), dim = c(dataset = 2, sdate = 5, @@ -24,6 +28,13 @@ lat2 <- c(30, 35) lon2 <- c(0, 5, 10) + # dat3 + set.seed(1) + exp3 <- array(rnorm(72), dim = c(dat = 2, member = 3, sdate = 3, lat = 2, lon = 2)) + set.seed(2) + obs3 <- array(rnorm(12), dim = c(dat = 1, sdate = 3, lat = 2, lon = 2)) + lat3 <- c(0, 10) + ############################################## test_that("1. Input checks", { # exp and obs (1) @@ -44,10 +55,6 @@ test_that("1. Input checks", { ACC(array(1:10, dim = c(2, 5)), array(1:4, dim = c(2, 2))), "Parameter 'exp' and 'obs' must have dimension names." ) - expect_error( - ACC(array(1:10, dim = c(a = 2, c = 5)), array(1:4, dim = c(a = 2, b = 2))), - "Parameter 'exp' and 'obs' must have same dimension name" - ) # dat_dim expect_error( ACC(exp1, obs1, dat_dim = 1), @@ -96,7 +103,7 @@ test_that("1. Input checks", { ) expect_error( ACC(exp1, obs1, memb_dim = 'memb'), - "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." + "Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension. Set it as NULL if there is no member dimension." ) # lat expect_error( @@ -217,6 +224,46 @@ test_that("2. Output checks: dat1", { tolerance = 0.00001 ) + # bootstrap + expect_equal( + names(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap')), + c('acc', 'acc_conf.lower', 'acc_conf.upper', 'macc', 'macc_conf.lower', 'macc_conf.upper') + ) + expect_equal( + dim(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap')$acc), + c(sdate = 5, ftime = 1) + ) + expect_equal( + dim(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap')$acc_conf.lower), + c(sdate = 5, ftime = 1) + ) + expect_equal( + dim(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap')$macc_conf.lower), + c(ftime = 1) + ) + expect_equal( + dim(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap')$macc), + c(ftime = 1) + ) + # boostrap, avg_time is NULL + expect_equal( + names(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap', avg_dim = NULL)), + c('acc', 'acc_conf.lower', 'acc_conf.upper', 'macc', 'macc_conf.lower', 'macc_conf.upper') + ) + expect_equal( + dim(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap', avg_dim = NULL)$acc), + c(sdate = 5, ftime = 1) + ) + expect_equal( + dim(ACC(exp1, obs1, lat = lat1, lon = lon1, conftype = 'bootstrap', avg_dim = NULL)$acc_conf.lower), + c(sdate = 5, ftime = 1) + ) + + # obs1_2, no memb_dim + expect_equal( + ACC(exp1, obs1, lat = lat1), + ACC(exp1, obs1_2, lat = lat1) + ) }) @@ -240,3 +287,66 @@ expect_equal( ) }) + + +############################################## + +test_that("4. Output checks: dat3", { + +expect_equal( +names(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat")), +c('acc', 'macc', 'conf.lower', 'conf.upper', 'p.val') +) +expect_equal( +names(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat", avg_dim = NULL)), +c('acc', 'conf.lower', 'conf.upper', 'p.val') +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat")$acc), +c(nexp = 2, nobs = 1, sdate = 3) +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat", avg_dim = NULL)$acc), +c(nexp = 2, nobs = 1, sdate = 3) +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat")$p.val), +c(nexp = 2, nobs = 1, sdate = 3) +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat")$conf.upper), +c(nexp = 2, nobs = 1, sdate = 3) +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat")$macc), +c(nexp = 2, nobs = 1) +) + +expect_equal( +ACC(exp3, array(obs3, c(member = 1, dim(obs3))), lat = lat3, memb_dim = "member", dat_dim = "dat"), +ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat") +) + +# bootstrap +expect_equal( +names(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat", conftype = 'bootstrap')), +c('acc', 'acc_conf.lower', 'acc_conf.upper', 'macc', 'macc_conf.lower', 'macc_conf.upper') +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat", conftype = 'bootstrap')$acc), +c(nexp = 2, nobs = 1, sdate = 3) +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat", conftype = 'bootstrap')$acc_conf.lower), +c(nexp = 2, nobs = 1, sdate = 3) +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat", conftype = 'bootstrap')$macc), +c(nexp = 2, nobs = 1) +) +expect_equal( +dim(ACC(exp3, obs3, lat = lat3, memb_dim = "member", dat_dim = "dat", conftype = 'bootstrap')$macc_conf.upper), +c(nexp = 2, nobs = 1) +) + +}) -- GitLab From 0f12505a05d64d033213ba5a4433ee9b1d8fa246 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 20 Sep 2023 18:01:21 +0200 Subject: [PATCH 58/64] Remove deprecated param 'space_dim' --- R/ACC.R | 12 +----------- man/ACC.Rd | 6 ------ 2 files changed, 1 insertion(+), 17 deletions(-) diff --git a/R/ACC.R b/R/ACC.R index d5f2cb6..d921ce8 100644 --- a/R/ACC.R +++ b/R/ACC.R @@ -23,10 +23,6 @@ #'@param lon_dim A character string indicating the name of the longitude #' dimension of 'exp' and 'obs' along which ACC is computed. The default value #' is 'lon'. -#'@param space_dim A character string vector of 2 indicating the name of the -#' latitude and longitude dimensions (in order) along which ACC is computed. -#' The default value is c('lat', 'lon'). This argument has been deprecated. -#' Use 'lat_dim' and 'lon_dim' instead. #'@param avg_dim A character string indicating the name of the dimension to be #' averaged, which is usually the time dimension. If no need to calculate mean #' ACC, set as NULL. The default value is 'sdate'. @@ -139,7 +135,7 @@ #'@importFrom ClimProjDiags Subset #'@export ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', - space_dim = c('lat', 'lon'), avg_dim = 'sdate', memb_dim = 'member', + avg_dim = 'sdate', memb_dim = 'member', lat = NULL, lon = NULL, lonlatbox = NULL, alpha = 0.05, pval = TRUE, sign = FALSE, conf = TRUE, conftype = "parametric", ncores = NULL) { @@ -170,12 +166,6 @@ ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', "Set it as NULL if there is no dataset dimension.") } } - ## space_dim (deprecated) - if (!missing("space_dim")) { - .warning("Parameter 'space_dim' is deprecated. Use 'lat_dim' and 'lon_dim' instead.") - lat_dim <- space_dim[1] - lon_dim <- space_dim[2] - } ## lat_dim if (!is.character(lat_dim) | length(lat_dim) != 1) { stop("Parameter 'lat_dim' must be a character string.") diff --git a/man/ACC.Rd b/man/ACC.Rd index 840f01f..4a4a5f2 100644 --- a/man/ACC.Rd +++ b/man/ACC.Rd @@ -10,7 +10,6 @@ ACC( dat_dim = NULL, lat_dim = "lat", lon_dim = "lon", - space_dim = c("lat", "lon"), avg_dim = "sdate", memb_dim = "member", lat = NULL, @@ -43,11 +42,6 @@ is 'lat'.} dimension of 'exp' and 'obs' along which ACC is computed. The default value is 'lon'.} -\item{space_dim}{A character string vector of 2 indicating the name of the -latitude and longitude dimensions (in order) along which ACC is computed. -The default value is c('lat', 'lon'). This argument has been deprecated. -Use 'lat_dim' and 'lon_dim' instead.} - \item{avg_dim}{A character string indicating the name of the dimension to be averaged, which is usually the time dimension. If no need to calculate mean ACC, set as NULL. The default value is 'sdate'.} -- GitLab From 658f594188920914f3d60fd98b750d1c10d7b4a1 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 21 Sep 2023 16:27:10 +0200 Subject: [PATCH 59/64] Allow obs to not have memb_dim --- R/Corr.R | 18 ++++++++----- R/RMS.R | 2 +- R/RatioPredictableComponents.R | 20 +++++++------- R/RatioSDRMS.R | 22 ++++++++++------ man/RMS.Rd | 2 +- man/RatioPredictableComponents.Rd | 10 +++---- tests/testthat/test-ACC.R | 5 ---- tests/testthat/test-Corr.R | 26 +++++++++++++++---- .../test-RatioPredictableComponents.R | 4 +-- tests/testthat/test-RatioSDRMS.R | 12 +++++---- 10 files changed, 72 insertions(+), 49 deletions(-) diff --git a/R/Corr.R b/R/Corr.R index d00f755..fe03041 100644 --- a/R/Corr.R +++ b/R/Corr.R @@ -125,10 +125,6 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } - if(!all(names(dim(exp)) %in% names(dim(obs))) | - !all(names(dim(obs)) %in% names(dim(exp)))) { - stop("Parameter 'exp' and 'obs' must have same dimension name") - } ## time_dim if (!is.character(time_dim) | length(time_dim) > 1) { stop("Parameter 'time_dim' must be a character string.") @@ -175,8 +171,17 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, if (!is.character(memb_dim) | length(memb_dim) > 1) { stop("Parameter 'memb_dim' must be a character string.") } - if (!memb_dim %in% names(dim(exp)) | !memb_dim %in% names(dim(obs))) { - stop("Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension.") + if (!memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { + stop("Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension. Set it as NULL if there is no member dimension.") + } + # Add [member = 1] + if (memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { + dim(obs) <- c(dim(obs), 1) + names(dim(obs))[length(dim(obs))] <- memb_dim + } + if (!memb_dim %in% names(dim(exp)) & memb_dim %in% names(dim(obs))) { + dim(exp) <- c(dim(exp), 1) + names(dim(exp))[length(dim(exp))] <- memb_dim } } ## memb @@ -250,7 +255,6 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, obs[which(outrows)] <- NA rm(obs_sub, outrows) } - if (!is.null(memb_dim)) { if (!memb) { #ensemble mean exp <- MeanDims(exp, memb_dim, na.rm = TRUE) diff --git a/R/RMS.R b/R/RMS.R index 4e6bfeb..b603c37 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -71,7 +71,7 @@ #' #'exp2 <- array(rnorm(20), dim = c(sdate = 5, member = 4)) #'obs2 <- array(rnorm(10), dim = c(sdate = 5, member = 2)) -#'res2 <- RMS(exp3, obs3, memb_dim = 'member') +#'res2 <- RMS(exp2, obs2, memb_dim = 'member') #' #'@import multiApply #'@importFrom ClimProjDiags Subset diff --git a/R/RatioPredictableComponents.R b/R/RatioPredictableComponents.R index 163d18f..3d5cae5 100644 --- a/R/RatioPredictableComponents.R +++ b/R/RatioPredictableComponents.R @@ -2,13 +2,13 @@ #' #'This function computes the ratio of predictable components (RPC; Eade et al., 2014). #' -#'@param exp A numerical array with, at least, 'time_dim' and 'member_dim' +#'@param exp A numerical array with, at least, 'time_dim' and 'memb_dim' #' dimensions. #'@param obs A numerical array with the same dimensions than 'exp' except the -#' 'member_dim' dimension. +#' 'memb_dim' dimension. #'@param time_dim A character string indicating the name of the time dimension. #' The default value is 'year'. -#'@param member_dim A character string indicating the name of the member +#'@param memb_dim A character string indicating the name of the member #' dimension. The default value is 'member'. #'@param na.rm A logical value indicating whether to remove NA values during #' the computation. The default value is FALSE. @@ -16,7 +16,7 @@ #' computation. The default value is NULL. #' #'@return An array of the ratio of the predictable components. it has the same -#' dimensions as 'exp' except 'time_dim' and 'member_dim' dimensions. +#' dimensions as 'exp' except 'time_dim' and 'memb_dim' dimensions. #' #'@examples #'exp <- array(data = runif(600), dim = c(year = 15, member = 10, lat = 2, lon = 2)) @@ -25,7 +25,7 @@ #' #'@import multiApply stats #'@export -RatioPredictableComponents <- function(exp, obs, time_dim = 'year', member_dim = 'member', na.rm = FALSE, ncores = NULL) { +RatioPredictableComponents <- function(exp, obs, time_dim = 'year', memb_dim = 'member', na.rm = FALSE, ncores = NULL) { ## Checkings if (is.null(exp)) { @@ -43,14 +43,14 @@ RatioPredictableComponents <- function(exp, obs, time_dim = 'year', member_dim = if (!(is.character(time_dim) & length(time_dim) == 1)) { stop("Parameter 'time_dim' must be a character string.") } - if (!(is.character(member_dim) & length(member_dim) == 1)) { - stop("Parameter 'member_dim' must be a character string.") + if (!(is.character(memb_dim) & length(memb_dim) == 1)) { + stop("Parameter 'memb_dim' must be a character string.") } if (!time_dim %in% names(dim(exp))) { stop("'exp' must have 'time_dim' dimension.") } - if (!member_dim %in% names(dim(exp))) { - stop("'exp' must have 'member_dim' dimension.") + if (!memb_dim %in% names(dim(exp))) { + stop("'exp' must have 'memb_dim' dimension.") } if (!time_dim %in% names(dim(obs))) { stop("'obs' must have 'time_dim' dimension.") @@ -68,7 +68,7 @@ RatioPredictableComponents <- function(exp, obs, time_dim = 'year', member_dim = } RPC <- multiApply::Apply(data = list(exp, obs), - target_dims = list(exp = c(time_dim, member_dim), + target_dims = list(exp = c(time_dim, memb_dim), obs = time_dim), output_dims = NULL, fun = .RatioPredictableComponents, diff --git a/R/RatioSDRMS.R b/R/RatioSDRMS.R index 2fe259c..b38d5e2 100644 --- a/R/RatioSDRMS.R +++ b/R/RatioSDRMS.R @@ -65,14 +65,10 @@ RatioSDRMS <- function(exp, obs, dat_dim = NULL, memb_dim = 'member', stop(paste0("Parameter 'exp' and 'obs' must be array with as least two ", "dimensions memb_dim and time_dim.")) } - if(any(is.null(names(dim(exp))))| any(nchar(names(dim(exp))) == 0) | - any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { + if (any(is.null(names(dim(exp))))| any(nchar(names(dim(exp))) == 0) | + any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } - if(!all(names(dim(exp)) %in% names(dim(obs))) | - !all(names(dim(obs)) %in% names(dim(exp)))) { - stop("Parameter 'exp' and 'obs' must have the same dimension names.") - } ## dat_dim if (!is.null(dat_dim)) { if (!is.character(dat_dim) | length(dat_dim) > 1) { @@ -86,8 +82,18 @@ RatioSDRMS <- function(exp, obs, dat_dim = NULL, memb_dim = 'member', if (!is.character(memb_dim) | length(memb_dim) > 1) { stop("Parameter 'memb_dim' must be a character string.") } - if (!memb_dim %in% names(dim(exp)) | !memb_dim %in% names(dim(obs))) { - stop("Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension.") + if (!memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { + stop("Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension. ", + "Set it as NULL if there is no member dimension.") + } + # Add [member = 1] + if (memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { + dim(obs) <- c(dim(obs), 1) + names(dim(obs))[length(dim(obs))] <- memb_dim + } + if (!memb_dim %in% names(dim(exp)) & memb_dim %in% names(dim(obs))) { + dim(exp) <- c(dim(exp), 1) + names(dim(exp))[length(dim(exp))] <- memb_dim } ## time_dim if (!is.character(time_dim) | length(time_dim) > 1) { diff --git a/man/RMS.Rd b/man/RMS.Rd index b7c044f..5747354 100644 --- a/man/RMS.Rd +++ b/man/RMS.Rd @@ -99,6 +99,6 @@ res1 <- RMS(exp1, obs1, comp_dim = 'ftime', dat_dim = 'dat') exp2 <- array(rnorm(20), dim = c(sdate = 5, member = 4)) obs2 <- array(rnorm(10), dim = c(sdate = 5, member = 2)) -res2 <- RMS(exp3, obs3, memb_dim = 'member') +res2 <- RMS(exp2, obs2, memb_dim = 'member') } diff --git a/man/RatioPredictableComponents.Rd b/man/RatioPredictableComponents.Rd index 3e7fbad..8e6dbb7 100644 --- a/man/RatioPredictableComponents.Rd +++ b/man/RatioPredictableComponents.Rd @@ -8,22 +8,22 @@ RatioPredictableComponents( exp, obs, time_dim = "year", - member_dim = "member", + memb_dim = "member", na.rm = FALSE, ncores = NULL ) } \arguments{ -\item{exp}{A numerical array with, at least, 'time_dim' and 'member_dim' +\item{exp}{A numerical array with, at least, 'time_dim' and 'memb_dim' dimensions.} \item{obs}{A numerical array with the same dimensions than 'exp' except the -'member_dim' dimension.} +'memb_dim' dimension.} \item{time_dim}{A character string indicating the name of the time dimension. The default value is 'year'.} -\item{member_dim}{A character string indicating the name of the member +\item{memb_dim}{A character string indicating the name of the member dimension. The default value is 'member'.} \item{na.rm}{A logical value indicating whether to remove NA values during @@ -34,7 +34,7 @@ computation. The default value is NULL.} } \value{ An array of the ratio of the predictable components. it has the same - dimensions as 'exp' except 'time_dim' and 'member_dim' dimensions. + dimensions as 'exp' except 'time_dim' and 'memb_dim' dimensions. } \description{ This function computes the ratio of predictable components (RPC; Eade et al., 2014). diff --git a/tests/testthat/test-ACC.R b/tests/testthat/test-ACC.R index b34ed21..544a235 100644 --- a/tests/testthat/test-ACC.R +++ b/tests/testthat/test-ACC.R @@ -64,11 +64,6 @@ test_that("1. Input checks", { ACC(exp1, obs1, dat_dim = 'a'), "Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension." ) - # space_dim (deprecated) - expect_warning( - ACC(exp1, obs1, space_dim = c('lat', 'lon'), lat = c(1, 2)), - "! Warning: Parameter 'space_dim' is deprecated. Use 'lat_dim' and 'lon_dim'\n! instead." - ) # lat_dim expect_error( ACC(exp1, obs1, lat_dim = 1), diff --git a/tests/testthat/test-Corr.R b/tests/testthat/test-Corr.R index 6732c58..4cc57d4 100644 --- a/tests/testthat/test-Corr.R +++ b/tests/testthat/test-Corr.R @@ -11,6 +11,13 @@ na <- floor(runif(10, min = 1, max = 120)) obs1[na] <- NA + set.seed(2) + obs1_2 <- array(rnorm(120), dim = c(dataset = 1, sdate = 5, + ftime = 3, lat = 2, lon = 4)) + set.seed(2) + na <- floor(runif(10, min = 1, max = 120)) + obs1_2[na] <- NA + # dat2: memb_dim = member set.seed(1) exp2 <- array(rnorm(180), dim = c(member = 3, dataset = 2, sdate = 5, @@ -85,10 +92,6 @@ test_that("1. Input checks", { "Parameter 'exp' and 'obs' must have dimension names." ) expect_error( - Corr(array(1:10, dim = c(a = 2, c = 5)), array(1:4, dim = c(a = 2, b = 2))), - "Parameter 'exp' and 'obs' must have same dimension name" - ) - expect_error( Corr(exp1, obs1, dat_dim = 1), "Parameter 'dat_dim' must be a character string." ) @@ -135,7 +138,7 @@ test_that("1. Input checks", { ) expect_error( Corr(exp1, obs1, memb_dim = 'memb'), - "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." + "Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension. Set it as NULL if there is no member dimension." ) expect_error( Corr(exp2, obs2, memb_dim = 'member', memb = 1), @@ -244,6 +247,19 @@ suppressWarnings( tolerance = 0.001 ) ) +# obs1_2, no memb_dim +suppressWarnings( + expect_equal( + Corr(exp1, obs1, dat_dim = 'dataset', memb_dim = 'member'), + Corr(exp1, obs1_2, dat_dim = 'dataset', memb_dim = 'member') + ) +) +suppressWarnings( + expect_equal( + Corr(exp1, obs1, dat_dim = 'dataset', memb_dim = 'member', memb = F), + Corr(exp1, obs1_2, dat_dim = 'dataset', memb_dim = 'member', memb = F) + ) +) }) diff --git a/tests/testthat/test-RatioPredictableComponents.R b/tests/testthat/test-RatioPredictableComponents.R index 54609b5..7edaf20 100644 --- a/tests/testthat/test-RatioPredictableComponents.R +++ b/tests/testthat/test-RatioPredictableComponents.R @@ -35,8 +35,8 @@ test_that("1. Input checks", { "'exp' must have 'time_dim' dimension." ) expect_error( - RatioPredictableComponents(exp1, obs1, member_dim = 'ens'), - "'exp' must have 'member_dim' dimension." + RatioPredictableComponents(exp1, obs1, memb_dim = 'ens'), + "'exp' must have 'memb_dim' dimension." ) expect_error( RatioPredictableComponents(exp1, array(rnorm(6), dim = c(sdate = 3, time = 2))), diff --git a/tests/testthat/test-RatioSDRMS.R b/tests/testthat/test-RatioSDRMS.R index 78143cc..53be127 100644 --- a/tests/testthat/test-RatioSDRMS.R +++ b/tests/testthat/test-RatioSDRMS.R @@ -4,6 +4,8 @@ exp1 <- array(rnorm(40), dim = c(dataset = 2, member = 2, sdate = 5, ftime = 2)) set.seed(2) obs1 <- array(rnorm(10), dim = c(dataset = 1, member = 1, sdate = 5, ftime = 2)) + obs1_2 <- obs1 + dim(obs1_2) <- dim(obs1_2)[-2] # dat2 exp2 <- exp1 @@ -37,10 +39,6 @@ test_that("1. Input checks", { "Parameter 'exp' and 'obs' must have dimension names." ) expect_error( - RatioSDRMS(array(1:10, dim = c(a = 2, c = 5)), array(1:4, dim = c(a = 2, b = 2))), - "Parameter 'exp' and 'obs' must have the same dimension names." - ) - expect_error( RatioSDRMS(exp1, obs1, dat_dim = 1), "Parameter 'dat_dim' must be a character string." ) @@ -54,7 +52,7 @@ test_that("1. Input checks", { ) expect_error( RatioSDRMS(exp1, obs1, memb_dim = 'a', dat_dim = 'dataset'), - "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." + "Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension. Set it as NULL if there is no member dimension." ) expect_error( RatioSDRMS(exp1, obs1, time_dim = c('sdate', 'a'), dat_dim = 'dataset'), @@ -113,6 +111,10 @@ as.vector(RatioSDRMS(exp1, obs1, dat_dim = 'dataset')$ratio), as.vector(RatioSDRMS(exp1, obs1, pval = F, dat_dim = 'dataset')$ratio) ) +expect_equal( +RatioSDRMS(exp1, obs1, dat_dim = 'dataset'), +RatioSDRMS(exp1, obs1_2, dat_dim = 'dataset') +) }) ############################################## -- GitLab From 3b32735b292a216470e04cc10ad66ecbc8fa59f0 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 29 Sep 2023 16:21:13 +0200 Subject: [PATCH 60/64] Allow obs to have no memb_dim --- R/Ano_CrossValid.R | 85 ++++++++++++++++++---------- tests/testthat/test-Ano_CrossValid.R | 43 +++++++++++++- 2 files changed, 95 insertions(+), 33 deletions(-) diff --git a/R/Ano_CrossValid.R b/R/Ano_CrossValid.R index d1996b9..7117f41 100644 --- a/R/Ano_CrossValid.R +++ b/R/Ano_CrossValid.R @@ -72,10 +72,6 @@ Ano_CrossValid <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } - if(!all(names(dim(exp)) %in% names(dim(obs))) | - !all(names(dim(obs)) %in% names(dim(exp)))) { - stop("Parameter 'exp' and 'obs' must have same dimension name.") - } ## time_dim if (!is.character(time_dim) | length(time_dim) > 1) { stop("Parameter 'time_dim' must be a character string.") @@ -83,13 +79,38 @@ Ano_CrossValid <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', if (!time_dim %in% names(dim(exp)) | !time_dim %in% names(dim(obs))) { stop("Parameter 'time_dim' is not found in 'exp' or 'obs' dimension.") } + ## memb + if (!is.logical(memb) | length(memb) > 1) { + stop("Parameter 'memb' must be one logical value.") + } + ## memb_dim + if (!memb) { + if (!is.character(memb_dim) | length(memb_dim) > 1) { + stop("Parameter 'memb_dim' must be a character string.") + } + if (!memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { + stop("Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension. ", + "Set it as NULL if there is no member dimension.") + } +# # Add [member = 1] +# if (memb_dim %in% names(dim(exp)) & !memb_dim %in% names(dim(obs))) { +# dim(obs) <- c(dim(obs), 1) +# names(dim(obs))[length(dim(obs))] <- memb_dim +# } +# if (!memb_dim %in% names(dim(exp)) & memb_dim %in% names(dim(obs))) { +# dim(exp) <- c(dim(exp), 1) +# names(dim(exp))[length(dim(exp))] <- memb_dim +# } + } + ## dat_dim + reset_obs_dim <- reset_exp_dim <- FALSE if (!is.null(dat_dim)) { if (!is.character(dat_dim)) { stop("Parameter 'dat_dim' must be a character vector.") } - if (!all(dat_dim %in% names(dim(exp))) | !all(dat_dim %in% names(dim(obs)))) { - stop("Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension.", + if (!any(dat_dim %in% names(dim(exp))) & !any(dat_dim %in% names(dim(obs)))) { + stop("Parameter 'dat_dim' is not found in 'exp' nor 'obs' dimension.", " Set it as NULL if there is no dataset dimension.") } # If dat_dim is not in obs, add it in @@ -98,28 +119,22 @@ Ano_CrossValid <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', ori_obs_dim <- dim(obs) dim(obs) <- c(dim(obs), rep(1, length(dat_dim[which(!dat_dim %in% names(dim(obs)))]))) names(dim(obs)) <- c(names(ori_obs_dim), dat_dim[which(!dat_dim %in% names(dim(obs)))]) - } else { - reset_obs_dim <- FALSE } - } else { - reset_obs_dim <- FALSE - } - ## memb - if (!is.logical(memb) | length(memb) > 1) { - stop("Parameter 'memb' must be one logical value.") + # If dat_dim is not in obs, add it in + if (any(!dat_dim %in% names(dim(exp)))) { + reset_exp_dim <- TRUE + ori_exp_dim <- dim(exp) + dim(exp) <- c(dim(exp), rep(1, length(dat_dim[which(!dat_dim %in% names(dim(exp)))]))) + names(dim(exp)) <- c(names(ori_exp_dim), dat_dim[which(!dat_dim %in% names(dim(exp)))]) + } } - ## memb_dim + # memb_dim and dat_dim if (!memb) { - if (!is.character(memb_dim) | length(memb_dim) > 1) { - stop("Parameter 'memb_dim' must be a character string.") - } - if (!memb_dim %in% names(dim(exp)) | !memb_dim %in% names(dim(obs))) { - stop("Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension.") - } if (!memb_dim %in% dat_dim) { stop("Parameter 'memb_dim' must be one element in parameter 'dat_dim'.") - } + } } + ## ncores if (!is.null(ncores)) { if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | @@ -184,17 +199,25 @@ Ano_CrossValid <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', # Remove dat_dim in obs if obs doesn't have at first place if (reset_obs_dim) { - res_obs_dim <- ori_obs_dim[-which(names(ori_obs_dim) == time_dim)] - if (!memb & memb_dim %in% names(res_obs_dim)) { - res_obs_dim <- res_obs_dim[-which(names(res_obs_dim) == memb_dim)] - } - if (is.integer(res_obs_dim) & length(res_obs_dim) == 0) { - res$obs <- as.vector(res$obs) - } else { - res$obs <- array(res$obs, dim = res_obs_dim) - } + tmp <- match(names(dim(res$obs)), names(ori_obs_dim)) + dim(res$obs) <- ori_obs_dim[tmp[which(!is.na(tmp))]] + } + if (reset_exp_dim) { + tmp <- match(names(dim(res$exp)), names(ori_exp_dim)) + dim(res$exp) <- ori_exp_dim[tmp[which(!is.na(tmp))]] } +# res_obs_dim <- ori_obs_dim[-which(names(ori_obs_dim) == time_dim)] +# if (!memb & memb_dim %in% names(res_obs_dim)) { +# res_obs_dim <- res_obs_dim[-which(names(res_obs_dim) == memb_dim)] +# } +# if (is.integer(res_obs_dim) & length(res_obs_dim) == 0) { +# res$obs <- as.vector(res$obs) +# } else { +# res$obs <- array(res$obs, dim = res_obs_dim) +# } +# } + return(res) } diff --git a/tests/testthat/test-Ano_CrossValid.R b/tests/testthat/test-Ano_CrossValid.R index c5eea59..d450ff0 100644 --- a/tests/testthat/test-Ano_CrossValid.R +++ b/tests/testthat/test-Ano_CrossValid.R @@ -5,6 +5,10 @@ exp1 <- array(rnorm(60), dim = c(dataset = 2, member = 3, sdate = 5, ftime = 2)) set.seed(2) obs1 <- array(rnorm(20), dim = c(dataset = 1, member = 2, sdate = 5, ftime = 2)) +obs1_2 <- obs1 +dim(obs1_2) <- c(member = 2, sdate = 5, ftime = 2) +obs1_3 <- obs1[1,1,,] +exp1_2 <- exp1[,1,,] # dat2 set.seed(1) exp2 <- array(rnorm(30), dim = c(member = 3, ftime = 2, sdate = 5)) @@ -55,7 +59,7 @@ test_that("1. Input checks", { ) expect_error( Ano_CrossValid(exp1, obs1, dat_dim = 'dat'), - "Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension. Set it as NULL if there is no dataset dimension." + "Parameter 'dat_dim' is not found in 'exp' nor 'obs' dimension. Set it as NULL if there is no dataset dimension." ) # memb expect_error( @@ -69,7 +73,7 @@ test_that("1. Input checks", { ) expect_error( Ano_CrossValid(exp1, obs1, memb = FALSE, memb_dim = 'memb'), - "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." + "Parameter 'memb_dim' is not found in 'exp' nor 'obs' dimension. Set it as NULL if there is no member dimension." ) expect_error( Ano_CrossValid(exp1, obs1, memb = FALSE, memb_dim = 'ftime'), @@ -115,6 +119,41 @@ test_that("2. dat1", { tolerance = 0.0001 ) + expect_equal( + dim(Ano_CrossValid(exp1, obs1_2)$obs), + c(sdate = 5, member = 2, ftime = 2) + ) + expect_equal( + Ano_CrossValid(exp1, obs1)$exp, + Ano_CrossValid(exp1, obs1_2)$exp + ) + expect_equal( + c(Ano_CrossValid(exp1, obs1)$obs), + c(Ano_CrossValid(exp1, obs1_2)$obs) + ) + + expect_equal( + Ano_CrossValid(exp1, obs1)$exp, + Ano_CrossValid(exp1, obs1_3)$exp + ) + expect_equal( + dim(Ano_CrossValid(exp1, obs1_3)$obs), + c(sdate = 5, ftime = 2) + ) + expect_equal( + c(Ano_CrossValid(exp1, obs1_3)$obs), + c(Ano_CrossValid(exp1, obs1)$obs[, 1, 1, ]) + ) + + expect_equal( + dim(Ano_CrossValid(exp1_2, obs1)$exp), + c(sdate = 5, dataset = 2, ftime = 2) + ) + expect_equal( + c(Ano_CrossValid(exp1_2, obs1)$exp), + c(Ano_CrossValid(exp1, obs1)$exp[,,1,]) + ) + }) ############################################## -- GitLab From 8568137787c33f16dc2cd7538cd52718146e932e Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 2 Oct 2023 12:39:11 +0200 Subject: [PATCH 61/64] Improve checks; Consider different dimension orders of dat and member --- R/ACC.R | 2 +- R/Ano_CrossValid.R | 10 +++++----- R/Corr.R | 2 +- R/RMS.R | 2 +- R/RatioSDRMS.R | 2 +- tests/testthat/test-Ano_CrossValid.R | 30 +++++++++++++++++++++++++++- 6 files changed, 38 insertions(+), 10 deletions(-) diff --git a/R/ACC.R b/R/ACC.R index d921ce8..71544b9 100644 --- a/R/ACC.R +++ b/R/ACC.R @@ -281,7 +281,7 @@ ACC <- function(exp, obs, dat_dim = NULL, lat_dim = 'lat', lon_dim = 'lon', name_exp <- name_exp[-which(name_exp == memb_dim)] name_obs <- name_obs[-which(name_obs == memb_dim)] } - if (!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + if (!identical(dim(exp)[name_exp], dim(obs)[name_obs])) { stop(paste0("Parameter 'exp' and 'obs' must have same length of ", "all the dimensions except 'dat_dim' and 'memb_dim'.")) } diff --git a/R/Ano_CrossValid.R b/R/Ano_CrossValid.R index 7117f41..13f7e97 100644 --- a/R/Ano_CrossValid.R +++ b/R/Ano_CrossValid.R @@ -151,7 +151,7 @@ Ano_CrossValid <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', name_obs <- name_obs[-which(name_obs == dat_dim[i])] } } - if(!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + if (!identical(dim(exp)[name_exp], dim(obs)[name_obs])) { stop(paste0("Parameter 'exp' and 'obs' must have the same length of ", "all dimensions except 'dat_dim'.")) } @@ -175,10 +175,10 @@ Ano_CrossValid <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', outrows_exp <- MeanDims(exp, pos, na.rm = FALSE) + MeanDims(obs, pos, na.rm = FALSE) outrows_obs <- outrows_exp - - for (i in 1:length(pos)) { - outrows_exp <- InsertDim(outrows_exp, pos[i], dim(exp)[pos[i]]) - outrows_obs <- InsertDim(outrows_obs, pos[i], dim(obs)[pos[i]]) +#browser() + for (i_pos in sort(pos)) { + outrows_exp <- InsertDim(outrows_exp, i_pos, dim(exp)[i_pos]) + outrows_obs <- InsertDim(outrows_obs, i_pos, dim(obs)[i_pos]) } exp_for_clim <- exp obs_for_clim <- obs diff --git a/R/Corr.R b/R/Corr.R index fe03041..c11fcf6 100644 --- a/R/Corr.R +++ b/R/Corr.R @@ -222,7 +222,7 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL, name_exp <- name_exp[-which(name_exp == memb_dim)] name_obs <- name_obs[-which(name_obs == memb_dim)] } - if(!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + if (!identical(dim(exp)[name_exp], dim(obs)[name_obs])) { stop(paste0("Parameter 'exp' and 'obs' must have same length of ", "all dimension except 'dat_dim' and 'memb_dim'.")) } diff --git a/R/RMS.R b/R/RMS.R index b603c37..8f7e58b 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -185,7 +185,7 @@ RMS <- function(exp, obs, time_dim = 'sdate', memb_dim = NULL, dat_dim = NULL, if (!all(name_exp == name_obs)) { stop("Parameter 'exp' and 'obs' must have the same dimension names.") } - if (!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + if (!identical(dim(exp)[name_exp], dim(obs)[name_obs])) { stop(paste0("Parameter 'exp' and 'obs' must have same length of ", "all dimensions except 'dat_dim' and 'memb_dim'.")) } diff --git a/R/RatioSDRMS.R b/R/RatioSDRMS.R index b38d5e2..6040410 100644 --- a/R/RatioSDRMS.R +++ b/R/RatioSDRMS.R @@ -111,7 +111,7 @@ RatioSDRMS <- function(exp, obs, dat_dim = NULL, memb_dim = 'member', } name_exp <- name_exp[-which(name_exp == memb_dim)] name_obs <- name_obs[-which(name_obs == memb_dim)] - if(!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + if (!identical(dim(exp)[name_exp], dim(obs)[name_obs])) { stop(paste0("Parameter 'exp' and 'obs' must have same length of ", "all the dimensions except 'dat_dim' and 'memb_dim'.")) } diff --git a/tests/testthat/test-Ano_CrossValid.R b/tests/testthat/test-Ano_CrossValid.R index d450ff0..0e2b442 100644 --- a/tests/testthat/test-Ano_CrossValid.R +++ b/tests/testthat/test-Ano_CrossValid.R @@ -1,14 +1,22 @@ ############################################## - # dat1 +# dat1 set.seed(1) exp1 <- array(rnorm(60), dim = c(dataset = 2, member = 3, sdate = 5, ftime = 2)) set.seed(2) obs1 <- array(rnorm(20), dim = c(dataset = 1, member = 2, sdate = 5, ftime = 2)) +## different member and dat dim obs1_2 <- obs1 dim(obs1_2) <- c(member = 2, sdate = 5, ftime = 2) obs1_3 <- obs1[1,1,,] +obs1_4 <- obs1[, 1, , ]; dim(obs1_4) <- c(dataset = 1, dim(obs1_4)) + exp1_2 <- exp1[,1,,] + +## not usual dimension order +exp1_5 <- aperm(exp1, 4:1) +obs1_5 <- aperm(obs1, c(3, 4, 2, 1)) + # dat2 set.seed(1) exp2 <- array(rnorm(30), dim = c(member = 3, ftime = 2, sdate = 5)) @@ -21,6 +29,8 @@ exp3 <- array(rnorm(30), dim = c(ftime = 2, sdate = 5)) set.seed(2) obs3 <- array(rnorm(20), dim = c(ftime = 2, sdate = 5)) +# dat4: not usual dimension order + ############################################## test_that("1. Input checks", { @@ -145,6 +155,19 @@ test_that("2. dat1", { c(Ano_CrossValid(exp1, obs1)$obs[, 1, 1, ]) ) + expect_equal( + dim(Ano_CrossValid(exp1, obs1_4)$obs), + c(sdate = 5, dataset = 1, ftime = 2) + ) + expect_equal( + Ano_CrossValid(exp1, obs1_4)$exp, + Ano_CrossValid(exp1, obs1)$exp + ) + expect_equal( + c(Ano_CrossValid(exp1, obs1_4)$obs), + c(Ano_CrossValid(exp1, obs1)$obs[, , 1, ]) + ) + expect_equal( dim(Ano_CrossValid(exp1_2, obs1)$exp), c(sdate = 5, dataset = 2, ftime = 2) @@ -154,6 +177,11 @@ test_that("2. dat1", { c(Ano_CrossValid(exp1, obs1)$exp[,,1,]) ) + expect_equal( + Ano_CrossValid(exp1, obs1), + Ano_CrossValid(exp1_5, obs1_5) + ) + }) ############################################## -- GitLab From b2df65301e027408f8bbe2ca9fcbb939af2e31c7 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 2 Oct 2023 17:54:43 +0200 Subject: [PATCH 62/64] Remove the code that maintains compatibility, update document --- .Rbuildignore | 3 ++- DESCRIPTION | 2 +- NEWS.md | 20 ++++++++++++++++++++ R/InsertDim.R | 7 +------ R/MSE.R | 4 +--- man/InsertDim.Rd | 5 +---- man/MSE.Rd | 4 +--- s2dv-manual.pdf | Bin 418182 -> 0 bytes 8 files changed, 27 insertions(+), 18 deletions(-) delete mode 100644 s2dv-manual.pdf diff --git a/.Rbuildignore b/.Rbuildignore index 4212858..0a21855 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,5 +1,6 @@ .*\.git$ .*\.gitignore$ +.*\.gitlab$ .*\.tar.gz$ .*\.pdf$ .*^(?!inst)\.nc$ @@ -10,7 +11,7 @@ README\.md$ vignettes .gitlab-ci.yml # unit tests should be ignored when building the package for CRAN -#^tests$ +^tests$ # CDO is not in windbuilder, so we can test the unit tests by winbuilder # but test-CDORemap.R and test-Load.R needs to be hidden #tests/testthat/test-CDORemap.R diff --git a/DESCRIPTION b/DESCRIPTION index bbfb47c..ec571f4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: s2dv Title: A Set of Common Tools for Seasonal to Decadal Verification -Version: 1.4.1 +Version: 2.0.0 Authors@R: c( person("BSC-CNS", role = c("aut", "cph")), person("An-Chi", "Ho", , "an.ho@bsc.es", role = c("aut", "cre")), diff --git a/NEWS.md b/NEWS.md index a69b74c..497fa39 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,23 @@ +# s2dv 2.0.0 (Release date: 2023-10-03) +The compability break happens at the parameter changes. All the functionality remains +the same but please pay attention to the parameter changes like name or default value if some error is raised. + +**Bugfixes** +- ColorBar() bug fix for an if condition for warning when var_limits is not provided +- PlotEquiMap() and PlotLayout() are able to plot all NAs maps now. + +**Development** +- ACC() remove parameter "space_dim". Use "lat_dim" and "lon_dim" instead. +- ACC(), Ano_CrossValid(), RMS(), Corr(), and RatioSDRMS() parameter "memb_dim" is optional for obs +- Change the default value of the parameter "dat_dim" in all the functions to NULL (except Ano_CrossValid(), Clim(), and Consistent_Trend()) +- Change parameter "conf.lev" to "alpha" in all appliable functions +- New function: GetProbs(), MSE(), MSSS() +- RPSS() efficiency improvement +- CDORemap() new parameter "ncores" to use multiple cores +- RMSSS(), RPSS(), CRPSS(), AbsBiasSS() have parameter "sig_method.type" to choose the test type of Random Walk test +- CRPSS() has non-cross-validation climatological forecast +- RPS() and RPSS() have new parameter "na.rm" to set the criterion of NA amount + # s2dv 1.4.1 (Release date: 2023-06-02) - Resubmit to CRAN because it was archived due to dependency issue. diff --git a/R/InsertDim.R b/R/InsertDim.R index 533683d..ff88b58 100644 --- a/R/InsertDim.R +++ b/R/InsertDim.R @@ -8,8 +8,6 @@ #'@param lendim An integer indicating the length of the new dimension. #'@param name A character string indicating the name for the new dimension. #' The default value is NULL. -#'@param ncores An integer indicating the number of cores to use for parallel -#' computation. The default value is NULL. This parameter is deprecated now. #' #'@return An array as parameter 'data' but with the added named dimension. #' @@ -20,7 +18,7 @@ #' #'@import multiApply #'@export -InsertDim <- function(data, posdim, lendim, name = NULL, ncores = NULL) { +InsertDim <- function(data, posdim, lendim, name = NULL) { # Check inputs ## data @@ -61,9 +59,6 @@ InsertDim <- function(data, posdim, lendim, name = NULL, ncores = NULL) { stop("Parameter 'name' must be a character string.") } } - ## ncores - if (!missing("ncores")) - .warning("Argument 'ncores' is deprecated.", tag = '! Deprecation: ') ############################### # Calculate InsertDim diff --git a/R/MSE.R b/R/MSE.R index 97e4e82..61cf3bc 100644 --- a/R/MSE.R +++ b/R/MSE.R @@ -63,13 +63,11 @@ #'# Synthetic data: #'exp1 <- array(rnorm(120), dim = c(dat = 3, sdate = 10, ftime = 4)) #'obs1 <- array(rnorm(80), dim = c(dat = 2, sdate = 10, ftime = 4)) -#'na <- floor(runif(10, min = 1, max = 80)) -#'obs1[na] <- NA #'res1 <- MSE(exp1, obs1, comp_dim = 'ftime', dat_dim = 'dat') #' #'exp2 <- array(rnorm(20), dim = c(sdate = 5, member = 4)) #'obs2 <- array(rnorm(10), dim = c(sdate = 5, member = 2)) -#'res2 <- MSE(exp3, obs3, memb_dim = 'member') +#'res2 <- MSE(exp2, obs2, memb_dim = 'member') #' #'@import multiApply #'@importFrom ClimProjDiags Subset diff --git a/man/InsertDim.Rd b/man/InsertDim.Rd index 51418f0..7a866a3 100644 --- a/man/InsertDim.Rd +++ b/man/InsertDim.Rd @@ -4,7 +4,7 @@ \alias{InsertDim} \title{Add a named dimension to an array} \usage{ -InsertDim(data, posdim, lendim, name = NULL, ncores = NULL) +InsertDim(data, posdim, lendim, name = NULL) } \arguments{ \item{data}{An array to which the additional dimension to be added.} @@ -15,9 +15,6 @@ InsertDim(data, posdim, lendim, name = NULL, ncores = NULL) \item{name}{A character string indicating the name for the new dimension. The default value is NULL.} - -\item{ncores}{An integer indicating the number of cores to use for parallel -computation. The default value is NULL. This parameter is deprecated now.} } \value{ An array as parameter 'data' but with the added named dimension. diff --git a/man/MSE.Rd b/man/MSE.Rd index 291d08c..cd58402 100644 --- a/man/MSE.Rd +++ b/man/MSE.Rd @@ -91,12 +91,10 @@ res <- MSE(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member', # Synthetic data: exp1 <- array(rnorm(120), dim = c(dat = 3, sdate = 10, ftime = 4)) obs1 <- array(rnorm(80), dim = c(dat = 2, sdate = 10, ftime = 4)) -na <- floor(runif(10, min = 1, max = 80)) -obs1[na] <- NA res1 <- MSE(exp1, obs1, comp_dim = 'ftime', dat_dim = 'dat') exp2 <- array(rnorm(20), dim = c(sdate = 5, member = 4)) obs2 <- array(rnorm(10), dim = c(sdate = 5, member = 2)) -res2 <- MSE(exp3, obs3, memb_dim = 'member') +res2 <- MSE(exp2, obs2, memb_dim = 'member') } diff --git a/s2dv-manual.pdf b/s2dv-manual.pdf deleted file mode 100644 index b4929e91355acf41086488ce94a23527e278f884..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 418182 zcma&NQ;=xQ)~;FBD%-Ygud;31wr$(CZQHhO+tuGbaZdN{{&#fjyc(GqnGy5mea1U- zOcFUE5gGbuC^{K@26}oZIuUaR zM<;xCdPXQZDPtQ`C$oQ+89DI(*Z9}2m6NdpKAnh_zLT+#v7xPzF%&N^l%tb_vA#8w z+eWbRrp+chy!Wc=l;LAS7+O5C9I_a8sW$!&a{a!6zqdSgF@Z`-S3-dGkIyXo%5eA@ z5GpehwtF5dOKGuLH1~PF~M=c0#yo3Vv@n&8bE^r`682qHUX!#S_~>M#)7LUlR_d_>Yf5JH5I zSO0zw0kE?XBRy8z&%QmSERi%GFys&_q0(USMKONFF=*T{Lh4Y0KQWV70qYK_h`3Nq ziu~A4ey(7Ri}(6+b4q~WLK854VuZmfYZzdO0_5=>X|5st*1>9wCy5V!!x?1K{d&0A z{3BZyVWhza7ue7z0*ys>lm-YzVjKbXNnToJWXHI`CgViW)<-%(W8e^2dMaA%AW4+R z7kyRk75RBf8bY~zi^B=DJt~zEv^D38--_-&?{ix3RqC{}!x-N0h~5{#ri*XuRiZN{ zfKvwBhNzbSB~P1G(`f58p)c`rA}sus^d~>X?77Rzi&c#Sd@%|?BYDt&7D2q8XoIf- zDqh^Xx0IZB3_r)5My@_?cz0n#ufG5~?ly5DJu#d0muRUTTCOkAM+LX&q%&86zjt8t zDhn!V8vwoT{+?aeSbWJz;X&+AlKnn9v{LDysdu`+9M8J17sOBV!wY5^Wbu8xaQZ$J z+j=YGI^xuR#{{!^ev8$?R{o~=Tt-&qTn&#t@77m0gcAOW zHNb&8V(m74!kH_d9v_ltqP=l#jQ%};Hq*P9tK0Iut;KE`EF)3_aJ|mW8ToYiVfNtN zB7U5cX6)@eXK-Z$oRZYmZV^^#@oBuM9X>pBA{Ehpg6VNz9IK5yt{AMx;isVkN4_#& zVhd9px9#!TGMan!&ai5u#{`HR%^v^1=IOeR(baw1~*d(~u=FZ~z0Ox5Vs~arB z-J*Y~_;@~CXZwYAbjF4;jrq0VFn}w&EQ3!$%OxHx^aHCJD&7$;rgZizym@MUw|^UG5X(n@K5wF ztzlxM|2Nh7KdQpa$oAi=O19drVqnGhBF;!9;TfmiAd-D37fA*<6zxsu_Yue#24QKD2)vC;n>MhSb)3+IRr2 zNaJ<0!s1xTBBlLRc3i z@*BBt1pcrz(bT%c;y;Bej$Cft&lBe)%rn*H3=*0$$3+t$Um z-PgP&4skatrJZy^7HeZ$#UOK@L7dmFahgGQ%4%;VdhSQaxYzX*Hr6Q?d`&)_iQ|L& z4EB5RXAra2rPJ^80r^HDN@sy2PI=Kn^R$UEPOvdO@j{}D6d6nW-ekOMsJX7nM4Dfj4dr2j$>acEzf_g`4O2DUeB-EA3 zPgm&*c}NM!Sx>mzx?bT!=WW5OZWzB`zZOro-vS+A)z4j7<-v(s$_N+5rk%F0rgjfa z;Wk5SEp(zart!&^p^)ms9wrn}l44Rb7v~O6%;;Y1i9LnNpSJKKMIqF5UE4dF-TrOt`N;TGA8_MDJDXcv_vA>0}ucMWU^c)d{Fb)2R z{ea+{>#o`=Y3lA+>G{cIUWDN%p1r%t0XN8SA=@{(pnf7H`J>LGeDd^jbkt?e&ZOBd zI<nYOAneU-cwwS-ospr)^iGhJbX*7=Irhq0YOj9I)b2jx;NQ1ui-8hpM?ixKp`g znWOp=D5c_ICO19$wj=L68}H-viFPtcF){eH=;+Gw@9cS%nU;ORYj1Yz_3xiLjK;=~ z+Gmxj;T5YtW%vFvv2;Xi8NkAM=3M~pYb?9dJn5^Ms=t66d>KU-O^<&jAQ&YUplH-+o~TumxCbsSG{C+?Oz)9TDveB(5u(VWK4WZr^aTFe66mCz zHNBW}uFuOb!j6yy#xSvsr-}jlM;YUj=2Fz1yBuyq0qxelV8M zJt5(f@mEc0TQ)xiL-W8jW5f@889wsV0X^jxmoUH_;~O-)g7 zEpZo-qjjhe`9vf+<^bFNR){MF7|_%2XQ|S8QA=1oC0Mw;BtH62kZCW96Li4MK_0mY z$3wQ>s0Vx;8P2lAN?~|SvGr$^CtwGXpFgM2?c0~a%r?1{;z_$}U-n>Is)dbYo9kk| zYbm%OK2e4mPlB+#gkcrRagsYEr=F~zxBfc1`X)l(h(HfsS2b$K(zCq&Fnl{+4A)R@ zpjBDv>7Q-##gM-{fgOjjih7T=KT?WLo^5JLu7d+oCKVmmsv{xg)1EJ-tIy6+IiQVv z$|q_asmY8Isy1FEK6hVyW9Vn-x&)me9;c`XZEWGyafznQm;RK;?}92fj%BW=)nSdM z2zb*@L1u66MJE;17oLVD0qzyLaWstHm(9(DEDtDf^I zA}7km+gepULu$D+^Xi7P{V6x25r*n-0l8E_Tzu|~*fBQ|36Fx;lHu#ho{gN=axxn% zj(Rk&WME(!D-@T}qh*v?vXP_LD-Hj-fu3GX>q&BXYy-QKi8xAbcc=3Z?oZH+QT-dy zgw@W%b+Y5d>jc*l04jF&`9O6J)WzSz)@8$OvXF+dDx&7qq_6qlo4eCGmZIIQm;rqu zb2l4L;Tt;aYYkL2BPRmO)_tPN@F)WTrrN&AdB-*VoJa+%rXFp1Hq~i$V!1V&uJU%L zK-T9z|33XtGn~6mu2{F((=l5E&MZGoAJ6SbV;`z~PXu(eAfoT%*K~`Y7RBH??J=aa z!rcfCaIU!v3(%2v+js3s{5@dX-`rvg+gFE^R|uUUZ2$CJ6ju-Pt*=QsNM~|@Esv1k z@?|t%mtHPFJI`L6z|KA~85Pkfj*}d3v@43N?)c`VO5bySo);Q-U#>QX?AJF%* z_v!zsWsLMp|E6XCe=eDY`Tudr?9A-{Z9dzrChdsDhS>e6x@U&R2%I={+@Hr{wl68e z(NCfx<3&Mvdi+|Xb=TJv(VVL;8ZkWMUN_JMdxh@35>eO$Msvr%{s+zEn4$H!tSj}t z$V+Hf6QwF!U6xYM=CT_K@XJe%VE;8wIqBKY5Cjb?D+0j_sIsUZFAFJLTVZ_Pbt;>1 z+KM>Yh>t#W9u*52n0M@@Q?JQNeE`*BPkjx;5Fj9$MMSMA3@+AOaX@qkmjD^elaEOH z!CzZQEowL^s1JP-UBE0#`T@{r;3iH;v?ZOGn|S1oIS4e)9}VlhPmA|1in^;nG7Rn{ zBK*$39WfluOix{wU}0yUZ2hkl?)ZsYl^?u#6>cL@k{V=JoyG!WmUx|?1hLE3Z{VFM z!$>Zh0ki;!P^?i8`Y<}ds+vD_9|lN9mOnYae;&}O5gR`6=otd@o)^3!1X+a9{+`DJ zAxt#;#K*b?gG_`cZ2@X%T;f=8{Ur#DJw84Y2&%Dv-Xx*~A|!@7{>w&WTv*^kkXu4o zgt0#%72TgFjd%FZVTxQM{{rS|4;QDRi}s4&d7b78Uin*EUrklC%oo0CY1a-bmDXhU z+MZvZ7aR7MALZJ~;g6Q?U-$Zt?}~MoS)b5C!<_Ag?ltDt$xNGj_hm1uTf7bD#+w$; zB!)d)5rW}uc;dYTW1CvCT7g~4cZ$#m1*(EId2Yir%2OK zv_X>H$KkE4Sbdv};cHxZ52BRqg2Zn28x=n8 zo8vcwH|O2Tm)OUb7Ihvjo>$Q-x*3-cG*cqhOq1@yZC9PvPxED(TQu!Q!2KP2Ui7aO z+x8yo9+i*r7b(u&HLrxGlI7wG+0^Z3bX=V2i%LFROl4i_n+)~udTmz+cLF%``mAO4 zw(G-_lJ%GMYCO(S>(;k9ALZPk5F}Mp5>cm;h;t7xV(O~P$<&=Mw{9E%xANIy#?B%I z^IB7IXpc_y@BChM4>ND=U%A|6ym^6{Zd69L?2jO7oq0u>>Hy-m3CS7fjt0ixuX{)E zzK`6==iBG|d3iWpyj}kJOAno2CwEfc+a9Ow!53TSZEDu-)QiWL5{s7S?FLO6-qp8_ zjm_VcTY)=S2cs(}$!dA=kHWo5qaqXfWD-7_$=i!#m(MUy{aF|EOWmJuDvK%!L~jTs z4kfkA(d7$|sTH$tqbsZ7GU=bLdy1tZp}T^8NWR6%!&<+z@B3y9xRrRzkYVyjEdg?5(q=Jw*Pjx7fpZ=1#=ibMGkM~qox z?$mp&|4%UEmUYj5Xg_ioHHs0-glo$EuLZA>M~qoh?%e-(KxfnycP}{d2jichFSwE* z7h@SOV^uc)oNKleUN#R(7Az^Pjp0b#sB8h@+1x2P9KmJu;+W?Hz*%`ow{X$nPU*S$ znJH9{D$y+qxEBzdHCaq=)L$_j;}&Ai*B~4>7W2vD(`?2Z$Nt zwc$U8$*EXv=$zwCZr^bh5GBw#SZ(c`Wt?0??bfg#H{(c<`U>l;Uw+sG{!a*L_qQcS zT=|jjvI}-m(^IjUl&@@q_#S;&a4_j#0#xR2o^i}qVi*Jcym7TKQ0ZFn(2Qvq1vX2w zhO~~-UNY?=9uBc>T7kskCFw=W1yD1GxDIWh{c6ejw4WR&ae=f4|kmd~a zbcpN3`HYZg-%LN}fWH|RxN(^g_y|^OV`E1{eLcc=lm{>y1VLaIVmkV>*kHB0r+1)QFFW)hAX{w8W1Ew6j=ku?z%6OFLpci9N31OA zE_=7QPRReYnbT84`fpRd@Af*k!#jLeq#gE}q|WcB(}9D3osGtX!iK89Tg?4)3Fp{4 zj5V6<@R~FD3&3E~Me;vE&CL4mgttsia$qL`|sd^_iqr{Bsh3gS^ z*ydbnz9nZ3D_#PuSQiummmG9(wCjrIXEdQ);zX#ep%b)f;Q#GX|HlvhJ_YyQhrKf` zH(OVDYjTiVKb)=ik(_`a7LiU`4Bhc$8f{1Ociq}IUq~0Z|MOk;RFxakDNGEp1QOUK zB#CGo!~UxqL$-mQES}Af!lhn_O}Wzd))&^{WEL3rvm&LRdNK_UtT8R_*Awyh{jWI$ znZGWgiB70+rZ)_JZ??URm&7@dK`HRTG&vlFH1?aer)Pc!Z`!drCxMU9*Sp%+Z&GoO zLW4#hK4iAsZvku$fDbp+*J^=!({m<1QBN7~RAACu!z#VS1ldq-m>VOaef37B46Rc6 zur*0;>vM;-QDHxzu=$H_h!b`SH8}O+y;_ftI)H)~P;~O%=f@XxRg? z$>Pkx!L|{w_xs)R?T=C4~duFb`Uva`WdI2WL?ZVy-%JD ze4m$58MscbylF`2;lw)Xx!vBfU7*ZAAkgkP?yn(DFN6|<%m;C`T?bdIzEj!Icm$2z zqGL%x;zB$r0yu}@xCC$jVGG?k)Kg3yD4=+m)=khR(Adp7?a+1>mD)uyHUEe)~qf&E|Lo|9%R6}be(YUO~rQN z)4CuD4=OMI{^IOODC8nYBJ2$hFHmJ7v7R4g2c0QPXkyoeB-r3s?@so(VyhsME^q`a z_xsq%U0h2_E^bCwUpTK8XyM(9uJG$)ZP?gKyta*7aqao7@`4xH3(`Y1-rjo*piWsa zXhU{ey9^LK?fph+Gmf-a!ijBd1a7%p>#t}O=o4fVJ0Wu!_6t^LL|3X#a|x;yHeDJ@ z12Qf}doI3!FBdckKGwMbm`{0I(k+i{m5f5W(J4_hSvD8wcMITF;>L|GNVNG-H8X1r zOzcRQbms4+BpcG#0Tiu01Rf78VlP!wt}d*h+56X@_IHH_w3Blu1>76qgQjE!)a?|T zY@{KumTMT<*-k-6hyVnVP~Xa)Oa>ORSq9!_GWgPu(yZFBHB2U<+#qgLXb*H%gvx*~ zAMKG$u_GhU9|+wJA=VQtO#wqvSE${a-4{*@h~;P271fDBhgAr34e&PesOlFU#>&D; z*N#ymS|LbVuI|==i#!vv`hY?z*)A@O;LH@WK1Pchd|!k4ZMQs_KyRP-s885i0yBoAO7@#nm#{8?6W zUt?uV3mG9WbYg2Hx`8y&-7U;C`gwujP3cn=yA;W9bzxbVWaNw04s^a+`ZhM}PQgS2 z2Oc9xAudxpTqpYdn0ev1(&9Wb5?2%tUk& z1ebOywNe_-zAuZ5FVI@w(jZqgO@VI754UzU4<1_4Y(?o84+an9yAu8Zd&NI-`wxiY zVE;ES`hO#imG!?xT(_EJ?7t9qTT34RKm`~tr9jsy0Eb1a*|c^N=bZ6Z5xHTyIrvOp zY=is9+m!up=7L3|J?yja(Ujeo``uyGuoW9p<1VdEHSNi&Jhx`Zq*8I?^0pKdf`~om zqyhqId`5LkV{iA`uj%vX7iSE1Ke_Z^v0UCrm{xVCs_@SCPQh8Q-gn-XHqx4~|3sXa z)@x58iB!KkpmNJ zV3J1G!yKFvVIN@f&I7#69BO7)k@-%`I~yje>(ljX2AJz!xb)65^QXd-r_NxK0$w`0 zHKu@^(>97UPK*o(J>{Mu7~`Miha|^S^_H=il>NDSt9V=*;Fx;o9wQ9Im24ZnPf9?| zy|N}h7?2hQ_?{JhEeWuJF$Vgu*-fZh=!>^_-} z`z@d7g$Bpy@} z@dEi>L=i|BSsn2L3~Y>JqhnG43*<5aStdKTXG945Cp0#cNvcjy))x<044E0~HNgHc zw3kl5K(5kV1!Va)yIZN631wKMH;#A>FHE>zZE0(=AB-}oaI={A>O^pRNOzBOOPd8d z2I5UemxJ?oEQSy1bR2zb#L6ruebd#^PZT7K-!t<*CjCWNs!SaokbfaOciGg=<# znVsNU0m?W;I0pn{CVxlQ=9$vmQoBlsaJ%_KhB}LPN~kNkY)QK{SUZuB;r3hf$lGqI z9W?Fiw$5n>4J87IfDG6Pryf5OSP*xTUp?9YbKbqm*m-YF0a@RS8)rAY7B5jt?FK(q zjv(EA{_LE^I=T?(L&rlWbW)ETyM;}n*CwN2Z~_s_#-u@nJO2sdxR+{ofQ>6D)HtEO z6`JqklJ|OmtpnQ$Cv*XXsCV@<>N;$=!!Dx2+(J$=7c*K^3jNf{MU{C2S@ADO5U5{p z|3(Z6C(aYdYT^fmHxo#L2Zd-uLX^TVCLi90Fon}|E{r=AYTQfLQ97q8NPBD&Cl^j+pUCBu+h3U@X1VP>>)T-agMTJ1` z++i~bA*+3*s}FV8tF6?mewnnSBwxO18L!d0B_7z?@fw&hHrFGxAte$}n&6wM?Vx?* zV=c(5Cf|*lV)b8ZrB_mSmlFl_fJ2)!$9g<{^^O+7B}nqvOm3ppIW$}i%s4|mzcQti z4q}$SY{P`!O%Hr%f+N+3jHGPs*N3`43OKt}xz;$jwPe4EZ$8nrA;H}fF~Qvj1Gqh3 zrlI$Z{$HhOWS9nD(h|d z@t>L`*u`~RJV+8>VTFdYf=HPX1oGB;;i`4ie4XRxU_kMN$?PP)!nS_}+mwSihY&f% zL$wjb(+;qEx-jdbgGaMdg3%HUDT~2Cdz~tnd9x{xLt%U2e$W95Jgb;J?WmWu@lp@t z;Y9>SoS^Fv#sey;GBy*re|(blbzpLXRA zefdSv9{_Xn3ci-|+46Li1Se9{^aeIxzwH_KGVMrIaIqPDh9%3k8B-WGWd+%WD!dI1hF7lu+ZnG^xv zmYa2&wg~$PaX!2-&|YXY7bd2TEOQZ5!^3{osIWF!;c{Xh7g9f~(OJjV54W;L+b<5u z_A7%wBU1Ad}MeW5TEsS6}pVj>=iAKD0Ar9U!tT%9X(6nKW{lo=Fe)RUXMXtW7M z%bIuJ!Q}%uTF+#S{TXi(vHo=}5jN6jHvg3@=~nudMs0O<^|Bh6F7YlrFI(SB5y7pR z)($*h9o)ErzV+s*lFj?|3h;xKh|LZP4r@DXsDqo}sE;BXb>5PDfj(g%19_K07oJUF z!Z(r(vqKo8$Q$B=UXsPz>GcIvz*QUjWhpYTU2Wtub>nM%i}Uo}=io(CQJCWOF;IcZ z+;fhJ61)^>L`|7&M`|OdYrQey)0Il&?2nWW2qnAMwt1&^($dWUksbdgp6%#Ai?S=Q z^E+>$yZ{~vv+EXaWlL;{>7<@9M@UshIF)S@t0+;Q(96e1W{Tn@92mTZ&(k9uS6U}n z*R@i5%~NtG_0)_9@Py!p^*N5`6yG|~heH%iUodK`udZaAp1_Ikw^VYJmCzE}{i7|~ za7J=wnRKj#@yu;c?YvvgYTn?{_A`0GT2bB6AuP8&b-&3j3)?OuLl_0kj=%+oTPC_k z6tEA$d1Wyd%m#!rhVEH1VmZ4Mitu*(m4Z$Q+%k@3yGp4m;Q{Jx}lj+Q`; zpPvw1bay2t;DpPS57B4N!@S4`B;< zE)KS!2S{zdqcS8|22g(6_7o5|vW|f$Mll^;?^G{0GsCdh5{Xq9U1O~n@>B}QckUk9 z?Blr0R(7ye=o-R6#U%`OAn`XUF}k3>S~(#swQ4V**g`{N?|IA>xd_1x z#)kxy64b(~LUf~(RA<|_PbJ>`DLB?k_-l>s;Km3X^`0msovD})a8|I8Zw9vkJ1|o? zh@R8#<1_!7xvTDi67%(5f&LIDBsRn_K(CuApBaW(?nglybON#_w~$#B3k7L2aKhy? zMhBX;VTFFlIj4N7f9^HbBJdI|u1KUL{YEPnd7q(6QNuQ~B5%F+>{aX|3RAFOjMy@AZnmRAF(c2aWuuyq4hzle%_V7z>D)6U<~J7Vede!7iF;F{>dU! z82&%%i>3(;q$swY8_6tOEVaY=wvMxiJghw?WU7DZxJ4nP?Pg~;3^xkpa=1((q5+y= zgjhqJCS%4=jmsonL6pVTcq$Sqcy1IeW4g<2R9UJPu==62z*N@G^n=eKRAz7Wm$`I9 zlMP?HYGK_a9II;CFE(n~4hNiB&lgm1|xY8>fLOTwyt(Qzw{k%E3!%;Oe zDo?#PI6Y&1f@G6>0kt~rz5WAY7+C%%Vi@V!|7+JYjWHQ>$a=-Ai!en3TX+9Pz;(Z~ zF)TA*0GBuRvOohhyh1F3!_}PS{^czm-*8;jsW$sEmnf_N7hyZme^3X3y1VVw+1cJ1 zJ52c4$Si@@87hnp;zPYKObYWw9D~|vaNn6)^RxDC=SpW_YLFG|lVPQg#dMsR4AJF! zYj+^s*SUGS?R`|EHJZ6btu2Zrv;Y=-^+P?eXckDd!&;teUARBwj18*elT`CX=e+4B`cykZ1GqQKM2xf1fk!2jQ;cuFy=I zxuIK)H$BV2aX^8 z1VDcd2v!B2X7jX{;1}J{i46Vhiao2-;FAI}(UGPwf~eF^96weeKx+5qMEytvQ+*v{ zl+9N9SgZ(Y35p_p@MEw%K;1U{fI?|@u}&G*l3xh~QVnHyRRN$+WQrXJRbZ_b#7UT6 zr3Mbc$;m$_H^la|&7@va;Ah>I46fWIFb~-hMq!Rl zC)E|%Ggje2;0G&-zmOUN$KTGu5~CpF2WiUnMyY&K-{_bVla^+~GM@6$- zD!bS-O>%h&v7cp@gqa&DHJXe~K-} z0tVLz^s=KR2Lz##dA!NW!foG1TSBI}ctZ~*K542Mq-t|`{4^+lGbjkyD7oT6w0&XrfKwH-sCRuV??=Dl3>T zT>Ub7Y$Ysk>r`1J9o$RDgT$qJwnG*mJ?CmD518sYMEbebL4)K8nBS|882!BI-EYe;eS=J6sa|YlSF_|qWyKbMoMT|R|i5koB&_t4ch>E zRnn6AqUU0O?BF^`qT=So88B~VkJ>Qa&?pHH7l09z$jyOrCT_%@=pi7Kn-Fi`K)AdZ z%au=|F!isB`Smi@+&WQsQRcb^L7`i7Y?zW6XgAA4kCv+TZ39;mBGv z_ka$}B2RfSdp_)qAh;eq(V??_ig8U_s`lkX@ab(7tgAD$O%aE*Kp}+W?X!Xh8~%CB z1t@6JuJZnyaPCc8VoMb^V-kCg zM|v0BJ??ea&4}$j?#UD)%qoF|QV(6(`VVC77acKuXst_tmOCmH-h_Dp@OW+{?tW`@+e) zGkgo0_y*rftuQ%xX(avmu3OvY8rVQ1_5#QfXAM0y{y+vvOgta44jDsHx~Ycld*XEL zceqK%S^^$dcCMOjS^6=WwEoZ#oS4Uw7MBf>*rvO00)_oSA3V#1B6Z)uPrXZItYq%- z_XNe;yIEW=!$?Qn@6gM}Mya*EjN4|00E>L>q>AvQs{s592V`4NsD5}@|fajo|5UJQzwnmE*%fhwT8 zsy?qS>nf`zM`zQ)y6DX0(3wUW&Saqv1Hxn-ZxEmpjR2ED(?4K1r%;_1dcK_uemy=c zAEe!fQ;q^c0YmXiP$W?@S;c+s4l`sAcv43!5ymXS~hZvFD{P$%~@_f6Ut=9wD(BU1cw7g7PSKr zl)u7?NI8X~wTtwS@m{^Uob2Y+mr_+v#tiO4RQIGvP7u6YvZUe2a=gODIqz4dooQBk zn!~|Xm#uzatnBEj;iM7gq~LO)F!=}Rjb9->=;3@XIp9G6(7xgI~Ul^Z$BBkk%2j{EJ)6TKUI>~>}E zm2}bbIht}9FJc~{Y43vX;e4y7)|}Nb^A&XOx>sZ+*dy`~Y8`12W0f4~kOg52X~xpE z?k_@NMos=PdMVsE7Yb)(RG`WiGW1W8rSshi)(+nu-)~IwXTB8=i{k2RT0M!|zABcX z^LU0dN}y(&1rv`7TE~6sNmxQn9{M=;fuIBs=G1*5DK06A620Eb151aqux8BqYPH$Pt(av;HO8T_{u?3xb1{n(&#_;^WD z6sB=C*996ol!3daadzZp_I3MFc7quC_9A8+hG*t_I!|rgOaq!T^gPob2d7S8Wox_; zVK0D%VTL6vyT+FIa28=jRh#oT4DLBp{6+u@~Oo$A$=IVwtawa6{um30n4H zK<3U={&)xN>mCJXbkW=-`^e|8*wWI~BsNgEyg6NV%7N$s-g-~bLkS|0WCwikAdKs% z2fBJkZSQh_dnS-%ce(JkG{ZKvRaJIPJU=ph{~c3mX)$(6az=|LDfHg09P8(o>C(@s zAbiazjePz!*3lSqU}w1~lQVYbGHl82n6AOXdabK)9gv`UIr4Q_2eV)sYK0Bie%Z5S#KiI&FY=g92<4E&`h*U) zx4P}QxJ@Duye{w5wsM&VkeE1r9GhX~XP>E=Tjx&Omb~H4+TOq7)x++uBz^Y>zXGI4 zf;YHnu`kwwGrdlX7SjOSPjv272dskPfTfy&8=?) zBCrCbD~@+8R+0?;+yAFM>TQ4{{kywStz0%xRL)E^ht$j3>-qi}5t`)2B-jQa~2JmxLwT6lZ_` zK51Q^o?N}RYJg5LPm)o|42KxR&nZrH#{?6{mR5N`qO)cA_Iy5_Ty1Roi%y3s03?Oo z|GhaY=77YgtG7}79KIHN0#QIyn>3Eu-P%#(p~*$<;Xp&$qXs4~*s03J@_cx_)!7;odZR{y>8aN65JwM@QFxDFa{miMifRZCEZx7%oB}xTW%24 z&Q0FUZg$hnmQD+`egVw+CI~Va1X_Z$`xwrI;Jz_OZccuwHD9$erzY-c7RN)|lP{&s z(vjpcsu^uyb24XDLil8KLO;-0u~iAiLCK3o^6_RLjL6VhF1CmLR%X)os=d9YEnA&L z_hXez{IX*zp~774PCYO8v#tQp(4oZ4lun%lS>l5k>{SdPZ0dld?Jv%s9_vQZ|Yj4{|JN96iY^yC5_<;4;FsP5PHTFShGK&a7n9EgYX<$n`8G&Vb`T^VDx z4EcEx_QyF$l+5=^9MuE3Jq-C-P5KZ7xoRaM8Er?l={UK9(t7Ks9W7Y@;g6J|-|D3x zrms{u+>D$kGVDTJDRp!M1ijoMNgV>i21pmFI&Bvpt61EVP4;V21xS1v0{X4-_8fPr z3Z^m4by76pT@QgGzt*YS8n;m?ke14s!bV3~tLR2>1YVS*ApfR^6x!X*6#xZbHj%yw zJBK#FE{)$@t3CH;OQ1@-NHu>^Aaw+h09#q;p&~MKKX)Hl65#QL&(H7`1`QCyY2CL` zADzhJjWK4-!ELGjM1H;^ZumhD;M|<6VT!;Ik=n>sGzrSUN;1Z_WvnMl1b|O$J8eJR zz}#nY2pWJFgN(K+(ULQZjJCvMv*^doVkX;Rl5;WDb|H#^(lkum#&$702wv)-pY_r) zDmd=0KW`GnBZSUln9i4>26nO)ZLGjqadV{xa6e8t z-+>Ell@C7D4Hk9$=3hvPL2fLVe|{kRxUBm=f1!P3R--LYtOco$SjLI5b_x+jNNq4b ziZ6+i+G%m?3sXF54aOkLMhusfz*`Dp?@Mgqn%P}IER$PM3kp9@hug}k5J74H z)HyLV16J6Flu%O9!!B0pg9q{8|ErhQ#{ns? z$2gDT@9+1j@8Ou$7KtA3uuE>|xU|_Mt)1qEK(=PAtJC*%1fzI*E5?3E`3DL04_m7N zLE6wj`ecXSwz=Wu3nie9llxt7VxAm7=R67#_NoZW(suSx=mu-%Y(CL~)D`#Cv`ft{ zAk3U3yq`|MVV%c)G*LzOJ-SVo?lpoW3oNN@X9v19wa4_Iq;!e$E*kk6_1R!cxpSEt z4CsSGG#Os-FuDc&^l*XjHrfU`?g(m)xQcXZ%M!^@y>kmL_-1E#M|lPFfCsJo;k<-z zU5O@}?_3Lilvhent<;{x=&7nlMyr3U%TRP;8JSP5vnzNr3>VAe(Ho@mRI8#A!RD=P zc>H8&Ox0)4*-^m!gkvP2C)ZiAhXAxCv_Z@&R||>aj^GfiD_me(Z=t_xJavqSy`3%= zl(nJbGD=vJE2x1_4^SG{X9VjTpq%(CIZ~E2;6T|EG6slCGEgKC>)w7su63B)(?Jk8 z-ZhaYGWduklLtl{xJ+C32Gu6mO~sf*VvTZvlS>0sfmU0e*glY0!vy&SvIWR(28oP` z5o+jJ1}K}$RKVNml!9vOs%NC7vhNo8jX*}u2OMqdn_gm5(F)taMHCEZH9cnj+@c^8 zmJj4?w{@W-(6wdsHASCJ-?2T4kz{DmQJ&H88?Dg)LE-Fr$UuRrJ z30QzqAL;;#lAoUJau4C5u%@}c9^8yPWdsJZr2O12{*Gz7Vc~=fiE&mWh*wQB+f*hP z3)?_k0Igw@`lzVQrqNzh+CUIqb(7t~0C{>B?P|wC3mhPA$b5Teum2X?Khm=gP z>b%#qW*d$(`$2stVHw=J9qMpOXgG=#OBYCdY_dcsLx}0a3a0fnlW~>Mnl#IK zv4Z>31JyOOMpcuilBsdBXR6}CR=F**m@eqiQX7Zf3Brb=I5UI*y!}=Q&{0rJd_N=K z&P6@bT3L2Kz@R5Cd=byZV#ZJ-=txiVsB;^8H7=*I06@NMyUk~4gA9Eo2a!d!4kdGR^nEaV?|Jthqt^x+rumm+KjRfA48OfTC1#o0T?_!6~UpKTle zwr$(CZQI?aZJVcU+qUgKZQI?aZOwTmlX)k3@66np`cO$#C6)bQr`A>bTI;t<*+2Eu z;cknpe{~CvokF0&2|WLMUFBs{s|8lrurQ9-Zak(}Ba>kn)UzmaFYe>GxA0xX8Dv23 z5hXO`@;1?;dK#i`QyvNJWsTQ75Q!f2voPPKijqP=SP6XYLJ`~JPB zERDLgLYph9d8|5kKr+0lDSD0YQ9y%Qk#;Mt&z3``w45?zy=}cUq~e$XF@GdI>RO@k?_Gd-yG^;xT?d@yk$#PC0Rh{AY}oFK=zEpR zs+Fi^u5XM$Yl+KeT{~Z(gfvc>0cBTqj{oW~f^o`=7qeW878ITU;a#aza}~hM;2VsX z-FtJVlIQ757Gb|u#@8vqeJ@hR#}UmhlHqzxmpNAwqbl4{?DK4A2AKE-?~UI;v%{4D z@Un#MYC-O>UjCL|dC{>*WpcD_Q|K1uy+#eNSoIhid-{y*oi`aUz1J&B^cg>Ljamgy zcI)KZ800G9GQSts&*uevG(^wxGW80-UQXN1mG~YBM)n)`gL->iPyqsKoZYZ8A8g;S=@!q z1st?cx>uvY#P?seEeC3ZFeuQJ$&b!tN&)Ul$ttKdAi9Q-)v(?MeZFk9!Ny$^5*rk2 zywh2RVPpU*of(-S8D`n}&jcWNVfp;nk;Xj}erALB(v?-UJZ|A^ZZ9TFyI|AXMUQ}i z>3yZp#!|Min(|h}Kgetx#W>x3VmaKlt4coZz=SU63M^Y}puZgq6QjP)p;wDm0Y!1+ROI_1+F<)WAg&bhWO*n48OV>fxXe@oyrW_#yP`+q*$j-ure~oJ^E@%xK zjy+;#g8`dYer-@cqnXM*G@_5xMO8wiNiXMl!U$`Yl^Yh3h?2-jx0KIL&+vP6BJeO5 z*y063o@MnqShT!`frBs1?+mp2MZyOq{!WxJ2MN@I&!AF7JQ+G@9LeCzaR;I@acav< zth@&i=>X>lir5qIn^02V#8lI)AF6LrPZO`VVM}$?r10A`=NHH}_ccbYNFSDl=Bq<)rhe}LZ?!a^*g!A`?n!IBJP^T zI#~Z}%V)*b^(#ibe`xn*_|;R;52QDiv4?*mjjhC$*no@eYgx2Rs^%3QT(S9$lEM`{ zCg2aMcf;7#afM2YM(56=rv%Td?eoR>qrb$J9ejq*ZDYH(-Y4jVM=JS$&`H++gaBds z?-3w18Zr+5z(W6$8c=)_g2lH5;jU{UZkx2N5jw1HURKfICJP8{UYx~8U>}$6uMu_? zzb=8iQTRSj4#)PV6T}C|1qbqe@235pvdIJ!(={c9O}zvnL0cq+y@wm2A{%Ig>kYw_ z>!aH>(5HBWl3FAl<$}Nu?ywe};pVr{iOnHw8|*qhaw-&}?1yv~K4=~fR^xlShX*H< z?L{=KOb1th(1wH_bwao-$cF*^R`Bkz3Su(aLtGdCi>M=#Vxlo2V-F;;vCmcYsg2!<9Lu)BQ)q+1|4NMXtg;>@jC*^j6-2U>OTxl)&;?0PWWcIqPfZNuY zHa5Su>B8_#LFSAbbkc&b!3Jh}CHxEuAnuuG~> z(1;krlgF}+1nWR`1EOJVx=*)JPZ6}*N;pcpD`gX>VW7HknoHeE6%ouU1&t=SPXyJf z6l4*v3mG-r{-{T=U3xJV)lrI}TbLEg-Gbiir>3Z-v_zP1@;KC{`R+JF)612KPtwje z!Bb!b*%l53q!+8V9ppsWE#ji770Uz(N_97{@Qko;>BtDItkloMT3^oZ{{oBAg)bGE z;34nPQq38s=X@#PYkIB?C7(a9mPdy1Zz7nO*>Kp=UE9UHeD(HBc})Wy=--aN!YNQV zf+~CC>+cL@MzLV5CG*D}jBt-{dDkyS--WMV)!^t9=eY`4!(B`+FqMs-tW(BG@o-b%Z>sG_J)e7#*@ihuBsCew-NPk8 zK!7Qgk_OK;Umh3;AykkD5s^b9 z61Z}9zn06%(?Ega0a+CGolqMijsINyA3RWnX^S1FNQ|&1b53O}KNFDYU+1)Opc0rQ z&;3|lar%pGNR^`F?vjwvx;7#KXzQuvgPFqTNgBdAu2jw#WFNCxYz<$}e^1Edz|SBI z*HA6_9(*}sO;+@ANL*;D`6102K+t>omu7weLSQB2zt%j4cu>r%d&#tdMx} z62wsS8EiC}BMc#Rw3zFre|32Ew)d_;ThV2~Va`|9ew-DDNlZ(Cm%0ao&(tjYlcm4B zg8n0T;iw%`gVMmGg*>gQ?7E1q>|yP3)#~hO6*6L3Sy#J>9+k z#9htlyW}P%3#V18j@5ZBLM@g%i(C%cdanS{o4GL5IP~|I#n*oa9s>Drf@Srlnrhec zDbc6zo7&XGetL9od>gj(ppow?{9f~1zu?H4PeW_}?Jm+<$-`&w2IEWrz$7~@k|5FL}1I%eJf>ci<*FLOd^Im%A4z^^iLOl(W zLCGS;d3#Ea=A2~4C^UhNYk0%}0m+%!kaOy|>_dzDAz z){uu?vpYXeJs8auyz&G(d0bTK_#U?{-r@_HMyNpg(?{5I(6H0OD%1m$VoggS!o$<-@4SWdqFf2gZ_ndle;3t1W@F4M6iOU%Riz3z+<@SORm3n_mT^KErBqBPg9>)aHUqN$A0mr48 z;;4ZQr(9fJe1$MEWIE?Kw>Ri)O4rmqWWwk;c$}W`43}=qh6@L_#IF!e8At2Z%GKG* z1HQGu7A{zisx|2?2x0u>}BFYwK5S6hlhJ}RKtDMS>E0#Vd#@g zr*I-b^kQJutlLlT?qSrc({Tv5B!T#_dq5w74K*4uYLhO557Q~G>bF{2dD;KUjDvj- z9^J@5_&@DULfDD$Kw|7b`Axt`HSj=V?2<*Z5CM;8CU!u{1ejCo5rySyO9%d>^xPt) zh<0GIrzZATeAwI3 zgkcQgkiv=#yuiUY>#%zg!2TsUfaZ-6!_UT{q?Jh z8$w@Tj)wTwsk2LWfdNin)%GDOfBg%vN9WD3co;ilGOYbRivC!!ryaf@{W2 zBycpj@kU`}dvqd~t)t*WN6c-93G}_ov$tPKjr-JwexU;6)=X`q%M~3lnD0mYts}k) z5BM#617Us`KYV&{8LL@sRRbz4yb|H!_Y(eqc8lQ+rV9&Y(( z&VTLHPi-_A^+Zue9ci?VL19P0- zSdb2ySSkB&8>d*b4a%-0lPA?-Lupzj%=U-~ERc0L zXkv081-cgprt{hnDwAfLU^x3(k`UKke(VQiB0%B2`$2~R-vjd>u^S(aY>78_Z;AVm z(&M79x}J+iLB3En82X6e+?^-;a~;UAJYme5Yus)!7mg3r&0O5ph}so3Dinc12oh!0 zjLu4T-{u%l?MtLTFl)Jj=$y37y2O&Vm%%|(y7@)KA$zM12Dk_&ES;K|HoOZ8kxV89 zzQ+ZaHJxG>gJQwyc0xWf-S*=UpY^Ve2?`mCN-TI9pv52<8ybqmu(!IP07PLu=ArHhh)rWy3J3#^Tykzn%jNaRqUU z5+S^7>VBR&r<;kzV7vE~AX9>M_J1!ySegExCCL99jfV68AB|>2ThC#e9mTh=FDQN! zLqF+33`8ifRcHgeQ*i#s$UT_1_rZIB)p^6dK~cOiw2t5u5(&>#q>{KwMc?{o&D zGEqqa2vxW&cu`0YR|SOis|u_#^(eNgUM;vyLKB*HVD@psZ^3!#@s1TxtPb)BY}Lm0 zm=IcYX=|8un4Q`LCWArRqf8gW(A-oa6Kv@~=2Bc3ijm?F;%o$2Fx&ab;esVqCg6=x zkDPoOBRq0g&2A$Qz2Oik*kR4^_5ITjDL2RYA%u~OKs|acxIWnV^u0RF$NG0zk6A^c zMRdT*Ir4X<01Bnu;sY+J+F2q_J=nt4AolQZsL`QzLw^4_RhJ`d z<{h;ff;M%?J{ej1FytcWkiz81KS$L7ItMJZeS28iwrtYvxS@&^7OG`}YS2o^G0LN= zlhH`=8y=-C9RZXeEgMFwVa6x2Pp%Dgdzej7f7l5_lSW+$oaV{4xuI}gMg9^8= zqrJVGAJ@S5^UbUC`))P*2S09CU;oRw)9W`<`uX);_~CB+ZqLNx$o}i%`IoB)XqxyM zGOW1cxE;1ijxa|M2hs;QuQwpBZt(77YBg>DmG|@d#r=m%tf_8r)qvpEK>$ux$y$q1 zGE&zXQe>L|^!NfpE z8P!npjo3-_&!yq~7n5p~WPTf_GblyNY4jIY27I>e8?lC?GEcANhYK?-XXK-Aw9tUm z>3uB!e$J^PQoC+cO>RM3%d9yg$1*?8qeZL6jTvyJ}GTpFb}Om3NaK; zFwsR-i>sKF!WwZT2g(C#R1w$n*)q%d7iuwV3lA{2c&j77&{v6~zj-ifzw~u?@BK&ab zlwt7h={)}O_PLhK;9wOmZr5miapVc|QTexV+iLh!yvB_JLFuz~=TrP5LtpR5^L;#{ z7N#dZ;1M*%r5Zlf`|U3bHBkTT!S8r}L#G=Hyrj0K(}ro18Irl8>BHFW8IznbH+-&{ z!|HeoU*5|@ErPjskCm||{@ka#Y6Wv&=F8t&dDHKvD-=!q8BY`cbIW<<#m%5L6XV%s zk<$r%#;iDrM|Z~aCqk$VTPn3(>;*^WV#E$VfsZ!uR~4>#22(436!5x;k~GV~6#$&L z6YELw3Yuvxp>m=B2^CZcu=`K#2E82Ji9T%h zRDdlJ)btj>8Rjp=%KwZ&c$($-0NGZ~s|5{t0bq0T@0kZcSyXfgyN0gNNHjJb2@bCm674C;Jnpq1Pt^i8x|rd3QO`mOoE>mXn3?1wVhjn36A ztNZf-wt?GXk0#$bXh}s{bwm5CKw?%6HS)>z6!-A9h$8`&v%O|^G;RQ)l$(a%kj1d_ z&7zQM#FRyOfDyo3gd52_vYzdzv!pVlToiBsS<>l>RnRh{~tDxnY~kcCZC|6Q75 z)@X>E3dSTj#F*`aGw}-Z=|lNCmmeZ*dzHILJfA3rCs|125nk=0S$keJpZ(34e?L2G z0444|++BK=Dif>O;i0pBCo2=HBG|RBeY}1T1~o6=i%-Y+<={iDK!&=Q z6_akTXp?#7b?cnHpGGKnCZ0!jk9X%_*sO0tiJXYjyuAszj49LL_*FPbcRFOhbB!jl z1n>y7`-VAffPz);*xrd7?JEBp24(QV+@C&O57;IGmxb@?-Z!8IXZ=J9?i+|Vz-f)y z5Az`(>6O&CNJ+UJt$ z2#)e{9-~KH!2d4P|C3<+UvTyRE2_`T$o^j=Fh{U#95%=Ay8OYN&}-2QYuq|~@U780 zo3Y+Ad-2eK-sft|~9Qkp!LVbob0$V>P*YN5p-<>m635wxC$@*sOYgP&vF55>vqQ z4WmpS2w}kO4m$zR&NfWp?f7lvF^S_3$%Hc^YJdL{AW4|6Zb}bBGv9l{tsPolDdXI^ z*gH&dOO;?2_!hMCcvVDH>CWhuKOKW0_U7668SYE49TC%G=3^1>|B@690}~)z`13bW zaKAitO2av2*<+BnHBI5WLX>Fa1BPI!0Z)|Lh>ATSsf=NXP~&b^c%zGDZJI6U3vZyf zgM`cBFBI~KSmsdA%KI+n)!{?BXKVR^_rhuqB%JOTZ(k;i9eFTO6-#k)@GOYI!tOOzBYjS8g;2?xgZ{vyj#gIUhr^+uK7o>u(u+$l47L>QmrOaD-91t@<+Y zzo9j#4Ouo4qk_8q7*7(~kmO~m>FmXgrb z&!1~rczbvr%fLr|aO~-TmN*P7Ub%5rB?X?-9tmtiz#z^w>exQa;wRH=8Dp%Ybkb90K6>DI5Od0M%0JVV_V&`T1smv-2;|$_1sm|asCBJQ5BbmE zR)wSQ751X?>{jISy2;9X8_U4MEZCX9&f~2m6l5f0v*25fJVTEl5;~9rr+xs;tG1jR z(%SyRV~XD$n1Yv1D54a%XQX-Iq@mMs4@C{lT###IBxtoI?tF%jO}({E&Gy9#qi-6f z&?G_g4Z1*BN`V4sGyl+FD8kG>w6*Hnqtf&-J?24sw9dQOf8KxwB9C%k*zV*y?~(K3 zPWrx0Tv@tu<4cP+k2gnrTwBunaB6NtGvmIwbjnB2{VCnmo>>LA_xGw;xrKIsp$WlI z8E)m#3Wf+61$1aN(wdHaM5CVaWq_f7SYz1cEh>-F_$eLsq)aH9=Ue7cJ8m6WEqG^T z=QjZao>#UMWv~U`1`rxu4X=?_L%1NYXz_`QyceOV?uu>+@h<~-HEOEuk>~BgT;r=* zXji(-pJhs6etNLtRC_2H90e+0rjo~-P0VUM@f;EvjyysH zXoz5sL0bjwK!2AavIO){waIOm7E%l#N)p;nR(Jbfq!~wQj!9*ovzDMpb&gJ-LW;0{ z#RL7~GrjUT^V~$YQhA9aKj=jn%B7nEQUF}xtq-Ok9m>+{VfT-SU>Nz2m#DSgXWd>tESPx zj9pyL4ge9FoG`PhuTU6J4Zlh7aJ*i|;=@xuvY|kZ5Iz>rxxy{*af{P}q6tP04O!xo zsN*tacI(zr9z5O2=lx>*A?lar)JccsAr^VVJQbKU20yg#K)*;czTahmi*lXUZlEfn z)#9&6iodp(UP?sTWzFd(jk?T5J;^((y#0m+$mtx0E>aQI$jg20FQb4k%5&Lv?L>R( zlx{0kd|x^J=OTiMtV3^3<|CxKsnxs@`_uFEt|-`|=4&tr&UVyQErogozZ3v`m~P*G z`P5!{KoLxRj&~h8{H4F!1o>faHz((h;cal~fHB6lrN0D<8C3!7iYYY8s#!f?_TF%I z@|DFgI+vRW0{hBvCH1rMA8HKt|0kOE|Hc9R_w0mY&3}F)PPqT^8~p-30BWJ}-wf{x z*B1!8jxt&;^=1wtZK)y=F6F@*9AIHI39UT`Abr9 zRL8HpC!Q7Nn$(S__>^S|7NiNJ$2Ip4WSvbf**%kkMrLptF$wb&u<7rqO0LkzH71*e zS~1Z62Wu(XYiT5UJy5<&|LKeRK`DH`2N@y>-J`>j&6_z4vn13 zXbFO>{R*l?m1bRDzOt%RqFN78<$~1>u<1I17Mj$}*2GgP@_wTZzE-?&`C?}|ii5T}!0P02a71d8)4B4wCI^$$U#@p=bOH~QY6;e0#XjTl-Zdfvn|V+tjXVYtqF z-zTPAiQ+60h5CmHX&&8ABLtIMud*`G8O?VjbCH)R*F_gEW6%ypk%u}DZ~mgrK!H4M z&icY_r6r*BgyB4jTg1rqm`ShQ0AjaW$Q09nPU%Rq7x|Uhps7x|3KHmhBl9i`bjRQ3 zqQuY~?hx&H$kCI(rK#(A6TQGLajs+I8_5cHR7HYEhhHlaYF0|;%9bs4b3(QC+kiy- z!KCkSH=}zBX4PvqyRUh_Awv!Ny@(DeT2H~YO_<2ygcRRe5slsJpifS(BM3`&d>aUT zBd&q)u}~5D3kf6aUeIB_v3YFs_Q8?zqy?$p^NjifN|Bm$0UPw)I>CfAU`NN*Tqq{J zc-{;zTg%tm+diT(mm9sPz3hX4x5m9_p%A^i-7UTATB>Za#$eK*MImM9gMGW6$|aSx zzUJ-OiDjRA--7^tbIz{kAsJjt0bUY13WHu|l3=m+{noVM(IR6yc!EZQBa->S_N>pZ ztIJxiY@;q9H$>mDTjE^=;-C7l^NlQhzuTe#Hw@;IMXfVoGs^|^&dz)MR8A|thk^?S z>`O>#jq~m*Hx{R1xB?q*rCV&4@Mkpu!d4w->&}UOs2{e|cG3Z6L9x%JR?-^QQXI z%97TT3i^#g1P~<1k&ev5BJ;-*Sj>D*_|P*p#? zYwlBh#x-DY9h=-$6N-R8mShb-hQPgaS9o=c**fkZvbs{48q9nrS!vEnx1*hE+^e(!3FCU2xeixVOaNa|isv(XyIVxiBjjI@lFXAO}ulutGRtiGQ+VL&DSta2D9T{PoY?LII#H?xph6(=X_B z=cy`pCR}uvvKSEIz{SGkcjuDtjP@u%vS-+ME@B25q_r>x{G{aqK`Ftb7^!aH-ir;= z==p+fBR3qBsb$*E8tkayopOxy#W0Hbtb_g8)-G}_n&_64Xw&R?mza0 z&+RDNzf1pu>lOGpu(t~{P%Yo!^rA7;Eyh3Ld|`A~`7c2@objr`#c`^ogckk8QGsXr zCH%-^KfX_t6JA%Ap|3~AO`zszC`bp|9Zd9cdpOTbji@Yptv2yMY&~p#R4K`CgS~h* z@D%&-8@K9B^8bQ6s`UrHkYb1U4>HE_pJa@S>%X?m9%JhLYpY-J^$D*&&)(}*M=iNK zcuQ`YuF_q0j@l7)>MNvLNpNUAigs9ie*pz0lS!N(JUc0XNdXOG2nF;ux%r%?{XTv8 zU4|iaW~vW(Sj(uxJ^9c_8kI-+&_{E$=>5gtNt^AL`Sbor4Cj?D1n}|$vSpooVAhEE zb%3+d-xklua>kOohmD-WrgGACxh=kQo$&7H<2CTHrFk)}c`-tDhiuRmZt>zOZOkCk zk@9HEZIW@b@+M9T4+X+%CiJ`8>Rt!rI7*z!Eb+q?mXp#_f8m1J;bHMS=3}deYSTt! z`;TU%E|z1YYGrau;hX8Ca$D%gTs@0WhfpJyi9SG#)JQ+rkXLv~GOviK2NWF=A_EK0 zg7(n^1(l#fQ6hsZg1ZUKsFee@7N?0Y!hGRSIPzpFSt6gUJlsu)*(8lHQWtz0s?7mR zbP~PB;Q_)?dm(1s$QVw5$Y#D8X*2c2lkD;-9%~ZUw8tsA#Us6agl*g)|CLcrZ<)OW z0Npz2r3Em=W!Zzd{17@{$5?(*_S7l1mlL&#J+==6)o`gw)T+H zMo6b}CJPWNd+Gm{Xy7%-0vGmz&yJ;JMF8wYx5*R<+p(?=;t2uV#uUFtcyc!=27DH< z<=93s)plliURq5Z1i%&mVyPr{NHvDO!w_ruux2C2Nv~dT!b$=#t|X22lsOvb1eHRO zw6R`_>7&*&>gxA(bw5I}A`{??`>aL34ot+uu(mHFAVOBfY(+wcMnCr#9Xfz26Zql< zQC=B9W^d>QI{r}a>4p=7v`FO#N_FJ`jd`ReR|CyB+VkfxUitU92j`qgF zEJfC`5Z2*NHSA6&FYtErbp4AwTa~)P!L$4)3IRuRK?4|A3EGFos*P0w&-7gDh+<=g za0>s})(Sb(1vad<5F3Dd#^NXqzZ+jLA+DO2M8>YaeZ6hwrB zue!P`P{L?L9!r+r5W&S=yudb-(?5kI8mNH3&=>lA!W@(j-Zfn-O{(*OEylQE{{iN#ChO7leu@bjp441z{1IhhO5c9w3w;4 zl4X{@ASklkZ%;(nMp!dWr-~0}aVLn8oeyteM+8DIM(+JL%q1xO}e(yQ4=}B%c)Fi^vF2WIrre<9e9x z^RUDEVCPOqo++BqUKQ1-5^=CStb2(3H=ozb%RV9Sr~2auB(i1T+R2yH25`hz#)<-g z^pO~5(3X%HzsZI!ee^Gf=lhmZ?~i=^?&qL`AAG`H^SpVXx>*n98@S$HC)`u(p{e>| z8<#p3%5f+{&~id3Esu3`K0O`6mIWe)`nc-7ahbzeJiKgI@Za#^egh+itIk#H>7NaX z<0gmnU0S0R#BH~G`IYZRlPnd*&l?_*B$H)~k%&9@pjBE<(gAdLl^&a*#p`cmE$fY8kSkv(3b>qAs89<(_S`-hxw_&M0|KFm4>i5Krdv$)bQtdgvd9BjXjQ}t1o)jwe=Lylje~aIn1=uG9{@l7&h`^# zB{E`YpxI7lTZ-sZ55%)nEwE=YbttCRvG)39AWW%eRuvIlF%XJQ=I|mMOKGAe*foNM zCJ_XrH!(8*B-`Qek?&*2u0sXgPQSVursyvZEF?!apnAE50cdz1Jn&(tHm?d5BR}HT ze7C<7SFIt<^$YgbUE>4Vr&&xpNl5}QYgX=#k(WLo1<$fN%>ks<&AD0=;V#K1fs;xJ z^ncN4x=iNSMU0r!;8@qA;%TZkrf}_kavJs3hzBdN>uuDp2l1ah{|J{sdV;^#)-n~= zF@^xlSIez?k19}ycF(%o$t|aRz}59t)_+>(p*cClCEcgCd^ zkI3bd;hw*!gaa!jC&SHFrG^q#k53=yYM@8r(+wOpnG7b}J*j?nPLC%MLhE;KZ!5Pg za(vi23X+eXtKe^PcY1S@A^7GnYMINhqWO1vzMhPf**9BVoz9Q?A|=AIN~S9lKTp0E zo1d*UI2ykutx;Mi6vHFhscpnF0tOz4B}jp%w%KSjG{Y%xXp;XJE`9H-KO<5O3Gmz!#>+c1zqM#i)hA=XFRSYhY?)(s$wD(6Pr}#Cosubd zw*Iy#F{+p=(4M14-#mr^?H{w}!ujdNorV!c(&xjBTYt-50#fLf~2;sD_8 z6%Zang!pA>6@oC01%jk}1{6Kdls1pBa*X&&nUN{x=IU8`U(O+qCbk9{1%oE72U~S$ z)4%3g(`};eUCA(#dtQTLQ=(mL5R?c*qVy(Ilbw8p)lE;<1+T(VqSSrNM1!4i-3RAQ zF=&w<1qm%X^2;$)8dCO6i5tj75;F4wOwi?2LVwq!34|aX6mgON_D*fj1W%7pbFIvM?Q3C8XKdLjD+}zvg?%uGUSF3r@bP*C1sm} zDkU3BTJ!J%bQool8kZKTgdHv=Ru~kHg*87+81yPFG^{JkGZ4DEkiXKK7=IHrTq6;h zv(Ct;?Ox=v_E^fF-8dBc7F%m2VoKsu!X1UNL1(ku0DREPE1y5G-E~MufRI^tIpyjQ z2Flj-mx_}w0HGN}Ib)7f&wzms{wsc_m+BqD7UAB{knjew*9uUZF@E^DC^gt%=@A4D zIo8`;0K&~Sj)yIrZC4-%AuC)?i9=^(%nW?#A2&bmG8;4=4Hwbv2!>o8OBnP9gdBk^ z+K)>Z1T7L$)yTUFe;G^rH!N|`Sm=_XC3qpL-_p(Rd^it2_o6>99@o_ozkgB5id%Vt zEX*n0s1{q0zjB{ ziJ1VcuSU7<#*-W$nPj*YA34D`@FtVbWiOc7qfm2+{SYoth-ezBv|VhJt*K`u1y8+B zS`V(RKe~XZ%$*{E8s3ROaO*D42L96~*RzXo^URmRQLlEZ_(tcB9|d|@sd9suDbFuA z;*KkPE0%gh@ctNlcwXg@c-uI!1kV^528FtW7UeEMtiO7hp%O2^dZMkYbv$vFPT%!k z=REI9gDOv@1{S{a*d}F04%}!;xC2}5kSu2FUp-u=f|$F+I)$MT4_VT6(MF>R!qDKS zF8%Ss_g%>zOzx#*7a-r_*M*Zr{9eq>(#k9pXbf5vsSuFWUDLCx zzjq5Zj4h5%BQI=y`2OH;E=#TYz5`ar zWX}r_-9?}1`_4}x>Q7EtrJMd?MfM}d@47X2qhtVBWD0v=2^_{A3&Q2(Xkzk7rE@Dq zUq93?1ne9?K)<4Fs{VuMaQ&xj3g^E~!2U~*cg_Fe(Fy@?_G=SWxCi1VvFngR!Ju6} zHtL}@%54gpP81y3KmU*F(0Ybmcb<)qh8OMMW>L^}=TLMTP~4>bZfg@dGxGyft?AhF zQH2nMG^7m=#)BNwaqN7_jy{ARm$kJS%^$)YEXDtUIzpQBRX0(f<^YY96I_I^1xa9JQ`3>^@<<%x)rAS0-HtEKi`(~yE)Q}`vtnZDkHr= zR`7_D_)Z*au!K;X49BnLmn!XEl6N_Dw{-C)EEYs|+YHS0K$vmff!2gmif%XbJ63`W|gTMjJe5<*a{mxKb)+l~)(rp#|bC zTCL$(+i@%R8J=t!Y7il^=hQaZb9d)0bQ|Yz)XYVi?UlklGNA{%Jk0d6zRAbGpST#{ znFkfr<+=b33StsFFb*sE3+%+~>(pf`d3AAguCE?L*yBPoeME+f`wyvvFgT= z+0MR!2HZF1L$m%OR(lsQvKa5-$%e%iBKkSYR9 zhK1b!fa(p%G#)%sgm*|=31Y1%blepnv4}#q>LZxH>P5NQH0O)toLRL_a7uaJ_ zg~nSYB~d1_cS_XyVXx-lT?JSUs{&{A9X~8Y;Y3xA`9@DarhHR|kD+jbS#A?7p{vSe zY38gMw~eO`iQq0Q+_V_w(N)nG9P@2NV>Xmv+;8ddQh5?!51R3Z;|Y2mO~c+s)&Wp0 z5OFIpM{Dj~`A5U1sZ&8CF+8Q;amrDD-Xp;&xperL&|{!B(o#?JA7Emk-3|Us^shIu zK4fR6T6EyaQ>$@$sV&gfMnJkMSw%m6;-^! z%YX2@`_Ce7et{yFzRA)%eRoE2kv&FD{8o5FhK{8dlA=X zucM3P6?hx1PM8@^+Fo{FfW2Q(T-+0`y;os5>X`M`p+B75XRo1!B^%@7w795#ybQMA? z7z#pLrJpN#SKM{h?T~S|=pIlP_-Na==s{9msdxn;MxECAQIexO`KcWkxT)JKx2NCK zT(s!XyMu$|)y8RR@7gVVE84p5e0Rz4+kum#Pba649)lZg$a-vl2*>xdFby~ZY;0C#DXtA^ZxNJ2qKEt$0wMxIL+3so)NRvUmD zN_ir1X>430GUFtvcls`E+&|F>85`ttHbl`KJbD5GkVWl~**GA=BcbkWnnQL)@tiNm76}(zhpa!xnB=o?%GJ$+{>*4y4P8Ce3L}Dpr`k@0@pPghdl}_*wvxivU)18F zg8M~nH|>k-D7B0rUoa@NwwUn;aio^eYr&OCS%07L-Ti>C9^j9l*N20!fJPs@ia}#W`a@VW2hBl zndD3dU$LYmt`b=!h^5vZ%@I^Oo3ki{QB7txkZ!__9ZB{ytZeelxadACz)RJQ@jPqd zDy#qC^|aSyR4Yxk(&xt|Xxp&&8MM~}XEaw@-fz|$9kFXvn%KUU(qg9`DnI0&qx@8* z*yB=+Qc*&~Lkqb$0H<7`5YnvD#mXr8sc`6T?*v?8pqqTnR5}^c_iFKh__Jp$l?imk zsz6sPjFuONi2CC#q{I62m!O)}=(Ho`TBl14G{Vza&mVQPzdE&hHU5P9$RXNY@*Hw^ z#?1I=aracm_+s7E*SNn6_A-ES9>^ZKkL88=^u<=~RBOEI3PsDCDjiVH+*O!13Q@`D zEwHJ(H?WQ!CXozu&ynyyxdBdlq4lm+kbaG)=Zik) zOZJ|yugS$ z=la5VV`sXeflUM7WTChmiS$!o_B26Q1mLSfW%@XJ`KabhOv1xxf@Wyo+ooZ@41^gE zno}sLO-Zfs!!w#h&p8*~aa}kY)}dPDPBS-)JP(nQ7K&C}QxD@qzn>HY5aGk5*CBwP zIf@m!k;%orPSXq+h|x7((u}CvnY3LAZX!gR>ErRq3Pw*Wv;>pHIm5Q_AmT02bzxiV zI+X?!5&wmM;2E2M`m?u#xD2JYj$X@#=(GoA5^4?_nNAk7Y>e1q2R3H!eLJn%>qcdH zW~{-4bn#+fs$*C&%|3$;9!~%jvUvqD*|)In{Hn@Q;g!6n3Gq?P93W{1RG|ieDR58# zWrGhRBSo+_Tdq53RCkh4lrIt&B#7&a7PfPk@1VXZq?eRi2~S*m#-||)yd$DpFJ$4? zD5I8ctDF*^PV#>+_K(e-eqXdV8rvP)wr$(CZQC|GPCB-2+qV6Uoph4Zcb(dGpQ`<< zQ~wumRjupE9Ba)v$7k4xaDkwmK&8^%F@|t8W+FXiLds?O(C9*MI8H!OVigRU2BMJ_ zUDsKtte~BJ;(@i<{r#BljCcG*1Kz#;)fwHbL1ReL9vUNhru{X%GVHz25&*G=dv-8n z3DPoq6D<;e6dM+S?xZq!QbM^Ty119Or`oYF^~Z0k%HUn&L>;3mj@e51Me4Hu-7mA7 z3axqu_L|%EyaFYkIb>08qkE90$ur0Llun%GT$yCnRxdYc%E^ip;aAVj1une=c)ZHP zHKBG8KLZ%=pE+3hF4ft3$?HB{nCF3TWfWTYgUj3IHFV&e;3Z$bcpi*_k``lqR}T_RZLA`i@FlDE@Z+5g_)d9Hm}wAa z84#PAFM-1WRj=e8X*W&Yb##@Gna^z2`(caX7T$jQlX2mfL)Sbx-l?eu{sAsgC>Hz? zSMwuf0lxegzkXtT$B^o7Puw&3gr0Wm99izrwF?0HnCfra z9eT{`C%7}qUkGb|c}L4O&Mqd=BbzRl-R%nSTy3BD4YYCYUQ!qQwvO-Ak^!?yh`rhP zV5p%44I)u%YrF8BxLcIB&ARHd1SPM}hk$_BW4F2gTMXD4|6@UxiIeqzp8AboPC0L} z-`&*h7qTRo6K6R@XP)j4J5ki6v_?5gGvh~wlEzahgBNn%ta%UsiAgu-$|Lqb?e}^# zbZL&etj3@Hb$+pSa`#6Qmp?U^O5}`5JMziH5sykC&%=obYNE`U`xU_d)%o`Pmm0<= z)d;11!56_f^7Q%Smf%<&koYjo@-SByJf8_FgF-Y#8%unc2~IU>G}}$xwxk8{O3AnA z?u8h~V0h7P*im~>w!B|zrOIPzgtSekOMEX!S)TEon>maPi|*`5+Vc?Uz;Jsk&}=@W z_$$;pRvf%oRtz!`wJc$)m+t1nVtq$YsnrWYJIMhiUcXDZ+szuCI4pn&&&`Rbw3ULb zki)g=>3Gs-rTQSbK%*x8%;buKI??|5ps)dyP{OT7sdEs-Jn5~LiIZ~pKC`M7Uo-LaujBeZ4H2SXk$VtL9 zl-KSNX4`RorOal;;N`}Ep`*kOdsLf4v|*T<$=hxR^=@~GWp`%Vp}Rt(VZfr`9|4Of zfA7S|dbGM1M=e89abQfK&gw8|$h%rKEyl{7iSECLUPAJgQyMtUyOO8nBkBll&?e!_ z*`vxF-SqHFy=joskv1oUxg-fDI@yTIsOE+uOW29OA@IRS17jIz8mi&itG&!@j2>-a zpsVZK^Oy|l${aVzE4bNgrO2QAs5fnF5D#V8GK)!@NM@(M{#qG7Gd zuz3d^%!ptwg}_#3u!$*FoOT)!>w_2r^F1V1w)qujYqnbYM4SSZgwD++z98(HdhW`z z4*Rc9f9I-h^@xWNJ>8RW=bI%;)6kLvs|`XmVsM10gQR-;f`U-9?`~RxWX7Qe+fd2H z5+aHS1Oh@ySkO~9qm4#=o9Y~NV7_Akr=XGukb!u%=$?Yql($6FmOe%HShm3kT_E9T zrG!)3;mRO`oqJ62i#WX`L(5#YTR@~A+N;XYFgS})`t|*kT7Gq9X$c<%yOqP@WX>X@ z_WS{VycKn@RU#ePs0|^BJZE{x#GFK1QQvEVmXC1&{C9)z;MsJhlpSuvKKn@O{xV!b zgxtHNd4hUjkDd?iBX^w*)2Yyq%Hgdh`Y%-xx(#F?ho2t0$(Th(OI=5Sm-B);;(KXo zBV8p#3)0Kil}b8Rq^xc${~)jcpg^9PRolQc@yc?>;n&zQaT`qWoM3M{w2R5$qMMws z<=h6K?nDv@*4!XIW@R`|%H>&CAd}OpI5GN@(Wfc%I!x1;0yA&tG$fi%Z6GkGFeGNA z5bnbPZy4rRI~`>!Arj#totu*I9PNY)J`6T|kju=aG$Pr_xdZ$K?Bv{PNL;g(ZGB## z`VNpS`~*41=}20v*0GKblAxlicsO=Q#K@AQ-jL?BXqIBkhiF{$2V-`9FPmtrcKBQJ zPJS~Z>^sB3%mYu9=^av*oP6zu^dgs;iyW35!Uz}nzKoPGNi2LatkA1bQtR7}hwr85 zXG?(~!qy|G!ZGBWaz9aH33pr=aj)UFQd;{P)rxD8@%5IsyNel0iQ2541SMgRvxo4T zFW{k-k>@cdgho((njwtb^ew#p4~!C)D+x}lUdlY~XV@^Zw%sAW!Yv7fpCA>)#uO4f zer$*~&#eAzqWagju9P75*e@yg(Q@Xogd1*g&Q*e1O~S}a1>t$P17MLEB&m3Am*3>R z5+-T@of%OamPVtXI5U{mOvWJTv|vpXY+7h%%bPc;nVy6jZ(e`A8{=lukk)@ZXE`%w zXnDr=2j1jqo;tcu%Zj#b`=vzk{d9WPJ-BG}ah;nyt56v25d3M;z{7Szb1O>EO>oqm zzd-w=kU(UQ=6V?cDh9&wpGu#>!68-NDt}Rv!y~M+eD6S?4`6cH&&m`BfU?l!B_sr* zcNhV?v*o8FF&H-vZY~-I9M3*apGiWCufP7e-r6mG=&46tN$nHOkElcawZ)D{t$v(t z^S)13X(lNrwn_VgrMH*SQD3?V7)oCC7Qhbn_0R{iqt@zWXx0~@;L5+Bmm^%LK?pN6 z%@K{>Tfz%;)zMB3alKR8Hs{+CNlYq?lHsS6&i}r73F$W5s7sX3Za1v-0yF)`e2tlv^M8MiY00E)wIlz-@SKxZPX2-J?Wn+Y@5x&( z)s>&bqKMc@g%vR(T}=)Z4#uDR{%|eA@wMbU!qRX?4iYZ{X6^MC8aQo-W)JXsUV5(L z&~R#|`b!MIH1m8d4i-c(azQQwDiAd|^KA53_4;zw=cgLSd;9J8wZ@^L#CwzgdSJl? z)fD?jFkJ&U#$%5|m2=qk+rgFa)&>b_;yO3 zG>f_#r^`eO4XdR++T{FLM%?XMcgfB!4sR$eP!T&#qIX?MG48L5A*c4 zO5k?`mUl=*(DhB&T?}cV9mirSg`pG(It+XsI9=DSZ~5x=g8ggU7RLgjTG3|jqTSE< za3vpNcvf*J>-}HYYx=s-l`f190#oqoRs7ctjfWRf9h9f&z<}RsKs8(P9LvIHl91&unpHCD zuu@x{PL#^+4eEHf=AIw>gwmhl@ZGpPam*B7x#ts0(0pF4q6+ceyH!MpU8UXeACZJKB<{fhpOQc`Y*55~2B^f9eRN80m1mJV0VKK?+ia zaiZ+H$Z~H?h`McTn!Erzmz}F!jQ2Nh#SJY1)`eaL4QJ;op25{VJ*|)aocV4R%fLzq zIQ?|bm7l?lLK<&G2~v@Wfcr}I343u$NM4Gr#B`#;v+FopnU+44m3y!$TZ6#(oL0)d z^UJ&U+NxOZpd|`5GNJ;J+y=7s$FN;3w;4lRlt9Jj;dyE|!q5mqpGvYyr(|&ntoQ|x zaD_$+?IIp?R*DH15@Jn)Zi90Hv#%x-1eaA@R_&cX1@#4Zpkb{*aSIcVo@2)oMtSCCn3wnfg<}H{9Bm_PyS!_9ydo3z~76dDnrdsl61Q0*4LbI@@mwbr4K?!YvE4xFU+h=5a>dEF~=zJWMibwuvax`GaFuz{_0IH1udZv5uu*7$eeouFj@oT>|-p^)~ZrbDmAyS5`G zk^qSks)wde($^Hu-aF{?50G6{_RGo&xL*rfqCvkQ?2LrubZwcOwkh22+$Xf=v_^TZ zr06FQIe!J+HJELbM_B<`GemyTobS7;q57IDLAm}d$tppH#J|0Wp>U+rktKS%GX`Ol zFnDjpT1-!>QsEPv?PSv)4L8y~uf-<2Se1ol;oI+$iNh({+3?Agn9QSw zCme_(ZKKcB)i>-I1%Y8jH{vz1e^vXz(!^7LceF;h&lTzACQ z+7oA_#}$w1P%>^yxlWqQ^HYD*B20&AfI>&^ABNMLx)28#29tpOB9*6Njhjyf*>QKP z*4Fx!$;;S^ZVv3L1`8d{J5N}H%R{x$ji4j-S*mPfLo){Z(?0jbIb$S!2ub{f|MUBE zK46+pzc9t1V}$gji8#~X$o0>gQpqU#*4v3MqqF}!xx)YyShlg&s7Z|j>E4hKhhfdJ z;)@l4LaKFnMN^5__p*RKXpsHF`z-A0$yK;CC-G4Wj!&QEC*Pjp@v&U9D^H@D^D`YS z0XlJD*TZJPIFh$^-_XOC>5)ym%M<%;IGCxTlq~>n z^g%~DPJ+ze=M(03F`OqvQ&(=Nt0i`2v3q6+$(w3@}owbh$PXe2@q7? zynnp&;HTkRkkmF1zixwoC7Ky|DeUklmKdYU6{8?n{mw2sQP~kdkR#)FeUl zcMRLUW%rTo$-h}kWvS}XHvnr)h?QD-{o4*6Qpt5Czsa(W(QzT!By4w{TUa1e&4&P1 zm>c0iV9hTCZ3m zj~Z6X{K|s(sz1rx^dr$1LD+H&$vPZc+QzIK`6Vw;d>*Ks=TuX(F4Jyt7nT7v4bD~tDDc8kCg!68}{0||GEhN|3XFnkB^AyAI1$_|jcGTUte>j1RvS4y@ zr|0_q-sh!y(vj5_jAHEXP^qw3V3Rs4&UAlaWLyQau1*)eoYD*GQE)XEJkXhbG8D7a^_p>K@Y9v&N z)(814&HyN}CZ6%#7`+iI}<)Wj5pgn#h z%yR8uAC7{_C{B6+5oH%PqOqsi4dP~}{}qFPc;jygM%uU2MPP10Dpc6|Ny@U>0?>1q z9eRbry?8~yJ-m2pCvw-^CN}YSa~h5#p*%vs^@lhlb&^0Bbc*L%jX<)Io{2($%sCq2 zTX@B+bMsM<_0@9l1bqst*!hY=4~uIwFDA0JF+A=$Hw#d-4nEo{uKFlw;@y3{xf<{vOF6nsW>=G)N9OuzA zvc)cNPOqI~P?~XeD2f@33SRVV$5iB5`|FWEwHhU!W#>ioDu2iLsp9>m!-hK=?{|I* zp4!Y?PYgcQzs9(!cQGOQb5=IN&F7QT{m~S^twVGk;%CMXQ9i8oGiS>dS6z=;7rC9& z!csI@q`<<81w^6%DjMQ>T9RULJ0rh_j)o8UIi<-AqwYm0K+{xE>hg4op27#<%jL1j z)u|g7(BI6`kld}oEOXVvKaeK>Rw>6tG3`$&PgQ}fG{R2)2#`bJD$0D+LhmwvPCo_3 zDxQB)dTYrLhgc}EwFya5v)W_Iytu*OXQ|B3>6yzF~v4|Ev2 z9=cI>EuC&NBX$=HqMwrIhd-KIa(uz_^P$-cn}u`-$z2GKKm{^j;-$myM%xKQ1r`uN zWDxd_up-=GRZi$7luDp}qX(Zr29JVX%V<1SPLHLLsdsVBXO3J(DOe{UybQ`R&gW}R z6La+yTFPb?Fl6Gb`QCs$xNohbK8J0khp^iTpcfrelfNi&{-{h_Qam6v-sD0lX7N39 zDWU4L&&uSug{QFT64w5uZr}c~$Z^LUpfg1+iI|mLUX69(OGhgu&$LD&qkXQ%% z`TV@E6EK+GG7LI<`_|S}^#hDUG5sGaJM7HN|FI{^^ba!ozm_lUz5nl6(SXPh(FQiV zQ1o)Gp5Il6#TApWz%753xPWHUoJb~9lxHG9K$_G{sSt0Y7O!hYMs{KB2=BIw$6vjG z#jW7+Y{a1`W{M^@2Xi~=NEiwUA%`)rUm}l1Iw!#3@AsI%?M2RZ_g~(Rs|T2a zblz}!D3Zcz^rvmwt8f4oVBo-K-V zk^5`G*;21kiBQC1GJabt4<-;zOSRI!v|@0ejQz-~AlvX|;4-vXiLi=K<;2C{wxi2M zyQQ&O)-IB7AxCu6y?g>GMutv*)m4a zSGWsRP)y~Jt+jz$Xg^=A-h*b-8=bUp<}HGCozowXWSqxAI2qfZ?Cfnt*SCe=56J)Ng9jn`%;-kz-(Ckb z!pwq_cRN^+q`nA1OJ`MA0y;5V=QXhYd#NwdM3o=pI}oR9S+t#=;xZ{E%*oWIpfyqT zh0~><{TLH_Uz(+fK!M~(b%U51Di13?Wg{((bEztC@3LCcdKh&KD_aJA7Unz`juZ|qdPoT5$GVzNg3R$#My z9Rm5)#uApFIH+qYjoS#;LI_C^gKtnPYaTzeyZJm|Ipo`e-O|8`XNQAZMHtl%ZG0xQ zJe%+`-nkxZgCOUVV*IP{*YT%$W-_F!vOmWxl?uNSwbBm2X2p?r>rop;6Yn1alobuJB< z=9~BvzLau4Nz?}+RIt5xQMMn#5`n#V`ftczH&_k-aR*~&|BoWZ!NT=F7cotleqda0jub6s&sp}f3Y&~mIKQ`By}FKyRvMOib5~U0Q1jOaI0swdlhtxxTpKY%a7q3 zlR^%m+X2?CJdJIx3@kfa**YL}~M3K30~}vC3&HH zEqx1tYLBnN{awa0Nb}li$Ewj1Y)dyLBH@M3F_#E0DT*T`K8+_*Y0|DZ?X13Z-z8y) zj3W4aMTf*@{!2ulc{N4~HWr6TCY6Ypu1v2Ql5YAwh~4>Jc@%|e;iD=IW<=a6Lw11q zfRBuqd&_#+E)iUMLw7L8#~lgDwaS_1Bu%;HRB5}l$=#%&LnJwUOEBWmID1m8D3?z; zopfyE?J?LH-qSh?(PSb^gVXmpGjUOuVNH}_Nj#0em0B(>@ti#aMnU{^3!j!Q*2F#M zP3kmW30XWqL1JDrNy_j62jYW&>6;QoOGtYlnHV}^{sDQ^O~I1MBhl(&1|=!4#_pxI zshu*pi1ceJamzz%7yC~oi`v!7x%^-q`WjL}DUPzh`c#+x@_iO_{S>U=dE-Q9dK(n- zi{{Ugg#Cp?JjB8|DjosDKB+Vc&GH8r;3jovS+eoQ=>cHlu|2uV*+UYb@C-`QEBdS> zBIxga@{V4)cXq}24&nNCoGbYR06|W5MRpwkN7_z7j`NN|jL^VW7KvTGHHk3NP*&rz zIV;w7+e+kVqCvkUy390L+MlIdEWyWTf6Ch3`=47&4>7eYs} zFbhZUSK4q~sao{&a&&jQdjYyG#n&;jn_sq$8NictX^>jNsO4O3I^0>Kcg`ZPZJ<|Jf#DlBtso$ip$jp}e z1}}a>6E(%YG&-WW2@q>2A2vto!#aVL0g%2}e-{EU5eYdaK@Cn{99GdYByg0T(5sK# zml?fHchP$L%)I5v3$D6_@8sb+5=O=xof$yLx{lAES-dvpjP*_g*{_`G`f}38jnAMY zV4~At?Ybl3iuz_g?W4R3NKXX2$xsE|=k8Gll8PV7DN1?9ex_eos=G|6F$|D-ag4u+;6+i&J=$n|Q1R<;*HZnVCkK zy;9UJE6iEgvR`;+9b-!pFSam1@P;kNB;I?*iNm>{0HRa(P7#j0pc#va8pO$T$IX;e zHfhkwaVv=^uJYfS*^+S@)s!2HhC8$hkK4V_YRg}E)B?jlu%HKvH4+Yxmhv6;t(>WF zBrp)s-KvrH#X6Qz%q#*6*=Pu*^;%RKa|b(;Aq9@7lMHuVq#KR^Ee3{1_O%r(@ukY? zhd9fg^H$(OCPSStxo{NKput{~DmNRXrHZA~5mBg$>P@Qqo#0rKt{6E~fS5HxI?B?S z>&pW2O|U=IPJ9hR9X6Lr&(>MQmQ~x{xqaC>Qu|}$=_b|U<<~>I2S+yRm><6_aQ9kQ z#Lp1K%Li0=U-1>te! zq^jv?7gJE=nPd9r-Sa=Rk%jF)w2_nTe@@aJ`G0ejOup2C(xb15bW(_P=7Dp! zGVCZ(qvFFRlZhteKKE|CCL0Tpv;nOus$iFc1#vaWaG z*E0}rxuy1lZJs;ToB--hyp`2hs&c7a*}9{W&NAAZrVK+XPeEY=?U|GaO^=2?)a*gS z%d;MjO_e|4lX^u}TQq2k8sJd9qQ}PU(TvKGrhw%JZK7KP;Ks8}^5Sk)C6&xW=PPla z&n`z`U4}ca+^#*92BjC~Opb_`P(${&KjI8zWRPvRsUJni*rKahs!5)`T5O9=%xz9Z zEDZx|U)bb#QQVQJ7>)$WVI(Rj5NVlNO&BjA+Ll8*Ur1fDtFu}|g>wf3(}%QFDSzVf z>tKCi8`zg9n4L##?gX8LnlBwjl-*MTKA&xtcln0zp>m#%O}LgR|9{ylvIhe1Sxb zFKq7uE5VIHX^?a1b+M68ID8N?zonB3VkA@?3qez*9VLF1rVP8>3%nCFwFJq#Zo`Dd zSE@ZRF_f&d&j^DkruA@~dpH-vE|Z<3ONj&xnv|%(9vzkgzFDa*BU|sID+tYz0g9=p=>^u?0hI=a>F~sU~@#6Y-$`U?ymWe z`S^a{p0QIqdlp6l*oKq9e2GH%2vJlmm=FC(4azA491@MECIkx_fi`~xMz&~MtK++{ znHbGBl@^Gn?pN!(VKx7tDkJh#$PeuL2vd_lt%b~~*tRP`dPkosT>w-k=b#{?s1Q?bh6cOeUM1Z>VlVU5eWY;}IMcLM zp#%K~M(aGhPmtn4Ogz4rmJt!Yf(Q=s7ni`FrELx#D^TvHRIje92eyU$Y}9E7!7pE4GPzPspfPo6O$a0h zxx}!LrP9G9u-28|f+*sSL_Bz+^TLi;@w3eyG6Ktc=OeAOq8YM`Y~5*0akN}cST{1j z&eVe3G(tRT{d)l>n?>hj)T33m;ssV7w$!Co@Jaf%nWfQ;#4QOMsfUvIRNn++7e8nl zA!{LLU7{l;Zc1*h6y0aq`my#+NI(%A41~YUSLGv4{(O4$Uv}O~= zZ|Ws6-9U-ovxI}zYnk3qQXt|{_#z9#H-+=j912>n zZE2iWl6F^UtJL|Y{H2Bi7Q8fXWftIH%)z41l1NVpVB*epE1l^V=7*t$_p*Vy9-5f= zT}hD>uVG4xpN1qb6u?ru(?b z$gLpAVM0cjkM5T6?h@0l{QV;vcpGBSN*f7 z0OArZy&`N66}zh_`pZ$Yj&IGFTJ^Gy;@L{?EQ73E6x8g4q@^zkwLYyH^7Ba4-rj_4 zp-lmG@Hq5ZQaoae7DPX!Jkn=YP~EIbFfoOEvc=TJN=R4g`&oZWEgQMsv9-$!12MXP z?SJSo>wh)e*jfJPhFc5fmi@B$lV9H;b=sZudV>X^A#M{=@)uZhBzwgN5Y&t}MHhPS z0j$(_@7Xj~-Su#BOaTKAi^Z(p?97!G&s39sb)G@3{H&KDnLY9Edipxry+>VqC>oSJ z9A|Sq`x*~+*i{00gWMcQ-{1)o2p@ts%bcZd2c8we!$}r^!Yo#saX$*MGN&$B*02$B zBhjEl!m9ka*GqO~k=#;-LK1wvqwk#DU?|ewshUTY#fT5Xld@*OXnw+FslTu*N%dy4 z0xKkbX9JQ8yPledRt636M_Rge@Wc3TIQX8Z%_PT60yuYm^4LtHAe>=eLCZAKJi9&J ziRJMNRi!F%cfTTWJ2Q=w6?&EHU{!;_8ztXnO~qY`B0ThuT8vSbCI<`gy$p=~E((bl zpPpgk=(~K}=_)j}%(M*vlkeX430C){9AB4g--9$iXc3WP0$RYw*i;))gRj?Q-yV_5 zPgDQ%z%9#95gk&7#0H8phje_vM^hg?Jw3)c<0(Y%n>cKZK&z5NDDHrQwU+>qVe-hh=tt&%HrP1eyB~H zwr0?6mr~&5>FUVkoJd?p*Jbi(Y1m|h1yYa$^qs`Gl*%-JTYASOw_BNM5VndorSpB^ zc#k4kDyKj*S)x#$*Gq-`(E-rK_Wa8=_lxb}9={<+Il9+D+qxWCHbW`^38oQ4qWHq0 zQZ5^gT2E~jfODOb;a82`Kyw(Ci=yW7H*^C9!@kUNmwaxLE~qX`Hf`&#yR!^Nh{^K- z_tncQBevE}Bv0F?y52L_KvVLnt0N8Zv^B-9zZQ#UFnLP0E*>}dun}hR2b*g&J&gx_ z*xzX#gse$0Pg=s`KAjGg82--NCNJF?KX!Pk*zb^E9 zT@_;JCn<$IcmtPJ?$~9#A^pz)J%jQ_8-nInBc6;Vb9A|Rrj+0CQjc@|GDINl8S6WC zHI^EB1D6W2OKWH~Jiq)E*5vz9BAY4;V4F7zZn7))uv*tXWt)KfL1FLU?B){^;_C1d z#6IMQ;fRL?G3Ci3L%`OPL+=V=2$5|hy$i(3k&hft@h~G^Y9=3HKwmfSG9T((g)s+K z$|r&=wKvCYS!LF83%?U}#ibWc2@~%m3wq0M4CUdm$*h?E?eICExSSr~34}`99G39% zEAKvyh+}~=3Obh9{-)s`9y9i*0KQoCQ+S*(3_2hXdV4HP!YGaTIs7f8 z;3uBICGyG}%TT%P=F@iBrFF_2kp7kOUGX{QvO&m!$^zF4_3gQm@py0`-=mck^=J45 z@FryJd2>a;f)KX^VxlNe5H(W`-gLwHApdT%yR5Wiba@qTO@Pme>AN~C_4b2+O&b`E zKZ59o!N+Ra?G8gW<^G$2m5a3rGWM{*DfRDfs$j3}=LmD%X%&MR7EYGoaB>|Sp+z`K z`{&|*TIKczbm?ooE0VmifF^tpXIR6~#eHD@$pWPjPQxltQhx{lDq^JNnq}Ls>L$j=7mc;m6cGQA?yRi-4Z92Gvu>o+zZg5zpf-EN6Hy))RBK}! z;Jv7i_K;PTY#Li7PqST9Qcce|n=CxduyTi(h)8k=_oZardy0zwD)$cQd5fVRnNP-Fz9aia(ox zVq5+pid4*WJkjVw{W{jDqt?Tv^Dk4EeuJtm-ghRs)jT7S69K(RMR03NX4&}Ws@Geo z%42~=4zsdbgYM6WYhVTk8wgC~b_m&*`8-t~6m^n?n8xFqK|it0Au{4*eqA08o&!T( z2WYmz=qj6*Fz@$l?C&v!ON+Z0cDV44O|rA!jq=&1N11|BK)W z(NK>$U6ukg%iov(H3%C>Wnc%s(k3fs5~qFzvYVUUjXm_i{k$OmzlxA1jF!u z#^21$|MT;5MpMpVn;og=O5+a0kt?4Rm?VPzu0}BNbbfW5ND@OVsGr^zQu4=duNue4 zZh~%Y6W$p~G%hck#R0$1bW=sjoUDRuXyr%>g-vcz`|#AWl@!HYK^eFyEA^;@%uQxF zMJaRo1HoE9Im2^iVyMccGEnNO!fT|dR6dl)J4D7sK~)-)8v8P8A>e{FvrUu~_`5F9wgIz(*YJQhNjSx5pcz9tMjKG){3T_dl0(5WP_-#{#Ib-xrG9mCDk zK@J5Y+=SP$A~>8(9Mh6e{Gq;|BICTf$cPy$*%TObk*Xp5%u-XR*oosf5Oagu`TTr< zjrM#X~xkk>THU94W2LdY6js#6*Ybzr0?1aBqr z_qJ4LYrSVADJ@$nQabtyyi7u+D2Nhy=Im_g%$2LrTXAul)#FrMU)ZS&pu(&^62lwIfR_swlztLObe!gcdIGM^oTgG2x7&7;+$yN}EB`^V9XImfO? zX?|}?U64Hh{TJwgyvAOTC65tn4lzW0QPgND~VbeZGA-X zU~LE!^NUPr9^c+~cj8JH5;CUxGg z1f_qs9_8Qpi;(qb<3`CC5fU@=_sad6`21`|@)@x#2GwLolU!3LB-VYHV9A9_e+4#R zANSTj>VwHV)6SagQ`UxuJdl$DLOz1cD9T5D^km7l)7H`wFy z{<+4KUBOZ@waI({{rxatH@x6(z+e{bHHw;%Cd(AZ)FMvKFuQj4e!1yur;GKu9&wVx zLie|v6XZAT*xnvdeY?26K|VtFi#e7t)w|7@ z9Tc>~jdIe{n;5#~Xmlh5l}Nec$R^^kh^}D-{{TxZ{HpxFD<}JZh8QsY??b5?O{s*V zcC_BtI!a7nX^2gFx>a<-h&;mF>1D%Hq*q<@;J|dtY%02VQ8%}*Pp@qDwrxyEuKW9= zqhHVNi+-GZ?T7&ZuRGs6OJjO>iS|q53HUE#kaKQr1N7dJBpx^r-$VQXZ!7OM3oYs# zR{_@no*$S1asbcT)+qEiF~5Llx<{=f}(&ehND;7mL3KSIp z{7qz)dx&jPhfI4B=GPsw6*O+(S%1^{`s^fF7h8VG;nBypS{=S3yc+dvfCs4zSm31G zi?YRen>?(nH#wFopGkfoXbNl8R8*yB0JO9=s7wmgXpXgN{MO#PUxX!C9@<}$2cYq> zKy!(=%%u(ru4VLsq~!ar#Nunrz>sAts4Whi@WP9_3Tzp~LEE242EEjTMhVs54(SH4 z{jrVH#5lC+@~j_p;K2yX2lv3`xH zObul=QG=gH6fOCkfkay-XJs3d^04D@DY$gUPlJ$Kx+YwepnQ*!x93XUe766*hR)_q zM?R1fg*>7#FE1h^juQ+?eQza^nY>7cu9F>tQ;eypz{eaR2a_g~^h?(!{5C{APiynl z|12zumS2^dVkBb`)}IT10yeBrTcI}>;l=Y!mK)3prGgGo((4c9?i+eutRi;GxD~5N z$yF<2u5NL3#OTRK1eZx%p2)RCu&Gwk6m&3+q=kk$Ll-T*kz&ToyTU?$>8Y>C!$4(U z`4CmIRjm$6cpbaYB)nZvM*>%|J4g+oZAvV$4t8fLA%dlXhgQ{|;w@(j-N(%da%6V% zLLYvUbwQs0Jh9CEv^n2h#QnJXqQ=P%?ZTZN1Ys#S+zYo05gshDl z7a~$v7ka^+wlak5ji#!@;B->&tAi30bmqIO4ctMiznJq~u{R189x18wMj~|cx~QJr zJ5rajs{cD(Rm!X^3iPX?5%B}Xy3#Q$tdyA5iFNkpnB9LjHPNsXw;iVK+T7W zJd<;XcWN`${arDWQN@ zrXjxz3Eksnq}~kEndlWR1U6!gPlPpUsw5lL+}oqvOeH`9Gxv$0(i51CxqvPne|*TD z${BCZjSuR!A2x@e_vbs`PZ9WPZaaxYDk_N@(f))U7tsu+{x>&jmPYyZ{tkeL2}-^I zR2SxWQj%%aY|IN=&T+^%D)U_%pej~+xkiN}%ysG_-6 z;oF$_ccUuk&;>{-PI}E{cv^RrJ=N8=5DEznV7tC=3h{EYgQu4sf+>qZpu4snUW)h3 z0**nHiZ=w)zDZ1n1q^sHbWl3TX8B=QHC?8Zv%oP%hw&tW9dMg_BZBVNTxrWQ^yD3`IVkY_Il8jW6lGoXXc8t1e08)JaH+6$wRv|< z3|=%AbOL|{*_LWTh@4%lz1CBeSI}cz*07o4augU)dBB~|5}fNQlZi@x z*h!>@4pP3M^7l=to31ZF>wKxC;-)XmRoz2u*0eB9QT@ipd4vKZ&g!f@l-6ouEc zqC;H7A9BE74nH{_^ij5Gvy_&lM|OvDLvlQjOp>>WE7(tEea8wT+JS;RJv8rV)?Fpw z7`e~@T}Za>f-Zf^VP-f&A7)mrOu0gT(tS@&m%x}V(6l9l~`_LJ{u$~YXe!}XqN$S&v&hnV9^r5gzONMcNY_~~{6drO84-cv>` zU~SoWb#9=4-I9q-)Ol{2s<4VFq)SDU3nb^W4xzWfwtD*9J&z3Bdl6z(u%F> zn)nkIiQzH{zzrW7_q0EWHg|WvoxbTpfKCx2*Prf>t#@w#T&u8Ic@0;4eDL#Q4rbMm zq?+8wj8T(AG&-mUg7Ce5i(*LlXFsi_>_B{MVFWC2L%s&E$1*qKR& z6Ii8FO0i+8jO|7Q8WO2~Rt;*6le{zj9&eE}9#MEt^l;n6*oq{#Xg|z%*`+c&iI~#N zezC$)3I7rv?!jTy)YziAn;x(u?eK6alZ0GoZU?a#QBUhEmzK+_Rx1A2=f}3lB8`|r z0yMGnkaj>H@oTur+(yXcdD4Nw(g#5Ft){OS(Nt8L1${gQ$n9cg0IydOWC zK7FsO(f(?ljAFc`iC}1TZWmp@+aMMvj^%Sqh%A!5Z8ahJ@`n_(3S>iq9*EWnH%#_1 zyN3TQZmI^#Xwi=)Oe1VwcE z0Ia%ROPZk1IvrPi!fF)19i^t~k0 zVJAkU#bB7qycJBGM(mG;uLz6FMVB0S(DnZhW&hM9iq6T=7w`TPm19(8KIuB)5OBzj)^mh2dJi!QG3wBD$lgJnKY@yD3#_aJ zA7e@R-c-Vb@Gl63w&ZoFx3tw=+|EJHuHK}4ZC-0jXp;iTsi@MG#`u~=T#0y?eUBC# z{y;wDMK<(PbT9K(BLvV5Hs{~S6*Akp?IQ1Q^ohVsgvV?+H5mUpF;}FW_MwVp^+Xni z>#Vt^iMEDq;%0qI6-It>g)$3LSqp&kXiC?&9n_O0>_$BL$?9e~UfjC8#3+ z40yC+DrM&}%IvF>GT;c255n-_jtJJH{vFf7 zzvIZ<5-*3Xf`GM~s3d>qPG8_0DCxYrv-at)KB3z+ChaX;UW z?aszt!AIXjA>OI)ey6-NEMuIezU>f~h(mqt1=hx&?W@!t>7ynUTBz5IN(XV;Av)_! zljZcv>ZX%5_@ciuVeCUIM#-x_u$39~Kj<#v2N&95NXcu*X6S*JIjbV?p6OT1)}7%I zNcLVF=PfamcAH#>m`y>5OL{VS$#pvd`+d)b zneyRG^Wm;q_7+3Q()sbY5kK_dp8BN(@Zx0S*_K;&p25R82xWYoYge55lI@G;UfTM^ zMz~15{&3|)6JTMRN?aU9w)etC51+LS5(Am#@1rX**#_T{#Nl3_nE&>r4#&ZP*zwH5 z4J}{vXZX1~+>s&vq}=?M3j7yhis}D@RYXnZ|7?{1x63oN95L*JQ&2ADA-2f27+uU@ zofscC$44lclm83JubQK`t3!l(hN8O*=k`T2UuUjKpcN^J*S?0}XPok_r&gzoX5Tw|stG9(gb&Rl7XD8F3!&z5Z~q9rm`6Bf2?-XB32x!Q6k_=a_K z99YU>y!ojh%XS!myVybQ5Hrs-pOF!PPL^p*&nbj}Wd9jrlW}iOKGB@-JcZ9T(Oc9a zKT(R{(ZZ+nE=N|Wl4WX5J2AIB4dp?6dhrJj6dY=2EEI|(7{=K`)(`rR$MlBMY87!* za*&k*>V-0p5ah>)cEOniy(yqU>I}8=)rnfmY*`~;|K+igI_M>Jv8CsmPzqU%#QFm< za!tzj__ayrT;n=j?9Y4}^&^mRJp(4F}_(Yf1UZOU)(YgD~r% zmPWgnt$W!fPG{S4;zNit%Ae^uwsZPUU8{CW5%wIi6H~=RHyNsI2sYR*1feTowL{ON z$F|=(p<1{@Xy>gPn~7?q8&OO%04pE{-WOJ`(?#-d z)nI}#*oyEuFjWFGldnwC&Tm%|ZFJNKRMt_?@QkLe3HMUZ?010;ZR2-pRwHPwjkX+DO`d(QIO#15{+i&dSy5 z4ET*%Ql|g~Z55?Cr6qZ|P9?-*glUyGvkhaf1c3_=jDhCepWR2P_Mbxt;dNbR&NXQ8 z9z1f1UWeUVZFX5?J4@h>-D|`yTN_>cBEy8iTN8BKS8>$5sm?Nu*1b~nV&bBg8&b3^ zo>Crz^MXVOqFckCG1|F&#te*!uj_$y({7e;hS=jM$jCDVq9s2~)@ zWwIIGA^ZALhNUHwl{WO|=^weC!)Jyu3Iz5KU&h6?wyp+o{k5YL=50%2$z6Tv~#OAr+w_bwl&ISw>`)2han~Gal74 zi0(UDNb&8%u0^FY?kCvS=A+`^}yAp$tu;P z10$10q%2DcXxQ^>?$M~+qT9C$8C7lEJ`E- z!SZ`-b=&3Z_4G7o4{(Jn2D}_@y(+`zs ziZcTJgr9-4S$5q$#WC!8H1XS{gRkqzYE*)LM`Z1H@&l>O{^-F8L0Sh}1% z(Z;y(Tc^A}UX}@^JGS57u_ur}U}^o(=LBmZvxUnU=X(uYgOqMz&l+)l*N4PCX)UOJ zEZ{y-dG3g5ehp8yS@1yyUKXgEZ8EKZGj(SuS-(-nyuV*7pDd}eV}W}pfj9rj3bCy1 z%`|$Se@#hPS7h~Av(&R)^QoBV!2STweLu7MH+P_e@lSo*RXB}~d01LW@8E)Nliv$$ z1?2OZR?_?SwuIxr2xa@@QR5z6FK{NnlF| z@1CJZLep4bQ~fAty&8d(4pX%M;cN`NqB8PS+%+G^1bkdJ<<&bOLdv5D-ppWKKcMDn zAU-$=RuGJEn1OE=Qpaa|;PNn5ax!+UUG=(;rv%1JWz%Jelmi8BeeuusQo9UCHxs5WU- zQ(>Tm3i=kybZ0+>1GZ5302Y7272x=Lo*5J!5p1!cdIc9T!I;o)UEAJ*;DXdapbDjx4zvmRv4F5L5MDh3At zR_oZS)j(zfZ!fe-Ao}Dg4sm>PIwxvIav;6)?=^fbIs033JH9FuDCCKA}7;{3wc-~lAbwMJi1H{Lk%L@Y?rx;PQ|L;In};^gx|#G36|`2TS7v-CMtJR zA!bD%u#P2|smdx}Eay--DW7he8Y?jF%J^@i4|I)Hv^5lDk7?8RnEyM@wd4U=A;2G3 z9vo;IcSQi~gi6@OxlFt**%lGRib(UmW0+P$1Ot&7|BP|zh%l-lRjRA#K9`%e0tND~ zONo$=B+fF(EpE}dZc*@vUQy|ovLHzncN06er zQX5avoQM?J7x;a3?WR%k(GZS;Nrx3t0RIwTis1oaX!K*VKMi!4a z9pn+~2S#PU!VvIk0E5;Y`!w-yn=?n;SjNa8#SIhqli4LW2HX}vkbRvDBl&+2?pu6S z310N0Euyp(b6#Xm%9Ka$7}dxg4nPV2go6}bJbcJ!+2+tfyR;>l8N!9#6eYPS0q&ka z%{x%|%@SKBiHHB8M@&1z5||%Uh506({}^&g^8IwZ`~IMDX6o(m`K*y9yl(UP`SK;; z$AZ}PZSv}D)O>Z@gm!7dQI!Ri0JyK$PgpZxquYtr4^V%6QL!D~7p3-|AADZ}#JN>Z zy~C)r0+L#4h;{4-=N;(ev)xR;Itsr>~a)-=LUv%f9y7)(JT**lX@ruK1AB5OGP}W7*u>M;@)EzXo1M9bJe{Ls0 zx-z;6O!LA3E~StEgLV24RDRW;Bd_Go092ue$#G^zgya^ZA29VNxH3S+JKUEPFH&DM z2Y@J^fbL#fbBW=mI!y;xH0v$m+)JIBZ|9?+dU997O~1GcaB2*z>H!O{#IF-b2II0d z)K^xMbFQ<6+uXMKeBzKW?%KoJX|V5N|pfYf9VF6a-mDR4~Gk{m?w&6dQO6veb z{xp>e_-NI8tic<*HE;vnuf@sujCupW9iG$hkgLHiAowPuu*FRD_lvAc>U#L;CRIm* zU%m}NNhlnXI)iE70im<*g$+w4^gxIS=}$H2#Kv%R+RQ>j*;(h?@S}Gqimd)Ng8?wJ zI8$wcy7nQ;vVqR}M$}gepApB=L1$EPfg@TQ8E^?UZH@8dG?*nppF)JOCG#+&tTmDR!Z;hJTRPDVh zIiyKS#w3T29NcWs9=2a{VhH#m@3J z^2bo6QPvvsu^hrE%K>6 z0X6gjQhNkYZ#J87FxRJq6dAXpa8?1Gg1K7M_e3_qmOnz5X4&c6;5nPxq9eSY2h=rT ziLTRSZ#t0ELj?=4e}I?dMA(?aD;1^aOH}a#x1t8(-yKIf=vyg)KV3-Gu58I;CH#c2 zOfh_?6;V_=4GCW`;(^07=UO`EV$p`gth>pOJ>JQY zyi#ibNurjhmQwu@mimgf2MVPL{})3SMdW!a*kaM{GKCSXx&C`Kq20i#Ji#1vW)6LU zDw4cL0|=JMq%J6qTtfy-)nW_XZ!^|KD>yUiR~Al!3q2nid7d@1#yQmZM&IoU-ok~& z(;cQ?%*g(F3~auDlIgO40*!*K!$9O_*z$Fc9OfUT6>~AzyTDimcCqHiHk*W$!5CMsf2@PwBXpqF0(6}gM-eL8VYk|8e) zOr5$pSDA`eq8J?ifQ_oEGTWHIell%t6rU(cb{R7=-pCyRmJn%50Z>YMbbyk_C2U6qH`@dr9Ee`W%OiVZW$)} zrHCLPQ9Ec?ewoKLI*(tkO8;Da{#<2cCAV5HZ~UzKxA(1r(rotl`M&b$ENuK&`jd_0 z|IecI|Fa-5GBL6KuTSG?jqSK!6x(l;Z@nEAaC4!Y7H>YBM5k81xD&tKBJUQ8SCjN) zhxlK9$?=cgTWB-#$=H`YoxfqcSC;I9weNdVan8<4+rn&qUXMTf)0>~v-Rr?wDh(YT zYr8`V$R+C+rrnVP+%mSfu55hZe)BP`w;>u|r~9{dw~N*bd{GDXI(^19Mh*S6c7(Y* ze!Dwli!7-Y2?zNm4WhU(G%k%a!!%LAr~tY2=cbVCTeV zaEa;kmCVgAIx;lM%XQKfI0$-|BG5tu!;DgF{bW?HLPCk2a*yk>sn0*^m6317TDyux zD3%dgVbe5+>{~}1HjeNzPD8XDRdaaZ7r_YCSH+tOs9OWlFE4UYCYaUgNn5p|FsdY{ zED@+p&)(QTnE|jWB-6uXIS5hcZ2VfYz}z|seMvzBJ4Q}qK;z24p$TmjaS1L==NXxH)hgRpu25F^wO+%xFIRa z{~~m6DL749<8|~3dw}>kxFhJF28<)LL_gBU9Wu~2du+j7e9U#>DX*_;24L>#l@bqy z?-DrWq%N`x*6hrR!`!#n13Ys3!|Rwi+{N|3EES{Wp)qt!JR?T7HDBaBYO}}dvzbk- zOeY~zuovJ(3u1C=9SCS25{p^htKP@=1;Wwxj0DU)&^t#f#C!MmH(ar_N)?2&hl?QA zr-wfKvd#-d+bD4RgE4XSs2t2^fX+gHq|2$cK!Es+(D={g!0x>Z@o&XNF~jX798D4i zEG|JKqDbW!qIay>cq$f@nrW>g4T`PH-pqp-551e%NL!Dt6O+>!FXuW=Mr)w;}4q7UPI_ zIs-G1UB#o4(mke_7HyV;I3rS(cg9^VJCGAMrDtVDzD$0biE1rL7zo|3sj9AK*kKXVsRw+(#m{))Y$%o9SMcnAL~5CyyP^Cw}B zAqba@Wc976AT>0I;KNrqap)vs8o-K3G1)A&((^bWD70Y2R5`WNcoGw`!BwJPs99cS zlC#Wrs*rY|{GJ(m4gu9yghPnkdI0)mdSvE0vi+ohebEl*2yVv-u7V z{QdW9_z%6UV4 zg?Ek8XPiU33Lb9$|4Jv~C=UKf+JR)(s&ux=civf|=`!JCmLV#t+(@d{ohWe-?P#o< zHyDC+k-axvAS+ew-*;Eo`qE)3W>|!jU!ZkCZoOY5^fhnnjr;GXqALq3PR!1sa!K}z zWAc!fv|Im8YDkby5S2uCSzr->Ylb!3qZbArU2_SsM14#*8W>V~_>$=pqc!7m6Jwg< zIv*^EOMicN4{Zv^ig^3U^*H;`iF>K3u`i+%0Mv4upKX^OTwO_Vq*E=<&muwg$V4@# z{pu^Kh-BPkIS?Pu)k*j?g!`7m*lz-XA`{2w1CH~D0Oy+GrTu6X5w*{9>8qu@lUwDY zTM(Acb<8IN20@JB4DgQ+1_txLC{#Wa+2F%L{ZXh#k3xzu+ylr*oHfe*U_;K<*25MT z4V?&zh-$^(^M5p$=gFs^$xY(X0!3k@7d+SFJ>tIu^nH5(gk1G}f80&7O1Hxh%;Ry2PAp|Aax&b~Ip07qGb?e%XW4h!CcNpu&bvUJ%QhV7Xo zpO+bn=X6M;<%5a%LM9&Acan3!9ZM@Ad(zp+5aHKiqh3=Rax?Q+7pF|M z99AMk$?fa4T2S?gdcF8eta0y-f2?hu1|%r#WD(?ims#~ru-@o!GecOP857@Y>Afif zq*7Q-y_(qKSsP0V1q$rsAW8W5&L3d@zaZI2C(on=E~x<7zW zl35+}YR(h)ta(kPUtKn{@}r{&5PM6PxO@)(?q-bo1(~QP^y6_&U1`lYK{-w-{XOgO zPtzLFb2#U-{yO6e87*H7p$0P3$V&Gi{ylfsUFW-%w=*^#twMKuk?A3$N3={b*Ua!s zW8jXd$!9r^;iZ@lq2smL_yZV$b^9dYZq|i@Z^8P7?`rU^&$AK5(~#s z>9fs?Ujvt}@5!%lx05xxD?zG-ZE%vG&84Ej8+RkNWK7xq4I92(cCy)-tJq5DNb&r5 z#;gVadu4xGU@!JFF-K-(si3s&^Y&xK;!6@asnCgk;U6^J-sD}`R|RJdxg$QJuuBsn zt)pZcoRd|SiD}Vvr8B&G#f@OsIxCGCl4Z&)N1mO4Qp^~4rP-JeCGW5ZE_GiCD5r48 znEYPaK&#+G|0Gd`IMMeJ7CSwGozi|3TjL7`wIGP_sc9%E8!nD1`2>+?(zz?;l}!u| ztE9YP(Oo)RR$*n}J=LtOL6B-aa$4EraW-+mkJwIL+46jPjTn$Qx$8+nci|I^!ATVMmp_0Bp zB7QzR$cJrB+w0#HR6C!e91AQ#ewn5$v&y{iqsE86=l*T4a#3B0RQ+fIXeOp|nQ~sg zB^?1UvFR-V_3k=<`aY%C0P1lJ>3!6bMhKLk)F@hKbgh)$%m9N+*Ky4_ZnutX*x64+ zSll-cha@%8Np6>Kir2z~Yk+U{Sf;dbhhy>BVT~#CQW|tW`@?%m*9Bj4IdeMy+4W~{ zQT~f~ja%Ia?mnfZ{E#pbJ{h8bz$~mPAUJUh5IMAoe{#!ks1ALa4APZ( z2^xOJkdzduzD|T^>FbfewTTvrQbrTQ%H)l>l$r@R*W^;j1+=vKv;IOu)1h|&ztGpI zdp(Y&6&n z7;~^*jc3vwM3VjjlpvnQSrDw}%?}uxwQMnB(_bypF25l82oiO^W#Dq_yM8kr>1`MT z@Ss00%*?RYbPX{K($!e-##j;YiYD>q(GJe*Oal6gt5Yyz%#C#mkubpCadE+41I7oq z(dYxP-j*%|U4eqCXxCSqrqJ8oc`O>T`2&jmaTJ7u@wo&UH>)7b(v}rQ=^5xl{rQ|^ z!}iLfBLp#roS~9}h8X}g@LEdUcV|TUGkNrNSGeSlpxhJi0q@U!Fh1WKxr~CbF%TT4 zXlE|9TvsCgxjgLs;3;)`wB_$@m(V)JP8-|q!T6uOe=^;sux0jXnEd7kC+-lqZvD1& zL#TOObK@*zTIsB8EM3Lw9-z><7W^YTq%a^@SgqGIv0-ovyv!^(Z_3WRN2M@x0ylgYVWA1Rw1t;mNe~UVylOXzDHxa#b~~kVLZkK>MdrFG_|a zMz_lpQ(LCHzSQEOggw7Uf!bcSaa{10gu=-VgxUx2MgFp)fG*BdW?a*8^iw`Tlzo4+otIM5u^T?14xJnJGB#wU``jr5t}1D{e3w& zsw+`NM2aL9pKw(;>UA?UORb%2*%~bdHwxuyWZIpvQgb!?%;56!x*t3_c!;4ht49jc zW#7Cq9dN-p4{LNe;|zE*&APtwyf<>7j^ea=dN@2un`B$KwYk&TuOg~5WiIAVfl9m9 z@_Zk;=!g4lWAby zEs3yP@RmC`=?g6Ckc%rdvf39_`>SwePE#LNopVeHP=wX#Qt2kOPrF261y7Z)0kJjrrFU!21pVz-1l6to=W)66-B}y|;;OQz2^EZYDRn=idkf=@P%2sPWGETZg zV_s*Eisu!K5T|s2*i*^iSiHAjzckYhc9vPmAhge@qkPH~W^^$+SX39KjIyG#JkaEM z1%dd=q7o8lu9`Y>b@paWPj}x&Xn)B*V`4n*)ycKKk&4$OLt>r14-QC(hjoeZsL)0w z_~tTv2+w4;fwyRXDWD`Wk>X3UAuJ|b4|tU`;l6q{0yd~_dNJ)QUE?x;xeeP^s;%@|ZU$5|; zm7%)B@+*l*{nlE1*{zam4v9JJ%DNMv=I}8g*7l6ifVD6!mZH^k=o)z*#*%%$q)= zabE?sUJf}A3>n_ooO07M%R?)4vth)u0ZZYR1cgs_f|`p5Y)w{9eZEYe8J>IyA!w@Q zFWylHf;I@d6$e62NHM=~l~$S#V>7KwHLoc+u@>WpTUu5VrK!@E2{V1Qa&UB(rpkip3o zEhjxe=ZyeWr@j8_<7mOuQOs-T)nVbG-|(Y9w?E>ceDn>KmO?E`r#k4xdL1v8F_I+M zZ89$`+9WLeJ+S1$pO7Oey%$3L zjfuplbOr~pwKEp055nHUgjPp3|5Y|jx}CAh;#2+d54D7QABM5*)NRGXt55CvRfsHbcMRjJWdsjlxLmMt zugPm8riS{y-ma8y;wL0sQZ=TU>9;HMD-VdZtLNQjtTogl6bpcZ4rj5W6RdOBI*0?# zytX9Y_0%TFHN^kB-x&r>uVDCddGP7^`~2w7>|MS>`47x!wlhN)5QjndjZ-6&ZU2qVFP;kbto9#dGz&Xa&#Fa!}qWu zY-yMVz2apw1`70zLE%4v+hlSOobC`0nJAvR-l+*?D3x1WwvLYhS|B)z1t*{}?#Mgl zaEHY2|2>>|J)j8N3y6-Ux;AEh3F;G3Bf@PzgJmhO%DLDdCV$xu+^EGbOQ|S#qG1ww zL3@u>z7@@OQcI2Kl2ci&xF&Z#EuwcsN;mZwHn2jlxfTUHM)8bJ|J3TC?Lh!y4XGr} zMFN_D7my1L-`k0dXs@kRZl+Gs$?2=MHu4&3%QD&PcwB=Latd7?AB)?f`%@WcbuDM4 zmbfxa3Y83!cE%#a zgB<1@=3>!q7F;Hw(jND+P#C3?nyBubRpQXQgbDV5CdK4?3)#`fP40?r)!`sqa1&fid zgA3Q?b9E^|=ZnQFi}u#mbkld+=@hG<9~mPWNrPSEtiIGT8_`qFm@_@E#CVP~144Yl z_oC#XyF`5Q>%R&Un@tw^osuCJ4dbN-q*IBCog3xY`_c=+S<2aJS}BrqA5pH`u2_o# zV^)q6pm;u*{7vXbS?h9dqouv2QQr0hFb7NU$4}cX7ut z>rTaaBtYN>#zbMzrU^E8mLQ5H^7KHqPvunRiqAOu?h1g5ia5*40pjq1KDucwi0Nud zlpEMLMz7>`*u*}$C7f7xVd~3~a5<%}UHiob^QS3stS_(u1 zmJ^<3mUAS|n7v01zKF6$|2_zu=3Eh|U@gt&ToF*gY9fe0oCQOAIM}BH-WYPcgfl9< zJR~F_wBjFr10euTETFOXG)A(V6R>oH5ds*+t_&S4x5;Wv-gwG!u1UQ6a|yN4(Xg;5 zcY~7Qj`i1ekJ9Hc;1h&zMZs6xS19?KCCp_-Gg|CE8P6qahq15&@zvu&4c+O~bpxMD ze;HE*`IiCpZ64zg)+VkolT2J%<|d>3wKXkfhaaiW+Xpbme}OL3ac z!+=A5*;fkl^tbL#o|iYX62iCqY{R}}jaOf?V<&mX#Ike%11dM!!%obuRlLjfMVfN1`#mPM14@%Y znzDXIP~N&!sB}s9XHROS;_?q?(Bl1OQH-vYCsb2-vwL_h)n(mInmo2=x0wIz$v;5g z%ERmbw@$Iq|Cdg&u>H>~v>bJ|)@Fc9!6+uML)Y54+OcohK zuG|wZQU@EUtkDg#Z<|zK1{o`!C=ZWm`^<+#v-7jdui5dKYvvg)QW9T)sbPUl(ZqoA zAwV0Y)PiuB$x#-MquBZcgZ2_$naC=aj{ahb1R!8ccslb-&h6{O(^rM|tvhEPsmbg{ zL+EUo%PJ0@P4_#GqjpcT+fcHr!&sNNEt`gf zveTlzrJ}H43TrL*g7Q=`>D{C&Q@MH9w7NpH5~Ve2Ehztt)1|t1fGi@9Z)Qeqq^EHW zWk!xTMUIB+8t>Falhm3w&pfe#Z$pdW;)VfLBx@KFA&Cz7&A?w_itQ{T&v+kpoal=R?Bb#D~p`$CRCxOOha8yRk77Id2iV-IV0Fq zBLD!Cs%t3D$LBk;w9hP~6;q=+poGB$fEyJIhC5y;vEdj5S+HQ|jazt&K0oBG4olKe zwk0)TMaQZvwzVNQAy**vp`Z)aT%-czL{*XQ=n#VJtr0y+e*#5AXSxg;=_>=d5 z`c@Gca_UMAAM!>jxoQvR3?$-R96dZyz;`nCk=r(xWEhkCN?z6~UPOtg(u|p?_pv|v zq@BOGaisRTxH%kl{<*$<#NNGxa*g~GkAvLdUOaKGs#7I~)}ONCAc}RuDbtzZ!`w_t z!I~mo1%A57VK&TrPSYgV3u@|Mck%oL#xsM&R%gXZD>GR<1cFh~{jQPNbfXf+9-xDe ztS~px(jROF&|!T)-wP(jlgG^-~=6DniRQ$NVh^=F~_gunNg zi=1`-2Fx$dCQSI!s##Nyf5nNssgB@YyVRCUB~q^ug|DSMre)$@OPU%Htf@hBYijMZ zd)BbWGxag99ouf56-z-JdHH@Pj=b12hox=FS`MoHNo?Z=`}IA%!&8}R1u7fo1K#Q8 z6@Uz&;d2M9#SW25S>zxSWitC#*1o+;E6+|npd_@VXQOm-Vrp)Ije30?CU=4%(nwq_ zoM5x*xw=nD8GmaqGpN)Nu)LCQg)44N6^|h#r7eg8yHaFq)&!=S@fnK8ZZD4(fnPrvZVF4qyE&ZuO2efm1@mLfMx#4#;{%01(v@}9X}mj z{!+Q{;-6k32I6j&+yLn1{N7bkh2=GgAUJO!r>pN9!f<`IGRsaKb~yh<^SzCy6d14G zIK#9ghr!uBnQro)v*UQ@xe`M4`f*%I+D<0f@V+*Z|LRs-2YS-C6kU=j&X9ehHR3{v zFg14E6=McU(JFn$iF)M9XGg(50qKqF1t|v*0z77-x+F*2?|8*W%FesXzDZXUYu;?* zz6harisk#9aOb~8hLg-f=jQTZ!Lg13XKJ)9mqBN?!L*dt!${y{ITJ?{Kd55jF%i`E zNget7crQ2`nkq~X^{(w57mx!?HZifYO(%}EG`nyXDIjQ-9!bLTI~HeuWb$bi2;SX3 zg~`Jw!(f279oxw)u;~x7vcpkP+>{Gy^*q}mjz#Qu=p~k3lJF^xW`L1ap=k>`<58j{ zc4-LyRX@TgMVEVh3Ag|=Xze=^cMxc&@5W*){bRnQF)1M0w<@{${&Q1>#HZ&9C|5jH z^zq>JuF2_WA~G}KlS^4CXDmebz<0)MfbbuZ^Pf!*%*_8YB>h)%oDO~^=Tyzz+!PYW z`UopM<0U{wyfmj<8mWP99Y?euXzSzmH=X+Pad9R-!s?p19VXo1>`c4sMvNm6T`ds3 z>vfyjeP4Zv!DPkiKsw@Rv=*#h!^Tj8WcXfVL@jjau;)2gJIOcNnyZ!I%(Dww(lSS6 zQq%YZMKI%vAnKj)@C72}DU5-rT45#Az2;m(A5M9Lft4962lm)DW;sb^X*mNHY5~47 zb+6E0P^6l;PlT zJ7nenOXh`vN;9Ebc*6k(@Y?twMI5Rk8{^``!u%r`y2k1EM$ao#Z!(^nSJyeSAk)Ni zgseYY5W`z{qs{KO)~`8KDIl&lJz)apcpCY>fEm7WZQfxm<9Kg-?>m_ zpv|7CtepdH5KPUn=pf!P`xY5c4&yWIM>&;l!lAU*NVT7DkvnmvqkCSH zmr9{nP)XAmVv*UdfxCQ8IIkf{77&3xFr~UU_*qC9YGFdCl(dSCA9Rm5mrZFiv%_^; zmJb!HobN)^VhQ1+Z2I!YUGCj>s`0+K#9=fs^uXcJ%f+QPdzVIy?eX|vLUQ%A+PY=9 zC_RwroiL3>PAjz`dt}}(lBPdpCPaw`jXLBlwnWRpgc(u9xA?addJd1M!PTcLK!U^6 zjfrwgt615rkhA(@g%0Lz83AC^3H0ysa4qlbtt#Fr9;(`*)9Yy2TRIL(hyAA^n}XY2 z2BAYg%UIc;sS*l)Yw?dA-i$<8BqO1{=<1>s5vpoRYpqkq?YQle)9WFU)@V zZz(A4t8dhdzk1U8)3kwdjcdMJaa*NlZX>YET?1$X(k$y1KeDhubJtmgPq&3l zJ5g$iOC$S^N{-uTqP2O{cYej597l`$(0J|+-`%}fv286a+i>D&32t(j@akIm)pvn34~tzi?S>`Er#>TfuZKo$b-2(c5Skd z{C7Xomyr#XV`$DaflkmOsP6y{kd2^Hhe=rzcdtI7FZh$en2R8*m?Odbs>gz?UJp3igwx zhO_{gF&2Ej;UJ17h+?7s?dZXwcsDQH-{~O??0Au>jE$mD&?A>0nED$Z)c2~ zf`e)53M9ROvZq34DrHv~6a|Uj$eWnT2O@5vkfsQfXZ^CltW)Xm=-u%Z_;=E@mNB&Rm1F#jFa+?n4QA~5Po0^S*a8_+GvCn zrjLRbfD2s6bW{xlQKHmOrvx4$Nv=fUEZ0Z3_wO&te4%eYlF!hlukvTyWIe*d-5{Z? z?as%8WQW}O^7g%tw?YkGa8uu3$!M=)$=r%4MWsR4yI;(0{@JOUjXYakMoT#w4ST)S zQfpet$ytDiS(xl-RO;%MrWvO5M@`%OSNaIh_aBp==|7Jh|9h^p8cpZ-*m1?vJ1`b? zOsM#GF|0VO;H<&eT;X?S8v?HouxpuVWl>{ru3P+kj~$MG+^stV@ZiK9DSVM0$Ep&! zJzXx(Hdbzi_2H4oBG#KTYsGS}x_sed$`GwW_^@Uc7xh+kHoTp5Si9tzKKm%B)h6|t z<=NtW zpPP)M)lOL-5D<9sSmyuWV+WhZ`cScOzL`J zpwUCf)znUU<3j)uhzLKXK;xB}ehQZr=xHt3LWMY&JLXI!c=_NhE;h*`B4uYmKEsLwF_Q`?3=cQg*UqAD)b()0n8zJYegbzsG9^+G`{v z8U&AumZ@WT9vbIUkhL=JB3jbnYfF^+y9oSN36|$i?}Ly1ej?+CR@BOeg&@{S(91jA zHPg;o($Y2$Xn2+)E6LXi@U-xt49y`MxcWA4DJJ){ z?Wbp)G%}OzkjCSr;Vv3K2zLCv7zJKmD;`OHhgVv%1-Wl|0~1Svac{L-$a6V@p54fSgdm zRaBAjVX0li=Zo_;M=O#tpN~)O6RPhtrQ*Cy*=_ga1cR&7^GN!5@LL}?CJsF5J ztR0-i0Rw{;TVf!#K>*b`ZnjL&qh~A$>eCN<(j&x>+t)zOak7+WoQp21e;5Bwr|8Z) z9+23yp;4h9(N=n!v>x0SCLca){g0jXdgjoUGF8kgi5w_vLAzGMO`|=4?wi>aAgDZn z8ygSM-Exr-+o&=&gb+n=`3=GWR!tEDq=snDMgMS7Rz3X5x+xqnfq)9Yl_dbBWrHbl z6 zvhGkn?p=f6nlfTHj@l+TlmVqlA~l@`39x6=H7`)@iq$y}?ujg?-&YrW89OTz|26;rtD=&L^?$CYoL1NP zzhk%W>M#8fm;fq5Qmtl6Lnx zzVQDr_76dtwQaO6nzn6K+N`u~RN7XhZQHhO8*kdSZQH1m`$Vk08vASf-5K%B=Iv_? zXU(LT3(#O#FR-av_h)S44;x9;`;i>u&p{w6P70yn7PHJ8vw_}|$bjTKNvD&BuB(ONr-?1!CODtV+>Vm0(S(e$oOeRuej>lu`LP{komc~Y!j5rN4N3egF-wW z@pS`t!QuR6n`d9D**u4z7g>3qvA3eG;q_slfjgHXwozt&wNS*^HhG5RnGf>kx1T<}dI;C`>Q5y*iCKFqeX$6F#;H%)U`|{G< z%cVQ_hOYG^p0jH;R(!n(^^DzuVrkf>_oCaT(bdvkr5bIXU8h{X9fm!p7+e8Tgid%H z;N4?sU4AShM1MZ;zNk?qME!5FvmD-WVz8MM0^v{wYYT@c7ONDDfJq=vmqgJYknO3eVo`rV(rs#>>UM1f)NTp!b*d>QbeRy0OD^> zqxJxjo$=ZU7l*hwP{|HY?VlDV!hX!IZ=alg6qI%zO(a>qY*+*>a_=ifOlp!>HVI8T z#a#rqBsxX>ni@|zi6P_3z`CK~OM&0vYkX102EE)+(X(mtkCJD*yJS+5tnN>%@+?(# zfBL%IwYsp&VqcBNTOD@sYP-jc2aOCcd5>92W|1L^4Jp)(6XQ*ZrKjS}x@6jrRp;Y0 zVm;%u?{{@z*3+x*f0J$V;YQrco+&UQh~-`e^S-OHjQ$}ded}9#a95vwqg>c&USUg7 z{D8Rb*3gwsM)1cZ{88Uy$5C|SsMvX39A}kJ9|A;_A+o{H8>8aX$>uLm%G}d(&s6G7 zUpz4vwanT8z>B|_Sbe)LVSH$6+Ce)H)mk4ipTu<+C?2c*WeZv?Fw4&v&6sX=2QduJ*D~Q z95=3%=0OHZ=%F6G7r==rAaqYlbb1^&Lqf(YaPNNf0;Mz-Lb@8qRlK#Z5LhGk(@z|i z7VkiMY#NFg)`#p=Zin-ia%kaK7F4p=0+$zAtPi`v=-%Xm9QSgeChBE3)XKWZOq6H6 z@zEKs#Pj~p{y4JH%Wx-LUOcOOdH2F% za~qudk08zZAAmm-$IsB_e+B&iUk|&og}}1(u>C)=laFy6E}3#ASA*kJXHG;Y4eAg1 z#AR)O$5vO&P9o?CmrG?#5Lo>m2Rp(z_V#SI#9W4L8wQLOMUJ(fg=k%t)eGv*!zQDq zoT~Ip^niYYEJbeiM8)U6d*79F%EV4=L)KUOm$N;-Shr*RNoOS+;}T>)x=s7-E6(ah zkI{7INgs@b(_tb?>pa)fs;fP|Itu77-z)l+>Z*^b~?8tQ1 zpS>TMjK$|+LNuJQp#CNxg+~!1ypR_uI-KW=H%FwUzWopi*VyIMi*Iy-EKuK{(MV}0 z?5yu03CALtS>ENsY$Y0CCecXA|CKZNxW*zg^X#3J=$w*L<=>a~{qt z=P;Kdvp#+}pB2`*^WIjB^pthbfh3UxXPvtmEBT!UOLL<8tly~meoA4?=&~yOv#eKe z;$RK#+2K0$OKFNCQ=?L3`&CI)vW@p|vtI3zvS2+(&IWDsB?GmV4F^;!cKsHAx4#MU zug&Xf-GZCTU{wQR@56pk(Y(WH~SSCu08^kPE>Lihxenx4>H-4;~YR44?61_Ug-$SqxrDf-pYXIM0 zt!YfURxVVVtW-itNdE__&kvEuA$$&bBv=NaU~+NN6^2hs1BX^J&=br?Wyjz-G^?4{ z7z^0o^itlWzb+s>pL`c9yTndh2fa(Pf>zW#n3e>E-;bU9UryuVX%K@)HWlQtea=mP z9jqhP3opk$2Ix(>fruG5;kvZ~>{v}JN&bNOz>@BqNYZ2SP`&%^lcT(qM@}yb75uwF z*e4?buI9WXY7Zozu^<|BnBeW)ycXxpn*uSxaMBJjEFlr(U9tR!zEQqlw6Pdr6ak_b zPl0HF&LDlzVG0{FIC8<%czZbvV5q`Ff{5~jqM9UYK@lorn}%w*m*yJ3Jdf{MA6lnSH-L<3f%?)UCQTQjHP{uOfpmWhlKq0`c28n z2Ei%hn3{$L`Uh zJynE}jdI!Z&ZW#^FS1yHw=?yISm=XT&ssW2vj*01WI1PYX-6RLMQjX7d!X6Y-%1kM z&)H~0fra5{UY{>-=z!JjM~xo+?QQK2^-P&js|B4OxJfP6GBU^U* zDf)5|s`W%Q$qBQmV7Rjoki12@j_YDkxyUwnA+b3O8IseoW?Z@zmmu}#0UJJY$Htx& zYaY`;hy=VRqlG3ia+vC5WEpku1cLB7Sch6Itm7W?xsIr^i$>6qTqpBW zM1xNx<@kW7X2M#Ut1OZ5q~}M^ApzLZ7NJCG&f&iA2T2m7IB+iQlxtvFSQ~o$43k8j4}<39m@zGJ8qwUNHe*l+95ad=LH?yL=df2zVFR8xd8?$;R0V zfz$eapiPBq?VebqT@n9a-CHcp_S20(ztk~mv}t`|aLW^`A>F4?x}zcUl5U|qg$gK} z7K1J1bHcdg@K{YfDHPHA9HAm&Y>4&y|5@$VwU)oE`q_6a=_Ck z{9%Nc51SXUHJd~Qq@8GG5anaZ-(ETo;ui;;IzVuj7HYz zM-uxcbHH^O)vF+C4pt8&8PgzQu423UNN~IwhDQb%B6nh@DGo4>+?c^5pl^{`dk)vk zM(zk^4uW>9+(NjY@!aKZ;^tN}!@GakMhNWphTP(+BkRHIj2JpAA?H=83D2~~eXt1f zaRUZIYixOKQ83JSNNy7-IFmD(S?%*x8g6>S#~Ij4UG@D^Uz@{u{2QsMTonE@)5neCO}Ms;ez~) z6>%McCaZ-?sZWxog+4|}r&z;e(jw17lJHz@2r#QYC(U09QTbbd5&%M~r@CI0gMO?5 z)nHl`(I`$*wS0ewb_!M07RL%fGfTh-%Ec7_che-ZOg@pB0;QV)_H1JTfk~ius~U1xO<`@tmgCrnuFf1*&2u0A|_8YW8oL5gQ^EAOUNNKt)xlzXog#0~OHb&>otRm%&RB ze=}P_YqO#3mxaeaz39X-Of@wX(TFKySH#YRN8F|2un>! zDUkuYB7Tv-p_iMXKS5j({%p@!h{-)$AdB}+eQ``|>S(dihzlk@%w^uK82xj!X4!2r zSfN;?7pJoC9XQY;+Ctq~zkZbo-(Xw7JCdYuuMlr=M!rWOwjZhUTzx+uGHts0upmz- zOqn`iIUJd$G`*`#P$FL`Jf%|;Q^$&@@)l3qA&vsrLALf4M^YlpstAEP`Ylfe1w+GN zt{x86kUZf(eN;YuL{$OiM5Bu&nI)(ZTtOp@F|B#ryh(}=JEGc-Vxn@}V~J3LnoM;| zmp@xy5NxQ63BEd7q^MC}03s}LpxciW`cRaGO{K$?tc3&nEvFluIUG0Mb%QyuhQ&D0 zTaSULY%Mya;bgvPba8C+ZRf-OPbaYUSk25)-#s?>OAS|%pVldxtIr0a>zL3+&$Yoc znIV{e$S(rkF>_^V?ZcXve_H+qXUw(+v*(<@xamNP@I@Bc6GyZ_xt`R5XHCvQMb5bN z3_~w^vSNQ|)j{{ZLoKz8;Hg3kp|XE*zJ*)Y5shXF*&m{ZtGmso4S$;F=zf?y3?qF- z+}F%$D>qlqYqlrj_I!UGi03PB>L&UseS=^GuT_l=x!`qykR05{KrA2}bcF!TO+r9A zM)o!~k#&AH4kD6lC6h$cpcO-p+)VGT)juj}WHft8^Iql-EWo2+pG0*gB!-5fXpR)? zqQa^o@(PEJ9Kq%lZ3+n4 z|70#(M+giR`ns9UUW}F=e+u|dC0eTun27^haTpsan;ISvLuiiC61oAH?H^mI{Sh`z z`~uFYUwhSYQcR{!c|}4z9zWc?My z8agq7lZr8j4&MuWKgOwO+`9W}ah(|ZxlH>`kzg=7$35fJ9Pdqw8*E_8juj&k%Wh;K z@Ci+&WLBrUm2H@QHnaewbAj?}c7RcjMF`EpkX*MyZ-X-z0&s;`-7~(^z<$9+|1@YY zAnejDg|Ru*y_9X$*7#!)b_@4*DiUYJ;NzQIAoRTaTrlTz)+5uh^vpmU5Xw6Jj`X|< z-w+>D&`SXM2W6c_Y=5JL?pu+xWx|ae#TBRisOs3dx>;IWYDBhrl~F`t1@bC#67f95 z=#9h1N%+KiZ^vPHS$Na;2GaUt+4^2wCM0|g_Qu)zA0OuEd^}M$bFf1tW5l_HhygA72e3sOS#35J>C|NB4KMot`xAwdG#AAMNWmxtU?6CGX@HdP zmHRsmFMt$Q7eh#Hml6d4jumdpsRzKSmC4MX?oguq7tkiVZ1YtSHl@tbpPPfT%7PQ_ zSiOv?4zqA^u*PhLDUGGzf1^k5|3YCl5(^%pF@uDTXD2xD1p;XEf>&Zd$6;YQjD&(;{Tns~W+}NQo);bD zY^aW#L2Tvt#UTqJk5;aeomJIAu_wc10y87@av#f2{0|NLnYcAg@acWw)kdGT(o>0eCfH!c1A$$LDv6hiSvxfV!jsYL*CP&vsm;a`=U*j}~ zj}v|?^7}!hE&XMPpU|U=!*`{&W8^kpPtSYs=O=p3Gw-pP@~O2SvBLORAwCy7+FAVT zUI=EovQjkhy;{k5e?5cOrWp)CZh!aIn%Pqe%)p~p!^@=Ei`=`Ww?%(R;X0tfhNXiq zlg9V0(Aw3I;UqbT3%NMdC1%r=xHdRaUP=90XQM09dGK0y7ODne%#WD{O%&}r*C4;b z*KBq2VXStRsiZGndd^!S2eX8j+Ja4UBvo$H&{te6*qHBu%?d75Tj*XHlXHpHsjP}> z_}j(UN&e8#S=xk%P#-PaR7|}52C_Z89hSc|+D?x)fPAkv;;Ew3p|-^PT*1|>MmF@k zaO}^vl6EKT?q$am(OP+zy*gMwCXY?7e>fpQk__D@t%KHX@Sfi(U72@BW${z&Z8P?P5lY0Ip5t<#Rz#P59qR& z_1y8jtS{$elCCqqYmZax%>AtWj_xl?w23e`jbB(pYfR)>9N3jg5kQZ2yN~XtKI>hp zU`2bSC2cuzc1mQ?>P&u2o_@`?t8l{gugN6i@cleUTe8}Pa6n=A}PlV zrTCYvF{+9B)w*-W1nLsNe0(XmJ`OZ9U}_OQ)vSnFoGI;t$YFn37tH>7A6JZUn{Iax zBkC-(t_yw@m?~Dk&=jrh7j=bll=f<}Nm)MhCLjf+cmg$Q9`?Tg(_?&5TVbTx;hhNE zWPEcE-KpDmDcg62?z=HBAt7J5@~^+r-G^m0B;joZ;$?S4nk!Nu5H0L(?k~<~_opZs z$#NlPA=^ng5bhQ*Np~YM!eA?MA6xSDgCxy8h40wj9O|D5jDdeBY||sJ;z*PQaYkHRrq9Sk1gDF#Qa%u@?CUqK0g4{U7bv&ob)&+RXhQ z8##8i|9$%T|FmNqm!7_&vov+a=AV;}Z69&fV>O{IxEW4Zb=+uDRiqtjs&cC9&OP5E z@h(;?Tgz98lo3U*D3Tk0tu=KouI4U=;<+z^tLs?^zyg;Ix9)jopgjYZ?RGi87|rPl zmP?;;)4#9W`%K9Vzimbqruid#HZ@jh?w)vduw$YWCXizM4@V3CYHrz~_1m*!fk2{k zqi5&s04`p?T9DV^zYH?_m@RM86vE>E4vNS$M*S5jq1_Y76?5}}EJ#DK!hYbI)1)Tt z*oj!euz$%?z~5m}lBi2*^N}MP?G(r9o&vu*;80Vrm50ZAUWc<6mNt$04dLp&gZ=Vh zUc5fSbKw*SFr!Qpqcp%_1-{kw1M*A3Q)}563J`D8ph-uHRTin+qf(1%6F51yZ#kd= zzSHDH4~8h4UpgdDtT6Vfj{^ii`jPY4(W9u2F) zun2sIi#hQdGZC8f)WzMjtP|^uauP)Jhmr0_BWM^e4d#{oPNfF1?qiCRIn6ZUNizRgz(8U$)Jh%9>$0A zfTpb@ll7w{o9TscbYVpDY5aaisiDIBHO3O+i?yX@@nYn z@!(@)V(e|{%5zno3vknl>6?>Qgdh{aH^$7}lg1Z#bUt+z8bkQJk$ACDiBOgLXW+I_ z3gF4>Ta(axFGF_1-njNQf+E=}**D@9Y?6ASma-vIcozV=cX+^3#n0VCo8{suSdztH zGhOmvtE+b8>H5^N`&ORGP?}m>y7G`HRi39=4@5E~qD^Y9%hq5i$D&#OTP;WMt{-KA zEIlPef7X^;L6`TyCGjHRynt>%PrV@$mxfZ0?B(x$)I$PLDpx}$V|>Rfq7Ik)TX*wW zj4HCdD%tq;#0q-2_#C{s@-k>k3&xB_#3xEwSC~P zD9&bjD?62Tx0iCvBpp4ux?-?Dj6&*7Q?%+i#GQOH9=|9^^?dvuTl*)34FJm!lDkhM za*PDOXL5G!?pxWJgSBo{EJrZ22;i?3Um%LKzyCIZpI!$)MfUCA9v`vfaH5uDVvErT-ncOM=eLKh2NL8#{onYzIt}fCM<HHq!CGu)yl0^v9%{{kv`q%-gHA6B#{ltLnV|LP-9=L+(Uyo9`+OsZb!JdZoGOf?NWJy$la zcdTs5VOCz`4876syYjdg)ho;Jwn_gn->jB1RJ()!w-2PQ*j?g~T2p=4U%H$6v~1tx zShU`TX?CO2GO181OPeZv;4`!mouSf?3{jR24?Sc&O_fh>Po9gOpxGcZ$@9++Iu~9n zyPS$Gz>JmskaR)flm+h+tg9pBpuAeKWMpajeq8Zq9K-=OEjn*KZj8*LGC!22aiZ-c zrhss_=1bvQx~iAS@>0JcqaZG}oTt_{6?QMNY#V1OhX2up6e0+unsfOG8c-rrJ(Mp2 zY)L0YHqKHKqd=6fy>2A^>WR66KZ&37wa%3AEB}7PE8^rwjj$6B$=|z<)>nIQZL~He zXg<4?ELbHVliw~~aLZka_O0(bz7EN2e3dPj`tR3$5kna_6Jy?-y;y?zIADjYtmV}UWv;abgck(;&&ht3vigRw<4IoJ6q7@ z^6vlfHLi}ew_2L_rX8!UpM|Z3b@}_Tk@#llV9lpU9(fj?Sc4$nzF~|g3R7`is6Blk z;#)qb7LkHq#E3~y(Y_luGL_a;ug8-tQs0^M5C(G2nlgK~f9l(q;T82CiIV+4Z~0jN zXQ!TSwf_US+G)=Oor^Hq=8dL53pN+aafS0nCj&^a;br|%G*OJ*?~ZOFhXPP6=4$qr z-AU*p1Gk2**NRQ7;3i(3A154~TI_g#k>=mL4l^@ZO_0=_;QrYmS#*v%T7R|jSbn{@ zZ*BacK}dBbegTf8@yHx=A{kPStZG`{R`ZXy*k;^tk{uOOvsCPSjL)=YFk=3Kp^Ux& zneT%Egfck(2#9xaU_$S(nkYYLM^P*`Oy-im@~UY)u+;*8?L~@K=R9hmaT~mV)3^_d z=wzR=ebAX3%2+cyTN@c_krol_y5T0%Ae+E}`z~W0j-c`wJ{6Mi1(szC9HL1+MM4+#V1%qvt%zi!u8(RLUN6It`+ z$^RIs0A%0hc;qlajcstv%9~(YJI0#Y#2)&!aZ(v4j(GAY1vKv@{ndG@#85JEe|<}JZ*++*QmHssbGY+}nUa1Y zub>q&0?Zh9NMnW0W_u2F)X>f%g1K>=%RS6|3Rn6LN@^JlWS|> zSKwz9=4DI6T1$G799G3pg+vy^s_kj;t0G`XTe3Pd%WpfG*qObh_-lV^HN_rUnmC}0 z@eB6%(n5t@ts`34K8LLcyk_vCSL&`$O6pZ#^*m&O)@gBfAW(U~?FwCjrHMQ_wk`&- zs)~1?`Q<3NFyKk-4bg8&5WTNB1zRpeye2hv(;j~*8w$=t12wry7H3iti^3#l&wPUY z6@{q6Nm#bXr>%^KtcMCvkyN}$s?OoL$OgP^@3pV-XYu6^IFWFWvxNRvKpwOe4xb*} zIzSNL`GeSJ6`j|mbUJRJ=IQ>Yi4LTI@Z6**W=U@f<-JbaAE3L-Z)=esthD`8YMBtU zLuhS2JapGE7vCntuAm~nIV_&#q!)kvQEMb*tt#YUi}TcaZ#Bw`Y}q$!`=@8+bZNDm zK@0xmZfBzgY&GAwAd_E1yVWSqZj>*LDdrN=Xi@~LnP_$~TRNajVJbzUUN`%%Q%5{q0;x4*tQ$zVcCYoPCL&xi-*<1km#v3{O!HQ&L1L&@{4ONb4~9t zGsxuw?eng_{!(u+kp0`>mSD_bTk~D)`Wh!}_XV;l{`Fs|COH5 z;CzWW`Q&@G=Crd72v5u-z5iv_?p$}0FNwstFeq)o#5Zhl(Z8fx@F857SP#(tK(t5h2!V$VE?9C_z~h8l{WIFetBGiR607W zckUjr#K|XprmLJO*6$)(GrtVoz7>R#qAn>?<`#%L`p{+oTQM4bbLHK*my)+kX^c{C z*1e-U51UQd9Az9v&Ja_VR;r@bykSx7(RK@_WDqyXavN}k_jmOOG`{?R@)WK}P3h3Y zQ%^ZtTmP(yPKN0|6n$om=qCmV)_0d}O+e#Ric=p&_Vh45He5M}O^GcQBYMCxN(#zP z(J5eK5E(N6T7u<$ts9O(%ly5bPe2OF`OFyCbS;KuRHq{hkInuUI2R1ZjUQr$iQZ8b z+(5&7_(=2C==OJ39+AxB68M;f;9nzW)8QoJGrnH|IHCwLmr<#HfT8XjTXi~#cqPa1 zw0e4r@uGm|=Xc52JPLNC&u*iD7R9%Ko+oNrGSzV$hE7~EKDXf`08r8l6}G^CIU$tV7?)k(S%IVMyY_{9Sqi2SMq zLY7m-T-Tp5X9r6{6pXB$_1bd^Qq~`EqTD+yW19>9J7*9|duI4VF6_Shf&c+B2}Q7> zG{Y8L%KbV)s*bg=xf3X4=j<{O4ERbU$GNa4S{#e&olXH`(T{7w@*9Jp1(}Uz;!;u) z1S@TowQcp+13c=AvK%Zq-R6Uqu5x+d!%c|EqoZV}nr=Kr%{!{Vi_X~#5$ffGctYwL z_Rg8NogonhIJ^zh>%7Rqy9Fx(Z(M1CNJwE;qEIX=!%$*QN!Mz_hqnodkd1XZhU(e5 zf6Xw``>E8IDx@#=MLlVA9&@ET2&JvMN#bVmx9^@(HD&@Sy)yIF4<9&}8Zyf)O-;d5 zD+gBN(EX}{$le$m`Nr7*0coMlYt$bVJh=yx+Ngf}#LtR;GG~t8;)aJFFT-v58JpHP zRboVQROc}PRdb(|Rn?BPDbUyI0cZR>H8F~Bw(3j%o-nluN7$xzu;dQ*9V!!!0QRek zyv0*e zfvo03mL^NCvDc8Onb#FeGjL?-IhaRcd7n9TEuO43!Uhlr@N56I2@+df+-He`uAE(_ z1)-FhnR3s0;(I?`_-cDV=L}W5S&b7^XZF*%Lw(j3z1qr8k%NMM#*{STO^qcz*7Px% zTAh8JFI1j~@wuWdom{n!nX?Y?gWKm;+N@NoJEF8yQRrZT@XjR8#N1~~89a%G+OLK& z(@&+Bv!+YG6Rt#0#7<*78TgVe+~0Vapx6qXaLx zWhZ#@dV+U2S7B(A|BgUyT2tIGJ--*?%NJKp4&aX4m0~ zm&^EizoV9p$Z}gt94-8RbO55As;iGQdt!VvVoXixo?6&z7sul0XkgWgr!K7XU(Lh&iK&! z-A1EbLCLIj<#|`O31GCD-$`&v6~dD9VxE0i*O_8}#gShL_&DmU;yLM`t}lJ%x=l@H z5F`94amnnUUL42kBIg8DFd3q_owabO@t=Hn$4U=?d;E6Ea%_r^!31TGPAb0w%DLI~ zyiP<697Z5$qk_8{IbyZ9PGsmO%0cx3x*B7>JRTRxda(|9$f8z^<(_nDTYkh>RVEKQ zGb#R7td>@UR#~(xe0Dnzes&!>Ogr&sU97pbmlYAq%L>GT944T40R*J{2_|~$E^YHc z$}ooe2nAA0b$dpqM$gXg5t%k1lgXYyOsnWYHA$)WljC|09_K^dl$2-7{(Px(iMYM2 zlM8~qD&&!wjU*eLm9{#g-BJ61Kmm9n0qz!4o*n7KiAvdd1+3z}k5$^2`dLMX-$!?n z`}!)NON8x^b=1yz^k#W=QR8DuYK-s01ng_KQ=`}yOZMTGgA)H9LGR#GLI{76!K3wG z5j;3&2x0H{ea{m@cVBmG8dOwo6VweDu6xCS(0yuiyw=Mt#Z?*RG9UQQU>v6AD+H2PctGtZTL*I6N8T_ z@)}c$A3QH1IJ;tWMc$OHo}}gQYogNA!r&C4B2jpV{mUE9Kfkf0gOT>KuQ!voT*K#0 zXxf8fOKZbREaELzy>B)C98=ukEr5e%&>1E(E3#=ex%1^27-t|7iP{*@7?uOJk6h%Az@uw&7=gdRHf?=N>T;?ZE$Se zW*!W^r3RS@BC~`4U`fZ>n<+FExXhZJe{s(q2Os@#6NI0c@Eyp!)BJ?L~p8nKy-WyY0f3u|oVm4z#LJODj&YVUvdE2}JV7E6b z_9lY^zu-RS+=I@%5?yD7eA=Ah>%|Ox6X7@`-LZ@EJ`JIB{Mi6aUP2ei*GYa$B*9Q2 z4+&R~C=J&f(?o}5LKwXADvccr1)pD$?ej~D$j`*^5co7K_WXj@CI+*?`y$l-2mXRq zEdT$F;T(+rRid-A|L;Q?b?Mk2)iJ5RoI|!kP>06(qCgETB2}BedH+c zo5y&pU%Fk0fbLBr)59F0<*ajTT|f4g2Y5m>9j#c+-j_oYpTQ(u%q4Wt62Dotw9-Fa z&VB@Nm993o`rA|2;&Iko`0<#JmkJhrK;3hlz_FY0m%irt)# z=m+pc$S&CZ(wERv8&20uMY13$Ws-^okH29}Q4=A-mJV;#CjqIa_<31&PI4p&1ER-c z)H-t(H!{wpW(SuBo04p(u9Z(3HUgn;xyR+5xZ{=OTBq`%n2s+HuIWdh(}X}BZt0~K zj}d$`NM40kjce#w!-%O^>V+qmaiN8Q5U_)hoTb;60xL3L|J+`lt5J1AT92xMq3_D@ z-F8-lY3EO`q38{#3ZGvC@W+w29-?qfCsg9Aq|X{3F5J?`R2Ee{9|^<*K!pD+>M(ujOx$uUL(^Y&N}(UT6zB9=c7YFDViHgs@m!E$zj~>XLU) zS)XQ=+0k&2##~J57cPWH@dxjc2Mak6rG)6yr;}F_S*5=0?8O72M;H+}mQy`p>L-oc zj5-!Wh1Zx_Og2@wWZbhK$V`A{g)cch9w|i&Q8cz+=^%^paZEmWk!-MKJ!qJaW=?0e zXEQO^U*qzhMGm$wIkUCFz=W1)v)Bvm7%Hfaq`aI+`5wC0`tyU+*@x3)7avCM(@zMg zDQWO^pvVQ+1UW9k^ntabC{1@UvT?!JcOU5=`>ZT-@87>~x`tiDv8aK04Shk-?oq49 z(u+G(siYE7EuRXN)WcIBa-$!{jKM(?7jU?Q5!qkjNGn%%ayyw9v9E9c-KwvexpGqd zIr5l;`<-B>_*?C=J0F0dY44tLknruq!vrLKM(Z!J-Oh7@C1?}K)cOe{xa~%qx+OJ9 z2FlAw%I0*-i}Qm8NEgw7T3>V+uZC<+qoey#NW((T;6=!T!E&dr(c5Pu%NT^-n{}l$ zjU3fBtT^dzU|o2so)Tmr0up$b0ebJMPiP{ zMzmFx!mMQH@4QgQktfu>^l%1gld3wl^({n zEUy9q_+xogOH&$8D$x5pEQ|Tvm-KO^ES-=RA!2Bxb+wRIWnwiaDa=iCZ{8I?v)XbLYJAdC%3nSkXf zj!t0T$(7WT`h_J1?|P#fG-Yr1ig!z^-nR3Jv88&!Oqx9h+C7KQ(n>ikMmWmnGA*@l zV83SSbn7CY_V#zouQM8?|H_^JrG&=G@;@t~b*o?eZ2nRH<@5+izzzZ%s-Qj5+VDGN z9?ouD7i_rQNY^l$hsS`Q?x7x;KJ4tkg)R=nFI?i=5u(f$?(lH3;Eg*H;LW^!tj$z5 zy0-GzDX~X?j%rxrAG^~dl2F9(upa^%$Fn~~k+glZz7Dpmd&MPk9M~ni;tH7vGh0L# z)6I+ncbU8_?xgv}NbI*hsVcmwmVzD@AGWGzvcb{{1u`=@q%k@bQR1rDjg3#E8G*~- zs=_hB(x3!^TK(8lCuScoa&hAqq%1DXvm@nZr6@fxp8Wo$VtU+;gprI@zm&~t6trMj zJ#DheNG1XkrS6&HT*w+|Xeg83*-Cr(fWbJ#o2=+BY*dWZ4j)?@HY%0|MRaIP@W1?N zCp2>8`DP`?{VJ`(JM+Q_Fyjh^`jqE#gwkHALSCcs%K4{w`7U^W4pL^^ z9Dfys$M3L^TEtj(MZ{b2>rSU-zb`44GV|R(rASoKp7FR-m-*>RGD5YQy}>i7LAO$_ z312yvC&G#YGo>ck*+-dKwi;%sTJ06abx$p9%~_Eu`^Wl*36~|JI)Aa>x^j%Z8t`o& z=;>HoErI&8rm!4`W*hka=gcNPjp0nOaZ`|Gmj$DnD>1=owDYOG+6EtOv(ePFnku^@ zh>#og>hT9JREOy7%k!%j$$WF8s=U=^jc5FMn_Vt*g#Cdu>zf}`5ELtNlX0KLH12i4 z=O5Rd6#=u93hEzQsBLBUdj~kcc*&H>MrSQ?%Rk~J91FU=GIQ;FKF2?%OgR0S>`(Po9<;QUdrR&p#r${B5Q|r3th&E$->!$d zwv$Ea%(U;wu{(_M4ol})5z@+zPyZ>?thubPHYr>kDe;@|ows@8N5Of;JD(PaSDB-m z(aXoY2igR!tU|$mf3CwcE*W(Nlk0>x#90E&zb~3DfqSyBl=T?;$nz1id2VA96!`qq z&YRi=cgZ*Z`I>DbHcXo?u1%d^?wG-~@q|9L#seKk&LU=2adrMX=H%=Ox<0*UwI^U} z0)cWo09s0(-dek%U_gE!KZvy@hbzDYhofhW$8{eYyO2SWPxE4zUA6lte-1@(7?j@^ zZC!{oj?YITU@)fYC@4R(ULL(7lg>lq<)<;;LSDvO4MKi~{-o6oqv&VVA~|S}GGxhz zYxPSU$(gb<42tJWb!qVXwTal>htX_%jyK~V8^YC(ER^ZW{K*s2jqs)i&A&zaHaV35 zxhdLVqJf;#NTr-Yg@`eDKxzyi(=y9w`$l1x-*E6ae9H|DC?K@u}69=Fg$z@ zj@ShO$;c0t#|jL7^lLnUhy!@)T&QImI;3ZT5Q*%@6xl z$ZOnTIxF5rwV8kx5WjY~sPS3qggq=-elFB5l+PW{7!c{d&4X?vQ11lB@f4F!vdmGk zyz%2%r0psgJIV28q4j7q;zr*3;Lv%uucOpHJ2wf-(dgp>@~gpp|Joo!#3YPag4=Jx z>BYzNF{eN-L^~kRA2$a_M*G}O05oL zfc?IXea0mYMAT5ldCDxD+=L(Bt{_9Y2E+6j+exwkABR2TgfjV52arNjw3xB8Kl2jV1 zZ&BdJm(V}cRHO+LGucqhNW;T%EZfhgcfv#!^M-RlWcz~xH(rz%YdIn-7AaOc)mVO{ zgzf>=pIgE0XSC%Y%I}C}zF`;$%%cFxg^gWSeU(2Qb$1(?Ak7d$56_=pv-_==q4)UJ zA8NcKF$q4vY_Tgan?C^X-$8f>0MnT>u;3$Vy`wQlX0g0bT=pS-z+z%DHIouWT?Xh4 z)2p9#gK2L$iJX3o)xsHgY?4Nf1jNJ!!N8_L5)@<(fHuKo-vBY~==R(Bv%#u}h75V9 z5^0(8Fh7ZQTKq=1zLm;=qcEw9OZ(-vQUEvlao=9B^v98LAV3yTMWBbJKmYVY(eQOM z98BlwJvci+NNeBpo^j9KLMqD#Ygl+I_R%VD>rHr1yim;-iH{fGPuKHpo{|qf6W~1= zjC#N%+!}iP_*`{c$KAta563r>nN1vHM$q^AMEHiu3h^JQo$2>~j5gVSzW$F$bF=!7 zG2?GI-<}?lQ)#Q+gvO&-4)Aw7-0K#EAqb~4-Ijbit0Tk7deDut5nq0#BCD~JYUd7K zFcPwic%LGPi0yrgJvyJZHyc;S7c7X#D-YaAw|Z_`uNf^!gRa%VZ7!HW!&C+zS3qs% z@R#Gu!j=&dPDB1lEju)&l8`|V2|Gb0z!R-xTcr+qIlM=sY7m0rEVGI)d*@_mOh+{5 zq^n@>#MO3tvw(iK@&4=ScZ5U-t(@qJkKk|ewZzL9XPYqq$3&CG#raUteIn0Qj}Hx{ zwdD0Sz%wn0$5&#aHgWR&{1$x7ElxZ2K9KCH@4aZ7x)S#d?>AY85G;7hC!y|PV>2D> zJ2V!9CdGEj;Wh5cOIGQGq^dsp!t;UsA#B;G{Ib1}$6@Kis3R@I#^8lDNmJ@pCynm~ zr;0}cXJVay$!M5lCi$0)v3H(ghtHuGS0J1XTC{(o`+9NfwUk@`o4S+ucSm7;lEs8^ zj9#;-4sxf{*Wj5xf{sc1w_5B;bnPdS4Vsba&4z{1fZ2BTx z0vCHYtRIUhyxl)xZBS{kDBY96mJBl>=yGAw4}{%Qx{l$=odnivcv4~-Fxh$-xD?$i zglz$BJ4TIbNIu~#xswrzUk)R(C5q@00)Z4_xobUY46rkz<~AaDaYuE(*By>22|ygT zJOV6~KoCQYn-Qq`xg{O^eiyK=+cYE5Ted;y);843*FN|FjjDaTo--fx2tjBe3^IgZ zWD1%KLD)bLh$jSEYt?BSbR^BL-<0+>U{b~-0tZ)&p15DQ-< z1TK}VBq#gu!@_7rsvy<@Hm46&1){`tWoX*b9|t}(JU3a=VLvYaIKCr8+?dKjR%DKpd{a$01gA3+lKEb0I|JmWB|A@~Yq8!-enXHcK*w+o^YU z@)5s9)8O{DcX^B9^rU#eZk%#;l<1~AS!TyBt;+3ltLT!Qy57ss-6KJmBOMTl#E^1m zh%ap_3&W#gNvNO55h*_3)@Fao`U9VouW0d}bHuv3uL{j2Ex9FGqNB8mfl3*~remW0 zS5CCQuoE)-gT0qeVNLO|w~QrVXG!uK}-OxH#2)xe-QHlFL-eKe2bs6D0Iqqe+9xbruZ(9OS&&zSn$H zBD)hNW%B{vyP)|!s>zpCQsXtX)1%pg6{}cpD){>n_hY+HGeL|ID`Z55tA$AH5e> z*ZmD#3~$nHgKRSyS|TVvgZP?ZgrQB)37Tdf^qW~Gqk#w6D7d;?%ax<5O6@W&YsYFn zR45D?2Q|bJL;7(dBE;G6v$Pu-*NN@e@Iwz3G4}T6v~8$>c(3ff!9u};LI0x&{wH>o zo#}suFAZy4IxmVL{M_^o2&b3x4x?`i(`)f5B)C{8ONCqV102R5I~NGTizh&SzHWE( zt|t(M#-Y6v*4y2_Ja=v{*JRxfuVMZ$y?gL+aV1;fG|VCIxcA^Wj~Xg@81Fi#Q4hQK zVD+X`*uUF-U(S~&R3|dsr9bJ$8PD)|JwM>cN8?a;{^R9BwQWg%5*lPj=0ghqFw{vh z4ed5hy{%_Jh;H~-oHG-2DHA7Ks+f)9Av||k?m%vjD?SuHW4)5N!8#I=?HJ1`rK!z! zC7iS~m^OU{ToJQSZMK+xG;{QeS~Gc-()DL;l2{2cA4QwdEdlVLb`4}pTa-UD|Gs#J ztar6hB!q6WX|sD(qv#Jh;Qez*q~F-ow({EU*Cdb{zdDdh{6L*O`XZ39+R@au1)khz zT!YWzIluCQg*r|OQq)v7#zwU{eWF)}@GF9nAbfWtDB_CjiJ(J_r-OHx0kJs9k<0Um zt&=S;8`#00cmg2tik1MC@jU`(9`DMU*Br{^h$feif2aA*Mp%f-C(nz`R+hz_QC6I> zkH4Poa@7F;&7#Pd@{TeKpk%(On}e08-WCR%9OE7piZsbEA-O6|XGNhH6BWb#4K!&q zdM>jqCq$dPh?}FJM|(dkp?u;Mi8@fU*niwk8xz;IX;CcZ4m0b$} zX#EE+1E*ZW1c>oz0>0w1W42rLUH<-^8|l-B?(inQq6}!KR?fMNBx^f4M5G$VjwYO5 zYCZUt6R0xL+54Y9Xk-*%J%@grpT>>l)h8iA{^G4~TGPzoigIgtFq8o=L8sRls8tL) zVK?BQtfyL8O&M(5&NM6KWPN+}zl2p0)RM#Rm2{ z0k^>>LS66;$=AL#2<75kL!>#y$88nJXKU@vk#@U{OY^wDl0CF7sMY$S|2`<2<~>C( zQ;${J6OAxw^G%jo8u>yg(xm?@`wAJ}hk zIIuH9U5Y+wEB!Z^)QPN{abN;5>^VDsM4-aAs^>kbRO6WvP&J~oCM;c@Uw45)^>0QY z#E_1B)|$(V28l`gEr@!M*|RrxMnYG#&=OW|SW#8op!&dsc7fip2+^MreYIVThrUFh47maJzIeJ| zh#qrVJ;o0}D$UF<45C;TCMiQlM@SM-+gyEfY=n=(vMNux^H3G7m@+vpTY862o)Rl) zG{1Ui>Vbg9iYN)J*SbsLOoe)bq`hua$$TvSn5fjh$x@&1M!;ow&uINEjBCR zCr4b`to2DlRn4h27noZb4O&YO0Oep8-W|}vfNvAEllI#Dn-uXw$rN_q{rScb6Cdp# z{O_sAel+hkCeJy<7||19sU!_8!`|35m_bQobd>qF&Z?IVaQ;XGMmBwsv8z>8m;Bpr z)*}bSR!Xr&RJ_D(6dSM-?B$Ud0`|Kgv-<7)v|Mo1mPU9m%y(K?Mg?uADZmChhAwv> zw-*Zpc=yq7;B=comj5b-|0(t|{LeP8VGZfT-;VHiP&#K@oGu|9;mI~_m}tg*Zo*~h zwuzS@Bi_>9Lgv|)uqFF(35}447tJkpbqfN6HC}iq&m>J&Zuw zJStlQV1FB!pkJy@Yl1&R2IiS~zQe7+S-2NV!*h_dPn|~f6XJ}IVLx@+KP4|FH~wpS zOR2`@oyMR^t<_5YJ&+P~Snk&aVR)3l{9k>71*tXXG?>D5wX=YFCGf@}qy1|xc{)YH zv=J~D<}j-YtR$o=W{uYwDG-;oUyX>}06QhRXY^GCr^26OJac)!h(<|hIupa(6CRk!iyqmenwJP%_(e}^@AB;|v@bO~pb5wBV#u2P1kfWf#-st=*h z(tE{`V=0@un9aJCqI2unNhebcG1xJbCg3%Ntf=`iyvspMwiUnY-Y?4)gKd zSy?Ho4OY!*>_sX{5G+%Zb82}4tsl}eVT2gsiv#gy>ifY4oq=6rD~Iom+66e35J({YZqFo>{L2wnTR5OW*jp?Y#F8jhWXA zdp7!T4ee^XZts_d+Sbsnkl3@z#f5ktWIwu6HgL4RK=%8p*a;Jaa10>-neTS87c$Z; z9Dz#1$v6^F8a;vEzf3zjJ{pZj$1qS(IAi3PX!#r@OT4_KF&RImKVu5gd{KjZO(BVM zJ5aJ)s82vuVC(KW{)!u@($oyNQ`G|R15hRg%kgHaf2ERwPx3KXM`;pDZYurPWQhGY z)icoGx_M!&sXx(tYQ5CPQr1h6AlMip`F(zmlezVGT>wN@<^`JiBvyv_l$;8PvnN;p z<<6cosx!ED`zF>8UjSm**5$JRkt`rYWN>jhoJDo&gaKlFRCa1w&UQVb?z|1-T-ooe ziyXDs4%Tk}S=1KJIZ-Qqbm>qi9VQyYi5ljNV^Fyv&Sz8jFlrdU&`(b)9}e#dvjmS! zRmqCuglW+u5^%Efz(i>`S$h$M^6ci#?f_vZU$Y$*T$*{$!K&C;w+zX_OOvrU4_*~r zdlrQ`5mO|q71u$c8d{lmVH`MG>bu}1aS!GJ)XrDK0ynF{R_1Un!pWXs`2c9lp{bCZ z3YBx=1--7JW}*XQqr5xIwg9t-`a2Z%E%xU*uH{(Z92Ht%7SnyB=2IveQ1C^6*l;KQ zKgu^V$A1aB9RKsKYBq-Mub_MN`y~gof21tMCoJbm& zA93EOS@-jJsQu&hVzu)_LnDg_{!53%A@;=M>-!ZRKkk}rZ<5~bMTF`JkbVL|a@5WC z)RPE4tDy!F0#_B6G~bg{{;QM#(q5MyF4#FiS0AupU1B6@$o--Sn{+0%g7-CuvqgLS z)yHvgs6Wwmurx%Tt(t3WhHJl54=rd$TU4By-Nh4#{rcWT&1sU{YYC<4X<&{%VTjG2 ze4y`NcnU)5+`UEU(=5{PKTo2mY|*nLI6i#z{6;Q`f!7L^JcnjVYcZ9Nl6Mr4`4SLf zgqjOW+trFHELuWuC*2nip#1#iqGO+Ro6SR!@1&!j#bw{O(dPmZhomc1LDE{NW1&0= zi|7Cb(VsUIya70P`lc$6N%k2otACHP`6@OPc ze-2e0Hk_A4caaS?ZomQV-YHtZ3=4wo*sjNtx-}-)JqR zJEM8-VWku4WI~08LC|>x((Ai+0Mm9?IRr!oexLYjfTB9!xBxhTBsEOHw}dN_WV5{3 z_z)3=Jd!Y-036cAHPWzySNL9#cYZ~cyJe_INev;bgw>LuoR=f=pp~h780vqJ`3dQ? z{QD~}iDa?98Hll6VDcxyt6doSE4cG_+sppqx99~MCEsFcE%8AOQ{mby2K39cH%_HW zL)-Wp&eOR;;MsAZ3&9vArGK5?*3-ZUMdRY)h;V~I6rdrgRTL=-OIy~}rgIcp;_8-R zVSyU940ghUuEDpZN$X__J`47E07q`)VK@$#NVKzbFVIW9apO3y0aPc=YMt>7vI7LF z-zxftwN3+E#CW)(@rH&pAJTIyp5QD|{=&j2sgEi(?_@o>cH&b%G+n6aAkK7C?v;qG z{YDo5Tk5Kkaa<1wTU*Ss?unn!^GR8R&zo9RkJ``gt*{H!WeaVfW`|m2j&QcvaSR)Oa?;_YLsgrYfMI;8z22v*j3z$_%Xr^N{1!O0Ov)$H}mjkCett!eY z8||7`xuVN%5ao~10!y+GR7r&}CIE3BV4WyKE3zhqHof>DUhbTGecFWBhyoVordw0l zp@hmN8Me?fwh%uGWw550jD0>%;y~;6gsxJV+-`P3FRf7 zc1HJIp#n9eq3y^#j&w`DZ|jmE)QXb@De3fcr>jy0hn9 zeF5TPn8+v<(D$N&=(DH6{Z=UL0LHZ&-J|c_m;d602M9J9Zn%4fCAzKw`ekby`bu~; zBwXufY`U^r|6@pRCPGxktl@N+e~Sof z>uy2wepL3)MJ-MR5@R;vFb8o1C$jQ567mri3vfYOnor+b8W}7)l1)?s2A9I;I74^U zAwQ+}piS-2suAx}EKZeL_`qK|H}sluyEORdi3Ep^C_-igTB?{hCX{|m7&hMB5 zHJn<-M?gl9JcG!7u9p^ZswO|-MwOl?`|>YbUrPen*W5$S@6J$LhGYXoD`Y0-+AS*a zMkEd4TJ~4*U~)qU73~^FmVE;=yte4+!0VIE?J0nFj`x29^J$6a$mPQW_LWzm!{&E1ZXEQ0&6X*%o-ERVNRI5CfEQ{@bF|rMdkH?mBt=_dhD>f6|^={&(KV^8ed+Qd@V(Ztv=%wwpP9k`eD0aAg|W~yUpd(Yx_%m zp1&?5;3S~iGAfjkPI)DwvUonVo8bLfhN4UH9ZlcDS>X^4=qvBR0>PmA0$m}KY zD|d#+$l56S9g)AgpN*LLPmpm*Yv7cbH>J;9wZYnz+Ar2pI#L#GzBwZG!Z;H+^l%Wy za(hT`;n^0T7vWzC=$RdRp7Cn!WG&S6b)t(7l(n_cw{0VF5JWdp@i3AL9 zTr3U{h4s>~UC3i|nru!l%dbr~5!!wokT{Q37)in306JGAQC7O2UX4ybLRY!CU$UEQ z-R~km3u>;~M1X{Xd(!kx0(4TcJj=N-rV%P~X*q~=7ghu2A^HywNIBkJqT%b84=NAi zYI!%KyMVkvXQUg!?+qV_bUaH_DYxIZ60M&w=jgXPc5D{Q2x4OJRnxeGmpr&DQr%iS zo+dohBIy$yWv}XB*v@6c6Mm|K^nY9@8=De;@*U9!hZAu%c3Hd-Izrnc)i;M%K|w3S zMMIgeK@e4bDf1JPn zB>@8cWI2+cE0+0iA5uQVfd-UfJ8+2iAaouO{NOze}$Pi|~ z15%m50FVGCfPkniml-~)xIg2^;m*Va^3)bstaLowrwOgaWgtN?&7vjkJ}9m?6X9KR zzS@6;pj19=MS(XhzCxm!IE>KtI(Bq7*%qBjQX1|`it7+m>6lcB6ol~Vo-8KnLI73| zvQJX_mQ`LwQHF0c&U_RUvMDi0r$q3Z3E_G9>*T=|r??axU3`0iN=psu#xni-iNHh= z>_>2~K^|O4fUQk{A8LIDWarOoUm#z-a`#xfC|X)WbLjiyAa$*Dcii*VVUea9 zK6UwJDv*^D!eU_+IRb%l_p63f#DW5@Jt+Gx$LZfAiTh^uvNVK=f>DyK$+lT2ba$R4 z5&^)C58248ZpY~>KDs@Uyk;>$a5gWR0*=PYFl37IX@ zS$J+9pY8`8N9I2T>qQ0$Q{q%Ogu&cmm62zAFWK!wv;UzUJ7^dKsF2VC@`=V*lgv|4rWdKd>t%Cbs`Mq<$IG zI`**T{^JX35W<1UA%Rk9R#t1zGu9yT2}-90GOmQf!q$^kB?TsYr~9(@7RJ0RR6R3` z9Y4Ysi4zCzlvh}a<_68^{_7WD)uqv^K2HSyAVLgKRth_DrUmkreJm-SFx>nf`F=GGega>F|M{hY8ll-Z2N_cIli}a3X{8 z#V(OjW*m}h?y*JEbOae-!u>+(`N4ZUOq0pL4QT46uJ!~W0nbI)4f$&&E0t=P5b^{ zS$=YAKqXljFa?^ijA2dUz)=TcC= zU)*DLNm?m#QehH~9Vfyw+|AQYuc4IaeloDOEau~YiBz}@KA4hhRE%JgC#Sq69{grm z{a?gA_WRBQTWTLM-I;O3VgTMW4x+PQuHr}YbRcB1rA#*NG;~G-L#;)N$bz)co+q5b zB(Z>&t(#n?R^!lL{0OM6N^{WKefQ`~OW@S8o zoTK5-^@bNN@Ory%uBTdHIP$JwfH$c)H4HJmoGBf@-A6ksU{gtGh zM_dnv!vS5J=NR;6I0SCV7OL+z_pHyvO0Y%p0yN8&!p8Nhah!|CGnzGu+LSq`;%Cbe z!{-KqySCUyID(vBBpPEJG&aoULPfqe!FoLyXURV>i*FMQA`BIt7$$|a1ro4SW@9>7 z6%~NfR|96$TC}xZJPT5rPr*&3P6yiqHrBUTxH3cKJ;6n;IP}S?NO!#=8;9js0(&n+ zo0p@LKMIuRFPt3uH1ENAZVXsmmboONb1xL{-_+N+5_DUtGv}KacmJ~|t(LS%3N7F= zj~sBbMwyX;?U9AcRLTtEMqxxkyupk7vE{F17~7Zd(a9u&ZQc%oY&lr zc#rj-WAiZHmbV9BS06`YJDb@4>KDLe#E%rNx)Oy-SMx}4D z;W-wCP@Bj_lTu}CTzIX`j87$TZd)TT*ykGi_V^T5Ba6p=FTCqK99v&AP_`Y7z}_Zf z96IdzVICSn9FCMo$EDRkkLFJ-y$*^|>c|Lt8aCY`XPfQvR{cn$;34tuX9w24kWy`+MPz#=&sQO(#}qr@tQ>oyI6_hAP|l_I1yl)Pfa%==s5chM zfu}2$ysg{-@*vBu@6B0!bMB(ny=p$3Trfh#@8kR>+tJcISVxE0SgJHi8s!p8_7A-^ zp6`gmK@BK7 zASzKh`5R&m;|{MooLW$zwd<{0<4QKOtv>n81pveiTzhs;y$JhCZ28S!e}6pyS-Dff z$ZKl<605I~!*_%-gZUrgXAvfWXy*LjWsecgc{RfmVv8`D|7(2IzDcwhrIN_M{@hp;$aJ|+BShV&U%skD z?aL?@U#^!GB``9d7eC+Mo{szhvPLVD`@jE5?5zL)X|aljgDC;Mypff%i!Btr904N( z0~EcOrIWJ@0SEj45AV#%$o{|X7f);M+GDfB_`d4rk6s&cg)hNdK|mGJ2B2E_6P^3n z3gY3MW`MX}5A;-Bf4}>7v83bbt8>cL@nMV}`V>$+5EpZwrbRJxnjsU>8Aa@P9AdVH z!*Y%+W14k)B4f@X=d=e=`zqcxj+4eXArTASMk3DNn?xKiUvWZ_aX{oSP%#HpDPzjx z&EXJ`3=0j)u}Wq;6vCvP7GxNCU-hrQ4LPjG-wR=oGSE;8_?5H)0Wv3*VQJ8bvLaSO zR!AZgMH$5MR1yh~K_Lo*h&!tRPL4x>GkQaX0S8w>lM2W4fLIiS%!o_;FBFLsBi5=uqX7JNzkWHOK2bG1yx9!kl zz~e~=Zh!<(3)ujH`+&e03(+uwsDTnVSd)yog%x3e3vLrl#fePsl@g*mkc7n;!JzBH z*a^)m=IK&Mvi6HSLo>$wzDr=y@_bj1BqlZc*A|UW{3A>?PSzIZ-&=ksYGyyn0v<+9toc<3yk^qg0%-8)$(W1NoXyELeR&FA;<4y^F;yMSp3C3l&cJ6c zKFz#lZN81fitqAP#%YuKSUFsz`(m4?-fcBYH!6RcJ5?VDbl;f7D!C)Y*>7_QD)WR} z9C|xz=B&YU^AX!o^d(;Vhv&?(@Z{XvafQxv@uuiswZ}ZqAnf}rc`N{#h^=S&~2Znj(9dRJFgxAn{G%R6Sqm*gMLTvqYv+fe$a*G17)AC2z~mPxy< z^_I@JQ8~JdLH(UrbM-^YpvIS5w+$J3dGy2K(-W62o6N|YuO`i=(`)j|gISIKm`I3q zD_UnFZ0Hq|J$T#R5IfJ8{u%Vs>B-aD%=`0)jm5|F&!;CRw;qe#oo98Akm&ss^WrBK zVd>VgZCSY*BYTeU8H4UuR|7g5WNFg0Kvx4*RE+9%vDsa!=wz!lW%4sAnf*)HbJ>k@ z3np6>S+`fpjAT%A{oF#;D_MtxNVU$R!9ZgPwuB}B`uQ~;kz_&!QLx&FmTo)R&}l#; z%=%v6;Qh4t0kfUkOe@FC@)X<;Vz(*XccNj7XA3k(S_iUs6JR#|tCbd;P31WyKHpCZ z@noG*9!&a<$?>LNon-sqLAUeAYD<SR~12o1itMkA`hk zD`r@ep%n>d?1Hid3MZ&)G`$&0hHjlj1HLoBXF_e3%5^V|M$TCK&rGwBwsj$Ou-oni zm2Y87(bbw*WF`3#)eD&dr$KDK2Dse%A<2O29tN-5w^m)@KJFg~oPb71dlOZISl}>c zOK=C-!0(lqk83+0d8F`7n>o`;Fj_j>IE%;{wFx#7tP3l|?onx64y8I2Dq3Q8wv(T) zHj)gimh?Boz9?QDeh(FYpZgTwE2}3<;$^<8G%Nf| zqg_v3lYtW}TR^iO+csJYFCQ+{dyeZd?3w2-&EfA!Y;))jE(enqCY4cP11AS@Jcq|l z`!(S$2(P{B0pG9nKd$|ROQAlfAKQyl2ps!g%`o1dm>{ER_hvYFz*j~;oUKq(Va4C` zN}yz2Jf^RH;Je_It8L?%ZPfNgp!Pigz!SbA|F^nu{Px@brweCf{@=UsWOeCZ<0(SV zhdM;J2$)rHk_d0awlJG4x;6?Zn(J!DIS}6F-HtWel^vQpRs6Ysp$6hD z$J)@z_eR$sV#uJya%TDe`6v3>q7+pz7b5BOg5PM zvNauz70uCSv;Ck)mf^kL*<3%7OI)hRDw0zD)0$b(@Z;Os55)%6hdzLuzbo!#CQHT` zqL&8J4d|(I%_tt9T6AvhJFv6Ii^V}r=S}~ljF6TZv2?*z%w79YuRI${3((Bs@o49F zGLh#oq#713D+jR!LOQvv_Hv)TfB8zUPe9DJt$sQD7aGnwZ4mrM#LpGyLr#sh#y+hP z@Yoz&#UW1ISc{Vo{3a;O?c7`YlXuRH4=dmuIRGd?aV(o6tlyZ2@GQ*7kVo^-%W~kO zP?v4lZWr*P$Dn2+mB-OJ*>xCL)>89&LXXZj;Yq_qo7%K^sbegz=B-s}yJfu#Ae5d5 z&YT|*&iQIjLpOrti3o8$&|8JeI#O4i<@x9h9D@vWvi`db9g1(1FlNh6TBw_Sirp!3 z6H(wH7!)!%loXvVUAwO7i+Hl6r?i+AQ$Vvq%Q%cUbs+gkzoq)KJ}T&vHeZtD##8%D zoxK>Nz6oOqB{Ty`1+ZOKO3{8vu3vt89nu23!bd3$(e3K}%&tE-zve5-%tEkCOn; zdR4Cs6m?8qH_V^OU|BE+m1a@1AB~jRcM00c93bI%4K7~vwFtL>LeKC#9yo(s6hoGL z&7pcDze8O^D2%2SLJ=FKK7-X&4hy_i(U#^$UE|V*{8Aj9J9BAHrfE0VssJ)v3@_j! zr?LuIH(LQ$eI?h;0lHT!EfaHTLLK4GMq~$B8xZi291xp0m_DO58mFHDg21E<*fZHi z|M)e#W(^@#K=epK^rpe|rZ0MJQ(99^wlXgjY-K31&89&4NLfX^&x{eEiJc$BF7i&y z5u}vHZ3@)grML*VmWAFInXmo8DW@%;rmG_uB#}~e(C3)eQaE9GZw{b3^fM3p8v$m< z3g|a`$!w6&NF=i9W?*7g8spV9L^~AfBUsE^6X?8(g^qeu;&6JxJ5WKcg#1>a5ZZ?` z(6|t^l6%s-S*GXeSYu%cU83ym|#EXAMqGAtL{OvD#MIL2c#I279) z!8Ecld1WI;e7P8+`5}|PU7iMzVdp6goL!;X9$>rIBVQMTdOR5zl($0Zh8fSZ98@_>oUNR}( z&VoZ3VpRCbW&Y+`2z^`}5c04ACP`Lt3URiw5qlTQwwiSty~GbpOM)?|iNBVchaH(N zrls0+)0G9rR}B`;l&6u47D2{)KemJyP%&<7MnbkgrW_}7JB)2 zwbQOee;0FRE(M1)x|K5?2QKvS1V-1|ynRJJ5}z%ylwHumR1WQPNiQrI@*;HT4q@xxbfAWrH5QFLwerKI`ds8vd+vHpf%dknCQJNe*=! zVR{xIrqb-#U6nRyIPLJeUP`AAedO{+td91|?_k|oalYaD-KX)v)ZiU_h7t-^+{ zwQ-@BHFl}1qpD=S=8dJF*($IV0Z^-E0yPHJXp0SUXDVROsliP%sMB9VVai_=Qg`vA zj+a*!opPb42dk7guCUKVWX=aq(9}UfB0zM#{B!egmWJ&LNI?1wQIQXsJG-3io}Qdi z$Tlabr{l~`?dT3X>p0R?-+!oR!Bqj{MrEdpmGoLK{4`Kx+|p)=b+UUiOZ+EHcimIX z*ljCEH7JEG$nZ^zc9tL&&1F(aIE*)wzO&-}^Uy#6%_fBe3@EmivmuCQC%_o8NLXZk zOU<|&TUW}+~T&ha-E;*-Pr7~a@m1p1XS5G`E2TOy-rn||crOE9<9JXT+Y8Mx29&1J>~i_Dzw*3r2BJDewkyD>+9!F?0FB5~3^Vo+ z#wx6x`?pUuou^wWx8R)Z;kDaY_FL(Cw3x6gR1Mf52Wh#$`rdZ@G&;{KBT%Mi0JY$ro6g<(B8XtZ@s9X>!46N0$?imbLKyYh)sV4V#i@T6W1>a zf&g4!*3T*e`gJTj#wdHEINrvzev2p`<%8P}8%k{my^%oN^|c|5NTd39hsl3;9YZq! znRn$SOvB+{6Fj)eVv7JWL-+}=q6zOj-lT}_z?O)6IIHCCD>VX_K~)4vT?!)4`2b8c zjob@LEhN6o^6vFiRh(A>DK1^f1e!t}8$(r3mQ;nlGefrQ{!z*~hIehRJzKaVQXe;R zn8sCA7DSVU0ryI*g1Y?Z2Fc+bSl$5?xH7aTc_fbtKp?vYA7JE>x$NUb$T9LPU1Y|K zZ#`?)zwwRxoTh@br3s_lDAQ)N`ra_{A$bUMC{FmejLut3=8u*J%2J87o^b|T>HPy1 z?v!TloLzgbg#}J(*_s70 z2ivE*=(ZN}S%~c&>jV^o2YXg6to)L!5)lZPw^X%fv!#mR-SQ>Fw~*u44Q^)d?Gdm9 zmb)kB=SJ*C1R$fGa^}9p)5}n-M-=KJPqD}rJP0lQrr*arA^hxDQ!&l2*pWLdhc#3v z&pIr}wDP=>C;MxDOd~w|Cx-zVvQvqFI_43M3>M$N9<3+nn&Popvz0t5Uke8fL*cvU z!I+L?ji-q^Q&p&EkM;wka7owuA7$-7kw!cpfw^Dk^YvMlC8a5%5d*%ufOX*Pth3V1=|yCQ3-*!b!HKT&m@0v2PPP!= zkn$IYPCS=iuWAV2QDm!l3-4-LQA64QzIhF?cn#z4X+Q?tndDCllyu4(w-nvontb}N z6(OFoRYn;Za=rlQnMo=Dd~wfJU_Uv@Fo&dw!zsoTNd)~a8niMnu6jGOqSYp?i%y@vf2`JH?1YpC|jvsMZOKVU!yariF;Mm2d;H2v5&_8Lfa4y z_j)!}5~&GXmm_#akQSnPu65^1-&h74E)X(#sYvXPH+(&_s~s-_kqwamJcN9`pi>C zBRN(?1+$S==Fs%&qoEPJAg=%4^CouNS5!x9j8L4%K;qmlcXISaYJmOJ<*gz!wK#B! zI2Vp7Hd_<%s3z90ejCyMUbM3O82A2~xX`7Z7-D4oJ}*{eE0LtYf|IU52P_j8e{Ewq z%RdH?(s{~6IFiz<|7sZFEIy25Zd9YEBn{*}%}*Hn7sl^aRy+liYjx`EkzYy6?Mw%) zcd^lJ_w&KDI}-lTGh94*LvnHj=686erX!z_7zJ+BbeYGA7G*<$0W5v2IYK_VY}qeC z1}dC`0+U{eTnXoh2-@rB($^x=wu+)D>9D%wrN!AZvu;TcepO=!FS58RlDKMAAW0fE>YJMKB2inuG&NB&asCPQ;&BjZpCKHH3xs z#%r}`5|EPVVv-~w8K@@$8>=Kv=^sZSJ&5LQ(35H zg;7GVmFABDSg<5Z8$oRSTM%?|g255F7YPNP7AKKhj9=G9RNfjy+LLz#ZDm<~kaNiT z+!=!{RokCwDD>)`M=9os)BuwW^D+;acNko+lExq&EBUQBYA4~OP^pumL-0W;ofO-z zsXJcBh@f`u6T=QOu-lAx{*p608W~~qp@>QXil-F9+lh{k;_nwn^L$@}Bv$8lLhDlP z5&vh|Tliv2^W_X5Vv{}^)xZqRG&9EgcguFEAb?Z@s)Gpx=M9G$hKY7Gbd2?;1=DC& zfK&x~+5GzZeLHaD{husjT+9w&bnv!2N_KZK7)2risfTd0C0Ge&bdS=}+k6Vwk;&zc zj#~HV`{>gYgTE>%h201FxDPAFDm@DP>J-5lT3h`*EF}b zGOLiSjQL@z?d9o1P-9QB`p@kRGz&a!`z>%ZmA~TL6#ja+w_BY(R3T;oqeK$Y_-b*6 zBG0v`KJ=CEld8(C*ZLhz+U#c>*4=>I-2qQ#rs93?E3y^NQm!9^Nguaj>h@Q7@DK=J zP*r^}(CosUA`(L!Zi3o?^p zgE%iEs;8wk1uRn!pP~OBWB(K*+S+zugJs*cZQHhO+qUhhRkm&0Hdom;RzY_lr|bq3X7^pQji1SSV

)*?;2n=GECm=?e%uGA`Sw~-i4Eq$N&!}AzvcY1;MV*!oFZd=WYG1!z2 z2>x#T`n&`98$2k@=}(Y~7pCB88;Y`}0|tt8#BF$$^p6J^OMLNVfiPUC$B`+kOWLbW zj}KMeurN-j6fEl&uaf{6zno%(w-!+Oqmei~FFV$|G@hl>t96Ydmw zR&WS8kQD=?q;Y3&-~ewntmSz95AdVRiPnG30qp;Ag5>z$A>=I>Q+8Wo|F_;cAwp_Q zI{ib?Bmifxk4C8gCXsTshzcTGLsGPwct9lodY`?TRw@<(PYlj&=VtEWz6BpKYD0+D zr}NwSHALPAi#Ey;VbZp~Ld!?A;EP1dlB^ccqi^}#ha-dCgizQrFTr%C;O?np_jGit|zrZgxTm%_aiAxM3c1~<$Vta z3{H8na4Vsj9vAS-_w8$Hp`8li6h7Lm5_hefL*|wa_Ry?eL@Q7iE@JMUpyl zlhZWePZU5ry}wSvEMKJNDlqqMCU-$*eOK63*+D~4X>%4H;4U3$E3`w0`SyvKzS>@e{@ZM{O72Es5=fof@fmwroS zt(K2UddwWvaR|pHgiLu5gg-Zv&i%;Qm7}RbGnPb+h|*o`e~3UFHYohSa`d9MR)5OC_af?zj8o^kQT8w7{RA(YR51T&;={X{YoBWKeilCL#|BG)Ub zTF;==!-R_^5;;P{GD5Fs->4EW6-5Rcf%X&joh zWj51s5&Z_umm1sRAAEcFlIyOD5b{E(Qg;NQG96uvQ^v7?(Oi{}eODJo>+x~7VV`r> zw_w5!IIu7i+laA-@&j9Hd}l(4t0lfLtP^oI4p<^luCOlhc8Yaf@-BvB;X>))zV;Ex zFJEGnRtYuzum9aJsr+@u8I3n4-zt;MbUnjpx9uvO=hi~!3b$Ik&&>fv)S$HpJ=jZE zTy2HGV)~b|2sQ_1BC4L*@U`498dXrE%4OyAQEM?| z6*^s)5yKJqOta6h{rR;~H^82~q0D^H9$rm{hL?FXKTTAOS zYs6w&3HbrEKKwaU#K)I|V(2{|G?3BH*}?c?fwB zgME9&9%#?!sWACH`SRXuxcgp(-O?cbD{*PRWOqUJ{ZLyt=ruaPB5I>im0UAfDY)S_ z#&NMg{IXabLOlKFvbTYKR9-s`k-aQcT{mSU_B z8Yez{w%9|*MRUw%B$R9KkcwW_k3n(M6Ucf$Ln>HX zM;H0#Urz&soXOFi71FW;ZB&l&fzAiYhTYVZku>|%H1X_x{US95j8 zd|+uiQ`XEm_YDYRZ1dAk%m>VkasWic2;6l5FD-1~$AkrQub-|UJMW64-Vu%J_e9^bSUEY z1r7;)H-TU5@B+WMCf2ljc|GD^1UPo|9}SlCzp%2bjQ{hZo%8<*X8(QTJ0Czopf274 z+8k=#rbPmQ+~nvX5$sR3)Q-T@Q@k+yxa1xpG@V)@yVOxTa?rz>^AmAg5WOyIbz8Nz%VqHtUc`R9niaT)tK&_h|J=eAS!T!qeV=rV}QcvFU1zG&kZ zLj!G=vUMAswYNM-H7$gq1xmRn@#NQbOaALgSR9^f>c{G|>Q+S%tv%zq513lFZ4gBbHce*@cCUX-x6;SA*JG>r*HX zNK=e93apT#$4|jH& zuX5wvu@p0-dh&_8bK;rv824yIcN3mPrJ4Q z!!!<`kX1@JKt+M_ax{EiMpK~h-3vOG+=DHBHKNhA7558b_-eM*kOp| zKrUs}FRApj-8bnw666&oHPF2rTSmYZHi*OPs`l)=Cu;UF4I9?{c!Gji0Y z3$8$f$A=h6@=Sd12sCk?9qyD%6@|nPEhFe%x3Z8L9_!l=z(J;8%`mr%tH439KNC1* zN(v3@HL?4eg3e${)#Dl{oA3^aIH%ZK*zL7%2I(n<9OOA*tEdo60&Vapgk*k_W{ z4AZ?}-w_>|*1UA&P)HozbM#D%u0{hKo9H9+uoBA6hF^j^`>lRotH5_pm5wV%)iqcK z@rOM;cDybr7C4~ez$Y}J{D5cu); zwxk!dj3cnJJr)Ojtc}Jp%0KI|Pm$LVfOLS2fO1?aA8zGrMel#S&{KZt!NzVhrwD~r zv}4FqOLoLCSV>7e3yhdIhWhZ8Wh;6ffzKNhjO3{(X^>%eHZu7o{x57x_$()mYCO-( zxwz8Djo`7*!8@C)TXu7FEXqFbD+h{CD>{6bIz9O8L{}E*U|O(594OQax4P zVO3yHx>+h3mJ{l`d7Qv_={~kIK@oEFe*SKr&sz>kwljIJ{XR8_h*`wy18Zj1mE7i& z(7KF`fwtaNCZSdo2waGT$|fy9Fa_Vq!(s*dHU!-%S+X zD3vMG<;N(#&E@8E?>>wKi3fzV6XT~BLtjILPhyDF#GzRQBqfRQz?n8eii!Y@rqPHK z{K{#i;0l)OS^bZ{2Y|CB3 zToGP?Iqruc%@NCYHuerM-b?!90tiP*1H@@lM;1BztdOccE-56WsXoqe=hRePJd+op z6d>L@!K6Xjs{<~R3&6P6xuN<^}?Hdi_ z<eP?%V_mCBbxa$%b!*56(y^L0&M;_YxR{1*n^9P$icBnU0>A!srFXjtb=?Io zmzN`KDWK0>yYpfq8^z=)s;^cps)Q3Qq1vq!<2G+NaW5E)92m^DQ(ZgYmtnGDgJl|L zF44{t^?eSeqkT|vb5-Q$D-zhCbegE%Rqq%sLy6uAcK+skopthSXU2q^jq!ll zzPeLNd8Ia=PQ6o}FPYGLwkc`mo>9w-$x5GsUPNi4-fZxHnbZh>L{_#Xv|@jp<|Obl%Qv;6s5bLQ7Z2G@71pQw#vko??s2*hg>XtxmV zdtGo|K?|0t!OVD}5qN#o?dk9Pk5rq9=h{r`X;F_1Npb;2^jpGmaOIFn$M^B1YADMc zf6+wsW|C)CJv>|$C9I2NMqL!|rjbMsw{k^(fc@udzy9CxU7kCB(sH8gkcIk{AR?qG zXjC_(DC>BqR~u1xEOhaG((5)ERPflPW}EPBP3}+c2ZFa+P+|Gs5yinMD%SEY!DnY^ z9qVWx^&4aB>yH_>*}?o!d-rEWRtDKA0oNQavsq={Y!8-f7WjAT*8s4pBDDKXWJKTI zGdb8bIgtf|G)x%fn^5O#*O4OdrO1dcfo(M}WYd8k2YiEbwkWq>%G!vybFU6K>vAdR zIS(21?g0bra(}T{l^=l?nO302%HA$s+Oxh*t7H<$!ki)61kgOY4mGVc))JrGBg+~1 zN~G0#;+e8-iwVAsIR5@4fy&XqM)Of05%iw5;WiT{2uu7l@Q+%3Inht>S;>;B?=bC) z1+i8`e6Yq9sO6g8p2y4Jr)E_gs6Ky>x9|IC5$L-}~3*qUj zO#e{P?uVXx9-AXt`NGY%S=N9ZTz*I>2advzBqZb^kUt?E+Eup;81TNb?m5&;nwZb% z1RvHMM{H6+=w19xhICn6a9OgY$-1HfuhQOL_e$p=0g2~OAC9h9sR@k4x*{T3eUYej z8N?w6pFSl_c6qpObMO)7NpwSnsR?9gFv;w;!TUB%YR}WI6rFvMPkLx#G~kICjD!+A zuz?jLKv)o90#mk(z(q?^AUK%79U}ll5a2k|r}PehZ4jVIWLZexF%xhL5Lp+oPJ# zeLH|!gMkiMekW=OB#RCr`z}|*21g?p)BZuo?Z8BHy(om(pb_Ad`$N!7`KRc)($ruL zn`f~H(axpkYi(c*otMd0weNFyyhMnV|Gtt>wZMYMYSBLEOGnjo zRwr`1i*$DJpoSigTX9J>k#OWImB#`ZU`xN|7r>HeUf4o-!l-ce!YxD);QD|%8HCDD zmpJw4tkp!u>|RifIH)`>X5t{C-t=?Q$I=BU+J z<$BYG97=w-e%Lr^(K5vIWk(b1eov%pBWf1-`6P!!dT6Sn2FoI+vh!qsGxzILn zQOa5$OuK{m*@*^wr)$>fOfmzIy?lG^!sqwX;i9R$qgaZN5ODtGby3TQnkUz#yT|vS_k|+R~IJc>$72vM1c==M-Jj{+nVM0=;)tZJ# zN^iF9*qi4%MzC*9o|tTkOStF$R>0x0`vitu9?*=haZ|39)`jkAS>|k4p72Y|k&>l1 zLJ5#|r-d9Vry<30EFPan!1~j93u%=QH8$Wh=*r{{EQ|b>g+KsPb|~mM>7q0x<0eNd zV$-dn{wmhId$})p={B*B*qx(>y?@dH4nG&QK(TcWzJ303hT>8W!waK^Gs;!BQEAOg zvxXQ*D$}whIG%Qqbs>=A?MgsZ$^~E?bv|B-iJ&E+LdIBCUwyvVf7FoJZv!v=0?4R? zzsEHOK3?}R5*1**2VGYl+sfThu{T6J;|Q(4xK2Ax)SOG_U(s%w$jas~HczM2{8o*H<|d4x{H(Iao8421DwC&l#n;Zhkdgv3Zc z6~JSLS$lDP;Z?4x{G+da#xj0=yLIAu&S$RweJ8EuMP1fT0F2XGMrStTEZ0GifrT!$ z`8HA<`&pdBB9hols00(q{>Khdy6i0nc;(ca0X6Eg2K-&%yB8N=a1c0P9uNS-JJ!IW zi5Dl30ENIob1Cv*x)(HrkF40?_N&MkM4gWY$B2V_7?RyQ{0-_zw+Y+6PknD_=9(cn z6>r+)1JbO~$*rdT7#jnKU6WE>GTd}GsjCI8_i-m6kJD`GN~})Y~}>Xt_Ok zUS>8Sq=~dt zW&;P5tf$w|@S`xm`6_LxNbUOwncGKY>dXN&ci^l$LrPO}oF3FkhlN{#IJ1kO4}*YC z7~TSU8vgwP0XSkflE=f1@mC*^J)U0mNPaHBhEX>q*0rEoDmI3jXhC=K%Q~kuquv1< zwBKF-E{C#q0W|9cBK~W}_^%f#7MA~+Y7$1@fC`st7vcOwp+h~jS5pA2)lo8qoU)vo8)(Cpdv{_lK>0Yeka@~T7-$S-B)--vU#vt8Z1 z%fJ&*sn7c&{+w$thibAe|A3s6BCD&v?;rG);Ss?A$t%+edo|yicEN+KOY4OwS9)z5 zr>@Jb!rsDy!rADSvv4Df0leL*@+KzAWy{m0P*- zD|ULk!1+!~(^r59s|aFIxECaL_mb9JImt-d5gvZnD=+mPb}vE7z1=A%9 z<6>#e$)vy4Syo+_hJYhm2_sNVm^7sjK<;sOFV9)(bv#Ic20+SaNHTsWp^9R1KMqWJ zKGV_zDh^5!6psfq>*g+4LE;E?qswt|JpzI&R1Aq+1F zB%A^I#>Sq$dE`b}9gZ(49?dk2`$lB@TP9jhQ!jkEZb&+6R+?nR>W_@4+f;OCZ;k^W z@S>uOJ|-5s;LKNF*B3Wj9D&1(%)n@dLH*{a;|y{;7@2|Hm-+V3kl51)LMqFb*PmI{ z#S&w%9Kse)7XM+iBqOUou7Gu+QI((!wvj1wTu32A&4UFm)IBIm#8e7GY;cTg8jfyU z|2t)F!ju>|553fnvG;A>4U*6C`XcD<=-JOR`pZ05y|rL!WEtZiTx<&7*{9G2&W6XD zTdK(Z;^;(Mc5$Um=$x?t+#%AhkNHC=nJ0bdDpx{seG#47E`D=S_3o?pES$z8@GVoB zy~r=z?G0scbf5AA4upXP3_1{l{nm!}_WIJ8z0j;|RR)UeBT!zp?ji)l>LLXM-+SiA zkXNye;m+a9uyC+-vJh@oT1neod{ZaUce(CC8kQh% zMxd|+XbZarwMf#hd@M#S2AwN4t-0=Gy*CEv`!_RR6_~#cj7T0YKafmU&N9DX=Zl5G zFdyh!5f)}&pY0(CTno4%m?a_XgoWWQX>aGC1i_;kB(4`om8buykdDmInVH4(#sG1) zia5TT#wUe?POlmb9}S1d7!4oKi}SNDK6qVAJ-Y2SBXx*CVGw$c`$6oFn%a0rdPsZ8 zVyDKZ+f#gtmuzl#p(6w{oFU`9OYZ29^!>#iEUgS#vJbsJ`s*Svs(=^No%VR(P1>}Q}x-gC@%+0o%q=PU^J=h zH>{37@FKy{{TY}}F= zAU-`3<|<7Sst6F?BneJRXmt&pE#OnLNB^^45ZG^z8D(O@Wn^SG2b61Y|JP+Mw_0hd@Gs5sgfF;m&sD@zs4^_&nR zyK7EvTe>A4#BEt4=X+Gpe-3EX5kz?-0OUt;>%#;A)#C(1)m9aCwe^n!E?rphVL1~_ z`+}3Q!t^M3K`W6+(j3chln}i}fR-%%x5;x|D;;Gb8zQSvs2PLz@VJ0!J;W6UQ8Z*_ zMhplL_^KU9ATyj8)-7gM5l%hqE33*y6Fd@^*Io7X`=6d*m7qLGbn27Z5n2*DRG|l| z(Q3=@fL;u$tF+aD{$@U~{D_4Lf&LS5A@yxjW7lt(uZn(O-%pdqfQ&&<4q3Pmu*I?q zPz(ZyLHdO2RHMNYSGl~$;MuutjX3s$k1i9|J!=5zZq;iyK=MdkL_mfHGg>?GNDc`ToX zNrwchz4&hz!e0KIVXdWkFM%GAyfg+|shm(u8d&QJUyMpFE8{!j1h)4FTZmHT4cqPw zK{-2c4N;qn9j1UP@{%xBz%-vP2Q92JkA&nj^19VXdP~B1%NR|pwHZklWDAYLb%aa) zJ+)}ARB>$8O8Qu(up-aO(m^QYMGu*(f;NzSf!#U+7buaMArNc11psKS7%;d%NgKN( z(U|H2Ma;wpC>vzN-zwsO+*wyNCxFjp=;5T=g1jl6mP)QwEp%~gfGVWW-J3cGl4zZz zxJa^sxy>Y%L$g5>a+wK=!EGY=CT&_?d3v!Z(0qOt8_107(L8~-Y*Pfe71?>X!j^O& z4GeP6h@C(4G!}u$0?&AjoxpUdmOZwKE~O+HZRU?`2FaXVwMvrf|Ja}dL z0i6@;>wnu!r!21Y4A`UIgAjy8CE!q&ER#J@-LeeagBVb>n#E+1R$M--Bj0x>YFIEW zONNSL0@Syu2@kcLcP5sppu*2v1_px*-Ol8mA4WxRlsAkUL5zP zu!%i(gOnX))D5dUi(1n*OpL@RS%yg@Anj;DWr`X|^el}Xcj!rr7)Jd5`wc$+ADMMC8oU4Z>f<-3Z)gCY7@&bF`h~L^ z4kz6SCkkGDqqjX=65S=*?%{d= zcyX`+8;>rkP^{RgQG-qc1B_P|O#>SoA|9>U@-`(c{ByfvKWArjqw&B4>y#UaZ~FLf z4V}k$QZxTVw2Yl`zae|%*L7rB%cm!XNtYD;Txvb`u~oSv(wCsC(ORX1v3cFbE+h?-4Gs>jZ^Sj)YKW`to;CRCJYm~5-yX0u;^ zl=IQgK8qI&dY=XpI*O#A-YvNL(=;VSucy=z8qlsd3ZX2WZ>q*cX=``vjWtqPzIU2?6HYhY8Pr9`^29LEo{B0{ z@N2y&z01+K(Z($scPi3a>=^YJ-KFhoOG8^X8qucgDaj6N7|IMs6trB6u2>5zPMrdx z*A#39kH?#5>qZQ&S7d}z@8Hl$Fe;HEH^rj>&u{|-B3?}`{Jfhku~{YX`YWpLOTB9RzYto9>&wqIp07E5-LLZi^eyOiT_oH)0wd1Bnd=L=uw@RH5@s5%ZZPl2kUC`8vqzc{<1#)axr_$cW0;T1;CZ@1lhI}b2&kjb(0%mg?GG=E=S;~((^o?eA9UXXY_PiG$FPa@ec0giIp3kP zu0oKnu!S`Y{wAtNE5L>89LqF>H>v#q{@@p3-&r1pUg9U%du_z0cvIgC!O(s!0p!=-gOoeBuf>zt?OhIdVpWJ!4iGlNg`r{X%;xY6+m!A!wzIR~i-L6Y= z0u`Y^Oguouopl^e2w!|S_p-QLdC5rUZFJ6FK|Ty(RYZeg*@@aB$1*Mi2o*FzfliiK zn{ilGll1_-tvfk=+!l!KrCHy+jZ%oyoPL#I5ajq^ipARo{x70NQ;U<==_hq%xIPn& ze%R5BCloi-c15CP0glfABI8FVkGo(&o4tkt@|P%U?*j2JF+fSu zTW89)!$f?GNsYSN6N^=sno3gvO)*$B(9`hD%s%+!dAfm+1*h#r347QSmBgTiAUJhG z8jg(@qzD$Jt5ICF5IN&;YvCS6c`<8{>_3s{QDIkQZ648PuIfi%6%Ow{F#fgDyh|G|H51pbq-OUpUoRK*u>Kx3KX~Rak5Jq zO7OnT)_VQk2K31YQ%plc1Yy+g()JSs~4Mb0$!ED1puXtRtmPxTB7TQ+=c5LUb| zszplK(n8^6I9dSk*Z$UY6DEVj91+fTFn1tjdKmBrM>hCq#01_LCI%6rjRyZxD*Cw8 zbqj8Eo-sojn0(4$Sg9nx=C)6Ni0$uNCcL5Ug0DoE?1gtJp!dj+HkOsmGxqJ#P_p?$ z`z3MeX)?+0=u7?ghOf<-5f153%NpJDf5LoG-)rUnVUNTg+kfjmq!YxoRK11tG2%jl zv-B(;1op)N-m~XEtgTRgkEZ=9v5(mymE8RPshYnTeP7HIthj2+AGCJxc@{=eJSYaK!qU|OIAp=e@Sz;%Ik5~?V(K^C{cS(HE` zrgjER2hs}J$20eXgtk)(iyV}V*Z#SOJC9#CH(q4hL&WRj(b&k*6Oox7Rw)tE&cSF= zNC*wuj!r^C)3`QG5Bzslp{nasX?dFGYURe*$kq}x+H13s(2yq(S!{d0mWj|6(P{KV z86;?uhl@Rbl(1NPx;+^_ACf&}vORBx6!LF`(zXX9Xwe?dz0~dNL>;$xc+rLk%Q^^Y zK|}>R`D4QUKjEx(O#qk^;AaXMY!5M8|~36O8p4*G&z~C_&*dPJc)K*gTf5Tg8KW?;103 zC}w&9${G+Zf6ETOSRB-u{hg~kz^`xzA%TNK+h^Aet?q*$w~qBtKGKZjacx`S|0T*O znQ%I^>#HB*ZkAJ9_o!+XCFqz z-<-9(kg73k3;HOKE&aX+#rlv4VYAz9+mMRG+xQ~JF$?4t;z|Q}4}f9P3WQzw#V^JT zn$=TQij!T+#m=ggOs8RufRo02uQaYt1Ib1F0K?V6e5@!4=a0s=y6X?s>&JQn1`=%r zzR}GR^?8ZZ5wb`0U9dGaPWWCSUOVzr$OIQ>Lzhb@R!P^H1Ik9~4>Ts2 zyd|^Bx`h|RN%7iUl+e&tH5|H9XU#Q1BnhttPs{DR2y0wx<2f z+ZsnSO@;m5)(i#b#sNTDrv+0938^<+#s!s4DODhBB%4aLxocC6t$>SJPXWa%t^P9% z1W-)NCSXZP%bT-NoGYXo@$c^{XhJ|^-$I5(g>EhI&*rTBPslA3M)1kQm5tS9cn_Dt zo71~a1VK~WPz2LYQ>`(R`Y1RSF$2R(12AKFPHqqskgLvyzZqi)WQFav-9V-e7pn*= zS#0>YtF?xxfs55vg@SMzhK;z=8sV3MYRjH4w8CLxk}FPq{Y|SKwCWj&a6}^XTDqVm zDfZY|;6|UYlxB_2=^kB1jxhXRZn!aHcP@#2;=yqEp^(?X5d08G_cGc~DrR@edIkhH zWgJ|=M)3};kPA7>gp_!YS*4w`hiuo9SiEW<)6=-&LdchD;JJv@FI5+mAR0`9@e^+l zL#qISX+jwWLqw3tfQ7t8LL<#knLo6(U7la(U%4@bZC2!Xv8nRnY?-Tyj`;_Tgt7nwjIa} zq=w+Uk^%(9AFtlUwTN@hK6r;|U35RM0ZDm(IC-8{?*KVPqk18nQOPS1i%cYs$3;Zx znDEFw{ifmU{)q@k*_k{WK%asiV*SD~A4K{WQJh2Qk9gnnG3ig++3}uug1?xW1T8wf*#a9^Pf~Go(->#%SjvVO^jeJM_$F9NhUqzeg zS9kV57VQ>w>GqOnyyDdQmzs);vJkCtBqr|Zx#`$G`)@SQ%H*!oW=FXF7)e;9W8aX1BK#FBASZIpi zn?dII>wNpTVl&Gpm4J|No}HWcRcco}T{@YIkgw}HxJqlL4E!NsGe=7yrI?|RQ7Rh8 zvxP1&^l=SUo}vWqF^!YuUB6IfFY|I`c9 zx-DL#2#~mHv$g1E7GHpDYf-S0`;hVF1O|*z0AA_=1d^(;2~}qU01N$bG3!gamP%DH zH^{lYN?s!5G)GX0S>$<61mf2)`wCRVvd3#day$2im)2J4<#~he-KtP-vENjJ7cX@N z;(i4E)4~AktK9XYa8Z+^+PL%NoWS;}i_OWR&yYQxrtRsJn&eIC!kvI&Lgl`XuBvRW zQ{9?`oeSe_Txl;BnAkm_mx9?P90Rh**4p7nFN?MzNldR`$z72g)K)RQR+q z4~+~`ezN(e)k;O)mss>OTYYVEubUG932kKVxzbw3Fb9+pyf|0550Ar}B9ksjkC)eG zYUPE(rjVjj1ZibMsoNhZ9hA$L--Cn0830}cNqm_NfZiR*s(?Bz){@q(h(cW`o&5Y1 z6{I@z`FO)Kk(dsJ&Aqo2U%0>zmj2zrMbp0nISgJ#9bKxrlgvJ?Ms3y0?FjY~*38%Q z&qk->*e;kk#(fT;kP$CoV7im-qy!F?E&DfPnTTrwAY(@+wRUuD#nN2B2-@dVVb(&? znHx49UVST{xs4jW+iQ;kx-JIpl#5d=E__Whax|9AOMtKH#AKx=YuA?`wC#NqZeaW# zV&RzYlMNP_hwIXD>n@A?O);L*sx7)x9f`*p`)y}~qs*I4%Jt(q(Y5m-{$n(|s9dOLHUuZ(9?ieZtL zP5VC*r}dV$m3As?hY)S@M>kD|WPO^h{FFrN7ygVyrYA| zaA*csadZTO#dxhMc3b6luUJee;QNm%_+M%0jLiT0#iix{>(MxCWm2FnE;qNAd=v-<5=Ceet)B>N zwU92S;X=xZ{Xd6BIL(HZxqBC{;*mqxwf&AdGwjGa@ zM1SG1G&0gK%~M*a`{fVW+xHTVNblbD=hVYjbQ=v8g=h$vB^cWCO~`&4W`lXR=4|gQ zg%47E?sT}Kz~Qp?ty!CXgnGbT4|pNZ6&b@8DJZNY8u<7Uy#hD56RZmdDAe0f8pBT81juZ8=X z3=n5XJDEskhd8)ANtrmaVtB_rQ)tsYdwA}J@|#Lxeuq7ei4jFMB@Py7TvXaEERMFC zRkH_MyivY7_(8EQ%1Tys)ut9psu5A4Oy-3ywQ0*MdsA&kYVAiY7Ep`f2L3-t#nc>Z zQImP&PS=yj9xqZ-`J(|kydj7^rFT6113NyaUB0xP;m$O`#*)jx(tsLfHrHE~iW2pN z8y309Bw55b7+L~dlZW^e3z8+Dol0*gq--jgH<~naz-T{xGg+pD*#kBmQhGdv&WCPO zvFy9A3QQWc-K{xYl+$CkRdUU{9Bypn-ZQ9uK-{DbmJO$tD=`CFD17EsrA2D6O`D^E zO8(^7s;lBnwN*f)LF#rD0!Ln_rK#Laqcii6rYmf2hV-i|=0ZY>7^vH#qk*ktf@@x- zN2{vL(>GMAFU7?Ilj{VW9R*UgUff0vX|~jzJvKP`%(R*OtMr9_{Y&CCQk4q^(X7M+K7;u{XY%|r^*hSb|jX03@{S{gL zf1orIls8{}(lj*Q0_&fG4r(kPIfnLJPMR7IA=v548&kt=&&dXTp6(nj<}ID~=7=IQ zD#8{vg6gI|y3cYlAfS;H%?T&IV$JlWsu^`QCxn(;`QtMM@xUEXV5hLMmiHR*)Igzw zIj-wuc3QhPjBM^eoV|;A=L{ux!zen3sCBUzt#E7NPRcb|p>AUj8c>xf_Bw_v%2%hD-v0&JD=nmg; z=vyU7hTMjv*0Q{}xtBZUFnvnpCvpNI{A7Run8GdI z)&uJgeNJ+LVHR@FkrPu&-m%HDn;ePO(}o0))YS~i&K%2Vd7mw)8;q%$@35u?(QJZM z`|2M^{kBHuT?laZxJR2348dxJPqmw7NU?xkQ;@n#9zoKLn|Uj!p(vmTy%V`H)x|BKDb9w2kL8^9l6;%DfDust5H3B+;Z5^$`ZSdJ7Ih z!Ah!j76eGKdL!gT^#)MZAafAKEA<9Ze1V4dcYpUc7@LD(s6giQ7W$pM*F;#wILU>e zn+}o1o8#oGZI`wMvU{k9)`dm8Y_WNhM;f;vX<5x z@CB-yYoPFD?~4C_mn zbgh)eL1Bf8K*jR4prXlOeW3>x5w|#i6xzdj8KfASg!L*BnKD$P6Hs$uja)!WSL*wn zqjmbx>+fP%&&{Q1GzqtKbZlDbmsH2Xll022>HEIHM$&oC+m~^)Z{H8Y;qBS!^?ZM%<-?n-? zdpv(0Z}@aeuB+11EkDd&&-r*|o=Le+c}ZB zHtu6Gt=wpUl!sSq!wJFzR-aO24DVkb2iU^MpbnJA0uCQn5X$|3QT7hOqI6Bv=CN(t zwr%4c+qP|+_t>^=+qP{RegB9abj1G-zMj^sqGDHO?p*6x3)2D0a3aomnY`utFfA41 z+KRKNiiPRnni`Y^s-vP!aoNw$yA+?!E+E9zTD zsunaiiiKF*eZF>P^nuOpWR+$BQ7zHf%NS|cRKAOgs4+?C4z-PiTH4~P#T~Ku+i-Qe zGS6fGl8&mMH%^YuG##%X9MOEkXsAXg)Ul5{nk-WKRO;Pzf%(>LUPu;7)|c7vcvno~ zMrvEY*KSqoN$c{xhZ+|V)Z32Sx8G;kVN*G;eQ2+JL9V64JOSOyhv);=IlNwfSA}C5 zr_D_`BUSfDn;K#lJL0x`*{l+n{i|6)6v6x3j9yEO^es4EIpYE#(I4F7ae-5F&hNeE z=grzn>5j+|6Q)E-tVBt~!zG;0(L(W?LK>eT`<5DMyDn$~K|6Dz!TLFvUYO3(mz=Ok zg6t=cM(HQSS96^BUfO5q!6&F$i-1#u`~akc!^FCTr$pQ&RV2(`J~=0(gx`Eh~9cg@jq-Zw~nBNM5DdR0!Di$M z=d72g)3$~{$~4e)j>h_8w$c#Y8{@1n*B<@0f4T3M+5qT^`d9(i7YL!T4U)Yt-X=If9F zml^lC@DL0Yip46ZN$ndqmKGrx;uLt$8wnt(o$3IkifCoJeDB$4vCk-5tM|8EFC^XQnnv1UKTPPh)&y8b^|)0r6S-U>#q+X=((4n?|x4_P1BQxz#A%dG_nhVWgL)kh~rP| zHbCIOJA26VSBQJeUd|NF`KTx>M%kV|`6{H7%>5`(A6np2pzSodhN zp~X15Wpq@AH_~uW9@QJ_OY5-(O{Mq4-9(k146C~k;y7Cs?k)=X6x6zGECd5O)Ko}c zPBXcvxd*BA?_j*2ZL1KEorkCiQcjhNA!=NRxq3Iur!MQay2=jvu&X^+FuQM(@E`S~ z8>_oq!LxRrit0Ge<^UJ=Q+Iz_LOj%tf+%Ywg3?|PV!}WWu$php-4)fwh6LY&2{^M$ zUfhi6$S}2I_~&X50p%GHYt+NGN~xb$6xcJ1!3>-^U)zFdG)}=hp1PZ(G`?wXK4z5Z z;^(^79S#erLtWG5 z$K+E%;oV19KBqU5mRU#Vc-5Se9^+tw%IF#5yw+UO2PWAZ*$p77CpfpEn{o~rN-M+) zuEiUv6KjcV&>f7TG0b#q)QAPnDnp-C(X-znB9ZfXET%Dv%?_>~LiuSQyY}%3&`bz^lJEu}q)knRBaKN_Vt*e&EoiYd2&bKj z%fAU%?&<^Okd5Cnm<)J;GWV;N(l=m6?J~fO(lqfO<&Q;aP=?(W>`S7@($Fzc z7-%k?LI;?rEDI<4zfZjYZq_U5%dsmz?Hi{!Mnz`>q0x|##POHw0S<$L_{-;@0~1z| z@78MU7SRcXg>?2xJPyyr1A)V6xB1szaVa1z%orWu_)nrF&Q7Wa?c|bOeS5I10!+2i zqJYL#>=xWSI;RPzY}Y(=+0>5>Qe3qFT+?>+fa_kQ?A-&=`C;GJ!z8BGD5f0}PE0|Z zyXG+hzF+55HLgDw^X9oNxStN{ti&=*$5pgYel(So zkhQ`1m&3Xrh0s{hXcpdX&Js3o%E_^&jsGeFvVY{lkky(ctS^OVg!il&2~@0LQ;fNC5zaZyY~P zJ02^LD+FSng_I0(`*sMH&K6qF(WoEz9_40$A?uwfSQed{VNDQK>k$O%tzzgD6aSP3 zXf|HHD{jXqy7Pm9hz~BlyF)C6&JIFhW?2ZQne}7|UC5us3%k4U4C90-mo0rqiij}_ z+sn8EibNI@JvN)a(7@zjD#YZKV1Ng26fgvBz_OO(g_^xO&nJ1lbIWKf`qDlvZ+Cia>N}x`UbIUL=k+8G2*}`{^^kmS?{h$ zClSD8dZQSum{?O6D85OBWdj zsP*;zT_DlhX+*U4N8qo+P!5IH9CfIm-)F644>{ut;!;f50e=FH5sT=<;NBCmKI7j{ z1^0HqcQIS_?%vaYB=kmqB>??h?uFc%LqKU200`xJBq2`k;W7+&_iP=8*}&T{E2*J| zYBTd7_<;EawHM^y+;2)R#aqB3!ih_raFIO{NHQ3Zzs>xVqSsrRd+ zkLk7SvS*C!pFok%A;-Uj!b8gTnk}YwHeby(w?%+%MwNF65Q|^-hpCl6J!gnM-GigQ zCVpY5?Y#8b-Zj#-Tff|;a*4p>0YQXGv;HL7i8yvsV5y2sUw_7vXtvP_q4N=sw2AJY z!SKL^di{!nF1(6#N7=hI89mRIfWYCiNmqV#x?~*L5=e5J5|KXWFOo_alM@tBg$XTS z0m}w2Iz1%@mpeGHv=k&6Yn*Oj#1cE;Y7sM-TyvWKv28FtpGIG>+U#^yz22ZKnhTk9 z4rY?tJG-x;if_D3_H-1dD~s=U3l`vXIwHc}$xb6rUdjh4}7sLDz&T>3s*6(sdo;oe5D3$2S{~+}P%XfdQsx*_L%ElMG`GLeu z8Plzftmq7$Cg^bQL}z?`=j(b9(Q*ae1jN!D?z30-XP$n}RbfW&`1Sg^zuG-k3uymW zSNI>68YX6@|9Mq^jj0p2*>=y{J7Cum)hvhfyq%w-qtNjPxV%_UF-MoCCqLo+}J-eSTP=5V2sd&vY-np{mGCRDqu2`V-z>| z$wsG^-65goN^ze+0AsIwrFSDYRjq=mv4q%Xbh#&>We8@T{OCmh=M#Br4Ak1 z>Xua8KeEClP(d9waKLYHGd9t-*uqY3>|t@IJaa|YuJ(pVHMZt6Qv>Fe&QAJ!2?p5} z`h&sV42F!vXuDj3DZ25)6^UYqW!uOiOe5c1KzwYxyc&xi3QJ=;oOx{8%pzv)UPW>Z zbYTNPb*pZWuZ6b~exMQ-%;b)RxFJjicoR!nDE?yw5SE)M{zCu)ZxR5w$6Rn4)5wNm zIT%ZQV+aZv=LsK8v8p6wfmfTc_8=A z&tgM)6>|Fm{;C2Xzd{jtoO_8j=ba|eq*zvd5u|Iy5{97vMhS9Nxz_YITBU`wX3{FA~H^s4z1PLDwt8 zcxiO2N4v2niTZL~L>@9Y2V@(+`wQ>D&dh{mNy(4z99!2)CiHiiR% zt7C+sDH@i47L<((+jc0u&KY9&MHaxb4aLWrN5*3Ne6$+>c0j|=#az>&DkwG$pC#4g zm)Kj$x%F)H^$)u*bfnW{n>=rt&fFgdm#A(wgJsQL|qB2v&SV+!^#v2b0l{6P| zaMdxL+o0&wHtdAzm=2WzpR$3cFpTcxhg(4+&P2abXyB5otYGBt$}R+5IWWJ#R9ya< zISR5|*Q0_J$?_AiT1BXszG`Qcxi7U^3B}8wadm__vAPSYu4(p36DuKK{6$tgGMf2lbqS_LU#EF|<=~rzc+^yh zh6bZ36nAmM6Cv_KS!g)VF*v^#>v?iTHy!;zoEld7nIrPBdeDw^G>Nq_gFJzavMCys z0)vC*CWFfiUWy(>&t#7|rqtjXz1g=Iw55U+_m*Q}LL3jhX$_d5k}jAoyX$Z5zMD$7fSSG&Z!Z z+Wjc4IlZzwvY6c@$YMBz&n2+4xrq)jCh5%ff*u>*8z7<_cXMF4*GWL>*$*7%-0jXM zt+b?JwhzYydzH*^oE1hsO>b*csW4FB-lWgk2(ou9%fx-)gU6KzR_+5Sgh72fT^zOAyaHE&?f9uFWHc@zS*n|k>*{+a4KhjHIWbN3`C6#(3;9Y8xD%hV6He=Ypsh|R~B zyA7y#$o=6@(k;iXv2UO&nufwjgpzo|U9WyGwo%^GFcI8Ayj2t_e}Y$u-oJPF(8k=; z+sdWu??)?rk_SJaIteY*2vl(nI5Gn2kD48#gw?^}4}l zha>qBO;|+p7yFfL|Mg#-^Y=fC8(!jN1%UcpR(`U$|4_4U`I!9d?fK^JXHiDU$id&9 z48Y1AnYrBw;Z~8fFHI+K{H}by|4isqqyNLRPt6Wjkq^Wcm5mWX(TxF`D*J{TiFhi^ zc%ZsDsqj>sc1MZ?ryknG9-UnsNn(r%7e}PAcV;y{=lARWdBMLw98dfo4HgIEe@OUQ zIR1ZZDYpNQ7SivZg#U;XPN5Nr^rBDzpNj^U2}CQPq|e_K0wba&Lb8B-L9(;gcNBiS zV4_HqQQwO}A~&|QbJyq3yk%>oDu4F3z1PcwO=69dvMGnwwyl~2N5xJ+j*#kQyrDA{@c9vBJ?-!)e0j{pk zRy>8Kp0=B|!^T~2*+Ic)0u>p(uC^^h#L5yKd@7?xqg2Gs54u*Tl&IHmXZE++WztQS z)^UK!mlBGBsus}gm8XN`nC8l&8*JRp_s7o%d*^m!PchWHrg){Si~{26F2kk6Y)3k7 zWUKX37w_9h887#`0}*EKUb(zsB9XR?&jTe9;+Ns%RXb5X#klxMBwGwJ?bhZkDlSc~ zy|b182%ij#4< zr+rtGA71;$rVieK~CwARj0< zB-y=CGdNoU`8}`?0JnnyXo)*dX$%Fh4aj4XkKBA1ZKZ@vCUFj+GKbJVVNc+aZZzs3 zy>yYj8711K2vOC|{^ahVh`Vr5;X`aNfAkG- zG|60>L1d{FBvtwO=lm>{>^jMUC6=rwu^`p>c3!cKJLg^YLkaHadDOgZG?tOv( z$)eL=O}TC9GMID@E?ba&`e8Vwd3As2-)H_UduO> zJ$yVQXtYIe>lEAC6`W~ekQ1Ki5&1*&M5h|7Dq=W6zi_Ys#(r;Xi*u=f9@N9V!15(gtWt-w@ zlSfJbKtyQ79 z(JW%IfTzX2Myuv(bB^BGj_)3fz4+|CNLs`u}c z7A8lpGj5&TDdgPw=MXAh*1*a!Qr%UF&J704>wdI;)K6&aUHNw5TQWtEU{etW*;{TQ z&%;jfngg&CVKOleK$I3ncuK%$rbUx2)WGT7Fe@J!?OZsJ5{y!lbPyM4Bt3`-k^4_7 zC%m(Zl^!(AyvTXE)$RWJ>+{uH_qNS~dg)$Yr<@b#K3i9LG1$oQiZPM;V0PS3d(E|= z+tdM`uY^B>9H?@Wh1uu%ote(kXr#-d4gA#O+aFOw_zF$^MGyC!YvfJ}jU}pPP-65y za__#pcL(xXH6rM|te0!(QrA-i4)p1*fy%s7sKhb%{-RiX+_nW++ut*(CvAq&-E~<1 zz>mjLoL^k6W8B-9ax(r?zwrtHB`2!ZYUT&bx`{UZU*+My=5Ln&ef}<1|5qM3ko<1- z_QL>D{54lvj}CMrT@T>NnV<)#J;nZbqDT$RUg*k+^14+>uvKAIV?(6tlhfss3i@ zff>ZHJM)rD8W0;sA{%=gPpl+q?2X7ZNRTu0_mfUFZ&-Mp&=OrXUVgYNKIm&Lha~#0 z=woYI7XEUTsjl^2JCAqc1dmUM<5??Lw!LcOmb9E|ddwVFOyznIYwMd^t=Ci(>(r_w zsT{+YfVZ3FoYEA8o2YPFBZ{XO&3=jY6@1p1v3lzK#lFEF_gN(!Pgtqgc=>aw*y=gR zY%|O}@uG7{{iBjDbA37SLUd_0k}6cAdCRKp9fY3uZ9TgY(3O(nB*lk%gcpw6xF(SO zo&X)D*tp_S$&{bpgSGvz2MEeJ<{uo^Qf5i}FJ(B_3gspO(iz$uKE`#b-*=COhwt^` zWAHi~w{v9z%%;0rW4-TlBnQ;j+Gh;4g73~NRNS+3acke{rDFz4r)BD$*2<0Cx?Qn) zJ&y+kzQgp#aniJx3IZQDqijX&Cx-~#9xC^a+1yP6VypUBDCFo&sh(b$@` z^CI5P{Xx(v%5v6;R+)*ki3aZi#+$|p3$F~R`hJSWo91J5KBi`$H-PVswJd8q8tU5!0eEUe ztFck_ayxAdmS@kkh42cpPZf$iLdh!Xt>A(%K~S7Up{$gWLjcCL*b8{q?XfEwB*>zN z-#L~euU{0>`kRm8)8eW~QhyGO@Vybc{q9jL&%<;L9Q`wekm~@s#zo5v3-uLMz8L*B zV#hvbi|YXLb%A{q}(WlHR5Ot7ah#s)+Rb%m`7M>kQ>d{mtv9&LrE*!8hhz3z=kR)6q zxLANxjo8r1J#CySPnbZ^J_XcAztqAK{e-B^tC?*P+DVb1P#QQT&M2I#UAgpcVLK#_ z^COTRI*SZKA3E#DUaI%9xxGqLKq5v{5{3C!joU)Y#N!0n8GB8zVi^@8_%6&N^sEcd z7?mj=hiCG`dM;p5sJ7n>QFz+oA3zR6n!wRFRkodS&1$Vcwuhn)?!_&{9m93g%~J;- zj;`(NocvKtyl73x?70{}f_2?y?qnJ$;$)ieq#k1qmP7+RA)+S^5}?FBus%(uze0QC zRT>JgC5eUe3AMclF&SJ2S#YpkU9K1*@vw>`b?P{vcj)Enm|Q4sb;TsalUjIqFI#9A z(3RL0F(=t$kN$JYAyp;dadojls=RCqo8_(`#PU4%;24-7ayVjO3YgeIB>hj)4S$Q2 z+zp?=aGSxac2+S*!3pdECg6)ENlawPtMt9|gO<0Am~c2xV9FlSAz0dgNwfDv)1n_H z1Pj z?mcOi^t9<~cWG~L?D!0VpnXFVoj^?a^z2dvFpz55_B63PFDCs8=v-!C2? zFW(lfs`F9G6o7i1ykVW%u;TCd!L=Je^EI!?7P3DgHcyYf;O%$%%>!pS@|r45Dc7MH zQXFJNL@|uRCoqI}aR{%Lngmx5n(*2-xDWlaa*7U#99}NG}>;1ocpmvo3?h`#%cU zLy4@@D#5o;H(2?|3dr)C&kX1T zq8dTLUqF{kbo6iSz*dKut&2MC_>5_#Cjbi>S?XU9q=gw4B>XkbV`-`(7_HJ$X<@qIrLr@?L-hfBsJ^V4iWKf==Iwn{ zS5)Uvi;lSia>FDWTq70XDEtuw0_>M|M4Tm`CN=>E70Gny77K`s)JV(I{-**1;gGqi z#E$JLpRpE7i>hSi!~mi$sNabOsypiEw}^c6V+`>;z~R760~+mpO4=WuM`0wXT)l{p z4PfR~+N-mJ!fB+O!SLVb@+V+q5JkaM>VruK+Hg=3`H}_2j4kmOoJFa}ucI7cGx+!D z9htKaWjEEiK&c*aG?iI30JR(${0}~9xAnp(OD-Ojv#t~dpDsh3H(NMp_yL{hPMXK# zv<&9R3XTXUmywptI6bd>))^@Z@k}T_4KP2dOtH(G2`N;N5g2xG#JGNXx+BsR46{Z_ z1SujZsHZU^yU**r(qjTe!UV3QM&+#9`nFLZRcOzl0+u3ku^(hIH^9&=0loK$g@UT^ zXh+rrbPPAnVV$^MR-O;zs8PzzB;9r0Ec3bPak~8)TVeB;WCwf-G`Aask!zU!9vlNv zT(Bym68}=jsAY;9(I_Co zBxh`!IG=ltbyObwK57t$T*Rhut?F?hUXlVzczXP$Y*?;93A<34Ov4eD6xnWsZQDCG zd(LGvS}Zv!5tyi2@Ziq9tmlarx+~cIGHX-j##{bRf9l#IN05TL?(gF=7 zw8_dB#@9MP!(HjuH|9j6k`5(l9sg(3=QCC;IV3sz>L-djigO$FN|-sbJ&N|__u%E` z?0xuB6iS?f6>mHa=YqTcvPTJlgXD2z(Te`5A6WZwdl`NId;4ta2}x=T!r(p88A)ru z5J8*|-iFK$8G$`I7amWcs?yBs06dDddDp7%anJB`0g_CBlqW+$Dv1!@UYcuj0lG5$ z{1p_l`?{!9|0b@BQn1`$$L3Nc^P<{tzwHVfg{rk~!={np=Yqqo1tFvhhi0uly`qu% z+>T7}tbR(H+$G!lRbG#(IE>chX>DLfitW>qSJ{Z#9!QHZrrv>6-K1$(!9=Y!U!4Lh z(*HVC)Sb(hYmhLLpRk3DcAink z5!8r3Pj3t8pqSnm{FjYmMtg zvd!qR4CfTWWk>b2G!?xuD)Zd>2hiv7>&f)x-jl1hBj?A(axFv*^4|6S>x|6|EE+Nf z`G8Cr{f%Pj+zjSo%=lCbjMkrO&PV4gQm=5$ws*KccXFjz$Q;fU7_2(#`hcxcJ1CY!pRbz105{p2-l{iUCu z_jO!rx?82WIto0g6nGKPr^P8y?>%6KnaV4s|DIq`enFmmIoOniv9C{qT<%Rf)`Vp3 zG;RBrB^I7RCjT5PE+66s3=!*E%d!)F2Rta~k0L3g{8UEu0~peuEfwWC%}VXgS+O%j z^7)BBFqPmf58C?ek68s3J&<3dC?!3>mSMUBURhbGvXc`mNzMs8?@t9~46;9CliY#> z1Y2Vs?|eNi-+xm~NIq8T=ipZO6ULewWG+m3iWlkgPJAOXW*L}R*R^I!nHBK(h`&iQFcuaDWsQsaP-)rNzT$BITQ|I_aWn^BZB28h_}*Vo(0v8PE^9_jFBmhT}DH~N+67j zr*EFrr{c5=;Z2F!47P9CtRD1SxEhSc6n)v25v5N0pga+5R3Yx>5bqt`yg-TLzAbf( zA8m-PG<5lE)oG8)i)q=-*}zXTe7LszG20HcR&4<1RN++GU?*+QlnQ8t7(Q)kmva7YO*;4C%|s^g*=U3s3y}3pq6cb zV7Bo{w=xnYnk{esp+mT^H=%ecGB4n*O8#g=Fo5sg8(ZW2!S=n~)zi(8S5l39JIdEE z(VMlp(*YacUo+58-(?=dJ^#d(9WVez0|ORns_e_Tv^nO|+J)Nm>4)_6J+<#~Mu}3mcWDrzG*|pW8 zb2jg3Q&`)Ifx(Gdy$;~RHuS#9nvwef9w_n%{jd7`AJ*1?Z1VpZqjRl3p7^gmcYjhV zw}(qlGgPg0I@8YfC80+R?KQKOW{Cyze9p2HFh?aO#%Ny+g6x&vUvh|$Nv zpoNLnxqn}6W}4CK+8l`Pqgy1?*}g>mACg=WT?5Nq5{Kqia@1~jYc-Xc-_Fu1Q;nTDP_8C52?STP4T6t|9;ZPHn-E(zEEJ zGO2WE;mNy+(?V(WO-l5t3jf$d4!ZJmUZ+zjxXwdxVg&t*=NhgK&9hvEMo5I)D7AWn zOtV)PP+2dWaIXZCss=R*qIi9&!(mwCO+}I|mgl=uFu#cvJnlNtf_rn}vowa1X@q*3i+=L?9TG!wQA z3~lST#%;xSw*M2%93y)_A63k?c@IxZ-nM~VV9-6;B`0r;Xdw#@Emm>fbx!|8v=`p1 z@Mgk6IBWENK=a8@y0dIdEX>X3O_9i)>g`f->T;e_DW+Psz8@>C=ZOt-sonA`dW^ip zPuR6s4g!D+rY1+}#(f>g>=vvF_2k*G&aQAB(%b|`zg+Xo0yg=*YDPpfjq)_bKQfRCsK=k3>&bw`K3HKz?@Z8mEn(k?*6!5VtBgaaSFPyjaHX z*N{UIAhZpu;Y!nS>fr>Z0w(8A*thX%sxa|S=+-o&7Dw;$SBOe!-l>qYBE!(%0iKIN zrDjyKP-47c7MAFC&Zv

zwU zx?AHVxA7xcDC_CAkwYAwE7jTqd)DG2b`W-@;`5u7crEBhCD8f9Q7iLdan9% zmImjoc_5C`UW3p>EE}HbGicl?89kXFjHboRLX&91! ztkqWvp@KoLzvTJ=X&hx1X@7Z=WSg51VQ$7sFs$DCYo+E$*=Fl2w-9qRXwS`MIu7mv_d)v0~1w zZ*tj+hh>%Dia@k)N<5f2FRxFpv6WOMM`et1r5P~#Wn8wlK;;NNAUi4dglCGoBH1^a zk1@2frku{tL0&h4Q&i;0WtzoR^PMSk($9hcA@$A$fy&?fVmustqq!`J{Pb4@_a%j?}QP}pnk3}S4Vq)*FQKW0S<0Z zM}K|+Q8f$=)gR-4KISk83t*6|zYEX>!*ccWgTjD5_KxoM&QJkSLqBh)07s}FzmF3P zVRJD_{t{FnhhX@+}0HQK)S$0`-y;F1i!BGGCxmz_D4&{b9xyP2!*Lb0^k zPV;(Rm*tT{vt>iq>uRe-UDM}xq-QF^5lIwQUq44ore>gV@AoHAbj-M+D?*?pKV%Tn zEd!5!6SA7a!QsXw9v-huq3p9$U6(@ePlMm+C%^_gzja@c{kS5?w|RA~t$XxM;$ifQ zMI&;-Czh}b5U)+~vBxrrsW|(r>WdkzI!fxRDthBR#d6g+DR$qlONp5;kM+NC36H;s zaC-W-y+(#fWB}<9AZYx2!q`3A#&ISkOAmI^!$~)91b}Orb?yun*Xe$qW7V52f2833 zw!HbQ(DApqnymZsjP(nn8tCegyp`Y_8T@V83fIAL8mLI$0?(B z!KJt&UAzrFe^!^)8LwCkZAG`7nrV6i_MwJVpsyL`x0T##s@qqIW#47GK9O-`G*~lA zK;Ruk%P{gu$<@8%a4@xpuzI=75M9_{xQx`#FHXgdj%#9?CwI>;VPJ%`M>VME&Vv`! za5Z_k_uRYQ>(2LL>-h2S+t=Iu4WbvB6j2{spEPWr7rD0mYzk*>PohR@A+Nv><_Dyg zUHwmL7-405zIAMOTYKk67q*ACl=Ht6Z0kSVVy<#?1F>e6via&i1h7*&XENtdXHpdL zA(;aU6S$Vw8q2>T+B+p5PNyZ!Peb0Jm1EmGnC4=ioS6CM(fw!x+RyVz3u*gg?kWpb zCdIXl1L%|9q3dE8Y5|FF(Uc9lP^JuzsQwg9msJjw`T$NTH+bl^wkjOQj|!2iB9E+S z0)pxvdRb&;O|q~n5u+IAR8`?C##D%V9<0PDeAmR_W{Z1TZ9VoXYER(6va-(T1SZ72 ztjS3h3S2T2Epn3b;g)#vEkLrt)|Y66wpf>Jgw`^CvqijUP|Z)i9Lz1f;EG=Q5sPbk zBx>u^Xt)v`_w*Y9ix3TaZ=dQ9>_5UVM=Nvc!RGL}bgfIrCTph2bW*>UR4T-Sg&9D| z)Xzgm<(OJSzdYi5;BAq`AXyprmZ3gm$RzSKso#n;1(L)N+MDincYM!oC$P#V1EuymaN%NJow?WqG=C z+!kRv9Nn=M9l#O2D_-+0nIKaWWxS6g2a##o)AecHg&KE7AQJ-qG&pIy=#nZi>akKuqeGN* zDk7(8lV4DrGShKexp18MOgb76J#Cl3VI4s$+7QXYJh*ru5$k;Kw|nF&o>`BjTUX@DIe4u&I5pNmwv_c z*$CM^rd7xL(dlftrA<4Z9jU;S3J8tZoaqWnZWp0YaB6E6Js(R_9*gQv0zo!m-T-yx zoFFIq97o1vn`|QV4;v$MmO#bE2GU2F2>HbrH;Z&*BXHUR$hCZ6!P3s z$^FmvIl$V<$I*{lQ{rhAtTd+Z$rhI>ESEBO#B{PXUFx;Dz=?sQ6#Ro$fI7~;n_>*$ zVhVCKa%U=1JyB;e?rcYFgwn%BG1~t$CEk=fRD(%d6v>=AS{HUxrgsAn=IwW{!W2qv zZ8K3xO>L>d(y3PXvyk{)o(o-wHH%SKJ9}Fz`)9|W1bS==yyif91zt7wnF`Cz6fpRk zHW#wy9#h*tP5f{zRvo`-rn2QS*J^-M(*}4D8i$SLpN0JL@sqo688Epi@H%34aPd-C zQlOeL)LVuvw8|}=RF^nbzj;~#moarO;T=UV|4O)+{34A4uY?WjJ#3!Da!cgJHVumN zWa~?7|53i^u~uTT=oG)Ke!}_UEp^2UqUxYpLBL-K6>hu$ssjwZtYwE0jNm=H0#e(Vz9Q+o z{AeEer{ZcQ%CS7HT)ItiIE$K=_& zV(OMJciH{i62W*uO0xZ2jxlR2Jxw+DyOieF^y=pf2V!+KGotywyJIY`>7|KDSl>RU zf6BH{m-?}6dr+fnB4D|Ea;wYLsMDkSJa5Z==x6)Q!;{hbLlpd`Ha!KGy?)1ty1k~H zIf;p>#39?epVMPsjzlFUhVJB7ex3b3WX#!&GdZz*bHzQ5y{+trRpRCM?Rn_<&)bdu zliQOq)R2EtOL+|JqB^j<7J`XC>n7!Hx| z{&ms+W$cTALar3!Tc?>EBfYvX)%~-_OY=fXD+;LEhe188UT%*1Gr0y2r4$xV|7zze zAb*F3G`-(qa5m=tSv)L|ZIYr(jH^_Fd@oFW%-F;aFyX9J*B4;tA@WeP*^U^qi)Vyj z!*S4f<8PSxNYE{e9?nMl^Xx3EQyB8dLQ$j4+uV50e0TFNQS?>Lb5E#xxFdCb<=of( zX!*;l^pMr#w#)FtmM&EeH(1AI?@h9nXp~aT&D7jp;j<~HvJutXre0t}>%x83DXzr*R0$*RqCPn~8}kH)^%q-Z%=mE^eO|qJ5_xeZ0#D}#=XH_*IdnI|{q=WKac%M-^d zIOf-MX+bAF_6=saB9!|43~y?={8ESlIJN|{To!VF4)ts)wxIiRJ%a5Ym=Dcv5%SYK z>$cuqQFVfXb*U^5(}HelnpZtuK@*ozs)c2V z|Jy)AQtV#_8vp33S{OrNB%(TAPS9YWwHOctkpw*<5jAlQh5jv*h?)bfK|l%MpIBpW zZ_K_n2pEDvG5(VX=KV+g)BpXWsspX%#bqQVKpNs=5QwB0L=7Y(0ah2+l#qc)L)6u! zRl(AV!2jC>laoHw%NaB9084_z|J{Bv4YbkOwSs$?sxgv@1LXQ@UR51>)B+Sd9)jw34RfX>j6jv?-fgW0QHt zxWRPIJ-$*{DSxRBe^f5)(#51mvh}<8*U5>(k<3Ntq5MP`y6ECD=4dnau8a*?G$j33 z$lHm4y>FgK(hlS&>Sf(&Tpow{B*`hEI9Z2_WY4lrY!83db}NoKQ zcvkR1_1=QocgiLzRJR>_6E*Vm>>>^qnULHGrifKTiU6kT-0?k;Ues_GHUcfTrr5i8 zA2eH7S$G1Y7q}3nK4}(&O^M*lIC2N)B!$vN;;y78+-aSNV^?LLO4Fr?RK7DDQ`7H&v77aJ`4WKZtETr_uwdRkbI;=>d14%P3nP0Zle zz2GKVhk4ge(TE7$?k++&xFN>UK`t3J^=K%-A=vSW+G*Jd6652mH}|Z7fq4arHnwP~ zrZHrt>z?Kc$9Z&th=FudV36MDKnHUd-Ds!-Ve+oK&U;#ip`<6}0$Qa&Qox`5 zL>$7Bv$qQ;4Zia?i6E|{Z5(cqr&6~kxyZq!fXSJsC7ey-QWcIUhs9A6xSId*Z-5TGb@{$aWOaB zj1l8X5@T{fb{FGre)e}poqUjj(@U$t_?&DzMiWC#E2zE|?ox)=n1u#d*VpWCXp8VnhkO_&#$*Ts>93h-xS6h*1UxLh5z#4wnZ* z@0jF?MPe*{28we7I;CuYCiKt zf=U&u&_*1yK3t&&mT;#}Z;i+-xzJb=+o+&3-5TwQq8p`37~@O~nX&Fh=3P073lD46}3;e3Pk>TynXR94d6EyI2}aw(R%1#gKO0r;st~z==bL- z4if831^DoFSv$7sRcvY0)eC8GF!l;gdmrb?vmb6FMM@nnIS_Y;akPyjPBDq=fFqxA zE6`hJPR||0Nhh16LhlM=d8EYp4!jtodu0-d=0L2y0PfEY49Uz=D=h)f(5$Iof8mvqA?Mf&m;+Ft+30bZR z9@5)#wsQ~`fJ2GlzU&hT-9%ROX3r~*U@jybM;lSo!v(@)l_b57ph@pfQMR*k!EW&o zP8J*pClbI>NvwqpBLeXJ#YV)GG5>S#jUtvrd;tfNhl7r&Nn<#ddozTlJS2Fw_OKsmD4 z`^a!oNX+;vqWkzg!lKj;hrc6NW2CmLmR#RNjGgAPw3iTHk^flbv)$b7G*co4Nx0#9 z91c4TkuA`%Y3%z9AviLkA9)tPLV%YmY&GAQ9>yA0lg=zzx_<=0H=_IJQ$w>EiE;8H{bpp@ZFZhOm94yZ*wJ6BO`2%|Bh4|0 zvrc zy>zi*+`Sb5p!psSu_FA#0UX zx<`O24%bynh(7=3QJSwcZgclRw)IGnqIDUT`aZnxdwP_asNnl8o!-dMEAbA3%JJW) zCE$3nQ}NW^tr|PPIN~!c!1zm#Et4DI%4O?X`XnZV9-FNqtg5`;^!LxTV7 z#dZbdCuJKYBE(XTVV-zw=w~C2{dspJ<)mZ zX!-#HblS@(&rAFPi>I$y*9$rgyaf}ajajk-5zE)613o&sw>$?@?KQTb@n`2ac|Qb1 zbbNJm75E133z+GcDoo7}fp@byonfcgmplW^yGflJJOc})FAI20d0^u!BX`C_kOCa~ z@$Pfi0iOpcuEx)78kJ=|4?nigrrH{>{PhVZkYSfB+Sd4-X*ag>qS#HWQpX#YC9m30 zMXEBh_X&JH(s~1v5N@oWI|`;)j2h-~NB`d8tMWf3fgSd=@0%(dk4N0m&tQ6BjetkJ zbd4h`6jE-(ut_Y0GD=&N&2UJnk@Y*)J1pzsRTy09T#2cfxiwlLoPtb-^t|vU`NCxw z+lLaFxUPB%HC=^%iO-{#Vi8Fd~I z6i8m|w(LL0t!{V|EaiQe|Dbw<*8;D7{C3|t&Q!0$a4u|Ur9mM#F!`PvnwGXFE<8tqH;(T@DBRB)M02xWLsQvdiDG)c{jFsCW+BZ7H4o9lYS#fIoEt2j}ZFWu2r3O0Q(`gVYNfJu4reM#^W z6q)kY!&$k-kLHiIUT#{vv0PWP{R}Y$w`0$OOgmQa`OVD`*ct=6sUf10`>bKu_#-5= z!=oz72aQv1t3zv3l)4$TZuqn$>CXa{Wg3kokG9#}hkca~%2W>;%aGf0MgpW#`H9o}Q?3Uv3m1{ovnMl`3^7H0uoelOIA zRlo3JGxIEi(T8k2Rz}(KrC)^0xxmUU)w{bEzD8)e7iLxo*POU6?*W=<()9Dhc!iyskAgaQ_| zoT6w9w|{<~f4#8v&|<`92BLocCzf67(qvt#plK?>cIrQ)*f0MY4?jKoJg;SIOWUd; zC`r2KiD}{@UY;G{&Ro1z*tFqcF}bun6c`o*T0fuGfvrnEOD`AY3mlfXxSIhX#u=*GAAF zN~OE{vIhB3md~ZIsA=kq?d)4zy#E93Z9M#3fS|C#jppzRU{EYq4zaQ<-;7YMj$qy4 z%%9v3@j9u+Wje9zEq7&Hi!mlE$r&4`ubMQ(y)#ra5U7Wm&2ep+qJh1xb7ppP9wTb1aiUm z#B`={ASon}A>!)jB63Q_byDGVu>5)z$c}_!fsH^Rx;a2u5(puNoDv5+5VBa}%Z}Tl z*hz6dP2iH(<38Yz11Nh!)_)0iU_o@rwST6rWA>tmB= z<76=5y7gl#Q4+zh5ri9N*T+43xR7V$5WqdQn2=r(rH((f{g|@Ro0P7PRWO2kmQcuY zS4pwLJg9Evn4`PPd8_hu=v$Ai!l2W=56^6GYi;T*uJ&zbYfNk8+N!A;@GP{V1O5(P z;O_zJ+yWwMh4vl5nP;i^;LOkRnkNh>$A1yd!U+Coa}P-_^FepwXxqVGV+B!+C!+st zbc=(7a=iVG^^bIO-jb951LYQ`s${184`7+v)U$o^ls-_+H3K{H5;#Z*@*BD~!u1;( zX5|V>Tlu41J&mM@T>)JWy0CHirF{TR4QexUdDgP4m%5D)iokxbt>Lqz3|{XhMCyH1 zi5SOYcg$kYLKg7yPQZuuM4Bb5$8^q%oF@LQfaNPZegdGVb@~5KC~56VE~)+UZ850m lj&L%>hwcBJje`5z`}qfBR+UM>APKOT3<(d9#zRe#{{U|eld%8* -- GitLab From 8aea208633be0e4ad3c9d53d3154c4972310622e Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 11 Oct 2023 10:22:19 +0200 Subject: [PATCH 63/64] Update release date --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 497fa39..4ea74df 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# s2dv 2.0.0 (Release date: 2023-10-03) +# s2dv 2.0.0 (Release date: 2023-10-11) The compability break happens at the parameter changes. All the functionality remains the same but please pay attention to the parameter changes like name or default value if some error is raised. -- GitLab From f4d8a7242157d09d641f11fca4f1e1e1ba7c79d2 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 11 Oct 2023 14:23:42 +0200 Subject: [PATCH 64/64] Correct syntax error in doc --- R/ACC.R | 2 +- R/StatSeasAtlHurr.R | 2 +- man/ACC.Rd | 2 +- man/StatSeasAtlHurr.Rd | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/ACC.R b/R/ACC.R index 71544b9..131d15a 100644 --- a/R/ACC.R +++ b/R/ACC.R @@ -84,7 +84,7 @@ #'} #'\item{p.val}{ #' The p-value with the same dimensions as ACC. Only present if -#' \code{pval = TRUE} and code{conftype = "parametric"}. +#' \code{pval = TRUE} and \code{conftype = "parametric"}. #'} #'\item{$sign}{ #' The statistical significance. Only present if \code{sign = TRUE}. diff --git a/R/StatSeasAtlHurr.R b/R/StatSeasAtlHurr.R index 9d0ec38..764215a 100644 --- a/R/StatSeasAtlHurr.R +++ b/R/StatSeasAtlHurr.R @@ -7,7 +7,7 @@ #'large (bounded by 30N-30S). The anomalies are for the JJASON season.\cr #'The estimated seasonal average is either 1) number of hurricanes, 2) number #'of tropical cyclones with lifetime >=48h or 3) power dissipation index -#'(PDI; in 10^11 m^3 s^{-2}).\cr +#'(PDI; in 10^11 m^3 s^(-2)).\cr #'The statistical models used in this function are described in references. #' #'@param atlano A numeric array with named dimensions of Atlantic sea surface diff --git a/man/ACC.Rd b/man/ACC.Rd index 4a4a5f2..e1a8fb2 100644 --- a/man/ACC.Rd +++ b/man/ACC.Rd @@ -113,7 +113,7 @@ A list containing the numeric arrays:\cr } \item{p.val}{ The p-value with the same dimensions as ACC. Only present if - \code{pval = TRUE} and code{conftype = "parametric"}. + \code{pval = TRUE} and \code{conftype = "parametric"}. } \item{$sign}{ The statistical significance. Only present if \code{sign = TRUE}. diff --git a/man/StatSeasAtlHurr.Rd b/man/StatSeasAtlHurr.Rd index 9657322..1615467 100644 --- a/man/StatSeasAtlHurr.Rd +++ b/man/StatSeasAtlHurr.Rd @@ -38,7 +38,7 @@ the tropical Atlantic (bounded by 10N-25N and 80W-20W) and the tropics at large (bounded by 30N-30S). The anomalies are for the JJASON season.\cr The estimated seasonal average is either 1) number of hurricanes, 2) number of tropical cyclones with lifetime >=48h or 3) power dissipation index -(PDI; in 10^11 m^3 s^{-2}).\cr +(PDI; in 10^11 m^3 s^(-2)).\cr The statistical models used in this function are described in references. } \examples{ -- GitLab

(8(cc~1`>cS z7w8_)HUaVG$hw;#1sjg+?-Q`^*Eb$737->3$vLZOKa83z(nxk+{a*&}$3DM*Y~4d5 z=1QsU+m4H9Nm%Cb!x@ax_FlM*Wxf*YGcBgph(EX7%VUTKwN7{pj?DML$j0AB zKIA!b8!!@Zs{KPWg5NJQ2=9zwH4+bdBxtW`qivFjN1^Yg*j6A{N)|yaxD?QaZuIa9 zit0cFyY3nX5dhJtsvu*T@iZEGs^*ceDta~%*uWwQu+z#^_1HhE?lb_cEr$ay3@YFf{4HyvKm?L zx)}8xiV(piH(ECduOatmKKWm6kjI;7+#~*LJCK&*`F?9d8iEP0>^$pewEnd z41K-b$_c{5$u`l|FTK7fl_4xT|2=2}E<#!uK_B%KFmTV_Rov4@V-2%xOWv?;h=vRs zOmGx2(2iWvn^{M^@=^JK)ymNLSPb#C1ix2LFfVFzz{3tpJ_LTe1`#OD2y*t*8@0I0 z`V|nkl^2_*KeK{#WgRkyqn4sgE(ng^6MB6p5+FxDaRbNae`U0MOGB~GwDFu=_2hLJ z0z|pBVwLfOjme6%eaS2BN&hly(3paNGS&r3`i0Q_t@q6OZkLxCTTOx-LzyjoRqd>~ z7A;=IEy~-R@P5aX#np3nY~nc<_NPyD_?f*Gg`WC%+lR2ih+Rl36$FVr!J%oMfK1EK zlB*|aD+H>rs+}u*{0o74iC6Nyf3nV>>|Mb9e>WM73=IEYzvBPvM`U8+_@5I{rZuGh z8Eg=HZfnyriz@z3y$*&cS7$$ulpDjhz`0(3_!AOFK#Ed%yPG~-KC*W7hYhVyC0|qF zmq4&!DHP)Cxfx}39%ehe?oYFSvg`Srg1ep5#dMw7`n5UXnw^5r>)>#9&b{8eyl^%Flu6yP;(rNy* zXhP^r>+w4VANK85pvArvG#)e_x^wN$!yk&b)^th_D#WJ1R>oXbO?GghFGo`PwQDNG zRkq4ZsFb=FHI&$jmchrYEDI-OpERVj)qlMlE$k?ZZgOlCM}YSWL7+A27he!eraF^$ zX5AC{Ueu!cb=l}OI&}6)hg4rR(^SZ%DXUp; zxvZXgu8CE_ckElZ{XvaWH#-5UOkW^QQDMb`wr#kvb#}JN^?RvqZvJ4$trUIy!VE?& zRvYj_5-O}HgyFYQ5{F6S>ZRcx{C#A`xfkO1YOY>Bq_)BB7+Lw}^}s5k)(SJUs)A{G zIW)Jm;;J(;ZD?j?87n<-XHp$euZo`6HxU_0Wczhijny?j<{uez+12^DITqW=jrP~A z>nRh_=>)piWFjD~uA-!T}Z_^6J- zeqN&6c+yg#O?SR<1k>9mvpk#+#I9)`R)_9^kjbLd7bzGbgJz>Bc`U~^0{y4z7 zT55B)_4Bc6Z$qwg%kJAICbQofhyk~NBDO`Ku?qgP&~t5UR;ccypF5JXEy^=6hO$D7 z%lCm&d-SY%O;94N4ne9=hj zfSsOY+Wdq6A3aEN5CrSE%V@&UGc>5Li)b*Mao`!)pZa2~dh zm4$nFa-H!+MlD6$)S=Giw%bxRP^0Lrd*^xOK2eIbv2obxaA>j1BNkKgQWIhn3MX=Q z>XC5^*;t7hlF`WeSs|QVE0NMX?UIQqa*E;VlVwcqEhLHFp720IIhUUeq6zsEQ<(z| zL{X<6ZzOpZVB3A>qL%*6Z0nx9VVR=+Qu0gbWiSGNE&J$=`1oc zi%LS+vM;?ebczj|o#=(^%&Fmaxy&`Q1u`A;6t>bD&t-F-+UixWnwb35cUpl3;lLIG zNh3*K5fvdK@}gTFN%He>V;;m7i_qbvK(v^34-1jEe#YpCRvoC%O4}rSk-f5nq^jQu zI$Fprvtz8?Za{phFbwZNHwfrq^`2OY)_sQ`6YHnC z#2J1+2~%;!h&?k1O#@JM9%FSF#YDGO8kkR1n9=N5*ZxeGuYr=xeb!(wWY#UnFriQj z=;3<7+76!V752jPVphV<`TM#q|Kr-^D<4u+|A8iC#BznVk#a zhtP|sQ9iD_`LtJ1X!=B z7ooz-CU-@*RFjve@SPoWS{1>6%)S$Lfjj_TJUX~QvK9T;toVMO-tNuzEzt(`e+L_V z-(BtGI|%v83oTJxS!*IR8cPnS8Q#lISFf zS{F=xD&Bg*jT26iKwd)9afiVA>p**!Nf&8uG&|+o6UFQo0GxdR+)1ALAatop6-ovQ36yT8pbo5-b%tJzPfrYG}7NK$!5(@6K zDZK;&P|;G|D8#_L=Q(3P`2$rk8?;7uvY80*}ylku|YqvehqoEGdUIwRc zk$V#wUa&5#IAIkvv~px2iZYt$$C%!=i|YpB-!ph@k|Y*aFU|q)(vykerKhBnY5xEy zt4mzSn1GOg96=rjpErdRaXW(qnIcPcUtmGBj*vv?h&Gs4k&gYmYRI==Km!-{3h?=c zIJ3wTS+*adKQR>tzW;W|s)t zM`mJY{+|hCe=)6UH#@Gq{6t?U;p`J9T)#TbpsG$=2D>pf40!uo>$y>43rU15Urm>+|TuM7VjRJN4i*rCxRCZQIy*W!FHNcTrv*Zz-SbO7bF* z`D2(xlGDQ?OWkZ*wGZRZS1#PDQ9VfWlp_~eD&JnB(!}-bD$`R-Ey-L#B(r^E!o5TF zJoCQ#m!8Lh-PXfFHzkRAv>QsFZ)Zab$l3goStvonNCBCOmRnXYa?OtG(z4@mP%PrU*E`_$Ap!J{FW-2igmhabk-?`i ziNE$q_0&9TPxYP*feEu$&Fj>!hD+&(p$BqJ+3aZt5sL0+88wURo&xly9LX4we$_=R zfc@WeEdmu$Vu+A&sJe=265}c7Hn{`Y6tKEm*G5@R-z=wZ)Eh=Ec13FX#tt2>4)eQtR5i5?C_a7duvxY|P5Cdd<0nj z7A{b%lAeICfMy={U@5?o5g|BLuVd;#)EGMnd;aSc-f9!&WYM6%bRrDseC}Gkw(Sl! zpE-0O#uTKL6uLc!J}*e=YECzRuwfm%r`bQ_!+fLq-0c|gEf?JV=6}0_x@mUH{9O#O zBmtmLM0dxQJ+il_eM!>?joJU$8*AqU_-nazT{nz(E+($3dF`YSA%RG(;3cRIqo-V@ zQt?lwyK_GM1QtMDI{^SdLhlC$2VJ%FkV=5P1KhtG&fpz*F><^{7luw-l&k(4WI?tY z73{1A!1!d>xkwi#L`uU0yoXFyYTbh7O<8{4*RW5>2_+qP}n&W?>8+qP}n z$;&Iyd??GX@S&*{3`ywfnNn!wckSocvJ2T2Fh=JAQq40uSPZ z0042LDaq{&v61$Vtm)1NgHu#AXg6?F6HQpmNQ2H%3dun{#~urNEQdTin)q>yL%-AK z4Z&)P5C)hHyis(4gArU9!-*eY3UFmrD+6~G=i1)>ql;5#6z_L|*kD>|)ces`)4MBJ ze3np4)gX?9D+CZyopHVds0~=8%Hu<2;fso+Y$!(nC*u!--Sl1)1VaDbK-pgi2XB*a zK5H20#u!JAjhP~@-$~03jGEpptkd)xH$rT2{+cn&s40qrv+Ics-?8>lMis6+TF4t6 zXTaL+Y!m}m6Tmhn-kC&WpqLac{OhT|BV$x{ZNTqwJ$>5FF z`3(Q6jh~zE5x?@AsV#Gl`{_}*h~K>Sd_aDENT3pg>U-lEY$-ny3J&7zOKWdr>Jt@8 zsF1IY1uT}yAtN}DSSwXlU?cx&EzlHW^AuHRJuheAa(vx+#Xv+)OEO-xjqw2dr%*$# zF<|X8HI`Ag7AZ>mfHdUIU}9mSbR3eirb8~xSJOZGv0xq4@prPLQl`87y*;@TUd7r7 z@A;AzKaFHLdU~lA5WFXkhX?bahtkn7Hjcx9xvm=}XpZ;MziurmfRgAn*#`dbj(^$% z)P9$0#k$n)@7CUUusNU9n~DHL%ud)iUdC>#AygwNV%-u(!(9JBw0&wLfy)oT9=D1y z#9HL!8r^R4ehcq_HpV%#HEj6ghs{yYG=b*FHYjty^=QA$=&p0gwG++(D8K0jFfsMj z!bUw-SQR*0%p!+wdWZJd@RS8q7tM1vX8}Y&Qb*^jx?A}!NgW|NL6I7U6V`hf+U`gm zA7XF2F;c7$ne1(n0S1$qxD&y11_GR(vT)Da#>b4^RR^p(1N6w5w8vui+iP6w&W`uz z6|E&{Gay+G2G_oXC!F`hqbTaUGVEGvHh$?F5R?@JGwRwkv~&&go^+>1OGbK0Wv3&A zNGenGP*C;omP#3y&5#)?%)X``1VfrYz8!OLsks$P0b@E1W2e7O08VOpB#G8cVXAP5 zZa8s4K=d3NH84galgyH)c~E9w-YbBzH}PYYsSmBzC80_3l&52OfEX@v-fH)$0$Vy} zZ}MEg$&maf2BNSk2mp7Mz14hvI!N>?VNj&>03x_|kvxEfp(uQH~AJ=<~BSx>1Dd=6@phU(^?ITYIo&3Fv61D~)MLhlv2Jc!PfFS6+ijuc+ zEnS~3ix!I~r;wzGCw-zW7-mA{}Fl!cTzc^%vkFhEtKj-WiX`B?}>!47ts`KT;Hgo*u zCHAQ-QyGBSpRS zMcNRV9~^IG6Cz-WIVHqo5t4_dq2E5mGxyvA z4uGt|d=iY0<7R)geK-st!_^)PhyI!{ireEjEuj0r(*H}f)zyNN_V8m^s`fM2?6Z1f zZ*jIm`XW}qUT{4qebP(4`Ajvj%OTJa)um!*SFAq!OiSgyR zr;B8Rq)_kq0Hc0r7r~}XU|(xH_e_}nGY@jV%|jU2j2Zh!n@NS)RS1{f^5+Ff@IVr; z=Lxd`UI`xjYbVkl?h=3<$q!IvDR}HZFTfoC_pA^TEBpT}dEdgE zh}~?vyRJ>wsswDUdLibA+a5%=u44c)3&d&Y3#6^@h)5ZX#lxG~u|usKO=ZFIx-^m{ ziW)Mk-xdLNJL%ZHwzKo~{1r*?%3e$MOcq{V?>VD`1>lpf>HJ2VvBccqpSJuuxz~SQ z_HJ&jliWiw(+cp9_=od93q@kY?SRO-3cbRA9~zNBV4Oe}D+<@}3Rv#VScCNmtW&Hyk>wH?PjI6W=`Y?GL^0H$Zwh z{i!Uvid6Q&Fu4zs+i%tZCERUu*A-Q`AdU$GrO=;kbb|J7rL7DR!(<7|_P_8=PsYup z68ZMn79}2q^y*^cj%&0>+@lU2CKE4-f1}eq8Kl2rB~u3Gg>%n5J4aLc80ck#J8o8N z+^$?$J9S&}%bv}%L4ynBUZ*;#PybmM3(1o}crsjrMx{8^W-iNnzlMx}Bxz*ER|`RyGt^-(-As&@YTZs$O;qTM1xoQu#rSRT;Y+ zv4Bm^~ zX0*07lRPEEx*7fO2cn8UidMKdv zu@2c65RQmvhF_>aIpIl9dfbxEGrS7p=kv&iPZ|F4i!JtYQ6-z&k8Up*bHE4PW|a=s{jl(4xpV&1Pw%a2?%qBG%76ZAFqx;gdL$m zD#K86(2#$o;VSQ}N{?vpUO+7`bGbRLqTW`BO5i~Oj4E9>8)2l%4a7HoNAK4~zFRAR zz={zLXOY?#4JOVW3lKGEvP%}euOEh38xa43<`ka;U8Mn|+d8%j=ZJ5dg8N4`ycup- zO5aoE%y}KHK%cp$HzkGPZBai~nS3p9_!!xUYoWZ}HOO1vXHbRLvRqit4qbYfInjIX zgaI`^hFT;=G#SOXHlooTBVpLyn9iRg6>V`kDMFvYbzS4SkO+X#7QND3$iKKQ?Hn7terq_Gd{}Izh!}8{*;J;Pd=MGoXeEpubJ$(`)r+{Bm1wF zhz(@pLTjO+`^B+OCG;T>nwvaAI>E9N4z0QZE0*jZ7;+t z=K2_6Sn&PB7?C}PXt7FjmWGQtl?HL7f&~mtQN6Qrm#B8aaEoC~c}}x{i&$Od#azBX zA4Eb>N?hmNax%uEu0TI_o_WGGfPPF>BG`wRdfLFmvQo{tItT|j7$(WC5&mamTr@~X z#GZM4%$;!W7qgG6o-3MA^h8P-ZWiXR_f+SSjiIoPMw4P9y*GybTUV(#5g^{tTxMU zUl)fmS}k^Xxj7+;Wb{%cy|-0FVnrO8k18qV5c>pC{fxiMdHP8!7B?oM#G{GM3^C%8 zyY(u>1A~7OnKmx*3TVe@Ku%?$gxm+Fgn39LU zLX&em0guUu3dwV87D$iQ6&@V}fO!JOA73Q~YM@{Y$353a17P(zYoc9E)F(rX5Hggr zbu(kht0fu0ur~(e!2BKWC2ZEn8C!)bGmwhKu9Av?`92_U<;;daPfJ-8?R9Fj5vH8F zL$bG~-~GDKAX>*XJM?@{7WULAFZEagXwMlNr+s6$xUu)2>h%=XF^wwDKh^aF zcGYPbx}`vw0Ix;!ay?;HPY1yo1<4fJq*-#U|dEz}Ylq}$lv9^v_i+9F^}RHUv3Sg>zGnlqSi?1bHkD866Ec(=+x zKJSDY3P>0O5bxUy(y|z#a#qmrJC<0=E_ww)f6H1;kx@==^vk~XEVza}F~pzf7!L_5 z&*p=9%H$!d0__`mz?3bgaKqd64}?LTK6&kvlfTsNn31SspJg+YfFyTM^2rIo%Mgt!KGkL*lvj5=hn^=`j>== zxIIj*Z3Uqx(J+l3@7_(4Lc&N|OJvIz^DExH-n8mYrJbpBk{GL@S5{u=kX8=)7NGt3 zJmh__v)}mGC2&ZbhDLpC2~r=q`?iG(9)aX`w9TO9rQuhyX!&&gTpf3vz}x$joT7v zw}69{nhX=HHsjyp88nyDVRlxJvrSEewmyqAuN@xczD!DjPxQz&TP%;V)pahfO9c9_ zS>IP!`vNX9Xl_H){Cy~*+&Df~Hz}P(^M<}?;6agt7fVWIw^`cl0nZ_kw2GH+*9ibg zB+R%=AjId)zv`CdIyLw5?d&8?c#Q}LAs|8m&`6lvWCEXS({12p2kUn8iLd6rPh1g( z2b`4ma_!*O3FmcQYx5D@6+Iqb8H=Hr|<(g|?Q!>*Y-G0Ea#!-RqglHGr^nydu=?ga(y@j4{ zOw~aAdPh#u5yez1}fZwU|Y5ZQTIFE(Hohh7ycmm*@)mq1hs~C$n zlLr!q9s5}>^aeo4%XWU^mAjxou^63{B)p@(7i!$eE2ss z;zBtKeXC5&8lV}-#KZpN!}k1(d^gcjoh+sLKq?z6_Z-8}e)O@ez5EtO%8AwW$Z-nM zy-9q7>M*H@BY;y$w!XrPVL*@1)0XsG!Ie^8cVZdO0LefepsvB z!}eSRTKbbnrP5kwKPh+mK7%)zNVH&;(Hx+gL|PWSx@;I~ge$2Gf9$IQOOUWg_>zy` znJI{h^vz(vCOz;$Fvp$)VABcr8WNs1vcHJa_~HOphZ!LHGMfNY_>lhB)3(FzchL(3Kv#w7A3e~R?Y*vNHDtb;7ejZ8kE z*y5Up8Q|vJXlyHg+B3J^aF?9EkTd7HOh=XLl-I=tq!Xef4>@x{?Tz)yw|2f5E1BBD zeML<2KRDXk@I08%S9E8ZO1-KX`)^UKg$kfx>JJBY5C*nU-g#F^-r~rYzsiyf-l{LMeVg7ueWoZ7XDqEM=9|F$^wC7YK#?Ggy%O zF(?Je8xrm5d0)&Co{>09k9DMDG^NjJ{3i4K7>D|cHK3V1LiFu91rW@cx8>hD z?%-jqv6CyAY76u?P+^LZL8udkTM1!m);f1?=KYm&;~3~3DRRH$Ul9IeD|!_Ss^-^f zrJhghl#X4KiRD~E70-I;eN=3gXdKffu51|;6+;RX-w+%#YoP0l>)|NbushR5bCm^p z-LOL*v~ekhzNezkvoSMeTQn>Wrod*L@vA{fJKsSsylhiW7hZ$*4Do%}%6isL>#u>&`x)R-PKB{`@>J&S;&$+FQ*@1S;& zXzvvtdjWpSt7ur^w_H1q#ndrQBxETDCTH%PGGt>d!$rjRRLv0vgfW6c_bVqno5wY0FE_&8y z>Q@GG#9HeVrEbK93Zic4NrhPAhD{HX!E?2i+KWqu9=u?$TvTaLR~(+fJBH_SjCrH9 z2UQmnp8$qJ5Rr&XwXLDmOB}1OR6u{?)lb<+*6C3c9Sq^YyfWu-Mc~ zXB~`xLGlDU1_UdTK!|$OoMbfqX$6v6!x!PP^bgcGS_L20#()KQyEtE0ty;I{INb$- zCfH2`2mZ&SgdmNVwe3?Adi_1grTsfh!)qJDeu&NOU0p zgk#C+cEq3Tpcx~#fIo)1A(KVTaD?h2Zg(Q$} zn=Ck`S99-7I|p2GhKnpQR)FOKYFB~#1Edd0jL{wU_-}`jFfjEWstBSzQ~{ig2RRO5 zInyD}HUVZ}19+|mx2@`(jGyu(@a9oxzUI$_71%lbqk4qvJ{TV#^z_L6@Z$%2J-IFU z^{Ntj6%;TN3WjwW(41Hknu$;j&y)|@grA?Rw^u8c5)1o{YjpkGevW^jzncETvdqZ9#QGm~R~Cl< zJ-PXdM&D?;+v*Xt+jpS}C3#(AFRN$1c2A6Tx^^bJHYbQAFDQXX$#-<{^>M3*hC004 z=DVvv18l zdPloD`L)`Rdu@*i)jl&ncHxjzCkx!Enxr2eSt5@Zq?nNW>;IU>!mz!(gCNXQ#V3{r z0=_w&Xj1TOcO&<0m*5}P9n+cU7@t*}Kbbwxv9|EBG!~=YnlV40u~d}C&d)@2UzX(Ed1@sHL_0*5r4H+pn55p*8PeL#EM$dWFUsB&9k)CKs#M4Gg)aO?lztHcR3k<02{yX`Wsb4h~o%D@Um$Ka%MOC4?_=V*U= za<%?e!4pFGOe<*W`_^7eKwi>;r~WBv!(s0M}p9z$DPFei|>+N@c3+raSNV50%hd2rRCn`e$X7lzQl&#xzeMrzZ)OwxC_ zfJZxBqo!+NI}W+TEgoU+LHg&?5fcUl0rPz;@jhEF7Z}+QA0ktkX_YdNeolO*r+w(2CTJ)?mtravL2#U7- z%?m#k*3!+VCekOxq8(y^BG*uuE~RQLUQXX~8waMO8ZIRvOg}l1mp_iy+HShR3U~O& zi9Oqc4wss?rg2*IwQE}DAPEv%0cd;slTy`m^m2(f3enGvPo@k} zWL~r9^xvk&z0E$$q~VBte zFS~O>MvITs@X)g9)fpqdm@xwM%ZuA zxjeN2WO216kV>rTi_)qYf!~5;W-dD%pZ82XCWS*ck4<^a`x~huWF;P!; zs-5yAOA|g5S7&P5--KBPEGU2R86~cfsAJqNP2k)3<6L?e&*7i|QJtR#j;c7@J%b zR!I4<8P;{??L{S`--qR35e3qjd~{B_JuVWRdYChtWL0G(iy`j2S^}MYbNRsKh0ALv zzq=HfTF)9nR&a>&QVJ?v*K^I%$7{+k>&3# zr8C*EN=fhQ*{8dwbq&Esj|CIt4GnD4{Lc=G&(M3QNN!u9xS&Gx=QPmpqp3wMeuLq>p>fHIp}QYl3Y$O+ z?BCiZ&?p6Q?azxMQcs!-ms9_vrvj!%GiA6@b`Qd-Jb-?#0SVQo{7thO6Ckw}n z!YY@RT&~ts2J7%yD*j@^-7dD;PS>JdFU!40TFzC2T-BgY$|kF9O%aoAZo?7o`S}~s3|ioKL?bC?OTdzuIlx5Dcwz)fvl#WQ(lhGX&TqY(3r3gxd^}Y zk4G&FjQ&9&kz`pq-_yEYhK&lm5hp4}+&zIisE5y_D8~A2hJRP2BL+~#>|Q^@EVtGJ zv^tD8`;KNwPFx^FM@2mR9~5oQg66K70ZMmb{|pjOaX*$4Yem)FJt?+;-w&dgEA1YX z09A$!J!ZK*C=$V6d`+Q;4#&Ktb4{WGDQkd;k(5F5_wY($(*=DG4Xmz}2^cu3uf;Hg z^HJ2VB5@m`jL?0@=S=rm!%WbUpFl(<3l!mptz9nBb|MBk1Y{m%;}RnVM&a1()Q2>+$(S$C)6;JKBCC*XyRkQ!GY#ueUp$ZxTmil7@K9Jq;Z#W`Sk@$& zk$_&F1!`(NXN3d5nzrest2-)`?pX%Q>E<>Ta0t1v0JFI|-|w`sxTafGxUt z`Ny-~%9q3P9U3nFMCGS%4MPPw%lzNa;P(@Lm9NY|XWC3kwqIV@VY%)J@{x0%Bbd$j zLr#(?s5dNO6t;}n=D~1&a0?OH)D%mqU~@?`DlvU1^~tuo)tUn{&NH_h081_(YN6ve zlos}dXV=(`1IYZI(%sKeO+3R`9Y4KO#f7Ivyg$Zz&yOY*gI73*)x!a#oGV+r4#gf;l=h&-5i>T7-^1%A#7C{sFW_R=6926$|mQN*}7Aj_5~f#gFO|#`Wrw zVEq|hfsX8}d;{F3qv52=$C)Q}l@!&tm5S=XDQKl}=Q~?7+R#Ilu>#a#189w zJ5s$Z*IW!3=im&_$xCtm+W0gGv|nWBb{bm2O-xsuvJ-(Oh6OvPB@@$29tfF`OzECv zQq}VhG8*5HV-K76H(89~RM*jd-3IufXS@8e9|m5E*A!o^UmwJH-U^S!b(`q~5VWvl zQjNOSXXN1gpHo6tnl}GGZRk5!&p;n+8IV!v zTxTefP$rvpAQLTuv1&EcKjAdJlEx#^n*7JNSXeSydZHnxRPTALK{z+oZHC893|<CqHJq2Y#ZnGku-~In7G(dpJ1wNF`TUvFy+y|cFu{gdLmZb-mI*uWHeGj_*gy+fJ(m*P*u6V^)Tdy-lw|^(tf37FZb%6>H{J()^uYoCY`Tmrx_j zVMi?W>MNqi$RoL2;t>xCC|tVCOF5QkKBl1i?I-;=K1-rqJW#fNQbwT^mV4wZ#-~2Dg*Uo;^837aG)OMDb^#16_Xid07E%D$fwTAFYlW@#;qc6v z(LcoX-}VxAN3`_{5MELGwD|^1IM$AUqR1wT%rR{sjD)`sCuR6)c75!m8cDH$4E7Tj zR>Co>P8Uj1JwfaRw3E~yL&Dr7@-g~_<%KBtmAp$Thwp)CqF%QgGuEVVh|)Ld$l7gm z(tzI5T;#R@ygKPB<&mpcK-Pc$>ga!S$X?V)w5Bx;ozzOj(*}}XnGNw~%?Y*zHNY^7e5#lkxOUaCll9Do zG@SkdAMP^llqra3MI`EIfAit)Nw#k-ZKnS9CaNq#XjmgI!}%EpE4Y`tyhq--B(`kg zO|DV{KZ`Q*$gR0Y6k|pJ6IoOy25|vtv}lYoc_@KAuKfik1d$NW%*G)1pswbrb8es1 z9C8qE1f34bAc?)?oQMb~P7N*uTV{_$b-j8aUnP)^4V&;34a&%T#rSxq0rKJbP&MuC zRNqxkPp z$HBc-E=7egxZW}c0-@1`i`KwYHj1qE4%E@QLPC|{5x_Vq1s zSq-6s4QT%HM=yCG3qDxL7R44haB(h>qy6FrvmG+|i$f6@*1r4buh<4JHh^bsi^n2@ zYsK1)XBnbZR_~Q9O4c8&y>s^w^flLx9S(l%(qlvd8}8W@2^aiFTdh{ROJsb>q!m}- z3t<@}c=qI+XxR7_<#w<|E>eew4(}4wV_BDFHgzGxN4NFtdJktdoS(b1@8iz_cXu{3 zZ|=y1+$8v68!Fu|RT4mkQ67a;L=crdGA@_cbKc3}hX_;zGH)__!wn437x5N3bS>Izn*6}R}S z@3;PW*ef-^NbV7Lyi^RLpYX@`2x>hTbILwQWhbe!fN0$pM)_Mk>v7)mU=xPJt*dOG zy@+ZwGE2ta4AALZ7P&aQ)J56hmqfWV=}_swKkHfkl=m|epuzw}~vxae6K$x`2z z{FCiH!v7o-JgW2#)yfO4vLJz9R`)+C_S&(2aoB-rb#ouLlMGHzH%K?e9YM&rzY=TK z()K=gR8W7792c*cjuK2XqGD&5Q1pswU8bD!A~LXIbh#`I`S~dwTG?tU=WR&rIT#!B z3qzLv57QDO!>>f1fxynt5{jGq|M-g8+5Tq}z?P=g@41cQ`%;S_4=m-MP9_qW7z!J- z!O@W~u`-DJ$2p`=!l}AE0(~nQF*jl0#XACaU6+VI@iJO~yB`z#*xf--OkE>QJ z=Nq&y72exY$%>^JAs7JJvK<8od}EoSjyFf!5iKVy>hSU5wDlX5EaVP^XxB4Poo&|T zC?0O{@B^K#g_|)IiL)h)hX(w`T5VcQ={0R>x9No6{a#3p=foiK8x$9#9#pO8vmDJ; zKOp@Ccx@iquS_&KmDt~%1D_yu&!KHs!7^V2;&xCsYyOXtcD4GSiMI*71^elMPZdY} zy5yLni4222-C>><&)?Jh4!fp99n5?C29EEWw;M|vuH)-^>U8VL-rIr4dk2?3IPrap z4{W8vDcWqph1-vz%GL;7{^H+&K_R|j1fVE`LEh=js^ ztQ3wr#>Xjpd-M*lp_|cnv@xKk6L+JIMMs>}4mlkEfWdele0+@TAHJcgcB8w) z!oZTWue~Q9jAN!R4gw92YoO-`2fng(ebiAoNACh=N(>-U$2Hr_1O^%w7#YXSdYCdl zwREq`dflv0ug-2b9SFW8op#%6l;3SG=}ghikQlKPTYOd~s^F`m?bD0fIR0H%YO z&1h+DG5UfNOu!`H4|iMclq_m8VIvLr#>*Xvevd)l1WWIABp8<}i6H2&$Vq zs@tL)QeUSLX4$c#n^HGqIUTas*syg1XS5yx93O_o98ZU=t3c9_@KNze zqa?p~QZ1E73Al>l-mNF0b>ZABd$E9=kYDW~h~5{z<$%m2Z`HcRAcbzAJTB9sb!wz1 z=`*;%SeXUiVsdH_Ro6llO}<(t5psuO2S!a zE4NgYdZHsHx&AnMB|)@Pw8^-CI7C$06nxOvSLt3ja_tRnJh%--VUf(l#0;04(>Q-ZB!YCO8Av71V1nIv85==(%T!q$^{n^1FC!@ouP>}*`JBK6 z%c>|iQP``i26&c}y9WAL5QG49z77PhhA7s=(>W88jow`5=YZ`?vVf*&;~?C1?25R+ zJ`py584x~*Kh}!45BBRzs#v_x5MVc_@x=|wzI01v?pgu+XxRB3pSA!rJz8sJoT(nFamdmzS<+-{;fif?BbJP!#{k)ZW=fpn$ulhw~G*?(9 zw(Cgq0E%pxO`Q79dozGE>zfv5}qvkHDE$F#- z{gJ^bWr4vST48KQDrhu$*UPq>gkksQ&(BVxd)Rj3rE!B|PeE^)t)`XpG;bc!u zs^kZ^N&@10Y^ z2LRVPx|us;q_E0OM7Ln|w@7FSxqE;mOS~z;01|8b9O;!g;grK8t;q!!oU@usO93{L zaHZ-aWu6B&!b)k`hQCK7S?3Aag~++7XAkf0Uyk?qkmiuaxWzD?)BuppycaGFsg zCXh=K>?`vAdQPhYJ)+x)csv&~1V?S;R*HLz8_P_R4C(w$y=tIY+9Y~Vl<|E=;w0iUIrYW836U6%iP@3Q^x^u8Q5Ew^ko1m7LKzBTj# z&QJ)1)+P^o#SU_wnjEsMW5TJkzAD$W)CsiJ)$f;_IS5t#%Rvu8teE3_3zm2N;br~d z+NhPvp(yA)?1-dbUGplo(24YehuLt!V~}pMs^wub=E!RL${k&8d%cB65l;#%ElhSD z1p`Pa8-M6G%z};Ac%xEAsw%Ow#Z0>hJwOpyJxYUNAscnpi@R*CTXd4tHk8ucb2HQ~ zxTUxdW^t*WPc~Ml(S&ka(Zq?1v zp3oF2%pTBtEy5DJ?g!xH?-4}aVHF} z5}MRjDqFZqbXDP5W@-4v+whCRN;i37LZ?<7!P^kv>ezb#PJ?}pG90=qC=BM}G>8E= zJ?>k z*DaR7Oa=;;S!|gg$tQVw6R0PDnvmiyC!f+Ru(KagxdX*Jd^r+A5J^on=Q?kQ7&@mq zaAP2}W-S*K$FYox{%QPxD3&LB3soAi_wAaN z=ifXx+6hx*9fhRMTgq5L3`-AC2{)&J1GbFiZ?D%sdQ-3p3%9)M7GPT{SVcX`a^F+M zH}N``ef|5ynGm7g6mEad5tn(!ga^+guTAqO)e#JA)K#ESiRwgHdM z;M;giIf`tp54cv}?>%rQl(WEeEbF6wH!cT!;z070Y)3hQMXPB!tSq4$`L}{rjJ(GF zj%;La2ss2{|Dyxdso+`O6Lg4P4huubL%Io6S~gBZE?(GekQ+Y^0egMBdV{Lm2@ebS z?2zc)nnMV?anwB^WS0%AA5Qop!IQ$$|9CYSM?ObhfUL2y$odcxrMyyo{L=n%DIa0_G~uVn&-~nt%Cd^(xj1eW0KBy z>j<0Q7U9XVNpdD2u!e||9m6jm17x!M3<70&3<1?G!O|t6bs5wa(gL?_csg*Vsfeu2 z)6-2r>A0StNv)_z3DW(xs0Xb%aBVl!Wp)La)lloc7B=CAQZRGtQ9jW$Dk62UPQ4T# z_;@L0OTNdyh6tx^ZXBr<0ai0!IZ|_(u9K4}I?1bHpue8|S2* zD&=(g;{?Av#Z&+6qx1uOnWx@ShLL&Gehe0Fo!WvMvGj2gFm<jp zbF1_4#1kP#g2cYtZeyHPROThMuU35BrA)sgEqbtSCf1)dH)M(0c+J`LjlZe%@SVHs zOl)B^Dzicdh(~nBF(M^MWe>mpkEqm7+QB~9t`3GDNe<(;F#b^pCZ2*QB4F?cH~6e= zS$okT*U?#$7f?D=Vims&V`~M-~j!4-96+&7Xe& zhz$WBk1vI7c5jhr=>^JpI_^25qSApON`AH`?P?DA7^|c0LNT^jF-FYjOp!f`G!#HJ zSC)|}cg@?v57LuY%ClX!H#IP8B3XVEw}9k!!2W%HaCCI0Z4|uOQ?S~2*p!vFvQ(w5 zTSUpD-J%XVu?9QZf@ezr*ODF6wNnkc3EaC{CibuL<@JQ6NZUky8y-G*^k9+^UfNodrk~Y|2x=++zO)bb2Nfc)`TVz@mWK9<&TFwftoST@gRH&u!6s}!=d;o!xDaEc9 zbB`C11pvGO2EhZPRXbFg-j9dWUg&kV$Q)HdO~@LSzFbko6eyCcQ_K|7CF}p~RQcXt zduMpE`(}FHeCb{Hc)3s`n~5V08R+(Ui?Y)z9El84``2*!^o|FNCWr~yg7L+6ZaLKc zQ zPp6CRZ$p`O?(zM-`1u9KSbrNF6TvMo)eq!iJ;K>~F7zs#m)@*~H{+vkLrm%kG=R;7 zi@RTRt@AMee<2KpKp16AZPjm251SxzK*UNFgHA&Ie~kT8kR}ZmwF!6Gwr$%s?y_y$ z?6Pg!wr$&0U1pbUOwS*G%uK}h9K3muCwabh?49dc3#bA?6<}nfM$%FP{1duom*KH% z7qRAk#iD2@m^5C=Yr*!pAB9RD_@z$Qz_Fr%v_jRgAalz8oR4U}6I9rG{StOq&facK z)N|LcK+35C68xtee6_0ctzXSnqVO`=U7*_=1KIOuTnnc~Y+hw7HN|r2D&g3T4VwpI z9A%n2-=QFy9n(KRs6~ijWXWNN^en z6c$5hzNJbxEWZ_-K_q_T7q}DOvkfL0S@R!ka4Ab(yX4%dwaYg)S1uu7g1v@bg9}_z z+g;y)nwRZsnd_WwJ4J^KAmqhc5>QnD6PPX^JfMxF^Nz@k0{}PMM#~HXDeEPQ6{Le? z7g7#2unwRAtht;e{vFSg6$l#|X^>%rfUKnPvAj8*^3g11(HC~VC!3GCkUUFjn_T8@ zlpW`*g?uqQb<))=O{%?^OteFAISqt~ah}P6W%9`9!AD^>3u7)*B0?_?Eq=tO0q|ZR z-~&EDephwobj&K8mP=qi_bc(R?Ebm`JVBq`pu2SEmbxEA8{;&6gAvlr4tQ4~jghwy zl*fCiU&=<%c0L{fiVATg1)pib+E7_PQka%QJK584P-~8`KcLT{)p_ zPCCm5c2?r)`hP<{edKP`t#YJCv^%;J;YJZDIDjtkzqv zeyebW3Q$?maBVEiaj6EUC2)@{8?ma{{p3iC@yK!5V=sWtU?t;-xN6uaq-Byqag|Fg zOs55#)bLt4JZ60C({Rg%cVH%_k2OMMFHqq4%dnF^ zUZ+=Z)dD?Fu)*kwMq$fxgPHIQOZ7wS*hG^^Hr{YRA8IoTd-YXt@d3*bS3$9K7=5|Io$F^;;*UaL;3JXzX zCm!t*J$RM2;2a ziM&*t_o*biaxe(-ciQ-rp!ieE8Yjyp4?ioji4j%Oc*W)YNgxMTgVH2@sC&(~-7Mr` zDl=t?!CHI-y)oO0i07k1q#=p#pK`(4^nPJaQ?!IQnDuJCoalqNoXLYx1=5DIsnN+u zoceU8yI1J>)GF1fLAae(tmgKal__0L`He{ZMa5Q%oES;8f?ev|H50eIHdAoiw&^Tx zJ2Rt_w*$}Irp59c?_8hx{OsHu`2m+AxJ?|gf@I+Kh0ES~M6fLhLNJS)lkO`%e_CZA zX85G{kz%`kp*%*0yW4Hpq!2(aG0zQ4yz)Q2k)ZS<+`ibU?17RJ)Gtgp(#auhJquZQ ze<`)yK5Yt4v*2L|+A*M=uUzyQN>kCL|J_0K_*#ZkHn@sQf-IkI4M9C$KljrvnfvY7 z@S?X?Pn1Or=Fn@01BrP#TskR>UoK92D8<{&{Bmdl+YhdR)hvt{*;P z8$=pzf(s70-!1pNH;s>^eiBSVCXb zsnA&xFHt}C&&}60 zu6_D)9}BKb`HcHC|7rWdlf1}8eW6BQ&L6oV$2e}?NH}+Jx}bEj9)-Fu6nV@GkjoVu z!|ps3RrqX7XgS<@`#(9DP| zT6~Hi_!!dYVg9vN^V^rwPh}7$inaY`C@Jw1pyEnx1sk-V_oP%;!}8ptBiKVx@jLKC zeorsf8^+L68_#do^ge55km%Y4lUc;~XWz;SV_sXd$F~fi5PUpCp&)3@E8e}1lc}O& zs%AE%WaI0J+WmV__Mr8Wy`{Zv_4e_;ox;m|VZ*B_G4y$?Iclzu%`#qu9D-hECHlQ$ zo?4DRE$IU)=v67qb!bYS_+TJf6C;U1zaj}3g&*iHaotm)FyxR$oH*Tlc_K$XNnau? zCNtj7FOVr*>x^YA?vDAUPct4sHkarcx`C})tliHsS9G^M;Vh^^bd zA-gpBq>~x^g^Eul8(A(ouz24ceWama}CCK=^XR`yca4G(fPQwVU#Rm>G{Qi17 zl-M?;BPhNqY!!7BK@L0l&?}#9<`Yz9-SsOHNTR&T@~$otz1=0e{#Mcv%pJR~4)(V8 zX*m??VR=H&2D5)r%`ns0khG$1IxrrJ;nUU@?6rewpPF?2eFkJ9)@BP%nMG&Qz>WvZ z4gJ)0BHXhvM6Z3rsv1DmTH_f&%PKyie=(XdsPjm|uHEWY>OCNLT`7`lMVIm$yuBeK z6=pjG*hk@fr5%Kaa;axoyIK|Z>O^D33-DINIs++36W|ND(Vq(v)c?uUSo(Fcvb$>& zWB;Ej_g_Xl4yON^EZ+WS#QWz-`ImitOXP2wuOxZCtsUtSg({_hY8OyQhpv-h4KqKK za%Ojb!!tzmbZZsWvL%9}JB*bma{pl#iqN`Qw|?H0W#7tCXJ6!y0^v!Vxbkc`f(0{3 zsaXOAbD&V&+O<-*gHU-frB_v|khR;k+t&+MB$XC^M>x};YnkO}<1};$dHwUQCL4A) zL^~|kE2$`<>#kJwd-cPnm=)??wmo6T<}+MOukM>OBLl0#H{b8*X41DpiV~-Wo%i{< z9)9t2)aV(;=k~N5s;9N-#6_L`!?OzR^v{EU&+TrnE8aZiSCsU#*(xJL-UDHrapvwj zUA1}7o!E5#T`g@fd#d6pgcz7s6V+sl!A>3yl6PbEk#C94S`+=1ZymQ)*;MP_AeQkH zLG5XuTu@CT^U^7;?W@Um;%YHm?-3!l#`#JS$6@HI6PoBhF2)F>iU0%@vYu+Kwc|Sl zbcn6a7LewryW*7$D9=UPvQM)3mz?tjkNP{2+3qXI1D=aq5hnWn&)8V`2%MUKww`}(C5%<;L61ukL zW93c3`sU*wbX)c#{KxGQ#V{1;xi{!HUc(UjKH(5;MyYfha6UAhok6Yh;aLN3qY{DU zGAkqqQ3jJgG$yLq)O)5cXr;`X@%4kS0U<=-BBSId02~%6TB1A+fyc%!=xQBTC;Jq6 z@0TFW#RcrL2Y^NILx?bViww)LcNGqXGulWR7zH9Oc>`3%b2v|7HD&4`X~t6QOlfnG zte}t#G^z?<9;jyo{Skc2GOcV~&YL0LHUZtysE0~!On1I`8t!!xbjJnQ-e?~{ahoVB z5jK^?qr4sDz1N#GHvB z2TzIEeb65ov!Gg@4Jv6KY=Zokg|E$ixzH)Il~~AA=&Ykt%zFKF*9entO-4V3=10_k z3RSopQ8pWA)TO~$PPM{#k8zp7U?#l0LI*kNDk&fF?J7^c z=mc^MKWPAic(l>3(IQeEGD5I)BAr6WJASN)E8PG4PLM3CRWYPNy0Xx=nbvkHE{pMb z=drz?wg8O$Otz8+#)==lH+jo)%+#1($k1Vwm*Ck9JA5);SsECTOjDJPd$?%gavqEi zg(lP+2^#N?X~&1yVX+41cbku*SHZ3>%6z;BeP>%%QV(a8MNzsa>-aM@QY>L$;x*P_ zkx+%M%umwBW4>SlObCgNdX==QNvI%eni*&e8F({TwH|f}fuGk8e?0>+OZt7d0kUU* zVsi9%_XOC6#&3cQqEVJ~Mf_n$?tiUQb=2NGBo`h2D{Fodn6$FDgaA6#y4Z)bY?wt+ zcDRr~NxBpQN#7025K8dsU%6JR>85L#>lr)}1=vf$UC{;%(Uj5dON^mG>GW*H;XAP= z&n#zZEi?Bh{qtU-QyWziNzNDPh5ARgit)FPRFOh8M>5Q{b70dNybu=bz?lgCgDC*+ z>Dhu5_=5?ZRdm5Dvy}y48K!9|A|R#sHcG6!pPt4h1#` zFzzAMb4^Wo)h8j1+kLhOr`kCrup#GXF){8bqZ~byw08r z+ipuxM%%Ws`hJOqY;gRabC8SU|62i};^|;Y$RKZIrR-u0%^>%$3zQL>LEO^G*@cjc zh3WsbfH41y<@oeAPWC+Qh-Y}<&_1;6ZLvM)N(X_-^N&LuV z<4dcG;>k?WBx@PH+rLF)E6P_E+EStx+JNOkKtvVrVFcY~cJbLPAfIe={v@ES82Ku- zS)z;L(89YB{hh1jd;+ILF0_ucEY?1zH-|%}MFY0Kz={dDN`=Z3p$sOJyM!7{B!|cX z777$13H(L15W-8=pju9E2Q^ClHcAmp0$mGSwSQ|STxDd|GhY|DOVwM;U|PZkWg_9 zMN`9{Zlw$g?&?kB!EgGxjK~Q~k?35gNb!Os8xMq#)S7q7FXB6gfIBTLKnzO?;I3(w z6olio+Clpe6N#jh@Xk@mWyJ|(HIC$jC|eqWRfwK6>{a~Tis=L6T}X9>Vl_lDkVS-N zRQBi^p>%;Kgc;DMEQVpE?21L|Bw|E^i?oWHw?{_oewce)VbdPDul(NM(#A8U4R$1% zhbrRq`F&npUk*mx46IYN6Qmf^{wSg<8`yw#ycV08&Mi~0MLDPPS7dBECl6rtYazu< za3&>RHWiTg^vGM)#xyP!pH!yu%vgoa!9fh-rqhz7+!!*{@#~dEMK$*&uiKrOt&%}U z6+D+B;UH}Y#HV13=!N>-cqhe(oG{c1pjh($Xw{PHvyLw==yS*76`=yFb3_ zxBL*A!s6EQ99bP?cdzsb`1O6?9=~rrak+~w!iMbqx<9VZt-Z9BP@ByL-{#3yAJsLy zU!bTHr(!~Rj&OWQ;#{!M)`*F=jE`>adN3lqkJ|ROQhi+M^m$Tlj*RU4+t$eR^(WfW zxOx#9+OmrC5o52s$ND*8oiH}&ouAVjulMUU(N;~dpOzNOKZvVOrHaawT(lG(8xsrH zSgv4kXe+i7>#C2d<}9TYl}slZ>WNn^$PJ9<-*U zWm2Dt0p+7G&qOm?WeD{jds|bS_=wQ0&K8!5FfW?TRf|^Rug=eRRL!D@NdyKvYEJ*iQ#N+( zZK-$WkK^;#nkgMMK-xM2%0uF^8Dy)5Mm}xo#M#*E$jr6pI&$KP-3NAmv&>&!$)3HY z@<-GTW^~zh`z zI=JD=Zaa1Nv-9BL&(%@2K({j#uJe!)^3w>VbiC7%VhaG zvC!s4`rga^t|k}Wo1$Fk2TQl(UwbNKJrUxAJhM)D;Ai4|W<@8HLU-XDmDo(8&SfnR zi0lKx>BzeHKgE)Xk>fwGYo>pBME|QAZmY{U|KCf)g}TF^+4OTsR>4RFlgyx`^&A&o z0QOV|X$Cy45OSH%IH~EzPj8ow0y*Vm-Sct~+@;Z-A%V^wN>eI&({G&aEO@!uo(M8r zr1k(dU5#v}u`EzEOvbSn9c%8k-hcIBpG;q0M?MEFw0sN>8kj(GwhvqrG%pwN&URCU zpIUmbA=dI?x%OifgI6G>2)3h1&TTOq&mJluvD=6#pdSx^F(@Y5ZUnFq@ydq!krK8% zoVY=Q$7k6qs1LB98Yz$X&OW8rn|rEFa7HzeZOnIAWFzSA?ovZpUp z3Q1Y8(LBWmb=3T|5(EhVAlZMGx~okTud0a(y*erHRd`5r#G9zg7EEO^?Vy}s;GLvP zPIfcqI6n`4#ot^fpib79V#HE0EPKL^^erGWh&oGMAn`MQ72GCo4s%+D%De^~mW4*P zaStcJBi7wL3y(ia6Vn(E*gkriog=(I#cz&gDQzz+iu{%URFW*nA^@T3rq3a4Z;SG8 z(wuIknl-Dxki!vMv{u^eXhvdFV65o#X-l-!AvpshWx$)K--1YCzu2x@L%aYEzrLoF zXk<=7Xb&C_kIOo8orv6^?9Fk0nm><5rQAs(ih@k7OR633Cqy#iqCdKnz378JaG zIoxJy`bZd2^s|x=W|jom3#7A!v4v0F_A?yMLsa>SEjoI^U1~fOUHxTGfUut!Xs;`IQw{H9>#W>d@^&rzxrW1h^n zM!iewoatT&5`zRizFw5!c0elQY(ukb4z&ZlF5dGPD?#4UMSZNq_m9ZYn{_M8_j5IJ zh%zTXRYQM=GxdhCyAe(qa#tfev2}N0J^#pX{%JN}rs~?coMORMXuEDgN}=8*3&!dX*3+=x^Q(c(bK` z`2&mkaR@(;K1WT7n=nI6uVST}m175d&nUxekLvs(0StjShJ%TKL@C7gCR8`ZswIu6 zY_RszS7Poz4ybcR0&wO*imXebUE&Q4&1O#y$)Eu*i}3r-H4rY*gY$V5P||isS7Wk~ zsxoeO&*$BA{4EDGqZNNz(fT?%yDyi0r|!L$kO4f$?8!A8wmDL54Gz_D+5=WA$ltLM zH{8cGo9Li7F1eF0z9RURI)|;X2tvq(aa!$RRD%3ZMIC6~s&GU7+V(Ki{hcCVcySW& z%U*-ad8KM|a210jer-m^>`$kbM@EMjO6oQoxMEU!6DfGkkkkd~sFS~kfPjU<3=gg* z8z@b_|15&l2`LfG`7!o8j47tSCOPbAV132ah|*eX3L`sgjwz8}_L>oG=C4Q!dH7{N z^S!i*2{Bj(Jatvzku(~gFOZ`tF%HOa{M7|iW=6DZW2jvuuP%|**i(tM3-cf*9J(JN zNHCcUTX!x-2(@;%W~Wik@8(oRe!F&V8(Meqk)iD(ltsM!!CF7aa&7@7r|T^gwd_u) zfEgVci+cAKU#9I+E6cl`Y1LS)#G_IZ+rr4ErIILg+3y)Z+~Q-doae|!tG+h$E`7+E zGEDYpyM`5q&}yWcLf6Fb$3S=bQ|W8to?SMLI;#S3KmHrm84PCIRiD2gt=kJ>m@bYWX;WrgH5Tpl~guRiCV1-$L+esJ+eM@fF34` z*O|fIklEGlMEi(kWyR$0^9_zsaxKA)LukSTAh)KX%42@n&hxsKiZ;wsF5zfUbo`z3 z>ue(6z~-EQ0(vlKhj;t0P@VxnAmL>AxJ3|T`?dIx@SCp!wU#hw0jP!k-Iwb%SU7ib@E@A*zoG5(dN zIej@R$5DI4a+q&P?D^grwVU5fyZi3n8K^%5@q$7&wQ-#39`%1TiY(t@vxP$eW&!TK zRas^JX2{prLAbS_Qk)MK6{97+<_8YvzVx=OS#ufck!GoN3MQJ#Zt_bYmN{&sFy%U~ z;tzu*zQ1u-Yk)D&fGtMtX*{2~e3%0LYk4MwihQPu`T_5M2b>E)fcu0rR0dU=Vz$9C& zT~MztVFU^x&Xn)Y!>t!wrp{x6G`YL9s~MQM+#UUk`PUs4<^5wVrev(Hv=n2US~@ez zqy;Ubm$3K#bKC^1#+*uQr#t|q`p!YoYro5W&im7#Abe?{PB@#J)eGIyOuE3UI=*;p!h zQS30@+-41h5)&r_VL!)Guzp$^X+EyWXE{0J} z`U7h*P$C%|if$)YSW9Qx(Hd;p(-u74tM1#Pt0iZ4o_8X7eIdb?xG&SUj;&_+lSKrR z22w>VSz}d98JdiDEmd`G!3d?p7=)G_loC34x~B({^_}iL0!=9RUfCGylFhbQ$B{}5V?@SQ$ZBa=jBzcn;GC;|^{Y%Z2xQm46^WqoF%5?qVhGWD= z3rz#^br#r%*+8#m{i%#Nt}4Uz`n~Ysp|k~2RjF%;TnnMQlzi&qQItEJvO7tAacv1Dlr03n6SF)(aY|ia@KGNcfu0!A5JD;1?hn`*WK6>%8I?4wl z)VYa2+SPoQAK{H17_+{p3I}vbH&(a}6Hf;(OX|^XgqE23gs}m!fu3nmC&$5WhY!wB zy!SI`f_+hJO%^Q3lOi!b16ia~)({OM{f3Od|852FtmnsR#p_4ixzmz+aU)uFnjIVL z=85?8>4wn<{r!H#q`2=*^}&Uh#&93sS79=MIQ5kBM>kuJ2)#*L$03>*FaCjn*Qro- z&4H=W+tlQWjibWum91=wztuqHO%u^ZexDNvpNj_aa9=vV!w@uZ22{&bAjrn^#`s)e zE1dLOg1wLsvskLMaD%K!02d=B=&#?eF_KC>RcN+7@=4?iUB#=`YS()uxRIu=gKWw? z-meA-L-lXuNU+5Cz}m-}1rcAoOBY<(lC(3+VD-*Q;VzrUDtM7u?}!Vz;qTbQeI`62ezcz~AA?sFJX+4zaVHDZj`3}-y4VOa@XSSUb#u3i7)pn#y z-AX@4G*pT(pQmTI81M+w3Pfz&)7Sq2t+JOck9FyiLM<^G(&MQhXfgr2jz6CNs0|zb z4@D79ph3i_axlvF$PZs`lh}i?a)U@rYa-eBD-V_pA%aO771}9Ma6^2o0oh=+&j3@=Hq@4hl|Wg}hbYullQToQ zt({9-C$Z|}TcmCeV=_IH!&DtjlTiL-$X#akhNBe;^5G#0d-kB$*(O+%342f^-a)7s@Ieb59<8?WXZq z&!k^|dP(9azHCQf-~M_Nx-2CbpM}m8YX~+|B<=CgH@;u2DtHt%LfyY9VKoD)ty#@K z%{i>EYYo(XgSd=FiWzr5^*DVb9Swg1=-N};dAGK%S2p=-pQYF5K$=9;kw*8Bs7w+E=krCpa@BBE z>{3r~W#_IH+_ zk#j5CFiwF0jPyFX;8|P&5nPuy@IW_RH9%Sy7 zc%tu|;Iy!koE7(h*OFOrQ=~U{4>I{MNwu_8AZ#UwL^R;Ryj(*5@~nRtUINqb7MMk$ zN?o;8(Z+X30dPJn*}EWZ=>^@8M9*`-RMa4i>b7dCraHR(Ok{oiNS~tIfUUvOY~u3Q zYn{m0w~oc(kt8^1)z0A9ZL%1`ST_Pvq=CSV?`eA3Lb|{)=1;+%mBn>wo{?2mXUHbj zcm~0AMGRgd!uy@{p+>LqlNnuWib~+0HtBhRCapT9I;Rk|ceOxfO_ZmE$yX;3vM#B{ z#%sm7kzmk62(BmOPXtXR;oy41dYFBxN-%!sEv?e^>ft z96D5cLHU|#`qvl*xYV=3)H`Y@P;ASvrK0<~%S7SFUR<_LtJIUx0a3R5`!LK*JPg-k^3top9O(akm(BnL&@s}F?Lir=KlA7;*Q2!K0}De! zy7~Lw9xC&w3Le=ktWb?#vDS`pxYWrEz1`CNdN0QKf8DfY1}Ny*y>9i#k)G1Pa9@qo zFjA?p&lRshA~OBhtoMe+L0!a!ddbrz)c0`CJsdr^Q$UFZf^sL+9KpI6&60C#T5;Uw z7&VO=yxx$V(L{LGLQAw!yU>i2KAA1etHe8>#10L+%Z?;4l-Dk((Gfs-^y?jqj<3fj zvJrelCkROytivInR&Xok)jKVumrVSA67Se6)i*M(vIha0jU|s5QrDnMJuYR>su8@+ zb)MdL^c2jW!F7$hY*)D{pi2R#sICc3F&!w+iWGL=>X$^|Q!J4?mt+Q)C0Hf^Z-&-O>;sqY+AZ4QU_v_w5%O^2N?? z`6+i%_GShv9`O8}O$VmabG*Z9+&jWtNFvaGMP~1BN!-)$Wx9g{xxa7MBis7JT^DgIuec z8)m0g>KI`1@z(~Yld}%xp$aD{pe=6F`H<%44I|~H+8h8}I(Vsw25OK(xpe2D{ogBqYlRX^&G5;8%{a$+Z3Et1S`npyVp3rDY_)Q@1L@<#dz8Xe;5{B4M`W&=vDz*Okijl76R%=mUIEG{YeMvm4FEZ@? z5QzlfEhrj$#;pf{T2&rU#$1%&S{mg$q7ScC&^;DV>mOMD1M6?9ye}IopkM<;I-pyd za(jqPBQg5>Wj7dqN!VLVqjhkT6DG&8qDq-q@4CCpxtC19*W!{%$ zM+H82k`Yl5YkIW{v*Nx}ZPY|kw=F3BoLui(bBwHPb>fj&oyyggEH;Tzh%rYNkwZ}P z`MU}_XcM=@EMZo*MAr%B0@gQREJ|KR?Z(LC?)?-+#GhMj)?e2_L8r-yq>%Fq2y%Pj z#JbLmH{h{+yM|qRQ_AP-Hc4!R!cgmh*E5!|-8^iI)Swbi2P|dtb~Rp*;rlg zCdJ#F%}Z>eIp_JRZFba()u?zDf6(MXiXnqaiC;#6uLh44APaIj1AG~jmel84WXjQ~ zS?>rVLsSY8pt+1ijkE{Fv$en#DT7JozB_cI!q1`fA`eQKP&&eyqoWm8z1Ff1=Mn07 zIAXBWXyf}O`(?EpS1sHFy8eY^l9&YW;kh!%T&bv`3FO^((3>_0CO-|fE%6&~`!=iG znbW@Jb*FBOdR(R-hoJL;8#T+#6VxOrmDlrWP>hYa1~T=?WiHYjk_QN3a(Y98Kp^42 z&lB?o(~15-c!1b!dRr)>K*qeR1*Ib1M>nbDEUxPbEmFI5-r>Q8Tb<%=C9bs0@&++Y z^9l;CYEFUep$#v8*NnT3n^{gy%^J{jCu@e@UI?ODt2Q{%DWw8z+vsancIDujM$D%b zt0`d>cc}t5AJCXjX5gXLu~_Tdig%{rL?{$1-Mq!u)s{oydZK4O~2_(*;xETyu!g~r6 zYG#?t*72&R$XqSJYDfUDFcE-N>7V5l)Isf5y1Un3s_rVr<+7PWEp!-?m)s$`W%U=R zZW}uFsa44orQJ&DXP3aj9o5qj=p#yMTo-e^SyO-}_sfs%n6J#N0C~py2!n{jm{{+F zLq~U!10J)69UDzOGw;8T8dVPxu;3#4>gtsz5mIManPsb`dQG7@N63QExMSbfxLek< zR+{D0+^O6{`#R`_h?0JBa3wy07*CiR_ zV{*E{r<6v<0&!TTA>GGYPBs|OTSaCm7!>F76?|q-zXnCB_qfDD!ddwRC0ei+x%sJ>_yryrDJ-rv(v@n zW7O436&#}J%E&9!(F$;GfIO-iX%a#=_k|fxz;1q-7`rJKGSvj%lnSG{*FirBZ_?dm z)U#|x%c3*=twx6Cyg&XE+IA5OGp74K?iP1gK!xvf@E&&q18BNn?bDe$Y(3lAV27R9H7BT`|z z;J1}vJ=vxwL|ft6ZR(C>(=psw#W)nf!f?0Igm+7!9CwyOaCisY_?^$0YnEivx?Hk; zotS?30Wi3~5FljgDkJI<$Ss2wbiSVb(JR#>$+C>p#2Lfb^sAKg9Wz4Bs-c9d6*75D zcB%&BR0C(8WMm?2Gm&X>hC>G#Z=mqD>d{SD3-1)Zj z(cmJFDZUgAXkUhNaS;DLK$vcU#LW!(bDl&PKGwpN-q%xYqWc53$9v)d8^Pt+cjV#c zr(^xNZ}=EK(+?3c`!Ru>5DFAgIKLcTD(kCWCHye~c2M*&wHNgU3)<6TKHJ(IQsd12 zRO^qU5fihxU3at7%a`@JTCXr+=2V{GAeb2)2dk>1$}<~8n?Y}~3SXr3<*VSP}WB1=(?BD93Z}?b(j5zg9*CmM0%!*7|2p(mL;2J~yDd=G7i(AKA=!hjP*SHv-^ za6CwHQMBc-`^Y#+Y>#UaWSG96pQC(Bme%1E7IDL)-s<`BeSM7#2*@x*^hhFYn2gH& z*s72QAK<@wayeL{d#;@5|0Ey z)`NU2TypRg{B`6}mV4@H<`K??)AI9iMger}M^hHWRP20S68~5Hrqc~%SJQ44*SNV4 z2YxGPJ0LW$Aq~tVTtFo+ecRbvSu2Y{re}iFhJCk%2Nq>Fq27h=q`F>LZOz7d#FL5* zMQOa`>H@6|*ga_2v)lmNYkPV+!>q2;A`=9oS10XFa&cNl3;ShEQmxwT!b~y%t2R@w zz!0i<@#92Ds6SNb0Kg3G#ijg%Mo^Dh*Vk@%z(^;(k%XAuGB@N7c^22Vkv%%AcpC)e zuOq~IlDXFU0R}R9+FAU&qrPUbdR49Y0#i|P3)@UVBl#)w@3TtK_c6q4kLSbt)07Oy zL(bT><-n>b7=+@$$B^&Pye5h`%R)FzuqAW$jJj^e_avS;kkBh;XoDj@m`j#XXsrRV zheVi-H)&`E4%uwcizH(!!5>1%Y$9*O^Pi9u_O%tQGZN;7cE#lOylXB`JDYfltV%1m zqNHH|RI7!Cty1sqY`n@+=)Z91a+KT87dU012gNiSnN>|729^0cx!`UcG+Q=YRZ%rr z|~8Dh;}YstODIPu(Fd=J&zB48=Ur|Cu*=j10B8eT^l6uv4`? zN1ymk7u{}q_gjc-R6D5LwARTLdR~dzQ8{@bmiI|*io{oFwpeFz33!xo^YFNYx+2h; z{UEo>lSiKG?Gm8BX+cqduDF|A|zd88*!1O2$+0LMQ=>6}>C98Djf{(lFo zkH0YSdQ|KsLHJr_)t7FOR-Hg7B^8211yegC_lM z)(hJXu-x}Rgs4tWhFf|*(CVOq>D?Qe0&66!zcljapxJ-A$Hq6*y&o#C^reAI3aLSj z1Sf0aTpBQEZNIt^Bm;gvrM@C$^8B`zw7c4V>kzofTg9SZx<*_ z(TK^VFj&~M*3QG;GC0#%tn1YG1LKA(@4lHDhS4!ATWZvB=rPoA~+}5iQhmkpLwW(uBlOvW#(yvN${49wAr}8%B zT-)4q&v5-Ug1+96yK{zEWp_;FT0*;V;uGNIvDwhFp|sBm3;ik<$YjDSo!Hiy%e9TucDExbT7@;#zZifeVyshR-1&MYVjCr?A!8{4aZEla!h zaGf8jM(S)m;6}4)*^4E*aG`5M9)n}pUh18+KH@Y0kL-aP<%y=@%XgxxEa3uHlgbr5 zR&OF2gF|m?eEo%dauQSAps*(LX8?ZtbKV##>?HI8p z^HnVCTVUKD!#krooSW%)=LmFN^Av_ z5|X1=CyifO^f9Dn!~%YnM|m0xX*FAr#U`V`8lN@RA==&NWI+VnKzLw%9#L#^{M6j5 zkvFt>PC?&QfSsua1}Z=y%8<{Lp}gcm{=GAmp{6T9v1Rvg{h@F{o34U@nobqI$t<31 z>uo=LEEuK|aNsa5veE9jUxyX_$C=DHYb{h8nt956(nM#^OC*8n2%WWSf$o0 znJj`&iKh^Mwsq$8x^$gC;Jk8g0I6D2qr5BGs&fNf7k3s^hAu*P(Vi?jlsL@^ zb0DK9aXBlVXH7?SP&#+^U9h5Gyzh116k-3UlbiO1WxTNe=Kh*x%R}xy(X;qa_T{Q= zW7Ri>uzXxDzZVAu7b)!BM6xkA3PTdo)*tu^@oz_C6{}QgO^~w$BqWxPD}u)-jH%Eh zRU9$8So!JV_1i>7opDvn$L|F}D3BjLHrCR5RsXS?sa=`W~ceYB&@tVbq zB%dQQ&tu{qbzuhkamsX*U4aNC8G|od*a#(4^2+Nv#3QBXM&R>CPHY1CI>kr9W0(!U z%gvEKw}C11A^f2txNW~>mQZl_F2)JN(iTin%b8USUQf8m>DhVO{`$HkkWpmPFIQ?p zGvr8Xds#c_gs(LZiUYxD#+|a&0}emjL@Hh(CFu4%)u56c90~0tYh;&ZZG%i!LLp9@ zs{RH`I`ZI6op(DsZT6-*^fCL~PlZS$sgT&x4SyX(lLx=s@T9g+dPd{cb+&#GKXb!;f2iP2mFG<{(ylv z6o%P%N;FE*iwAJ=(QTlndaKm@Zl}HEKN)Xi3~W?5)QWVe(K?SWzoAk}+2Ear&YdS1 z^(So}J_JBWA(JN?3lGSir!R>IA{G=n<2>DBsD2D_rl z2<}8knFC_F+)tw2SJl4|tSa5K{TuMxVxF3%sL<Poqq;5&U9LPCw5Y-|knrs<^xC^A^8<^j9mia6|`Xo{Q`(z*;HV z*#bIET(-xR@;P>)ai85WMq+C#aD3gOjQ}C#a)0)kPYy!!^ga_IJ@KWBvHa%u98JLc z<4gbQM}psTwYr;oE9u?@%udb5I{#{cgE zhO~*TnX@?o13Sb2e7%`gzl_@yM)=+7B|4D8JwJG4f+q>qY^&ri6S4P4An1@_9ar46 zTA9%q(3_o_sltzlN<<^%_2B-@c%L>hW5uu$>pxp=OogAdy-jj&x7$$l z;yruey~tsVFstW-H!GB279y)&muTKzK9s-$*)e;Pu(QWrGeipgA(F8$EdELCy@gg$ z>mJW7J4pKZqMT-H;6wb2v$gu_GntcD87+%Xm_%)l-YWV8h( z1x(c+JoZOsDbXxN^bj%5l4cb`5Xr;N{d8^8Md5afVFQN4rDRm$f=5HCB%qbyVYZuE zwe2)Pof=i%Sf>Dz*Z5{qF>@maFKE`6&La;+^r+$H=IYmoxsgtGAe~Rgp8nFrrTw!< zBQQ9wEUpZYD&nV(nCs>9t3zQNnqSjw>r%fwiz8~S>-h`!swdUfVJL%E7|j4iqK-~j{i_$B3ThjlkGogjwf+Lffn2S5+~$B{b*l*Uwe zUE5WMLKn3pg|V4FbEIC`D77KLH!vnXzTm{0V=>J71nbBjo~0r5eiKJ8jtcla*yI7P zgWK2N?kVncJ?}p^N=W+_#n{P zZR;Em=ZK#QjyNK|xL*BzHF$dQ+R2+kk32jS0rK{rjAfzi!c{?i#@qPq!NZL~pJN31 zZ9*|Jre4{W&{tgSWlE!l{Hm0d>o+8R^zhC*Z4)@`u-Y*EFlG(FSVpb;IWhwpHO*2l z?+<6*Gy&>M8mJKa*~#SnCGr6Fo8p3yK@6^}9b16{ck%u$8VAAuR3E6*{UCdvd+kg8 zio9_a=)&y7S84QB+w3(!(cAal$gjZ(kR$G^m^_*ws4G*?t#C$}m?` z5-x=oLgi}q)#B9k4bkKpt!idnz58Uz;x?C?@%=U=G;vNN(|XlJqclsUXZqAv zl-J{S@NW2)mOp7y*RWyou4`LY-WnG-@<5{(Stl=Pkn+?^dKxDGtxkkfCpD-nicwKC zOa9vrG6R{`M@Zkv$W9Nw_1hbgqSsCvgqGWQGVO%s?BINSfDY~cl~Pb)ZMBYBXp0UZ zj=>c(t;`Ak?gPAT*qmt6n4j4-f3wmUNn~Xu+^$4bCJL6-J}xc~0N3{i>Jnb*jBc)E^h z?QJ?a1gfFmR4UG~CC&&a@Yx&M2|@vh&4!65NFC-CirWryHoQ8e`9*qQ3ac0 z&691Gbbo1*Ew7yzHhuQ{p9rc|$nfM`8$s;UN{oU?vOZZ_12Dc%aR})-VMVQ-OxDD` zOt;$!1iHQ!%z!5xcvXmB1$KCNhHw!_BP_9TuU^C68Vx5Cbkw>$LlqSr9%nqRp=Q&b zrtJ^w#!&&Rd;L-knYCBWNV87vAh4amQ8nKaQnxt8N@wjnUo1M}Qlb~f8!G{ z6YGY?nZ}ii4S6iAi>IB8@t>3lMy~j2>az{ ze(_jViaB&e>p{(j^wBJ4pE}Oh^Y_++--vJf$yy3ya=;TEhhNs>0TipADJC30KLIgu z_txTHrl7(?5z6*MyvBm$(JY5KScv6pWu|eg`a&7nb})N+y4pk%Ae%PuvIBfbB*+W% zbD>sw`ClrQiPhmEKE)f~> z)aqsV3bS>>;hNj`g+S|(JHW7NfKpf{>&dWFdq51E)W(AZnLw{m^b9E&!{Cz^W_|-E zL!Y>%&<5t^o(x3JlslK^{Rbq)^MWzEl!8+Dp~q%>VjKc|6RGbKAqJ)r$munZ?hI@5 zN)MEPV%msNs|nn`O`*%s84K%?C2o$_&@w$qGKmccG~fP^D2k(Kw3Q)e5S{H|-ZTgAh+{jm0;pupc;m;@xOnUZzLbT`K)jTVkUK;|cObAA~1Vw!uW)1z$XHBkd zk(zMX&Ed(@$YJe86Z*0;Zq^4Y^i;e6)&|Qw1#9QSRe)ED%fD)-Kyoxd~#J)Pe-fFTU zM=pp>o$Jd<2ZOIqq?A!6Nx$M54xbWBJanhB-FwLSI6yeSIMx=!Pc?(}7x>5P;;po1 z8_M1s;Y#?q;rXP{9w{}hjEp^$>0TP29oa!~jlTFM4O5KYC4LnDAi>;eOxC>nsIu!s zc9b8ydh{_9)+0EK_X8DiTW}J<7;BEMfO?1`Cdc%tV53o%F?Ye9D=o(fV4r!Yd;#KM zQ7Y3J=t5MY$j{B3o(q}mC_j2<*Q}iXJdtr~j&g9b1LJ`+$T)wTxh-J8gmENusVz#J4!1dK3jLk!Sw255*l?1!Na z_WM~R?A>WB_Fma<9Ha#h#MuX~mvT^2$2mlr%NP~@sN3Y)%u{%{HiPzT(~lMUT>TXZ zJ1F@hzoHG=o{EO2Abu=#`F-c~VVbwTUcVE3kCEY}p_F=^ic0B0kSIyhT-iVKuLpE) z?cmC)X@lT7h4hGJ zg7P>L^L>_|t+&Pyw(vocZ2E!;UvC|;wr6x#Cq%6ZsXELQj`87K$8&ENPeyt<2d-sF zYw2kgb{)1+)RsneSOy6Dbo*DPJoIP)HS}`cb|~NMN#Q zN~VN4!uH_%xs#Yu%vnRsHjoG7>*M~d^YH%WNMBJlaNG{PmzuVOO@cf9^O1UjEb5sA z28d6#VVoNJi#e7oYWb+~v8Q6V7Im}3kJdMLXJ{NC7bKr=QXmavMkrVtM3Y-Ttbqsi zr2uoLoW{;Vt*HvJ>SSamAbQ_}&>G%}ZxTP^idD2A+dI7RotSx`AMHyCKLh8sijnj)o-&@4tEf4fYxDi=XRm;jsLfR+mDX!DAyHH3+iR6AYxLlw8(6}KfRPne5I>{#jkd;m1&HUU z;Idd?uS<2hvvX66N^|K>R73>!>G(K#+T=x!xOvHD8q*Anu?c9E=6f_)L>1?3ke(=7 zq1-SV02)*O94?g}8^~Z72W;LRL9f8=OP(lgnF!GopLBo#3(gv;nKHGiYHR_){qf}G zu=(3v6KiZZjEk!-Xbr%PdE}<5;8`}B>5NCqKpvCdiON<;qn*K|MD;r1bQPDcXI^UL z`esQH8Df1Z^3g|6M0PS06XY=I_6;_8zmL)lBc&th_WgoJ`iTDHD+IeVc7pt2ui28X-2j6V&qIHERw*)u znmJ=ZOhD7Y9(Qef_d7AtOR~BBiL{~vb~NGElVK>j)j1|V=<1KoY}bnaWBOzhdxo1i zPHSmV^^0u^ry7rdk2lP}s$A*gJk~_2;_{pKZMiRxVklX= z6_yd!?i`g!XDv>stZO(F-MNj=I)i4p)(T`&YBj})v6NmYjw<~ufg4ev>yya%#eumu z#rqyvfRh_fw}V+kkjaul%q~A*z&aA747TH4GMMExdDkbw1GzPv$!4Pq!ZYzQ@o9BY z=ierH;qDfkWX@D;J*|Aa-#${15h5Qiy`cKs%DgzII;(&gV)I#pir;PysSXGdP{oG*&cc$L|@W}I{7in=QF z*s9jC+~CbrZrAfAwuMaxC%w=eyp|Uun=C#mLuyb_8b@D~iufpnwHKihY7&mk_ma<~ zeCEljbMyEpYu8ws^h=6ADu%$54=D$|0*n}YIsIagu?)xby4GcQbgvb-TYx2)pCRoW z1V5rU%PZ3^l=Z(iWImT_BhLp1eC8h??Em%eWd1KKj)Uocj@|r+#l>xk!u|C04)mdh z!wg00(zLe~jFEPV+$^wObG{bSY}7NikW*QpbQ@p)d?X6R+ISp~^aH*QAH?Ipz1xQl z*0Zfkca6KT{c7%XwLuq-59mw3|XU*h@-*ObtamwH8L<42{3 z3lP+Y<|-((E2i=0gxs=X8{t78nt zQvI*|5_R)5iZy^hC$-p;MakA_zjdUsw4e^o=~{4qnMIswSYLL=-34`=y`TSP&{cENjQ;?W__Zy$1P2-QgrB8>JF!U;IqtiXPjs+T6{hx- z*cR#AUo*%DOB6{AH_I+Ad>aM$4J zx8#Yaha$Td@Rg*XR*)F|X3f8%+S{XXJY#LWS1i3hD#^hr)ow_M)+;oc+6UC$ow~JG zu1_R@i>9rfcPM3x>|=lMGh9hS{4H7I5@7KM8w)~hZ{j6R2E0qaE)KgvTn(ZEZb>U( z&RGxAWnx#on9Uem%gx*~qo0l;@(b_xMVMYZCbAB!ef{AxB9leswF+>cbt(SC!oU8i zp-SP84SyLy-wDu*5AZcNtk?NfdAr*cHGY(-w*Lz^M)@Of^x^*r;1><*x~ft?l%Gkx zP?_5E{r=<2(L!v1{q{%~-N)Xdi0w3;_2&8daQ#gawR#7}kbEutGx*tRcm3YkuCwFa zb>Cmdb`O7BNfC_815d8u@i=L>Ljq2irOXyAjvr&m5s^1RhUlp*ePid_@o)G-Y&!@2 z?*EMQ;tjG%5S`fTm)GA&i#Y|G*Y|-2KF4~SHRK_Yd(0e>CC1}bohN6R-vR9eUozuY z+H=cQpkOEx*8q}{*T1Cp36wE2(!_2G)sbZ6wd-1N5&l|}E^41UHByrSpXfOnRTdgG z^o*_-{D&uCFoE2jU2e-cXJMh%B$K6rm-_cf6_dB{UNzv=!IK}cAPBE^ZdugDht>>K zJ4PHqk2z)yIbyVLD}Ag)&PX#(MlVg5VRU@S;UnV7KT~^nuwq?!AFR6P;^6 zIMeJ%u@nGA$ezB96|vC7Jbj&cdq&(wW)Wyea>BAHJ2Yo{R87Qoo|6^V6O_jSxNK1<$fW=Uj&Esc0o$ zj2-8M9ak48FJ5Ty+GvmiNquv*L4kCN1tCadO>-&tzyz--A?Y%9Y|Y~JSQ6d!ufU>p zAWR~Nq_YX0yLrB$5>@wLNb&e05%Ve5nu=Zxi5wFh=bnX=@|wSgg1>z@rzAnq{VEJV z5WL)HD+~fcqG0Bp^%?$8+P^rdR`wGJi^I|LCuv{`RNm{pcM91oFC8oe&MU!reWO&I zkEj#o%A;N0@$x7VQL164{Z_Oa#igKIdm3G`E3Rjo8UIM8ipZ7OP3pN9Y7 zYdPxvU_(-NX?N_S!ffsp@x|ds!&@zHD4p#AJ?a*6^lTf-Xh-(w>m>7>xMA%*H0;AD z+rRLxALOaOq|peL6J-6zl>D#wNV2Mq-3C31 U)ck=?oJApjj%bWzgh2e5j@x~ylhU@_dw2{)L z!nm)`b+AAZ+2t`HsL1J7oKvmb6-US+N3K}z!MrmMbaruP7Pu4n4DRmZmOZN*n$v8| zKwkvY>FP8a+0#XNk>36Oi`x*M5pj7}&TpBQn?xJLHkaSN zbYO_jx;+v#Vxd>X@-@jrS7zMw;l4xTyMAH1IP$Jrs>0GR)6yl^0=T%Kk1Hja@t6DzJ_}?J3Eb5b21JW(LIy)ey?uQtl<`J1r33nhagUd1vI^ zOKAAv=Q(|m9D}vzdxD0un0eq_+zOI=XGrZzfXWk`cbSY+3Ha>Xus=4nhr#>KY(IWz zI{ld<=|i*O`@wZ?Xx*8^it&;TX2IXAWC8nyB)X+I&#{>99ANfcdn zpVBkI@he~$`yo3kzaXtS^sr&o`LSSE+lHj$2@-RnVnKI_ZrvVTxfKqzV5f@l>#y2E z#clNR*VhO;32EhnD?9QqN>0Dg&DtAFZ@pO352I0{8p$*?lHcfo#n)b7tfDS(=A z{_EJX{FeoVgX4d;pmbyC{G*<(x_gPvq;U2Q8jsf+ps(_UHVuT-VAh`h?LrK%km}-c zJ&SE#*5Xqt#%4WMx5KU_Q6v_S_)7H~wnCuwa=*Wyj6YYJH;#Q#BaR=OxFUiD;M*jI zNCWZ34jq)JcRe;tUkpy$t=6(83}OzK=Yk-PF>w1S%ltk(%Ky~Fj(w5r(bVWcx-D}? z0`aX=uLu&wuGp%4)+=i1_*^-voG)|20o{^g4N#$g7pxeZnK?*Pg?3zZ;yaO(zx$;7 zb*OXG&h37v`f!)Is;wlER`d421GE*KgOS0DTlAh3ehMrizKx{D1}E1p$kZQ z&u*$E`KCZ&56y0>Zdb1;-~==%tU^3{ z$@HZrhx4ewmVstf=7?51nohf@ATDhkP;iSZ>S&=!mw7P2R_lf^Xg3BLF%sRXToYj7 zxlyfopRGKGDif%V%~>A}0#SBhbF&?wY)g*yQE>^T>-6Fp(CHwQ*o7O_suKBE0%fPZ z>dhm;%0wc;EF{Zp^9&k==*BYq^Q9)__5byrckox+K^p7j{BnhdCr2BsT*B(4+D znVh2XsOivN716jgxBLr8OwB!ro*_{|3*j$REjYVvf}(l&d?T7*zyG{NsbKmKxsk*0 z1$Bxd$#0A#d3h+gQ5jEStE70zLB8UIno$sm-_FQq*#Lv_K$p}43Rn#_IHQp;2_1Jg zV$(t3LQCUfOdqsFzb0gy%@`fR)0fBLtU$nKH(f;tu3$^!UKM+Q-rFj0r57T!h{yq0 zNS)GPLf%)IeM@qtayqN(%5kHbuvI<1sH1TUx^OT^@jS6l4<=x)fyPjI?x@}uEjyZ* z3*d)YsLagah#PI;Xd#78+M(%)OZf1Rr=eq-pAVQ|Logm0>GRmAvb4{wwf}0LsAJRC=2ucXY<`Ev}SRtiZbKoCTt5a}W3S{IvGbwv6B)m|Bib$H&BWx( zC%d`QA6tb~G%3348aIE@-wxYk0y)9B7pqN8viiEw0PLK+7Rr)LF zg#$)ME}nxc`eq#xI2p77f}*nnTk0%G0A~c7Z)&Cx18MQF5Ce}qiDIPPp^*Y33Svf( zEnJ7}K?I-;nGpf}9!Ad`n>frFZ%6?r3!DLbM14f$Z;l{KX0YW%eugee1!ma)eR#Io zI1xk=4HX#>2QStU8V!Qju1VXmqW`gfq+)E1u@9z%0jTqZ-|KWiqqhpZ|5*DA$8&dg zMy5_;jErdJO~LPNC+#3eZwEJ8!U_qf0b>>DRvvZfZLXE4&GxrC{)ZPLxCUxcczeoy zd&(#Xa6-8qd}E8DlVS!BxiVu!O%V}1C(&bzXr^4$!4xYgR;k57Qi8H0_iq_Hb~%fb z)8vb`*a?b5Q=Zn4gKSK=!^5v)OaF-8&#;hKG+pw2dQf{F#rT}KJ-4<0xVG(8CMvH}Y?j`XCa|J27bUn%YmgY!Dc0A$yw>D2L)5cmv;JTX z5jL`GT8AIWq}bN@dpH1Os@}QWM>HY>^YdCE#SN#?=F#Yau2k%*A+v>G4m07civGC* zXUbxyWDk{ApF8nV9r_1^2*8!@RFBK9>j$8ShTEBEb>yg3jIS-;KG@yF5m)KLm+qdp zrDV0CqGzKt#gi+kJG6-{vb)-oEGM&$od;Z43F~!L=U=~6(_u&X)GMR%`ax^0^Cr<2 z*&U|=iIg_+WT25~Kjclh?PS=)iNF)Rm8Od5v;DefxGV6uU@2z1mvEs=aNr|K`8lx8 z>%Hb;&+R_h-TaYbFRl+ zhQfo)Zc)CN#G|5(*oNygorvhp!|-3ofHD?_<>0LrO`nUj1l>`7XANY-Mh3)Ok$3P;x0Y4hWkmFZp;f!aFe**K!Q15 zw&OSc=1hr2Y@(<~a)sP$UR&PRxaOXOXV}$4^YOQ)3LG?oFd!@yg1-pP8$QQt7hRuW+IDT#bY4 z>mE0;1H-n6v_JP3VV7!lJEh|VFcT_Wn%Z{g3K(D#9hyg#^ka$c4mvcx&wf>#``f35 z@2Q;BzfRw?Y_~~E?HZ7T6;#T6kgIEyh7NX^nMEK_*(Q(>3TH ztm=X0#eUtZ-QJ$^*&T~_9&us-_q7ES6phg$s<->l1X!Z zS}I_u!l!(-3+Xiz+~Nm{vMmQRtv29)JqW?dOzQ59317A{uN?SUafe{ix zw?%d3+RG1QG=pQPywVh2L56VTf>FYSZKzXMzAd12sinMw-$`c`_pCFH1ku>3^Tsha zbLQQxY*!E8n~L{D>nF{WnW|l4Z!1eDME13btl~MV?ZzQo97UCj3lfk7^-Ho)S;+aK zh5X26yoLPeRZG#2O@u`ty@?wDFe(1vhiS4vO=C(QTnwDoJgCT{Fb*4mUiy1>rLsu2%FS@1BwH+G4B^8Zpu%;zB9Rzm~N*M9>gD#hv zB);2u`0|33F=$kO$-aWaoHcWWad#a-Jgjt^47E(O$oG_MclDdOPM0dgi z7lY@4wlEEN#dHWnaKmoiOcxnt}lU>ntfY?b@E3LAAAMV1~X^l#p(#< zgHky|Vek;O2Ta|9rY$=D26=DFzYT`LKlzV_%#|F)DQ3CE9_{oqx9+q}M!&_L(ASz$ zgN`7lp*@0)6H>CDia^lyOECncZ(|T@l>qQ~A_Wye8!)+Gd`*n~$webObH?#fp-0qZ z{K%DMjcz&&N+JfI$=iQFqLY-jR+W(acG#}$6smR$?9;9x>{^ChQ#Nu(=(t!q2U`Ve zY`@OU8YZgD5{MNeC3d{z-RCG2BhY1XuBH%|glnrmkCTj#EbyC?Yy?jKp+HFn#gPsz1J!36TD1p>r8$)ocgu(XN zat&GvYhIRFqou-7WFMY&iBBX#ow0Zxk-Bl^(Q+A$VCzgXz#ox5S%MA8UHO{LruCY z+*kc9*fovX!JFI&N(TCincT)cQawvC;WA`z4H@4Yd6ly87AqH15%A7t#wQICa zkiAFA{}NgwCq7&rofchgJ@8=ti0L7gzxK~$X8On)`Xxf+C9Q?_5i26c)o0>4kE^k&}uZX@vkPQ1no zncTZ*AaK%9Hn-J?85clMidaYZ{`JsD!n*I0<27cJvlV_lMx~>92^= zcnWR)om-V)9ZB+}P;`zyk37yXXu8x^{$>oWgiExa>a|Q-Aa?t(C2NRrOAlEJ^2wZmJ>#?8qOEaA7C@qX;#cA6hCirUxyj_W@jj(nw&LCZuC&GVKJ z>{tSG%&1iX$TuK658`6OkWqEfUtXcr6d+HZFY0Oy1o(SSNztMHS}g3Yh*7oy#2?Sm z^Cw6wJw$wCOf5E7Qjfu^=3JgvgFsuG*dC)ZrLg;$Qk)0Q1btN_hTYXZn# z=wh9~U*t?$>V`OWe(U|IR&D(lh6AS)bu1pk;+sg=cfY25g9|U*GBl7(r~rem*}TZ< zWtM@jH5!rqn=FEqB+e2cLE=I;{}!AbGcL#H_w^Py`K^n~yd?46^#HNoyFN%|F^CHY z@R?uO73p*Xu)zf<4Hx-En|gu~9T}EaS!PASqByo`E2xb9Ag!(bJ2OkQh5uA44eZxI zg&R^jV10vH3nnt7;fPDESQCT*_?OB+nLFG(1QmAD5EIgcQx!NC7s=#-1BwRQp@HU% zAl?YijNsG5&wZdG-KNO>74MaCsn4jI&{cugK521h4>?>DSNn!p$Z;R!!qq7EDZ$xl z+eERjyH)e3Nm}^$X+^W{M&COWnRE4J9x@lFBuT21guOl8`Q~!7ePoWzdV&v;jP1GH z)Ab@`+veiC#CQq2$M@;xc?_4%Q-UUc_1x)Z7#D@r8&6U;dS6!9O=n2?L{`YvDl^Am znQ1u4)t1m^Kaf^Iyx`A8c5bTV<}6K7t{hDJs@8z)cfRWD3$iD`tZ)R6Uf*;Oe!VS+ z%oO$MkKYwTU&hq8tRFAdPYfi%&6mEU=w}^+lU4gxuTtj-%&27FeJe(qln~iz%FyA% zz7|AefBm6t*%!pK+oIc2+d7Sc<&OX@rjZUXcqq<7rRl5v&oqcmLGF) z)RJ|ccG$f(*7fIe-*4z8=eo@Ft%Q!;9=HfDXBlSZ24@;HEleD*Mp+_MC!B=BeWsP3kfkZ8t5=fiMlDHV&(^VbRBWenz!Y%1p?c@;Kv zUTbe*%*tw2XkSiv?cqbm(g``froqFS{F-|oYJXl1!Zy*_?1mmJyVXYxyj?mwp}hSF zQ|?ueKBL5g)mqn=d%In@e`l|E?RKa|T>Gpfr z>;`_$tm>bx?=I;Dh-4Bk8dhYQC0z0=`+QmQ8-G^#nuR5H8}F}E1u2tXn4}?{=D;S!MJvVK(~A23`dh_z$;K$DwV2- zIvlE$6Wb&zyR*s{RE0)W{K&ocp)dbA8MgR2RMjrB4hlU{P6 zUZ_#;#s^O!vK`F%T_ntUya~Qb4i~I3E~!lwv4AFrOYh_%c#?#@S{jZc$BzRL+3mT)3f;Lf-M<+U5+Q6SJ)e*76O$c=-`aizSqSld{Fn`m0dq7-JE}aA@LrfF_8< z8382MsDBGj^su6{w)i&!T=Rj))(&gY@{}Q_mz|a2DL1@-$-EvOe*z@WWsnOB-@c1C z1x(Yp6*@KK=)uH2viR{aZ!I=G(}`2j+6RCMl=wcdY=uk6cE%~5sG%V&BdRK?H51R6 zV{L<3F)rBg*U=+j7TTg!T`Z4!Ti{hi1vdJ$`0`h=v-tSxf?J_NXc%Sz@_=eV48n=| zhh|(F1b|kNaE*9C=p&ysmtOr-Pa`2A-T9^y=9TNd|7m`BS8G?`kp~8dHGFIzDt%9TxgFCfjC4uu*!c7>;0)>dzQzu4W%XTO}%ro5TB>6MO7#N}t zLux71_h_|8F@j3&~R2$Ns)8nNH28km!Ps@sjV$^wIOqJP( z^ADd(fS6J@!BCwp!hVKR!reBZ(4M0w8;Q_qyxnw|-b`8=ZtA6iCo%|(FL+5LKavj2 zY0{7xI#=%r7CVlEWsTw3Fww%i;dY1mkP0zUwlX?HHf|UqAVmxh^qRH7B`XDwV`daB zeM1Fn$-1D9Q&(Rib6y^i%+TP697&T(9<~a;FmAW z@{~GS5-RJ*l$Ys32jo7yj~e^mr2D7Y27L&Zaj-?$%|yj)zP?dJP95@?9jzy}=DiBD zex^&e->-@8?ct{ux8$Bn59?iV3LR6q^w-8+_;|@{){sARZAq1maUyCIK(1159)Lho zB@=(SXppFjBDzdm@!9^el7P7byVQ<(0c*h?rmp%|3$ZrFw?I9mrP;p73`^-3;OmUM z`S4%ffI~p?V2km6KWfNNkKCei-rI&$tC4|y*>l_H(OrDMV`_pkKK|8CZ>xYwW6WEHE zL)LeeJ}qlC9ZJKxxuj!^gVk%?!nb7k&HPvf)y~5=>TRiq>vj2}i_1WKckI?B*7MH! zQ0QgRdUqH71&8_8U7DeHjS(8->p3DTBAm*A23VPQ$iRIq^pG}PH;?M_lmoR|Dp=M(|OWv83@=is={dr@xV7oE0t2GCz7CDZfK zy}y#Qhd~Sju43Y!Gs@kcj)RxkUQvQ{8m04AdCf(xnW9jvLF@YrO9ku|^Rof>VUm^h zxhnPg6@RxI+oQ>791Mz-9$~1ua@XW#ccjTp^R&k%?KXpP*y^S+D-FiJV+uf?+XYOV z9hfYFDpJ)4xamq|^hSg(+VWlukq3$N%cgMHj|Rg}`+PRqujD0J@y*>8@y8I=)$cAG zwWrtB@06hNn+u$ab-RjQt_YMA4I@E;w(KvF>E}{M0XgozADmI{$L;w#XqZI~vZ9sV z%eP+7eV#P=O!3{3i4Tw(2YzPj8{9CNTe8`A-c~Q&pb)V1*KjrlwSC7(@Ta4CwyV4k z7iQ>Bqw6~a=K1U9@gaV_)K&q<)x{(dEGlo7xo5H*wii!x7-xo1Pvz)pROwh7P=03Z zEBV;o?v_Cc2H{>$t)1Q%KFUla(SN;uvHnNe3M0e+9yq_Oq45veLh^mBO>4~uhzku9 zR{#qn22b$LR(MdED@*8d=h_u)>4Zqk~S+ASXuKytgNi9sI921)cl!# z8R>oBjH<=g-Rjj4W~+Sv1DTW=HZ8OF`DmW7MUCu-C$>K=uRRoc)wThr?uqT(V~US z%kH$Xlj5#B%(s6UW}|}2_$5pO!>i(~Xm^bF=SwoII5-K9+ld;x5v-Z)$& z0}8FFzKpi;s^%gR=NKIFHc-DO(kO+wGDCE;xx&ZCBoy8e? zHWKD~w$=3UW@%k~6U4v35dquwb&j1&dB3{I0Bc<=$J>AHuL058K#$QZ1|~#)EUnFr zVPIlpkYIcM#m9f5l`Fr1s$Q-j1R;GJM+S~o7puA0G^^#c{fQ)QZ0P{85ZcW|QEuk! z-KmcK)v|T@qH9;dsCu&>Ox=!TzfvWvqOe5`brcU$xm8``Z!MrC5%XWM(qZ;bamV-ib<>h zFJ$*?I08f59R8g+TXU5r1eC*t*Y3;cNNlU`n*~_!t?q35d-j;Yl|@APqq^Ek21`1m zAlz`2Go>X$*c~|9p9PjF5}9}l)~PlXkC`R(t^MGBEs*uwD(XkrgZpMn1mG3q&h?Br zn$2R}!p$1WQW89oL4io7u}QEfBN9rR%H?MbDce4k>*Z0AR-u?c-nv-DW&ml078#XjIPpCn`WB@D<(AMW%P!4aAXcdDt8(Yc z2m>Pr1!JPXeVNJtw~-kX7tBJn6v2~ZjJ z$W59f3DhL#d?9=g%n6ygRzoyma1c>y<`<%n$C)aD^2bQzX_$I05IT>TLSnf5!(ccS zah_g7T?6aMOP+LBHW!c=geaM7TTWE~=s$Ih@5`@)(ekKb{>C8$sOhLd+=!i zJd@mRxlf30_sO$}w)F&k`jbqb=vi0ze9_)EJ zFrLRPjF~6LE{Iz)5qbbS>PKnBd)CF6gj!a_Ud;XDr)dn7r*R;$qbOW`x8M(tfibom zlLo*=U~%FcjDg09!IDG}1eFu?6Z=BVEH)FR8X=H6M3p)OD+Q_bvdD^e+_3R3Y(d8{ z)89e;v$W?J|EMlp!sj!LzkEGEsRtUJpM)1HDB$d6W7d0a(M zmb1&(49Fah`1jPfNHwEY;D&rbwLQ6-b{>8!A?3W_RWa=Y5n!MnMvQ^&Dzey9?Hd8o zq)?B7Q%fU_Z|9HR zSY!s)k)G_ZRc@tC+d(1a!rz6+v?2!i<#d*n)GX8{H9UOGT`WGSL18FWXZ7wObT&UX zmic>EaUzN|Qpx}9wncmC<@Rpy*F#9z*0jRvxvy%1F$!d`Pe5f8`sXbKj5FLQ1(EKC zZTjP&oTl+T9qPj}CsQ_Nr?7VC{8RByc`wEpGC^!d>H!P^mG`-Soi$&5>@_bUz|^>1 z+mkXO_EQ+j3%=q(1TXSF%pwH$#DT%8zhZ}bG6dfW zGvz*R&$+pw)7y6&sLi>>$kxr$iG*A3lQDn!Fq+JOD+>bAD&FI?)B77qdi!VyB#cNV0enAfCKbIX)i!Drs`!PtnS`3mk^iJz;Mc@>y<{+>R?7ig{a3&8|I5<+ ze^m~Q%nbjtz-UORGj^)AFf; z#LVrsmd_u+WOAO&b)o&!FbMzxXfKWcl(X=84Diz5LK=Pwdm?R%P_M|f5l3nm) zp8^UOQQVGMFLoy`$^GH-D;Hg@XDjKi0SW&cVM43MdXF;vaf`@2Qy4k>9Pcxc+?zr) zEXjhp&T3M5YVhImkjuy)xkm6S@WbVdbCY>SP))(@(&<=2MwiafDHY8thD;hJCLQXC z92@73ou;jKpMzK_E|ST`mX$L=bv_rJ1Q5XWw95$W=vx8m*wJ@O1=BU@JdIRjI*eV7 znG9@vRucIWssD$ucM9$#>f3f>+qP}nwr&4oTNB%w*iI(4ZQHh;%$~Puzx(^D_H*zY zbXA}BLHGLgTGw^og(+S#DKa(eiIu})xFbME=Jcu?kcDhs(kZ1D8l8LXt@83IK5mB3 zF$m*U`KI|Gkh=7(jn30GHqx<>c=o#Ts|Ub{>wro+bVx+8QIoiA zfDVS3QY#eFq8%rlT7}MW$1?luyp_clM9wZ4vEmJ>L)IHfBtMWcRj^hPw4gkSLv>@# z&HnA(--C(G)gus;ZLLsg5gGeS#Oc#J++P+ZBVUg?Rfu-aE%SKOsj;9&#ak=Z4FZl_ znt0cSIep6Dh?8)AD;qD1=--UCzhZb#Q17w7r|T$tSbv-#qV$}MJZ5L9aRuB!^V`h? z);xm$?BY7i>7IwQ*4xGm&Jl+fG~CvwTrtg!8|Po)LD75}(u@^q+lS5*qdt=RynCM>k&UD!~n_ z+%srszbx-{TDL5(hSHu59J{my8?=F3a_%)%vc<0>svC(OyOehj_ZyV^;#THkRtAb5 zZz_S8gnJvVkA`I}y% zQ&`r7pAfu1{1?y=`n8qSZF`2R(IgWjH%&)hJH#Care-+|~Fck54<6*aV znUuP`dB7;)$wSnwR?|^|c4MCMeVOu;9bUTJu2qsL!ALa|^oI~*6;;6w`8kx#J7{pd z7~Lvnnv-igkVO!A0luersue_Wd`yO3AmfpccNSs^LPcyGn!|fCUNm>$S!SZBIRl+@ z{{^T30jvYl(a%u-#q@WHe6%pb-kJYaIv4U9&k9V2#Hw{|v^&*SPeh4FQ!T?52Kg+V z5i5N{)QX3YHxJYPk{07<;@d%&SNqcX@cY$iD`y>};q(mS%ePmaggOS(f*O#CWu3XV&yes$jqxUG4w>&c!{j+p`c5in?MTe z2rjrDYw-qj{F;7wl+$dx`(86y&nWu5SlPE}CvJm~Q?8l6>lgvEX@byG6RIt;bcL1iP00?SLx4=iB`WMQ%jlA*ZDVMkY>&bi+NRFp}Pj z3G&BI&}=2Y>uPj$Zy&EKdrMa%7apfuH~-1LkR@c#8nQ78p_!|~`JVwHz+cuv+_Sp` zE6w_x?*@6p3YhS#IUfYgwpaIgg3r@lLwX_iqW%xyLL2Is6CI~|r;SFNMUKy@>65le zsa6vQ+ip3`nv?iuiN`p*mS-7yPl7kK;LR4B)|WX}b37hQ!Nxz*XH0brE~V?U{3$pC zX^g?B0u5Mt3!rwRkhqo7e~XBj_=&hk>S4V(vh%*3!qx||+x53MqKl=72e{{kD@!k+g%8eH`{DuP}=+g?YE_gBq6@a)xtI{DSZ`w%R}h2ayg(X-FeD!3G) z_{FfQzrwBor`9ksfQ|{#sk65{gg9cIrhL21VY_&~DIJ6I%YsIJe0elL9t6uMTGxT5 zYl#Nq3WjpdzxHA_6hW|I>nLSz{xb;AQ}9l2>^kXn19qG4qN!2yI_N_DFMM!iBcG>z z6qG?qjOM0EfAbL)LF+|GBt9#8vbug1BuQomSpriPt9di!61-lcmbQi*t&@|$LA(XN zPNt4u8EHR`)J$56SOtqJlE}BkwNwPv^o#q%AB3d{B{&MuPV->$@*8$1x<-7Kt~uCkwn`2~js<9LRVhlAROm`FVn5?6$cGw=;L1umb_&o2LI*R|E_erV zG*lTfHTK9dSsa1~=imT=tHk#(ODR~F+=B#i4RjpGa^e-?po~0O&sg&5^YOK``XUA* zcsEX)18zGe*|eedV_^9b%yY)L!*g;x$XrCBU*FbqU<)2in!>f&z`X!%-g4*BXJA2k zqB0MZ@E7`tjumO^c5kS=1APUbY=dEa$nY2{v*5ZFE>BH{4a*A?x({K^$Rw+w0G?9sz#3|r0Vdf^^+ zsW`$}&?kiRzIJS)E~9|T59q`xh=DL+tpk(+ikl1}iKh4p5@HYt8x#>ak|nO^;~i7n zo+7^CX`^`jglncwA^_(%CU2PM1pzT8UwcXP=~L01)s-7Fd{k^OxUd(^DWu zJ*tp@a091A#Z_3DLvEjmlp@YtVFEYaUI3)dRpvF;+vhDv{-oX?t=znGUt6EO#abBO zPZi9Jx!V2UCB71YV`Y>BOT!P6w3Gge#vpf9*T#jVZw zQ)XQ5kTzL)OBb&5318j~^c?%?qF|D@v|QH@(a(!@d@VKqM*G7BOK2^>6`ay3rQJ(5 zKaf}%@GR520PL3!AQ+wJnXJxNpsK9cvkaWjEGX=SU*>ZQ&Ie@?cR)GKG>5#cZZU4W z2BXxYC8d@fkPUke0oM#|(8i6~f>;IqbM0lW=ZswFa{D>c zvc^$@im0z(5ly$XDa;Q?U@eZ9)7e~ukRD^RijWPAPd}OoH5*5mN_p&r)s=IIXTW8(_hSSUyWyf~54zuX7m1Vqe+1bnU=|(vWA^@HX z+XrqYSAKoUrUQUcM(J)#MT*nsKr`+`I?rhJT8Y)@yA=wXn zBW^xpTRvg969x@33G`us!14Dym5wwopz#%=%(bw8Ac(Z@x0{HEGcl`zZ7w=F$1eX^ zNH*|CawHRtz^z=!y296(fc%U9B({Qbi)}5jx460Z8v9%golsui&W9sNP#T5>sCYT5 zAs_AnzJ#uer?Q=B{V_6UFjuTk0M`>D^#u1WG?tOqF{@^bv6rt3iQV???ezBOgb|RZ z+;gp`cg^oTDt@c@^PH#fwY8cYPA}DsFP|JC0^gHe{D&8jiSz&VA=JDa&50NlO>9(M z0WgdTM9fS~FpLt`&MvM*+#DP*jQ^XL$HL6<-y)IITJpAdl1SaRb!Ucio6qapM7~ln z_P~d431V+VIpkn5XlB?s0ePC;Qu7v)o)(fMK8ZFqyK0)9jUvc`USJoUcDAu`fr1X!?sP1N|DJ-O;%g-IZ? z;j_kW8!;Da5WP^R%6Q1tIB-QKTEff=rxL2^d{>2o?n&p#$?nSx&^m^=(fCZ9Jq zFN?FCpRTDbw>t)<*Wuf(pHEodgS!FOcZ1J_ozpLp)lHr4e^J86Bf8dmcKzDFyXJiUvXos~C*VsNaH!IrA^|*f#ii z6&hBBqFcB0P6{iI;{KHiG(wsXjD6)a1{(i)m&tsc#GBZfu*r1VnofVGep9wMiQ)Hw zzy+ozWHr0QejtZ?XBJgwA5AtT*qC-6Enr8S-e^1=^M_}18+UqO*nxuV4j^*jQXT@s!xgKV7qK6#d6!8W;1S*BHgqTTY0QJiX)QE#1vVfvI45Bn(hsR4jO z2fS!~Df$yOzvN}hlOc=Lf%{fkfs%sz`8jJg=LkbUTY+IQPB3%`bG+GnBN&kw^4~DB zk~JAnmd{S_%p>X+OsqSbkf%xdHiT_?Im^W;JDEd%eQr(=up4`O6g~0etyh|xp5X|hYVw<_yz+PDyI_F%zwUE$ zdoveTXLDn~|J*s4*uXF|bNz>07#0@J|2o^CMq4(1s|~s5Q`0pNTmrt$TxQ875D(9c zQmS4XZ2ahm9WE}5zouH};*5Fc{j~yfSuK8~;dhP{M)a^r!$nnLF-JUZ^ZR19;8w4f zM_IBwcA9n$;07^UszQl!onlrkhz{i4Pk-EsJtv-ZcRY*<{Z`G1!u)c$M>b30@QQAp z%>h?0j5P79O;gy>X-94L75z!lIUP6tS6!FJtxJThILS^uvGAjcxJ}6Ya=FE|ZaRm$ zwCo#rPNK7EwbN1IlfiQB0jGQ`PAC+F5ncNtPS(R>RvnZ`e#2oKxl38^W!4pKxc8JENmTjdx6cq z_2MOSfkm54zoS(et|4=WF8iq;SP!gck?z<$D8eO4sO&bkH^|`~y*&R^c=~2VP5zU* zOlM)SjId@}Oz2w9a&shj|dM;$n#2k_Aj(+Am z)&dUX60HyEV5YbZVhXcMlNX7{4O#F#ZN0WnJFGp)xe1gii)#GEBS?BfpkrKftU4xQ zG^`}|e;7x=eaIqVc1)>KA~6M>D#nLcj3J1hxBb7%3Els^`k_4s87@IW7Yis60Bn8c zToiRBUD2f=$F$T{9m!^%V@S6!57hBavO=IYZ1Ex=S=usFyNoH~Y|r>2x`4a1TJ}mS zAc^bid{q6J_ONnXkHM}gnA^6Gdz|#3sQSQyLDocRr(b}Q_ALU(iXK5fO?We^#HSWS zJ($Hb>3O5R3tovtN`tPz(AK-5Vh)Atw1q#`Z~j6S%V-@XpZ5|J{Y3rSOT(SbZxI(b zv`p;G7CsmQn8NGp5^Ez^!#)nK6)yXOc43W^33(xTJ)#iGYtWGrrH~0gkyD!@DB+(J zBLTgJ>Ipq9_c=NI)qf4us7GNJB00oE^6f{;Uu1$Qk`jg21U&@_&N3AVG4%Y2w<-Bm z4z3E@+$08};0PYX#qavP(^x6QSp#KB`Kax4$)$^bg^tu4cVVt zZ{%!@HCHplQ*viTh@W|Yu>mt>TV-9X%nyN<3B-%AHLNF#VmAFSkZ}}RXSJ%N9e)Ep z;vavkNB(tY}LsQVaX`U>-)2;)QR zrsP%0BuMARZJ8<-o79Isnyw!Y5>gTsh$Efl3>+u#BvV&eJ~l`>v|=Eekb~huTdxbr zsXBw9=Bf97j7G>cX$y&KRdw?EfbUA+q&4W;@LgwMh#K(Hg1$M`j!F-Z)|{d7ADa<3^bV4j)A{9r8v|AlX!w7NLMi>5}J6suR_{Tqzps5rY5L8pHv7Z%EzWg zn2mu-AgJ6~pcOGq>;~_1$rFhPik8So&R@}4_;n;m2IWcg&mU+*e-{w=$?=v8_bCbA zw1+RM+F;8QOWx;|k>??d^!)dr_li07Ko->CLecLy$l+7D+@No)d_2w{r(%JB5F%*_ zT$Z_C!ooE@1S;Sm*K68Q5Qwc1M}8)XosQNZb3z93gN7 zHE|a06X2509!)CEB+wvQU@_+&|4cJ)4dC%#Bv>M0Fh&J_9dzpg4d{^>g4GIQdZq`f znlTIdz)EkBs}K56OgHq2j?9_F9h#3N(NGu5O**(E8g6U0d8L~$U@&BNsQ_z^RyF$6 zu9#A9KK(ngbJkgM;!WT94CtSX%AM7se^`V#t3_GrQ9TUxLClb4{+m@BSW#3#O|lJ1 zclD-BLfD4!sJ{B@&gD_V1(d*mnY&OWEvmG=U-B?ItX4mqLxk94-k^qGx-MS*Sx%bQ zwsIi{^Bq@}lFU6hX}Faopi3_*&@IATk!U9Sk;S8axHOqCtT^qj&B4wdu-u^!3gLA5 zF9Qm@^4#_^Xwx(H-}2LWeA|BQdT<|preP_g_OCXHCe;k|sLtX?6Gs}P7lz5Fj8Mn#xkXv__4IpxVYH3av_vX;P zBEh07#h)^^MEZwaBhyFY$V9cCUbaT57n8>$oX?PzwQH#llSEf@p6}hbVs3puE`R?l zXTM7OraL^)P29YUb}~V6I3;ZZ{um{X%y0K}ecnC@Hs1(FQ1U-j8NUAYe-u!VU_Id5 zw0p!``O{^LM6y^FDBgCP{W`BT!?Sa9)#TPBP9kp~(<5iGJGNnw?Tg8+EQnxft=6C; z*=hFfgcMu=rXozb}OjI_)SRC0Z}AuxgbPa1Nz9J&nfv^g-vX9?{`XvLMZ| z5MhuOx^iG0s~bLDGw7IHMh!qoY0<7prqcbHjM|{5b*q%}MF0^yB$6JK_~D=;om>q( z;mxm#<6@|+h4xlyH25`{R4+=OB?$tny^2p?WWQQ79+>tfn*fn6gT8DwihbQyuPbwP zPM^Ynm_$`$AC5B%2OH{G&9ye)U{p;3zmeRJCZK(g0u{)cX=?P~WEEv#eR84-BD#8+ zX1*mjZ$xeB=BxJ$IHP=I@z=ddyMyGe2xl*tuq%#~``8XJ=>XPz4jFM1F;G{jV{90= zwTWhAT02R&JYK160r`e#7Z9!)2pY8)9@|sa$6SvsVKUV(~>tgTe#eA-p zaw{;#%DRX$EFp8t=T1`_Vmn?Okr0n0P5(e@@n*y8;F6Z8Om!No=xV;$QEN08q1r*$ zWOH7G1Cdomr~|I8*bpv+))hIa6QY)48I);oW)$X#M2O&Umqlb``fxG9!BM7A1X_&p zRi<2M@CPv4;S@alrPD)Bsho7kncu)zqjk?TmtiYPD}R6o-squS`=d_|_rNQ&7_#*A zQ6e7uvwzUL0>E!I!5kD&`|Y|fY~PQ8<#er;kFD#A$1y_7&2@%TShcikbm!R`B~F0` zcmMnyJll`#DS2YJ|2hJNAEN9GznN6L6D5zKs+KSGg{`$!b0K+qq>)Q+JY$bf>_##n z#t`T*riLMC@e`kUhY3;+NmO;tg8P(9E-ui7nG>dFJ^7|V7f$=4LBC$8igI696X!i$ z;5twTQ&T}k(iRsgT%mQrm+_Y0l`8oeHpd~-V@I=K6&}a_RCFo~VansNdd@`#M@;+u zwF6`EYidNeVAe95g^8G-yb`VOB+IL*L-*rvCJZyFWe&noxnp$C`I>DqjouiQs&$cLS^hZ^b z`pYj;!v7?fq-D9HtO$6dJr*hIV|57vs!%%6Wb>jfn$p^YvghMSMv8JpJx9A2rqd+#0&!e#> zPXCn4cr2|}_8bpJAE#JkGe*n$VE%>>vU}hPMgViS)N6SSP>lU%06eqga+=of?6avk zlE9$VJ|^J@1=NBl-GEIWE|SJ~N)I2`d6l9F(gj?wG)QcAqoj_Fg(Qes5apVz-rIsdw>v8+Kscm1cEY9v;HIls#txsV;%x0IQ>Jzl#;~f zk_DWL5w)US2(Ww^@1~K!g0!gMX?cKoG942Ps*QUBu=!!qz8RxBlk3kxJtqM*g|U^% zsQtL8x^Uw4Q1Fgw^Nnj^cmSQ#M@tA~4ELy!(q$z9RgMOj)qh*j!v11#_*B z6&(smJZLZ-k$Ga{vY3u=>(oQVSdcUp-%}ZK{+(Zlv3=FtqAJPuv$EUN;=8!A3D z>vaj$$_f3pF(npa5oC}iSq_Fn*A%p{ZG#zCzc*f<1X)6lZm_oU!ai1Lcir&Z(4Khn zYc|KU5&g=D<*#efy^s7zSTRN9t?0P>!(NgT>CuhSxLTFm`F3Noy#oHD?I%|RZQe5S}2vURihnO)p{xDx{`I_!)s%O63hqG=AOZLm$)6H~?3 zBpQgE)_u~J8dWJWapMD_ya3&_7VW0f-nb3cn#XI3xCd+C!mp<7Z7zklFrYyJYueKb z<4*DtD3cDS-tA|Ra9SvXtR_gbJGbc`){nnH+)^-(O@JD_R5f2)ScT#zsZgZ>ei@j| zp|W~#WvWjKfl;E^P-5P+V(BDZBu)<&YKtljoX;{y6d)iO)$aWF7;^!+8uC^_Yk zSR0xK+Wp%k6MQ`Cq366)*E0Ta9UkrxYV+8-4#(02n_G{?_cSlMQrq$SfMC<7e7>}< zHY40$Z|cP+qgAF7UeiGKX-$yNHITPZz)%@+JHB+_8@yI(Ipv@M(!QEGAm*Z5mi&*` za=GfVB8Mg4OLBPeS*_fH=q<+MWw22ffBX|PSiGN>F#Y|ScwAbK=h^A-*TMCLe0&ZRdB@U(oD9EdKvAopAr(+u;Ap60vgp*DO)Dwr<@&EzEzm?k?M$ z$lbM7-$F$pCbp4`ci3s}Wtb#f)cIeLKoc*w z+}3#BuJ2lx*DG3R^0Nv4=e^mVJkQ!rr~%K$m~C;iw`6&a_wd8^pR2s=-X0&A5CU5y zM$Eo*mf2nBMLtT*MUJtLkyQMv*X`upJYK{Bc7@!}eUo+sugIk%UHz-wnG^pbl{)*$ zej8Hb^m~);2TGS&!)nsRXGIE50DCs1|Jj)wdhE}%o1gl!6im*@ozg}F@O62{oB4^P zLQ-pG+B-O_oFx$=qJ}DgO`P;#O^9*n?<}uG7iMt_ZZt%sZ(G%hWc}5vdo{B)#WC>Kl|u8(8FC<`1>?Klv`jCN*py=e}ib9L5w+BB=si z0mK3-t(`pFsqH*az*FW`eJe?T+$%K$SnjH%M~qRN-#u^<%{0k0)^g?*@+HX!2~{;T zjo!Lt(zV{Ui$7?(IL`py1)PvM)#-xgllT z6=7fa=V$a%it_Vn6qqD9=o~#~9rDg6Qe(1VRcJb!^B`L$uI^U|+OGDfQjLyYupKC%quAc5jpR;qa=?A$YZd3&Vs~q!0y{UFMd& znH>#$Wy#b;TX1EKF|X;VOjXIhQ!A>cd;_hg3Il@f7#K>1Z+Whx%bpKkKzAr`6U?jp z{?x?d1kBqLvdJIm<{T#4;dkRl!BMohXFB%=nJ@#pBjZc5c^xF(;^uRZlds ze>I!Zp_vmjoq+z5)UgyaiolB*3vVgxf_mEB8son_i4X^4rC{_0(vw5#Oy`CcG=e35 z!X%S`YRM@rrN_})0zHjcv9)wr8Ze&+Z(*a(Xi=3Ds=)7CciBMG$zVQV=KA)rxFjdJ zTF5j?o7A5%?V9>0>~J4HoMHJU8W!Jc(mr89oyHbhIZ;7mCkPSTr>f6_YpPIHudzYs z#S&NbooHK5CuU!H^0&w-2j#2&I>)U<6S<6QBBe~8itX2Pwkoxq|AOPcy(sbd!6-e= zEnK0$oI9D2NdwuXgqvR`jQ@pbfdL&!=!9`b8-bs}^Qd9eFFp;{SR-Ty-m^m9pdHjK zoehtN!>vAawmzS1pqZS$5mXs&DrPkzweEo9SrD-cBX3p2rIoZN;3c0ZKhx;t0 z8Y@N|6Wf(5?L*)#2SkjPz|;l8Boj^PFH=KUM3Uv!&Nx?CE}v$aw=s>Unh%W`4#+*5 zZrIG{sUjgb)E=`s=V=^Eu@VxOQ{*&b2CiU$uTO|!*?f4lcbyA+kHxp-T`pV60@fFy zW8q2CAXvhM*-580DIO>~_sv^9SzZ0Aia zg6R&D0++oZT!n{R)3iO&Y=Vm$4@zPFl8?`sT}f)y&pz)j0M_S+e1!NMnF6CUV4=lv zVrpW7Bbbbk!;s`tqyK!IWx7*gLKYoyi-C{%@@QyCe!jK& zG`j!MKH%RHq56Fo3r>UaU}$xiRHV$yb|;vAh?b{Gq4vcuT5bM{50x~qSqN-gn);pmgOuHue= zNC>9jN%+Q@-j|@+ica6Krq)mm{#-mX+mB(gS}6ICOYHB!~umbH9F@6sRTpjB6t^85K_zQtJ%-|39xN;aIs$;2iZ+L zf)|vqZqcLKe<>mS=M2oQK!>7fU*FFV?{z0tDoF@0CUB>Os#VQZlP7n?fovY|VP zL}kHlt}BF|RpB;hR&boJ$P{W}kX=Mac8dJU&O+A$1P!B74GrzLipFet2KZjno9D}A zllo7O!n?m@7RDCbli!2iYa&VAq5Hq zI`l@|8Og7oF-O%U|9*6j^OKpdW#9a@o71m448{4WMsX_x7Zp9$`#&vX!UaqJUs`a!P63;A9m z04l=SMIG;~L&3@v_gFa9(81j0$CohcN$i^_zdjFB_wt@>1Z23dk3S404B*7@cy-D0 ziX{{8Fw$*(|7<>}J24rCnatt;^Yt~wAH4fVGbtC$!?c^qi&ka$x}fTomzp=vV5es(t1F2mlcpYnbI$e%Ci8tRJ{j9XuSPP(q+5S z%C7-Lf8a3uEJZ-=(=|O5P8a0LTjHs2+LRRD2+Q3k8Jq30BPsP6BhQuRu1?Zs#l)iy z#kTymHSDm${94->x6DB)8G?eFvL@BxrT+}I!cC)oYUi8lioAF6mPIaGZF5^ThJgLf z7w*3~-RM6~V*h~*VrKvE_lbtJ01lg6a6h?*##bPEFl?1(;|_z@qT!{l!7ZB`SM`JT zP)l0pG2HGJynv6}cyHOODe2#CYkpAG|3-KL66&b6c9;4`pWEj)59gV3)PgY&KTAFr zsF4VkU1;AJz6+kiwRbMh?2~2kx+pWZC+n}(ac*;V1e|xO2$F;{E9las^6+U4A^mj0 zrXx|#gybyirh`XunhA*0+S~DV+22SRex+;(zlnjh>6RM(xpBO)5bZS}eAZt4;aJ*zXs8~-n@&=bqJ3)cY(s!`LPof*_^PDF z=^NiJC#OoCL2cKMX2Kwr=_(6lmUXO7)w?^#^tYVzSteO2+Jk{SI~#cgqz&w=ZfHmG zIDxlbB8LK>LF}0{a{)|#Q<#$r&%F7@(;J5#l~-ZZ$5JJ=k5zKCVZ#u=bWG?B0=kb< z-PY8IxM`aWc^8}}!$eE?0VMZFJ&$}C=h6XB``1SoPtHq%=esexdhryet3@8)<9c^j z#eZMVn+FWQe}M+s=OcJ)*Hl=(wJ$ce;Ac_pEBLK|rD! zPPwt5sbT)7%O-FB+^sj@{lw;LlmXI(n7IG=^EW~%8W_B=j9Bmpz%y0wtUttw#vntO z*z>E+4K(dwQx>H{-f_{tjUxIYM)QTGNr7+Mi5eUXJjL~e4doXBaYmC=Apwlvtu`f% zq_8D4S=8MhS7XKV1H!^d1HCWH!v+1|Xy%_hH)D2v|AbzEq;vc(;nH_^`QdU(IY89l=piJIVF`%!rbZk!*M&N|2k zu=I%OArdTfE=Ur(e!FA#-M3wL)I5l%s-5R{-1Vv40EiFFbf7<%rl z2(z0>^0K)<@zT@;%P&AiOVE&4DfABeC$1WiDPa*5_weH`A;-+O3DeR|{Ar_Z6$m#| znZ2aDyscMoV|@&LSYA!Tt9j{Sgc~s1W?XkZ-=KM!=>~#GVeWtOrA`q@9bcI$EH1X5 zcCN1?$~odTtqy@a1xOKGum^@5Y!8<{sFk8twe`^e_LYz39O}0ands_~RK2PhMxKt0 zQ8J2mSIP*5!Yw(2gYFZmgMAJqy(?brKU?V1)spXWe-s|kaw8)D(v>zH@OmOEbaJU`DTH9rAR94aMZPZDWudGH+;}Z<0ky~{Il>yW=RyexZ(X~iSqs)zKmHv4R7ZU6fnAl z#?Hqh(jc(b1%{7}@7ips8%0-{qq=%KVAt^$#z*aumwe5be{ z@5kSpt#yvnS{5gtH+*r@Z5nw;qxuC|9i#z0+j$cqkQPpl0u0~->5Rg0MtCEB{OG)!g-gppR?Cfk=! zb4kJu#63I3tx$Goh?%pQ!#S3-KtVnCKZ0m4i|ODR$ifvwnL^eazK6mm!E*F{ysuA z0y(j&Q$*kvn0bC-2;!&NDw@lsjUj<~EWYshdCLrG7AuNMZ<5JkK2&?M=1SJ0|mq3HF2B^~&0y`K&4Nb$6R{e5XD;K-@k% ztP&@m$^+k|Vt%E2?bTj@`VMgY7uKx!@7hq%p2M)|9pq<5etW*DJ+ql()EJj;h{}ns zm^MpQh)>X6A4t^ZceZ(dRluO-kN)kZzJt7N*`9=@@l$Ryw6QjPkX9*q!mNuJsw+8~ zF7{=hG0oL=s;OXL-v$~2T~=OkdsWK1+m9+TS#S-kmmK5xKlb425%%&AE2B$A=Z{C9uE%`FLNWW-a?iBrRpL<5UfR z*+WnJ4DBOVHLT@An2T)mvvmuWA&A&COSEmZT57$V=xF3Z;$$2#LZ2vg|7)q_=$US{ z8Z+bB7qSwR==)!J%eet;26=7`M=5T54Q-29uogXK&z57af zt1NwEUMV<3l_t&K$H_gSDn{vVFqvQ)^#j`Y*mDn34?)nbN`f3*2qB`ShdIAaP^- zPSdZ3ecm2&`F;cE2lwfX&rp@%nY_O<=DIbbJ!1Ybpw%tNXjYcAP?SrCOCTF#SNPTD z5wqC-c$oD}mEE7trY60c%);;)MGxgBdDKl=fGxQj`4?E)p-4`> zLzZ{WmDcqn92s-1Pnc9m8X*TH3k9cwLEw!nn;mdatuSfjrpW*ZuUWYNxwZWLHvr( zYugcSOYH)`=tzNdMbMz)xl|F&*1`Txp0S%EF3*$92ogx1eHXD-!I)jzomXO#84_+` z`2hZeQp&<&U;Ek(qgAo0H_nq!B^qrZ*-GoK?zUD&4jsEaaELlN`1XV<;Z~EDaH|TE zEMYULu10EgE4da@HRl?9_V>tObbw-vPhf0V7IXfF3hWcYMqh~jp2@T&T-zzU+$=1i z>mHZ{q{3Hz;VvqdarwSjGt>;x2VV{z4u9x|U*G-w00~$!hR7fy9w5|vo~!5J(NI`% zFqF^=#Y&6i7taDAQ%$G3yzj$DN}e6c-YR^a0<}i(oLK)Mga311^_mhJht$lIN)1KS!F0xddp(arf)Cu z%ky?tRS2*N31(5M|6DKv17DI*+-DLBL&#W(9K7yUw}T3zR8 zk#RD5(M1GORSGZI3(xi!JeIJ95b4^++*v`8He}v@`*~BcfPyLCzBYYM1t_{`2o;P4 z6^OCfDMKmi)ZP(msHd*1aqq%bi@EYj2|A*6E}H5T1>|RU#~%O*hbkCl*UVDnHFYt7 zR$$oCnN{451ZA@%s%5)5tWu>~)wEMIMekY&mtxdO6gNCDtl`+tee%_uf~M}D@fawL zWNl7-Ey}b?oUgH(t+DPpl7FvuT}{^h;^lB0N^5Ut?Z*lxJazE7+ykVBv}Y zVfSg?^%T?&MWuwX665JJPN&&d4q?ux;?tRqjE{tvD`M|jkARmmi6;mKioC0;NJwX! z^P!OzF})8_(yk%-5LCgYo8ysLONJHuhe(AHgSg0S%l~!u1S`l%AT%k_0K3=?5G_fJ zD`VOH;#Ip*O;T6_6N75M{F4;mm9$VTYp-t~l79=_mM+COZ(!1m=I(W$E1F)oNvnWf zBBP$ZqYH94DX`0+p`N&0i7%Mkm~e<{Sljzt&dpe?^(eEhn0mA6bhz6ywmdV3(~5V? z2UCldUfF9pgqp_MgVNI_(6i@N=I6_x(d|2K&d4akeb#$<9L+;Grfr*rtZNK+9gq3k z5^fOLm>!^8W#DhP_4J_IK!7_t-P>L`n^x2-DfI~sy0j`CV~k{sQT(JzN2ltQG^b((dPUG4G}gB9sw;}EwC&_&XNl6)bOU}W~*jlQf?dQ4guM++S5 zu>!t>9s*|}-XpL6J0e*u#T~QrSReFYBD%tkDvsu;mbM3dRMTnJd!9j9^N!7^P+98M z%)+=sq*Ks12?? zfHLt*<4o<)D4no&w(F*>y<@T8sSit}&LFlMAo2xt9p82oE@x+GG#|`qO%bJof4V~~ z-*M3MOX6pnXyJNhdAy66Y4W4Ya(H2@*FvRD=t-;#20bqtjDzxW1(xR<=Noq z;@xB6k#dsHhM-G2eBF%TLTx=A=7s)9;B`Wvf30=72+w7MGU-P7yf|5Gx6-Qw(H)!s z$;oO~hk|v;6`X}{b#&2CYJ4*t(9i&wZFEL88hz)LV*lxmQY+fmrCWrgzO*`=q&7xn zE%DjmT!otr^pHG{z9rPif%{Kgo-F@9P5-|S77Nq=`ey&*xY)UxI}8k(1Npn_X+%#`})ihp+q+PRkD)WFPFIHhBz-;>FJ zI&dR^Dx&>vSh|I4u4Jf2qnGV>&XU&qPLo=6omdk2v@FfJ2?At>ss^OVj~B|V5IF|Z#;+s%5YjtfUy(=D) z-3jn*@yA(4zMfovLUI5%NlhmAsD)?U~fPMjQ< z1{e;ue+C<%*`0~F>r&fZ1lHPbhkFAXi;O*-`8#{D)mOmdlfVb&jQTH z-6u=CZ9hc6mXL2mayVd~4~w`=5;dOvA|iU`~BggZUmI2AQC`@UURWs=AC z(PTxDtzuPKIx@&YbM$*-Es4KGfXv@x97*Z&cY)<{kGUODzfYw`XN7V4nw!(M46iEa z5v2m9JdtbOxj-XlsVLV?u?Kr@RfqDAKcsYJn{_-iL9vecP?2LyLBKP>V359V4)@@M zu|8$mBVea{J@b`vXBm*MK&krs@9wS=rW83D!8%u0L~B-#6@ zxB2e{7W|n;rEAtzPj@Xv#?&yeQUEO>a8iTECZ0eY+lirPQa+{yKUu0naKTrz|5h!Z z>Gx;khWq=Cb|x%w6attX@Zz~Q69aP^ILP->Eec*|b#5c+qd+Q4U*tTk zKcZ&?~3&kD(bGv%Dhte69a;smdb#-g9jnFQ_z)nrHL%cr7@2p z*nmV%?M)33$0JmHt{em+q-JzcA3Oqyv_oTCWeq_96zx<#5dz6^@6|{fslSzO*>fpa?c~u6_Swylq|m=v=~Cg)w?e zRQ<}l$ww2hl~Ad@5hO^gOhd!Li?6}p;4uSS5h8(EdEF5iAzJM|L%N&?Yr6y$YNE3tV)Ae~_O#)jXSS_u`54&M_U+!+^BkC6_>g!-pR>&)XxGXVmQ zOP=L}8j5eVqbbpU!2H06gKTlVe)d7JEE4HY~c_A z0QY_VG}MU$QSnt^HVV2 zChHYvKOOY%rfXw~H>kG=A{hXQpY#@#Q-ehj%JxXZ4E?MkIM{_!gNEL6u#=sBJ-x&? z^Mr0!M(5gGDcob`?@mx3tmyt79f~v(UrtD2LC5uLmpX*6HfFH8N1tA~Cke_!L~hUF%Qt4Q}H4_!W2oGxkrh@F5WQ!;T!&sBds} z`c`EGuI$rHbhmG;kl4roWqqD+88~f0V)< z6IxymrO`Kgw>P*n>>uDbx+)Y;!h2!^LI*1gY93)W*a>zSKY6DDT=aTLi?x~&zw;97 zWIY(FN(su2thMr;5okyaG%77rt%+<+r;K_`DnzMJRBd4jq)*M@T$cMgBvN(QRnwj& zOg^iUyilqX-d@6fPvT(l8)Qlq+ArFQFFRrx$+Is$nK#B3J6EE z>h+{+QV)VOep9msXjAOLjkx^WH4x#~<$<%FR(h^iJ_+wS%nA6f;vkW9 zp_BptK!75N{_pZX=|X?ro|)2=MKy=_-nD11PLPmAT-@ zTWjPduZv;kh3H`o8|YvY`?;nO0qKlbrq18S7wZbc1R` zqD?E8&r3`Ea(e$E9)zsZY>Zgb5rE1jzh~nYjvN}c9#at)-YR-NPir+ z8kEzO+0NUbakOxDgIzu6U#_2yEjJ(8Ba!^>2twnAVVpXPJPdYsd8ggsgDAQ!<;Jye z7oZfeL}{K>EY-+2c?<_@cuu1JA0R-psFp5M8tl=Sf5Gxyd|$I);15oHCodccZ=NsH z(jHw9fGzI}+}X}+m!$y0-6^r-$i2Y1y{dI7aNLeo@G@0XC2Dn&dg8IETjcY27DU=Hew32FjJA0Nh+NjHTh zB|3m+=gt5S@$d|dG-^K}qyPslLnVWVGknd=((6f&0UBgR^X$x#b?_MWR8Q$WDPlhf z701O!mFL5Zka&r5g{e}um7s($9_k`}ejbqp zSZZKxMFoJ_U#=eS-@v-!@Wx=NwN2?YX@Xr%)y`Y$@7OG}Un{LlpZMe$;omrYZ= zmzvlbJbMmq#eX!cbTbjtj|k?H+4T=P0ar$_G07@4hQHTnv+r2_xm^SbFEzACgOOR? zrh)1VwH7rIiu{{7LaElOosK5{ez(iPIb;9@+rk8_-X z<3`vtpYFHQ>&1&TvaJK3?0}J@>lTRMn|zklg76z7B%AB;Ng-O8)$94qZmaF#7(%oW zfD>p$)Eu2NmlwKI>E>@4RYWgh*TnVaTy|^hz#5vM&5M47RECdP@5<}34PEe^PoC&b z9;RG9oE`~<_+3GV;J1Dl$mrCClNlU6l;e z`0GDgT`Q$mmBn_<;A7Bjr33q{aH4X1V~xz|zGlgO;PZ0s$K#rk5FgS{jYW^9^457f zzSd7g*6n9V_o!sliJ_S>&|l`xBmBV6X>SVP1kdejp#AKTNE%j|(&tWEgJ(y+76?*f6t1R-@ z2%B??OFYiXif@;@R`67q=?gYCi@ETaHvq_plN zr-dpg!u_PLfo8Rh6*l(naY>Wy_LLh7WGHx=$e4cvE@2acUNA`)s5VUGP+WIz3D3Jp zH~v7r%nOTXwi=pN!C(ubS!@mf%)$ipZ6=II#R(Yl<>F^!sckZ9hc@59;4(a2J)@s8 znYP!0m$gmzkW8fMkmgWAdb70AYcU9IVMSuVN?Yh%#(<*JBD zAEEL1&1?@H9OM=AMp#tYf18CPza{Wl8>MjQqMtOi74tT79Vfiik7IFB zo?Tcgd&f`R!)dp6VbH(`yKvkdNUKH2i4rYm1Qd|9QFcOL2i|m^S|LmY zMD^I@`#^y*OOJQLkmR&Lh`w*LbqqFf?&5aRLwXT*Tih0&2Uy5q?sI}&jt8p3G?Ts` zxY8cQ(|PZYv%Jk^kN@zp3@}oISAzUl1P8|W66m!*6o;jAGbB%JA`|5u*dQjwfa>Xg zIamWPfB;U53_Z--MToZ6(T}0=VMjcy$ZOT8g>D?1lQGN9VkkSEb6n2hX)%(M;XYc^ zJr_neQk6pxqBxtUHwmmYo3>y)t+;o@=CrxePk}>EPJQM7)i(Pl^5m>$7WS-Pi7#JTy%Sc{MiWwn{U;MXzebWuc-)86 z=H@;aaPsJvtb!ksHf^&ld;20%5eNNba+f@3u>2!i!qh3Rf$(zA&k#q|XPR>?x9U*k zB=IAzs!^qnXGP){tr0}=$q#&+ZM6w^4At0ICtq^3)0^Y{$0p?scs@v zq=-qOE6sq|WSLO|R&_$}CgG1%rF0Ku_QiK~MP91izLip|$HpGPwvdW;t>B&7Zl3`; ztx&e_JmvQTdLdnSI)1>el(#W;3!VM7gk(lbG<<04Ed-B11aChtWGFa4u6FVDVx2$tjj9QM1yZdWdT}bT4aCpOUb_ zC_vWDti6xCG~bxxR{`))aB65#G~|xVYxwYpd{)znCo@=A(-k<{ysy zJK}5|OtH;tsC;65mW7OTCRb~nLYTKRU6ZO(Ual+Pi{LpciRSek5&#s=+XcqA=IE-U zsJp|2R?HAAL)=ap-}8-o>t9cOc~lv3W*67xXmX1B9HV#uT{YTeWy=SjCLdv38EE_y zy5eH;>$&R-_oNs3nU+3$!U2gs>u6WG;6pD<3mtH|b5ZQzwdTgwJP^X4iKEsiCy|`N`9YHHmcZGN+TT3ja zX&~cH^Yp64Sm&8Tu?31T<(`D^e!#NwKgFHX$aCE;#^z*)pH>*09d8J? ztDH;*3TUPrK9mGVF)Cgm9&0BXFxvtgMBfWpo(t)9zi1ZOgjxV(V$l3=16HaY!|JBo zolhj+jAQGOSjbhRSAb)@?MxOS)H$+2NowwPnzx3@;BV6&vz}^LzK@1%7=oxbQ&$~D87U%g$XQBxmJh9R@cbZSr|yBr7D;rRQo2hT8?^G%;92(dwBr2MWBcNy_M+)$^;_4b zHz>ZDVk%KOA0Z4K!f@S z#fzCv8J-+UZ)53&Y~p4%!au zR@EvD2iEKknhC>oSGqpdhj!2?w9WeuG=87kLW|hFgBqtgS4+b_9PrY^?;}62SD$Ra z_CVSE#rRJ4Ix8$&_Lhr)ADjk&m))?yn&_J5?J1zr@%eo7Jd-#F?bxA2{J=74 zEOW7ZpdM_AhBCQO9M5kw|FfL@Cz6u0%N{`M3@k$#!u80=S9{9oVBM z=Fm(|J9o6k<94I`+2rXtFlsoV-EWLz!((lRBH+#!O*D4yd}5fM>Yrz=7OT?sm)S$`xhxv(+E`Q=k0TzDW1pd|c*=j+t5l0U%K z#060me)$A17xVk}fFmc98penBcOiT~ZIx95wjv7K%xc$E%g)F9j7Cwwz&odiEz6Gf z%~;ci{m}z)Og98Xu{74B-R-4wY>^X2Tf~oJ zHE?mQ19D-Kw~g-0O;z%4U({f^Q3FT%&&KZ&EAZT- zv^svdIG23AOl|$F!%#8HhiKPa+e{&C|YFsEp7JG?alRU6`6Fd$2txt34RUfiXbK2UE$z|0K4^DW3 z^{@Cp2xt$KX84DP_%yIHyxYv@jp1Dd&r3n|trkEr6N!RE^aib6-M92R0r%6^TTBcG z>BZto0XP^6p3q6o<&jVbT7s%9qiQDod4y18W3AiQjJ7N(AFHtkwVc4-3qye0JbJ`(nLTqssWiQevm)9O*vY-0^YwJxN@zn1QQ&4lcuKTO8{Y z)MP+J3#!QZsy4ol*09VrA1bq6(@L(qJNM;Q`g88z@YfBrVG-qKf^8hCyIM z@%^2lBKJqN!nYH;S3|jxpxJkYv@)nMPDhACHH|o9WMt|UlAMjYQn(#>Kw|IH@S`9>KfXvg{6Q6 zJ@k@(|6bNhXgxQoW2>UaLzbT_OmmXC?^LCzko)6Q$2$nSdtE9hAR! zCzMpRMC>F3e^5eJ{|5tLfbi@v+Z$rb9BWMjg0P8|5G_UXtVE`gC$xy>~Y*~ zk4}x-Fbo%S>p7W=`{Uw@7aUlle+8V~CtR}F`&jWkHzBI>3(w->dw5UT(%lIca%ek9 z&y2JMYH75o<4)buK%ik}VNNP^lhSh<)>JK( zy0)&o#b!CQ5Sx9P5Xvgu4850Gy2hd`ur$s1k|j%yG<_f9nYu2yUy9}Gj`g1ZXty`a zBtD7vi259mz5C&(gPjP*;q3}EfX*knzoOd?*tgcdI<{>{J9!BJ{f*l< z=U9PruTcmHPru*8<0T4CHNlund<}3UgVL;d!xe<(Y01Us@Vc-Ev0Fgm-a67^p;L8>{Y`)iKl3$l)KJ3s2z*t+!5#eF5 zG|k}M%be9Fu=-AQJy4-E_$ddv3DAn7rp2VeYUPuSZif z=kfdVQh8UUR0}25^2b$KPB=!z=-AA9DOffwqGuk8icos&Px=^RdVLciDhD8Z7#0u$ z337ygGJ;@q(g%)CPIw}r9oa9!vu>jjFDMO^QdK@sLZU(7Gnsp(sQ=w*lr0uryWBP-}FVGxc( zcaUMJ63*rlX4rKDjq4LxX01r25X&&5Kds_8H>;EV^~HQ8v#|Q|k<|7i2EW7m$}P)1 zFn+e*WCbYk2Y&m}vKv(T^bl&T816c8b^+bRT<18UXY6A3^>s;~%3w-2%1W_d4NrNok)0XtpwK1)!!u4ICTD zX+M@j)j*bEfihn%8W$aGpEiv#m99lXx`=gDm9mC=KL2tn^J=1$>) z9=D{-%mKXLU?{DrC{`;oVKZKdo6x-!E zlP&OgY7Z22z^Z^CecMj+zDZ&Hi3=1&QXelfpnfx4H$(uw=X`tR0q)V>jCTf}&nV%tz`%X9B#*(TR% zVRJXm@dOwS8q2e6&!ScEbOO`1XpuqBxZO^C{TLlS&EmhW7w?wupIO-wa&Go-L|-*N z`KDz0;R>Jnl=+ZKyg{7Bw`IccZ)sq)E){7p&CVNk%^8;k);^3cMVI zQd32#(U?#-GzC0&XIO=GC1b!m9c4mo&#mm)ptL^sF_9TUWqig>rRgfIHW(gW}HxQCj5wfL0WW zt@%@$xB zi?3#^da=T3ul~5p>;?d1gGEWCBvab~Mu*S%6v&gT zRcwz{;16hiG)3H;*tKP}bj)soQL@j|Ade1szr3*4e;rLEQ`ZVPNBKIf^aZKBCdAftOPLGBRowTNiC zB>Th(BJt3&h8PYf$5+pn>0CFyM2}gBL@F!$IB46_OeE`1NVGkf=HvpxNvuouK=HyP z^088bl((O{3RW9|x@sqr?fmF~El1<~i_Qg8>Om0rL-k2Oj!7wj2dTMoUdVMrNg9L} z&s)-^AYyEOVWd4PkclUxtRFeSx7V5&i{uQs5V(mmKQGyt&jcs2EA2f52|-5*|HX2> zy`6mr-d>LG_=&qHE_)SB;t?~Df=xsh^BH+fIfZdHz%EEb8V-bwjSbJecw-cwv?#|H zYN8K-DlZtXtmt1_w^t`3&2e|T6FXj>q1N}oxTq{PtIpydg5n|5AANQ32QuZq2PO+& z*e7wu`2gnm21r#fZ6^?S6C6$!AnYd#!5}AGP`ndTVIJ-po2asiph6BbuLlil6aFRI z)qx5+=3r7k{Yzgb&Ph4Mc}PH1l`t9sm)}Sn^V~A=YBPsnGpEn8E4}>%!dT3~sA)@Q}W3Y&+8wt6Bx7PvF_MF3d+aFV?h}haRmdbtSny zbzea&<1MlKCDX?buM)>3=N3#UZg%_Fiy#gOzM0hf3Jq)*-B@kKyoU1h7P~`dwx1-4 zk04RATOv&Vj|v1<9al%uL&nV$uXRPY$I0vOXL7k%ca;dqK(tNV!-JcBk0g12u!DC^ zTQX;|4`DN*rI4CT)@3=c{1P56c=R=eDEp5l8Bf53LF3llt*Y`l0)2N$ccpa*jEodhw zh;w~rhwhrLIZ|N5dHHemK*5QGLMs$+yEBDKa-6;RIT-ECn*BO1SpEWDY+j2clgD&R zPso6vI0F5YiWywu(mOrPI3-*Z6u;UvsyJEmg7=85#%86(N?Yt=q3k0}q<=~^kBIz6 zE%HASJ?qJsP&h^#LzP9c(i#&C1W!YAc{3fWwa9v*;ZUf~FctpbQRBpy0Z$cA`+%xz z)|RW3fYQDraDxOIV@zNbjY_CO&l3oEfCXOt`^rS!c8A&fixaAUCcUP^Os7(=v`2X0 zm2AUY>3pfwcim+?{0w{wqI%{=XxBmsx2#kpsk5) zH4H`A@wTezQ2%}Drc5A_4|bN5PApgU&j}7^1E&IN-cVTqyH4!a3eG{Zyxp=nQzF_*Uz&H+(XeD z4R}G+cvNc`KlBckn%g~cQikdtVHeL4#!Xi1mY@aNaIo*i+DnH0e8EHV;J8U&J0vQa zG65s_-srSKl;$<#HT5-gmUa5pUEyMy&>fYpy#<&T9xrgpWvb>%ITYbPTvkiYM^|-* zP6$%N1_IGc*&j`mE)1LOX7aWTn7Wz2WAE_%0#=ej*u=PXn%2`XmKhC{R9cHUs!>uf{Xm4PWZmy8 z!QMNrmIKbGbv8Xz#|R;CgrSZ%>)<*NmpS7=7<6^kw}^McN`IoWhZ3QfGb2n{5!QrV zEgXg|>LPJNb7)*bz_flJGVdj(@!mC0ut`_A^HaI zHy!HNFZuyQB@dXvM;HQtghBpb+PvD&3Bix#NRfijc+Fk+fqlbz&9!2M-ntH?_7Hmg zt;m7dC)-emKY*aKV?hKL-MN>0V^1=CMqvH>$Bk<=jw}ST7f$d5{lcxRUJ&^q4KWIt zfIwb&a_F-Z7&T1v2o4Ba{pW7X(!Sx+)&7FWdypdU_oZjK$#>9v7D#Q z5_&+zV5D;JQ-(O$X=G6kXabVU8L;iA0+u`bsMlOu#4>flnYA1`8Meb2BgD~%43(Yc z`~zzh*mn|W`LDL>*l|-0QL5GaZ0^-s-;G!-Mbgt1G}ulNil+~(MA<(2hVN+nP!WWQ zpc-XaRqa9(7J)&@y!ZrzoyEIXD(ngCU#6l;`SM*9u1uGfk z(fAWND@V`fwsnA7kdY`-npormOF7uA!U`uJml{Pm>4u#uy)N)5R$$d3CUtoQ0oimD z)07hV(}pDksaHiIBmsXq(@1pML!vuPqE8&RVOVaah*qHws*J?sjc+i4uuvLH6&EL3 zmg-Cq%$SP>e@aLrT2i?;^O{|yqoa8S|AzD|@RtgM(QqDJL5To1*OI^EKzCZQSVyA6 z4olGgWtk%DdYJG#Y%p2pg@%F%U3@sR_Nz|%NA}z4(TH_{GiJWyiu$@aJoJ2h_e$3b z`^&_qE_{r7hwj$j_~ekM*fZ+@~lBasEuov9;D!9pr6{zV4uRKn}yeobnw+|*Hgv! zj|ECkWSndC15d2F?77ZI1wp74Lqy#+YOD^UMaT$eorqK?a>6 zbmfh;{iFM>v2=YjdGM-wE4WYy_m5v+N+Fh*)PqMjKeh*bZ7M5W@t1g$ywn;R{CwHIWonICGF6z&QbmCbW-hx`QT>4qo}xhH7K4c z6D?>Ypxrwv%~$&^sk~JaK+P$-Nr;$0ILi6<=x1Xbz_z=X!9fTFgIG-*h|E$YFx6hW z^YCMNg4*G`1!hKZ0~Mu-3}@59;n3@dmuA7U(4Fu&7Yp!h8AO_FU4qLWu-!=%b6NCT z(jPSokVlkD-1H|hFZvAYC#!?MhquumZ|8PseH9Qag_tXwoP&>hRAQrE-hO7&eYK1ZNK~%wWc*F zG^ZUm;D=JTF9Wo_^76Pm7b1`5J9H9$7{$=p!D|9sEF9lSHfBm7Dw6aFlf?I z>AGPB8~E-EDXeC{WtFT`FixL@9Dod-*gO3TsX%dASX3F}`5Y`?2 zgBFG@wRumXa05S9iR|8e7kg^MkC+%k>*{VVE1;DS6q0AK903uTh3~ScsPHvMV)Qqk zZXFkk#{F9l^*&66Oq9>A+o&u}Pq#H#@15}wT@^J)WZzx<*ELhMK%YxLmOWttYEaoiAp3o1uNa*s) zECmK>ayxtwKZ?h)!~b*-fBP)-jfnliTE6*#70zaDsjMA}HEOgR885hk@hsO~c!Bq% zIw1$JI>Xq;p|BmLrLL|)Xn~@`r7w#hCkmywC+*Etl9%stt5No`b_xEfKVb>x+bnHN z#zO?l6DB#B-No(~{js#L4{D!)SO`TI{a3lNU}f}bn@X*drgIQ~2q+);J2n^;Q$?JJ zQ`oMkE=gB=TmTb+T-T&ar<26j$e^O^se=6tw8DB3x*YQri{?2%21=L%672R&lY@T^ z?tp7VWF`pEG^~VY7VLv)sj&9%Kk`TxI=}a^W$sQu_m2f1wGxC$;`V(B6{jNinOx_Y zsy152!#VSIFiAtx4m`1lHZ;38@UL3lEVO@&hV+(8Ct0JcwPZO3H&(r`i%j>=+YhS( z;jV5dsy|3)!jqNz=OinX*p=wx+g(WO_RaCPKP{(Zw&&CI_V@Pz9}gTV3~`J-i__k3#bDk*RinehNJ|k+F!QF`BemuF~=|MRW!r{(mPS(<+De$*>QcOfeo0& zA@`)BWTCv^G^8PQ&euY|*p&H(W^86TUN?Nw9wb5I9FUZi2GxMXcRvQZMI$unxTXx6 zlM(!|k?6EI@D7MEx-%s+$q1=yWEP{Ehzt`#g=t}aqf)@!wAF$4wI-yx{GNMJ@5Kc! zUOj(M<%A|ISnb5(V#aGy<-t{&>dpcqGHBRwj+jJWLp$@exs^t+M|hj;8^xUlRwNOk z<<@4NP;W9+d59*Ce*btOMlhmV=%^JKaUg+k8UmXFb^9WVLSt=Tp7Um_wvVB*xhV9a z)Jy2iAu{`N9VsI@aciKLpAb(>;10nUER)2@Y@lnmalD+W7y)q!><;o6XGx6N{FVa} zMa#PdWNuYQ3>tdDXZiUCy@u8tp+ib(iOC1?`bt(ds#Xr(XzzK3wE`pc(WW7tTS(mv zc=7=gaEN@cf#m44vL2Z_bT$Qw+ZsRivErpsSeJbYV2nu6D*%gJ&nJ;0Y zNyd_LTKij-4XFa&Qk37N1uz#MJRfd;=>vLo&4dskDE&`noHSb2UcT`1<)ZaObl!%& zGbkzw70X$RsYujHRxaQdnpq4bHpA1k;@E$M^f!ysOBVcM^uGWN#nj~gHIG>TOIKuN z{~uSmWut4yE{fiL`-lX^8AL|feq(%U-~wzbD>Vr+H^CtjjP4Mt;Bc+M+Wq!CHpgUV zC=LoWbTTzIHa>Q%G+s+h`?PzscXYJB2C5$r$D>WFWTsap9fHkUVNj4gb+1$Ade>>O z)$!H%bhpEO0haedXOTboAs}>HUp!A1Sj0a_j03X0?$}KNsd33?O`+}}`gbu^zJ|7T zP+V;31WBmRy1O~}QcLFGf`1-ix&!Y9Uvi40Kip7OVr|E`{QUe(V-afa&G*dxmHKUk z)b5GqL!6El;GXr@WY~@zaY=6Gxp7{OrgP@a(MH5@pHQbv#W*%k&7m+ZdN4jBwyzyQ zOYXKqGFG;;Q#9%l%Ov&QGw()_Q@&kn=*v8Ou$;ekTe)VIeE<@+jqE^7Xulp&0qc|X zOUI&Z$A9(cH5m$uS)9>v%Wsg#Zpk*J^O~Eo^fxviPHaB0ucX>8%AWc2)wh9rIrg}} z@N>Svk|qKp#iSI6#vZPLsc|X~_SiKSo{F2XC_kUj>eP7x1njpa`C85Fp_)@d8?%%MpJO2z}Fay}{+*vuP zMIO8v6fD{`80S9dW=jWrIh@G{?Fit^5_?&I2rv$txKlbeq+`~-1Kwye#?0v2q%EmS zWVEh$6+ zx5KezrU;O!tI-qd0H>CO3SJDg9{^!Y%px>?C^@NNLmYDa88p$>gPLUAtG*v+@qygU zWyt5Tc*fAmL01&{n+DhX#UxyI6lGF{PQ{y@RSDTW;0C zuO2z!g?bDMRWXCF9kf`Z?hLMSAq2oWU*#N6u8aaVm4aEtFqo7q7|5b%P7TAFSS9&} zC6JsvlsqZWZP=pdRqYE#ENx|vEO{dHt9TX=gou>M4BF2(P{b*69dBRD+1^D*D?VfJ zpCMQtI**#B(GX&_k}9f3jXI<(f0)!^@bzlc^%w9keZoHeer|Na0}6E@DnB7#EeuN| zb_ENUqka#hVl=OV09+CD(tdS{Lzj@<+GsMb3G>1JT$n@b)L~AEtkLE&frwh^@B=eK zD0n2FxWFx>G&-Vu@GcT~I?Ss*AJqFn#2z)~5IV&>tG{a=Ydb4t>tCWw*g;0(sIs60 zcxH2x;*aENjL|~#ZjNygFDB=O4uUW#FV1pnjJajWiJ6#U1n0%OY+~te@I-J~RV)rJ zlr!fb=kHt|Iv_FwEE9iL_2J+m!7XpJy*QQiELM|ZC=$-9Em6g0y^uy+9Dy5oiY>}1^8C1?x$)sV1AxDQAk zzVMn8gd8yLd`Q1U;2>S~i-dJ(Ajk%>Ji>+5Ak5#|m%IK;DISYNzhz-KP5qD3Y_}=H z3wh5U9)8@$LMw-h!oeSFPN`he=NRH@ezZ>k*!?g9wDaBaR>gS1Y~o(!JZA3G{H5iT zmrjUW$hsb47aQvSyI~%KbyKLvf$W%6 zGd;ZqtA*A`dEF#LOW2JxCabk0VJ)Ra-#O!wwSEl-Fb7Gsj;^U^fxyYkKxnqb+z^Ms zcxYf_;IH*CyrCHx*^(IRZR8URp4xuJi7`;R*ncMGkYhHT#Iew@ew{Ghy1{(b17NdF zWR6)_mLS#)8i(;8XlpKSc)eY^gU!+j7+&imbgNLZO`B*FbLn9x-0vJ>&zqj&PoZ+W z-y~)UR|fh>Af(_Phk~)xH1hfQd&SjRC|up-ry(U8oCi%0w~pFJ%aLroyv2Ah$~FbU zXnAGdg@}1yU~m6r%=U+UQO+9C<#(m!2gaI5^mAmZ&ksiNTTiQ(kYkdA0-jBiT|Cp`Ms~i6{3&y*0wX;ikDw9t=1>O-TWssO>v;U$^O-9=5Lz$!0bBcc`FT8kRUO z61k|52c-E~XDO>+8+AV~XMQ!ne2W6_w%CzX4uWkm!pw0zJm~ou317CUQAE=>O>jkH zNVDm_#vF~5Z;jN;Qc|3kmqD&Clw-9Pe;chJ-BpuBTx->3Gze$B*kryWrSg?wOSVw| zmQx)h8U3m^yDMIG7SxDh<}%~8%NMN(_ATIPLMtKsh*_&OYye<1Bea+Np0?w0057vF zWbKmo)NfLPF4^d^H4G)&A^&TT&>Mcp6T#cwR_u23bVT&aQ%T0J)o3rHF>3>8G?o|M z=n`(RzhbW7Vn&g`CY$M@sOVa=+^I`l#TPHGs40HN(>dDawcRHJw|A9wYLIuZR~j~f zx-zqrT_N<>pGE}=BNnk~xKvWizR_WO{@1yH+$(_H9)I=-aduyqa-je4o}cMn&tVCx z9*O_BH5a=E&S1R?LqDrMzF|R6c(< zx3sEFQCTyVI*ZrNF}^i~BxJn(P8cO*sFaupcT9c`v_t0}cBvo8UR$*!sAio-ejp?&859wUDtO1ZF-mBP zx*jHI4i$*$eW;4flF<+E)M7%+Te^b2*axB;(zQ2+$W3oVnj_g6FLFtbcO6NP_ z1NSM}hjug7dU>Td5WVbA9O2*enm%WKVbvsO=V0EPuAl`U{@;_q%hg1($}XF^dsEZ# zS)>m*gIoDgEjGt}j?6(Bw5U<+C%PEGz+C4d`?=A%I4`6pbf55BrM?yl2OOiiq<^_F zh^1sk2vHQQxzU16#`3N6fW2Q#1Nx^czA{(LM)*ojRR-*G1#8${4Qy&T9j^pW$qpP+`#hBv8X!Ea6y)_n!Y+Fo*F;=~L zmbAhLA9HWgM!F{eWvIsa&A?^<#4}(zhqBLxvbGuYs`@{EtV=Vf)^Q}>94))gV*)%4 zv2!|CWJa-vEn}_1f2KoWx0W}G#TN6>P!(YV+W1dN2`|;b%&XK7drfhQAUH9c&dnHJ zsB>^ef=Y(5jTC5_MPs(b#W-ScWSFf{;%HDr)yYr#9I5;Tz=7Z}4n%!vko4p5b-*AH z_2Tdi;E6H4WzY0C7qFHxXQWxJY*WD$bz$kk%kYEe)+a;`(qZ30D7UM-bAM!@7qq1U9 zc6<8t?%lcC$iWJe0-0`|a78F)xAg*vB(xU;rXl^S-_X@nQoH)1U=d{aa(3m$CDa?2 znqK1(zRC3m;nEN0=5bWWu7rmy69)n9;ELPtNr0*Y4*JEWecCvT;3Q3EcZ8vtC!_b_ zBm-GxVE-S+zA3n~_FXo%ZF}PUV%xScvCWBXI}_WsZEIrNcFz3IsoHy2?XT*5>tYON7rAT)k}` zYf5YZi)&0T!1F7hm%azh0Jr@Ze{Rnt=;xZ>vCH6MQ0q?`f?Jn!U}xPtUEy2(#83## zY~r%iCk;qS z@j{-~-kcFu@9N_3JXNqtE56RqLV9V{dDa(uZfDOk@f`Qt@7=_)Qy$ncnE}C@7LTI^ zeEys9<$V#JjAH|fBTgXd=AWoJb0>2dzj?I`Wp6ifV%wzHz?WM(eX)nkCw^Zz!)30; zMQ8Fz=F2_HCN-wO5@Rg^K#wqx^nJE5F1NAp%F_@2Gpb>J=kB=u6BKd$lSl_({nt=br2bzNU?VsMaFf*8 zgi zmb{)$NPOa}CJNc~uTuq~4@RjhO`#7CxGaxdosJ}mt*MV^%v8lzaU8M19MN9!xz3-e zimARH)DGz%fM?UeLz~bUia`lb#rNxykUl`#Zn~+{ZE`a1nD+T@-F4&yk+YI}mWb3d zn!CwYlyL@Tg{2)1>fRU6()N9M_h(bt`V(kk{)>dsJdH(-#z=Ou%dJl0CH`_G#we8~ zC`w7vi>7t!y{E@SkF7N{rmqf(cH9Tt6~SF%B`#-Wg&j07ehiF%$2T$Al2EUs9O2qs zbJ_QihZ}V(Edh?nBs;fpo_fy-BClyY##3)Gli~9)HhUHsZLW`4w26F<4V?%xD&|dTpYXZTDiq!P7MM_B-!r|Jud?<0SZWB zw=CA5S6-H|SO8pN8`$OBb)lq|1oaAA8*aSmxfx-O+2ED-@t^hjDh?oDh2H7kg_4!+ z!ulb+{s~@d63(<_m@{}t{}Ye@{>!y z(TZG>3kpwrp*J6NPEFzJ0f`;`o_KKKocN@KC_pAqU1$`+C+XG zZ97vMVJQ4l^$WsYd-PD#&CCIS(85d>>i51l``f#G zlsJP*E44S9XD04&fx45Bns|=8hh`65{Ww7D;u_KDOd^$cXarSs?{jxNH(d@9Xwajr ztiTsuiWzzhBA7YA88eu5!xN4MKeV+C9Zn?v2_%^N>xgTtB5c{jU`DHMb<0I z+w)+4fv`yiCVbZ(1cOZ19K$GsR=?kN2JLR3<7f7mA836Tymc8Qt{ddC0rs}=9H`ba z^zkP=yLk5!!n3mb%+h-lf^}RkI3zG}u20QdC}g;<*{Dye2rRGK6Ljp4INHn`G19w> z1nG*o-+h>d>K-Yv;Iv;?aY$|?idV>5ot(1e{Vq}DBm2l}Fc>%?fz%av-8(q%co7PE zd*zZ_f9Yey#BqFJ?yf;D#a#dJe2g7< zP@EgEXae$eVYJ_=%QpJ_8#^;?;?%)vSR=OQgyweGJgjH(r<0VQGf~hh1(gT|_S=>l zI28_Mv&0cH9=-m}IO<(X&&G!G81O_OX2m$ycES^u8$B2B*~8e*XRL%ja3y&3n*0KX z7cSek#)WDyhkt{NH?70w5QF#rBqz+OEJ}w{{PO9n2-R{=ssZgyW~EBBS}v({!blTRaxD8}&QM0kXs;rY04Ztp;aR?pL?)icAK94s zq<9yY3Z5~7C<6v@Qg~vPLr@pcpyvQ&1q zfnks%Vq#?c&t1gP$(e|gjs3rKH2+3&{9A=+N<-ETj~%Y-x@MMPR_Y@G3X8MR-wr$g z5ZWw;AXrZY1LkV@w`=$MooZ#+)-`I{eYuuF58*f*Ehn2Q+RBDES;gv}45uffbFW3Y zoEJ|Q#e?W(kcWrWfiNwl5I&aj67=Vo1bY*S*bj(Ur!&@G`m*zzqyrOo+BPecGj}Sc zjRBkmdwEic%Pbm)fgAyaV|dz^bO;cQ7;1%hm7&mJGPYju0htg)McRJFzS?EdA5jFs ziZU|=%;i*TUZN4>;V_0gmLgecBH+lQSSkJWOuZ=4w<=tfrLi=$wkbiAb`a1#+z=}MO!BvF?aq#+I(R1pglQZPj=L_$(2!iODjZl#F4_Wl4g6g6C7;t(mn zp@d}&6KTk)0u zg!>V58st34`_h=vXs-h0+4O+Cf-+7BN=6+(3OcSxu#2Q|NUsyh+V~Tx1@1BzXem!L zsRUx2+#vd=<7^mPr7M-vj+PP(9kRTemN_s7%Y`N&iz z`+|Y>-yc@5L1-QFM40_&BhxyjiI{qwzVmhqA>WY60bbvFm zAjd@vwAQ@zul&>a?^*yN9R{~8J>|)9ThA4|`lp6mQ&o!cCG0^XqK~zU@-W!SQ}QMfplp=^E?aTzUX~eM=vpaZMjt%AaIY^6NLs-&mZ#T1&rJ zE9cN57*5ClB9BOB0*hnX%ce!ur*uA(){hQa=rhfen!6R(62vT&qwDtr#Y_X*nrV|w z^UJiB-*Dv0*yeiI`XQD-!akY{{hP`l#FAvQL9MHHCKAo^o1|l|(>=`R5{4`&GVJrQ zr$p5ooeP>Be_Y$FEqNP&bse%wyYA4^^@$Fcp~u!y9hK2KZ)q5QNG!IT85aLw8+uz{^cCxCk+!NeOY@+VW8ns~rQ66jMikcjGdA9D`rwX6k4O^~^b9aft_x9ITCS9G?Hc3z2* zel)tpOj8F>E8>Ty;8`tLRZO~|>;{l1_0`;92O~PLd2{0N7N1uq>#f9~UNnS*l6H$< zeplR@h>ro}yJjvp`Tn40QK7o}fjJTI=6Q2Q*r*s^T|?CSIMPw`KEI?9}aq}KsVAXO^@@bC@7j%F6)pIlhm!DwemYde-R#FjQljUFzefvQN&Ax_|})qYo;h-%~ijvLPaYK1!%(+WTV7hZNLVC~nxB6TX9g^H@!=nBnvm&;gpiIhuuUaEfjT+g zv0PNax@gBk10tR*KdHlOOi>`ekYi@*Z~A29j9XLmKuyWN!1r7C8t*xIk=lI^+SGJo zdf-j%`CR*V@iqFvnC)}3HD6UQ9)LtSatZ_f(wa-lgF`K3z!Z2Qe}I-avDARGka5@s zCX+N0m4j#Rb=2?pU~Yg!ZsEEtoG!4gMpfP4Id+o-(4jH&m8lp<1dJcq5>yqMQr=ulwWC2zea^h?UD;pZ>yu=<-+`A*t)=3u?k-N9A%_>}AIOgH-4YZd!>m2qIRvw--)eLzd?FwdG8(?enPK)R3=~m!|w?rxA94ycH z=kpqd{UJK(tsOz+*PW@M5)^!hMAn6?wk89_-9PJ zZ2px>=^39Yw{0()kZU}W@Sv3&09VZTf*kk_Z`GP~7G(O<59Mp}7b0$_9|d9pl9uMS z>83B%bv!-15p8tS7qC|kQWzimX1stpk`;OJO66y#?+M4nL+j0bk$sqwea7Jd$6vmp`pm!^L!*ULouQ`>X9Eg|eDGfSaeNtZcrhajoxygfmo~>rgz4 zl9d&Zs9}$`fQE;N)1tsBkF~GC4}^HsnwSMau-|emfF)x?viOLT_QlLMYQX5c`ed|H zMukl{AmCLOhT73vs+>PRl}Cu4Un2;4t>UuTi1@2o5qkKRgJ=VE|Bz%qPwJN6kM!t! z1hkC*hEc$(7ZL0wIJE8N(6z;b=k;iClASVGAa*+ou6~xFuouC{+kcv%v(-W*&=PMp zC94pJLZ8`_%=|1PvXdPZ&GsAA7FZ1LAJBn?@qeDB|BKaUX8*Tm<^O>WXyCMBV6OuiOqgE*--j1f2wvreSrAGgwehO$ zqwV?KFOR&IF<`zxuGb9d?X1eI!W2~>RtYrxKiExc8(W5U{KDCjE#i6=FZNcJjB!G0 zyDjRuNzSeCini(CnQ(Zt^oyVBU4CMSZkebT<*9mfX{{uewX>zk6i_`y#(+&!@@lM` z{wT&68dtGVRId~&pC`-=kNRLZXR5PE$#e--4?dSIf}5wxuZW^#zU5v$wOd6{E0uWB zY$7u1WUlzJ@F4PT2XXK_uWU{M1}<4@?ejyrSu3@e*Ye<9Og%5P*R*a6n-{oXq%rli z9%3D8*O$F$PV2iMY>?!f*{CZ&?~lq5tCSJ3K^#LEd?;b*VX328y=iYUa>c@7D05#u z^Em{_;fo9F!T#~BotYPKv;3*pqw0GQF7Kz%_gJ3I_-7sB4tvM!P;6kLyK-yRx{)&< zp*Ml#s-(MP>g60Q^d86U-O|Yb)K<a@x+LWKq-HHa!&J>1pLL(@YL*S@(ZvnQ*(tGx}Ih)@L{G$eiNymFucs zLr3>m<#_=0#Q?>lf`qK;V`&(y+3AptUkLI7BBM60f)F_i81+dWZW9H?f~GPp`&NWn zYQ%SFb7leLeqInLATZu2U4BnSRLFWYW;3vWrD|`4fTB2ojLaL;B_d*czH?tNMx)rT zLf%*s=w9btHK8DJ?eFw1g09H?SytwRHLi5~QlxyPjLPrwwcqmu5Me9jb{TyWIn9dp zZR}x01#t;9Qq=rV>%J!F0B?hg3A#Gv4%WszuPj4(n{DkK)7aYpJ>Y%L&0sx<$A2lL zGI|DLwMVQznrjm$xOx+LHh^?edOFE=OIq%@n49Jvb^cQjy4BYXb#&X^k|i!8dE=`XAj& zb|a{hs+IimwW)NfC96`!t8Ck7oDg_&o+bSjih{my$lad+FiJpdJ`MmDJs zQ~NoNtJs+S(0Ui(Sz!-s9IX7=HGzq7W^(d*_E0E!iys>>n?EH9`4|)+W?&-))vVWI zTCehopbeZkaDk$hJVaq$-ul!&pUXSBkNEFw4Y%#tuwM?j_3kZ3Vu3N(`x9RXlQ)n| z{|QL`vAl%kFH`@2pZ~u+e5s-Rx4Z=HZwx9@J&2QE8nUEr%h=A{aDiOZo*&q>@vgy& z=pt+uqkX)5IE!SK`~bIF$>Gb{mFurBkGrqC5KnD90D=P62vJSm5J!p#sCos^nawMy zFds=?mWs@ZzGnAi>xuoOR!`po zhyWHv3|eJ<9Ko~T9sVK#^| zBN|J!B{c#^zY?7_jY_lF-hUu3jI2^jty3HVbF(=PTX86N z_>=~q-@U|hbkqu1C)765G}N>bG14#)#fU0zIZ;C|D*Aw@H15f{{6eU=hW?C{f1J~p zAnrY$-&#_*(>*IK=$B?)cdT==BM|QzCEok0k^OGGAZEx95wHmnMS@mX+`^w3XYxxp zGW--I%U@d%r4q%u!l^hv_}=B>?K4@mk?**`-@Q`_Sz?K>HvJj!YlVBwHr!RgFkXZy zADNRFsDp&$AVeHi17J3|hb%~d5Q9OwU;Q(wD4$IsY1`e3u57#rr>pKHiZ`fhUlx;R z|2~7Vnd*%SMy^3GZ#eJ;Rb$mnK~4ys6NdGHlckHW^i@xBK?O|wrx-e9C{kdbCjTJ+ z-6Sm0FgFI%SC1fEaoF2(e$lGnl*lv zRn#b>N@BVtU0=FO z4Lwg{RRbs==2JQ@FvmG+s8&Z5iq8#e&au$Z(6On*XG!b7PaQ7XWWd&+N=TOGd?$ff z>K`N}AhJwBuqs!{Gghr|zZq(sQ?8+>)mbfi1`r=8>-`N&$YAVkAF|x+%3Z~mgX>Nq z9ZIfx5TSVxQk6=+(_6;M^j^qS_BH7f&)4me9Qr^`s0(1gWSz%9l#6Y(I28+1iuUvB zBY3&(+Wl0poGB{f!Zli3XaBsr79Z9TPYIJnUFcre>|xQ3&354oc#>K(QGDTUIE!29 zr4I$7+nBD^$)s8&AkE-dvQM;9^NlbE_7Z4N25Wo;Y{5?cRi}_0{b{_bgB*v znz4R41wDkYH}KC)doQ7=a@ng=3B)6347+IQc&GWa3;iLDjRpF=lqK!3A{*h5^x94q z-sPOQN2{Sw z?1VFDg8fa_+)A1O7wqa|EdW6m&61%z=pwTrtX1RgBnyz>f{F~Mt(Xw=&q{jSL zz1-hkGQ%gZOGsF8q1O0iV~eanf2F`xg&;Y2ujtZ_V=KrEWNvPhydML8Xy`3VzTt?a z^5gG$iwG3LU%sG#$NsP%rfmb3`GGp#=awzYh0KG zyMqNMe2$aB@YoDV45_!w$=I{r1b-;}nIPWq7~%0HJ|?%am5;G}FdoGus?A zcmy8>k!>U7uGVj~6dwtX4H&rl?@L+0FV9Z`TS;I|+B|e=Nlf1(q8fVK`p1#2hkE?8 zSb<`%0+Y>lupFN-O4<)F3W27)k-T7nSGETZwigo6Sz+v5;QZLe zU{r+HH`4c7spAS>bn<06zT&e$Z@o(PbuP_Ltns`M7|6D)PNI1BXN4t1sl7V;dLw9i z6M(rk_<$V7z>8t>&SQz7E|N*Ag~E-I-Xd+&Uh-e6a-QhsT6>x@$eeaL$V4#3Bl1fbP#iSznSS`AvCI*u^EHl~W7@9`;zm zl>z0oa696LAgQo*%n=H#OoYPGhMZOu zE?gkob~hC1YpRlVeRLXoVf-~|V=283l*!^1RJkEnlGk`#nC+{4`Vt$IHng;3XO$w@ zi*g6|Y&DgeUXE&c#tBLAjS-NF1j6QWl*w*Z1pybR4FlQ^RT&;lO&~sg=O*LbpPu&F zy2=@jBZ$e=5pE(@9T07>9x1n_Ad~w;dfa~1czVFG?AwT*{-ziYSL^l)8u=ytD3_r_ zNPT6`m?gT4g}VCc>#0FVdABdyMFw_VXj*NSmF?h8ccglD^#`YR*K%n>vsf?9J}?{t zHzObCyAr~PzM2Mu@fA_Fd#B1soYvz_;<^RNBau?i5N0UMXR@H!XcqW?5WO2haNP?| zP=8d2wjBlf;398+miBHMZ$L7hyX(@*tz%?LQjx|ch2o2sNGj4ZDmIQ_=AM_j)Y7RU zZ5prkV-Xi8>5Y2(H`Od1!kyjK@V<917;Lg2qI#N2kxX}zGapNmHD=oKwLi;t#poXW0jHGd7Dy~)#TwCYekp?4p(dN+?IuXnPKXd$lx8^Uom z8E!0E*eGWj`mh$&n=`kT1yEG9!jSk5w}HCsqg%cIDS%y`Wo%uRI;nO!Cy~EzB&7$d z7@v31Qjaa*uLtQ@{g_R3SKZHP5WiF5Z(M1=oQKt+&g^%dSE>FTcKw!D4|2_~`)jW7 zZm;W1@nj!ypa1U>CZqyO~FYsUKTSgAK-*9Sxy z_?&+Pr@#I5|Epk(iH-4J2h|m6NXHib&1`wD5pcqe!@#&diW{Kd#8)40kuiV5tGX*-cep-iOriER-M?e zX5VImYp?DrM(5eS)v!KzJep8np%QqV15(Yvik)v{0~yZ3;+tWm*so~*+;hytE-HsQqu6TdZ4xgLQ^ko zTU5QNm|5nq>;k3#RJmBtYSE`#0-?HoA>O4`KxMU+t1a$xMG~fX#$DF|BLbb$<9wtz zh=&2zc>UZt({V>NJ(r=7$>c{KGNlB$%qdJqpctvtka;gbL#~xeTAV{6wGK$ z;?+%2;4p7&&E(Ygb*fc{UfJ$zQP_Rp)~k_D)7ZD&I{L|Ci^paK8eoAnKTVVU*kA9> z&h&043=w1e&A##&MCHJW6Jp!vh7o9oMFT7>7STMw#^$AWc@ePR7=l??u^ylvV*)8@ zV2e0@YisW40p;j?q4jYSTED|935FdoQqEh>8CF&-4cNIX;@!3A^p`Ek4xqlBsz>ge zcvX}D2W`hFg`$Y8yk75|1YE; z>Yj&zel<=M8h9V1Wkfxuu7{mRH78WC8)N@jN#ZBA#*P%^d4E8ApdK8f=IVMXEJJoT zmhhyeM(wSfS2$|X_)Yc9(=R5hPB?^na~?zlWxQc45`Ji#&sVdtpS}$beRo*fw1hpK z^C|f4)vute>b$G>6{7FD>r2APQx`d9ub~+YE@867LyTzK@;o8D)Qpu zah9BI1bn1gEZe2Fj}2^@F1*VPzl%e$J{B(~~d~p~txU74kOxmC6zYsx!iHcWmC+jrKnf6}mekRxtwtd-@+6~N3_>>A zE`gMIio4xLG)DFgJpPFZE>Z);3COeJ{I0%TG&a@-{=13ic}^9a{_usE9qEyrsjdL2 z@GQmIolgw$oLzCvm(0YRKe;auB_D09Q%RG_-}69%`nl3m{&pR_B8CSIye;1Q z%rgReB$5F93qJDK=zwYmW&OSYHzr|yr5vdWKLLm8GlxKm!MXzx!ALlw1YC6^H4*v>zvSz9cq27VH7tsc?Q;v~ zYbzugg?Vb7GM@5HiJ;m^>O@hl@5c;OFZ16Q1W z^CmwkEC3yCPh>_g+~GGhB0a|1=$BLeh(hXBQsB3Pq(w2|SEf5u)g}4%JDFaBRag_i zb~}}1G{f^o?&>@(Qg0fa5`V28Oj>kpn3wtdlfD`9oso?$d+``mLgTG#8B(x>T?M9< zBr(jz9xh)JDwIB$rz#I>v7*HNki`Xt>Rek{L4z&cJEa+95dNCYpvGAP3YSANy?4HA z+VP5+jHQI}PxmF3fAXHPvHokp9yM|eKCFpu^D~o?eqo@ zDj~Bv$JS$}(@;4yPujSC&BAHOR9L3h#+S!eD}7f96Fg?*DZx03_HNI6oHDU&WQ2r{ z0~Tq1RAhRTmG?27R>^L4-sPCEY{xp5eWpm#oHXBzNs*m44>fjxc8X}Cv8Y<5epV?- zd%1fqsE#rY(+o{hwTiBpiG!#A)v4m>QC;oIP{Tkk-IKPeiS!3@yQC`lbE8ixD{jWp znA)6chK;I!$zo&TVq>>7O|FHC=)^ws2AOQefsge`L=x2c@4!Ebs06K{MQg0399xl2 zY=}Zib$@#M=3~Qa<_FLD1tXd02CVyal`LSSi_seu`-Ax2x(a}vOZAluZBJA zyzw7MA3b-%J17r~@b7KJjBUi7S-5-lU$q-ZkB-9jDY*R&8%V1gNNXEN8p#9x8%PgM z!e~L;jsvKp@Z7GjS2v6E0o2EG3qm!enK;IDT{f^W@KWANL|3LZFFpj8ftrM;swo2| z#0$UhSLF4%yI)}2K8cz7#>F4|aOtLCeqMCK~GB$zYkzW2ZPBg7`Z`-?G zX`HL?;Wdyp+GNI`$s3PUx9i&(4!u{oelP4=a}B^rNt*)#)x2iTO<13-d-hq!H&0`V zo_@bEIVLXus)sX@hNysmaT3=n!0Gbs?m5ycl;u??{^wtI?#yj!D>ZSTODIQJa>7N{ z>vU{B)>8%qg~zTZV@X7;TFTUoM%xZYcTK#zqPYXEJHP!YI`^(RLzdH@#6}mR@u;K1 zyUzN=3wzf~FJXJ7UEYuPzApH2y>Pr4sR>lS-!g!eH!1%z)kfd!iS+5|vtptYru3VH zx*I~(6FmjAre8=*X02phyt~<8ClrV|<>4;r)65 z(sG$I$w}#ux&J&b3UIJ;)}dvszSL6v#??5N6@Ak4$u$tbga;UZT~_J59gNTj1_u>S z$ljNhv{EblD$(966QJtKNUItOPRLy$b-3Iq0{f^Yon2*q!G}ID!*mx7FDd)83P(v; zov*gGHTxy|{VF0oXP_y?cCT^Z3{x_GD?@0a{mR1(c|fI^l^j&KNp-|Sm>4{9gdetk z&9koR^5S)NHOQY^!`9&>m#iD_)N^7{;`+?Eia^g=_i4ncpa%kS%$P8@kg7zu*MBKw zr4AWu9=891&?d_B;-8@GpJKq7*ct!z8b#CJ+tq)d?7D{W$p||P{meuf+;bJ9Lo}k0 z4y7cunW~l91~yq#J-=Sk*V~LkSo6+uL3J%#1R+$|@hCHO(3&5$;kx=S5#7}pS)h4j zR$f9eC>?6oTQ-Nt!{1S0m>KGWRx)e>P5kk_nFGPS zCbJ4~=Gkf}ikp!*Nq9Z#iyq!eU*s=KmcO{fiWE4f?4-LA`02)8v%MKpuhv_U0ep{m zt>4pJDZMBRI2d8ktN`T&r#_*%L5)Y=mhFNHYO#wgXPy!mNZp2wF344QsWZ@>kkZF8 zH<*4LpP8T4yf>|b8-tjITxFHJ2Yz_}k^ zj*6$c1J)Vc&y$~!Zv|Y~8J7UN55ME_c8>8_k|Ni+| zE8GepEbN0&#leILwYdP}5RampdcRf9TkI<0(%|$P0t8VXqUwCqlCTM0jPPZdo1zgd zHd&n}W}7Lu_HPjfOM{k3^_QIvEG;j^D!XdN`vri@5lFPi+&C9UF4$h+TArMVHV(;y zKAiG<2wCu=fm?N#I=7Ype{qqLsu!+@pA^*;9v92C%DGJ@?%rbOiU<0Pc@O;ZuRnrp zb;KkfEUpsA)H%4}y?Tk}@UfGEYJd#X!ea&~TwAF~+k&@-Aqgut%LGX*@cz2eh@W1C z(4B^~qFi=>P%Y}?w#qTnc1%}lw*J7UECB zdqc4U#g?IWC#0umCC>W4;}Suq9N}lYX&m4bDMF}FqnJ~{YHMEtPCTo*iicJoNQSwx z0uTspmNO{i8gfNVNe|hUnT(E=s8ujYDse+P?+N$Syrkd~S$}ljvj^DSRVvr5(`+1NekM(ES-)RF%UbN<5 zt+%+IQ>^Z^xn*dNOn*$xek1#=f=c==b*L%-nwrs0-X;*GCggTEbn&dFGZY zX&--)s2sYs&+LIy>;d5iI1q900-b`TGcw3M#rW6K7ynpi)n;q9-XQ=l#0Ua!rl^zg zKQVTp?Q(6OtLZ{1p zG7rA;r6Fe1jDsM~BSo;kiIGwG@cqULS;pG=}8tC?<<0PywE&{tZGI$lndbKS}r*;4hKk zSp!$KW)1n?!7r|zuN=v>h9sKX41rUTG19c$?4s{ffhgK!3q%ZXZL9_qQaAb5Lf*Zl zNIYm09m-6vzYaFF3^4zusmWdx1ZH*Il^%TB1CU~fu|@E6FZDS6-jV%tB6-S31pIOT zJlDKFwX|*H)Cm8N!1qs@7ZWGrzx66~sY~1K|GzujDv%W@6KO&|E!~>%8W}i@HKDc} zgM|Vk3O;I_NR5bH#@8Ey===}r`aL!q`NGlkUG{55EFLh!o6U>N$BVrXF~NxWw81`4 z)E!0J?dRu^tO$3Zb8>!~C{Zc-8;o~{Z`E6J|-LZMbAbSr8HG2>iCu7vG;LRQIM&g4E>D-o-LdvfY+p8^ zSc!bBxu8z6FwcN{WMtD8E=?ioaj(pCP$n`l$&75;5sha9!_fmQ_6D8H`I@hEQtNdly{1}LWMNqDyKL?<>DhTqP@77sr)Z5kjrkoLYQIvg7K|ijj7kK z(>oZJPNp=|bgr>an7`ck@9bYSJY+_N<+0mn>zHZoJW9v7YM5)PB*;KOT$zuOTAYD21x-XWbTU68ll2C; z5^^IoFKZG+kSEa(({2p6+#6yQ#moLq zEp$U_ZWkqzZg@CHypl85>*kNzkm~yIJ^fuLi8K;6bZ{U!n_*-82J*c7vgEXLiV~$S zzL-a4^vxR)$O*HqEUqAO`ptp19_QVpE;ayv2J}JOEAl6ji;+KFPWHpd5@FyA{ZyoQ z-U1Mvy+oQe{srO{iy`|@bMG%p^}pp5PL_WiojCP(736PKweR2P#EZx#0kXum;z&NS zwujkV3I4quKdZ=qlvcgn#`)~R=<~0~-@9;4^J36@UR(pc2?M+KN9=@nQtpV^H(wr) zXIE!O9b```rS(+zSFV5UzEO#j6D-KZ4hNg6TQy${rll2$wt8;fJ)fUfms4&I%4-ms@aODu4>WReJ6-hBPxRk1PFy58Ukq9q)Y)gz*C^jqm$x0i^F*+bgoX ze4IYK`QZj?Kni65a#YI)5&F+&T#MYyt&_8Gib@I52Crhvx6`TV2Z&G85;Ii$r%Z{V zcVXTu3rmXAU0A$BAF{$Xh>+li=Y4lPTRYqGYJ?7-AF$uM5JGAZt*zK7>0?wH%J^Vl zLI=$5Yo=v{{o%|T5FQB)`YK0+@6`Zw4FP2Uo7xFt#&vt~DN@zQt}Cvw5Od|(h2l|T z?ZC9frsl*sTVuTcraytecgNvYrKW-s+pbzI(C*N7v2FAfZg!vC%_Zmw%i<;ITsta+ z)KPw~qilC?*}|1)X7QH*U;*LCew%Tm?lUiQzJaM#ou*x)#i2 z)#Dvr;=M&s_!3-!@erzYl>xX>JcAH+al<&2PGVbY&{2R{0?APn!D1`uQc^r%P`5yiL=kgo`$kp%HQ`DTvF6N^MtAZG4|QQLIiR7fty{EJ<#F9XZJjxfP z(O>i``P5+aZ?~eb8N#soBGvf5l6~7}fxFA?;P9TUa;=Cf-ZeSqVVYehYi5|xlcl+T zcx5am8znTON&gRH{}iNI*F|BXY1=j{ZQHhO`%PBbw(Y94ZQHhOJF}~!JNk4)e{tf! z+L!BU&k<{`XN=*4UGlpf=Eq8YOeD=c%41RAX{@*J!2p%PXN@x3F| z43_t1(BEpek7?3)Gxv`P!%x3EAtr_%gR2mZ3wIU>(!V~oo2}nb5+0ZbHBHQ@jvpOl zWgAhdSmKfaM!Y9eWUyKj)HZb=;*5_?Fu21LSl$`z(=zTI1N(1d-Q~tdO-CcUpDa zUDz!+a(YTHm0ouHRf>MY$ip$>vfv$UF`w)4LWu(p=%ndx&pBG-IXz2B2N{K0!^U6?DC4#&1-TRR_EpSyb+#1FKY5ZVtqpN_6jnuI!FsTt?qinPF=?2 zF|l*jUwwN+t2xzE0Mh>)h`jOao+lv;8II=kppuRIQ0|J8xiw*@nJe(Vq#!{)gzZMt z3^K5d|Kye|c24oH`^UTwo%u8P_JkY%!Hf;{akpl4$cNj0IIp{5^c0vcLZDWIw~l^w zg|J|MFxGG|I=Eg;ErO-^MhST|V;r(h&|s_zV^f<;cWlb?c5#2=*yn!*`!9`W|1V^M zi~WD*u&1ylVmH`tuWJ~ifl>mRQoUrvTqGB46G-T0O*drfp-iJXFn-CzQq?5&+;mdO z;M$>_%oBjYhYjp?ausLpOf7w`tj(-6OjHnMTi9cK+4)_BvyLWbQ4wMx&t2^75Y5R#JN$#K@53t8h4vTfQ}T!sF>e4Zc9C=M zkb&fNStVcQGpRHJusKug4i9pFbOj z-KF2Mlvi?SEnj=CSFWDJ8oL^G%{PnPtez3_RhPcRRBrWNNJ|i39@3Hgq52N@=0fEKxQz+I0{j;7Jc-F znruWNYv}JoNcB4(FZpKWS-ep>pAX2l96>-9ENn6-+QIo#-<&62W~|^&iKd9p-K6Os zo=TtMe%F|-^~HOVK5mP|;(JU2cIP9h`FBA6Hl1x!8+3{S53EwpMH=;+2RTiPC>;k% zz?ya$2Ace}SUO2y=U2YdtD3j%+oF??^@^bA%qh;BBt|(~f9<`G`t!K}fj=F(| zPCkvc4EJ2H)5lD4yI>(DL7>7U-lM`i5Tfs2q{1}nv{O7JMWli<1iqPU)w7aS*t)Qo zMa#!t!=u2kQdr}G{%eEQQW;Y9qS7@!lXQVEI5RBO3x9$+mp`Do4I`ecPI z5gSEbHlO3xw+w~VEOLkhu9MbJ0f9cAgN0dW?SSP;+d)Tq5y}*&nM)}Y2aW9lb1oXQ z_>lBhV@82!;aoUekraX)AE*!@$@>fFuN{fJ_&c{d*Y3pmVDt%KLm30B^jsI&p1SP<#2`TTonnnKL*D zk&s^$B66)qm&TCqv6IOmwxxn?MkKO7`sVx(>DL;=@JcW_kc^^K3AIY9+MrXpjCL^;u1S z%)unxfc?r>UM$u1QWS?Pa&{@q{aa-Qzn!cqSTIPPt&H21)&{K~{Gg|UKePJpPj z9+csYaJ~s9y+&?BfQO+1$k=ESV{`65hG6GX!`emvC5%~3pML~m0%Nh7et0eKLE--3 z6XSJky9?4FCnc_%`>B_+cI}jATHK%zI6#Qh63YaYkq21{1cViUQOAz>8qx4>HDO&;^!cYTv8iLH*cSkmj%133k{?i{$~GkhJfkGn88Rv2PNa6PrQ1 znuIxxhBaJ3x2q2U&WqmRy~&`FpggTW^PL1ehhw+Z$OE>EQmMEBO99ltc$@5pTU=KA zhD!uWT+KKF>0xkdX-JD2M6EEEO`Y#RASc!+;M;YDwn}e;o{#v(pvtKsYgzD3nHt-z z69gIROXvEFJjt87szP9b1FiCSbgpuJEC4SQi z9NyB66G-%uF^^c0ZF6_Jc~SQd{VTMYO6re2I0TSq{C z3a22d0gH^@5^?JnxM0qMq_c_hP<8WA3G=LZs~c#A4s?cRmuC<}Irg$edy$*iGFskd zQh{9gI{Yw7Y@IU_Qm>jfi2S}nlXXi=aM=WVQ1Iltu|mIF_w2aq?dWzt8j{0C?Aq3} z)n}74d{i*&q4o7o9aeaG&~Q> z9d&8j{rVwLH#?)QZ2&el7XoSHw`bg05fMK*_DQeWxc7JdBn9sk9s6>VKWiJ}Jj1>j zz+OhZ@oRv6&`9BW+WfKHB~0xZrEOsib_3U58F#;*K19_UP!6L9kw&%taT!9@>T>c-Cc zUtV++oz|u=aMb--}SHzYFb!yU*+y3ud8q5i)*2hi3 z$T4e{H#@hVGt85?r8th8qe8P^2PL?}Oq|T(-B5F<<0dq#lXA{w ze^+;TGH_o+_a>aYJ1x@Qxij3(rqm@SwcT_$)si*6dv~&P$BlsEFswZ7woW6Q&&ats z9tWIEZ7V&LZj)(uVP^wn%KXNXwJr&>C_dWrU^@B}7DotK^>7(~_D<6*bJ4cyMyv6H z=sr_fu-e|{b*cF~pRkdBzFs-ahOzX4{nQo_a-YS4Tei0$>6T$KU}OBQYwa4K2!44> zPR~0M(8_hl54zzEpJtB-EwiFy(T%iMDT!b`KvJ1Mu6$0Wmf}rZx2ar#Cy?&L9|&K~ zI%b77^NKU5IGM}bb+VSZu1n4q^$zW>bx#IRvM^IZ+~fUM24}Rpm=Pt$D-#J1twMQA zyHQ%rlD7L4M4^|7M&!>wc99sm9C@PhaQX_nIZC@^Cf3|&t$NOfy8;A5?a~PT=iBy= z(0ap1<_gG)1-G}~b7Y#ZypV_JtLlf}L-tkCO5yn(61vQL1_Hy%p@?M$8`-UL z(dYg<`&7|#x;XuVIJo04G)$2P*`7nX1d5`SNASTUDO!R=soqMt7eEw<6&Qvn!4U^l zDiru2u9>b7i&T_gBu)yPU0W^a)2LK_E^DMyZb`{x2hurtC{`7YVAc{k5;0R8K4uif zDp(|(q8Xa)szFp_AIW;ssi^likXdzPjvD2YVy`uZ_m<=F&qVI=8I}mKfd1q>AD(rj zg>`#VH8U?|a)UAG$Aa8WZ=kS|qB!(gh}{6z`MpumYvatkj|0Exqx4Z|SWp2~85Wdx zmAtkc=YHj7o9!aTfwuE_6CV|so3F8tI)^1_&D~daY}g`ywFwfs(V{q72Zj>zFutgg zgeYhLk{C3y*g_C@Wfkls6HIF_2e`^|r<3>+P#n@wK!BzH1t}2A;~>~RdOX|O&|g6c zQCyZw?MX#@lTe@b3nCltNnw-D>NTbo?l;)FfC&M?p~_iugFRL{ z1@Hk4jOS$w9eYY%{T3H<5-q&AWkD(u{FWx{cJK6;f-QMlHQ=%P+uOkrQ+*Z z>?x}xXLa(SSTTMuw3#-_c2Zq(NWL|oW~VSHUYs5@h8RCPR2XkK$KtNgWsxvU7{8hV z-r}xwiZ57%kQV8nVsb+@-@esbJaZ#jd0wyo7 z@ApGywDhx9@;ZLux81HmQW6l=qR_j(|J)DyNNJG43U zv(7J99eJzZJwH8=|4fWo0dw;*B>9JZ-*}6KfRR438=qd+cd>22Ek8tSa86AWB|%Sz z6cr)=NP2QLWii)U45SYdgd)PzUNOd$kio$-K!XvXhJyb2qQgUovB|pAAV)Jks^GmE zQnRPJ<7hTvX~-vz|z0=eCnj)uQoOZ^$cUdaqasAl$KP*zPh(5?hTHD>7HiJdE!6J(Z$ zb_zM+sL*I`#w(W5CzjP5rXLH{3p-Z0dyKi?0Q$!)Y^cd`f_5tAxmSK(|;bG5i2wY!Z zBe6fM@w5``r!5;&o2VwPP5i0ky>#WN?_|~A8Sj}IWQ!2+dBF9yLNl|OH_q$BmszBXczoMxQWf(3% zX6GRY5WT1Xd5c||@Ueg*abzx+S=DELE2UOZrdpyj(dT~>C{b(>O3hrIT{@QRF2PtEXSCjNiwgR zjf|{EA|q2nZiVDWFG1_Jc+K#!__xBLU^Ke|Fu%f{0bCW2)OVm{YYX zdH{#-KX3SxkW1CkNR;^9J zZne*gV|f-V?BNtnxys|-Ai$6+pi+HQTMEOeg9al(y+@s(TRmvRTc4<(2{p0G;FuyY ziC4DE8l~9gsQCWNRXt(Rm)m@bBwTO!EHoZo;Ya22g|^xTLjRadvP-adX8^jX+^|rM zTHra@jO(ld>& z_=bPCyAqqTnLZ!10jx<_gN}BT|CG$e=X6ydd7n-iG@@JaZM$Gp!LDTuDo<{34-_HtFb-zq{pUZm4n)!;98tF08?8!XvGB zX7)R?n{NFZgUEv?4(IEY5^VVbX}lZ8(%@#@wxZ|j&%jZ?Lq&tbKWDAsBv5Byb?H5V zux-73j=j^Z=5O=dzcUo@t*0?}x?rVr2#A_A5Vs#KH~R7NESD3}!5`{iIO(qXu zt>-j)uIdlN6+(R1gx+g)6*8xK7b?#+tCrnJQhvQ{Q$L&X%2~LRIoaBXi&ykRbBUxT z)Fcdv^$KG*Fr|V+?CBu+b%+#;E{p}?eWt?$T5EGr zQnA}5w_IKuCC~66J!c9GY`*gOS6W#9*0a&6#Jmn=U-@!L8~=)OS5%OKsG8f*TvW+} zB#1Xblffpt1f8$pZ`of^nxm;-_8V-&KQ^Q6`hkLWGZz@Jiw$hQe}YXEGNsy+6Ya}W zK6{jBV{a#}4HlGX_5MTlm^uI7viJWtC6xL9l@iMGKZE>JT5=A!97tUk8n>8=hu#UG z|G$(_Ap{{3H1NRIaD1Y#7atMq05Ch7YBTU|&4!LRmH|%($?JCI6;P5#cToJhudqgDoj42xy?M?*E2;com2Gif{2o}5qzM`{TohM4dHrZqS>Jp*D6x7}*~sBvD^WAi({)A$IM*oP z$=$z$WSWLnU}hm9)~Mcw;>gMHsS>H1DD{!FN|K`3puBaWM_Phy!;4x_%Z`*#1q8BC z!s(*&`RP-nl(oZEVbVxVFH||Z1unf{vH0Mm6q4b_)dl`2owdtkMC`P@RTSa={=#gZ z!WMz|!Kg@FX#K5dLR?^zQOdF)O(-Ee`|%IkSp)S@4kC7YQ`Tgb$iUn0w-AAYeNBxJ zY%5Ga%=9=eKn&UvZ}18<^%T^Mo6jUFiF=^%wKsUI5z-OAh;f(V(SiU=eH2hCxYvpl zO?{@SVC4F~{Rgv$XAn+}u1e z=gIho-(kYBVop?Pq)K>WM`h@NO|C-3U)~|FI3cfAS2*o5Qj~L{((cVtjm-!lj}!T0 z&NRFc7z=nb4`l6u0s544s@iTXe{}P5g&m(%9d)NMbnzle!QH`p6&<52ZM)X0^dMry zLdR_>26N>+zepYqnu&)C?t&l6EnM{Nz)!+hu~HWf-$!9Gadn0P{RMPg~imUi7> zY1@34VuLWH-f(YA@z*zYVT3Gmw}bbh2E;N`<>~D0e1YwJf&3}q(ApQdk!`B`amy09 zs;Rd{uCQ*y+|A400!WAReCALua-lXM7977H6XR=E9LQ^Ay_u*T!Vv@Qnwr?YUP+Y%uvW@-E*~ z0zqc*BqlA-0NjsCa6BFYX|53E*!*NjMQPX&y!=PwKolw>zB7PAQVR)^TGyF8P1hsH zi3=!L+>6#IaFHO2I7>W1z$(!P)}%Meg12;J5l~XV3EC4|zVfVTVH$^!ECkA@B&a1F z-7{OvB?W7lXI=U4?WThib2cM-_~j)0uItxXho=MRXkv+4r?nKAkcVIh;MTBiM}1qX z?b_(E(uoIh+cxgsqAKmrNM8jLH5H##NX&BOx#6VP9G-pA+FLgpk=+J#YP-Cy8BZ@; zElZcL71i_YOIyfk@aq$jfm2;h`!+67p^WXu=?iwE<7LlB!}iP?;H1zcK5Q``@(Ux) z$5ZfNhDxV_tMTssK&YhMP(7Fp8X61+?b)N0j6?i=WFn()HpcHS%&CJW{ACJA4^*4)C4owd6{?vXGh2^ zA;|-IQcANDb^{KB@nTAx&|w+Tlx6m-AUXw%L2WLPsx2dCvgreoq5UJfXo=1xszHK4 zKxpSy@Ka-YSB2lw@MGEO>a4Me)DAM`(VB&4JLSN!S@JE1^j*|`D(L3SV^zYZTIi&$ zXArvAFygyKyd04v`w#ha9oONEc-EFWE8gTK@|wOcP6CViTg_|+fEVJHl^r7>0s|RB z)@!8{qgm(VhBoNehF{&cIK?3C4#AEx$Xs(np!nXW{eyqGGqx0LpF6m-&PG31V|dLJ zrb63;yXD`vS(j({Da};y$c8$^i>$%$MEsz>*n;^V0^cv(v@K3WbE#jJBfvP7WV2X9 zrHFzb79zz_-#m(|&M{16srs&CCWiNJ51`>GPQ&C)8j0S3#4k*R?u5%Grc8+incUB~ z*u}S-#zZ&2hCTZHuw8=tQ>UWewta@vL0Fd;&}`AF<&H&B$mOGUKN8A^(?FQI-vryc z@!o&Jf(Uo)@AL$4KIhUo2Ox5RrF~d1ZMMe#{l+7xh@-}P@G}_b!kqN;_lHwFb)$yR zijHb{boP_O&U+&CIv=A|n!4Gau7A?9(&mI@VK{n~9$UetYC7|sTgd&VNEiM;89vfoneTlztXq!AigHDh; z&ik}6YdSV=P!GDNhx*$#d z3|6CUi_lo6l=)Tbc(LuB`-`oZpoT-zY2x$45hGn&dNJLrGb7}%msP{Z-gyD&YKg)_ zONFAEmaG)O(136X;KUKbg9*GzT|fc2b=XC=l-$G8?wf+0g1)}qS)79P6p4IkvyAr~nvk#O0l z(yS_(ZnPzT6Xs%?<-TSW*9mZ*@fb6#h(7d;caz08H1Xeos-xlj;mfQZ{5xe*l^spt z<7r?k>-mlJbri2M+sC=JnIJ~)|2shL9 zupWL_Y5a0HOqtDx#R(1F8rVSZ_6(DGpD=Ay`m_&vFtelf$8RX3k&D`dsMQn}T*Kt_ zwevWj>Y?g$koOKEJF}n8rx@G#ohwl+(DeOT4kBi*BTox?VE<4qQ~lJ^lIgyJ&WOP< zX&KkCxCpYaGzpIV%;}=xF?*N32l;?`9kvFV9@xV#7?C0GZHA0??FVea0QgV*l8gO6 z7IB>ayWc8D^Z&xmPc&XJa5X2qPuB{=XltppX(Np}>=3s|;?1}z)c-k$?cF{ucm}Y? zl8cJ(j**fEh`BzG>6m_}N36wZINVgLw{T~h31L)txV7X+5rg0lH;`cn6)#=dvwXPF zH)(#lzC4_>FA`Kt_X|>Sj@)^_K9Sz*Li2mMR(Kzm#2yHWj@g!>kjFc7Re1!B15;$J6M*h<3Krk%gTWcT*YsezUXBLO!{g`iQ%s&?1cSS#`a-n68S%A$Sa4siQ~c=Q|#;NT7d& z($C;FJ@`)Hm=cbB8*p;?g*2ow`F4|0cuSN4PEz19nKqE|PvsK_g;EjN9UC;uIWsig zwrxG2Kv#ZYOJa&uw3> zlol{)CYPnEShh4*2Vzbo6E-G0<&#QvoV)(UhB$-%wpoGM zo?I~}E_zEFV3V^_PY2C&jL{YhJ9eE%pr_p>18pT_UH8W{G^?0kh3{Ps*BA`q$+5pb8 z+y)UmMgee!Kj#~S#x9cr03O1Ssp6--*+f7T;*gRE_p0JfVZ!xKij<&ry|ELa$hpW8t`Kq=xH4&l^f92ip(z-rUXXC-EQ>Xzfz3FZ9%*gk^H z){*`i7l^}g0n&DP5y9z+^*36$8cb&V`9-$5W9J@so8$4WTI64VrM+SV6WmplWI6vo4xPq*s{{1ub$?fLEN87sw!F; zpc}YTAL@PcrDaB}(KMaDTUl;jLphaNB=M9JNx5zPy`m%ofmWAV(I3-{o)q1Y;O+co zdKa(qg|jTVEQ``w93fx?AJ0wN3WoH$6^+A5B@4zCI;10;SI?7>%Ioo61TRBn)$c2t zesCU56n$yQsipI1VB+r3N~Dxj=w?6?;oP{=E~*^@=#}&E%FQ`=)uyx&)L5$XXZ9Hi zV1f$v`Xe5=H(MFE7aqZCG@no@ zUoYA%&KrLDZ8&`<^u^;NDq^LTP@iGJj8uON@v9HcJlCaB(`gO-yIUiJ*($z=FXgKe>!OjXhSy8P92{@< z>+fIBQ$Y!S|CTKNK0OF`k0-9gu2`S`%{)~mZj+*=v(~n-kcF6RXI83;v<%H`1c1Rf zh!Giwc8VP` z1nSCy8Waah8?;hsAm_Iw@}vce%rIb|B@?E~q3-S)KfpI`JM#Z=Pi6flqyJxT11IbM zUUPw|_m6$J-RcoOm9foN7gZ`G1NfXao3ARu=_M5++98j!o50S6QI5;~-{?b8@z?@^ zZKC_gg3k`qZL|LF7t_a+wVN-p6vG1x`mdYwVN{{r2}#cgm`}~n?WN%l-k;m=d*{2S z^O^@(Y)%tv91*mgc!#fakcOMWeyb0;C(+qYzOLeZ&{TY`ZgUD+UodIRrUZhweX}8k7S#M!P8D?x3C!RSReyNZZiUI5aUnsA{7WEY@OLPA<*@Uw zngiM=wc)Xs4)%-YRd?{b(wHaM)t zHyUnVZPC6?DhGJcXjN+hh`{|BV^|TJ6Mkzvg;fI2YG)DUU>CTjxtM@-`eN|lMiRSW z;XhIgR+-#V2FS)#mS~|}`QOGFy>~OQqsyLhS?DfY@s>bmINB~IjZDE^8&>g+W?*z2 zM19;G_)3?=7l18niZTi9!D2C`s||DF{Wp%!1@u{wY%`<)x+-_efKqUAu`V;kxhuy% zj8!jQQyhwtx-QzPYb54YER5&#ocnfRB{x>&EIcMf9gWSr`L9 z=)hWfTjhXP&loAPLat2q$@;fE4nV2xzhEN6u)Bc2J|>aXn!(c`yG2OZ$^cn)he)- zS7Fvj_qZVU_q`gwa#lhaE1`g@N`Z*S;-V)Y7E|H`zG6h6!y@TciN1b!#>kPvqM>M8YyRV8o&GG`GUich(#U-Pso`2=QbQ$X_rb< z{B7@NV$0day-raUc06510|G0-N>rc*jxeV)V1-=7uvS{KW%be}zeL4@@N|s%)F|Agrt457 zx>nc=xQgIZdr(YXuLM_NV|%f~@)y(|m$4CA-+YSk8VUy8=^GO#v!QuM*02FDVcv6WVTK$)@`(vr3YW9M`FA1g{D1 zOK}dbJ2roO9CWxR1*d1M`~kgyDM<@ zDYlJ#w2WM2v)t6Gk`lry3F=18p=csKh}6QTtq@YX-Z5ZRS{0rcw9xgP2_5pNdYRmt zTuN_9diQS5U$=FdaR=hqrQ{I|o#ztl@8xy`GF}A^7lI@Te)nO7lk^J|a$ne;uDs1B!kE=rT0S$rU(G=zVtgWV)f!q%C88*!yhQ#QyQI< z?$R3w!o7fg+}#&3T`g1^ha{I{D&Mz4(Io45XRythUuMabC&W7zGl8-5hK{bn<0FYa zqle#5L_dH*<&j`3_AkUH(MiicMWHo-qW!`5m)3KzyOxMlMydsGIM=gvJ$}LKpR-!@ z-G9U0VG1syHx>G1J0ieLI;!_`y7f3dcbSwAOCi`Fz+v*b02>&oLc`l}QwBxe%O;dQ z=Jblk7w~8PNP@q-TDla_;|lz*W>(gJxxxP*6=r5+`=0|FtNulb9JC^L&(xd_fTRYb z$|iUnJEafFLPAsY8Mi0#nFfX0&e<88Ng=0p7rW#TUXQO~LiR@o(nvAj%N+R4zEusiL`vkn`Y&9`gC{ zkMi9(sRadQrLSckqUJ zDWVt?ZlDPAd_X9ZD~uQ^wCrXz5&&luM&q8hCwxpyh4u{39uSC68vzsUY%wW3uf=9x zY!)VI)5FKp!^0q+Vw?)hS9&F(7xT8mfu+9#b=P;vaw*jf`3cE%eThn&=#YG*NDI4g z6mO8E6nowHQ$v7R>OZChxmCZ37={dk#yhp~!3~|Ny-C1PiF~)p$|5}fE@#JNfKkuD zpmN1BG992SefMKIq&T6(cNL_v*_ST)k&82@3q+YPr?j%7+p{pG5UJ2v`m}^HKYTBI zjnGu4&CXkt*k28;d4x(aK96F|;zXIuX7|^i*X;;7bm^$wrB}SK zq@iT$ueFh9tCY^~(|@CP2j`-yqkG`h+lPs&OwlhIP|iE@m>nXNdNr$|dOR`gZ`!G%_bW7zcHCmj9bHr{J8Sx{j>eXN*LoQpZ6 zZOu0N{@%_x#p5uI`tq18=st`2X0tygxJ@!ksWDR)B$WXQ3gLMA`YTJd;i5qgHm9Vs zkhjyJEKRxU!ufC)I*CN!>W~Q8zAN70;Z!m4;&i9f4=?&k8+ja7PPz zLVwVu9cjklEOfVTF>W+-b z^oZFGC;jxol!4!OXZQ}}Z9=?Lt3qcm*0yWp@(9BcGLFR8(kA!AI0*YhB616!qYDDG zo_TRe<&``7huFx)h@gNwQS-AA4D~G{@s|$aAi2l}yab+Lpeg;cQg0|W!ndR!dmj6$ zgj{$(GzZopDz`h}$H=`uGUH(FW|>9ZddANwWdDfo&E};s;Ct%#cTde*RYfP`*+04d z0SyKV-}3B| z5UrUKiI}4fgu{UT(nd`8tWHC>qWIMIj<26D^+7@g?K~9?jH5MtYw}-KBm2Au8R8(k z#s#dV6XuDkcU{xd{;NW{MH{_t6X>MdfjRK>8Lp_vVxkiH8uN$Xy4wq`s`86PO4hT? z=87sh6S%3o1YxZu(awCc2yR?6-crDLR`cC!|DBB<1K=cr)1|&!Rs471;PsCt%u9Q_ zPS& z>xKScsah+u+>UX4ywqyVZ_So?g;qLpQK6mde7*3+Ygj<1?znSDtI52EX#|PI;OZub zHMR(E_98-0OYaTQ2$4z4@H0(3Z}?0p$j{Tq<)Hn%&EMgqTkkQqST8z|m&ZlOzFa%Q zZDHHTIRzl@$O!n8RRZg{q8E_M(bd!>cV#goJp4u-SRe?#ztUoI} zM`BjAB~u)Qfz2MD0PoEc5j5m5qL2S0d9gZ!rONrLza{^j?I;-n?k%8_R2ZH<8f3=j z`H>4w4n@2niQ(z!pmsrY%sXz(>zK7`e*fU>Pf+9L2 zGNUglHXT;vYeHw?f-J(N(b)aox}>LeG5izjb%C!soNAoS%L0j1^a{- z?7=-cqNM*!D3GQ_zdb|PK%nYbaTh2gIItapr-23;iNt7+LryAKuJ%WEFNs!~L1k<_%qxmUc zAjc`bAro;aD2)b3xgCj(Z znk1D7K>^S8t^n?(bx$1c9@8X#7x2NO*rF8jP{belUi~jUnuv%yON9Jeab9e5fFm zu7PSHA^okTlNb0PXxVz@Le6NVVkvh4JKgDh3zPy}6g|#FBBLXVIGX6}EOMuPQnU@t z;h->1CFP}rubEJURn1Smu5E=3zv)LX$gQ8j++Qo3tjmw91;Dx4q6NzP%{h{#T;JO) zcD2n2IUPx5)HOF{QuD%*O0b9@fgSj$O+CchO;uV)YAJa+FJsQ(f;-)d36(Z2)u!QX zKf<%cQ&NVCpybhv1ui>BRwer=Vt*iOxg&H+bX1PRC#(8@hxsBF(v^5lN}P4D+9d=x5m(ry z6$(qOw(fqh=?_ggYS)SibhmX6Z}yzV<5edPyed!m3y!bxG?;Tm(+DQ`r^^D z9E4MTvf{Xrg)ZLC17s}@jCx;!F3o8989i$;`9stlZCbkM_ygq~81F+5`Z|n=r|n_- z9ADi|ZoWVEQA0*!QI#HiUO&iM z(6rt4hSV@sJY((6RKxN>c_QlOdNIBZhffk#z*ZF@OwQhsRY2hKqGKlG0YX9+lum_6 zxIxv2xo6QHtKGVh$ZKhNzx223x#^r!%Ssw}m24guaP>=Va#zgH$SX23a}=2FFAG(( zrx-YDJtxbxnYyx!qwV7FfQgw=GXsCIIEo&6N|$K*YC*rL#hq;MZY#wU)&Bo?t$CnqO*vmj|8yC-64^){Mg4rap_;jAUg(xdb8L3-ONcJjdQ!U@r6fl!Lsa$N!2(kL zgU0waUU+g&QE9SoI1-hMvv&>cee%K5Cg1aMs*CO%V+L*@_rmD_*Yqfuj3QrjudRH5 zQN;ho@?eANg;ntk29hSj`_ezZ$ z?L*-MjI4ong~W6&TnwNT=7s5~lymPUQ;6I`y&1ze08}CptMZ{MYyQiLqubreiBJa^ zjHPuO?FXvNaDG%k1h4^kuKUo~a&R|vlsQD_=@%iyjyI?1U~aVlC zthBKS*2O_1lv1YIn-9fr%c_={9fq5@#N`Zm&Dvjsi<)2)+0Hdh_Q50x23Z&)HLszy zu9=*VXuZ6aI?cIsG1Raoh)MP6$A?MUKeP|5_&%MRczrOEfzSZ}*gr{ds^(7%5hJ<3^~DNIo;YdDWt>7ic@h(Ps7qeaPG=^1% z))k)_YQ}gf`8&?ROD5+&wi<3$;Z4PPY{chWbY6{qGoz-Gt;JR3Z=^s+*i5)i+pOQ0 zYzy8)Y4yAavWGHA|$2 z#}~O02Q(_o2ITH5q#Uy?#dz-~mIyTuCzhidV7 zcs$1EAPndYa`)bNF}(k|ZEH9EPin>VpH_ivzXg^5WfkR=+Qt7+tDoy0!Cn|)FoO`3 za@Ak8T5P!6Mt5^+t>pyLXGlyAjvFSngkrP5cu% zwnimdjS!r3pdMK)LNA)+o^qpqs4${2xa`@nzs89giQ#-jjI3JlSD59a_4Vx%)i}F} z`7sVJ1YfiB$Qzjy-Gy~@$gH7FH3Zqs&};!DAI6 z#@t*L1~z`+89$-olu1v`V0bi@3f>z#9CJt=?I_LF01!Y1*6+|_ZM)i}rfbQmDO@E( z5*jjFCA0f3jksxqxVS0>WNC_au)XJmaqRa;&@59W zDxA|VAGJw2qHVlWC8m9E8pehU?pK0(;Z_N)w;c&?>iyK^S>1mSH5p(6kitUzol8qh z(13%z#4}bUt1HKBt$nbXDcd-^4khXD(d)HD<1awF4%elss$oW_ePsOt`~8?Po+W9L z(U3kI%4xck#*9hq3ES}u zo5I<^A@(Szmy!tw=+-+S0mamy8TZ>N7}=dERd;+D;xHc+I_ zw{SCBTEqhaxOGtkt1t0P8}2QNVUn5<%2)tW5dER_2e`N)R1KWe5u_Jb%vw#ywMcc2 z=`>*$k$G{`elRP(57Sb9RAKU*DwN&DBW@ylPG0?Eafl*Xtb>aofj0rRqb?66ogOuB zA|F~1$9$LU`7?zV`CIgi09y@BQN+v35^RLx& z)wu)m*eV7uo7YuLQ*Xt4pF+t8n?nVD6L?G8WSY zaV{4qo8u)>PD#H}PDl&2LSkyADY%RlonZh)6u}M~nGD#z$CPoC14DC9?nU#u3V`*$ zzX}A=^Qww}TxDwpb~&Xo2i*%wADa#0)U!)yrr!o zP&>!2AO zZIG`=unpOv#R8Oa51bx(7N^Q=S%Ath*;TST@mFt`T7r`_OHi>M3|@?`3K z-d#LpKCJv%XoT5jsC4qA$;C0e2mG0Y#WOwPAKvVmg29V+?T zVv4i;Xkq{DV*hpTWpB?S;?CSqdk_>xe-A>fAeo;N`em@_|Eus2@5f~;2Q5Mt^&PG} z9EO(yEW!?tngUIR^J|ayLrd{~PZ(PNK5Id!%OvSN8TCB*zaI8KubkfB@2B=lf%!=Q zvtn;4IGBpaA;87C{S*WDZ=6=QQCu@xna~f533fBkZCNO6g&Ve%OsX_n=G5v{eSvhw z@c_OC5OBz&co(rRv8_2E_fQc34o^pN>&KRbe;}ba{{uk^dHpFIXM2{!!UsQ~^9c4@ zYD+@#j-tKpDU>Ru{|(6yegiz7H<#=*XwR~h8c!m5L$j*@x|u~Uo1ip|7(MA|2XsXL zv+NBn+St2}c{uw+xl^KJdp?j1V}k(5gFAJf{jMIB?AX@wvubHOe(|@Pl#^uQj?3_~ zn{7D2q-r$u;&_n31_Iv;aO(r7jjYNW5>DsdQT!E`9|Kp88~{1V4^M^go!RYqP~@LH z-(MHm!V(-$;VYg@kC~!9EQ>>qjKki^MVrynE$3UU?*Kb36hRDC&L16#Gef#^a2=IE zUyS?xJfCIQZ&8--4P@8)v`=8H4Eb>0l-_t$Q&Gk1I8 zZn3y`K004@+FjlHmUOZA%rae9(}h98R@okzNy3nkUDjvbj}%gYvKy|ow#!z;DiGPC=(cuqr&}QQ`>qXp76n`l40m)7f*B%M4GilWT@d~3 z1U_S^Y>hhPOdO-MdEq~8lp?k&GRfB(PFp^oZzq3i4B?nIJIT~G;wH|~yQL#%q? zx-9!LqmqxRi0x3o} z(2dmeQGD=v^@#X#naWu8&F1h7m~{#TM!L?=b)vV;7I>Z~ti|#<#KYEw+=m6c?MC(# z-I@yIK17gj!=p}IOtfxh41mnr-m9}Ugw?MRjFE-Y2SSZ`R}trlwE!hK^{xC+ zqRo|tDGkNfdH~K6B7da+p79O*TUH~f??Vyw7P0^5N9u$hv$_wMxC)b}U0!IMhJL%8 z6v!utNf`bWTAE%%RJp1Qg^MT$FxrM6jJhlEH;d={l)A!(fvS@>W;d>w@u(G1@vIe5 zh}H40KHcCe(8c4bwYC}kwo9k5e70g&!$ncB9KZDn)7t{C_$Qg?W__KPrmLC+*@IX_ zcV(=avf1NJqWRTynHEn=P0dUkX7EfF^wj~Ak`W}OK|W^E*{Qa@Ts(u4kzYiXP!j+m zfGOP1k6@EWhxS)}0RqO|=`4NK0kwhpIqKB;0oi_X9b}&v^-O0Xnsp}&u>mj*$eqQF z&C~Z~IoUxCF|I3IQUbZQqP6~&Lffic6&rFB`#94%XA)k=v7M5Thx|r8X2aRhs#=bi z{e8jeU(+EpPO6k+`G#iW@5EDRbsYL0x^tg-b>XPhR3NgM{5?J#jnT4l!YXjBD}D`5 zz@{5Xq2JMG6V|QE)diWQ_MZ|4TPS2{hfXD#iR)Ng%C2rEBHeblLYqpC?oh4{h<*<8h5aml zgL9KmRqxIy53a90fyR8a$&uk= zcEJlZab&d#6XVAOKXk2XgBcRKBonaL4XW}DmMm3kbyTgjpK@cY)n4MX^zJkI7)XGd z$|DFl&MPV}V>{Gx%|hRT=f?#%V{ba5^i6Bh-{w}e^HaEnLB_t5xkQ|oL8%}WI`qt&;pxo6e$ zht#*ks3S=1SvPNU{m|~HR)~4dI`gV54@A1o&*w@J@&RUSPY7s32a0qR^ z-;2UjS08fL8&K7Y5<;drC#$}R`xsc`fSVI?8rD`ENea);RI1RqAKo|z1|dLfa07={ z@-T2?D@k=c=b1m`FwCW;y!P37;(K&u(l@)8hfkc6t_-I$_c@S&KKQyuFdb#Jxo&op z(1!Oj5Z<~ExyOkjzHKkN{c=zPBzg_=v<9hg!2{s!*R{hGv1RNc$k>PCp)uk9R%XO} zLcm+maM$rVSQuM~BPqyPC=<}f0>5U{xDPVtuwLKqmU^rE2;?|L+Dw5VY!+GZo}{wTanh%zBuR>gkeHBB#a-k@k7Oh>5LsDKWiUoe=t|z&Z-hzzdB%LsDsxjz7}_=Ww4f|-#wFz0L4-A2h%xFma*QEz-+ztj zI31gEzo9RC#&r(6|Bw*3d&Yklvh77bAHV;#_6R~!+u~G}n#v7$4DHH&C3{am^ z^jK?5DL(Q^&L9{?wkwZR#OOZw*CEapGnivE|La7pBHqltKU%(cL!kY1oIh`P38rA*f6&PFt&)=o+M(i{J4FU}O$*Th3Fzmf-*cyb1=V%>5faeFXo_540pI?_KdL|HfmYZ%WSjziIy2G zznE5E37Q4pVDiUaq_T@V$-JVSqS_9t-0&y`I}YF4rK(De{7!UWRAX znL%VNU`K&RxhZ1ZA(>p<*x{8M%T*onHf|xm*PF-uug%?x%xuD=T=_4QTN)*Nj_p1}*Lmlvw z8~p?z=%dVcxYU+s!E#b7x6Tut{T-U0?#(%CwY%~w#{i1h4zhwPDfQexsN7}Ydmcsn z{Co%6z&}IL;x!tHCCZw$l#8N+U>j1kuDm8_VAv7YpbQ(Uhns(R|E=K%pjQX>SR}H% z&B?sVnl)z%U9TS8BuJxt$wLRzT}2h1Ds9hS z5)>oXQXPrUK4p$$ZmVcmgA`q(<4kYOp;YYYz{*>@0~Nof#;|Ne*>Db}j*Y=jUr)*> za@NgV4{svy-2W8i>>jpkx=P|?PzHHTMsd*P&-~P<&FlDk#FeUvf^DJ$$ux_4CBT^f z_VU{REA`zXdiB&I3x1+#{2oEid%+tqI;I4vd}{HW3vAPmi5hL1+hmcWJ*6*j>PsQ; z=$_7`Y@V|+wG3>M!|RXRzv5 z5j^WbgrS~N{GQ_qB<2VqW`{Q>T;$1Fts!Rzl21v$U;alSqvVr`q17DPDZ!qd$!l8d zz#bWsr76Qj=#XpW(33X0dRr=)fI)S0%1qiH(ePx_$;g3T4eKiSW;~PWktNv`S9!D6 z5Q$@klz!p)v-&emd6g?T?LU930Twb1wRlEh6_n;@Gq>;3ySSJ;Q3s4(JG;7}C(k}7 z9lj=|5`#$BQ3}%NY(-N^b#g#GM%ZGo1}AOwx4Jd{usBC{)5Q?;supxAXb4zOMGBB_ z&EGL;D#8AEE3!x(t=J^h?@b}!z#@xx;#Ab&bgto&F|=7E*5tZT7iFJ|&_>WqrghOq zcB?^eE4m`^;KpHF;9Xm)F&&>4orWGbu5e1B3dBm8t>xWJ_&wpPgJ`TYd&_-6SH_kIwv!T3-L2VPomk=fOMo zUhlAyJpYfuxbhB^6~=$rkcQ={mHRuIp2?3x6_u;jn%B!{87zvv{?Bpx6SX!LRY2oke{6=zX52q~zG${%EhR8u&8foO zsKJwl?w_2=5%XiC05(Z{#kv_mQA%J;@(bxeb?fn~OHBYH_9t$L1d?;Ms&seW- zglr}O-OiL3VuEHR-yJj+JKE8z4SOP*4`*MuPebyyN#+Cl)i?dAf}bz!o@pbbrXw|+ zPxP{f6QLDkGFSMBhge7AVv#ZTX7Xg}wEs{C324r%{O9|%1}*!d$nax4wf^xYNM@Nf z-!9*?c#+B-BbeqKA{czmcmeNT{0=&(dFIsVrO!k>JRVT8L6FFE0Pms ztirvD$9CVk8C>VHPcU*Qu0%MXJ04fc2e}^jPMRM4VCPE9B*S(aOpb$TYp>l-NHlE7 z`QGR8FQSk(3os|;}HO~G?i0r*vL zcj7CA;^zBezC|;QtSP2n?XO1$cbCrSYUP=dx*C5hrQC9` zg61QNPelD~wX3RPpWm9sJ4{-%eY#)2)-Ld|Z^6r*4wymBGZaB67-_gw05*lrV)R`< z(ZiiiFFl*PXqCA*-L1Ty*Ws%`;3niYGSyloIB#itr?b3i z-JmXkDbs^bTt`&DH!ya43dsL)4^({-IgDVYmva8;p{$fdstA)|yHs(iv|xnFO&#C-b@}-_ZF{saG%}OZ6d>)U%_fd~ zk!iA}k&j@5ZQz%({I*|PC?dSV^u%w6Rf2!t|R7}%Xj+J88x4&4R{ zU+45W+PE^s7-s$CTw3v&B7P-z{K>-u0gl0UnDfrtr-cJ=xF^a;c%W0xY76D|-JVh1 zl(=4FX$jTD!r7{cxq(2#9&abnzN;YoOmp>=x>)JK!y({|E`c$Ko_ls44HOfi){VM_ z+BjQhsXy^z1#bK&mwRSJPh`2X#;y$rd6gMLg0I1L7GJrY2Z|p-)GHacB5%ctHEvZ7A4s^e0(7SVJsNGv#Y2L2(Yc#*(V=x?qr6RoV^CcY6M+yZjjl zp@gseDc19EJdhEA3$I=B$zURB)Fs+2^z?nOZ}pDic8q#Gf}=0WTCAlQmmP1n2a{V& z*X>)BhP6gEuF>}EYuQ{wHsF%avmWkwg!Z3@Ipp#K&f@5X5gIPj`Vl0-y}K)JF?Td}K_o8SMtbmoYap+oO}{ z2+;JLiKp_7B#a=%m6QlGZz-0xL4ajBn!KEc1{0F!lvByRyl!SZ@S`06z%YcNz?#cS z1Eea(F{ApJV0+s|5~U>1}X=BiMk>; ziGfa)L>b)fc<@MsLybQBJ z7WZl~Pc!#mG4Er7x6i)8seqpcoYHC_DjSO@I$qlwojo z`1;519HyRI`pfMdd-V74+DI%N-@*?HX>>RE<--u-x{n;1y&PE4VUH=*1qd7p>Ct%l zwh%iysjD60-O)uFKp@;*d=Il4=Z?~zy7o!58D?TO*oldqiA6GupMnLx;%N^&s{s{l zT-HbMTmXlANWFD;j$yggIqiE#UF!%ovmSJFI;`nd()Y&T9wim((-ZQmz zP)OlQ9UsOcZ9v5M6qJZtnjr<_f7FTw|+~q)~nDjHL{puvsQ)yJJZJJ+B4i!e=lmorU z3m71bc}Gh}*z!asfkKD0o7Q(VX$A3}XtMI%V@_KS+{`&yP-j8A*yIB&PFlPVNeUM9ith{uEK_*S%(htNIgc%|%(dP97JB+z~v56wc zWe@Z7uj|EkrZ}h%%(Zi=WmEo(seW9fe(WgK+o!GN&F*~L^BN4eS1V6{HZui6qJG+| zMnUs^7vrF}W&nTUib!R;BFAh`XT6uF+JfG$XL|_6Z`6`X1=oPgYFF%oZc*TQQAL~l zI=1#c4MEzuZ@cU;pC1-i($DrAl^J90?`)DUNT>L8i@k)3;SmRO#+|y5*C^WrnyfL_ z;y2>qK4W;hn|z}I`8Y0HWXI!LqWW!`b{=uAMznj(WEZODmTHXP*>Uhn#&+_|6P8KL z6rXQORm#@ERGz;jRMpqKRFg)3s>+;~CKslEY<~da6e~d_)~6q$Sy&KX3)_x(HL65? zquH&-vA^ddy-7PU9%xaS`&kOX(47c_^3|CUUk zw-ZR8oRv&gAs-{TmKF#}X%Kr5uD+hx1uQDL>Er*%2Am!z0<+~N_>*yv89Qo^D7Tx> zH=uXsKikT_mO_ECB{=Kq(lBZiXAyQ%MmTPWS%C4X=61Z|um9kk69bBjJR(7i(~2r2>M zNny%UBH@flASas0;b(S!VYoj2aWn?<1W|7Sl)l1{6QiNc)4(>YXdYy&c!3}}TgO3a zTu!Dnn1ob3aELC%_FX(1AR2TaqOR|;XVVseCrt&=q*V=yj9`pyK>6t%#_>m!2I#XH zQli#I&A3amvy<360m`8;@fOfi^1Z_nxNW@x97r9b6O^0w3uAkgL`2f1FwyQdyLk|a zR2WQ!Ak=k2CN|uQ$UBPEQw($IK8S=fAz4>R=I~NmhK-g#*8httXaZ8`h&$^Dc7h)i z8_Me6mnAP$qIJ@9Q863~@Zb>O+R@ivSiUSRtt($_-cT-XoMCo3AlO_DvAj<`Rai1P z9%{;ne`6hOK5+V)%1}oh*^=&#y>}A%A;s!>(-;FoEq$rnG5;@{N<^989Lso(Nqq_n zluWMx60Ptmt4+){=z9WVBjQj8-%7KsW^Z)o$AEV;*UFWl))P3diyYgF+Q^OKT~*=v6RQ~yXOV~aIF@9@XyyCq zQte8lzL}Par!5|_3|*~%gQq*(RVvfw_YYv)S^a+s05JX1=Kj}%^8Xj*N&mm0JemLN z`OlQv{|Du1C*C`n59>vRP{i?%#Q_2-pB!N|_zK{x=LV~WMtrXQ$bB2D|9BHc0f9D z99aso`2DgZzr;q(3|Sgh`a>KVHkW#LTw*blKbJq2VfLs3tGrdhE}GzF>O95JQZ$br zG97+Te{hvX%i_AzuC!Pdz<6vrv(KolJ-98|4H$aC;>^%)?o*1fgyo8wM$RENAwDB0 zY)D)2oPLwIFZK5>Cm%Ff*GdNj^A-e7XcWoQ4wH3)W*DKK4a-*DxF<21RqZ!G+KgEy zV})M3l$&hd;>?Pqw!G_4af^Zlo?~F>zqGb_YBh>0TW{~rQh(H|XjO(yB}s$;`sXP~ z9Lj1eF-VA%m6A6oWa1`w8VUKv z5THMu&(T}&m^Z(BHxeL6e@%=~h=L-L$I5Vyyh({0_TH+hqBW(=BT-h$oRk1lSAxsI zNK^e5v|oXiD~Ergv_*x<&(xvnJkdmskfh-30)0L|faQzkH6d7(f8$UWy`P?a)Yh5cHnvI`oeJa!~11shimio_Qa;~ z3xna(1`p3mk|w4-*9RG&Xn^bg=7mZc}WFW$Al z{>5$(-(T?aPFXQa9xM~=uJ6(|E)c$x8l%sGlaX0DYp3Fv{5G}6?jDGYd1#LeA;Y~W zwL2Yz(Rxz2C5NJLqNXfu{OT;IqA?49W^Md9p<5mN0z_A^Ibo85xIi=N!MQ4G+s)MT z`>wS=*udRW-L{idjW=Y$dzX0rxlBfc@)F>4zhU)x+Q4B!c_U_sL%=Ec1jUXQU>D%aq!MBk zH_h*@CGJg|k+36)=7MLf+yWTGhB27dFW2cKWzfEo^|o+d=bK$~G8WEo$%!j1WuTvX ziEe#RNuwn$L}uA7#H8F2q{Dj3V+!))B3c5Sw>}lpV;66?SWeQjQyNW+N( zcdagpYrOZiAhV>NlEoKED}REmf#Lc4$ImKY#KQ!v>5^WU zt&$s8DS^$kEvBVUzoquI{mdh0#wS*%Cep+wMvtE9a(&<%{HIeV`+q2iV`OCh@7<9Y z8#NoPcRad#Y!m#Kr#@$z5u_p!_?k{#-sX{hVg<3m;|T;~o*vH^Tx^m>1$mY&YL7$M z({TfHb~e}_nJ3XbZwHw>csrdR=wg}saz*;>967B1H+Ti?TSn!+;sth&Rjj@bKA#Wp zzN=pcucfYdg{vA^sAmLJP`kpF0qngZwqE*hmDbaqjb3;rVTaN;AKJT~GcA!eBYkV# z*gM`ZI06q-yrb~u(_WM;6-Q^yRq7t(_p@Q|J}vNpvzB|S-L%RBic2r&$$j+)cM=b7 zSWdxmyV>nJDOtfPEy>%U;V*PKDO*P#SW9ZIG(Oh38^A zkn3|0#W@yKqJ6HXNJYDA#g-#XwE*8fTa1`!qutlUS$c|~P>scZ)yFMsE87QeaOFgk z`ei%gj$olxb@JHn-^*VrP%E0l)Wt!BsW+_#1(_p*5h8*Y9eJX%+a!D8pN^U<#zSaL zc9HKW&Al+4ejea>Wu^D=__x%Lar~L+2%(8itH8d2{viqHCGWajaWMzwUP!9G$~zp0 zGqU0KML!UJ&JhBv0RYjR)XZ5rycikGSSf|yG-;?BB>*JW_m8HOg1V#WG0qJ1^I^NL zM+RO79`25uT`K7c7!G*n1n<|I-UabBVUIbg5w@1s|MD#gFo7}LBvUOHuzc?^at1{;Icu=4xN-wAXhO zu2d*bUE~dQ-LMeF9Z&_Ge$?QLXH!8myg>nwet`{t0nSxKnxG^y3Q3af=rJEb{e?y- zLF)0NH->l*f>hqhh<~Z)&B&a+(0^jIgU_n-=BLs2Y|-dvu3thbxhp~=jvwe9g##8= znV>XxU>)A@2v10R5(LqtYn_{ip8w+^Vcq3)1?>+}BUK9xnTiuWi072kY-8Ndfv2{B&o*ViDKV2yM{y4D{+g+3zExR9rjQ8Mu1 z5$|1Sclk6VSt3ZJ3X%90V!S|j6>_R5XI3>Tdn9Y|8(m7H06>QV=eZ9m3YH(czrI&$ zQFtQ=$U=|)SZ;hu?iX3=x?M`Gyk2s<2yQ??qREnKPMRoaI+rU9FG~0Pn|4g=sjy`kIGrScXyxpJQSLj3 zdJa)@5!&po-2q$Q2_ieM0H=8e1c}h%SYg=AZAwG9okZ&dzvp^GV0WW`i~yn#ChkSF zPTek0HTE@h-#vjG24(;8&3G$}+0%n`$5e`RS1k#mSBm~9y|yQd8cv5AF5RFLN6$nj zzC$Ck&;1(v2XdUdTC1?9b$AT}ZRORE%UV4e{_qKKXZ}T%TVhX%TY~rZz1~eKtqcaF z+zVh|HAp1kglGTNJyyK*J6u79ro&dX8f0YVKX3gOe>_|Dq4|IlI9I8>f1g#8=xDN!no-w!Vq!rny;puq+Brv6;{_!%4(A)P)j z)O~yjobkf#vvtDY=IaEH58KTr3(h_Y9-;Z}Xvg#UuY|M2>!QOGQ8cOF>3ZX+Ju*L+ zO~BE--tDk-S%l~L!t^%)~sdcqc*#0lQ;>i(WbLjb?a9hnT(vM<`|mE zq6#pV*TnH?u%rdFz@*ag9g1Cg9Z^P zsjOgta)ZHG`wd}6XDKw!F{UXb^9uaF`R|DKp48L7;dj1e-zqroo>REn6I+ds$Bd=* zL5j=XmN0mlYnVx!4?zPfE%46>i=W1SNRETvreZ86$l%3Oac{5QDq*t@bmFOTirO1YUKB|kPL%FMibSA2?$2`Vm&CC9l~EZzMcjFMnnK+wK7E6CWqg9 zAQkDA&PSfG?Ozlf-@tVc8#DSJ5&VF{&vacy*oX3ye=f13X}%kULQQzmeD?~tS!w8t z>{6lQFKhe?dI%vKzFh`TO{&d}fGzZD!50tLfM?F&v$$EKt$XP!6?8|2{O6ywukxoHa317hBdw)_E+d8zHt3G z>bt!&7as|9_-g*0mn&-Mc;9@b{}Ge-oj$zah@3NwypOXquBf;z?lED(i?RKNRcJv# z`%fn#4*LJ?dinqOWm$grRsUsPWJzu3f8<4cUUUim!Ponzp^BWZ)bScwx9dZ!SKB|& zqXH69)YGdwkZ_oPe{9{6tN%Nq9*fZT78l>fi5-c>izVxrjy~Yzll9T~tJ8%%AFht= z=HJ-r(t5#2089p>bqqbDUNl`wk-B~Pu)m^uQ-q!t@hjLceetZEx-03Db2j^!FT0-X z`rA`!o&-?l+h?jx8h_Lcr??lpJx(CW0>=Co=R~KoLaD=u-#p$NSYNbV-}frU&NY{g zmDl2mD$0Y=rIa_>{^7o6Ii?Qz{C%jTGW%Kr>dVBUvb0(Wq z+`yR;x(xnr*(!{ZTkB+y0+*xNjyKF*(7)V(jMKIfJX z7U0pfh7#ID3`*7e<})@c9am9Zo95g>bbkTl9o1p}vOR@9n};4MEH8bb@7EP?7vv7@ z?Ka|mgz+cJ?6qwaF2?cPgA{)_#P?h<>hhuW#OkI05Pj_0KB*<^(fk$_`bHX@Z%y$0 zO#Vk>HT$^g)bfdgj^JB7wUe*&p!)oo48Bl11N8m+Sov~W`(`N^SU5eg8PUNvF?MEf zZ``jRa&g=Jc&8of?z2l=IaWGTlNf;1YeE>4#bw>@Kzu@-)T*?XCF{edR&)A3j z9YYpoV>CV{2Qn|?q)o% zmAt5`Dy=MMM!){R5Yq|+a!}(2wXf6`5kIaBHCDhc7iHT>TK?eN^XbE5uG*s}D=H^@ z-H#0p@&I6fumoTW1^~r|>5obo1Gk)X2?%Ek9g2n+HhU%@yoWZpSM|0^5l01hQn|~! zz1wj2Puql;>d`Tz>pVj#POGsYzaRbRqP>7gvN4HR^@U3YDPT|G#JCH|jw)l@s#j5} zIZY2AQV&OQ6AzAzO6+Bpe|jk`z&h2pUUrwiH2uyTdUPR72gtS+qjN55SA#m5QK0^! zSUnv*oVQ<77#WY6#+*~LOQcJy2$BCxS-DACv+{{^q}pumYZc7TGw+#@Jz9C0ezS?* z->sGUm6V4>|B~drPQWucy_HMDAna!x&XqKsMw@QJce}|+AN79oavcN18 z;lS{Mp&+CZBMUKTy1(3Id>^h5JZ&Sny?2DpVlR z$UGp@QRdAIH_}Q4tX^b127iapFLC@YHtA$ijQoR7gkX2|rS|4^^>-&V5>xH`ZK9MF z()#o)wFASaj*duTPKvpJ)Y=DR@ytnb8auPLK6lM$(;1|CGLeTa9ZAI=;d8Ax3|N%HzMbu^XHshn5Bf+T{PI!(iahrx^Y_D2`M^qR z_AHSPdI0UzNNZu*bD6wuORdb6GZxVZ{J+)FXH>-CQW0LF^4IzK+4>VtVwlVI%{jYY z`^9)_I(cF_X6tfl{*{J&I|{q%WSrI%EMS#a(c*83B`SL|6v@5usFqZbcm`~`GK|=P2^_|7q@wIdB^mD3sesH@}lO2xZEwJ_^i60ixvn%c5JA(K zfuwcN;&QqspxElxVlXbDr8{d1O0s=bP3Fe+~mF}jd_9lL^7V|F3cm&BQ)=RBtp!TT3R z%1UAuQo6!VQEptgm&Q|8srxHwUEvmq=E>Pph|EZ0)qgj2v1H&J>>vMG#KssU~FQz^uYVCNhxd0?Q+;!P(K{ zJ~;XxnBdm&y9lqgX4H;!2$jplmLkV?l3wIoia+3^^A$oeZnN}8f;;Z4sB5^8 zDlePhPiDF(VH-hUS8|7l6pbnnBdIqsO1n`As()@{W((r%=TjVDI;6<$npz3OGBUyQ z_m2hg;6A6qC<^gB&?YY9KrY(?hAl&6ofmh{_85Awn*T0d+>9|1O+y{$OdXVL?)mgX z+>~I(&P>BC{F~C+%_(#JKF?Vhe^VNJYMbKOf8X|1JjOw-II*o30BVTj6|?GJdxlmB zS0fn!G}rB--GdvNlz*DfqO*;t0Ib<2+PBtFx;c77w;82ePc0xfls^wTTP(+#-upV! zqjj^j#S?XImyrK*)8-T4T@1b(dAK`>nWPl&T|f=-N830Ka^7p8L{nBME@)cPIqf(z zbLLPM_U0J67FN;~@kZ;{gmO`u3ht2VX1}DWwdE=K_Rxodf|G9zXePyAa(u5R&~!W} z*|ZeqQO{I-1iZAvS*7Y*2K4r}e_m!exwkA8%jNCv7b7WC&#&73{+GOxBWu;&wL+Gv zs(MgbPI_=j+$K>dF|nfPm7$+6FY0yuZ-G%ZQR}fPws|iybWs1ANFH*B4<0b_B%$}E zg?HzhulJA#nf|WBZ_K|GVGAlPBehaAidc8Nq@$p+7NBBD_6>*pir*YLDZm#m$>8538P9J&^gE)5RtA291 zJ7a2OOyh3SqYSUcYI3stzeu~sAkn%lP1I@IJ8j#xZQHhO+qP|Mr)}GrJ8h%)sp^WV zi2m-4)6xIe?>XjNV?6J8%kDzNo~T~vRR5fx%<@gaF)YVEor3kT6@eiZzU!-k7!fJ@ z8jvxxjpnLo>#Chji-kzfnQUDvEmhN-R}0+hl$1KRd1%I*9W1a|MzcD%+50riQPmXh zw2iV8@v2hJ6rqYnW&;p{_^M0;mzM`iq8IQzFK$9a~wZ$^{P0J#e!sCY2TG zIwm9ug=Q!?0&Qo!u(OnBP#*9pHSl)?cl`rt&&=_hDBkM1jE+;w5eB7Z0_*PeJs2BT zlWGfQ9SBTyn}tUF*--5rwGVzwGgeQd%{fkIpr?>B@`oH+{bXkqVEJ7I&?5pFr-Y|$3nnE=2W@~r5ki=HY`>#5Kp(#)4djUnp_8QwKeq+Oq z*2#UT%VCsrAIh5EoRyw);-R||hD^Zxy_(YUo&m{cys7LQ@q;duFtZ;h zgG0_g=+G?$zv>odou)r}nc|#QLpI4SpcbYb#8eXi0F5Mvz4XXDz+OjK@|MgNsh!3> z8n@J9!F>O|T>oIROD4N9Sa1lMa@w|es7&EwzM@TnAuD)K>gJlDRe-QiOKgHVIyHKYBW zD?v}!-@94^*CTtrVrqX#c0{P;R2QmQiLtaxWXyTBM&uT_1feM=1UlnbG(>duI5UVK zI|Q&lbb%P^5JL}x8Ejx5O#g^FP;cDNPA>^TmNXQ?Df)JrdJ${41pwYVd-ed7e5e=MZJe-u8TB0|Rmejj=8`*SA5Kb^ck(w{B(C{QHRpX2 z9sqjjLyTR?6@V)V?S>j&}?e#BN^bCS38>8qHy#^thy*ZZQJ5T=-EwG`oVx zYt?LD^)o3mTHVN>2kqz0bBwM+D1a(N=x3f&uCxZp@zNNq z#Vee0tIBXSZ`IN3bgQ)pqdSNQ(WX|a!OaP9^FwBxCtq@I`@k0?H>zPvaOm7lNvdB%NRR{a&`zt9>DN1POL5mv<>wm*!Pxpkb)?jbrSUFnT{S8VJ z?J$?-7eH5DK_76l*8$s8U?KfATYvO?TL*?g-CUp4R<{efGzH)f(|8vxf;C1R9!pU@ zSMjy0K5JVr5ERxPK{Oxcg2JyWo4%90JUpA-k=<|>VLTNTGT454OCE^l_8iEoNAnFx zp~QdnPeqO4pK@N<>Hqys=3n-+DT>g0p@wi)fTGXn%?EWF&nmIlPm!rE052h5J(ki9 zfOnqQSmd{xk)snqwHT}PI2Sa%y?=Sh-S>;qzEyVbv-8!X#r>HxB4>fFiQGvQiwp*c zPnMBv7Kkr~$V`PRZ)>>`V$1gz*!8}S-h=6z$%EjHcMSGBnK3cM5@EYM42T(dg^ zD_v*qO5zPMo;w>{v)mtrsOeBCe5*>gJ?RC{MJe5e-`HntkJ#*3@3Ab?0neAIQmw}< zm;jQV2775178D?!^|mO>3jVs6$Du0OtVDKh_~u(uGWt5ZjiR@|^OCq(t`-)_ijBi& z1u(~a$XMIM|Be$Jhj=0atyf#kFC1|2P;xUaSs$UTkF7-)@^}Re+}W3`1gvIU=N#}VSt=0+;{btf9i`c}Kk_H;K8t7_%5i)PDOJZPP4d!(n* z$98Nx;LOu_hnWqi@&pDWTEhZ$Hi@jUX6T#gCQorEn;^k*YP z4CHDUTw!fKbF5+tt;4mUFSU>x@d26_+D*H5XvL)H6ghE}Dt|I+?T`ZFxQ{o-vv7@o zvQ0ShpTpu4p)pb;z*6tzV*qWMe6;;v*A1k%<7W&hkH`>mNHC)OAyC*MT|}Xp{y58H zD}}#?19T~t=(Ag?3+*Y=B+d&9+C{$C0{tUKbap*}-vO=D41=i-kP>Q2L33r!Xt(Zd z_pUkti4F_7-KfKF({ypI_yv5m*opz1=YS-gD`iE`^LL-2a0`{y_-MtUMgZNuJon_K z-1qY-?hDw=I5EeiV-K7Vgj3FuEY9EKPy|ulMecZ9^6zF zrQz?}*5BzzRRnLlk-Ck~4GeQKj*FlyHk!LdOV$=CmUj32rM;(T8V{jm8etcspf900QANnOlBM1t1;Te*)ab!;=@xK^iUh)_ z0}!!a(?@xHxW@cJMP;rQ7C94)9G@Tj4RwN;k77HhaW&5!5)Fmq;4r|?z3Q0ElD{Hw z_RWd}|AdyEU~k3(%r4{xR{0C1EC38k09O|Ccl3GuK}-5`(AG70M~ZcQkZwMAqTGkS zrxV^=f~2Ws#dw65p^I)hBmPjF6mqRsn^C)Iwft|XAn^Hbm_IeaU186sb}|t&gg&JS z-=9h-4J;G-?1Z3vaO|(VZ_tmtqNgQ13;Ap*WbrJ#gE6LVgVh}jw}Vk0eKDuefHx@LU8adCvZfDfS>}h_ZgEseBwwJPjzOD1Ebk9vpW@7-PZ+AYuagDZt+k zhDZQwAzz}$23@QKX%zfJPG2XaB<`P9X-P;eVE)@{1*X}jjm>OTld$Ltz$BywRRS=9 zmL;g+VCyYSIjz9YwD1^7Zu2apLT~7e_$%)c{WbJ2KV^YgTG9&>Zsl)a;gPeQ3$Frh2cHkV4&NUj_z3iamr!sz^?# z7R7XjJAYyIv?0aEzv+scOo*^uD*t2RaPnO^;^yA7LY9tJ$P-9hG-mxsG1=TYXTkvS zN+SRSM(A0%cqBz=ou*Ide$2lq3-c3dp)%bZlz8mShY9Y47*Pu! zve_4oShnx)&csIFzlnpM^2e!b`i>d9unEQ36n55YLWnSwFAhOlT+2~bI+4BJRn3@k7=~W8HtsvE>#mLD zfak6;x)x!V$i!^9rs1V$fXX3$zHG(QR4^@^DRrXTOOlrD(Z837P*ow3QK5QoZA%Q- zWTo7U%ofeF4=7JjuhedNiL2I7X^|FLoz`Q?;| zk1xf>;tn1&S=_pklPwbjAm=42v^>XF6FJ@5B3RW)8P2%U4&Ukmx3&DzaJQNr5<4r{ zSW;t>fpc@jR+(HF+C;WRy-eI0LB{(l6d8w2ggb-!(whj%LinZXuKjhJm2s1XOfd2> z_2_{jNP*Q(g+QU|rtks0`{S0fT}%xy*lo|-IAOk@GpjNEl9MQwG3w>T-_RMpCnd~l zMt{RBX|}Ql2ZVolqEUr#7SU9JetZcEy^h#=XCb+@h(NOo7}613(PI>y8*Xf{%SCtx zs;Rg7tcxaPp0-+=g5+|cWge)AFq{T5sGLMlhNxs0_*qS8XcnWm0COeZD|k6hZi>Mmj@#g zT=a`3z1=laUU!%yd=Gflm{&jVt*+YsuZ*uguDbZ)dn)g+th%!(OyliGGB;AqHI_1P zux#0sbN9m?o_3hje3C*EN>mcWbeLPI3``0YO@l$pYpHy#l!dw60rE z4SJ;-xLzAW0fkl@lUwjV0S(g%8;Y+*_C7SNvqT}8Hd=5kEi~cNmxhIurhA(L<_*k( z7(@X^_s*D+7)ss(wsNy5Ywt|YMd)NXQ*NCfYp#uT@Zfu2yiSeCU&n>#z`y*;qQpdz z^HtFicZn_13(Wxyz)3074li*{+afOH?u_g#B&x z0$QBltohXEtlnN!m%FmfCmA{=lPj8ulyEP)HqafAZ!#e1t0?PUrrS^)9|RjRR;y8p(&EYyS}tu<9z$7qUCjI5wdJMQce zvE&KSi4@d_%Ss5QrB5vl{T=HJC_GPa)3oNEyLgi3R=9T5_{;fouZbGWq@b@W9D{ZM z`zY%Vx4lkPBG{$YdoQa*oTwMuVK^-Wg>*Gl$s#4(_$Xdue$|xorp-Bhfcx6bdAI1%ZaMl#13Kr ze+gIxb|!8H4`4LYcBq;^&$_$k3Ow;Sv_GfJT`<)Kbi&F;_$5_c z(lZ-o34AR)4$11dURIDKDm(BtulekLpD*R|d!8q3vTIsoca>v_+u5-~>f6XH0vWu* zsK(#MIL4$3$FZ$$@~NTI^}3aup&{tZ-X5)H7tn&WeqUQ__9NHbaTjQD?(Oyd@FS}# zsx9sC;Vx{r>tZrXZ8fbg+760h;^D3ieRZgNziqj7<_6sL#r-JQ)^WfCTz2oR09p8V zgxJ{{_=ui1ovp4eHSMTu23#nLHDYdPv+Q#uet37g9sW^P+z;Rer^S_C^mSbr)?>+3 zoNP~(8=p5jka^HAAfSntJaBq6Co z4a9I5PV4@pxaW?G-IG(SkX z&kDmF`e?e>K3f;Ie@e{Zby-;TLuHZvws^#_=2WNU1NUO_vNzDzA_H?`JeFO{8bDl1 zUkG@xyvuZHbw7c_X}GHXvAX|L|B;FQ-~Jh#qWWL?a0R8Hrof0ol1o_iK4&Y=lXETW z2fmh({t4z<<+|Dtwni`?H(f*&TF%M(AHwI?9q7Dn+>xGEah`oMzPdBCJNI*w;%MLv zZQ35uib(fsQihU+^tY)YFBZMsy_(*--@bROM?~i7!^Go^_Qe9xWDuDO7as>U2%Z%A zMzQ96V~PXhK{A1~(F$Ekn>m`Vh$Rns($V3u)$FE8a0I^e5TkTt+{eKD&Whei$i9K; z#iPo3_sDSmPDu(R$~vq9Wz>7syOIhqhiLog3SGf9izdbv zQ#jt9`sSWmTvVC8?$6kcm!8TPMLsK~cQAc1r+ye}fD}({G`Rg*SfP&#Xvc@lk9j1` zrbAa?zL~Jm(wJ6J8WZ6^g+D>I0&@Oui63v-q900QF6;@@B3Rt@pr#4FBy{}l5}kx2ShR5@7CF$INder*zu>+)35U$ zY~C}ho#z;^wM{i8%4|hbq3|+VA)G6O^`F-&Ka8f$Wz))G z6||zr6tY!{VQK!uL{X$!hD~gp%{Z~0tbioUsgfrqG(m3SEuJC5YJw6~N^e`VpReh~ zq%IPK+5(P)N5Cr9ANftXpYxmgSwG#xsls07w2*M@m(hcNpcOf1fTQT$r=^L%{E7%d z1|=oY0Gpy~kINhi`nx0%nr@G7<&HOGb|b{PYiKai4l34EJyd=-rB%U3rOpj3M$-0E zriy%(Yb9w%`902KH8a}|d(d=%CzmbZL+!q&wJwcKB$6B`#g(wiRm@T}>7$a0Y0#A= z(bCZOX)Kw4+$y@SrqYPCDW2C^__)`PJ6t=kXFBk_0V@&m`(rqi4p{u32MSAh2k@oG zS@TU(&8lZDjtT%jHxZ34IXsBjnX(PoPr3a4h@3~AsP8CXpP#$!E(_z$>~CuZ)(CAt zWgA>FgQG={$Nm^^>%!s1(;?Cc6F+bpr!bq(UD<}TLN9Ev5;M6R&vWwG>|(@Xr}@b~ zUR_xsr&rJmJQCY)ZnBN*+wxpjCho=`AZ*sioqsxPnf{^k_Lp1y+Z*ww{||0~CLW0* zpxM0B+bq&gG(Re6G9G`#!}Ik%6N6Miezwu2ei_A+O%OJ?zr}vfHjCx=Fv`Y<{V#4Y z{Qt!*er^NVcfT(FWi1ZJGBN+dTIdTW#rnMkC+)lrU}0=Fy_ml9P9cm(?YwmLzvSAX zZ^s5TdB6Q!8<{sj-~SJ7asAxT_$Yr=fcW%fiw9P)I?(E)QyCgod9zFvWHkCCm-%BC zREq%Bt+YCs+%$LIy3mDx_dPh+*!6dNCgw%0$&eIJ?k*6TU z#~p-iHrak08sHchf;)#>jBZjF8M2pYk)(IsawlODNP0Bt_xgP^{w$F6iHG`Y*rBYK zL%dHs_9uHz&N-F2b^C0SJohs-?ybUP0(TfmU>4@Zvj;&XLwrD(a|bKVvBx8d`=7pf zifEl5$^ktdnm;knK0mtzB?f<)4A z1sc)1XHQUyPF(Mdq~&R$1^(=~Fw}3i00rhEJ+}lTAsQ<*qs(3W6G9MgC^Jy(EH?ha zLmnDS6`tDn`XW+cwRQwbYD_siIDNvk0MbVA;`K*@eXchjR7Zjkp2P0oCk>C!PnU`8 z?|8aTykPNFd*~jKKB@o*D!sa@M59dM7O_^kJ?LS(xhtl!)S|Py9$lj?N^DQB`na- z*Degs$RKxqPCEoziutbjr|2Vt?e{O$|w6TLh) zKeaCSEOI64nOi{Eduj0g$HUW}wxdd(&atXzf{Z6*a* z4_v-MXoqo2lXsn5=cvR{;kJf^>+i)9cTFa0`q76D2=8Ldo6f)*NMFz=KWOFfDTl5; zCi{^sKEEZ0X0s)S+9(nIa}4L$Ov3n7h)^ zFwM-=wGV->n@w1F<5$7GrFQl1h(na_h~KpDh=&ho3$14YynIfCC#@sya8*r5CgSoL zqXZa$4EI`gK?h^W*b%mqUW+@#?)?%nqXX>U#xk9=!53g@hHh*7Gzr;5XNt4)LMBZM zqUDO-U>LfSE6>v&00H`R7Y=XY0*Y_Ja*tD~V{C<2<~JUI!9Af+!yBtU{E6$Le%|r> z-V6hdi(4d(y#pLz?fvwc&84WIh0N2e^(~$ULD2C+O53^gx?vRg=#s}1MDA_4kMH`b*(J7O`!t(?KDIGiu1sUnRwr6S#GZV}OhfUgq$%0QbXUTQlo zNaj(hK`4VttiGYA@bZF`L&4x1c5b&^(6@TI-?POdWk>6TDaCHQ-8ORDkWwQs&I8Zx z?en1zFEFj=s$l4vzI$2T>V5C;{0DINx^JVO;~Q0IHx3VXP974`wEf{va#&QE(lsVY zED3|CdN6l}1PYSlr~8spL4wrK?4LzsU~F_iekTjeZF;N=FXU4F@};;7j)Uv6lY8L* z!7XzJ%nc!nM1$Imgq0 z{dTedLTI9Va?z$wsHOAii@G#DRqWa-3HY?(nbXHsVzL$-ALU9H`u|G&HiGyT84&u>}nKj&Zn z!&@W-sFR4CTk-$Bw6AlbT=8!8IExgBHw*EnYD>tT|M;k-7=$%WfL86VaLBqxJJ~ z7=ASeo;<)GXQVGvrkItt5S@a|=V9%u|GRTkpkT-OjbzuFYMz5jE{3jF@T8=k<78rg zNo$TcT&dQE$B$P}IQaFZmTP|Jq{sSPRw`39u4e3_d&BLWyS^izc&t$R#;!KzU5e+( zChO*h6tRF0fb~>UeIlkvIe$R+sD>ye+BM}RHrv#-pdtq}H9bT|>4oh&7a=zPHOuk+ zHdxkMG!8Ap#XVi#abYBYX(V)e>>x~LtP@3#7l*L@^NIzN@`2awDBo;9xI_*is0$us z=G{Jl4*YS-vu_uws~7__0Z|BJ+JQe* z0<%7`2lIt82=Z2l^5j~ZeVUknIJKKnT34NLLRxD3rfPB{yTn%Gnr&Y~I}ShjH_1tD zYz5Z+O>*a-^iE8@8Nue@AffF9Y}DE5$K1{!Af}}rJ+&pAUvo>t8Kt$lnT52Eh!)Rh z)m4P-0^7Iqs?k>V(~YUIyMsJ4v}sMVOi*0mVqvaigwzlmFOk!igJORJ#3AItsik_j zN;>b@LxgAUQj~Y{ns()$$tugBa&n>S!#SSZF~O;s(c7B8mdYFUBbumS8k0BXd@Wfw zae9O41DhR;$gZ+UdRv%(VamDl?=O)BmkR1D*$|vE>={?CQO%>)Y#mhPU2ef~iY!-@ z%vIok4%zT;)fv}NrXW#<>tj~zz>0YAlqK}7;+6Erxlm2*n3jy%C|zBc5;1V>yIDPT z!s#rB`j1(iUXJOp&>S&S14&Y|5vJ3rW4zaSS(Wd$6v2RNFhn{tZ-{4Njo*2fo)u!VKL3Y+LCcPUbu@iVU_xX^6~T6>9Tn~@&?A*7^jCAn5#fEF z5Im)6!sC?RT`DdOuYGb8e;ZO}YCW>namq0I&`P&LH`OyePHJ&gbdH=g!vfh;wW#4I zQ1Pq?`ctQK%5g|CIqs25CKsKk(^!a*6u7B531f`zV4l6>SYM+{eQ5}aSRb>1bqeJQ z20}=b6FEL}6jV4(L(XNPt|dV>9eUP{Mz!6XAS~%QLH)$g0zJ%*z10N;!|(SXBwg>i zy=iiP^UaK>6)A!{iU~wmPK6*Vy>tXQS*t^3e>1tLWlc-+Zy#Ijc1TlGozK?c9%Y zm5u1zv01|U*^u%33RT(WeZ}IDEs=mJF(8jZZ}HH#r~S;RmqT_6@bxc3VWP$52T|Be z7Qa>^yt}bAc5qU*44wvFAPyBQv;QiU3u&dFp(STdqUOLqI1CC_hM{X~AK&cm-vZ5> z8eNT%Jw$32yp^kD+m-f;g)U-Ouss+;MJ`*godRs7<{(wREmKMpM0VuX_U*0mq+uUR zL2G7u+M3CYUB5-k3(T0Xksy0UE z+wux?V0)&nn82EWonz<8T6AuIY@)yplN!i`e$I`i^5HCGHQ|W~{sWRvKK!B3qL;+P zgKuoPp3E5o?Q3*cc(ubu`+D_^q`st78!)eW9l)V8i03~ZJIDDA+%W(6^p7X{KmAc; zVgI)uxmW)k$!;E*GS8BhT&^~UooU)8j@WE|ctrvWq)}*7&{!;a&-?9T#-24;QD zF*lei4mVD~@i5Is+|km|{G0hZL7D(l*kLF#vG;*0We7rH)hPy#VwT}2jaPRw}Mlu ze7-Fk*?|$<6=pghvD>UGTiB`@TorE7GUO{ulSM`qt(b|zZMio@WFl}HeZi$AgS7gk zL-dgT7$&HrxTh2NF*}44_emZ+hW9+5gCD0kt~^M{d?_Fv&dwBJEnksFw3E3$f2m({ zjGmahpxiD6vdG6pA5{YKnrl$;>?D3bgbPoGKM=PyUj`piM|iIiOS!h9Sj0kG;<#5q znIK)DB=UlNmgSv)8bWRBr>*_{_<0&jl==*A3Ppl32|D=KYw=^8$5DK&1unLtEd^W`iKoIFp+J|o8&7G>`k?Ls6BKb9$ZY3U@ zC%Zguat$+ADTLCn+!Vos#QneBODP{l zm2Dtkb`=OW)XA(L_>ABM?4Z}2NNBZbUB^`}*>+uiyZny6 zH}K%=Oy?dR^uvPx7XI55(#NuPz4L$iZgv}r=4 za_77~7tzxZ7;!Ak-0eWjs~^ zBb;@z3`lD#7RpN*)||k!aGh>R2Kzfi#Aq-RXFD)B{NVLbG{Tov0$<_{AMxgj8( zVJ!Nij1-fu^J@C$h1|m4==uO6ZqyNq)@9Xs1WoSR0f-g?=Zpzd*xlThb}0g~^8N!^ z<*S~8$ncCOJ8mxkm>svzXxxKw-YAVITdUg1kb^>DlsWTG!ELYe0(ep*j6*-9B`2=wt0J@95IbGe^cftNsf14oPvcR=OEE?-SsmViPD&i^PMPFY z8Uo6DqnB=^I8)rp6RbSb>2nsNY{iQCwz61}JSvZuf43wUkq|J*NrY_x??_2`M4iY%OGPpSPJulV9tRAn~8Wc{0hp8CB z3tjka4J3V3ahU2YPp*%vV!9{rt1}x23;qGagu%U>*NVQ?Dy(18x~V<#9}OS=g6a## zIyOjSzi5enP97;l04xb+X4y%6*t(E+rv)X^f=Ri$6=f97P`|gm$A8AHoJoAn&x$cR zANO5fQ5gp+Y1Qs12mR1wnD8y9w7{yQ7XzYVxs)D@hv*b#hZ>uw*1>5-8E!Gg@L z3oMedcAT#ZT(3)dI)1CSb`0(TXEXnNyS7jvP)JB|z7SieY0`Z7RHYy!eF;nZ_O$Ej zX>ZSbNn8#Upv$gwMNkDF&JKFBq13`@)9c|fDwc8I8h%d4CZC1+XqV z*=G)$e$>LM)iJ%xEYX_R5lR&5f6yN@hz#LchEo)b+ zHt1_(qKPYKlEb2*@tN)Qyi|easb(|Rx5_exk*sy3=ZIUxZufPl*wb5pu)oy z-d@`ye#5sxEjZ}=uDWfbenlnp@6Jzr@Q3YUlQYey0`60-b1LMy(){Uju!Z=Mshhc` zQl#;RCuS1R7)6hR2qmo7p;08g2`utyOLaCC)ys-J)JbBi25drX z;Q2hk*772uDO3m3+#3Olwf%tX?1xa0WSO^&Ck>ezQ5>InQIr}1@LpB9Qgo86)t#z< zXWa4YFx9I5iF-yt>_52tHUfBR;O`IuI*Skmm0<{H% zj_V`t7;|8Up4$Q-RxBT%F5fi=^((dwsRcLp2*yHLK!6r)32ixYhRMwGmlYx%pck*F z&i;f24Rw=<2+Fwm4I?%>e~srtUtEX&g1ngcMrt3DB&X}_+{@I$GW>o%tkfwMWI}j! zs*&|#BLy!=Vc|hnx9nO8_!!xqis{(n52FK!*WO4Tz}UBD1SKfNTi#8NV$#kkV^$3> z_(Y>2)^G{ZV3m&7)~zcAsh=7DW@Ircv9tZ<6l~R|aN#VDgBx3-*5>QniCd}AoC)35 z6|nCQl*5VvfK6oWv|k}N$N(70!~I%+HRnzo;GjFNX*?y1m91L^P+1FiT`5s%ijefu zpPZ@s>JS{&F$~;zx)}OEfSAv}3@v+67Pw;8?^hy`k1Ea+jzIzhP zJmAz9V!ttQLT!$=n}gHFn$ABdR`k-MPFcjh=4?mNa9#6dXCu>PO_rp)-aL549#=mqd%N zu&d77`0_?NLH7#D?_w(ndwV2(E7-r*IlazcCA4pmSb zaza>94Ae_bS2YxCbfhdhIBqhDs>WK0MV;UBPD>$#jwc3>#p+{~-*^1xt1fy?6*xvU%C~P{Q?uK-hYTm0??l|AlW2h@XVQg4aDTnFhPd(5Hj-%1m?^R29j}PfIb!W%JK3> zJUG5R03yy{zTdhv^gh9-@HxW&samrB({LxlzyDb4QIoPeWJTybReMF?M?s)M5*b&W z$4z9VPz2$r&e3&6hh8s4E<`d3f3&^7;TkNko{aNp=BL|_XZmE1vlEr&_QV}7+NHBS zMPGfXz(7?1tzpDa8rXGf}ji` z8%tv<(Ce{Nd3!1~=L@#dW=~Xjf`b$^M6z~(*z~xx)wx~`VykoYHV~eTll&o`q<7|! zI0{PO+FZKj4bV}4O=%{%6$#jVBy(N>)VV>DZ*gZiMNX-dZMu+cpzu&KE>TB{>L@i> zO1a<_PPx{gWr&c z&TMd4eo(kFMc#^Y$KcVLx4@Ofxs=)E2eRQspD-L_rAsRCrx1;+8h{iKY}<(kk+Bto zuM;DJlrJ^}tcuGM?jcmD*${O%o%hq(gv_l82@pC*?68t5SR2&F+lJSD!5$-o=fVU~ z&-oI&3x6|0gJ}%%lSMJ@Sz^BS>`8m7^ozKy|I~4%b+1QC+lK-qg0t{U&lMIe%l$%` z-mR>4OSPBF4Cn3!9EP-fgE94C<)2xX`sGOc3uVfx&9u~-_?Jp$!UliDlpF>DNVLUb zZHVrwnsM=Fh{FNMP&lK2$=I6UAKkW)usv!CF87VanrzVT0RLEvwqz?WO3p$ud>+V<7@_<0gA3J_;sYgMgiV_!#^Jq7s-9F!lPqkBeu(r|WZPU+hsvt{wJ| zfoq8&&?&+F|$9rvAmhN(9tXF_>+<@E7Okt*|W4D}=ze~NC zOTXz}Qdyo)dX@SH#@C}^zqr9E^;U(Zu(oqUgyCuLX35%J;qJ&?M#Hk2;+qSJ2GB=vAt={36LZXrL-lI;AD!HgNt01+cBHn6s4Ov~i;>mv@d z@C(__fVt0myWWQR@_RgW|KYe}W&WSx!T;55V4?rFXW5rEH*GgrF?wf}&KiNyREvcp zJEg75t`O(~Y>F{93iPQ-_bH`viyv>Fi>x;iP$UVFfi~l#FaW>&e%>&4yI#C+wj*}m ze0n)OybwWfp#+49&T6i?&pz-WBE$$`#L0h>-Sc+5$B@1c)A-c-aQfb!fkJg*3W!R719HFo^8ySeUoa|kc{3Yv-JqQaCgfdz??A%KeA z*}G_FL8;QDV7)PbF!7;Z^$~OutSa`b8Rr285rz!R0i(eKP&;_&Rr?>X(EAg3>`7Ux z51d+;Ex5r@Hui-4)Q`P9aljnW6NMgu<{#*i2sef{HrM@2oZw)(Ups$A>hsOS90-UHe z4%pwKtV?mguIZZAz?BHOC_*?OwG!{vMGM9QCWXZ zJ`Gb+ZMM{N4A)fr4+~Kk3WDCnVI$F0-<_?Xr9*X<4XKWzU$0ey-6@wE2@!?@L_!kJ zxth41M-igG!tD=ThOj74A?I5f{M!qeSIW#+L1~|18--s8skI_ zEfd=XB}~n#N>ddy+1PVb^JjY;G5yjKE= zm8vT3H84o*jTBerPkc&udFjS<&J$b^ei4o+@=s#Z72eh~R2awz6?WyqtjP=#`Uzfu zZHAr%?A$Y z#Uys8fry8aZtc*COI8Fh)?jbl8H^EJG zD11d-RX}c5hzr0-ugAHEVBXgk`D2>k1$p>nD{1NBOXXe$*opLv z4xjd(5Ffo+en9|<-pi#$jSYa0wQVpMc;n4M#}0h88SNSJVL??z=(n_a9T-H-viwoo zDWQ`hG(oc+F!8tE0z55<95T8aGepBYL5&6)I**h{PmH+yMHJiyNuP$MfAmcMVH zbyMG|O=bZDTQfZ8nW#2h$LEfkK*B6%iDQhLxo*t;7sRR}3%O9G*9?`u{gx@xr&iFK|GjsEb3WfwTPb)RHBCnTR^J znFhZWR-7pFq3QKdHkPTB#3>`eN-QX**p5Tw6%|hmf)lHFMgt@3O}p3bTGz&M0A(%`i*dLRH`qYm|s$T>my?3%3vWrL-}Qcrhjj(|q5 zvR{EhSll;CE@wxKq$^*^^mY(lwkroHJNd05Gt^HkEL@E%?J^0&q#PafQ0UU1Sp|qd z;dKO3^{1I#!H$;?&^?(0Y>(k??BT?j9Bm3z%E9#)fdN!?Y!xe>ob)im8qFPxeTYdf zSRgo&5{8g(iHsDo)x#M-Z5!t(y^xX~p;4qRgp$9~^-0r#>H~H;z?!x=r9BfoxUz%; zMFlg43=s64E9(^A=rw4GGP%eGI{mYPMT(=Nz=4xce+>i60Y^GHi*t-j+U-x8$($=hV)a>5rDlC z-q+jNE&1OQ{EZa~_0o<_9U)rX`4;pVS)#L-pzp#h9RYaVT9;S+ zs_PZl{SEw@I{xmp?V{-B@BPnJvrpI8582M#*Xv&2&Hc!i-!0qL9m3G<<7rV_w#T38 z*U|0KO4${BS6rKoP3(`$+Y|j=U(YA6E(%P!g_uhzAuGIB*vGCO@URz|{GSgO*k2l4 z(}dVvc8?35W7{3hwoAfwOW$-?Yp!l+9K%oiw$CQM(dUM@7U$p@M~=MqP+864QmiVd z$wJx#nuUixzQ$<`UG_|>C-U3$X5V>alS4Uz6*)BsdFTn$h8x`NCPjz7`oGf{UP5hM zJ$v|epZ-t0g}D>8DFgN=;OU6%&kak)Hu&tjsx3MayV1!Sub5>>bm<%>{&H{5=$KKL)I3r-d< zCf!lSdqHU)%=Ig&p31Zv<#~44{C;0*g~A~UoSK9x>J-L%AH5plQ#0lj>@P6i$WwRM zKUt%Qj$0SUudK&-8#ngVUYvG~Jejo5rmH&CdF>B;YN%%xh2F;Krd*s+-KOZLtaB*h zJ^W8H4Zk!W)_f&62Ts|uWixIX8Qu8asfByTc5!*^A(xE1Q+E~Ro(c*oTS#xC7Jf{V_UhS`}2k3tQW9a{nbqU*+1S<~ZGjPB_3J;kZJTr)41n2;FfH}e*V~w-MTM?`Y)c)T9 z6X^e9;7tE7d)!Gl@S8NCa&7W?x+u%?_({{F`)k?o^>X=ny7i3g?cVye_&U3BLwEV- zp5rYLqKeW)*ptulHPsUMFM_%fvjnQn&Q!5aa*O|8Pmh#2l;1mSNEq)cb=~q)FhOcn zA0(DLT?W1Wd`!J91Z7%j9Qc4)bODxDAlZvv{oFBP`Dk4_;ue07S2D!Ps`# zJgPH)LX__)hDturaDFzomgq|iAfjaH*je2Ps06~~h#vUUOdF(WEZ9xvh`=S#R5fRf)0|04nrJOXegF5FD`Nd>|2wdD`&{=1)gVEDB+e+o7YLvb!yscmV;~8X zpexW=m;e6P+qFmQ;DW5hFhVhjqEMe`){f!FYMO^c)tuUaO^+Y%epvG!POM9}HB`gN zi~vT)00z^EATVBY`zHag%^XH*SPOWpuf)7Afl;in!+5 zBX!;E(r^Ih7@^H@m^FP#0DeVpLVrZwI{h#K$LXCO8klQ-s^v-l==kJn;1L8{&3>6A zQMm9MgcRME^gTsXneXG&X3TZvgUHO_n}&@%*DR3M%;Kf%1(j?aY8h2+&(v9a@-~8C~`PzkeX}nTo+MnH=VWsx{96 zB0t$m0W9*9Fy}Av!Bj>~U0>nUK2rt2pnv-Kf@Nr4W@s>AYG^Aie%ZsOr~Np;%~aG8 zSfS%b`+k`;wlco+Xf!YUG916Ne))O6Q=t4O7k~Begvz?Xc^bBnKb}$F)9Q}eeFz0ENv_xn;q-L^-X~=GBCLSVEoBU)gYq#bSS$5 zIhcT>{YU)_Fnz$enbG~xkb#krnf));=Jxcs@|7?&wKdy+)zUyw(fcW=XliOp1-|y2 z7xpHJh*s$U+{gfUnaRohb0V<&M<(I!zsr<8e474ZZe1AQ6)*lnKaL;fnfd^dhK!2Gzr-LQYUTz*?# z-QK?AQvVjj{%mvfxc)YH`(!Yh1s#6ve4eDw_^E_`|5&8|_MV>p*qQ&1vcLDrf)uwG z1`qXgC0@k800n-`z~Ae@zUO)o*4kK_?0@#G1<3v?D!{&@-u=!bF6P8ioc~i~Kx$=b zc-J;IrMEo=Vo79oVqgKqxYAw+{!6U-mKq(LhN7^uv3tGB2Z;gUUh=D^%*w>f)CRn{ z0sLzLX=eI_2f7oyj+w5O0ie0Y0r27G_E85Rn`daMZvx)V05m0#rvu1`reGruN@)Qe z2hl$|--oQs#~rMrJk$qgfciuF3E=>UCh9{ZH?Q_1{x4#=ZZ{08@BPPqXbi*<`6o6F zAQrI~4%+{Iz-|c2AoVL|4KNzlhZr8UYzJ~k^n)GHKK?C6K-c&`(Dq(9^swkJJCK9o zdyIe%iXSloddVKdu;|DCKp+1>D*pqu{15c=AGGj}?GVKB^4}o&PML~(yYn#3duU?) zeJ9p5eZz19+{|82d!S$o3vTZ>kSHVj>_D0r=h&HBL7_{}@PF2Q!>)c10+?9q7uZ0w z{-bby;TwO_-)joLHz^lCw&+NvasKeu%gNO37`B9+{ZZ-n4GZ5e63bA@ut+DySr*`xNzWHcv^KIWl(B(p- zeLemx(KFe<_Fq;Tn-6pK1gJ@Sf&y1$eRyR3{Hg*M-?ePm<>95ZY^4HK{44@YP5cDm z-)H;;<=E4I{`sCia)H1q7*Tpjzh1a1JN!&QJ3i5U!VN**ngMd*d!hg#t&Yts?=HBR z-+~dCDs)$S#e#e_fAxl@V5F8$UYICDVta7rFL6KMJuAP7zfNzOf+*JhuKB|6@T#$X z6VugxcZ}HO^=xRdek7wXiR-^|-{_7Yn}1g@-&^ck^aZTvJx2NuVT2N&W4;VQO20R$ zKj=VQKMlCo1TJ3l|4o*RVDOKTF`qm9f!%9fcKTf368yVJUI5g=zV&wq;CSfa4Zz>< z_e!miy}9+PsWQLD=(tW;xY8NYW$!tYuf zz7GiB3zsEN{+4MO;rWi-TcCFc60?VTc1AgBo(9Lsyt+EOTy$hh^gtKgm{)=ce-h@b z+a(m8KY32h>!_B{g$-DEF}-2dT-}w=8ao-86jQDGS`L$db@fZXtm}#I}Do+Ql zGVGOPD_n?IBpHDV`Uk`x?d6!B44U6-z4Q@kmNaNJYWvY6e>`b@6ZQk;k;=&Cl1voY z#;$lwUUnyMXrfRD+qhL1oTIQyWCl8gR>V>ieXmqawGNuK^XYNo9+;+jTNDA}xDF=r zUdAox*Xv*x&dTI$l2pn?t%4)i^vK)qxFj5`qpg!IX^J$TpG2WNF{?Q zCzgp77jQ74I_n(Rz8w1iE*D8PjC~_D1q7pSg;g=6(mfE(`oinq3zi{_N@U(jcsr#& z`a~k7Ob$BX3O8Cd2IpIOd^kTKU3M~V0tmg{qCen~tnup!zRQb&7BbbN4LpSVXC;S5 z@mQ|1Rvc(wMhAD%gunh-D^@2!2-Q>*PVQn>2JlV)Z>&ndYT&a8MTVzpm05bb2l9gy zN2GroAhhzW7>I=Zo3J2HYvrYR_oUMP-<-@7Le^SC$=o`Wr|>DYp=SbO_dvhAY@{}H zQj~6SWJy&P9slF)Lh0M&(AaU+nBKkeOUks|vz?OAhELxPwNNNY(X9n!rp-UC6BsIFxwQ!ml_R4`T2l3 z>_+n2GA~=&S5Xg(KU(W6pvaPgHFkJ`GTOc6{YG^ZkS7Q3)rB#Rse-QCr2%ueTrT#| zbQUo}6iZn$y2p867;<70iq71Df+PbRF-Si8Yt3pLvrn@NbKZvve(0#sb0dKj$HeJG zJoH8*3k1HfN2|ymwy6=YPjXV%|1Pa{R8W&X4^X5*0y(18OoQ!wWW(QOTgE@0l$xDO zVNSd4T-?zonNtQ=k}@S$5kpm3E3(o}$Qbp3<aD9Apy!4=F!PK;SEYpIz+H|jGdhn=Vrc!I_$@Y`a zY#;j|<1ZA{!RC+=rH`k3MBD#+{>cU~dQk2-V;vO1YZ@@YnA(`W55ipcOZ7@UUH5-K zoKq3k8XvZ`40b%NEFWiwQAhloIn${Ob&T0e(jZeOsE>%wiHT^qnhGXu+;(Wn`u9h> zeziCqH}d79kXa~Nub6}E;2P{L?tz2) zF1)IV{wCAV62m0o6e$psFKa5RnqPehq&ev9UkSJm>parZ=gl}tmm1Pgpx=^7N+mO@|FwBd`ArA*nRUB%ToZ#S-zxGZc? zIS=^65bU!T=a}xPwAp*Fvi*EDoSV}4_CP)pxcB%8OWg09gJj8IBdBLLC5k7RUg)}aEevuEau7c^TYXzf`|ONxZ)fjCmz zz8AOh$`N{xR1Z=o`h};dgp#rTwHbF&UC?gp*6z{m0WHZkOpCvk#-`kJ-S87v|mOipS3{y0YCl(b+NUcc#hUr ztzi4Ln0CXaf(^BaLR4r@FJq` z0E)F-it7h3v~y=(J=m+MerwiY=TbJ3aE~k{M4XIaI9)+Z1A&&pOi$EZT3@5=7`sg7 z>6JVdqZr~7boZ|8P#C6E(^m1b$*jFgLTD--*_)JGqy|8)Z&HW7S4NAG3VR{NJbh4p zNa>88%FNMMT2A~*>^Fo?t8YgHIA7$oItBW`m?{^G)-0*|$)(|xOOtK*K(Goru|Tm? z!*CaRbd1K%Ay(evy^+?3V?PXy%lkhXqUOH}8Jf8^k9gUX$YKivym-~=7so{BMh=)q zZ@`9Mwr}vp&^}VCW=gG+oI}ZKcOP)k5B%I=8oKv0ehUY#kgKwnK|zBOPeMfxCSegj zY#L|s?Y#5tvR|XQweEypwc=MgmS)!@5V8&p3gK9Fw-ox1UkXqs968~!>+zQ-1VpMK zSKfKPh8gPaCQPRN7NWG|MV$Bj-@Iz5>W}L%G%y%2Nvt$~?T*opRCKTY<6u8x*w%kx zm(ott_^ff(%z4KvGNDucb?;jz9{Pw|XyJI9?8)Ay2rXx7Q>9d9%#T_c>RykCRXsRv zH`|ZsQkn~fjYNh6YT9*O)1Fkzt|3~pb~P%gvQzgbQ>1p1_{E1KpAOcB-FLCy2_-Zc zf%4nEzS>Hs2)f1-9#=5TfTc}7k`S|SCbHo0*)y~3sol*ZFoaFPwiYp*PzbD_k~%om z2l)(Lj#a8dPJ`R|+^+-oRlv848UD9|`cLt_mYe)p!&;e3fY1`@6F-1B zj6PtEKPxizvx7E4Hpb&CTh|?V{Ho{8nWeovo6L|$JB1u?Rqki9o^|`9kz=6mxp0bC ziO)NWJx%=YzrGESYzV(e^Bw<26ggZ#fIv`Wl?gX>Ep^@*qDvz=g~Irys)|GGK6(6T z)X0b;ueMAdemxJrWUA|wu1q}Pp-Cgy0HbyenokbuP%RVviNG;2;4_ccX5#elWtQ@w zXr2~1-^4N%;l2Ea@T&p!QMQ0ir)6CAe9NgmRxR8&WqoP)w-AoBh7%l8BI4#M+2p;z zLmdjf_7!#ur{4BewH&91B)RwNq?q1S;&eR@Wdy|Kws|>yoIiSGi2kC^36ASYhvQ+T zMeeiQiSRcLU-D2sf6P(!qURh|LWdEtIcmmfMXQvyVB%QhCKE_ltmk$jOM4=c`)c#T z<7V~2Elf-WZRDZdjA}fMi}mtyAQGtlVHJbbuGk6C%~g%n8bMrVbc=uTovZ*5i-WW; z^_2;_Mz>5unJFDh>n6NsU{jQ$^MthKR@f|NUD$xTheE^9oRY~h>U!!}j`C+}9+kJg z2f+P&OxXx%D3>LrJ2&FRGLyC@ddiy~$hFE~A7uZHpM+MHK7?WXCU8HMcTwFuP3GO< z02rqI6qA--q&~sfVC^v4K-<K{k#Q?Mg!IOH~P2CX9ZBYB4l@h|28HmQ8c zzk1Kod#RG7l~Ulo>0Eaw;fJ9a6?<{s9T}c@bmL45^+s)y%(*rn%yi<%*abfE@)5oe z3i_S>o(3b@xnTEQQpUb=(mFev5t9-ZBu1T^znGqT=f^7*kEX(=KoWC2)nMp-o2sy- zf5wG^6xbQ^v2j#7m*T)WmfB!UXyP3qHxj)E`m!U*fzMwHlMhYzAlTOx9%`<>4IqB-4y)ETh0TsVD?6|IkfM!K-b_AFO0W@S(oHHwa>(~Dhem6z|3n8lumQl#w`LZH^n43 z(;+!$vfq`L2*YNg?x&w1{&%C4={@DkYWDZq&&ui}6s;hYHyL;o{&0#*rf&8A`S4mM z)G47&iSbL+&>j+{2!Fu0sTwOQ_RwF^#Pv`ZfD7DPR7xjx+9Z3Gw%*%F^*5Jb-V4iO zb#}bWirg-E9kQ1j$20$UQ7Iz@Bc7fSb<8v~R6l>Cu4K+E?@1#gT53Lb>($6uZUft( z1|h2HSTvr^jB_zR=E6(dr3Xg~MpXn(M>!6}GrJfdr_V45tFlUYVy{2rA#r>d1m)hK z$Z^^O%DxHLz7;ik!pmaH^{TH`uWl9aePLLI*Wkvf(A-ilhH9sa!hZvT-@N2{n8vqe z-~Ze~APf610}@IvecH~A)TO)c*b0jJ081@pGFR>d{ToHa>G0|*zXEOg@_~3!G{9lq z-hFw)w&U4w#SphYYnjWE_@0(YYTU_^TOSvwS8wT%mOnzArSg|OS5}m34b!ZUR&azu z^h&2%bHj~KzIstDdjSFcH3vqDXHIW|(ZQ7!GhrHtzG@vwpZv}KpQF50<=UDi>?Uxz zcFA02;Hw7PAu(uVT~V@`-dSj}%(kD8nMa{Ao~g<-!7$qa{XD_-*sw}~`-&Ly$-^if4nF7S}Tu)ertdaxUNFN>^5 zn8XTv3bek9(_lZ+2qfm1*Jhejf!H9O{h?duMssZUH4*)c9RH5PUt-%bL;JM?i~rhZSblzK07|YdwCqGi1rD0suRf zKxu*PIco#u>xCQ#J(9q92+bV zHK7XDpH#bpkVHV{-U3UEqS+*R(&?wVevK zafo)3TIoz~`~tfG*=1QNt)SNWNX|UE>@)m8`3cpFP4pD)^f3lCXtk>sF0#Fe^>K#a zW>bj53Ht>U(-;CdaLn2}S#|tQfiJ}nCmyn@D9GG3d43WM=u_<~4MD7l!31|0S>gGK zy@nOkX0}u7(o`Pb5#UbdL~f@@EX={lcWE}5-BD=#D#@ayn+2hGiGOc!?kzp4XKedw z-KdIi>^4XBJ#f;y+mMwxyX;6LkX$C9RZyHIB(;d`zWJw%&Cf(AQk@%l2E-oDCW7QCVjZX)Ilc8mMg$zxHA|^O;rCB=o5vcsxlS zIBp#}?%5uwYsfjOchhmL1r0s}Dv-UHK`%d15dfb(*KZj1U1fH)bU27k3RVQPXs^EJ_&V|7)LBTj#COz)qMh6AlJ2Qu z{tiKn>p@6D#%n}hwUNcF<9nk9HdE_;v3ZwWXKf=H!CTb11z9TV>Tcc{u5u&-{IjO!Sby5AS02l0Kz5 zz%50ML}LDs^LB}v{HF9K zZEF0dBv_hB_rgcWxf*Z zw-!=|CgUTs6WsmM%MtTagpoPF66c!c3AumXO`Pm#L4>!;pl^UPE7CsCOuOc8re?v? zl_+5DY-b?kC6!I`N?mt(AiYv!-jM4VBvAzwKiz<$EoQ!Xx{GjSBKdDx%E7R{_6r@uzVd2LaYH-ngbQasero0e5wOSQ$+k7c$=@XDtG*W%LBn6jspM-Ps+v>=a zHAzi#H%jR`%q5HGxj&zq7pJzwgd z4p)NgNR@2kfeo)h6dkY9-|07bN8_G3@r z)G$E@KXa8ZmN(?6bRD^6>d`&ieN#}e%knw>h#je|%jkfVxIPvBnOJoE6$QbdJV zEHD}r^PD_(ob50{+4`7^Rdl^-g!$M^N!Mu|$eRvu@`$#%+qe`kVwTayp4e1p`aQR( zO_PUOfYODGwD=0A2EL|g`+>Hkwa*d&;ne#_J+I+f)G@PTOuuUWLM$BPB z#VN&TO~l(`cU26|#AR!2j|vo(g2X0@2OptDKax7QRt~(G zd{7byCecQYluC1~)Hn%N;W77yy;K#G<4$=img>=Lr*cuRq7BeO0bgQSJ;_Han8*!? zZ0pZ?$1J}*W*uq?q?LV@irNxd8KX36zn!o%x7eE?p93?X*0y=U+)S4QF%C&}#gq!- zcNRCT+&tKB9zi|?@5d?bHzlfzVa9lRgft;bi-XuO(CI+QIcy-`tQ@H-pbXE|#zl^;UXTe^z0gG~S(@R5Q_$to&t)9ZQsx%)jn@wmk-QR?z==4Ch0ed2j% z-5WS}y}{M^+4NDa_-xsz!2cU6Q-JC%TjBJkQR;|>>*#g}t5|kWf@qv;)rp+#+dHT~ z@g~x>C3*;dD$Z%SOCV@M@Hlbt)UUQtIHKDQ0+RZkv8Up-LVFqDW@#x?5au<&etL95 z%=2t+(@_G!-yT)JiBU<#X`zRJ_KBBe8T;2?H*#O$%IeO)_K|#`>doQapZdTG@4Ptb zH{X3!wmM*U2p-leCkHz|Zy28p@ml$vQ3qak$V%eEPIY#DBUK%}=q9wc@=JmhdIw{d zdidW#aIQ2*(mW{38UP^alqyAz4I zv`Np9Ev9VE6&^QYu{=abpkW$k>5NG932(31XC}H#wvDY6iO88Y^TQ)7u^B#+C;3Nv zrD&4;O<+AhCwbzaFl4g;xiwLDYUyCzSTiAbKID>vZ1t)5u;KOs{ z;nVy@N^cCDCi1s^oNIw~-L8&-tZoD8AvDu*$#_7OAj%XI7 zTX78fBW%Op0WC^6lmhYcwK{SWd*Pq(+U49reilS`N%aCmk4qxwY?;?5zHb~ayOQ@G zL!iDfkwsf~)BfSVkZlelBlBOgj;TrjZbDLRgFwixpmoLJRPQRP;bF6wplB)`+)$}l zQ);`TgX>`pmN4v{U99gTV}%Vt9hFkA)n>S1oA5jFTY;&NLjx-!zm=O0rzem!NNcxW zQh2o^G+*r;Z~km`=YA?Tw->ONXQ1NNn2k8>!DR*~!#2mMS4yZjr8!|aFX$AGH;8-Q z6if8gZ+ zv*lXBmC1YmYlytl4<7n7FcRrv-4&(GgfkVD1ZBSV{7#nA8Ozk^Ikh~-QdlnE68YYI zbv-qyD~jYfA+G*#LBSE?NX8t9i@kA&DPh-NxXIxR&V>=fX-%1ERF;K;6{7TjpI{Mb z+cc-d-?kJfcmh)ed%01pX_lw(dIBoYa68-%vKa0#=cZD1b z|8}T*PX>~36hp)E#%>MO_w}3~*|5okk+gucVYJcUY(U$4y_M~Cv|0k^p-wCo3*!@eu_wct z*U}&(UQbn>ma{606fX|Fh{aFdbdLCKNCshmtkWl)yHNL^Z0jb2VXHU2 zAzoNJXb7VkJMbX6ATo8(rU9*(iLWYZ^2>sJ{9Z8c{t{XTy4bfui=NyeKe|^MeR(u> z){Ez|c_J$KWVO3%FCQSuC4CXK)uph84U@W1*tJk-{HvyyR5TQQ5!?XN#F?7NdI%Pk z&Ou0I)!rrCo0GvuOl-RAw2LhYlI`B6XGWWjRa2fe7PL?Bqg&*oLt=y%q*Hxvy?@ud z^syog3^#GN_TseEkBTVUI)Y4FebGpN(-tPCxWIAEC_bEB@Ecxl6vaLAV?8h;3s3L4 zI9_*w9FwZ`M_F#<6Z%1wlmp5EQj>K8-w>a>!JJeEH3yc-*CxZwrQ@M-p~!U_9z!o( zqMXQ7nG&8w?DUWp{ck&nH!0M7NoD?s!|RL@!QTeJouoBNh=tCbfEGQTR;%GL?d@z5 z{&9{_7rn1$e;S3|nWje05V9#RrS1p4M<#xvYzlvDCl%@oKYa&^0Q=MI9$zz^!An)B z6AYdeU%um_T=7Rh5@<5Fq$@v&Sy}`w#H!h}u!jlc{wG4(vZV;s!Qp+*wMS0$m8uVu zh^G?sap)LZc^}15m9-`!7|y?(VMMD|eZn;iYCu5D`NJ!IMe&fY=QNyBIuUPZ`6pwW z8t|*J)3>q`rf_8j<*$a}Wg{!n@+aX>SPBZ%Q0dO|bhr#6ek*Z2i|(#S-1b^_VjY22 z<#_hcDNn?>8O!QigESeFIoYb;e2}gyy@sLY zcO!n+Lxyh+WFUGvHxkii?^;8t5LL^GJ&(TW+^}>cZq4>)Fw-C|%t_&OzY>fRf&?Is zcj3X+w^VB>WA2o)(G8G1@ei$juY$=hYPK6Z*MR6=0Li(f@GKQb{w=nVxDZf|Mfq%C zo?K%=SUL-b3gjep3G_;MP{=!GQEc>z3EWIPC8iPK3g*!xDu)X)NYhPAbr6c_uk|XT zB8oo5u32J6-mP*Rlrsy=ZQ5!`Z*Sv+e*DT~+KgQ=x#1N_TnEm4Bn5i-Or1dh>g|%R zK5u`ad?SKw-XKq8Wi4rza;LUh=Z@w4?WNfS++pap3ih=PMu3o}+Nss^#`V7JTS>=R z+xDQn6{~dwI}SlQoHi)1BW&3yHduW4arfuRcsvLaPCweZ0*f}Jqbsl6Jh%JK>(UQIcMph7n<*2(`(x)t^%p zXKx}NJW;=*wUQ8mVIVZI;o>GJVFqcg2VuIUFOgcSpd$TRO4R9q7nZN*xmu1(v?gYE z1=njne(%Fu(ADx%2evopK+fw<{`?!~4#ib6jGL<5YNa4y(`j!XSFMw?12wx>T&4Aj z{rX_bHj$-#mpKf@jCSz~3J3U}^-rF$X0DPu(?yS_ip@Yu779!f-yXzY zW|`-gcCiqiCbb@nZ1H5x*+IOnhgl7*ZhWv*q4tX?bd^t{NJrK9Sy5+fZFiMK-fi1M zN(|NdWKLln58(a*Qd`o3R~c`Xs}YB)9VcSU3xiL(VH&IOF-(p2teaI-7XE`QhBrc? z?Gd;%j$TLnS~xyd13xoI(fh{pD*9dCc`s|UPtQ)7j|&*}yt|@W_r1hih1kmtDMOox zhioxjg&BbUIAd4R9$7h5$|$<$ zkEnG?w(G*TuTslIA~i{yu+5KX$*@KSg{2Lktf9ClyOF6t3=k3@ArxM;txp`P4WC9z z$<177GWeY}Npdj6*WQ8m_sShF@It(NXPS~FaCeIN9%bp--)*<okd+b*ot_>QhExQF`k5pDIOpf z#UB$buld7;YUU0GH4M}6B=Iwm3VE;h;2n@Wj}mQGcOCb$P!A$ToYXJ`Tnh{w(~C0l zz5p%KZ^+!Y0Nd4?Ar}b5IZm&F5gzm=5a2ZO)Q}zCRY2!x#0SAfnfVh1Rb0k+TNz-g-^b4n$>8G+vHCE4iM=xDW;riE@jtD}Ng?!5QcZt3l6zeOHCG!?)YeU2yUq7IM zEp=xL`;9hGeUjCzmUje$l{aKC?*^ae}Ne0*`BCEaAe##=;Ysm=Cp{$g{R)7|vzczKT=IzTr_(tX`%t zyEkbcGp@}OxT^qqeUJ#6XXS%LKsX&rLDnKpid&cWTz7P_iqmOYPH*MxB?FflZZefe zq8pS_W}`A#@)&$YFSjsK0Za8v-+o&k4$2ic@PyXxds!loi4xUNrL8qDKH87gR3t`V zLuqy)I2*6mD6a4a2HdAhSs7+2XdrK%BEm6BkYkKH3umY|OJ7ADxQPaxdKve^o#cI% zGS7zf-wozkmqEBwg9}(bsL0~&{d0Xy#D`dKv~QnN4VCt*e4v+ff{8*+5gbQN=}Y?& z5ffo|xsO{^n>dNj~TsIeljP=xVRK z2#2#MH_!NP>VDpvZSXSZ8Km+dRS}j02@Z|l=ZSoh#{}-Kx1mW<$DnX_&Y!hIE@|x( z;h8F#{Y*r)-k>JhKx-0(8ELmoAEI^7FUdiTL;rjjuI@SkSNiP@9xdPxH_lC6l)$}=7rpyzw>&Z+VK#LLf z01xXzyCw0}Q2xTPH^1NSBQsgSR9ivVU{5{2+tS2e_gi7+u@op+h9vd2U`;F4LEzG8 zz)x~NQ?}8~Bf;{}2}2|PV_(JmI~&z^1sj~Q=!p-+9TnKmH3_^V!7l6Kj3eLoK<8Kv ze6|?3qRmR1tM{q`cXOY-y4{$yI$JL3*ljf;Gr=KI6mTg#rPozLQkjK==*V7Efu+st z!;yeKvTkB@NtH|=fUdztq8Qr7lFqyA_78U}fU4GI(-vfJpk+227h-(P?hc;8DhW4! zaW7&@WWv9~xTvp$iB}9ODPj|p(})Qujh~ha1L=kB_L16&>=J{{IZUy&KKXSGJ&ZKQ z@E}Ym{sMwbdebv~ydef`E^8c|Y=G=ewX9V=8E3cHoqI&$f_w9&ACn=ED1CzI56gM?$qLn5)&ekENoPJ33;MAp))OYDhV(Q9^OKC++lObSP}D zq&t2Tu!_CVU@_9gH<>m~vB(jIYq~z!uZNJMV#j61yl0V2t1DSTQE!tmOe zPQKQEB+swMD#9zf9RorrVa;C)^c%~;md9Ln`t{|qBl6;+ElgE+WaGbBe!?uVMpjj= zCXW}p)Y+Ah39RDfPKLV;+Fkq%g|-i)exB$}gSd38%6mZr4K?%IWijv`IlZULLw;;h z`0GsxIK-5SuRl-knDQRa6XwZRLxsI@o>beW#SK{9#95|Lf9k~Ud*u_`{vfK9$t;f% z^9tCcBAxfwRpx=b^t~-YU3?%5A$Zk?;(%<|WyCPDaFL}cvRl!TWCGUV4cvc6AT>VNkg_^!+qZ+!fg zPQwE_6OVG6{hh#(8mLqS-{+X9%shNL9kV-+8pS(_gl-F3uE-nq5Fjx1B>i-HL<=9O zof)*sB_^8p4FKP=(BvZfp}vVMV74z>Ql@yML|nU`vimz6hOv}t(XGt)2M`1wr$D-V zu#2e@t?U7G5HR=JSSi7TMxJWx!3MM+qo6SS9w51kB4Kg&>lNL0AE|b%`z4##gOORN z;-w5Y99CgmDI^gJlhDWei@2=oGg zZnn}^{sZJz|E2ajVidC!JCoy45Y|YJaS!|2$sYns9a#am)vVm6A5iyBB}>aUG4aF@ zm-m;*(+WNdqBfY}K$6jT!LT|9AiU$sZ2jG6?X%s9qmd0MtNe`Q9AJ>$<$XMVGP!X0 z+<}t=CjD0S$PuHW>a_Wzye!acSwcm94LN*_>&}|kL%HH$v?LH_SLYk#QK9!4(Bu7< zd?k(Kw&;}avEMQ%xvnZuR693Ww^?emDO6%!kc=#MC2C7>i|Cc^{)iYJ0XN*|(k%G; zD#Ai^tYVR@kU!yq=;S5gNf>mulQ1;O$2AD|gr3XP^0V}I-MMyWvC37zAa5~hDUCz> z1qx=|@%B3(+lz7^Mxr(}8XBJuHrt(OLY(f=1dURL!(O+>NFl2X{mrKLQ#qHdSF<|f z{kuQsr}@*G3itmf`R{fMTDi-ZfGSskx757tJK|4g*m-!PDbdLj&T;w&0M>c2gxw0I zrBVb%$qdD`g>9a9rZk~SLdeD2DpY_JejEY?RYjkwZSVfU$b^w-I3Xil*%sN52axGM z3U@=2>Jos_Y%cP^(Gj%5>iRG{F`D#$|L`@)#?Mh^5v}i#1(m+!h%K)|mJN~|pN^T0 z@yL|hGqf)9LPl+tX-XYmFr0_MXqnnDj$PFY>B()AKJqkJ3G_Z{Q{St&u19c2FHZpA z-(fm}$WRm9n;KK7mM@2)msdWZ?e5^^VWLy$zWlp5tme5x(S*~Y%0`- zHHtz;>u|(|*_%n+Hh8D3^^b1Pem=HGqH7(>cb>fPu2*pGlsuf34OKIuQalr!^w6Oc z0l(*(lOj@T#bni|t+$;@3PZhNe=51Lb-lr`f$>@>BBXRv0*tJB;=xK&2V;;AW>`p8Qn+SQW#9b!3QQKKuWVO5PqP7cU%U)jrAP@+FjXRazORqz+)S3`Dp zt)5L%+86SkdbU(ia!5cr@)O%4IUgeJ-W2FRsA`_Vz$$zI?pw(5|BZ7wK6L=_%gi&x z8RN!`5(*jrEbUI#wqTB_I+*?YTTS}6A_)tMEjGqc*c;rTGr?e0b-^uwXyZfs;;OXE zOv|2TpJ$^rU?LAN!p>Dpy2iTJc-Ew^5oqwAdZEk77zNp90-|dI{c-T}Y^Az;7bp8B z^r<&6O2}eEBU@8I5S!f1+hZXju33-4Qj{<-nSKb4@LRSxtto z0%p(B6g=@-^00o0lfU@Z(*qFI(1-i$2!xi4oTE{1!dVmNLw*qk+rAcp{-;_OL|D2w z6J!WA-QkbTa5>}V3mzghA3`t>Dph(bWUJk8=z*>)7b!ha#HK6DKM zBKS83u$87Z?GS+ycGU(;WBTM=u@-9Zj)|O4E&O}Gax^P(^{Evqj}{f-RAH_7*{fZv zLs|Pb5dQd8GT_~of4Fp;B?#R0r!#?n9U8t+0SV%)h+A7BtaQ_&ZHXPd1ntlj8j05W zizC#}W16mkMkOlEV5_@O#oRxg$ym=~y(CJI+$QR>Yv=evz*ZMjqN$ z40m$f&G!U!xsh90vW>M5-4zx4SRrPM=WKr(Z=W)y3!kp#1rIq28=g?x66Z;vTDH#K zi1at7GS3D#(ep4z0Ldx8gxG>eBujCG>@_M+3!a$-j@NuAu#B-9rxrtyME?xOc=GGr zNN8@b;`Yd?&%nf!Z+RDQ+@Ao=79T#xUKVM>Imu?BJHwf=+$ctJ(K#NaGaaADM^QFI zN7*T5{|l7q+;!9`id z&6Pu~I{#>eVkiWQFExJ30MQi|l=m|2`4ApRaZs-Yh_uBUFK6**eYoo1QzS&CUV!s; zKC$LQtIuOMww5)kF{d!JRfNR*E&N}Mox_$WT99qiwr$(CZQHhO+qP}nw(UG=+jYll zRihg3C-#mJYsH+powG)4RY5_LFF^c{2R-m^5p8^(9MiqVz7=i;hC*9aeR1A-^%R|8W+VA4 zG&_2zIk!CfFrj*x9NG2y#o0xodff{-CL46VM3k~%T6DVK!6fL9CNTu^44$m&k{h+_BS5!+Z}v7jgy3>P4yw>coo8jCoY{@-0*>ani0ZRGes8`X1X3iczb1y?yzSb zDKwG@kX<^p#MY;Pdj~N@z`3dL*>(D8f}L4c94zX&yZziZ2XjEMtk2k0xizNgEW1OE zv&1anbXxUz+C(9V@tu+dPMmhEMZd~NIr#Lv1q{K5jeYlF9|+{DxyPtW@@)6jK^*YVi7>u6nzB-Dk- zfR2RS)4(bbIQl5{hs&fl`0e^G_~GS>CrRLk#O>s#bZGSsy5m2Q{6`^L5GZ$rq}*$B z3a(q;>YTJuQ{$NnKLNdAs=bP&Iu{8yU-*DwJl+0_G$_ezqh&KFIdBJvE-;=+D@ZP1 zb=C)@Pnz(2Xanr-u$|5Uy%cfV@RK+(N#glS?Gyz3OnwnApEB-k|U!STgnv0q7nw|K_EYnY1td;D}u z1jU;-B)a^9EGi#Y)A5+~!u)cY;AD!Fkww}{%%of0a3sn_ZjBsVkf>kE z5y?YTH}OT0_WMFpG%`Bq`Lydvo#1vl`=M&=6}ZD5o?^}^3Hh1(S3K^kr**~fZzlIc zF`(e&5Ds>oWp-)?6g}E}Ak|TwayC}|nXwjS(2pM_FGkmIE3E#jn4?B$d>mCv$K#0x zz=?dyWa3(fn*iH1WfmH|Ttd7nD7}bW8>Qx_Bogvru@MiJcacT;uWnlMub1dQj{U3+ zO0G;trr5ma@>?pA=&MI=@8+lAUL$F5quCUP;_UjcV}=kt6~q&>E+5!k115o3gdB^+ zVgWEzZ6_9gOG?X#sm#4|H}P;9rDTp{q9ZjWCsnl0?Z1(35^P{^1UniGU(I(H44Tc*Yu6zJgE2V{Kh_FlcuNRk`-ifZGr4V=X#i7`~{ zsw7*k?}zkf=!G zJSUNv7+%qsKf}s2zfa4J+$}Pk{3Ga&3l<++%H1&3&I5ji|)*; zu4*F^!iZz&@Hgl_HeeOT)Q_oTk=1@?hx496*and-ultUlcaNNH(?FLC?E2e0Z#w^; z$dBb--`GuLO74O~>R9qZt>{W1o6sUz2MtQ08a+c;cM2C1DZ(W1$K=y1v|iX1(I1{t zds^j&Rtr7LzKY;P9Yo9EI7t+(KIZPQK9y2vuopFJrhY_gi{O&7H0ovn-0hQZ4g7Sn zYqVbc=(Rc#Sn!0BXW4^u8i)CNUcJtTJYnm#e)bGBt>Fh)miz6Zv}ZpteJ;!XC1U{S zq!qmXW9JT<_YvdQ%!~rVd^B*`I*w#)rc^ro>IX8X%UHDkJP7Tkrc}Ox)x|~CR_~H} z#6qRU>u(NEo4YEvSi4R;P~kyzElhQ&v0>z}1x3yq>`q2NnoF?$NxMOCPlnM9Of8W) ztngUi1++5wN2Amsn8n?d*ikMH^KtwL^bFTaC~x!a+_$3B!u9Ph{4}MGp5_VpllL^O!s~QX5UsKqD#gH^&Wj2k3$K9Y6CV7# zV^AFn?1X$<8=4}79qd(-CBef#zCwtEN~rRTyS9Gn&Kc_ z?7=DdMDw;}RI=S0?)lv5#;*l9b|jJi?E^-Kx1n)=igTWj2lTo5=R{@GN#T9A)-p)YuiMYeU zn)gqzb)RokgCbr^Wwcdm%?6Zyf}3yPCAd6O5TzMH(y8knaPw%loT7BxUnthfC!v~qN_}W?RBViQt%RR7!$|ap@GDfa7o;Qo5S4jj6ljT>w&7HqlfLEJYb|^JVX>lcdDW;{_RVBoPKAK8*`4-cH@u z%F{MHNK%Qguqk!pM?HN_oq~QSae<+v#X8&QYoX^OUJQ(Tl@p)3pv_#J0c)1d4YYzF2OfW`QCR$bsarizv^KV*RA=>8UiCqRV2St#xr|H>c-N4ZCJ>i z0pR=JaNM0gnSP6nTM-k}n-jfVMLWp?tCu723DO8dniorCfmg{j|AtTA-hPcHW5l%sXJG#tpdBtJtv#u5jS}BP`MO_HNLl(=J&#GF&Uw8|!P)k*EBe zqeI)AHolqF+X*WxUs@!(*tS0?Gd8S7ny8!B9lEhV7Z{xZdZWjdnab5A|J4>;xXHR+ zXY&}BGZu=^179XjZ0Jy&4vGtN^Cqj#(!@s@B+l-BppUH*q|-A=@I|q`JJ*SQJBB_R z>YJv+);nc6pWo@-`)Ls(aAN*97enF5C`<~s2`lMYc25fQV|3q~re!<`GWxBXs45?2xj{15lpgW?*5+q|Y3W17NFAH5s)cP1{hgX@kZlkeHdLIo@M&l! zu@`hXaOh9qNBNaN8qSc3y8Nac=Xp9xB(Cbs2!JCpSyiyx;?S1yN(^Phk{2UdDw{Cd zCvO*#gmavm5UNcQ&KdqOa24rHas}1zkQnmbPLtRb$ zyfaU(_#|RZG7obX=xvzC4|XA16!DM@J9Bgh0^1i1F?K;lfkPx(hs!tPe`Cq?j7c4^ zpuy#P!Do|XZ6z#CYr5NV65l*dwqNIyW3{`iDF|Cz%`m4MX#U~K*$QsyHD}=zjqBBS zka4_*^rygFznCy0q*D&&JSapbBb>wX!uqZEIQocRhu=Mc+e)=$rCTHQ+tCV=nu+nE z(#-?p`ws7^6vD#XqQ3Cl`@Y0mkh#0mHVm~JD#dPp3q*V=oW;f~3}S7M7Q*b+3`<~F zKxh)M69Vc(d(yLd>@IQE{OTH*!0E~KEC=GM^UaI*-T$rSl50_S)GRU%m70*T%fhup zni!uP!wT49l8sY66l3pr43Chv73gejs8@z3IHDjB%s$!zaPp``k>@Re!yvaXnTpEy zET!Q9>~Yq3f5Qj6ISK!=LcOsBS9-%VBU+}Zoo@9pFkhIk{blG>b~!}UEqohvc9;Ud zHM#r?#7)udGJIVU1}!Kw0JC7xtSR;a7=KgFXZ>QZh{-$R@CnIO=s~+28rCeDS%B-i z9fI)&xZSmgxx(I2rsbaE? zTyK3T{Tv>d0`up4WB6MoQ#<_%mZ7$4(0djb1&gQ=MQl(QZ%J7@BJ)=(|K z^wj5zYkL^<+ta4Di%9~%iy#{j#(}BxO4As=Qj|30(vgG=1Ov04ALTp$*x=JBD>{T6 zM8SagzLRQ_^?l`7qi5Ar=5oj^3n)xH)5E1Jn5g9uG)aeh+U;$O($s<{PL-$`G7XkZ z)YJpZDh$F4UeTe2hGU4=9iP9Y?Hl>TA(cJgsVP*yG;2YO`6!ZHlUefC0^3?VSFh!W zH%g>qW%e;EkDltU$_1IDpLke!oQ}_l>?R_pu`x-mZ`K6o(K)7*2_`wssGZ5~P{ z)K3T{X|-&LbACo+&dc|-{zev?>uCmAZLRzcOwrS-&3pntCA>wQ^1z4J4r^irp^x~(mm9P_o0P?L%=rM^E`d>u+40ua7~%%Van&Ipr}An0sOCe#=MU~ ztBfK}dAu5B08y|DrCwmqaM{H`!AYWl;zQ8EY~h6hn1rpBwrn<_u5qqNIx3;w)yXZ~ z4TQ;fUl~aibKe60b7>iC-5?L*9P{~rQY?_lFtom_L#8E1{7@kbSs-8s5Kk=Q#D9O@ z`nhJxd^dG%*`&0o!jB**4FZeoZ(2mrm;v4y^%H*qPIqJG?1W5de0Dw57sYv`gnmns zad(_fqh1i(hy^$9(quCqdXMjXHkaX`q41;Eh=l{>=qbagvdKVMug4~^&Y|)=&`6v= z!9)gRgzaXdiS!+v(`9Q9>zv({13B#f{`A~H`>{E~S;WEnLukQX2Jj>#zi+jUF_bEs zsg$-j{n&%oDDSz+S$~}=(z@BjC~xxIwm*+O85kD63V&niBbXr&TS%sku7ljZA;j;} z26c}GGwx@hmYr$cvUtHMUIJiOiLy>G=Q$F<-9%$>eZStyP_&&l{oHe-;@u_T`3r&; zEqC;8dhy_~I*(L$Rz!|{RJs95_){Uz7aO8oG2AXAde{>BWs_Y*sRVw-bX76R20Lt7 zm5--M}tj<@8w)|nFKe$@pG@a3O!N#}34 zil_)iml>ScT8dv)N;mMfy*B8MjS)%2Pye{jc3R&u<@3A@yUMvgNPKVB4@ z6BPrI7=q`e^~k?l&TAc#@jc{)c@eu_7t`gX*Is&MPRDZ)bg;c?MYx`(*4S-p|2N>~ z&(>Rx+{{&>ZjLLKF_j`!K0@#q$)2rveW*~M%sCOZcW(p+MlHX5HHf90A&VPiW!Q7_ zhwS8fvT+chzXh^dtztqmIz8i2nHSH4Fd?@qW~`bdfb>~#y(G@72zl6G4P7ZsVnqZ= zIbjRMN+Mi@`g_|f&Ebu%NN9$C8YGhR(GAH#WPJUT{NgH;nQbrou7qHgSmJm znWk)_ie zc*2jdTu;q!6;AdRtsD*~$WP~ZZ6)4E`&%gguCUbON%u6Rv(2dI&<3eQWMrG%6lUcr zU%_%(#U)PH&Y}QCRT?N=Qj+J9&+PUp*wXus2t5cBMEn=^g!UqD3R|*v+~Y9d8TdE6 zcy73y0WWuUo|%@QJ$A1TWS95zUiUx2X-?r&tfz)IB)62qCGlm~c*QFlH{C6Z`y zEwZl-7`0=7F@pKK)J|nuin`f69UJ{^9ZP1(J(;F*}06uMXm4lgCHtitP{IWt z)>oLZ@W{kaqAE6+YhD?i=l*~8eKCI-xWZ2P$KqosP))r@LM~t30kAGfJnI^ly@ihw z%t-XMnN|{o{IHQDi<04Wd%?CrYV&l_7>IYXjZJ(m*?+X@zM+eY_r@ab*(VIG1!fi9 zKQlC8@w%5TkTrmUu$S-KGFW_h^mc0Rkm9MPMJ(67jp9BD+>BIdykt_%SfwcYeg#4twXoK_jDllBQgChr2jgrmR(xZmNJak}7HXHf zJ+O$x&stuChG>x}X(=YNSPL}4=-;9VfavtOdC=fZUZCtMm}V6Hvkd8SoXg!~(*<#k z5<5pF>GJGR!@UsNf-ik+?f_QASjO`xLmy9G>g1wR^V1f{K0G!=Z)rwII>oYbd)t{I zXU>GJvLiOzN>o*jWEuTuUq?))ZxQ%4LFfQEy~fF-j`b=zMhNzOrLSIn-LjTlB@PMp z@Oa2G;Hh}v#d~5aP|czo05FWULpMl4aMHlgAXxO^X*Q{uY|H`!|7ENAJ-;XM7Hbyp zLY;(yj>GqBc#Rs%7BHt?`ox+!=G|4^gNMeJ1fH(UaSZo2Q!fVP!dP43kl6Oxw(y{r zdxMewcfy6wYd%kqXkv}o*Fx$-B1}j|05eHNiOM>K{*cb{`{z;{`9vEyuWAhAZK!5k z0QSWeHgW_`(K`;^mrr@A-4H$RO_*KMq`c^Jv2^%l0VRbotU)cZrY{!dAdF&N#reJ} zA`&+A0S`DLWV9DfUg^rjX-Kg@@Dq2Zpi<}08U>o^#j?hc=s?-TxfvKY0KrWHFRS4I z%WtP0?QRfY8F(sfRX>R|w6|n>l$g>RX%hQNxapMsagcb#L=6wbuGahylSi&Fr)0$v z;;Mh@YvhWv&%nl>wJNt}ANQQzw8}6%eZR(RQT&IRIXb9%VJ-%Vv(#Rg>6(w_23_^o>=KtW81o|1q=)ThCuV@1 z*s8768`b)(t&=9XZ$&>W01FVfp_C0KoLBnie>rl{?%=o*3~-7ZpC_qR2Ht$(j2;d9 zii9AI(grAAZ>UZ1&P$C5>$3X&XYqyS*oehmDE~8(b01uYJ<@fYtEImtdW~Qija3LV zaGdTF!mo)%xnD_oj5i!^MS{`F#6lDsZbBPA`T3*w^l*hlv}@^PM+^Jznq9=LcCe+D zXr_W*povXC?N)73=j4emVdy4Kx2Xz~T{z!gW|QJj2XyIv6K>=Kpf2^6-KR69qrz%M?pEAEI)Xpl*K(Thkct4G?#_;)^!1ufLM}fJHh9zP0g0An!Bn=l!D* z%W;2Xy9-Ob<(8{96STErqFfmvNB1v857SFZR7A&7RoyyVJN^@r4F28*my==W3VQ75 z3@isCkD_V`UGcrKqhqG3K7-#VNowO=K2E`e`9iu=UJ8KOayGv7x&isA@|O-j0U|N> zH;6%@B(RZ!a!VJdXsi&8FoxE5k-Rcdt>qGY%D=uWQn_5lcq+z!0C7VXVd( zLt2TeUrc{Wf~QbNwpKoouvg0)s0JGC@iIF1Z$oB#7@&gktb4*Gt0!c-KHr(rS(vg} zJvYEpwNC4Os%(^UX0@K|n-XXW!YDZza8kqjP)0-?Hn+^R_?b=kF$rGG5wRE5@l&MK zp(O7q1ZD;;no!i>17CR7o*BVzl){QkP48XZUo!SaWU=1lAIW7S8Xcwg8Z7hJR>3=} zPC%5a*I0u1EK4?#j-rKqzsX%<+7M z0~WIlWq9Xc*V{283YHCM)fVw6FE}-iAAwYJRN=O>3DclQD@YHkbvhH#nbi!8tbs%B zR;-7i?8Hpf3JO|I=CLsWkcxhf82QzBS4QgfXIQ>s{!_@@{q$gG6w#l%S5L^Ne8oVy-V8Du6Ei+%o7RhJPY z{H>?E5}VRyur$)bT5C4>aU!XA?rOXFXHF={z(a#|5a_{hqPe)0;n`33&&8Y(b+y*? zH{gHq7Ts0|7{`ohpgoYp;sxEbAD7>Q4NkYN*2MXfM2DWfzr3NIt;VrG(&iup^2;A4 zQoVb_?;iCTenxR9)&|sd^QwDg(t1#!q-<4x-T&S{ZaTQfo9I2y=UuAL)UnFHVLmzg z;#VQWp0*^9^KSB7Z)@TGJSOuX)BDqH1hm-5gV~f6k@N2Yu_-dh_V+xB3*pcsYCY^^ zt`2BK2HZ*ZmPX|-gS^o|(X&=BJxxsibDKKBq@d9V^Hhv$P&YqGg|C+_eoJ9`PxL;3 zA9m5@D35Q;XO?aJw@vy!oI=BONh|^pOtk6Wt2>$JbIRN>#yWA}Mf@1XnlBh92}kyx zqmz}M1L;6scWw1#2zRbPi1E~sfza4u&~jQba=K=g{#x#xNx`?Kuzw6q!B1n1lEQR! z&OB@06d#hwi_PTIKvc-~qX5Lr;7#==)^W?9@j)3w)H2xxsw;AUdwj+&JX1CC7U2(i{V&0 z30$ij4%N9X|8T#-{I;rpv?f&hb+rklkEtVW7X!OVe9Oy@x!o;ALuI;=AzTn~+dfF{ zpw56fd*XoNtJ#dQzjLaQdj$5Xp+N*NhEX;eDT^WB0V<+T7~{U&E?eHG0lq&qTw>f@ z9+y&4aK!a4)<1C;yo)i5c0cLSyas5K(YE@|EZEdch4U@jKwkJSPn#m<>UzZR(K&b} zpo7LYVn5ewav@YxW@vUlcF+e*c^b$TAX71At#hjX$x`~I_$Fq18w8fi9t z^T@&p^hUqTErI%1AFEV2rLb``?|bkov$3uB>)1Uc-*oo{@XGnU)KmsjEQ9{X3dmvx zWO}Am%{Zv6ftr4&f05^tMvyzKrE$;S;+GaIoeD!*Wi=;m!r$2#k`z_P<=;&8{;z)X z)1q(PdCC$6wOuR!YQhMK)d{B$Ro=8T!U(`lQY1SP--%DGbQe-%LXY-eR9tg#`g zZ9XUJ<^PEI^t&`5)Sph6=ln+R^xapO!BTrhKCjJh%?%_B$4{gObEZwkujP;21+f+y zT$ukkK7~mSXGRHw{**i?*-MR;ERN}SV#s>m7)jz=iIWc5$L=Ow6tG0fK2D(zg1Vb5zo zx~aWq4rzia@37!gHBaoDl(}^3Xk+iww-7|`Fh!+mW=n;(q!mmYdt^GFJFr@tQ9|lW zp;c2|!uKzpJ=*DwuAx#>h zwMJ}n8W#T7tk3aE&0`kv2uBC>86=(4V{_Q->$$UKQMn!Fg_q_8NLi6K?SQ|^Uc-s` z#2Eh$S)`IfE==k4C)}<;zt0>kHxs7Qjtn=mh}Obi&@FXflR`Mp^0i!uhh~qf|`_# zADMv;Dn?>RBWDr|3UElNi}uYU`n6#VsF`_h{P_l1(xaT67R^yoJxo3yK1TC`k=(41 z>~0?wwo@-CFkcv@m}?1_CsVC*c9@oM-+ zSN&b0E3TXD!%X5J4*+6r^52c@1Az0=PydPZWlW3%XoWS2UKKRBrN6{R*#26JSutCi zKswaX5Cl3Ue)=9x1`eBXJ0`x?urC*2dhYr9^LmlxJRNrx2S2X_9D?J%PL}YEXi)z5 z+0dv*Vdm^TxC7B%)eodLICys!aHM95$=utk6Hv6Z}U4!b!X;p~7y+9S;}Tphxx5F64J#eW1MK<9?8tiiNEe&ko~FRUPX+H#Pwkuvs~YYptYC>hp@RLY-w3%)zy8Q0*a*+< zfo!*R<+*Q1^nvr!pR@TNN2vWA>BX^LX8B5LfQ{JheFgTG%yIzQFXgzv_98?o$45^w zb~>;zL0zN(o^HFcZ@uJZ7Y-DL;hGD|?Kl_#Rj!A`)lVM~P9TPcp*3DuE{;w!mN4MG zX+M=JB&0(F59ReR5jT(x_~Pb+<$(XdUTdS*tH1rs!8rUt+A7Cb&;?QD1mV+&_ViWR zApkG2?sqg?$aY$_FJ-7`#@-2ukGXglTEeNP0}8uug-(1y6WN)IPrw$%0uCcCHE;tn zldGnM2WYrA`hexy-LuS^VJA!a=-jspEcWE~bijs(H|XwriCvMRk)A!lv`dCg;ni~q zz;|JvPVmdZO(wb{aecN{r zzTW)CeLtj6#FIc{s;m+d-hIQBdN>#=;Y~h4kSi%VWTjXwftY1c%SlkwZs=xJkP3nm z2ai!DCC{s? zh9nwY>|fCUSQv_4D1dQ}IuT(9QGzK>Nfmdb7Et_7sJCpg240Y&safUxhan8!!Sk%b zxBTmuyI7|EIan#!{5$Pkwdn|I%UL`Z|J?{3{zhBCEG76MX{>eRzDC&YsoP8sqel72 z3rZ7A(Hr|0H|%~3hKQiBWdXv^EmT%s*MZF#H_1g8vXDdYF%S#)N3zSFTe{9>%pOUU zRl#(FbMw)||DyWOJu0UrS>b1DTQcBh%C@95s$`~6T%mTzm9EmAKXz=Snc^$3Y&!Sn_a4Rgl>?Dj%=2t3RcPx8(`^lF^B1tODnc%t4X|Q293=U@jIZIdMeLx0Sa7tzzq%)%*C*W zDG`7&er75Qihve;jx_%`y`los2qkw=D4=sSuYZhd3ipw+#B>KuDV*N8GFV6tXw`si zf@@DaldXzkesgK`PcHn}`>4Yrila!GT#?E{RQv{oiSC|!==y@8I)c_g6AG!(+=le(2Q`LuZAk&g0 zaAgdkFgFI*ap?Q#2q!h#+GwJaJgncbe$(F#J)AVfE1r1w3rrp4AI=9Y;PKi7_Kyh~ zz>LJgN8ahbWHdAZHkpwvjejAO2$7L(AfOj9SSXZ?7u$Su`U(`OYfE3vd3n6}?%I$k zBZe(ROsH$L*Q7P;0ScP%z>KQovgUPj6ZEbw-4e9XJuyP4(%X$gjL8|MQa(nr3Kvz-8Ar_+4{Yf z?ILc;rCzP0>6QU~9`dI`4u4BXnK+)m8&yC%zL|x8Q9)OTu7&0EyP+wr(N-cH1$Q!V zrQV`?I)A69Y#E*)F| z$#2je+fwKZR~bMGm9#*(d7Pll*v>4#9`bHhAbzze?Rf|w7cbZ3F2C6jjD04EqKcny zjzcf)D^DN`1joyTi#Elpyh^BSrVhKf5XJ(4;IxMgrTYayRvHtxaIQ+!Q^U*OQae+J z>;P^3>WYrp176nXw!0>qCnxJ_o?o*|&*%XR04oUa*)3eJBftz7F=?2Ie1&knuD4Q7 z5I!0f%P!~g$i~+P7}qv-wP!|>-CI-!@Xc_Mk?Gx^Xcd2vwS;BW9dsI)3SYYUZw=*6 zIjEri`5jmn?69Bf7Rn=+MH7}=^g-X{PIY|~1KvEm4|yd|?I{RX48 z{@v}N%+}4w5X9VKUl*7^dZRg3kp2cA~Rm*Hsm==C)Y?02{Kzn<7~~ zK9WdXeS4A?p^tJ}J-GGHX9}F*VuXY!mt?Yqj>vXygUrwR8)dw6!i@ z@kda*d>LVFkbaM9)ZN0GMJB5c%OhK7>a4mK_Evd38JBJNqxI%-Fh@h$7{f?M0hE&u zealwhB*R!)6fL#TNrO4Q^Vp+Hf z)Y|AsW{*kH>IQyD!vTZuzUoU_wcO~86%*V{S7=k;Dt- zM9KrygUu-pMWP!>a=kk)68y)u!WmO0Z|}vB2rY*A6D)h5K$3qR-fwF##RBN|(o@is zP&Hr;GcKm8x^d3Y6^9jx3s~s7ZT&&x7aDyk5kCf?x3-Qi&;oFI7x7n~sb_866e!Z| zd4T{PR{nQAMM!XvXFWC`c6zq_)6+u+VbQ`x&EiOQS>IovAs0lbSZAvQX#)kjAPyyF zmS_DR!kGCo!qh5JYA{S(eSg}v&L%U{)TvfT3H)LCn@{+NoMUwN=rL6_H-=>7vq{3? zBVciDhB1+>MmZ;OGdzaN8JOVR!KJ^M_4j#I@}G~4Uyj96Bf&{L+eo(KBc_RYo6TZl z02KMR;LgB9=g7Ysyx{T}Q7UQGDyZbEOPdkH_}fZ$OFdKM_HaG9?;R7a@I8IR7N{*< zEnavb(be~f=~z3WVEHkT|5J6y`oE;kGNyLsE*6XgjLaPWOLfS`!2Exj4%s+48UCN> z@c+Yf80!J9qP*S33ba&0EWu9DOGeP^p0FoqB>@B?6hz{ZpjXO%0U-qrc%fSfv;+!> zT0)`gr6{QP>~Y(B_WOr%7aNm!{o?y%Z9UuhhIeSf%z&m6RD@%2NkJlpKmw8iR&kD{ z9TWgSpr8T)fkJqA!V+kV(9nNFl4HgI&w>-0@(Ujl1r8H4xTP|PL8E{k3bOMg0w7QX zkkG**A%q115&;mXz<^W$J;pJ-(|}5705X698aT|*_a`w(d=)d;Aq@@f?d=U6xVs=k z0Z;C!2N=MPa}2`}RA`8&$3StgJ^{enfPFo0Aw-e`fNak3NgvKQg?J468UWY;27&`5 zT+~RICqXd-98e3#u(kwv-aVY)AL#lE1Of1C0|!6?@~Pg%zu1p7nAjgYhyXD)iyQMC zN}LN2=KumzP+vzJ@-PSiFd%VGPk<39W_UcPXTSk;9RT`mhYO>i&IA(Bi2R!g5Bm_% zZM-04!Ev-6Gt|Fi(5?v!sVdmnIhcUKGFktta)`$O;kNG^`iE0TjdU9O{O5fNAufdL z9}D>6g3cy7gzqubqVi|ZK$hgconwFzfT19zqXPpHzzZGaSm}mEQvpN*eXr&;;Wr#@&(M1i?^OcSprxyM-Pyprt zGx9;d_HD}kQ_2p41Ia8wXh)vwD?6ZWgA4htzL=pQL7 zB7+0)dJpiGWH67_jRgE2+)x!Vd>Pop+mhvX(m1H&d2(U{fV{u{#E5^T-bomZnFWf0)B3A= z>N_}8XfIx$V^E`jQoP(Ta-5-B)oUV*2IWodLw&3Av>6Q%iMRN2rk|(lR=9pAZ40~u zKw6$+gDI2YQTknHyCa@vgEO6BC~Z9jVg+9OX6((`~OA3tW2BMx~Ue7ZSH{qc+JpQC{!J zQT#nv+Z)Wb$Hr$p{DZ3g174e>H(e zIdJB;s}V#{UJn-l*G7I_J2uZ>D zc~sHZ1RA^IIJ4+n^zJYxb?gd*hwiCGl8xTN({(I#rqI8@VM9RXyUFV_yy)Ri7|8i>GAeIR=JwqcZ+`fq{N;-s zZU}oO@b+LVYNAxEkv%;Iu#Kr)1<)uz?g*VIK8rP8eqdKhSk0W-ZAEb3juq?WeZxnE zPf-P2LD_LeR4S@o?Hbfk`h721G!v{cAx~N{IfxunNYpGrh-)@Rp2QLo^bV}E*p50@ zl%`Sraff~TS=Rd(&tmI3GxP@bLtySPT6men-vcAU?}OB~fbM@&9dcRs_37ZfJN6Bj zY*k@LE!c9pTe?&{fmTH{J(9^TiUwx&#g$G}?M76~UZp*)n04_>QlQPJ48tDY*3r$) zg9)^yXmVD*Kl@_WjA2?`iko(A)=DOKjQ4jSr9CUMqt;*447XG`#OegbYpy!)&OuR$ z2Y(VTlu((o4ImY@|8|cM%IwWKS1|OBJAUEp+U{<@4xUGdl0oPby?Cu(Z5td@)wiM2 zAzG){7n&Yst$q$KOWI($8{y6Pb2QHN6N$Jg&pp%9DWmq59Xul_FPg`ViqXej%CgKZ zlYjCFUXz!D0Tv|6U!6{PztkN^;(K460g*3jsKhdxI^|WRZgRPaHiJg)msHsTyAQ)G zyvpx)x0=?UT(qE^@1{*g+b(B!65J#3K44{On$GHd+Ftg2t(`2^z1|z6vUC>p;0&vp zD~T~tj(P*~2!0{vM9HOFd2xh`gLoySbq3bff%>Ak_q54Es!&TP%dd_%k!g`JA5XHj zQJ8>xY^V%e>m}}g)A*>!VhnPzt~i|)H>7)rTdy8@tQK0!|4&2Ph2sSpwY`~Tm`J(O z6dkq$`IZ;g6aOTYhnQhtap2ZQtE$>Tr@yu#=W>o6o9>8dtb*<-|SIwI>Bdvd8@!!gR^Vz zr;VMl7S<}>l~-JGX7!!3Vqt75NfECjE#|IN>i>ks4og!}wDxS-lV^Pf44a6zPOIx5 zk)Nhr33A4-LYX76&(QMPIL8=Bq>aNgj;5SdZ=!k=Z<=J)BCDE_uE)67h{@)sENnv{ z#X*9Bzl+Jh!cm~hnBVak&4(xJbkl?fjP553U#npk^31=eCSIq79Nu#|=k}=CUmpND zYwput^XEeAeCnD1!`M4D38O??wq@J4ZQC}#vTfV8ZQHhO+qPZR`$or!=!f%g^J(QT z$QdznjX_%-0~_iRG}UAi%Z_3SBH`c$kIN7ezAR%V^>9r6V_t{Xr36$o!~UWqISQb~ z6Qsi?{KkB!E-7PHgLi0#TW1`3b!TSn3}5Xr(;(H6_^CuX&uUrv-Z{lk3D=_qTHMKS z9q342{1!84Q^|MA@orI0QSTHA*3XCL)nv155*;}fhk}i1ZSQSio6>vfJ;lA8k?(3| zTZA#Gv+~uEC0XAR@!SFt%b?8f|3pB@VA-2RX?r_FtJIbdp816y?IX%{oOnbZcXmWb zEFN=Ip7qqO+Q7+`Ibyff%#VZ5dh%qNi@-O2=J$qYc#*Zszp1Mo?-Ua}D)%P4UDA_p z$V(W%8NHtv@x|fRZF|^^W2DXY91T=?-!L19mKRDs%|ugpH?2C?z3_Na`ZtEC zT59$4r8`Jkq>~$x;h>ekDJMlxyEt+ZtL4ruw~aAEM$}IW!}{Y{_DvUbaK^TIc`vlb zlj*-a3|hCf?DY+wl#5#bT2jF(gtXh6J|?|@yY5S_?K3IV7LyUx-!&g>B0h^<&SLF( z;iF@=h5%1OyFvIRr4etp1VN?Jnexm;7sIdLlWJD8VtuMlsa8}CMTl5=Gj8m=WVcY% zZ>xSA2G+&zHnNi-0j(ndDbMa>=c#jy7nFA&_F3xDN13zxbpTkySh=PFeha1Ktp!$j z)5$)sZXvj-x7yqVwmOVNfe-L0j{pN)EQ5%3kWBX&z#PbQpxUL~9tq5Po3g z4iuC^p30HxeBjwjzLah?)YC+X@fVONx~wVyUN1p_a&$58>pOoC5(H`8N1)k}8b*7MUO**s|&Z;yX! zpylXidiSjD?>z$VO-g7`Wi%3$Ac;9R<9oTZ0o^ zIh%Xn!?O_IL zIQM`opR+y}VMCO8M_CDL_Sq?YttHrlPuNv7QnXSoJTdHRV<%h|_i)?cO`wJKs8F!6 ze%{@Xd&8xK+ms$QR#!(iyEAS})Nf?Wmd)-Kye@s6v^jN?i_JEa5rna}t(W^sUJr+i zRH$q};vGUWi1d(NCYJYv=WRg8M7cde$r%#Z3>~RWO}#hV=?zm!Lu4of^kb`P&SR$8 z`$JI5>42?mYui3?fzBuEcPDz4J;FR%h^H8xN?%`hRe|vPoRjWbwah)IF{pA^-UBP^ z;8v%2Rz<^Ip*8)y`81yw8cRqT&z`F&d%!6b^02~iqal&!Tr&mlYApQ}Lw8xvaTq(g z^eRHz^MJdMVs|jAX*%DvwvD>vHa$blO4?svNt?E z*oI3kYt)8^5e$;6BLh0FGh$-2XXZKl3=HE5$u_^C1YS}N8DN#C{2`(7p0k}22xV+BT7ZROb*086RD1o}mRuSrBCQT%!QPdkITMTTcr9Il+Oj~} zF`mHFs0g59d;H<0SJzO4fXqv+_IJs$qvOXe&uL{uYbIV%o#@%|G!XUhgBZCbO^;4~ z$A&c8D8?(D`3~i2yD#yV+I}gazuMj>@a^7m#Px(6XI7#%fv@MW;YW01Uj2pWch$~4 zekK!iROwII?QW$_QD5(JJ(|^g+Ngy;+O;g+v`En6vN2KM_`Fhwvtg^#HN(EBNhm_l zeJeYUZbY&%TExNsN3j(Lv$$BXUNu&7^2+gdr0fCRx@LP(A7n7X2!h-3f%=u45qUc5 zk$bGQro}w5X5usF^ujaIZxO6DVv_SCL<;QHj?oi(*lQj<4n2vcPD-0av8&a2h9W3C zDymmY!+e?$6J78C0-_ngtZm}m3P}?*v5k%(iW71I_? z*Lq6*zC>`mG9cR+0`JqY<2v7{S(-(tbZhOZ(_Rva3r%jdP3p;s1?x4n#(Xm2@HHi- z*SXH3KpZDRdwhrbNjY703pRC;Bd&erERfhR{KemXqCY`A$45WW_E2tRzT7gc{*2Rt zME zwgAHI2 z_@C=*$n|y!*p{zz3LI^KY%M+vL$fr4V@=qAD8vzw9c=eI!C~xZHFM|rB&E=4kDI58 z^)(y%7gZ*?#2PoWx?@m)?m1EZs^O^9k<@P`daQ`IrG%Gy`ZzGDm(8jBKsojfhyK`> z$rs8et*RbW6(!_eX)|1n!8G1(hGA~s{_z6LlIe}f)CTQrs$3wC&P*5o(f-c39CXLI zgGQmuu=qMQR3u-M;i3y`+l-oO71QRn`+cRm420k5#@0+3^;G$^E<&wPg z4D9-5(8$GILBxnt>9|;P3mmD*6ZJ z<`caHl1TO<^h`dLmQ@o+pdyC)CNt=lcGndw(m`^?;BcLe7fl$1QCc{c(Zg`au;yc8NhrAFA zeYj)Q!Mv46)fb1vS5Jpu?d@}6`C!-ZyW@^=UbEYl$-SV>OjfY0$cCqO79CjL|AuPR75O1Ih<72NQ zYl3$bAsm&v4!q3-7vqnN6rM{6#BJ%*Z{l-Qk=5#$nG>k+G#6p}mO%(ug*Flf4Crk| zS!iB#>(Wk0(S*BNhN-;n>x^f{9e(r@vu8J#_$$4f3f?NU^B%Mnx}2gJIy-75=wu!8 zKHihxJX?^O&Cr-JG$GDx5Ars>Yi$S&qFW5+8+hVI|V;R6E6~pSc{%< zE0dD$oSvxawzlfeW1uKe>n;jz=8t!)cfZ@ulf52Qfuvw|I_wbP;v@%v}CkO#I2E7p8_33)_#xwR| zFJoEUe4eyvv@0=sq*tawkG!?;kTgW&No!Cup#M!HbjL{lp62{ zWbqPXL+WQ|vk*L)4P8Y4x{4nRlfW%e;i0MOcZHIk5a001cbAoeq6hhHxG1dKdQ=?^ zsdEQPGjC&Q3H|OxPujAepw4d5UP6?T*hG@)j)5W1c>1utRwlD|V8jnFm74wU)qTqnbjEDThw2gHFfXNimYnX&UVRA zN{j3#B8aH$22*QPSB;!&-ep$hGF-4ootTF%OCL1Gv_!XQ2pT&u1-a}uR@^AV!c3~V zO(-2IB56j>Z=FUC+Fy%YksH3yfGNp9a#P7W+Hht_TcPeVVM-Li6cih_0Kn2|GD>Un#&V zoE0#4}FdN1c{-fJ@<^Dp5{*iQC^`1WNd@Wc#?j>2R`k?kb>$POk z`H_GAqzToPP7@6C8|kg8ZwMCR42+&6t+)E=H1J&B=yD|xG$Z`^l$~v+vdYa-+@ilu z=QG>R)eQkQTR+~3`T<}c+P%2)wB&f?ip_B+k)H2W=dJ&%;{VbKUM#OJ3m80m8D(3z zF(2|RG_o@(i#Se+l|Gt!{lo#TQHH_aVAoCys8N+&%llBy z@f_&8{50@f^S}XJPIr2;eceEPwQ)~``NFGTsyW+ywwKMWE^r`h5=foL%e4;W0yq<9Rwlb z^b5&*ElvAkuzS&5u03L={tzsBfQJsvvof`_UQTE_bvBD=8)tn?{$Nvxg(+tCmG0ng<-V0OIjg)yZJ#CQ9Y+6u2C)J9k zq|+u8S*<7)5*6GQQ)rlcn0gsYL51|9b~jM7yZpuJmwoo(>o@n-#eOj8&c$5#D6f1C_%#?2uhF-Jy3BH(;%EkP(uRs!Cf1|_%jGd zWZ29fh^SwP`iqfzKlpywJA4Kahz$E1SiMHG=@mPW7y$x6=Q{*2TM%$K6p+{%5!MlL z*O^RZ5H(nk?;nd3SL$G4jhWEkg)1O(tim{PX2ydC3&MyDD2*}(N@k4^v<^ITPW-q9 zV8G$?bT%R1xIh+C)=Z8TNc3>O1Ajjagz0SaFv`O;TfagwgtOZ(IYtOdpMkXk#D2r6 z2GA-FKoNjFb&wHT4wJw%u$ja*i%d|)){#2|y#7KvkUjS>&_bSJwm%vykWeqgHr`v` z@Ef-%4xGLa450w{#yP9EvbaG!Yu8&T^P3B5pe_Y+K*yoo0bjEO z0>jhh`R&1Nqp9tkUJ(v1q6$(_Q!5C=DVzH;WjPU`9iw`JP|$A$#Mezd_p}hep!LD| za4!lz>?3G7G++|uP%Tie`lDbl0x*b7Z-y~5TAb)lz^^?&>zv!SJS_`*SXB5_&c&W_ zs{_D|Hh??eQje3xH~yeS0)qN?60j36@PKCCA3m-dVGK0mI78N#i%fh!=q3~sWqkZV z2J0wIFQDmcH%ELRME(Ukw7$LjHV&OXFe8z^0)fB|yKn%5licJB1F(S*19m=?;@`si zbX`Bo48p_5xw|PH1n-y0T;M#Apgr}tLN~o2Myuq3S<)r>TzrcW!uVH81rZ`iPiq?~dHnuRw97-FUuStDQJI;+`nVbK1n~aDcVqr_6EHAs3PdiF1 zdKh@k&V*HbTjqm53fdlX5uLJTzVETv3rS0wI+@hL$;Jh@v@TXy4}lk7xG(6v=%SR z1LN+bTvbtWeMHybs9MO_cDs##bC>on<|($CUyVI`8=R-BbuN~QuBy6{Pgvov*KU+` zt1C7V!rvmBd*(FCeTu(CtcGlot|r;u7>wPg7=E0ieLelGEp&SWO2?%KUKaX;CNf>0 zT606aAgrQs8_6#&7e6ysD~Pd46Q(|IgPVVFZuKi(y~WL8XhG5K@ckDmi@7f6l= z=h@sW*G~e6)M_zZQV&2J3wF$3&|D~b8O!9jYgP}yRuRb zA`fs;i_(&c5!16jO?GkYmj6_o9RWvneXR=!{pPB0o*<9%F@==DoBxyISKVYE({h*shQ~53Zl$`B znJ4Sf&T0L+?5rfl%C#$6nboj~8UytXURW zFK}n|GCbIrg6hm>qQ2!Sf|RXmt-mC7JO1MG-E(oj_}w(oLRv2#x!@hLT$`psr{66j z*hR@K_v8wxM$OGr(^>p*&|1PY86nc7>~J#J6v+H(U;ZZ3Tt3DSaW>Y<`wu@}SF?og z+a%M7;`U&#HN%B%5+bX~Sn86g;axl0v03TM>0s?5Lt{Wfy=|AQ<&{9PW0RTY$fuRb z@;-5Pfa%@i?t8dn&(5cKVsR5W=hv$}bUUu`@1b0U2a@3=N;{Wh-Q-GuhsnpyyFZ>Oa+PjS;9iDsciVF!ev5|L4Ha|*BjVxc?(@F-o zNopw91^Cq6_@8Eleyo?KGt=vZa1gXf=S=6D1t#!T%(54o1^NJo>f-5XOfD<*x-{P2 z)XHj&?sI_7{Xr#Q#1?6D74;1CW=sVNam0(7=u@gT&aJQLM+uQaN{`h??RC-ItS=5} zqjm0EyUdIe^>Btq?24TwTqvxn+5{-3gjj5){>i$<&c#gY*Z32MVju2Zq&!qp58Gd3 zrB%{p(28`=Kay41u-n{df`h&1eJABK{2*bSHn4=1C)l^O;Slp+*Vp(@5Z`tjp%2Cg zscQqSLEMb${%rW}8-1?zSH5}~qikuV8H2vgAlk!Jv``kZVmvpB4XyidTctCCGjdBUY-Mhev~>vg*?^hF8yj0mSVO2hv~MrH;PrJ ztMkfS5J%gZvzW0<_wtC#6HBDhxivdD0&S_k zbC05RePRctp`vkDQOnT*L0D6zdo5)PxxS|>7h%$06Py{mCOMCl9GsPkai`k@@t}&G z5zgJ=-8MgSukE>QF3TG_nwTlPVCMJ7h$mGFb?oqpiP zu?CQ#O7osw(HR@)>x#rbAZ+$7Q>Z3l8&6SQ~z zccw;nc7p!DfqP(w7GWC~Xn_9D@ALV>!FDgL_oseLL+_$G^JPUhDp^7>Lv4O|7J|am z>`G=zVyquDzNwzk(Lt%PDWT~oxgZ5JQv-nSq`JPicraE#*bJIm3sKmN09^pr90&mr z3phO;AUZocyS^B}fZGdR9Gcn53?QU3k&Bd-b*7KRF9RT&=eOeH*}0LS2{hh^uN|o7 z=Gw-;bvBRicPw^NfS`W^2ZEuc9t1eJyKWEc?T(6JK0A)j`BVIC`g-_Y2`04BbH z0c?{CkP@)eH5TB?4+mh>wUrFbFXdF^4O4m^QXj&;5gbd)yAyCHCg9bt!W`gLKpY#I zyll?QKLojddSQO`qX~T06#!bx$O=8F55Rj;_U0GN_|E*z!r-am3#L^6?D*RF+T7p{ z=6$-7fan!Id-gPR*6+l%@m&S@T85ui_BvYUm+Hc9$1GjGrl}yL2Du;e{PtU&j+mf- zcyMBObN-0=&5XfIJgU#2okMdy^9LFbwja^l^xWJK*4gnB<_Ytw?)JM%uHUa>cYb$w z^T^JwtFPu4Ip{wr^898pTx!Avb6LZanJqK4md0nFsp#VBGF<=oJ$y$*)DOQ)t-x3x zw#dWUw1RIS14~0w%PT-SfULpA$#pirG7!bD8O_qqUBY*tz{4NZz#sMV?_a{#9nMdh z^!J}v-XCvsdQ?kGcEQXUz_-yD0AE^k0qwri9Dp%^A1xMo*5A~~{OI83(cj7Q-Rfn( zUp{JM6WfPdPI1$LnKX#a44;KTzR`Qw{GjCYAg+0#{(-eM90P0f@AcZAqpB8ieo;#Z z?S0Z(pB7ZUiLw4Wdro9WNJGkv9!UMKFlaODhueFe$`5R=u85S3h*;ofpJuHeHkCJA zKvQJc4|(e!h3M++F+aRt2qIFW6S(^VQ=wc|GV4E-^16MUSQwyC|zu99>|~12Y=P? z*~eW5IM7bOXuZ{x>*)4Cszt`dtV?>wP!iE5uut^<(B6$SwrV8Qx7D@h&*ES!CpE0D zRo@b;tW!^$7fsG)-;J~)ZuF~xM$%g;0R7X0w*MJdZ!C5Z_p?UuENWPRwu4WO~Psb*P zvbmH{gwbd=m)Z^k znM7~UvQr0%6Gz%_#qGOTtXPu3bHV{A?Psy_`8Z4A6}xPQgE+Ll1a#gzlP85W8N9k} z!4Li;*{vFSV$%HUQVZ?uRfRj>`y)RZkb|XJ?m#12G`UFyy#(Iq!bo6hOrV#4rtXL* zBX#w{3e9=>hb&wApyo~jMI@J;5^X}Wj%;s6aJGiW{l8jpJH0MI>jqHsv6mAno_2u1ByF;v7e*T+_35tP|WqM`ohg`2QAM9H5&$nm!=o zciB}lzPj>V!3Ew-L#njr4=ko-qYQ_Yp{J=K-8Cf`u5|j(ZAMEp=X|Fxq}-c-%b^cr zo3z~#m=OmKVoR%3l9t)$Gu#wpe_=nq=kc2b#}olhaMEs^H!Yyxnf150C)!%gy}lo> z07c$(s89KNH@K;5U(+bNII{nST}gW+77+Y|PbXxHIal0%+?I9~J-?PK9kQYmzee{W zXV|mSWSS>A;*M~QUFm5?S9aT>2Sl#G;>BY0cFK1+R-V8Z%oez}6Aqo!!27UA6|wfq zw38XTNHq>0AC*@)`D%~6k29Vs1jSbk6jB8hvf2ClE*QmmbC;|I;ZA zkj2yV_<}xyZ)I3oW~a;<8k$9;iXy9F4u3mtk&wf^Av!(x>A{@uAKz7(_xG$5no{7)8*i(9CBN z*~Am(J3WYPpOF{gh1@CnZTA~PK-rlGnR2i{lfIfqq$w`c+;$a^6xN7S<%JQtnV_i0 z$=4y>1vdtt4s~L@MIPrF!%%u@Z(1jtW!hCIrj7B9k^?!7ex)iyxJw<8ifzaxsE_SK zsw1IBN&m@=)*T#cljBY)731VcmAS*R zg+$<(>4#rQpv+eI#V~&lnVgpyo1A8OD_rDhV0DL<-Spy!G-9nWov=RmFlL|FBGa4V zLdBgWzbzX~&_HD?6&v_lw?y$_d>3`$aw;W!!o`AG%9#0{Vus9Fj-WJO(6`qT`$oe5 zwj7s$Hy(7}foYhKSiF}#Z5s|6ps<-n0E%>qBrSfdSJk9Lc4>uqxqAI?`97{j9PKk7 z6J&^vx-8?a%+V^DJJXD%l83&Sg^qPRl9rZLCori_)va^mEX|d(Lpii*VKP{%waZi; z-If(t@(1g_TiWS+w4H9#nIlw95xJG_^dXF z(vq{-Fd~xCFgax95=0?6euZ4|17~DvI8x2j0A!q#?aBo{R~dDhN!GYw?ASJ;#a&Tsvtt6Jfpy zZdZ+cd`D)5cYr*QQzGWK!+yrR!-Ru|lXK@5qjwQzqwT)iv)#`e-AT%!%S?zo{ad3Th z+jubG!TYhJrDofYGfWCQ`R9MiW{K~`K6wHoIr zZZUFvmwH>S#rlo^Z5HL~^OZCYSL@L^FJtJkyecWH5>VVA!U0Dc07`YiYSKXeK_rGc zGs0Uox%OZj#N2LRE!GQ zL2DCor{31~}DqVjlt0tsYVhir~cntR8vJy26;vqT11*Dxvgq z8F~0AcD>p+qZx5o`FfeOz;k}Kw~pou5$9tx6Vugm`-d-ceyqb&%u#oky?47b8%yx) zmX+J)xp|5`;PJD#n*u zDpXK4;jKrHr}D}k3PH;HK;_=*N`jd&J3cp8_%}f|t{*TX`uVxbcqdjZ17^1-16cIV zwlz1FoPB=aS{QZ)Ws^EOec+l42n#tC@Tg#9r3+D*v-u#>GyhR`_!~urdn9z6zUR>Xkx>~xQFM3OnjRn%PhqWXRvW*k4{@kipm6QL`syH! ze%(J){k&52;6Pwl&HKn}@l^T;?K2;i(d`_vwMeRb=^6R}qCo~e$kYUJn_0D!O?6G< zt_qT+@j}Vyo*1#nG2yjf?gDYyuS?HvvqPmo;Z{w&Dm0NRtvcV&~S~Wv97kx z)M#GMbHroG&ZMj*T7BL7i|3xeSwSmE%W_3KP$T+VS}J%Oa*6Rq7oIb#3=LXz*-Z?{ z#1|864)x6j zre(FMdYow2ec=UXGOMoux6MRqxDnv=y*sr;Z1ScHj`ULsT%&4GuMEGT*aB*))oy^o zie1tTLGZ9DDd}-=q^zwFod|H|{%F0mb@97Va@5t%FtM3$Qx0yYQna+pbK5rxVCYH4o_PLXJQ$JC8GP^KcL{aWY9IS74KE?0=@*tEM) zzzv&+i~8@LM3rgV*SInyX;B?jrn2oJ7jbIO6il-TQg2E3YABi8DNIKJ8uWphxft0< z!)lkii+vs@{Av{g2@c&;N(#G2jqy8*xXKy!ZAhzTVyRcM_HAg`R8}GK86-o2jZUG~sTiE%&mD(kS32*COLv;RTYpOrNzwHLk~J)U`d z@JOr$=%f(ermMq%_!=Yf^eDYbi>-5El{bO7@_C8&S^QAl99DK3hYNy?x%zVRYroS$+^;o+r zMZ(4DdD@BlQuuH_lI##)$u_aFzpv*)Tq`oy$G%Fys`^|akwSvds8_0GD+lSiD--di zRV(4rJ=is4WdtpbN%Jxz#F&G1il<4~%BvxaWr_D+OvfVxBcps$!f^Q!szVbn_OxP} zZ2F*FW$TXo?HVXcQ3iZa4uB%S9mW>u1mAg7`2K-rSOEVU$ychSkKP!epl4;bM=2BM zWGy*ZlZscBq`TFryM|X#nKm9_g$(W7ZF0yQbVhFB^sT&MbI?LfGtbP}-dA^y_4LuO z&2e5=S8}l(TD{ z%i{DQa~SPTsFaEYReOBUquqt~=7gevO6{O!{m(H=uhbjTr=A)uHVw`L_ZFS?Yj=92 zW&7u+_AJI~cNqhHu9lbb@<7T(qLd%M7|qh8R(?RpKPBwxB5(s$(IVKHi~l<<$^6)p z?nqW+q6EM8Ed}$7{)!5w&UT5sRI6iU?9Lkzn_q8adQCU{nVPRu|5@bGbxm%(zJXjf zdmysZNj?z<$fH;zM|Bt+JBYOKsz#Hfc?ngg+nA=O3H+Fp_kiaRBWMEg$0rOFGI!L< z-`)oTv|}jPX)UuMkKUf84;m-GA1x`7S+e(EJjR(l3?)fEIEXg#LH?C|_%`DlTuCN? z*tHnJC9kSn`2Jj7yiCvE_`8cu#7;FXp2HCxHY;3-mjdmUZhKD*sGe+iOZ+||!13Q2L-682OR zNPN1KP+JC!oLRUX3r*x56tfM@XU=17WMcyxM+g~j*pExTdMF+K>q(}YGo)y_V{nS( z`C(A($cYOEZVl3GXOhwU zoSh^Ji86@ht5TUhdG6pJCY+rxnwD(t04bq(jNWDsSjFnE`4}qQLO~M?>T`s<*}BDV zV(ujWtVBlE@pr{#p5Qs2mT#~1y!jeP*{Amvi_jVlm;f$e`BVSi_Xjob!xp#;syoC+*qTmfiM?#sCk4K+~WP7_RRg9E>t2CV5nc$ z7$7t3H$EEpm0r0A?zZ54Z5U&Hj~8&;5HDUVz>i`d%Rwg1$E&8&n?lU2KKB7O^e4ZH z_Jp)pyF#VES&ZlWqkIT=zASY>F}szY3jjM>xMjkHlIOa8(4US2LWV#SF|Znacxuv56o+tzYlVpc)`9`P%lf#hln2MUN-fCU_0H z&{SIKuLl3cyGw6EQ!B|!mbuIs-ff$AXJgW$|EC9ow!@|6Z$H-`XL*IMI?M1x4mb{i zFMj84Pxu6cl40%Bb$(|PoD2X*q@!~PRKM2MY)E_WshSDiH4O!7fkk~Q-MWs-fTMA& z8tH@ma7hx+7-t>c7-U!S^5P*>pGy#cTaus5+3jV=3Z58Bn(3sfC@D)>S0gz&xvX8- zflVt2piTJvQ&=EQ_H0oDocsJHaxWAHR<3s{Dy}Xw#m>wWg3?yLTVf+R{INI?+b1I; zg^O@7)Gy`G5?&cTBPAzz{=tBjrVms8XQf*0$MRUJjY^q?`o!WoJ!CKXi=@;Y8G~1w zAcZL+D<#FWzGl}ZLbcDLjb2uY!DyZ|*+refpq@99puPd?@ziJth8duHRoGP8tatHD zbO=4oToCasc=gWe#?5pxkj?xW+8w$NRN>$xQERkQ9CVqoq&y;|1=Bb6F@)nLQs+Rs z_H;d>f^t!C_pF}{3c3II;Dgd`iW_RrrK_V(^X{batzA?VR*)L0P&Q5OwXYTvhO6ejL8-%tfz+~KQ0-}l&PG#)b#EcH9?J-R6of~I9!7S zCYrgaJb;;LjX^k?mi-i;5uJYFnF9mYdLIgTn-9cTa0lE`M){Ovztg7#MW8Vo4w$KY ziawXt+zC?PSXrk!U&m#UMQ5_ZTlz#N^Iz--8NIS6%tz;;Ldr?xGEbZR$z5+bf||l`r5p;T@@h ziJVBGnkiz2Ogr8O7)8Z;gjHPIDu17@K*f61)g?B}7hMT5J1iIiFz|2101u(+@CisxW2HvKtg& zV&9p%M1|Ba?M#` zq)B8i5saEazU~A=Zi&t)KCrJUifgKkMoldk;5W3uC7}X`0uLx#8htC;7ItNlCsJY> zM85mU_&&Hk;l!33dd~4UV78hZ`Z<=3qfpkBxt|s9R}FG_RSSVq$UrDUxTbHMsySwh zxrOp_3T&M{>@yv)>87ran)vi`7x0nDAOxEm=LeqY+X+M_kCU1CSbTNODVnKrx+k?- z>(^*fFDh@%j!?92>U(l&w+Yn*odb>gpU+XTRsc7r;*imggsWkZ4j5p-`VYxca%?30 zAyE-N#T3!N;7-^t+e+zO$-YVVRiwY}2!WPE2nA0mM+Z7Gc(*OLYInY;2gmsmyFN)G zHIgv13vJ`gT44P6f#bjo2Srx2644V*!Do+SmRbJrqj@eb!T`ODFj{P<7_ z{b!>^YRgcJ(+PrZL!ij2-u59r5)Ls)Qc*C)e!_{@(1S(Q)2FKtm<(IuyytgG43XX* zOV34cl6bO8QpERRZu@?{pbHyH?)7UfyxRrUOuBQc_-#L=0{~9Uk^W@=JY7jD>zfMAxwi@$=1T>g=*E3fAq@!BRD4m@n7^f3-r#noi^NV|PeR?IIdKOKX;GJkpd zLb^J`qpsvAcUf^;=Tmi2p;^SF!t0A|2|$=s4`CSnbNE^z6vDDjNQJ5SWFEp(fngXo zj)$KZ=_Z9WcZ0>6r3>KHg*r;KKX`$>fy{R(aCU|g68%Kl`lz+B5bO6b zE^SQ*&b&nT*9+n5VSfos_b(dlujDWAVb zl>Dtm!FdX~khf|X^i42GPE;8m_zp$VqPj|U(<>-^icGznDg-foi$napvz;jJDjU4a zC!CuOd4zg0NWea1qwljr)5rX={D#wtsb?LwXG@lsz|q##fB_oQUVdT5@VAt~P+IhD z616VjTC#lz*RgRg5DUM7nHi_wUD*Xo;cd$CLEH`b+lg+hXks?#Ar}Zim3gEm+0%HK zGh5+KSk3T{{@dp_OKV$4KwX z;vCh>eI^8fQqcppdlyJV>v0ow!HiMa#=Zzk)1V6CyRlM0c( z2Ypdz9o)%^kCXddzIUi1;W_Ooc64C$$Q;FZMp@r&!hi(I9nVI zDlsufCv<7yz7+w^n|z45bPBR9ZGzWk@eBU}*=o1Wo_w^%nH{ZUjo)pkRLxJZA~)mA zr$c++fECUdV(`Y@5H4LZJ3X8Zq0|NWk%J!xh*dR>J%^V|ENBY2u_xu7i93g(OgH!< zN`F;`GM2W-uR(|+02wzD(;MUxXEFJ9C9nT8DY<-791fw;IL3;qK=lvZs>g`{zTwmGPT z{3)p;;&Q(KlBn9A9oC`ckgFi*y#p;6CAWCSckGvti%A#11YO}nFt^m z*?ABN0ufQSfnl8;STdyb)qKRab>`Qyr^2Ls={~g7fGEW=O%ck0q+Kd#Vv;6tY?Q2d zbsYrdqxpA_?iCED?qle~B-t_VpgtrNdgwC+c4jUUHENUiz=H9I&_~)TtP!)7cH2^! zRxr5ZA}DHTNraITwhO(b@`>cATx1Y=$e&z#BEMsO2=`=s%ys-IXzEMv`n`(a7j!pI z?I~PzVJ3;59&neQha9oke2tzB`0f6j-c@UkNl8_Y(BvNDWD%?{bP_vk3koi=3LoV; z9%plZ)XEfXFHMyebVyiDG$`zogofTN6mGf-KAHv zliAr$s%4fTkdNsWZ|tw}BLA+(w04s_Y65e)z5AQm8zHj)v~{iGJfS6bfTbb1#H~fd zW+J+hIT{az3cl7}9(iwC|EEO>r>gtx6|%Mk*U*QX*du@=4fq}1znKJ7e5+mS5v(#p zO4tPIDp3wj2|>FJpRe7ty3PbxD|gL4F|F<)`$-+zZ$cYI*L@#x;Mrrr5f%2hz|6vuBDtI^HUn@q(A8uUn!UD2wgfrsJVV(*en z-Ss7;>O82May8{P#2|5aRrIQfK+vWstHSOchi~zEekg)$HkTYc#jakj3P(gjS|k=% zL{!^D!%jMHns!uLM4JFtY+=b@0^1kDlnju>?UcnY|F&nw#?NCt2$Mlu07M zDA%4L97qaoMmf>F1^w_h%!peqQJ~AM4kzAur~K@IzYa;@)VZ95SE=FhORRaC6|PAl zP}VlHzeypD*^3Fstuh|!V$_Uy=|ineO0|z{e^oPa9J$gO-4YQZ$Xdz&`b7Sbs|Pci zF_SZA3)fifE7GJ$=Q5ChHqZz|pOvha6O}}q1};bRdcMbe6yGv1Fc)>-rX;khRZ$z&_yLsrY2 zdt55K=iZNy1GU6L^Z>>RuQfeg1!tH=rJ?|-g-PBKhmH|t2$KwlU7rX^H+A=3E~^kY zcs+jb$Nm^PurBzr+h98q?jnW`?=xhK$-N?#KSRz)=BINbf~*k+ghvoiTS=MgATDx- zP7h7XJ{}09NM~av^j+Z63@}=E%|t?HbyUh{$|07xZad~kPb4zTfm)912IY;(;uv#; zFMNaSG4VXIOCfa&cAC^ee)pYa$^34df8xpQV(G@_?XM$9!7}wv(835e3>1F>JF%WY zhI|`qpsS+P)5N$9Ye}4arZP?CPHm+HvFbTSX9TLQ)-Zu+I zMIxiqf7@nf%9#g(&%Q2GJ?^zf;RTHS(E5S2XI0)dZ&~)?$B8S=qqQP+E1mOuBGa}) z#(%+Q+e*c?w@2SSX)TRTQUt#~!gb^4<0XaBNf&f`i9XmUyC``v4NmXiQ<#4k4A%E( zB#rNUbk7f(g?nRA6m2qzx=b$wwM9nRqngSJqwXc%y$c~Ua1gU-N4JbP>bS2X zU7Z1mYG;2SdNL==l=a^mZ4a5XCKn%C^&6z+RI0YYcV+%XC^-WfN^&hF3etS`(NTdP^SfQId!6fkNYmRk z>i>14p(wtytekpeX--DDmk7sfEchV+v6qwzAlvkp}6w}I`L3f_4Io9P+RcLGG9E`W}QbgrwVvPB6IP(r)E&;&J^duuP zh}Y=V!pfDN$vO;iUb5iAsGppa3YtDny{V8u0A4k(7bq%y*+o^AF(Kv4piE`NC%2-4 zKXnv~R5hi^f&^ZmwddBME%*cbsnGYX8ebNt^&g(EPz(qMucQs5qEh){vYfs=Vv`4n zD{ES7T*CbDaxoCk4R;-NM>yA3mX~S}FDpEfU-#(^X21%Xd|<*v?mySGl7J;P>`ZC( zGE+FaiWW3|L*?f*6e4G(>0*Qxu@1I#QZo&utix`1E<7B`nEZ7$sU^bo*=_FSC!_)} zh2~lBzH#aC$qOc6yT8uRO;i8Uv9oL6b4&*Cs#H23mZKtS+n6Yls+y#95RPCEN;m}5 zZ2UY-sXwy>D}|~2L$aK^_Snvg_4X|tZdMdz$OsdNCi&tpEIQ67t;L2A@)m@=hfsAq*LE$SnrntD;kJ)T}>$n1PZ@w2lfoQ;kSC}4fa#7yNoyLs5Mtf4D? z28)&?DaN{BOwzU2D#i5DuTpvM#k6WyitBBYjGI8YN9ZxJGUL{s4v#g?o(msx^lwcX zz%a6U9`fxHk?0?6T1sC1r7%EQNjiyDkUpy-zy70vqUYd=ZNEE($-w&l5K|+FVCfOx#W6MMbCe<(}+Z(i5j@wgkVXLZ%QS9xJ z%U#3i*bi*t!y)Op!MtTwiJybuUr$?r_*>?_?u4*`4_}eQUS{?`=UzRDi{WltFWY+c4@@@03 zmW#k@y@i$HIQR5QQ{iyqbX!7c_M4vPNenD_i&?zy(?MimEP?I~I-id>AyLEJ!l8Z_ zllpZ$)ryv_&*HawUrlll*OP-CLjx;5&seI)zy)y`CX{S6syeWcKv%2<8|T!E)b&Hs zU+a&#x)sta*3I{tg}Hlst)g)uYcDA^WA11v_csD{+5y%tL`#c(%qKTIX2{>h3-aDK z)UxcvGQ4;Wzrra;tt9I+;jPZVSi%>3w?;y(us;`Rd@>veGyle&h?mkyKPDp)n``zS z48(U=zo&KoGgUxuIo8uVYj1m_`xr5LPf(1JtZ1slSDn&#vdFN6xbZmofy^4DM`6ie z%T(#|klvv4ue2D5X2cyFbMPU`GKOScl3snsYp!%S>BaF8nP7JL(sQDSjSae~V$0{B zF6O}C8aJ)nzb?U3!_(e5nuzXx=mVW#`b?${Yg$czd8~KZvhp)mSd;kg8@?<+PLPI} z_aIS|uSvK#)q>`|3v&LdcY7*d`2ecfaQ48tw6tVJ_-_DjDSF}a$RW3R7ym)FrAF%3 zkfE#Waz6C8=f`|UVDo6En`nrw9d*%;0Yw%8=hT^!T3U80F4ER`400c8sqnp3GyKMgM!jjj_hORE_^ zn_UHs6(FFJ6~jZ9#aM1o9|qsjPu}>fz+w4J4o#XM7n4d|?Bt{a@qoW;;E(#6B=91; zYTSBm(}s=x!QEd#jR(wxM<}r$hr`2N%qx`@{t%WF3vDS+pnW2oSufof+qVK_L8i9J z5#2*GLuFUK;Fm;J;cyM_Z>^c%YcSQqPd`*vyO$xGsmr!UiW^wv%pyhjPEIdK$KJav zZ5yvx>cRQWd!Bd2;@LwXf2?xOg-$RUq;g`D9N)iRj=O5;oW+=9o{&Q#8X%vGtLqKz%*aB)#ul_;Lx`mdSc{?$g0a3k*gz{47nn+`6%WAd4@~T9ipica@xlP>1 z&c=l{3qbv+D~zp9k_G7K?9sCIu2hnLQn?{jh=FEB(}a2NEOPp~8z%)_hFVh7^UK{DJ*?Y+1*w-j_JDBws>|g^+ii5MHfy~D`zE}AzqMvc#HP5 z220kx8d0K>)(ZtU#6YwSlzd0X6f(C)^OzJ_#XgA{g$dNF?;=OVrjvsz^enKe<@)nl z^BQ}hEFPyn8-u*CweC*6BC1y;yye(8@T?#S+pH4u%pt7fPUCe28fashyh1t)gt%HH zM{cbKjFokc)>MRO0mpRl%5*k|FZp-t!#G*%>WS5VZgd{qba@r%GZ>rP6CU3)$gAIjOG{dy*qYJ-LS6Muq+~ zlInFh;>(ju;3H0YC{#aeW)_vylc{jZoBLN$E2%=NnrBPV5{u2B%=-#Ci$W_@Jv#Ug zww?|>i7oL3Fx-=2?f+JuX9kRw1|IL=YL>~PLlF2YY8_6_B`pU%5voguS=kyBy?D%1AcI z37{s^Y2*=&R~h&O9tjQ<;QviP{M%ZI$Y+?4)J1DozsYwwTtjl6Vg#E0DfarZ&5|YR zLb+jCZj_#+h>cktb@_3uNkIIvd9^tKa2Q9Q{4QBRGYME3ovkaqTKmYadI7$5(7M|9 zu^G|em0l&Ba(@u{+fxeuA9t`+-mOQh5jz;j@d&#|E$`*i4J*TG_7iFJXxUPY;nUoK z(T$A5oLfZlgSJ7&JH8iXAVN=L{uen7Kdiu>EOZLb<3p%5`~r(9EF{lM)E_GOEt?f= z$?G_8?mwKn+Iw&|!qoq^RrgO8yRPJ=t+G3w*<3#xxFsIN*H9cNUx6KxTV5J={cT9B zk@Rfl%k(0I?yjkEvbr|0JV}&vfdu*F5*-ovsA|em-eOwh4XQxuRP=9@Y0|@X6O0nI zbC?XOxAd0V`hY3{+*y`&OJnDf2MK;Rshcjp7lY>1ow3GS#)j$X^p;YiSZgd%CJdkHe>!TY4~-V=mG zQzm+yufd`0W~%$@vN%l<|ksp18%iO}(jZ;$@DJkA~t%kja0J%%3favry&= z6^kNijC0O~*V)8K*&i2d2~+xUp&dkp4FCy!n0q5-4i*g$L5XL{+C~fpWcg*Via|k` z%4V$RfRs1U;0X!`JRbleH)TVxa=TaP7zb+-pYS#TYxrJH?mCj$4J{QHKJgQz@Xsnp ztN0oNWofh@SJE2}O$J*g`{L@ZhS);Uf!aiY4n*4C-h0cP+8ZJk0{MX0b5QvW5`DRS zza0cDZ<{_j94Z`Z!N?FgJ)%1RerZGC)#}NY#vZ=AnMjex7k|8Ji~avHq&OJ= zry<4s|6Fn=0wzWV2G;*&NHH;Tu(JH$TJ-k@NI&)c{Lhc-z2V^(=2W^Q5mKGy_B&&{UimxtyMz86KH=$WNseP>eY@GqL`D ziD_^Q*8qgI-sSV$KMZVOYHxID^&t9HJShATtzcZfRv|{T=oM_A~$H%RD#Wx73SRTwHtB z-;?`m^1}bb;P}AC%vug{bm$9pap;)3H8hnM2f*J%WNLo{WMK5wwzaf;&+lSq*6+_6 z@sOWc_#rhowluJ_f^1-AhA>KSyZ35so}{x5ZNdv$GXcjERc(3kfpP;XjHBJZB{f07jNFAbJ9@!s$3=-AA}%H!|Rvwkh> z)KBisFR;wS@L4sj&tDmo_f6$q$Z-2>-`T{b39%;;v zK$;(b&U}`q$DZmhen)Tl<-LBv#in+K2A=Zg6&)G>v43Z^{!+e)+aADx`6YhUgWst> z`{(?!zM7fgnUOhMQX`P@5UybIGwEJ5K8TfxxI%nn^#9lBp3G8-h6T04_4;NedTFnM z+r1Dv&o*!8=i*79#o3K7sq~M1Hr!BpD$D$)?0+OJyr37^Cc8Z-ct;&7&=1S-tV25V zZ6WD`Eu5aI__6kvlGN;bf`{=hiw1{seilI$I8eg~ko!1`I5JP#!HB;{F2y|3_MKnn z^nAE27mq5upHJN1!5;e|*2&uP&|tzNrs-Q^EfZP5Z=zqQZ^-x1`;h#I43MNfO_bG`O3dJiU5xJDG3y_@dvU05S97_xFb72OK=0sC__92e!*zV z;hX*3aSjp`0#UUQyn)Zojz10g;n9jg0-*~!ZC6<5Q>$B9u(A0>+66b83AfE`yWk)D;$NER zSlba9t9#Z30)csz^7pP(trACSo`)?S6ySl) zB8^%>*~BiqkP~7GSYf}+<1zae!Nw&Welp70gSDPW{7=J169@L1w}#=rn^7pwoe_Jj zyI1YS{s(;uRO~_qzZ?2z^oaGxRe^(`xXH`oyos=jo&DC|zq|;2ycJ{Gu#0+0w*`L% zwWcm6=h9b>OGax-n(&YIoj6!ciMAJ>b^~>FnmBqk60x9m(0t7+(<%9~d*N)jG<_~6 z6<685)u!Lj(ASU!Re*nV6%QfTrot2Lau6F8GxHxo$$QLb$s#1iXS6fHlqh8f@i?81 zg+tL5TKEz_x>n&-Tb}J4TkAnLT~wXmo3M}}x#jnt)lR$itiP(ehTh}RzAP1}w)o7^ z{@W?8W!@EAr*UYwm$2s9;IzqUu}JIiV#8wFJc8?UB}V9{nKleQmvBVl{^HfcQv*xB z*FV)F?XZD|W!<~|K}T!udwixcK-}TY4JAkL=X=;}3QkvKG*!t0^(P~Qr8_m4W8u+= zh=BM*6qmP`dNr0T=LzC7b*h!j=W{n!B(Fkj_voEI3KiBxD9n8I=V?eMSk4@5lcXD< zPd+g|YfsY2elK1?>?W4;!F+05ZW&!Xq`KfS`AjTYXo`9dB1)rLkY=aR|2-?>PjJAh zem^B5gi_cGH4s))g+_ToS!+7Z58eH7dM{H;s5aPma}Dsbj&=!Qc_ML!KghT|k*tzy zvZ7e)9PdIc z*L{5qf3zYC*fThN8JU?vvG_8=Xs)IHm`Lqji;ZUra4p*z0Z`%`o^YHHI-AA;HYZ zXXngADL7M}#?~HuC-o_egV*DbG|I83*jg5B>^k5yW{tRnrlgLmFuMuNRCMS0_ zvGr#|cAGj^0x~J$5%9BliJh=LNc<8zXMrzvvAqyW|9D(BRVG9%3uB>H+ltlnsY>8a zz5dm%$y1c^)KsU#;F1_jwZbXW#YAzdV;@vE9$!wHu|%xw2>4L88O9rL*kYqa>FR-Y z>R7xb7mk&OjmSu=f-3fei);H->vS~NWoA1-k*fuVvrOO_V;ygp^uu2v>^cY(npBD< zmiz1kdiZdUwj-*7i$;G`-a##bbvRLv7+e_A@~FZ2LUkj2M2DVQ0gGzs$hSWkdN<52 z7s2ck8>?~J^QLxtxdO6cauUoEVhG3(;#6NNWFA2dA_P|m&2YVKf5bKmJBE-+So+gK zgC~&=id411%}b@M&OOYpIEMYn8@UEKM%!G2qmK52L#tHiai|;S`;WJ8bq{wgv>dQ? zA@4UaCj~+8BfOZ&=LKl@(gA9s>Ont!XA9`fv-S*T<2eu(AE87)&D{*S^<*$P6B^1C zbiCt2>-EGXRr>d>OuW4q?SQ9J^0s9CJgU>y*Uv7&@~2oy7Kd}>_Dc>QcrtE~A%`R! zJ==|JqISDVXp7&5t6FK|s&|>h->f&{?lInlZG8qpYo>K#!oY;XTh4c~>3M)@WBC#H zU%2dNDQ3#Nh^jn@Wm^up^Ku%C3rRwL=b-y9Anz)(g1BkeOCAjd&T7v4!Ng#wuSEiCwa-#kh5vQIB01N%3s zJ~x1auZt(bcc3b8u58^?gQR;#4=lQ|BL-Sp$CLVKAso+U7l?!w{z^ZW<6R)6=xn7I z0S0@96g_8c+H{@8eDpv}){X2z zY(~PEf>*^0&hmFNzgY2pe7gb^Mw!VdXv3oPW0=o^H$-smVk9_Yn)?hUk+(Lr=^7>? zg%M2}sXo22Cts3RvxHZgs5~3w&AfK2`~h8^sO2rqDC;PBD@pjGy8KuPRj~Oc>Wj~ZnZ2*k)$rn`kZw87#{8@ijejuCj=YnDe%cbs-g+S_zg{(~>a_v88`5IEC4kF-2 z-N%GsTDPs(h?6fLFW;7+>JQe^lj2+c+Qf*AfcN=2OZeOWsFaGf8(;o~-HyPG=^ypor2Htz2$F@_|Z+1`u9%=X4C4OiH|GNW3v8Qd|Xwu%&C=T^Zd1%05 z+yE(jchCVj0<>{L3Y{jV*Ur`88;k%Lhu**mjt-R=KyhM z8ReMUYIP4?m8zA(UWJKtAZ&?Qz&Y9QbAL_jox-mN5SgKA82iT4&g?xVi|MfiS8$H-UmPTzBJO-Owr6 zZ9|POv5m(}f~av=i20nEyuwj6j??RDhPr~JX$MHRQ5@I_1n_i1uY_4INo~Kd(@uyz z|9FL4LNe;|dRYqT59)XezCZ$7EfCW9^yxX|g?~jz!ryxi!!YEj5ul@1kuP=XjyWLB zv%8eNko`J}eDyiUrO^sL9HK|L8j-Ao>L!yT9`p!=GOAPtuh-Y`vZ5Hij;%}YQBy=uD%W;D!D8;n;W+zk zv`I9GA-iJTttOgS^1Z?3@sSiwtAZPrQ_0NG*XqT-> zO?(|=jT?-F)4~H=Fxef7J^)nv(|2XIr@EX*6`uaTK4Gi9aY~1;gP#<%CX21W+Gd1L@XRZcJBkX(%<)9@hYki#oS%Y1=o434oJ-HfJz>(&5Gy@w z(y9%d23!hYAuwt(Pk+)q^_kH^{x4mQuw;TbB7eszFlL5ig{v0EIj2x5%R}>yFOLu` zRM!+@FP7%K860QNvMXbTyPci7$=%dI-)VI0W8VmhNLAdF3aMScXLd=HcSfhF)f6LN zRV~ORm^Z`w`SdYJZ0Z%y$nOm!@>l^z&*(x zFz4`s^17~L)-__mFCyyh_|sGFj~wv_^c&;Z!3H}2Y%Q#CWvaB5*N4ONIj7Y%-!n88 zFFq7O{gKt8Y?0qr=q@rP*Sq)e&QO{8Ek27%G8o<|`UiBw1FN*mSS!ydq+!iK(2S)5 zoCTzcx*}WBp8HW}!}ZCf$S^#&x+w_@WjO>o!UZL$K+Ec*=|a#4s4VHn={IRC3a^m# z6Q_Fd6x6(Yl-=iX{kVgW0;g=50|d2NU~KhOy~4Dkb1d)3pF)$9RvT&z+}q?!b7B=M z3BBSXtzO$PJqAlTFdll42zB4j+BtHUf?x8 zcgXa|(7DvgF;ohPU1Og){A%RcIo3!lq413TViRp|kGWi(Sa0z1 zskff{+e<;9sUQ(t@ZL)YgizYslitZ|K8rp`XKzAKt|ZW?4-0UFx((ZQX~-K=TaFXJ zFN0^h+z&n?gO7jbxtYd1#MyC~-&7oW^NwDb z@mWxVnm;Z(dc^m^{lG;y&uz=LKT*#MZ`{EzJZFaVx*CXH;=jJivJgf z2{K2^-xa60Ug8solVY8>@DI!iqfnZa|^WzM8%uG2ZvKXVgG2r&4U;VgvhkJR5rT9AHZ@Li`(en~ zO}3ip)Ob~m!Rn!{$$Q&Kcjco)rMn3`zfAnu>-X0F1=Bf&U!sA~3OKH(KfE(iQ)*4_ zFW)ebSWPOg{Ea&bIZDv&10zrYqZQp@2NqJMWqzgZlweh@c$cPZ1B#V@;OPLyY=q@U z&$&auwmWbp7hFD5a2ziSl0h`f){MZ>@FGVXM|HQNT11%sAR`06U2T{|I(Lldg=l3Z`f4fW!e*xQc?xq}R|%ia43BVD& z0YVh3dg)c!%_`l4{BdE$CD7WiPZWeOuXSGMrSdTK>^tJd?^D;i9CF5L68F5SKD%0| z1?5kp`@@Dal_B|?_X;*9eJ)(7`J3{mkd_YyOD;r!5^Rweoq}p-JbRjOh|yZq`M@{ zuJ#sIkfF%%HE8t88g@=i{p+0;l$ zoe_ZZT4wm_H5yW!S~H~GztMSLP=wI^yR$3>?rLjegi@!yo^UFwNx<_BG)bfx9@QM~ z)A9!@2hp+A;0};vivHSN%OQ)eH!O{89$Q(xI1J(8vzM8!5qR*sT0NnfA*)|(Ol>UY z=IwgMDfJRG-;l3MOF_OydYIcXDITsga4l3x0Jo#nCccn?NTTOyD38bbJ>W0PBI1Mk z%iyt_DW2fybSVR{UvbCls@oeuFIPn6lw=Zz~lgnSrzxD*SP zPXX>4OPLQdY_4HS=e_JWTzi8`fLL1JcO3EO&*&DBYNL%*+uR1NGDGqG!{$F$3P$c- zji2kAOTZsdwe`A*%CdN28}e!KA$a@MAhLXHf6(xQXb=ItyBeSbnEq>RN9Xz*htOfe z$?8%c^qX~rY`gmtpC2(wH`fL}A-&!eQm!BWK)(IWht^N}uztXX1v6v6whRy!jQX-> zUS#n#z^7;KZFj8OL)t{@!q@Q14aNgv&Bn+$wb{EvofVRVh8{rqBDU6FjgG@@&U1O4 zURYtml`7Gk~$XhJRShgn6k%kEoI;*w4GrZ{s z8p`R-zNc>Q$RhN%*P78HSmc=d_b5Dw9mZu21XBw291CLf)f+sLo7yAfCYCXWn1dps+OU~?t2FYr5` zYEz6!DqK_af8ZZ0@bq#k;?|r^&m5Im&E>+M^$b%gr5SYQj(K-R$}Set=3L>=#E&z6 z?*hUf&EmZOdT9Gu_@;a2khGtSZ_)RiixyLR*K)QCA>OI;ijCx^AJ6TCBnNv>P_INb!%!hiU0)rpJ`Du z4fE8g@mCs|@bwvk!Ow*9N{;o0Y$fe$^9rV@5HU=Kpu>w)cdStbIf=Pw5dh9X{8BBd z`9s~k||RT!S35kw&ZijOGk@c!dhdMVU=+6vF@ zbe(YS0XovqT!YE#2hFF#d^4q0VDBG^A^I+BpZP>^2h0vX1n82yN4SxvdavLrQB?=_ z*bTMt*0u$#aO*~?6fQw-gxPM?M=Pc~`GRf3dv3jf23H}m`t~3TQIFqP8i@Jeu5__X zDNvR6O)S31+efE0FlSzs3m-N2kj_*vf_qn@m`Z2y`%Q8(!Ht}=fB3!ZbPW1Q2)k*B zO(4Y)@F8yvtht=Sr$}}DYZ}5Cp=xyw$}pq}x>tPC_1o2qt>5poE{B<~ffNi^ed?!L zi)4}L*XfWHO!r#@I6wHl)lD3nJ^VVyUdkI*Didph}nz-k&I z{TGE3DHOa$jU?KYu{WxuEE*q-KyX#3{=P`KsClQ zQRva|ouZO@0!#ne_A30|AF{TxNrm%Ta1*e5U=x&bfq?TRpO|XM_6S1e8&C&z31ptl zE@E#%G4)-M7?N{_n)Yd^n^X0=1ZB@{o+>(wN^nO(%r_iNCOJZbxY1s<;{45Qp+P{U zZ67T=a3zY~Dh1>~+GBWJ^U{^Cj?Yh!I-hUc!XsWN4+X@SQv-Y@!;psSl(2IIIIUM zo1~QuV8-VXr#nx{tYsA3WX92WfkVPG!T(7oQA5T%lVYl<)swHJiJP@lbR zV=W`=y&X}5%WbE)MI!HKoAKsq;%%vrD&o7JZmiW4-2FpKRq~{mN${J=PH;f-gy|Sy z^@LN6Q?)4n56*EY1OVkdkEu=RJeLL;9Fv*I=hp<)1irOClFt>y$!-CM0@BVhrCuQ( zxDMde=%$KR={RfuYi@HxMo+_>)FPIi#S@>%bwubN|6)Y9Y!O`DfIQ9cjVoCclY5VC z3#j7SgjT}EF%4fvZF6ls1PFl)RiH(nFFjWe7!bv*RCv6yCf&R(Btrjq>F(-m?{>$B zY`e~*nn)nBQ4P>_qjb&55}kkkUa4&X5wxwrgS#t=&h_PQ4^W-kg%p9wLrb+F4uO%e z#CM-hKpmvk<5_~2m;1VyGhEX~(_mSfJHItk%G)r-!=?P;TDj2}$ysw$T<-#I{N8LzMQ! zTlmA?Cu3e7TlOBfrihiT{LhQ(L`{LBQkmWoNxCCuj)jr|rcu*$2PP#Fo1t^S!&F7h!0m{$dD z%M72RE`G1!?_~45K5!fRoX{BTvaDsFUFkWNhXFK-Cy*z(@^X+zjgNR(p7v@U%v8tu z$&RwpH1n2tgxfxfeD%OUEpBerim-pcjG#BoK+K66Du#JbXls?inx*c#(45L?#T1hB zQ6&rSLm?y2cwKXF|1+xJ9@NuIKm#(WPRWXvS$;1Az0A#bMNx!$mLVJ#-)3c7buZ6a zGPmNeVBTCdWLB=CDElnwcQL!^0NXN8&})7y^3w%2jJ~{|OIVR*;mDT0$bJWmw;sPA zCsBbWi|xwrS)M7i{*YD}mj||9|T?9$kXc{6j=Y{4{y2?sJwZW?= zkvx{evI8ANZ3XA{p#}gcb+u=T-HhXy`MTg7@T<2!w(G+|FZxLTV<_u9%M+ZQ_T#JU z%Q%}vI`?V=(ckhojwAICYZcEa&cQpxAv$U&ko$?t?kp}+BexiOjUL^(X?y9R@@Cr^ z3=&-iFVfh>lkRdFgRRg|E1$VN;?}|+A5D*wL|Zzos;Bq!q_cW}zAv_?{8gIF=xdf! zm;2y}O%$pkL19i*LSH_w-F7Cc7gR55k10ZkVG8|C~jav60)s5}~8wz)LX36aI)DqkH&`e{1hS!hPU@~~& zVAbt4h1B>PW|kwW`fg^S0Vx&o+##{T(pYvTg99h6!QAsqOV%mH}UMVdu zN9)s$d-9oQWJQ~4tB@LYj6!!5$hJ+jZspYORcg8?W%aPj@8Z_5IIDnEKw9^$jb)Tg zhzz=u(-Kd9;*9pIg}SBCxLL#{gvT|-cp*AHVvMcV8^Uy@M7vc}h+&}9?w>DP)r`U~ zT#j|J8<_MiM|{XGar_(bmv2rPbKO~tLZKl;c-ARSRUDK3z3ElNQe~8Y>8S_xoa5r* z5GGY$ccZNAb{Y_D@J)FT=rg@{F1;y3OAuV4K}Ok(G^)_e7U{rhA~uqE!=t-2(S;pS zTDqZA0bkRGxlFEl#9pyL~qV*IVQZHa}v}Cg(?b^6@hdM7sI7fGT^WBV*yLz`L%D$o zRxGawsznz=eHYNKn!Lj*4@f53!8SFbB6%3t=E85=SL88Q3Ppub7=d4qp$;Fu^DJ%Y z4;V&H5>qOsom+WKTPD>p+dPg*$iNg*W`_F;K<{#{#8Lku+}YJ=duNHzSYFQ9Y0DxT z5!YnC+-HijgSW!w@2@+;d1bin&5?Ost@2^C*tm=>I}PI}VNDf=p+=dVCz7OrJ1kBLF zP!`7iWvL%0h}*FkxN2>x*Cd9NFP|B&^m<@C>QWEqKsOQ};RK@)c+$xN*|+QJqTdal zkFOh-Vx(YyHdUNBza<-t6-+CvmPmzk-cL4al>Lh-;>*n!4sRNib#=ve*Xs+D^m_J> zs-cf-*+P1fa9Bqz#G?=jA#<-3_zjq_u*dw<>MXdZUh8fdw_5tTQ1!>_(GbK7`h%c` z=1#;A=@^mc5c|k+Muzl3DZ_G`i?R5u2cBPXk8o1yozYKMhh-fX%mrREvyDwQ2o*Iw zDDVujLSP~u+S8V&3NeX$yM_Ifyv^naEd=Bi|=;w`!Dw4 z|I2pPViU4AXXh$5^e<)c_C3KzCoTnan=V=Ut@nJIrG|CXj4u1_65pR5tM%ZSzbbXR z-#fYWh}|WScsBBR49#y&>AL>v&(b%Rm{5o}lOVYXm>#W&R5vxj>cjwt;^vdL# z_R8p_v_A;uHOK|8h2h*~MmnqF#G5skifH&fhQ5-#s^Ws$bLmSs-<(rF)T3thsJ@*l zZs4(o3R1ls8{F=+Lwy-^7fLv*t;nnwtXE&AEu9y_((HNBpJ5JVE%vo3{lQhBY&BrH z6k48etnS*Ry-|9CGHMbHv z^fB8DTI416Qmi^IDJ@stWV_Nfsok?m_Scf2Ka~)y@uf~mP?A?kr*sw~Q%3KzcI~7& zwJI3uViRFrjheQys^#v(FoekB5(%}GzXB*a3o~tTnHedorWc}NEJ`gzlU&(Rygk&MlWhP-$yk6rfI+lM|X{qb@|k>g~13Ji*28Gp5?lE z%`HCZ8cs)7hMTjW!P1{!cQgd!%6R@MfMZ>@Yd||(5@lAq8r1u*+4kTWQt_ND1%qBD z8KC-+It1@y?*!5Qnhv6F21dpg$w(zF_b(7}ER=9?=WWt5lNNUVO+s~(WNA|C*iq67 zwFplxXcDN9-5rM_ed>84k1%D7XrJFEDY4!e47|zv$W}BiQ88c+oa@0!4y-%9T{4?F z8*^$CKkHCVRU3glh7Y;%0#k=7Me7!Z;Ap7QWK81j?ZhcX75h8IZ~{H?W`i6q)IJb3 zfS&oY$2g(YSR|<3_dSjh|FEd^mJX1Kw0(yU2-qy;aJX=%3sRBa%eiTqrgN47Uv;SO zvPYipoUxRC#bwbs{Bc7Dq<+Zr!?#dy-oc>)x3r>e{e31>Ef>1ukYW$9$64XYP8mP& znLiZFmXcRRkK?Bin_*iChrmARF?XLX{*UftdiGOpHeuwpQ7`}pGn%WoS0{k5lgDQq zE*ls+Gs{^@ym0>TRE4zWLepwBSp*JcjVuh$mB8Zo2uJTxqHr3S1`o%fr+^a@ef*B` z$8c(ntraQpV&zHl@7MT4BuhFu zoeP&i8b&}$h(*~tx-rzF6kETD8>H7F6x~GYO>%C9UALPH*lR?+K5HSeBUzgR%}w8% zQS?Ge7UC~6#jBvv5>XcYJ*$b?Os7?zLZn2Bp)y8CVi!aiaHF}YtI1*A0p<lzE~9`~I+EV+r(cuEsUW`bO`NSU(F8Wn{R%il5|@#p!pfEyP4 zj=(GLZ|{I>n5*?YRNPNojfWFOF@j6YFGIiBd!fv$eTi+75vF26SFm&{nY93#Eh~Q< z_;paRJN=-?a{Ss({cb1XPo-^@Mf!6sDOBWgAY*w4-<(R1UQV+vz1R~b(B9WTOWX@M z1TT`(ZMxZ!mY?+1Q@)B7YP@G^N+k>!FO6zXq{XHlvblFg1p;Hji*eSOy1!XbfzOgq z*Rg)K8nZ|h@hU3E#ALXNTXTRFd-&U?Z~4x!4$}nc8LVmw2u7&_Q2~R@)6d`p@He?( zpjq-x%DVg$4=C@)>Qp#X6Y>#<4LW&OTOmj+Z-18+V_?dz$p3*DId}h?S6jeI!YY&h zc|=;jpF#FPVCo{&pD0sjn@BTHm0z#9a*q`sCmV+_k54NfX&@@%>evVXQ&L>TgcE5g zta!@GZYzwDUdH^>1z|CG!)D^AE&w9$E`KXh(>7_8e=&DzyMzo{->Wzf;PyAVVoc~9 zH#z+i8;rT-Zw=|ihfwE3qJQ4HTZWl*SrLVx3hDIk)Arn4bXxc)MEn?CixVT?Yx*Bh z9;mm=^RG?eeyXa|WBo%r!ma_wlz44UO$pKJV6prm*5fS;`QG@XD`pq*=derxLXxhrtAa zmc&wnb>DG*mt{;+kfdzFRO)DM$%ROM2;76Pc}r{cfK_CgyZCzWNAd{Q75d2oOFig?}_=~EJTKqq{}uuvgLSL8wSbX#ex zxjzBriw~>Ea-s@{Ub>Wieari!_;n7EF|^VE8*!(2;J}@IDn4XnuRWUzZ-O%Aqj-M? zGN)lFTz7IQuTRQ=U7vJ}&vExe{Zw95LG0^1@CBBc6jh?{AA_`495P zHg26fHkNnO}8 zpl#cY%w!-3`_rRAWpF<%W0&dN%Q-D{#N$S?KCzY>*!MA7H-Pfn5wzfyC<<}0DkP2( z6qmY|O|z|6yz&XE`5#2<;MWBx#quq52r&G(b`=qT)NeC2{!>$!@ku(={|XoU$VJe zY0~r`_i8UWBw*VXehy6MvR%mAo{o4a4*ohRK8r_Wi%d9N*SwVF3bpYW#+gC&1mGM| zgM}jNq%r&N+v0^XB742SPPTG$Sgub&q*MC+*QNqM?ZTwLPJ%VX_I6#zP~spJUtrmr z#yCuS>wY?;h`# zk0N;68vZINivd^?iB;=s1k_F$R2*>%xN@Cu)DtN%fdo8aH0vLe}wCF!D5Ht&1BcxkkpEF;I1!~#paFPwa26Pf8j z-bd$#e9JU?Sl8tC6b8^Ox2f-a+CY|~7*{O+<0jUj+Jv91F;WR}a|*E|;uyNMHimB`4$xs4{yN@;QsKOg^}j2L~gtt)c|d zrK<#=E!C^w^=hijGQ3WC6ksQ$XXzc6i4B#FOz4^kfHkP(+FO)_m;1|txf%uL(vWDq zNgTaoix%=(IQ}-m=Z)HF!?cM26@i!L6tES*8-;%e9_zxBrWw4Pd_gUUE)PXmhSEj15%D_vo+qVmOw+82Uiry z-C=~Tb)K?YRqiP%h)ln#nGU)y()*w3KI*dxXO_FRET823u|yLQ%T#7|s^-2}K4duj zADWq_3h>S3O#Ng<10=pMN9Xv&zF5~1qFWxLqP#umNp?Xbmk|qdV0}|R(Mv_ZLT94p z{om*J$f^6n(Xu!^Ebwgs1k_6oQ_+Cerj6==qcfG9nj!Z_Nl%75vk3sg(!w=_%Z16g zpI?uy`n#rfODW6l4#r)Y2&kKS>%$#|03D`Ev~yN}-b-?4+oY*YnZ+`RxPjkoYTxeu zaIW6LL_w0~eVi+J%=hj-q%|R67!EsUkrE;g^(=06!CaOXClOF6hqcnW18`>ag=yCd<1xekk z%ibvqV$$+jmbHg$=L^>m*K)02qNPShx95cI;X6a3WFo{|b=00FJU$z@U2elsiRo-6 zG1=`fjq`< zhhSRg;#DJ>2Zj^g{*s%w0oh+VG(N?z+9Q}GG=zT`iN^u;7vYYYKOrDC9&ZdIC$?3Yk~HFP3TPOEPnl1_H=}Ov%K;s?8+SG=8{|kOF&)E zc3RXO^wqt=%Y-!lIL1bJsb~FDFX^j65^?*+Cq0u4Q!*d8laqPH9>^P1!roDOO$jHv zi!q{39pQ=IXz%v$BDnjEE=AK@*YrsTXM4wd-dP*c$4Q{Mm+Mv9f!gI2bWtpGPkg7@VGwpVws6X1;Bz9)9uEKuD=Je#R^p{sQ}pMF7|Kl|&zuUhnr%|HMz?RC zjo(viM5+fEEQ%d4ktJHM*P37bDnMV|RCH@Ic z+j!fx&mRQ?UuGd->+k3Tcxy+b&DfFhu!AUm9Hvy;>TP zW*K5hoNPaVxQciIbMAebD}G%XMSF+a z2wtzGnpt}pTGV^^sI0kKWyy>@u-C16H_}Bo9R>8SHICoKVfngx{xf76Dmo^~hoJf%;6WXs8PHhGt@j&$#G zDCxb-ujgmDI8F+QJU{TqQc}IhfEK{359Qva%%cs$3nTtx=*uTkt1E(IDTXb6gv?gq z^nQLu5!Xl#7HxWg6654?L+u_T>TDQSp1I(Ct#@L(DKf@tcH-^<*=DCsJ}lGlHRdK z7JJROF-laW*3zJm5)jMKU)P1)_jSo79j)NBQo+&Ski|nNGFpNN{;g7+AI70zbPUfR z_Cp zJE6eFN`SZ_grUfTq=}G8~&0B4?~)q`Kd zvrz!@RI8#w>Vgfvtkq}Z_D~oI#a9DBv386=55Q?6b>Zyybry=k6Z_o8&mpZW6OvaE zvScQF{ATHo!^bX`0{u5N8$||-afS7R?0WRaN;Dp`teZscOejLDT6Ku8m_|xw1Fhwg zJa!uLp5b4cWsYCTm)HbRgui3OV=-QxH~d>k!;@h>Xf!=i$dJhO;a?eDxJIsKze;R% zhkfzH0rD6A0nl<63Beh>$G{FQVccP*4MzzP;DZP0FLJ#!Oj zr+3jKxn8_hx_4P!K%Z@36tP&J?Ksr)Nt6w7h)85x{q8{K8sOu~ z32Ql$x+nPf8Rof7oWlC`Xf!_GcRP z?e1S3CS?E``ukK{j@~ zm95+m3Y)ZmyT#Yz{_;u-rZ;~g8tUr3?XgRpTX^UD_^~fEY^y1+q}Jt>imG@K-c|me zi5xu;%~EGzNKGE2GRMJJ{%b8{C8T+E7e5|gu>N?vGy&~(^()e*w~r(Y^zG+#k8bVAxs*CSMtakOj^3tdy+SsR zY|pU4QKGAi|Ln3R4vs2RUoGRSH%ZIYLsRO=n#TQiq60(;?SPlqMG|SZ&$L=lf+I?-C9a??9)lJ z6p1KpKog@ky7b@+$U%wfnb_FHP=v3n# zFG9Ds`yLaked_rs$ki<>U)%Xwe@>$&?O!%-iRu?O3|Qz1Lr@XX%vpUbk;b&sE62_m zZrtCe3^YX9kmGP6*Xl+(U0Ut;oc}G3wpcB zM)jNPYEidj~Jol3=sA-L63EGL4o%I9&BDjgV0ynnm-C;DG0p>e`d80#^p&F zHHq$VDr({ewk#JtIdNyNv6L_~fm+Os*H7D}r+*dO+#vMO@D==Fol?NTp*?W9>I?8b z9w+3o^S5vbXkrb8EMo9hp{ZYoC}cqly>J%J*vVxFRNmIqHk_4K%*(DY`E+%_QWhRG z-R7SXIzBKwar~+x0y4?*d$R8pwYrkHD?u25_ZAbgf?>0<<)fCIil(`|*Y6Br7}HKQ z&i2I6AO`fC#=2A5h*zIUL^_6UNr#eOG-qrTbv`ksdye(;;KqYSuv!hz0!v~sglEQ# zfVetNJgP;~VyuOU8bL{ka9O#+aB%SH5kJ)mv;DTnJyDm`K-FlC6d9gu~oE+f{ET8dUN4%*tHXz*TS>49T7%&aYT!6 zjYCTs%P=jM8T)pk@nU>LIPt3@`;ls(8pO6)c_>X{;B)zl(cQ=i%QA zknSa%%HK@A2R4_nYmEFbQ{Ez!`L>EMUK*!)}#R8g#j6j|( zY{5xT(YmDehXdj@UV0-uyIk+(jaFWA$!c8;y`_7-*u3StAxsnZH1frApormdTHUXc z4C^#L`iB8DJQkamWm9zyI=0FNE)vV;%q94k>D~uJ{}sqlrxvdKPWCgOx@gMz5(&ze z&-|zCa+*6+oS7Cj9f#rZud)Tcbb11NU%Vrg*VCt#Hs=-moNsGKBhr-4XC;r3qgEd8x-(-v9?B=SYAOX^U=XV@P&Be&Lz zU|tKlKJW!MQ&m3Cy0W@>{Ynk{Qo4uj^?V|uiNSXe!N4rYINY%uqT+acu&qn2%~~WQ z^6CysEG4JAO0O0V(gx$|V6HE2q33 zc}D6)%@u)rur58aI3yOIX)9se5SvV7zvkWeIGS@^U(6{t0MuEb*uxiFsxSC~;gI$Q zYvgQmNH4d8QY2Gav#_`a6S4KtJUF$PGo5_PP~0&xMCty6fP~ZVL9kgd>m<(xOO%7<6wR1mh@5oTF#FC%s#dyow9DW3g&!m z+*^>7kvj4Mh(>oc6J!S*);xCtnBOziPG1+rja?TonrD{rlOQj}^p%r}5*D)rdXmBR zeqEXyYa%dwky?~CQ@TYSSl$uteh%I}wtBp&D^}rYw~NXim`=c|D6YMjhYTx_{Bhe- zfPqul8}W3A3>L>P@DXT?I%N=%_MqFsgfk85w?6N=S(e4onI|1$)h4SF=5*{594R6) zn9`+GqO_X}$TZBa@qW!XW^WE?U#_fqw!*3K)y1297UgeyT!`rBs#TF!6_XAXeHVQ? zB9d`wIV;(L8J09|SvkIG&IUzhbd+-u0l;li6L38LgsE0q2531RH6SeI>7c)%T-XxdO+Mz%dafS z24t;3)9rtx+-s44Q|FhM7rlde(!nA__VeyTs&=;wFd?lR#_er)!J5?v7!qt8LV-Sj zEcM5X8gwnlo^#lyevF+qJtc)$si0sjNaquHV>U&m>va?h%EFrW4#{Q`N1Pg6$$a9w zCE%^3E*U_{HW`+Y z_<}?qiJb)|;dP65Vji&)tudz!fmR|oGpi4~>Bu6|f!nP3+W#D{L0fz56WP(IWOuY! zPb1Zl3PMQUq)-cVb!EUr`d#KDCasn&hCu3oqfHc@zKijlpO!p%xC@kzy_hxJ-$pmft3&)H7Bw6%=mV{4rc!mcn_!8Ge6n=*;x8tx!Ovw@$| zFlz>M%kO-puBwogNmEaK?w5G`K=%b+Zc`(Yn4R)Bwz-^i;c2c_r(h#w*;~fRL770k z$J?Kj$PM3hTq+H?}0>=9?4 zd|k<|ugN`hCnkd^fs?3Lvx1yA+$IfC0G~E2(3d0{vK?jNOVwmYsQ(M%M@;X&KzHx6gq*DC zhr3Y}JsYm(3x{27W&xy<;ni)?wyGp*;(NH+f{v0(av3jxyV&$Xup87SxX!n(H^pk)(f^a zy&e!y9SsAM5q8ldHGuOJL5Cy ziKw^Hl0?$G&oZ;-+Yr}odVUS89TTRMBy4}xb8bpJ;ugW#53_&>bfL#?t0NBh%`gUd zQEU{g>*k=}yKmIn>`h<7ri}X$&5U^_|$dxt|c= zgE!tHLfwwcsDV?pNAr}}o0Q-rv#-~V)zMsnS$IEI%*?@seJ?Z}BW@hGrIk)-@zN>( zu^fn=FMLz^6S#b>-d2T?GI26oO21nRx0etw=5+@H zkFx{S&IQ@{Nt4C6Rs7YJfKODv#PU4Rg9sU{H_A$k?kdKxFA#TogWk!p`IMM`b-)4= z&e{`DDu>X>AWa$!rz6O=l~HR=)pnoqPT{Ia<8Gf-m%giu>BaJwIU}kvhJJC=N0k=T zT>rtbd^Sh_2$Y&yVaYTa0>m}iEk?A6CyLBzJX?b|O<8f*z3%!?d`Cp(3qqE)vaP)s zMVFu#NErI`D+lQ z_DyuVb0jD4PjxNXxxVI;R_cR1cz!n@DDy{P>4#mS3bvB_wBe1{V=H8l-s?9pMnPTh z1Henb)G<-%$ZJ>qqY9C)avENG=-Ep$bbu=5dXY$dsv@~Xm!jarS#066;M+0lqt0^4 z<)2UvzRAqsA2k49DNs^CT#$v>wz&Fv+qvFATJX+OomBr%2J`ej0u9J-0jZE3*$ z4C@P<5nzCb!0*DC6{~roE@)pT-pOAc+7w8Qwpc3-vUg}U2eb=$ytn7@A1&P)%<;CQ zzT@tp!QV5)elbJft93JE(e%_aQO1xSggUnBnX^eIAa^5rC&Vmj*|AHDr_YG}HV@{x z(af4xiR0v09`(LYJX14V+#((Yz#H@=N>S`G^l`t2qhJ312_ALf--p7PQ=;ALb4r3+dSBut~ULFm$C;;?+d zc~JbIJi@NO5dxoj?IFzp6lpXr_!*~(kX@f?Nlm0*K)1JG76KwC4$_EIZVjXhCM=){ zCmr=k2$_68%>_Z~`0DXv0p6@IU!F zGyY8*GHDy>m*KpXot1M(Zv{zw#DL{#CjADzV2~1K%u)CKZBU6GtHfNg8=E_ThXdQl z-BIdgb{`b578q5SI#37b6187Go*g_*gR~>u1>MNL=ascUFDpb?^O^DFTJMrsvYax~ z^#ZwA0Uz@2zRZyy@>2e+R4SYy#zhqa6ivL`d&pCpa$Q+i z{s(epB4A|ZWZ?YY_P^u*TM{s`u(LA#e{x-GJxx_`wwp-n26wQ-_iwRyI;46n3oJ~{4-ads?8`0Y$>&R;S{wj-wmK6kD)~79V+Yk<2_TIb67UN^S%4(~WC5?Q z0oeHX_(-e<$i2bg$*G~G83N>lRipC)10VWn{ObW^cz%IB-(1?7001p^`#XSaZ*Z>z z2=2K@|C)=j5Fh}wfdEg{+5`s3NlkGzMJ)kxTZ+I0upofAFt>nGbY*O6WdI-5$^;Ua z6Yvb|?m!xT)&LEx;F+2~wX>L?xYIM32Qc=p0a#kS+=08YfpC9?VgSGkl5E3_zJ$T^YZ!2fBB*fAd3da<2F6*L#icOr~Dv49u0uslgfcd8?X2 zmir$;w6TK!#@yPx!U11T@7QOrWp#hkp5b5Rp5lUHYX#;27#489+0!8ZdoZ3{8(3dI z;C`>&n*dyf3|-+k;= zmg?BpqQ>6rg752dgWdO;#0Unw@d77+f9tZejmiCG$2aDt){g(pUhUai1OBDn{)Nh* z*?jM!F(!<5v&i_&d>NfdX86+kxf7Z~A-}lpNlCf^R88Vw3oqnW8 zKYnQhtnlIl1pHyjOAqc|^TYc?j*i~!0P4xuZ1(_={a1jzt-a@A;d7VI{}I0Pi`e|R zsxg3ZYjy%ZYh-F_ZtP0_`8EB<{^WxN4E8Td1j*dY{=y|;tz($H@_GMRzC&ksad7rZ z|ITxH)c^6%{q+D5EZ|y1wX_)6Qz6*oW+j5v4NhZXr7v7v83yA)Ia1WA(@#9rH{HET z!|okZvwPLT8QNtW|Lt5d`d{C-QNKCfiNn{?+PXvCe{(m&llt1@jbX`h!w>5bOs5;A zv>?|~)JJoEz+&jysm=D*I-;)7i`F}kB;Vl3L7>Aw|EAP={;sRM!BzB??Ohri-m=Qb=MnsyGLR)86#GL#yt2W$4@2?;EBn#zm)YG=IeUqP@ghq zw^lJAv2OE3>Y?dORNNY|HLfqsaY)eqMhMys*4CsW}S@dMakWtfnWktoA zl`NpZo6{CTw3aYfl~~07NoX#mSr|U2yEVX51}UJ6lzLhD+pb13{YywdWl?6?>eC*n zEheb0sEBhtA5X6Eem7rHn!`x66%?vSX$8}HXo9?o$}A++@JL)9%aDt)YM(#jUdEXR zF~nf9c7rwfR&3&2X5VF>)X(aE;p$c*?F3RZ6OAc@`^4fyw^Q<&SkE|v#~H(j^Px5S_0qrdRG7%}r)Gt{LcUo;*C|vw zXHwF+rh$>ua7)xkH7FR8w9gQSa;ah*#Y*qE>h7-D&t9LhsSI9)JS}Re{bqJy_tF+j z)6Um|d>P$BpEMEDblfgo0gFh(2=Cfvvd`XX?*w4BE!{k(aEuV9g2+2HY+axmvFjRv ztHvZCXttnXs3jTHJq8YMZBZ1sDH?Uh4fL|o&uc!xNXqs{Nu#$MW{fKC z@^z`d|8Q!(@|FQ{wSp_qKHJISVysW({HJvu-i>D0G&Me>dFcS_`$uq4R{ zE+V~hI33p2)Z%?FkN*`GiuGwBGs__((1|(8tT`|`Y><_G(qTRUlwr78&4xieb|%_K zIya;o@*>Oz6~b>s@INrb_}zp_No3O;fSUa0#f{H`Y&3@Kkg0~XfgimhA39iechZ2k zL>*%Q`GwN9C24tIZp(|v=>N%L+48BEb2?LYtTTy8=>_FBaIEaEd7zH?fRwD}MC@$O zuRm@8q@H+J=9YUd(7YgaN|~0R@TPZ?Y~vN`^iPt`j~tFPFfGvHL+k=e>0@rJ?ihQ5 z$Ik!w#s6s)MV#m@dqyB36%Le(S}vRCB)^q|@i?5XgVg90h$+r<(`F@nQSgF0z%7!P zb0OYVhX^w#dxYl+CpuKKuwTRhl4dN1iG=z&_jth3X#$C>K~NH7Rl!g&bJIp*ip}U* z9DyH*S{X7yA+BR387gD7@v0hS+-GfL z3y~rQDV8GIBLzX8W(kY9)q@fQwJNc>*DeYP75>A@xRETrAJd$Ss{IEHX%$2>8^T^4 z=7>i*UA3J7+T2uI+0NKT!0$sB#wL7aU?1kBC&YZ%#Tb2GbR8a3!<uc4>#f5RiSU- zwbr~NK>D4Er+UlwL2rZLoodKmc{oVED`Jdpp1C2g zE_}F#A;p#HP={EhnC?-4owdd!AmhFHKgQrSTlzR0a>IiepEUWg#3!4QyX?H2zVl$V z`lb*iu>uqv-**W02HPC^w*8fs5v#+&DdJ-h&V2l?DN*cv?onvR*^sff_P=1_=gk?e>WPiGDTrU_9{wT&Z z4AA6eKZ29geT9GrEV706tHpQ(FZnqpit)5I#3GJ~H1AXq18LzYNGmwy_D3%@Ikcu#4W(IDNZi2wJchIt~Y(MDy{DgwfI( zW?vH@EU-9ge?QIV^uFoPkA+9`uhU3*vmp)>RQ7NfNiGVG;c+?O3QmMNNxN69G9+u^#o$Y9=k2TpV%K9Q4ht&LNb9ba5{c1GS%FmV)z-E8^Oh7csyZ`G)W$3bmZnGIIgY2I%t ztR5$~#iPQ-HuUhn<;p4h;sc+mvuv`9izh6?dRiqNCr393c+mVXj?^{yQ}apAGPD!G z<5U>we>CPV@8eK!aw+@Op7SYnHb4mtX zf0oh9{_Vs3?0m7QngN7i;J($H%)aqy*Q)fTi7g;^x)kJbmeAJ??&!C6_03vDn;8 z(oe-aiTEeFd*~;S5_ThOWnSiv-;G0CfE?#l)71RtiSW9jA`gc)B^H5>24S$?2G?ae z+4U5$?Tp(M`EWc>&o&%A+r_hd4^v}5+FsFw+{tIp!hQ zIDC}y?Jk&XEGBb`!3K%%3UWIzr|e|d!6(yewUII!KiShmWs~JMqV&kk$Do=DrA;p< zvyLEOsFr9t1VbDboEcV;({&Kk!UXk42x}y1W_;A%nQv&qJ z-|0?^+ip1;p49Q^#22>H_g0%cwrLS#(g6>ZCO8OZ4{pP#Jt>AC1$uYVeZ}+(Ywd}2 z0DCWN{AMw__7D$O4)L)@18 zX^k!%743Epg~}~4YFr^76}D+_FS8q^3H4^i@iQ0YfK+@C<)(AiL*Lz$<>_|(0I|!0 z29H3UXV#OKwkxFOWWsKm8^6(K z0sc-iL7l*>PGhToQz|JbBdiep{s-~Q-|f`y<15BZx7d}SJfis!@a6(^YWYj*lq>6qSCU@Mj$e1AaYwPAh(G*V8$wWPm-W%TW?TIxk?Ah9meq zO2hzIXHNzj1G-_WS!a04o}qMo?AWzrxGz#qKvMjSv_wP(%U#1oWR#vYinR-gT#&pj zlffhq9R9#P&~$YdQOySI@c7RTGvcGaX?-K2IZEu#75Lf%x$e=O@5fLiCZ431;=8T2 zcRY4U6lOpPXAJ2sh)U4JHL~}k+8Ea4O57ti4!%_SXKvZws&ni)e2H4|`!IUyt*060 z)Gk=*gbmJGg|@zIn&2nwoBIYrFL}GG6`4RJt~2l)t^De2$iuadzNHy~wCRIRC>K(> zV8AxjCz?2c{lh9e(C!O77_WiWxXZ{GWj8^SZ55$v3g1Mtg|}mH4Yv33`{4-1gf&O( zQaO^H`>wvGeI3v3+}S0(p72_u-!6HmjwawgLv;S@l3P4v_ENPlq|u*r%!$N9X~v?4 zJ4`2Wd|nls%oYn=XxxHC#AWo?iMWPe2g`SwM|p5K@=@mGRcAc|;=tMUwJd8=ejY<} zsf!Czk31jYYDO_S|4`RyA@uX$(KRG=1IY3wnqGKV6%U=x7IE-MP3^|BwoUOw5eA06 zMpMG2svD)~WHpvx?Ammx!Pe(SXBWVV1#J|J(M>)`CglP>%N)}1g1hqMU2 zq3JjZf1$Lj{R*jibw3IAizQ(4k5Om=WgB}I(pC4(p6#LYO2*P3qlbFa8VC|43SM2Qb zr;ju|wAMe6MBOOwVCGzt?ecEdoLcndayi)^Idf|!qm>Ql*$9B?3pBk$g?y&@0RV;4 zjm|Ch^*CGfw#e3lO7fBF2pS6!D_dHUDm3p(eeyM^pE|(y!D_ez*=~H#iNZai47x0j z21>HBTp7aWGu)=n4{>XTVSYDTrT<2w_%DQT@H$$WAL6u)evp=JBW=zqdtXBa6l_Z1>7={f{zM8<{tXw)E3 zdt$I;)uOixho>=OTYuTwe+FhK2n@@7+l& z2d$=OzcwZ!?J>53c@Yx4o{f6fG2{S-2kz8Hq8j@MDUnmn;m3=?qJF<*J(UL=?VQcx?&6$T$V% zyUBV^6WzPFp%JpdEA<4T+5CQjpyQgDbtbeIFl(#wdkBFk>Gj3E)g*QXN>T+o^stz{ zEqL=+``N;N78r`wd;l0d-)kTFyF=^CNf<3T$*A(6?cqz`Yv?cXd!-=_}Zw zB8a|^VEKKYZ@JLpPsW(22ST6=$mIC4=&f|Qi`f+O)&a<-kXuM5Imb*Xd(KAi?Tec| zBD&ptn}o>5Cd<3@PrI8OC+HReD&jhWqgbr*%NG2Kg;YbJBZMGSGUg*WZrIOIxNP7& zPu8}G6#=()5!!pcft7GPrUMGZT3IVZci%|WJ z%5mI1;axq^gIP!Kqc=yPrkU3$-B071z7CX|Q|Ic^F5AarPCAmQibHk7+LX+XNF*>I z?o2*7hz$E9lo_#!wD#YVWT?}!hy9Y`SGxxW=F26A9`cpgsNzQ6jG3WKsOOxLcr~B$5Lny#+CkF#6 zRYpY57O@t&bW1wCPb&lZ)7{CRz-w$RW@|wLu6&M^6*-arejP;`14_ zsG8&=Z;J{Zz0gX-H;!;ug2^afsGkI}$8opVPQW1ozNc$vF-AagNbLRWq`Rc-GHWy; znp11yAW2qWXX$>LRq=Sr!C@W$=IwCDKUM-_wHbLzL7k{S6C0tZPaoVa$~97zALEGI z77YI{%rn>~4nGZjs+3cmITq|#$d&uY z<^fYF+zu5>q3Hc7mC<_0k-@edhGL9O<;BM)nxM3PsXNDpbofg?21cc)QRuKMb;r8z zxmS!|z%v0`*?9R*{Dt?6|ywxVegcky>fs$BjBqBpV- zhRU8!_sU`$wcu%g9+Nt?ec>ua*zJ2RmkaY3DjF;Xo&ykE2_r0bC8ae16xF=0`V)dc ziCz?>A+kxquEbJMZ0ze$kDtDx)lYIAv(p(Wh@MSf`%g%rD-E9Y2)m@;FK^i!EbnTa zo-_0R6h1SgBq55NNF1ueU}Oly!uiDN|lMA`34<6kCgLKN7L%!gmCwEH+DqYc#JQ0gz&!Xe5=S6n;% zkCcy`*EZthEwZKFkh;ta5~8(f`AuuX&{?s9q4Vfq*TZ8pk<&%rvn99p7+Su&cU>v_ zC$fccvSAMI;RH^vu2_mNZ2;|%MdkjNOaE+}u8RvxUDoT%P*-gH@gxA0V*shKtY4O7 zsjb5#TbGPzCE%N^=f8~-_RwT^Hq%Q>2n4d9iR1jl5+c@{&gIox(LB^NZ7n#OYEvF_ z^q#=)1d%2$u@1{%`xOEE72g?kVzPcNq%4-f zk((bB>O4Y_Oy^{h$Xu3l!x@u(aw3J0s#g6k=IcI-G?X6;67zIMoO+j8pvyxTn?O;O z@0t}Dr%C}b@E(-8Y&HM7=eo^U7dDey48T5sF~ew}t&s!L$&PByX< zOFGv7t&7dPm@IGX-7qW*bEiar{3vDsW=0QiiR_Ao5c4daPWtx!k&s*hcjZt z@JlunLO?M!=wswsQdyWmrXSPap6n`;4gi( zxyApXGtSg^P428#GLe-tKj+_a8dy90LcWX75(;1n&57f%XkG{=rHt!Ae$l}JJIy0f z*=+)Yt%RY23$nEjd$9lJh!&C*NPXb|$|U{DDWry>9LYDe)+NBvjwaE(IHK4C4e%tR zE(~zLKN->oI~g~?I&jI779fYI>l&Ks$-vy|RClsM0p`1~%;mbi)<7x$1F z`Cy0oU1~jVf&M-IpYQWli%h*Vt+Z@Yl9J5Ui7mRE0ncd0nmHy$N-}2I#-hGaz>9M1 zigHIcHm?trZScE4ca6R;J-CnXpjOawt>sG^(*SUf?*mo$vHe&dt<~_cDl%Lg`Yk08 zV^hvtFd^jdj+cpIGJq$zz=9{}J#jN3`@ zeNhyvHp`AGqnAxP%3jFWDAnR08U_h_=|4z??pqL~MQ&q*YCuXN&F%#kzJI7!0^7MUHW80eaMS}v>YhuBsMxf@v97$y}G@V); zZHsd%x{a#1+r>qi-r0|jw-W^wtipv$6J7PiLgykg&X*;AdZO!bHjfhdM%qSzS4yy- zsXn$!rG;(VG>_8zwro!$r*R*bpM!3)of6N#1RjsW7B-1*iDB)NK`ZjrU?ixg^!h_U{wh zJZcc(S!c7q?6YThw*?_ST;b&QV3HKupxNO<6 zJU@sN638ny0BA9Py)G7_K6qc zD8aeSRPAddD+Q9J)OL|wl^sm0&s+B2;TrH*jaa9z&ee#0Fw?2h?y;)vpcc-EHXFiU z+BaoKEoQeKbUo1So2P&II+ekQMreieBlgu4lDH{qpXN@Ku$BdJ;2TZeJmVn35tqctPyWpv54I*MmQD)TT~f;41p=^hU7s|Y1nZXG z+i%gRF>3dzQtW0OJJJjUO@BQot>Lk$6NxZF2w;)+KDr76b)(st*xoFUG)BP+J`;HV zvZ?_D)~nB^pumGB(BCzN{_tS%tJ&t|p2hT=T6p#JRDT|FN~`L!J%{+=RB4#O=RpU- zO2e#^T&3dLpFbwxxD5DSgmUP#srqWCcdKH3&GMT_-+Kj+B|+P=x@vlE*{1}AE8Z9C znbW|=>ic~&G1Y;BH#oR??r?ynHJ7?Yq1c;Lh8UzPLQWf6luSdvJa!H#3-xn-V#s;5 zRlVgtN5WPHjvkRW8G}0pmJ+Ee%|TX3AP=7iJd4e_O%U-e$OR(A{`N2v(oe808|Bnn zPp8{43lT-N>hvR?@I9c4oT>*}1hw5ck&x;t{Q)9kzaMGGZhLg_ZBfHM5+A?)V-@9_ zLZ)Qy(27t~(Bzo7@md;y8Td}t144r08d@o3rw-e&Lkq;gfxesHL=JQ zX+fnWH9%E^=c~mpS2OBnj2eOK0=2s8%KyfVc1U+iQ|!d0aW& zI^>!@@9Reaf{DuaHn z&4~>1tPBC3bUlK~A+Cu>$wl!ONqSz|GgZyd>QY-TG=MN0`Igpl^Ei;fQmwT=xQAH4 z99S44F3X0Qvl!L~%(+fAoxR_e`}&i5F0-^TJ{UT|H5^CyLa2`75UZlU!p979ft%YT{H)rTkM9W6uJ3CUsWrs|FBa__DajtCWD4w=YA23~ znB%VOnT!mEYF~x;-@9VdM1^D=k-jH(ORTQ@l0S|}qbB18j)?Rw%u;q_dc%(pyBMz@ z{Q@816?1a?Htwvb<-X(WpFdUYe)D8yRTB9&|J^65Q{oleq>8ANFXe;MiR1geN$qJa zIOsY+K4I1h$kg3bWS6O>qlkQNR}vDhKkX6986G5U((8-J6P*8(YACD>qvh&kEV`Ls z@Pek1gMa+HH?fDfl3Ckd$jZrxI*F>F}70 zJN!F6N?=t5nE9Sf{yj}T#4c@|Y}PlT?NTEwZ6g&2rFeribG-erg%yKkVNXSNI^-b> zlk~Nzu29!w3cG5p>)gP6?MEOitVb2e=$}K8sbhb$&_NUBC7A4sRc&TR-z4vK0!fQg zvh}28D7L`w$*mik5w25*X5YoDdbqDMam)qBI63i=KWZCLsY!e(d((-1sAm`08SWtie;(;fpmqD zhCgo^D_hCy*?&WL?hv|G$%6K8C(}K?i)%2jBjm_zj<*oPk-4%5dUGs_p1t@`S5=!Z z(1h2xDETXa^0ap{Mx1M9YD!58jr(5eMGwN%%fvx=@H)e3uuklrQnIBX(Nw;_nt4~= znFim{YwP0tw9nzJWz5E3BId^Ux|!PWU<>#Vrio^+=s<#(kkF!%G-CK+Vr92D0sup} z6;56#HvVJ-v+M~*@atg6I=WQJsHq$u1U4xo zitOMH;$1dh5xi8kvByQwfmEu@Ka`45Q|!2M42c1->c~L7fAG#@Sp_JxbWloxeycXV zodN(0JhfUD-mS7ibbhz}b6u*bq=8b)*d6_m`A_hS;|w*Q!gAU?vPl=fQ)%8CxgtOe zN6VL3QHU*G4zD0VhQ^si<#SR^?2YKP2q$7C@@RN7ly}l5hNbk&J zhO92JGLkbyqId}uM`dbxBtFhA->WG}ackhCrgO(`!sA*{D;V<1>2uiU-y?pyLi*x! zNgo{E^i%!US!s3j08Kztf>9E2Ib;5!{s6aZB2)GlicRbDuXAlaN3jF7%UfB*Sb->9 zO0o6vxGX$Rj><1epp^W8%a)1Rk=LTybbOHFM#RqqmCv|487iqUnI0V)6`(`P3)-s} zr;UYTX~r?DU|rb2C5v;dQ0uAj_tfkPI*$#7CmPE7daf};Ra}vfJ@D5g{X4tVfn`2A zhiLYi_2pEC#Mp>{Bg*vkHwDCFD?q@fF}hWGD)xW*7wF4kJ>Fa!Ntw?IR`dV?y^+yh zgI?Tt?Ch*VC*(t_7-}BZ7`xchDQ@>+A-d7>+NhryC+0cwvj1AA-OpC| zg_D`|!gzt&wO2JqdgwH+z0TvKgJaNGL;|LRX0RbZX2^pcGli$LMJ@xag{D!_XxD8> z+JU}B&g+fk zBB|dAVXtjUYn@(?)BA=ai99IAoU0Co^-y)6&@hMgYTQ9ECVln)<_SIx0LA_b+{q3` z6DA>`=^RlrBN*`oIqXU&nVO9)hLK`>89rlz!x+*m`6q7Uc6>BR2*=S7fYlMla=Wzi z!^o{^iOym6uw@=;>64hxMtQIJr35EopZl^f%f47C6z(0(i@F)A9J4bglYj~&=2pwj zY?0H@%N&#m$C77MJCQ6ox%dlz<4n-=kuPCul%&DR7YO0>nyjRq zR*qOP`*r;OeH+&~ZiBr>c6yl2FhGc1B9ObP-X}+m5#kq>Qq=Lra=6YUOVrSTX*(W* z*wNI7v}&w^g39}Oa}#}irb~NDa3*wD&igO?C)X^RVCG(=w7_Ir<$(H?zfvKinx}an z%qXW1BS0PJRT?XLko!sQcVUm9@V!(O><1H&KeTs1EZ`@BxsCiQcdBTHFACfCs)?YM zReFebh!7FaLvWxns~yBwGgIK?ddfY(gXF>f-kSX+BtrNP(96-WB7Duv@*IL zl>{LfADvgo9)?dU+$ixtCYVC2esjiTqVmelT%u$MWJ_!@8ycQBT0}fyJk=(Bm@D}i zCmFqQ!Be#>XaB2WEJKHmXShJ=fIm4MsWXs5AhrXT#|6E%BE0OL0e&sTi8PnT2Z^9( z>pQdF&3p3=%3y?4FiuFR=^eXi2q{bU2bk7G(?cs+rNEaukmnQid7NnG&CwhuRhVpc zJ`A4OYk*3{;%7E;Msw%zjDiuoB-80uFjT801=MeFCnsad&&zkS#p%C*idPGD!)tXD zKLVXYcyQ*i$74@n~K^+?8wM<8LAn<$6 zGskZXA|36V{o*=XT(MU7QS6tf99p1eO{W7r?~RsL;@bxwhNgvc-?dj9U-MpLW3|VS zHr{!-VwAuteajQ?n6T%msx-5av~`@I$L9Y$I-DQ&&+R&>m|@lHW);?okT|TxF_9CI zY>V3zSs_V9k;*fEjB^5!{go=E6!P_3HCNUYulj{EQG2(oOz}o&5FipClC5Uw>WRrE zL<)nn=4yGfHT2W-+$QM67b`7c!we(q1+J-hn_Xj4Ew9d=kg-GAtFZ3{aPduM-R2`9 zv>*)7{&Cba1AOkaMii$(QP6GiA{M5%?9_r9-q65xLl4&g!)=T3U(UHh|yGb zPnCdd@CiUsH&%?f$C0=&7L_xntt~g$QjyQquG5~vH=-QOz!phyejmDG&lQLQp?8%N zJ!(*Vt=f)e$uMrf-N6xVBJ4-lCjT&=(%}-HuUo1n?+LsZqE3YrnxU(XGP-sF0Cm(@ zQS@iK5^G(W&SbhF-eiRb6FA_KF~n*r4X?cCgTwNDJ_&)MT;DFHD&Zkpq>uzA#;k&4 zoCGj$w)z+;tY1wJdQ8T+Mb)ww#TNhIB$p0AVCBu_HVJi}Nr9aLFr4Y%{`#r`1wdE3)>A;ldC>zps-3HdMS){y|QpH1e z#Ms(TyY{?}T4&Hl&J>G=v-m=>QXCzpX@=lLx|$nZ&7rVQG^hA9ck#m$hY5=YjaZG^ zfj;{f?C4Fei-<_oVDQjfa;;N)UMYOv5SR``GbZLS z8XwmuVsgaD`Y8FyzCPs-Nl@L9imdBX=J2X;TO|Gx+3=@nB|#dgiRdo2bRi=j5794* z!6l%Vdap5H>BsS#9S%5sR1qIo+>|6USQu!VHqs6`EK*E{8#E*-MpLG$>O*1vSp^uP z*RZAGItZUWcf7CKpM{G48%vM@DbRnCd@dF(WB-L8=R7FN(<{uPbe(}S0ti8)kQ!b4 z1}(7mK`LoKxPFhZ!meP40N}$g0H6N0ff-V7PELH5&Pe09X$(Y9R6`of2d^vih4E;z zNCaWt)MBQ^<;?8uoQe zEYOe99W_Kh#a>GltCaOvDUE=GwT*oAWD;;kdDA9p2M*h}8m}GHorHB{eksTkQ+f}e zu~e0;3FttPh?F;SODm^0Z`$QX`y6m& zB>KBCZfQtuN4R<;Rr48?(FPFi?FivT1be_(jLOF#p}8<8OBp81YyN4h2{Nd;vL&HC z`1b;%oX{|Dq~mQID6D9!9V@2<6hmfF4349qhJz`&M4&m17m*$>i&K>vcz<8VAsXM( z1NhQgtjrB%bGq!H(JHOo^9%MXF=H_(l3FZn`dH6nj@}Zv6sVjm@C3WL2J*x!tCb%>Z$W_EDQ9*{R zU4UDtuJj(Zv~>N1guO0XHe9Y{S|uBAEc7}SX@?;@$Rt8|*28(+oIV)k;OwhNi6Z@4 zhvb;oc5q4!h;q~3YH90$n-Un|*lPOrYCa^YnL7%$PslIz9g5&j1v~KtJX}zMq3~Un znuYM6oj#*3e#oST7f$Z?(f;{GEnM0GuboyO4q?;1+3yr_D1l-Ur}LlIpKg!6?C^W^ zCsS(Z2 z+q<)09g{ql5p-o_Mw~1DPku2F_v^A*>D=;+j3Hzetwe+B7*3--t2)fcYOZ|?FjQn7 zw!Wo*x^A{SmJmv%;8xDYXsT2~)p z*>AHU?=PxZlei#Fle#M5vJt4(sOX8D<PADXyEGt-bkmmw8vrZ#?R#ADx3jC8< zMi+ANDnzpbbPogm-oz^qq~xmg-H>Eb)akLE$D>qlhkVG6P#wc)Tu5wMMd5l=Hl*C8 z-6M}w0;}YeDMN`2!pN9~5yv6CTS*jJ?a+q6ukkG1?2^VIUoqmCulAI@#B4jVmf3aj zL4jn%?OKHG2N~25mNV6Y|fuNL-|Xs(ZPH&a!-Me%ij8zI464fsa(@?CscG z{X`Xg8g+nbOJd%C9U3233=##cZ3*KTIw?t|Itt1;d-3TCD4#9UOp`2G-x`c~nq6@y;pWX6O(n+M zt@;TEEP2RYb?TTnI$^@E--A@^+8jM32V+N7du2k#1pCq1JZyaK_;RTW)AM)iOOpUH znuVEZv6)4j0>1KeVewlh(Qd@kWAnCabf26!uR7P;`kG&BZR(?}&jcDp)v2)*K=%V7 zk+opaPwx!Y)hsm;qGcYa?D?sHiHx01<-*q(`8Q!=f`JujPMx`VR;?}5IFCu*0z%Ny;Ql?KnG)t8TZnN-Gkz&l%zWkql+|pUF_R|I2^=M}{&pv;5CwC<_xK{r@i++Ge7xqtiqZ-PLub zKd`f-6V!#bzyBX6xD|IZvs-vqS&{{9|c9%%R)hdYNKEtM9)(gjrpi<9&7ulc(PRR8b; zZ@jFGX?zgw{^e-^*4*e$AG+D;qxikgRT&frkT#XypJN;h0zpY}HB})QNM4Gf61dpk zmA`C`Fj+^&n!gmlBc5V@7E>IUzReA2{o4zWzNL)`_(v&|>4+>X{Quygpgx^|JkkMh zfBet?8xN%!-}rdK1aJgXXUE*?@Xig0;sG!=vplkVl>^Fib^7unIo>z^>lk`P{vuXt zb#rxKbphgN2jDHDjFS50l0%m=O7k=13gR{J@A){BW%5#5^OO8Uf0cNO=)?%R&IY9A zhyQOw1^}Qbz8N^S(cIj6o-v$kzF*0~B}`+}`y9+Upe#SM5g8M9e$x}#4A~oB*;Aei z&~Mvi49-7m?!Ob8zdD^iD)9Iyruorq#DI_&rqYTjGi&I09H1q>A3`HDTX=ng-?p9U zl>PDFlI4*#b&n;7|8tJKBbI@|CbPz+5W3s_;Zc; z)4O}}D@k>3X;5Hp{jv7_MXM^=ibjVFfzIZc{khlm;U3c9c{(Op8HFB z^4qC_{B~RYZ`C*W2S;FN_E3QU3=K{+);EK1CJ_%lFO7L@XbDNr*80KS?YFUV^B*P3 ziqExQHvY%CCr4&_`WINC5hz`A^Q#baw1+T1d)>EsU$NCksh^0xf}*xu_{Ar^o@ot6@J3E z1~p16ix2Nl%S6P)1iks#RiU(!P9n3MUhO_4-oJ4;R9o%v_Fo`lYtz_Ei#g zcdv}mvl>j#D*Mpe=0Tgw*^M*4h#UL7zb@}m21NH1?mced`Lw{+_j_2#1!K%eE-=f! z6#d$(8NV00cwoHBzMb=4YAF8=CB*#_H3NBj88Mo-O|yp=b+`aHvc~-16Q>Kf1`(#H zb^rO=YVod2tTJHXpkUw@`+OHzuoKVWKG}P;y_ce_c!D-pRQ3(F^lpC6R=YO*c6>J- z)2{Xy(AD_j)zC%P$xq{_!Y^eTROTY0l!L8Wla*oM6+0=U4#pQvP zdy|l#Za}Nh^;EZ)Td4j$1@TR}T4lbt5D>l1z>~vV_P>ns-t6&cRRUPPUB*M~#<~S@ zu0rQ6Adro2RCa*_2vy|-yjWXkT-Gnvz}7e7hrM=^2Q~rScke;XZd)ZiWE9MiCVgL- z9au4Yg4ht7p-pcsksLE$f^OzoE9z9MHxDI{ zS^NQn1zdgs;IRy!7iGF)^ze3=$PC`Fkmq0^0JdvnuylWlWdJTJ69yith@H5V%i~A% z_5$zKC0SVB9k$nYbGqmp7gF5+-5Ba@P#C5V664fMv-Nj6wjwCuYExl3-x1l!q|<+; z{#_Oj%IoFB=vBHgho3(V4dKf$$iP#!^XzTw8J|wM(D~ThU0R|C{9#9_v&Q z5Hi^JMA|Oc$~x7xM}M=`IGN@pj(+iswjgaj;R7XQlaY)NastewB7t*ycU4(PqGLBD zGo`VwI%iTIIe9wR_ICjQqlFnjjYvH-oY4)kIUhv1VS&6gBs@-&plhTtF|@lj(JG;} zFh(s}qzuprljZeB%xap9HK)jhC6E>EEa8~N?1X<=#aZYJvo>P>b;3Y@tW_l|w|s#( zNr25fjLb__15OOA;vNnu!zKeaIQqw1e3Kt`R+|?$fniO!;g!ny?=&&4D5|~QmN}P) zr%`H~MOAoM&#%#8Yu&$BW7H3zi=ar3dZ?44_|L|$NnbSAqMi3{s~v{M1xh5Jk0o$1 zjTqQPlABUk>ALAc&uOQ@fhGCMyA`dXPD%M(fH#l= zHffrQ;S3ZmWVIm`M4*$nXnvH`dtmKtp>dES6?xWmQ;{yaR2`d#o()*_zpu)u zx-uyE4%~yh&x>l_L0VP|V}W@56%@>JK*>3w9g5hsr!^GbLC zz4q+URCKJHks84PK*IYp!*&nD90CXrDwj-bE3qx~>Jvv|gwp%? z+*7&m3s4*n&eCmB`>T!*TDK^hn>4a*2?XnvtvdNF(B;Qgn)4#P*j$;B1Qg~PUl~ld z6tfUEpy}%9+fs8cAEhr7L`mjMvN-AEALyCCTS*n`j8K1RVKKV%vp35i;#dw`sb$4j z>WihtD(BVR|CWw%Wl+Bu^v8_{cU+{!pNMog!qAK8ZJ5x|s@q+8#B}A)Nysm?CX8ae z_#!ZsJst8?Q^krAXHhIk(Uz$|IxQj)&=@|>N$ix${Qon?!|*7jej%w?1`Mq-tDAbI zOQX<+aB=Ua5E)09YK<<7>35s7E{V*96z_!7g*q<;-=^IHpQ1pEjpTepmtF+fESl54 zfE$9kas+SP!RCn@J$8k5N6hckb(iti5u3TQK03dHXa1a4LySsUU%HH(U_xG{hcbCF zTUs9ILQR_AV1!^&IgvWYVmr=pIs;C>bE|z6l28QFF*NIuA2c}<;37)-FgE)Pe!k2> zOSy@#6K>31TvD|0Njs@K=fU-1L6@`w`i*q>`)HYQ5=(Eh%!Y~Vs*=i{2QYABED!x) z5qIwNQq5&XTiHl=xXw(Zcd)p!h|$@4}tQNq3veEAoR zHJk`rTr~xe$^A7uJ!8c1E{a*VD!6knjCZr639_*am#Xt`VTD7NUT#N%Z;oVINKRPDr&&dm*BgLJDc_gBuNBduE>K8 z)}vyv+y~IZLFJ>Nz;dHH!kzG-_2{wY4-)0mUY0&I?mg)rI0t4C6~F+sQ$cdshU8MP z8Phmk_t<<%=9d2BE9lO$CC*r>kqvkDv&nyOlWH!mP&;}t z|4GoTOC@pia7OuENq(3q-v|0)%ag)gJAZ@lL+`Qe<0T)VVsV_dDF~oKzr#C?KRpWO z15@U*1KwUUwDSdvg`(D*^9{Qn(dABR)j*6d32mM2`{@k=+Jc}xR(t7sQjt~tgeI&v zZ$+TA)02T~F%!#!8{*DTB7qwLaBhm1z&G$+O*k# z6fre;20Rq? z3P}63-@1`!>!kVmY9SZa`}chkHBl_%y3rxW*hYadbNG~Of0lGcG;H*@Gd$DE!&TCt@uBrXRXbl|zd8(Ls_e(j*{ZI#H<8*-}xRAi;~=Oo}eJ_=&xIqn&Y&qooNJo_J_$61Ud zOU95Q%!4CrX!KtByPNI>aFita9%2YIJ$iV^5z#J2FuhCB72VGg)Iy}Y_+Sh4^EnAZ ziv@SGcaIicsitN|MqS z7@+tbdxtoBZ&)8SsTgT6SfypaN^7esaL}8&8I#>=^@D~K z(&!>0ieOmvu2g_Ig5isBzlrZ521S_Xhc@lpKH!Nz?u@*PMphpAT?0;h&=?^etiI<$ z<>=>pi7h~2Zmr075GRd+gw9YjtL>eL|0rV8W;GAG%WO4*|J$28G4<6Wy3!MSM7mUO zDpWP-K6_*$WW_t+YsIGQv5WYwKQ&EyXYq*hOrGF2$Hdn8l>1A!f&vJiGewM0$)g$F zX?b!HTl;4E2N@hT+Tnf(=9sQTPcqKV#+d22q_3vt0hI!D+V(8C(5&Y5H0<4&zfy7p zoe@jSY}eMO1W8nugJz;~icORbQL?M;pqpzWOGQQDqIvmj8nfi zeCMWCA~$FUu6maT}t2nv8j6r+e{Xz3tv zbU`V;ylH(Oiif>lrK7+pr7;CsSp}8>@io3W(%{s}3BskF^cJBIebZrfSN|&=ntm}B zCnmwdFO;z`xW9Hc3p|jlj#U)nt+Hza`W~UTukGLrx*A0u8!?P-z=?zbN^YjLr#jAlW2uuV18(3RGio8nh>W$Ee&apSa3-+6qv$ojAswzJnJ< zCaFi#QwOOE>>z|l!D4v&$VOy`7OblG7fm+*tk|5C3eg~~(*_O3jxn)jotv9>n!-~O z%t7#3E+r(btL`%1LRnr7K~9wIW#{8m>2J4KZs#!z7V0}k&JE-#0#`NVIRfy4j6>9S z&*O*^;@}8a=(sSGDqQ5mYNf40Xatd=tK%M6*M{DIU44JNKdh&76bHUuuEpcD{G%Km1OPvb<@c!-SAdR zNZPT(I>_th>j$vKOJ8qC@TVQwv1!>A%eUag70lo z8m*8zlx_e~heYB_qA>-J)gPLJBX){3+o+elVb>yV?KDj_D1^ z#~@_5ekiO$ZVBuaHD^w-t-g>+jEB;$G+^GJ?YN=G&_N|F%>6Dv^!{FwD_tg%qT(yn zM+6*Qo6@Rjk-%@?Jkp`=MbqDBK-0dqEv4bbwOk$O4Or_R1H zJ36blMRv0=#))5B&dW@EWz@^7q>sZhHpr z0}9Im14d=f1kxAbVzOI8%K{|T|sbtJr!SJ^>lmp;tB8^a<@OOw1nG|o`+8@ zb87e#H45Rx*BJ^`O;rgPA`y;dF3Sr}w`py9dVGAi;> z)0Zy9kFmkE#%H!Ad*dP~ickKMEa`a-bKaP(c1QHEY?u8y+bE^(?l#epx@w;_*E{;% zAz}Y*TAUN-#Qamg%>*s*Vw{pTDAsROXtix!v;hbEN9=miu~)l9VZV7E@mgQi-+;>_ z#3K#O<^DD+OL-kn-Q)j_%eNpfK;Nn;bIk%r#`|2Uk8g zuVQ2NEI2rcd1&0)%*j+0e)$an5gn;v#uoJ&uTd9Gr|rFf!IYwfg5a48t0}SzwkI@) zSYbQ%On-tXjRSFcIi^B8xs1kLGKL4w`^J!8VwCl)5vPJkdKMaLIiz=;2dS> ztwm|;jP6RF7kd|-hVhHGIodLBs7*n`U>#Y0WV&aT@s!UIwe1*c&j;zI69z~AoU z1^U+_JX>8ZJngHI{nT($@j0iZ&A#dr=3>?=i}=T(R?yy#xrRRmxE~R z@Ch=NieQGUOi;*7Z%!m6!4jq>D0h=NpSQG{HFE5aNzl4rt6D0{D_vgTJORNz7yhy0 z!|mT!Yf>)~ObJZ&8|-`z_jynnWf@{m4F*)~-_gld4Q#)BG|}_?OF^X_I@2WWHuuZg z!?{G`SObYb`?2|*f9T@!SSyemn2=e$4&EA*W$-xycQ+1KS%di8s|?r{6zbpxW!hKt z4eq=da6;5ndrb;i!l10?Zp#80u*=AXrTp8E+V@2lagWKND@Gu8opKw}1%NxONu1MG zR)?mDR4804#%M4inCFGBW${#^t+A1;4P_`?uHa?aeoS}tXN=g+YR+vnqMnMf7K%R5 zJ5UTg-Nq$t9NOp#+C`z}L*>M0deeE7ymS<%W-N!^Xn3$;+%#3$dh2=n9!|jnAIGFN z9qhh)s+qP$=JfgK6i1&^sVtjyS)f!IsT1{MWqdy3P(7t(F# z?`Io77mIqf+lY?qEpt3}#q)0Uy)B9yg6)gcsX3=|L!=LZb~trkiw*I*G0}81SYlZd zC!@yAXYT${Oan1txr8gqo5jl~ z7kklfN(W*tJK?bfw2uPgv6D?qybiyh^A4GN_Wk=Mrd$wBhE4L>U+$VAfe5+zcIRj2 z(pOkIg`1EhXZt{CMu;;JKFUi)Ekg@`{lz)^q}kklU0zK^tq5~J=_H5y^`i6B03V+Z za{WO_wUVrsJv+Z|s8JH;?^Ry4o`zaT-To7;9_n0FEIEy3C?s4QH`mvn7HyG$q)6MVp0?4k-m@*BQVQs z?9I9%hCB2WE$CfjFKxmCZ!((VTiDx5`Btiw z@GBd$>ml-3f<7bPg0BOh)r@VAzAQ+O>*Jvj*uH0S%OH2O9GCbPW5rX9g|0lzGUV<) z4-C+rf4x`>ADr_zUc6w0#!dvOU8bVT2D|0shJ72UAQA_^InvMQ2)ueGiM(utLU$^40z6CF)Twsq=3G)nLq# zFb}PeQDs=Irn>2;7AdGg57aRd?M0rb*ciHqRSzg8a{vclt1R{-lqxv>W2O0w1jG0= z8yFhs#1u7t7@XQLlQ|Kx*E#1F_mTq z3qK6yvbU0k-!OTcf^F?XV%@hF7`1NjzrarXtt(FTxt;jwohCyMCdHcblKKayy?KjL zUShzesGh(L2@OBk@Z*mg!hDx5+@21#k=7H2%L0Xqs1VrjfdR>FIr z+H^9$#`2QDc;Ve-p#_hmA@K$S?WN7AJ!m#3!Q!!InTsuf*dOCB*j21d) zp_giN(igXag#Nl^UAk`{5;?lcZzK^a@Yzcyb*LBh&gAN+ZA!17(Pzvkx3z|K?Aat0 zI@81>yj`nSlb{bFwXUrClNt*l1+shl(1X+$a}w3)I^NuPL5Ui&Z(x=VQX^k9lEowB&In;dR)SGlT z*3j8)7i$>E)a>>Y5@EW5quxZ|Dq+GZy+Pn#B`TlUF2qL1{+h%i6Go(pqDFRYGO-`&am!u+qZ_w}?@VCLR`ssg%dqc> zh;G=jT1+$CKajzGK-|`#3_G~3PQICvpl>ivFU#P@7_Om#J*?^~%mmlJ+-ns9!ZUP* zSly4N!~(Uc%kI9LSRIvNL|4shd-XK@)WYjlCeb zgNA4kE#4f-eK^$#57+EblABeL4%Bfl4>TvoEuWV!Xwx+l`kmf@3`MC$VnInVB&QyA zhY^?4n)a3P*fm1`UNFEjy#zLZWlikPt=`Jn&_J6(_by)U3|#b-|3%6NNPHKvX6Wgy zle!umj>>(VZAEGRX{jKM$0_h5SGdoN3%GNi5GR*cZ^9iXYNrC8q}4SW8$uqp!zg_4 zfVg3iDPB9F5YP>?uw5M#wSc~q31lcMYj6B6=3bGQQiR<(%?sK+w!r-GqP&q^Ww|&^ zc^QNlBPH0J`#ZVR{d7|^g##}I?a+AwZu596aHcr_Q^n$6huI`Mb~Lh=eR$h z0~XOvwS`&E5jXx3k>N9nAY^)%IpckE*6RYQ`WGUW30OvfgY# zP0QuE8xXms+1h&aw?UHY1h+TQstWP%N=KcN=p0f~d`cI*b|uv$a~r*O7>nNeh@>nu zL4lQ3)CLaYGTD{fobWi83f(NS`ZPY^u0)iI;LKK=(ZU4?N_@M4?--w`j{>M%aKS!$ z&bpJ(hpBvsp96VE%6h8i(~fZL_I|%N>oLKW*FLKSW!*u%aPnAm&^hvwT6XpUHB@Rt#EO2{$rtd_nsK zJ0!A@&#Pn`HZffar}KN3>VUBE)M(wRaWVF6P~k7gR7j!+_!qrC&YA9;p^@a+_Fqw9 zVfxxJQu;7b@MPE#of@Ff+*&8CCEUUvz6eGiskL_MLd{`PJKMfM4z6%piN^Dpjm9XE zMZD8cDPebhC*eFf$r^8}r3buJbT_|)4qcK__q7syGto)~ic++$@d1w@(3R~%6ZUH> zgk}<**un@yKj+hgfVZgCkl9@_Aa9sd-GiK~WS&u%)I`4kRi)Nj@19<6A=@d)qWN6M z6x6;F%7>(4X6@hHDxTKO7+?&po>WXIGY)aMRTcjiW$zf{NgSn({@b=~+qN;yY1_7K z+t&27ZQHhO+kR*7=5F>)HaB}eRO+OvQpxXpI(g0mJ@VS=7uj2hrtBA6SSQCgyo0IN zoKKES8tnRW-#Tax&$uMHRna^H9ICFF%vXG*rG2lzSAB~LWSgTNGmdnXy&QzB~E4V=R2K;TZ>g^5t5U=S!+q&l8SBQ=l*JD+bw zXQCj5<;(5~KvnGjR>=RlFJj#!_S6iB#2V~5MPg$k}M#|OA^kZ z=ahm(5XGiiRcxe-Y~4y{%uj`VrG&5UIkm*VuPg;Eq(Af(EbG$A<@D0d%U1-mj`8Fn zPKW0mRw3^69tuIQuNj9Y93x9y;}+2rg$X@W?QkW!b2aZ}GQO9`UR~6Tp3(Yw|CV{=C89iyZW zPQPU*jp?M9%m5)5LOd*GnBeA*1l(Zr&r;PkOsU*z0B?D0_~GO@ux6pB`b*KZuHqFK z1j1mxVO{Kp`k_B)5sl<0V7>jrs<*DScnhxH5l7L`;J1n4)b!B?ylKBIz&TqrZi1Sm zIw22Hs-l{xo&^rnw|QKb7phuuqHzI9W$(j_rpII;>;NIX^C6^Iw~A=u8&lKBnsu^h zS$f#S(o7;PG zTO5W65cW20{QCmN)-$+Fj8dCY7Db6rx~KtB3~5NHIPa>`0uQGfVV^lK$vuxl11gy7rqi_VV6TR#S4(ZW!zxQ$B`y6XEQZt+Y+!$blSs7|sbg&_is|CE>AK z>4A^&5gC@M_;k!kn-a?!Hko_er(g@rNSLardcfw6IQ99f*EJ1=zJde(ge;nR9Kz?= z4YiaqKPBd{8;`^O$J)aJW(QYwUUz?G-aF^Lo;`dtbH~jwxIG7+AC~NsuFN1EEN=-U z%j=gOh>KdRlGl2rVp%fv2B9>HOvk{F`U+D;k?4rHXTNx9cq3JY!ZO*ZHcolkj(18G z(&^{Qs@lz1zDOpMNtoa^&*iQ`U*$(c$xGH9`2-hRfSjSUYv_f7taRoarObQyYAm|g zNOs+-HJ-VWR*7uZjPT_OX&LlMLf9KbYgfMp;ka)HkK{ol@xwVryF#o$>Y)sPN=*@DfxCI*NbvoJ_~*k`z z>H2pOJaS`NomNN~8nFn!qTq`({dpr2)}W2lA*$^(Y`HdgjWbc6 z;(Vz3+h^R-hCoyTdbgxsf8kV?$I)#<=#6c{srs18j{9pjebbLK6X^+aAg5{jRS&}l zFMN%t!tp$1L+5xKVM`DUbO}7WesGRH=la$wNib6CDh2{I*034Cw#(0tUk#Oq^fpK{ zsxobUP~S|m8?9yDIFu3@Fl{N@>ta}N&?zaBk-Ymdy<+^-hq=FLasvQ;dS&cvJtHS~ zjeKn^j93NVY7~9b1DX-f{7>>_h4rVr;|mYh*U!63Zqo7P1l2egm|jrmAz9JIt?L|Z3h{tjiX?A^8NxcY0fL$-W*ozil=MRxU4 zb$;byK(uO9Nb*O8p1;RCuPzdHhwtqjHpkz5p~>0<4M_l%=0mH%VWl#uio8(;wo>+r zG~et_>oHRFH^g1iw{p3$kgXb1FwL=OJ&BDw1f&57>SKImN69LxYzqCYxTTvaWjZXqS z)A_hlu9e)pv}UAYJ=xD>lX-|wp`J-T`PeJC>WbqCoqv*(4+D-pw-rdZo%e4iI1UJc z^i&n)`>?~qh1wDR8mxsW$A_o#S|!r7;%9w2eR)y$PJrSJRC3Q%nf`lZ9_>7>vGx)y zzXq%H(`&~UuUk*W1$rpgz~i2TPOI3-Jd)+koZdnmnYODtu1f6a$O#l74G8aFR78&6 zq30YX9ZxKTz6ydFCqi%uN2L3{&Y2rDeZLlR(|!vX_S;=^Dzy57D)hqsN4k3QRL9l%GplNk??uLfO{ zom_@+I3HcD+*=gLjOQ!=Mnbt#FgKsvu`{DM2SSh3$4R&#=ZUVu1%g;ezLe;4ME=c1 zfK4HHnp!Me7k*_+IV{YT+tEi%i;$;Sl=H-s`S&5&m|@`X;S*muk1(;rN^zXWTsnFJDWMmTz} zZ9F2OTa$-OXXR`S6rtz_K_L>V8Y1t#KZwwwqd{j}Tx`Kj1@=*2zElX8*bj?goVf5_g3DnMIx}60hgGm5EwkF^6Z}r)+6pqV(W#)W|?p*%}U9%gr;x zJL`_jh5g^_QVT(@+-4ZT0^K-;G6mMvV-kLUAiSkYbXU#I-VIY>=C&Hea@+S-US;uM zsD5)*iAsQ}+7N%(MwFaIwla&X*^4C01TwS|@Ru+8G$MAUbNdKHLrvEE%rmO$&>741 zV5_|Sg=tHDTr&^F;`^Ol#4%|ljg8h+GI?omVbHzRj$po(s}IXDBQTSde;P$S(W@Er zbG5-dldr}Qf(@>ogT5dGhul*TX&@!$r*k!CQ%KFZ9MPtr;STS)^ajQk+n%`^HAH5A zwx=Pbiyz-0aT!vdxwNb`(TXg;SF`${CF3%b(y7W-Xc3rtLNo1r3c;&Zh65^upmmp( zeI6l>dE_t{NcHvB(*Mhrt3+jlw);BUwZ!w&4okps;1}qQLq@qCjeO)CGWei)*jc7= zwmoV}Scrh8y<+~!EX^R@FU_=xnA>}?a8KgSH8S1`kAkQnpKV#BE3*@EFGRtRX|l|1 z4~H5gJ>ml8Q0f?QTE3u36AtWdVTm+oX@+JdiR;BDRJK5B z-+w3l(O2CFCDr~*Z;;W}r$=zFLI>ivBkm>;q z+_I>iqqU17Ezme`scNejHvUs=TSUX25u8YdR{x7gR%m{G*;3cOCEfC7oF~s<1nwg3 z4b@gde>{zefF)HjNvO7Yxe3~I0IWmkGyS}))@CT8GYR>H0|6&Vr0VH|*M6xlbl-~ zN_CQnd*ex(ITOzV77)*>cr~jo;-&wkv<-ezQGTtymZ%)5C(@1aP5E7@&2`JQd9IZ= z2+GTX@KRKPG>syB`9e_eMGVyu7kICLX~+H+e`e3|f&f`sOH|BTzGe7xzHevpRuO%G zB0D$oDAct{^oKt#n)yg=$G1Hwlc)jqk`wredAMsk?65zE*pHci$f+`_4l7E#B@MC0 zIHZO%f9n20Kw@YpWP-0PVn45!oT=akN3M{^UTbVz!C8144; zlk_hQbb$l5WI|rduA(Z>VpUySJ?xl_lbd>LE4-aV{jF$2?17p&m<-hzn`7b&dL0LB zpn6GYyiT1_%iwys4>x*6(TGXYOix|tJ$*D}gH*RiJnjOi>MpSM9ht&#{}M7bi*v{7 zJqCg}cp}An=Oa5R3x(@Ia}e4hQlDkV|Z4xA-XB75c5 zJk_bku;7(NoWX}uSOj|#A`Hm>{VTnerH*WfgEn)Q;ob0c*bEm@MOnC?3qYXkneO!TTd$JQoo-MZa} zSnUzf?q6Ync|3oJ?NfPTDZM&N+v8dn1#8LS<`|vX=(iT#BHH{5+U}DNLBOV>?*=D? zGuE%rdEgJnwWJD<%nbgsqQBX&puawVU9ummcP}h0wj#XIfAf>90YokFu(-I}&*SsWNAV6(YkKP7D4I^JK0UGQ)GlU8>9>y3{0(s@tt0c<&~p1a%o zh|=U?F-Clk6a^ieR{5c#TQgav9m8$3@liwCjeuj*7-ICBHHQwWrD+>Xo=T4t&!{cQ z-iW9C3%-q_GzU+f6w4F+NA(&-U}N;X9bzob$uCNI41@8#n4dL^kiaOxBCi+qFV7c= zXx;h(u_& zrszHZ^_JYyrRQrJ8z}iwz)(5ID=AGQ^zF{efcH6C%Ay0v2>+$(DdikJoxs^NbY}~skTzQeYNG}x7a`ODZcrDGcfBYI#Ft?eG}HOC;l<$kh$SE3ClF~ ztdl&`b5ZJ2IVqfXXZmH;)D#n?~XI|Z!a^~RFgyb*@SvyY@&RWp%FEf|nG<*mkjV)sm|k}VmQeNM2O%ksok z$2V=?#G{L6f<)pAqJ*+19C#7;h2KX|YoVXanDOMU3x`Z+*BV>|Rr?3Sud3{^43RZ1 zE6f#W&W?r}JM|V2pW8}12R97~gaI8%+9A6S4agUx9zY_j?6yq6>Gs;=XlW9CDeYHpk_(A+<4q2}eO0hfd1>CMs|(!d_~uIP87NIs zL`S&C2SIm{S?jqop)NeXdv(>0WwKI0eQbv#os9;Bc(e-1F6FBXYMpa*)dV@gCuhUl zapi7jwpVqZGL^^Sn>WpQ{zvA#d^_S~kGE@QW@Eo20EO`tyh$d!ZNxbm_`KUGuBGn) z{Pv5=3WX0_pU=Kh19P^NKu4b}*=jW?C2^MBFP9qdO^$J#y-)oDp%O~neZMD#cw_}N z%HEaD&WOv*L7$?1sTj3GB^#sycZPJaN{--c%&w#|-WpR+&PM=2!UggN>Puy$j-^dR z={Lks_I@kQ#03a*Br`Am+va-6=%O2l%nD<4*q3;-7l!TEOpQU#`?yG8UAnWJXvz8< zWmm%Pm6YYHxl1oc`nLOD>sF58C;1w zJNRS9rHQfihKS(^ghh zWHhAbBVy@lG0C$Qx?r>EC+50s(!G_^!-!*&9wZrA( zsp%9TCp5GB6*`(+b(VkHz8nP{SM>=siEs7O8utc11D}z7KBevJk;uC3yE*df^F1_M zSI^nKP#4XFkMdUTr62Q`x5?jT?cBR1Hcg`WBP{Lbq`Tg!%#|9D!8u$pBaKiQ0`YjR z!y-4_j?QEDluZI$sN+qmBiFakv~#aYL9>YuK}ex)H^Qptb_aW-iI>*(4ej4RX+D2{ z(hvZPL1ig8SUY@6g5h{mW_y@%ub<1QQgF-#3_n6 z_2hzfUZkJoMQdwQh2p_JY}Z)F=H6SGR{u5rKE6XG#s}l;8LUHOaiac23UmaGgr=Cn zAtY;V;hX&s`-`iE5A{afby;*f!mu9L zSn~8ky=_$(kn_6DN=|x!Yn4Wc=;wUlo03i!V)21Wjqsp`hq+KT+w$4&pFlG^EI8|0 zB3-mE^Wjh|UghSSGavJ{5q6+l)w^Y0uF!#%8|bx(Bp(x&b5juJ4V3nK|91kcjaz89 z?U^kG;^*b@ACROk3by}AQOwHm-xS5aJ?u>g8RQKum7Q&%8RQ6=82<&!id#53IsYq} znEzjqF(E4>3)lanBqsci*VfJ^j)V;2)&|Zdq9#Um#wO7G{LoI$jwS{+(C+J3+E#WO z;>+LHdQ1dvis?>0KtsS%+IC6BYu1T2^Wc3jYo^vV#$ySGw(EL7{4?>%lzQoZi@tyv z(5b43#HM+j=x4ahLd&0-pvW5IG|a8$B&E|4S7-Z=2SbszE!is}`|9>YCllZp>W>bf zc zhuOC=qk;U%U*~1e$sI@Y8H21@wbBFcW9djL$s6-4YgNsfvumf*K00f&@ic{2OF^_0 zR}b&;H6sEkUrhEIP5m^X%y4fOG&ym&s@Z|J?)Ys&V5&Dyf};`+EE%+ijm*LJQVz_y zp=*qKF}a0?BTE5OJP-+>g~2ZgUHZ)Y<@15`i6(xC@Q1x~(I~wKYxlq_Yf(_dtD{V^ zsC_iCKq`VhqWblab&s$|A(i3y*u#jpE7(Xb4^?P$)Ul=o4kw(MPsHq{)`(2(GvY`| z3z!4sn&5Q+@%h(fp@1>Y@tu4{Xa6w@87mlkH?}Web?76h?Bc(aTD&QaLYIl7)SA(| z^`pi5_t3*?#z17IYQ}ppqXm-VS_y?@+?axL2`q&Llq&7TVpKZDVhhT}kTm%SN52O- z`RmT!Ft0S<0@IG;$O#IQdRxOeXOB~;Id++@R!zbqr+O;}iBv1FM!mb! zZU1SI2B~alyHEWJjoiM`uFi+td=d2isETI@`TW>l5*`J)ON$z_(7}39yKCvW+Ur3Q z)VBwr;zX$seRydPWIT;gnLf@H1a61cRBHfTRFH(?b%@ zz&wJ4%jM%5e)8xE`bd%z+=$|3)FevY_@bCeWU?sC4SEUF*_qhKy29Kh{>23$5IXm~R4O2{kKZzJR$FWM|Z zI3G^vSV?Q?Hq(ji(x!~%0jy@#uTPI8{sx%2>WycCWQv__3c$DFa5N}fJrjMi`9PVm`lpl+F4JASYk*1HS&1rqKt4~ReKuI#p z1ZF@@zr$_3l0jov3rg-u{|;?n0~k!N4*0#SQ4IwoD|#37xK8db2!%M{FZCA*g(r-A zV4W5>5|=)lOFRKqz(v2B6;WWJv>OP@z6n+g9>b5WKm5QlLx{UDRIrr?P#`>%vH=H) z$G8@-o6`U4ETy$;Xf2T@SMcfZ?~t$b(jZ5HPA7lZ3&~+Xh*&G`x(38i3$;#ap)8&i zFlUU`O@ax>v5_L}1f}9dG)RO2c!KfQ0H7$oYE&0P!AzdUz>1VE5S7~12T-6w*jj|a z1?vaING7N9Nfk(Sl6$SV;A$thC{T_MA=Ev1;{aKD(}olZ>;9;C&kZ8VyKAp#W6waN_L%4bEjPUn6wwSr`$SHq9L%Gb~X%`9f>13H3!HPeie9 z5LCz=ZK-QPOyn~Fc;U!Q3mk4xUMl-|$nRgoc)$)2V=2><9#`a(6l#1zxJoyN52*E=M23tAu~V)3y_|)7+EAhD={9hX zZ~ejZ_$55bA@D<-j?LK(Y*?^Ed7Rd;)}dv$ES=I3^b{Yk)%9V|q=x|;HVO3WW7WW8 z4t$2yEL6{hVpACSij874Pw^}j#hEgX0b_*0YEpaj1R_khyIi1Zs6)qqe+2a9kR)1b zW`zcug6uVrS&NQ7ZG^4nZBhH9jz2>VpPoO0*fh__1Ti6LLB-+fB#DfB581}{njuru z;PYMy#vsK_b3OD7yUgmad9NeO$F1SUR$OzPU3=wLhr~HX9s6e3r;HHW76bidiJ16a zlLhtQ+VF?-JRH@%!w3t>!v+(YaXIcSGom7TxHJ;yx9vlwl<1*L&>zTyC}QI%-c1{^ z0M3KYe9G%xu_S+Lp%k@KbJTzYH%K9DKLOHw>rg}Xns(4Zof~k)!@HLfU>LLRrzKlB zFwpHjC7VUQiDmk}_*$8cx{2Oao<@Npi7f_eH#sK5y{BuuxZYkI2onbgI|DGAR+xG= z7~359e`Z`KBRhZgnRwOTE5(T5J?0))XA;vct~@|Bd*)YeWWNRDz?1uVOY!F*1b!l zQur&RVs9nb)}(@boFN?Ub6$u&CaY?4|dpgU-XQWj`($*{sdvLbxL|P#K`MO zFUp~8;eECZ%B4+#IdaKy-gLurXkTo&m#vpLDrMzMB6haDUCLXrbZxsc*+&`_USDe( z5nr)wZ@`dEZ^URMU$p0R@8DOLL{>nQs4VV;3_YJ_>2V}&!0)#|@enjqx9**WRejHu zb=7?9jC39oDt?^>2l!aSlf$aoz&h`KN0}te@MmQoWJw_8c6)ry*x}E_VLU7uvTMlu=CyxeJe?g` z_v4r)Eu`2_p&)Fel>6Y3=!Ntx%II`*A5*8SC&iIt?5r#-G&uI(tzX2gB&|KZ_I*05 zK0F?^^Z!8IuO`{8Z{)r!6c&aA{1Cc(8JP*Jl1wH8ZC>nsap2 zo;iQHC~i8uEqW`^wWBZG@^+w&!)O@7^_!WYxEIZ(HARf7Gzp-)h)YY#s1(4PAwRkA z@)r1NO1;5IlkuRIPkRETJj~$zxZ1DGohbWk`6M)RRIO3H*PcG|=B_#Vy#FlKtu8Kc zYKw=_ZjHy#exy;5t^jgWWT2AumBXO8H*{@FBsdzG@NCKj-Wiz~YUk(5WQ#dYnAiSA z^>|LFeC)$(12M zr|a|p`<6B0lQeDz+BCZTTwMCgFY?HlMXd0OZaeAIHE?_N8&pp_L*+A51CN)B*Ztjx zrvfAD!7S?2Id5XIMV6Md&hG6(q#h}`HAj84qkW=WfGNc;BYj&@XSU_8{~#41_oY?8 z-eDEx{q!@Kef#~0O4~t`H-4Jq)S3WihbqkrUJPR0C0!4PppE$ElkML3bD(d6Vy1f3 zt2dtVrXF79&_-K+o9SwF;{s0vT2EiHx^*Kje@{M$Hd|t^EjiXWmad zm|fM2C$vMO2*Hpc_VTM+90z@VPbyS(WDDd=_uaKDoWJ7{JLK}9@&h|T zG(IZ1L^q>JC0)A~HQ@3+W0Okq`Eon-vm-ptvyjRAn`ovdl~s~jCmqMmc|}LdVc2&& z#%DMW-G72``rq9~-Q;&=;zu99KCq4Kjh?Hh0A`dI@7JNu9fb)o1J9BLCVA6KErTmg z+c*@B2ED>CG3lBGjZQYEQf734d#qVd7)0pYG`4z>`9wX!8h8xOu!@jXdjqkL-0*>U zUqpXy9N5pBb=I$0d}joj8<*21jF3g>mlw)r$shY6?t`5}*f#X%Lcho%Z#h(Ll6U3$ z;LRR5JZu_~!Le@)qZy~0d4H~>DvzxuL5{Y6nsmbRLtz6|7SwQpM?Es+d-2+>Dckaa& zl4gYdCewGVKUmXtu3=uuy&e*y@PVh8xB;B#uDDBbr@@KSQ8N7PyGavBk50~jLHcBv zgg}@%9>T;J|7k`s3ZjZ)U0MxXNE3{p>WE7fX*1*?86Z4k@iac}M_Kv{0^o)TDjrdI zc;0ijK?@Lm(h_A8`U*5q8C1)NQik|bM)8#4KdHzmv(EHpPf<)f_ZkP}zh!dDilQO_ ztoo!9u;)RAnnDi%Am^O;cgS|M$aawUWN9U(I%oPM>ZtJsh6~alqg@ktJd!k*4BUzi zLklIBy->jt^`I4ZTnxR#pySOnEEPmJG&UtNLd(Gd$Wif7e2 zfKWKgTc84C(u#y2?D5b)$0E*54b%`ixTuuiI<&eeF6@%`WG&E2JrX7;iT8AGFj&7e zNFX)b;xhT}$|JE``c+LpDN4tL70yc=6*(v~8O6$@H0la%6#`Y^Ja0s$?_F{v1L4fe zNvSmyT%6!7||~ zTmofkO__`kGrlboDuhLo7|=R{GR;vd7=%#{#}gk{Bp<*Kt?jve0)uD81$zwC}A zj1@JvtR%OWo_~Q=6QtI1-8fGI4NW3ABrwWcs*|LsHrQ)W+7fe!VHmNl)mA+Pk2KTQ_<%zX?ikB58~LiMeo+ zlyEZSp{}}{lLJ*%tZTFgYIOLOgjho|fF!rfYEHoBP&Zl_fkSguF2OlQo~u@OYSV}( zR$j=C2B@x)!7QqH$NcrZ?G>KB~U8A-Y!6qq7bpOfsg#jNDrnPki()hAxj z{O{JBlpHImHg4rvua|QQH8tF{&ip6l?M{xl>TJxq@QQN7C#jH2MuKr{Otf;`k=<-q zI!^g_420sC?+%>%M11!zd$vTZ-+Yyu6B@Cx4km1{y54N%73w)9*wX{!yR#`vK*`D_ zSj}OMqHF`qP#1+K3Dx6o?kRickrfqyB}A4%f&=N+@x@sqG&-#KQS!z%0sjXY4} zG!vHoLIaviueBXiA}7#g;|fo`F2&@vomo|(w@lTBOBE)e9%kuILFHdEE!JK8wd8VG^yuA zsw9eRv`J6VMRuYHGK8+x!ak&+R_+ShqiTixAQw_Fz;Mb)ql~w-gHi3 z`WI~i+l@-aa4(Bt>v9_|M;po+1i1OOW!{P``KZF#oUA-lbu+4dijAJ@KkJ)Z0~BzA z@#<6anl7=_37{%&M&A3^HyM{dP%0Gjsgkwrm_(oWu+=zPy1FSo66 z8g8~Xvwt?$NFHt-dpb5p-i|J0F2~m1{4{@erKgdLJ29@dgXZ+j2>HVvgv)?IE`Lm( zIwb$q|EMH$Rv`tg0sFZA&Vc>@sEpwSxd9HKg4lozka&3iXn-UL;xRxNLQota{C`)i zAc+6*tk(&!2?R+3*aY0-0^9)Zp#C_3OpttdKpa2;M9>Ma2(*g?umqUH19$+ez=Cjq zX&`+Fe{n!9P%jtY60i#iUpx>V?aKLKMA1fYQOVp9Y+H#2+4mr*kL=k z&Z?i&vVS#`aT)!ci>Zf!-LhZ(<53x+DI|92QpK5q9RO(h=TDs*Wk7K(VYoQ>`MdI) zur+*%)2nX1M5VHMb|%7sB9x?VcF_L6H-a(;6JgL01n~qw>}p5?r~?Xj0?Y%2lK|!c zqyO0we^vl91R)*(3n(6(a1to^KUxy}e^>SpgwX)||DTQU|KBxY7SN09e*@@+^tS_i z{#SMU3$vYE`+yg511SAvw;F7PlBaAr-~_JqqKEOkr|N6E!*0b}qU#_1!sFx$`=<1! zxtZstU1tIBX>-}}1h2)awa|BC{i<`rb*lMk{RhNykofd}8fduwySeKB$0~%2lj*+( z8desj|MXP-Uu;5Rv~1#VTN1vj_2vi~fToW>U=TrPvy4Cz$u7@vaRa?EZ<_zMO4 zE9zUj_v3J{f+zvc)3(42jAN*z>XIp8B{hLK2t}3AV>3>Jzyq&}#&Uj>Hxc+Nbb%Pg zoK#oWcsy@gKcM_p@^CKZK`ku=HaZTNOA9Ss%x`dXpEtQgy)_0ms_#cBjv;jlg32}i z7Y_7@3SMzR=};>-f^kFzhYpfl!n+#1SExEv8%$;JN6MV8HK&4^r!}56cXQVz6E|tp}+Z&ejA4Il_14AdYKq-#UXX?ouBA!_YiH*1FE@H;HW@7a(E^a#H>>@}kyhHot#p?^)-Z&;-!2ncF@3~3wQ zLqi%~tFM?)`p%_UpmHdUb;7&|?**T3`lZQ&0Vpt2@%z{2i0 zL;>$3GY2;%`&y52J>MyCzZvr&pbcCIME}}j5pxdOo=xt6Ky!xiba|;Mwcs$ zt>l`|;;Sg?pQzU|lWe$+FCwhFq}fk2-CDcB6IARD3!TGr-Irks6=p(L^El!T99~EA zwl8mf4z3%yvTeta=Vu4?BLISOSY&w57K>Z0iA%TEsP9Cl<4bLmodoqKVtD7PldT+N8u#?;;Qb@8CjMnWM-nt%-f zN6FpSaa*(w3G2vs{N&O{X^AWF@tdd@t-2-Y-(;=1tClUd8ibF7yR<3W4~6&O)?$Am zPKw%k=g2xMX^@-pohC3kR_?5yB?BJ(>+6@Wy2%8WngB>sx|$vDRy=|}I|bcHshkNr zfz&1$Hq@CrJwhF}j?p<_Hh4s4SnDlW@krcW+mG-ZR4t^vN$uw=cWeZ)g(Lh$m{9Sy zxMp_YwL7Voj<3BXaF$@&Ayk_-pO2A~F9$Db7!;+`Q7iXjIQhI5Jzaj@P9JW(Z%Ur2 z;A%WI=Pp~HsPgHDhwHePtc9k`@_B80=>U+D_7vFw03cD0k({+L;)v}!%xYgIFS3PPZ zj^6S&3&$&Xs}^pu3(`3oVqCUy6wm{C(({l0$7s62CNPDx2@B;wzbs|>lOYotZN>f$ zLwYxSeZEzmC!#9D8nbtQ-GaPtfK`zGGk#l%oEN0XF$~|{=aubaODrFn^!m7}_48P_ z$(7sqkSEKLw5Y2y1&$8ek4Mc{_H&ueZ?(kmwy7v&A$Z^T=#UR#wM7kz!fA73FE}rUT&v{>763>hv=#1}K|M`BY**NH_rE+P=SYKZE zFm?Sk(bz0KUM7-#_xkMDZ9`SHauR~ktWyvv7uB4Db{@?Fvu*Re>c?ZyZ|+6cv=IHB zD1h7Cqda@stWd&=b7R|CL&0uqmS%0FAT}cQF%9jqyoS7)GRksIQ!;!SGOW2Usaf;S z{{51D$u@g#;Cn?)3pagzF{?i}0oHD#!fvmvNiH?(A2c5QIN-X;r{LZA#a)YYsxhnAO)9|rUf>e^tK1SE1TFq7dOXEB)?9RZ; zPuNtvXlmirnV4Yg`lnDT$dW~wk3miVTo=}2>4QB_>w?yRePS!?f!EO2vW$LU#pTlx zGj61Pj*j7XHC+=5htDPfK4t&9ufaGIJKsC{(y-@5uR+|%)j-QsHF?TWtNd51e+n)OD3-CA4I{79WZnkH=BqzOx!s)^j7 zg;RecS=RR*4qfSq8(V|v`Lx8>;~j-FlaAj3B*j%VT~UCo#w%Q3$rr)R3&KGxG8w}W z8qC3qcA~}2q^$agDgJX_2Z~PE+!h*{l8yw=z`668=3MC_7uLdyq}sJZnA6}=LRJ&6 zo$EowwY_`&c-CoVcoQB++)RhkkU(B{_gXf)y1lONWTutiweBP2Cd^ldxLQ*tHm9zR zES$?jnFmblcSqgwJ(;}I#FdMGL;u&xl#>+ax9q3xc&U;|bdO(&{nsiT8|J8#n)*ZM zn^FxU1C$(^{-O-ObL#HCt{(BShWL`+c+8}NqZv*{SKkVfQ+!%mjV8=(@<2q1FiY`B z`qd&(_aAJAZp=r-Koe-!_od!AxLIVqVc+E26eg)Bb zV2!FU?C3|<#i7~|STK5Uk?B)q0p%KD<893%qN$L&Ws{(~}&*HizWmSDv1 zl+2L2T^hEm{=gb`V6M&tb6O{8X}Fo#YSu(O0H$5~KCmDJgcZiH#yG7e)@$Y-kY1a? z5|}g^Has5YXfXm(gWgjrA#t$BM*L~7I*uC*?oM?ngi+fXZ?|qa>!nv~blQr*%34h% z3?d&dEe9kYu{tE208rGrB=L4It1QJSt0}5-kS-x2ioB(dJ!;wOxWPjh`90xnu<072 zoAm%gzg%rLrwIT04&Fk0W)UFf6_vLHR*OH_bUGXhJ12OB9S(YSVO65Q6lfVWBP~`> zlq~BFboHd5pdXpbyMy?jfjw1|D7>D=V4C@du4#$8by`2u5b@G##L9DZfb`8(+W<-Z zU@z9+m`MjkZN>IDtH^#^Do7G=t|7cs;mG}9qCccVczOE~`;tgstvnH&MN} zlrD>U7yc@)j*qc7lSEVUmxVppcO!}_p)m4lYzlmAp*npjjXsGYNC?e|JQRuDO8%;R z32)9+J{6L8ntcmj+4n(sScrX;30OYRpZDJK9^QcKmIh)d=E4%%a{(Vg6O6Ov?laud zlN1P9sYTTRnOl&JjPuW|q}(ORCx?Q1g)HSl06w*lgoCOXeh&_zsz4H$+93l1rT6`64e9V~zZuWLkxiE@~<)^l+b@vSF|Dpv)W>c@V$y^{x z)MMQ}6`|URt8*wP*q={GzO6#YBPIgJiltq0i;RJ^UHokuA!+H@9NcU8UUGD3X>q0? zEvo3WPioz8Y%QCxU1l$gOliq34J_6!q(yo{D^8p>T|_p{%rqEaQZ7N4$BH82J=IX; zMv80Y`q-SLmCP6MPDCefrmV}I#k?sA(Y?l;u(;@(A-TUnh9Z?_<5jux!DvTZ7@BuYxA2L9_i1!S#=j4pTRj1}PVgH>ex#Fs_G;N)G>uD1=*2SFGwc1<3wP zTOA(c{ATC~h)4h-H30Y+kq+n2a3?XstSc^e(EU~Q0~07eNk7`u=Z5(#4KYl8?Q>3* z>~ltk@t5VHYOn?{HoaSc6DBDjTZF0;4!ISiO@>M(s8a?Iw7IvFg2-AE>JH@Dn!eM# zCQMS$-I5f_Yg)sKlx3`9j;N#TmhThvoxYBSM-{EPDC=1dzx3R*XgQ$h&drnD(P5M(8AGk<#<7%MqUYp z-=rR~yT1LEeJ>nU@6g`V(uWy`XA_JDXpTRmGo;CQRL~WcS48MAV3N`_K#=L0Uu+