From d8bd4fc81d024f0363ceff702a5af221a12ea65f Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 17 Nov 2020 14:00:15 +0100 Subject: [PATCH 001/154] Improve Persistence() input checks and correct output AR.lowCI and AR.highCI --- NEWS.md | 3 + R/Persistence.R | 140 +++++++++++++++++++++--------- man/Persistence.Rd | 45 ++++++---- tests/testthat/test-Persistence.R | 109 ++++++++++++++++------- 4 files changed, 212 insertions(+), 85 deletions(-) diff --git a/NEWS.md b/NEWS.md index 567b9e0..df8040a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,6 @@ +# s2dv 0.2.0 (Release date: 2021-) +- Improve Persistence() input checks, and correct the output 'AR.lowCI' and 'AR.highCI'. + # s2dv 0.1.1 (Release date: 2020-11-16) - Change the lincense to Apache License 2.0. diff --git a/R/Persistence.R b/R/Persistence.R index 3aa0636..f569e63 100644 --- a/R/Persistence.R +++ b/R/Persistence.R @@ -8,14 +8,16 @@ #' including the time dimension along which the autoregression is computed. #' The data should start at least 40 time steps (years or days) before #' 'start'. -#'@param dates A sequence of 4-digit integers (YYYY) or dates (YYYY-MM-DD) -#' indicating the dates available in the observations. +#'@param dates A sequence of 4-digit integers (YYYY) or string (YYYY-MM-DD) +#' in class 'Date' indicating the dates available in the observations. #'@param time_dim A character string indicating the dimension along which to #' compute the autoregression. The default value is 'time'. -#'@param start A 4-digit integer (YYYY) or a date in the ISOdate format -#' (YYYY-MM-DD) indicating the first start date of the persistence forecast. -#'@param end A 4-digit integer (YYYY) or a date in the ISOdate format -#' (YYYY-MM-DD) indicating the last start date of the persistence forecast. +#'@param start A 4-digit integer (YYYY) or a string (YYYY-MM-DD) in class 'Date' +#' indicating the first start date of the persistence forecast. It must be +#' between 1850 and 2020. +#'@param end A 4-digit integer (YYYY) or a string (YYYY-MM-DD) in class 'Date' +#' indicating the last start date of the persistence forecast. It must be +#' between 1850 and 2020. #'@param ft_start An integer indicating the forecast time for which the #' persistence forecast should be calculated, or the first forecast time of #' the average forecast times for which persistence should be calculated. @@ -37,45 +39,54 @@ #' #'@return #'A list containing: -#'\item{$persistence}{ +#'\item{$persistence} { #' A numeric array with dimensions 'memb', time (start dates), latitudes and longitudes #' containing the persistence forecast. #'} -#'\item{$persistence.mean}{ +#'\item{$persistence.mean} { #' A numeric array with same dimensions as 'persistence', except the 'memb' dimension #' which is of length 1, containing the ensemble mean persistence forecast. #'} -#'\item{$persistence.predint}{ +#'\item{$persistence.predint} { #' A numeric array with same dimensions as 'persistence', except the 'memb' dimension #' which is of length 1, containing the prediction interval of the persistence forecast. #'} -#'\item{$AR.slope}{ +#'\item{$AR.slope} { #' A numeric array with same dimensions as 'persistence', except the 'memb' dimension #' which is of length 1, containing the slope coefficient of the autoregression. #'} -#'\item{$AR.intercept}{ +#'\item{$AR.intercept} { #' A numeric array with same dimensions as 'persistence', except the 'memb' dimension #' which is of length 1, containing the intercept coefficient of the autoregression. #'} -#'\item{$AR.lowCI}{ +#'\item{$AR.lowCI} { #' A numeric array with same dimensions as 'persistence', except the 'memb' dimension #' which is of length 1, containing the lower value of the confidence interval of the #' autoregression. #'} -#'\item{$AR.highCI}{ +#'\item{$AR.highCI} { #' A numeric array with same dimensions as 'persistence', except the 'memb' dimension #' which is of length 1, containing the upper value of the confidence interval of the #' autoregression. #'} #' #'@examples -#'#Building an example dataset with yearly start dates from 1920 to 2009 +#'# Case 1: year +#'# Building an example dataset with yearly start dates from 1920 to 2009 #'set.seed(1) #'obs1 <- rnorm(1 * 70 * 6 * 7) #'dim(obs1) <- c(member = 1, time = 70, lat = 6, lon = 7) -#'dates <- seq(1940, 2009, 1) -#'persist <- Persistence(obs1, dates = dates, start = 1961, end = 2005, ft_start = 1, -#' nmemb = 40) +#'dates <- seq(1920, 1989, 1) +#'res <- Persistence(obs1, dates = dates, start = 1961, end = 1980, ft_start = 1, +#' nmemb = 40) +#'# Case 2: day +#'dates <- seq(as.Date(ISOdate(1990, 1, 1)), as.Date(ISOdate(1990, 4, 1)) ,1) +#'start <- as.Date(ISOdate(1990, 2, 15)) +#'end <- as.Date(ISOdate(1990, 4, 1)) +#'set.seed(1) +#'data <- rnorm(1 * length(dates) * 6 * 7) +#'dim(data) <- c(member = 1, time = length(dates), lat = 6, lon = 7) +#'res <- Persistence(data, dates = dates, start = start, end = end, ft_start = 1) #' #'@import multiApply #'@export @@ -95,7 +106,7 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, dim(data) <- c(length(data)) names(dim(data)) <- time_dim } - if(any(is.null(names(dim(data))))| any(nchar(names(dim(data))) == 0)) { + if(any(is.null(names(dim(data)))) | any(nchar(names(dim(data))) == 0)) { stop("Parameter 'data' must have dimension names.") } ## time_dim @@ -106,27 +117,79 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, stop("Parameter 'time_dim' is not found in 'data' dimension.") } ## dates + if (is.numeric(dates)) { #(YYYY) + if (any(nchar(dates) != 4) | any(dates %% 1 != 0) | any(dates <= 0)) { + stop(paste0("Parameter 'dates' must be a sequence of integer (YYYY) or ", + "string (YYYY-MM-DD) in class 'Date'.")) + } + } else if (class(dates) == 'Date') { #(YYYY-MM-DD) + + } else { + stop(paste0("Parameter 'dates' must be a sequence of integer (YYYY) or ", + "string (YYYY-MM-DD) in class 'Date'.")) + } if (length(dates) != dim(data)[time_dim]) { stop("Parameter 'dates' must have the same length as in 'time_dim'.") } + ## dates, start, and end + if (!all(sapply(list(class(dates), class(start)), function(x) x == class(end)))) { + stop("Parameter 'dates', 'start', and 'end' should be the same format.") + } ## start -# if (!is.numeric(start) | start %% 1 != 0 | start < 0 | -# length(start) > 1 | start < 1850 | start > 2020) { -# stop("Parameter 'start' must be an integer between 1850 and 2020.") -# } -# if (start < dates[1] + 40) { -# stop("Parameter 'start' must start at least 40 time steps after the -# first start date of 'data'.") -# } + if (is.numeric(start)) { #(YYYY) + if (length(start) > 1 | any(start %% 1 != 0) | any(start < 1850) | any(start > 2020)) { + stop(paste0("Parameter 'start' must be an integer or a string in class ", + "'Date' between 1850 and 2020.")) + } + if (is.na(match(start, dates))) { + stop("Parameter 'start' must be one of the values of 'dates'.") + } + if (start < dates[1] + 40) { + stop(paste0("Parameter 'start' must start at least 40 time steps after ", + "the first 'dates'.")) + } + } else if (class(start) == 'Date') { + if (length(start) > 1 | any(start < as.Date(ISOdate(1850, 1, 1))) | + any(start > as.Date(ISOdate(2021, 1, 1)))) { + stop(paste0("Parameter 'start' must be an integer or a string in class ", + "'Date' between 1850 and 2020.")) + } + if (is.na(match(start, dates))) { + stop("Parameter 'start' must be one of the values of 'dates'.") + } + if (start < dates[1] + 40) { + stop(paste0("Parameter 'start' must start at least 40 time steps after ", + "the first 'dates'.")) + } + } else { + stop(paste0("Parameter 'start' must be an integer or a string in class ", + "'Date' between 1850 and 2020.")) + } + ## end -# if (!is.numeric(end) | end %% 1 != 0 | end < 0 | -# length(end) > 1 | end < 1850 | end > 2020) { -# stop("Parameter 'end' must be an integer between 1850 and 2020.") -# } -# if (end > dates[length(dates)] + 1) { -# stop("Parameter 'end' must end at most 1 time step after the -# last start date of 'data'.") -# } + if (is.numeric(end)) { #(YYYY) + if (length(end) > 1 | any(end %% 1 != 0) | any(end < 1850) | any(end > 2020)) { + stop(paste0("Parameter 'end' must be an integer or a string in class ", + "'Date' between 1850 and 2020.")) + } + if (end > dates[length(dates)] + 1) { + stop(paste0("Parameter 'end' must end at most 1 time steps after ", + "the last 'dates'.")) + } + } else if (class(end) == 'Date') { + if (length(end) > 1 | any(end < as.Date(ISOdate(1850, 1, 1))) | + any(end > as.Date(ISOdate(2020, 12, 31)))) { + stop(paste0("Parameter 'end' must be an integer or a string in class ", + "'Date' between 1850 and 2020.")) + } + if (end > dates[length(dates)] + 1) { + stop(paste0("Parameter 'end' must end at most 1 time steps after ", + "the last 'dates'.")) + } + } else { + stop(paste0("Parameter 'end' must be an integer or a string in class ", + "'Date' between 1850 and 2020.")) + } ## ft_start if (!is.numeric(ft_start) | ft_start %% 1 != 0 | ft_start < 0 | length(ft_start) > 1) { @@ -195,7 +258,6 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, # ft_start/ft_end are indices .Persistence <- function(x, dates, time_dim = 'time', start, end, ft_start = 1, ft_end = 1, max_ft = 10, nmemb = 1, na.action = 10) { - tm <- end - start + 1 max_date <- match(start, dates) interval <- ft_end - ft_start @@ -204,7 +266,7 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, persistence <- matrix(NA, nrow = nmemb, ncol = tm) names(dim(persistence)) <- c('realization', time_dim) - for (sdate in tm:1){ + for (sdate in tm:1) { min_y = max_ft + ft_start max_y = max_date + sdate - 2 min_x = max_ft # for extreme case: ex. forecast years 1-10, interval = 9 @@ -243,9 +305,9 @@ Persistence <- function(data, dates, time_dim = 'time', start, end, ft_start, persistence.predint[sdate] <- stdev_reg * sqrt(1 + 1 / n + X_sq / S_sq) AR.slope[sdate] <- a AR.intercept[sdate] <- b - AR.lowCI[sdate] <- reg$regression[1] - AR.highCI[sdate] <- reg$regression[3] - persistence[ ,sdate] <- rnorm(n = nmemb, mean = persistence.mean[sdate], + AR.lowCI[sdate] <- reg$conf.lower[2] + AR.highCI[sdate] <- reg$conf.upper[2] + persistence[ , sdate] <- rnorm(n = nmemb, mean = persistence.mean[sdate], sd = persistence.predint[sdate]) } diff --git a/man/Persistence.Rd b/man/Persistence.Rd index 33d4868..0d6c77f 100644 --- a/man/Persistence.Rd +++ b/man/Persistence.Rd @@ -14,17 +14,19 @@ including the time dimension along which the autoregression is computed. The data should start at least 40 time steps (years or days) before 'start'.} -\item{dates}{A sequence of 4-digit integers (YYYY) or dates (YYYY-MM-DD) -indicating the dates available in the observations.} +\item{dates}{A sequence of 4-digit integers (YYYY) or string (YYYY-MM-DD) +in class 'Date' indicating the dates available in the observations.} \item{time_dim}{A character string indicating the dimension along which to compute the autoregression. The default value is 'time'.} -\item{start}{A 4-digit integer (YYYY) or a date in the ISOdate format -(YYYY-MM-DD) indicating the first start date of the persistence forecast.} +\item{start}{A 4-digit integer (YYYY) or a string (YYYY-MM-DD) in class 'Date' +indicating the first start date of the persistence forecast. It must be +between 1850 and 2020.} -\item{end}{A 4-digit integer (YYYY) or a date in the ISOdate format -(YYYY-MM-DD) indicating the last start date of the persistence forecast.} +\item{end}{A 4-digit integer (YYYY) or a string (YYYY-MM-DD) in class 'Date' +indicating the last start date of the persistence forecast. It must be +between 1850 and 2020.} \item{ft_start}{An integer indicating the forecast time for which the persistence forecast should be calculated, or the first forecast time of @@ -52,32 +54,32 @@ computation. The default value is NULL.} } \value{ A list containing: -\item{$persistence}{ +\item{$persistence} { A numeric array with dimensions 'memb', time (start dates), latitudes and longitudes containing the persistence forecast. } -\item{$persistence.mean}{ +\item{$persistence.mean} { A numeric array with same dimensions as 'persistence', except the 'memb' dimension which is of length 1, containing the ensemble mean persistence forecast. } -\item{$persistence.predint}{ +\item{$persistence.predint} { A numeric array with same dimensions as 'persistence', except the 'memb' dimension which is of length 1, containing the prediction interval of the persistence forecast. } -\item{$AR.slope}{ +\item{$AR.slope} { A numeric array with same dimensions as 'persistence', except the 'memb' dimension which is of length 1, containing the slope coefficient of the autoregression. } -\item{$AR.intercept}{ +\item{$AR.intercept} { A numeric array with same dimensions as 'persistence', except the 'memb' dimension which is of length 1, containing the intercept coefficient of the autoregression. } -\item{$AR.lowCI}{ +\item{$AR.lowCI} { A numeric array with same dimensions as 'persistence', except the 'memb' dimension which is of length 1, containing the lower value of the confidence interval of the autoregression. } -\item{$AR.highCI}{ +\item{$AR.highCI} { A numeric array with same dimensions as 'persistence', except the 'memb' dimension which is of length 1, containing the upper value of the confidence interval of the autoregression. @@ -89,13 +91,22 @@ observational data along the time dimension, with a measure of forecast uncertainty (prediction interval) based on Coelho et al., 2004.\cr\cr } \examples{ -#Building an example dataset with yearly start dates from 1920 to 2009 +# Case 1: year +# Building an example dataset with yearly start dates from 1920 to 2009 set.seed(1) obs1 <- rnorm(1 * 70 * 6 * 7) dim(obs1) <- c(member = 1, time = 70, lat = 6, lon = 7) -dates <- seq(1940, 2009, 1) -persist <- Persistence(obs1, dates = dates, start = 1961, end = 2005, ft_start = 1, - nmemb = 40) +dates <- seq(1920, 1989, 1) +res <- Persistence(obs1, dates = dates, start = 1961, end = 1980, ft_start = 1, + nmemb = 40) +# Case 2: day +dates <- seq(as.Date(ISOdate(1990, 1, 1)), as.Date(ISOdate(1990, 4, 1)) ,1) +start <- as.Date(ISOdate(1990, 2, 15)) +end <- as.Date(ISOdate(1990, 4, 1)) +set.seed(1) +data <- rnorm(1 * length(dates) * 6 * 7) +dim(data) <- c(member = 1, time = length(dates), lat = 6, lon = 7) +res <- Persistence(data, dates = dates, start = start, end = end, ft_start = 1) } diff --git a/tests/testthat/test-Persistence.R b/tests/testthat/test-Persistence.R index a75c518..2ce2dec 100644 --- a/tests/testthat/test-Persistence.R +++ b/tests/testthat/test-Persistence.R @@ -1,9 +1,23 @@ context("s2dv::Persistence tests") ############################################## - set.seed(1) - dat1 <- array(rnorm(540), dim = c(member = 1, time = 90, lat = 2, lon = 3)) - dates1 <- seq(1920, 2009, 1) +#dat1: year +set.seed(1) +dat1 <- rnorm(1 * 70 * 6 * 7) +dim(dat1) <- c(member = 1, time = 70, lat = 6, lon = 7) +dates1 <- seq(1920, 1989, 1) +start1 <- 1961 +end1 <- 1990 +res <- Persistence(obs1, dates = dates1, start = 1961, end = 1990, ft_start = 1, + nmemb = 40) + +#dat2: day +dates2 <- seq(as.Date(ISOdate(1990, 1, 1)), as.Date(ISOdate(1990, 4, 1)) ,1) +set.seed(2) +dat2 <- rnorm(1 * length(dates2) * 6 * 7) +dim(dat2) <- c(member = 1, time = length(dates2), lat = 6, lon = 7) +start2 <- as.Date(ISOdate(1990, 2, 15)) +end2 <- as.Date(ISOdate(1990, 4, 1)) ############################################## test_that("1. Input checks", { @@ -21,10 +35,6 @@ test_that("1. Input checks", { "Parameter 'data' must have dimension names." ) expect_error( - Persistence(data = dat1, dates = seq(1900, 2009, 1)), - "Parameter 'dates' must have the same length as in 'time_dim'." - ) - expect_error( Persistence(data = dat1, dates = dates1, time_dim = 12), "Parameter 'time_dim' must be a character string." ) @@ -33,34 +43,76 @@ test_that("1. Input checks", { "Parameter 'time_dim' is not found in 'data' dimension." ) expect_error( - Persistence(data = dat1, dates = dates1, start = 1961, end = 2005, ft_start = 0.5), + Persistence(data = dat1, dates = c(1:10)), + paste0("Parameter 'dates' must be a sequence of integer \\(YYYY\\) or ", + "string \\(YYYY-MM-DD\\) in class 'Date'.") + ) + expect_error( + Persistence(data = dat1, dates = seq(1900, 2009, 1)), + "Parameter 'dates' must have the same length as in 'time_dim'." + ) + expect_error( + Persistence(data = dat1, dates = dates1, start = start1, end = end2), + "Parameter 'dates', 'start', and 'end' should be the same format." + ) + # start + expect_error( + Persistence(data = dat1, dates = dates1, start = 1800, end = end1), + paste0("Parameter 'start' must be an integer or a string in class ", + "'Date' between 1850 and 2020.") + ) + expect_error( + Persistence(data = dat1, dates = dates1, start = 1851, end = end1), + "Parameter 'start' must be one of the values of 'dates'." + ) + expect_error( + Persistence(data = dat1, dates = dates1, start = 1921, end = end1), + paste0("Parameter 'start' must start at least 40 time steps after ", + "the first 'dates'.") + ) + # end + expect_error( + Persistence(data = dat2, dates = dates2, start = start2, end = as.Date(ISOdate(2021, 1, 1))), + paste0("Parameter 'end' must be an integer or a string in class ", + "'Date' between 1850 and 2020.") + ) + expect_error( + Persistence(data = dat2, dates = dates2, start = start2, end = as.Date(ISOdate(1990, 4, 3))), + paste0("Parameter 'end' must end at most 1 time steps after ", + "the last 'dates'.") + ) + # ft_start + expect_error( + Persistence(data = dat1, dates = dates1, start = start1, end = end1, ft_start = 0.5), "Parameter 'ft_start' must be a positive integer." ) + # ft_end expect_error( - Persistence(data = dat1, dates = dates1, start = 1961, end = 2005, ft_start = 1, + Persistence(data = dat1, dates = dates1, start = start1, end = end1, ft_start = 1, ft_end = 12), "Parameter 'ft_end' must be a positive integer below 'max_ft'." ) + # max_ft expect_error( - Persistence(data = dat1, dates = dates1, start = 1961, end = 2005, ft_start = 1, + Persistence(data = dat1, dates = dates1, start = start1, end = end1, ft_start = 1, ft_end = 12, max_ft = 13.5), "Parameter 'max_ft' must be a positive integer." ) + # nmemb expect_error( - Persistence(data = dat1, dates = dates1, start = 1961, end = 2005, ft_start = 1, - nmemb = 0), + Persistence(data = dat1, dates = dates1, start = start1, end = end1, ft_start = 1, nmemb = 0), "Parameter 'nmemb' must be a positive integer." ) expect_error( - Persistence(data = dat1, dates = dates1, start = 1961, end = 2005, ft_start = 1, + Persistence(data = dat1, dates = dates1, start = start1, end = end1, ft_start = 1, na.action = T), paste0("Parameter 'na.action' must be a function for NA values or ", "a numeric indicating the number of NA values allowed ", "before returning NA.") ) expect_error( - Persistence(data = dat1, dates = dates1, start = 1961, end = 2005, ft_start = 1, + Persistence(data = dat1, dates = dates1, start = start1, end = end1, ft_start = 1, ncores = 0), "Parameter 'ncores' must be a positive integer." ) @@ -69,7 +121,7 @@ test_that("1. Input checks", { ############################################## test_that("2. Output checks: dat1", { - res <- Persistence(dat1, dates = dates1, start = 1961, end = 2005, ft_start = 1) + res <- Persistence(dat1, dates = dates1, start = start1, end = end1, ft_start = 1) expect_equal( names(res), @@ -78,26 +130,25 @@ test_that("2. Output checks: dat1", { ) expect_equal( dim(res$persistence), - c(realization = 1, time = 45, member = 1, lat = 2, lon = 3) + c(realization = 1, time = 30, member = 1, lat = 6, lon = 7) ) expect_equal( dim(res$persistence.mean), - c(45, member = 1, lat = 2, lon = 3) - ) - expect_equal( - mean(res$persistence), - 0.03481641, - tolerance = 0.00001 + c(30, member = 1, lat = 6, lon = 7) ) +}) + +############################################## +test_that("2. Output checks: dat1", { + res <- Persistence(dat2, dates = dates2, start = start2, end = end2, ft_start = 1) + expect_equal( - range(res$persistence), - c(-1.025059, 1.042929), - tolerance = 0.0001 + names(res), + c('persistence', 'persistence.mean', 'persistence.predint', 'AR.slope', + 'AR.intercept', 'AR.lowCI', 'AR.highCI') ) expect_equal( - range(res$AR.slope), - c(-0.2636489, 0.2334777), - tolerance = 0.0001 + dim(res$persistence), + c(realization = 1, time = 46, member = 1, lat = 6, lon = 7) ) }) - -- GitLab From 54e55d6c2bfa831c033a88b994fbdf1f08b9b8e1 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 24 Nov 2020 11:25:28 +0100 Subject: [PATCH 002/154] Add parameter 'memb_dim' and 'memb' in Corr(). Create unit tests and modify the examples. --- NEWS.md | 5 + R/Corr.R | 248 +++++++++++++++++++++++++++++++------ man/Corr.Rd | 46 +++++-- tests/testthat/test-Corr.R | 234 +++++++++++++++++++++++++++++++++- 4 files changed, 484 insertions(+), 49 deletions(-) diff --git a/NEWS.md b/NEWS.md index 567b9e0..d1e42ee 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# s2dv 1.0.0 (Release date: 2021-) +- Add parameter 'memb_dim' and 'memb' in Corr(). They allow the existence of the member dimension + which can have different length between exp and obs, and users can choose to do the ensemble mean +first before correlation or calculate the correlation for individual member. + # s2dv 0.1.1 (Release date: 2020-11-16) - Change the lincense to Apache License 2.0. diff --git a/R/Corr.R b/R/Corr.R index a74725f..6709aed 100644 --- a/R/Corr.R +++ b/R/Corr.R @@ -19,7 +19,7 @@ #'@param exp A named numeric array of experimental data, with at least two #' dimensions 'time_dim' and 'dat_dim'. #'@param obs A named numeric array of observational data, same dimensions as -#' parameter 'exp' except along dat_dim. +#' parameter 'exp' except along 'dat_dim' and 'memb_dim'. #'@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) @@ -31,6 +31,12 @@ #' be completed. The default is c(1, length(comp_dim dimension)). #'@param method A character string indicating the type of correlation: #' 'pearson', 'spearman', or 'kendall'. The default value is 'pearson'. +#'@param memb_dim A character string indicating the name of the member +#' dimension. It must be one dimension in 'exp' and 'obs'. If there is no +#' member dimension, set NULL. The default value is NULL. +#'@param memb A logical value indicating whether to remain 'memb_dim' dimension +#' (TRUE) or do ensemble mean over 'memb_dim' (FALSE). Only functional when +#' 'memb_dim' is not NULL. The default value is TRUE. #'@param pval A logical value indicating whether to compute 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 @@ -42,9 +48,12 @@ #' #'@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 +#' c(nexp, nobs, exp_memb, obs_memb, all other dimensions of exp except +#' time_dim and memb_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). exp_memb is the number of +#'member in experiment (i.e., 'memb_dim' in exp) and obs_memb is the number of +#'member in observation (i.e., 'memb_dim' in obs).\cr\cr #'\item{$corr}{ #' The correlation coefficient. #'} @@ -59,20 +68,37 @@ #'} #' #'@examples -#'# Load sample data as in Load() example: +#'# Case 1: Load sample data as in Load() example: #'example(Load) #'clim <- Clim(sampleData$mod, sampleData$obs) -#'corr <- Corr(clim$clim_exp, clim$clim_obs, time_dim = 'ftime', dat_dim = 'member') -#'# Renew the example when Ano and Smoothing is ready +#'ano_exp <- Ano(sampleData$mod, clim$clim_exp) +#'ano_obs <- Ano(sampleData$obs, clim$clim_obs) +#'runmean_months <- 12 +#' +#'# Smooth along lead-times +#'smooth_ano_exp <- Smoothing(ano_exp, runmeanlen = runmean_months) +#'smooth_ano_obs <- Smoothing(ano_obs, runmeanlen = runmean_months) +#'required_complete_row <- 3 # Discard start dates which contain any NA lead-times +#'leadtimes_per_startdate <- 60 +#'corr <- Corr(MeanDims(smooth_ano_exp, 'member'), +#' MeanDims(smooth_ano_obs, 'member'), +#' comp_dim = 'ftime', +#' 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') +#'# ensemble mean +#'corr <- Corr(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member', memb = FALSE) #' -#'@rdname Corr #'@import multiApply #'@importFrom ClimProjDiags Subset #'@importFrom stats cor pt qnorm #'@export Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', - comp_dim = NULL, limits = NULL, - method = 'pearson', pval = TRUE, conf = TRUE, + comp_dim = NULL, limits = NULL, method = 'pearson', + memb_dim = NULL, memb = TRUE, + pval = TRUE, conf = TRUE, conf.lev = 0.95, ncores = NULL) { # Check inputs @@ -133,6 +159,19 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', if (!(method %in% c("kendall", "spearman", "pearson"))) { stop("Parameter 'method' must be one of 'kendall', 'spearman' or 'pearson'.") } + ## 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)) | !memb_dim %in% names(dim(obs))) { + stop("Parameter 'memb_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.") + } ## pval if (!is.logical(pval) | length(pval) > 1) { stop("Parameter 'pval' must be one logical value.") @@ -157,9 +196,13 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', name_obs <- sort(names(dim(obs))) name_exp <- name_exp[-which(name_exp == dat_dim)] name_obs <- name_obs[-which(name_obs == dat_dim)] + if (!is.null(memb_dim)) { + 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])) { stop(paste0("Parameter 'exp' and 'obs' must have same length of ", - "all dimension expect 'dat_dim'.")) + "all dimension expect 'dat_dim' and 'memb_dim'.")) } if (dim(exp)[time_dim] < 3) { stop("The length of time_dim must be at least 3 to compute correlation.") @@ -189,43 +232,159 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', obs[which(outrows)] <- NA } - res <- Apply(list(exp, obs), - target_dims = list(c(time_dim, dat_dim), - c(time_dim, dat_dim)), - fun = .Corr, - time_dim = time_dim, method = method, - pval = pval, conf = conf, conf.lev = conf.lev, - ncores = ncores) + + if (is.null(memb_dim)) { + # Define output_dims + if (conf & pval) { + output_dims <- list(corr = c('nexp', 'nobs'), + p.val = c('nexp', 'nobs'), + conf.lower = c('nexp', 'nobs'), + conf.upper = c('nexp', 'nobs')) + } else if (conf & !pval) { + output_dims <- list(corr = c('nexp', 'nobs'), + conf.lower = c('nexp', 'nobs'), + conf.upper = c('nexp', 'nobs')) + } else if (!conf & pval) { + output_dims <- list(corr = c('nexp', 'nobs'), + p.val = c('nexp', 'nobs')) + } else { + output_dims <- list(corr = c('nexp', 'nobs')) + } + + res <- Apply(list(exp, obs), + target_dims = list(c(time_dim, dat_dim), + c(time_dim, dat_dim)), + output_dims = output_dims, + fun = .Corr, + time_dim = time_dim, method = method, + pval = pval, conf = conf, conf.lev = conf.lev, + ncores = ncores) + + } else { + if (!memb) { #ensemble mean + name_exp <- names(dim(exp)) + margin_dims_ind <- c(1:length(name_exp))[-which(name_exp == memb_dim)] + exp <- apply(exp, margin_dims_ind, mean, na.rm = TRUE) #NOTE: remove NAs here + obs <- apply(obs, margin_dims_ind, mean, na.rm = TRUE) + + # Define output_dims + if (conf & pval) { + output_dims <- list(corr = c('nexp', 'nobs'), + p.val = c('nexp', 'nobs'), + conf.lower = c('nexp', 'nobs'), + conf.upper = c('nexp', 'nobs')) + } else if (conf & !pval) { + output_dims <- list(corr = c('nexp', 'nobs'), + conf.lower = c('nexp', 'nobs'), + conf.upper = c('nexp', 'nobs')) + } else if (!conf & pval) { + output_dims <- list(corr = c('nexp', 'nobs'), + p.val = c('nexp', 'nobs')) + } else { + output_dims <- list(corr = c('nexp', 'nobs')) + } + + res <- Apply(list(exp, obs), + target_dims = list(c(time_dim, dat_dim), + c(time_dim, dat_dim)), + output_dims = output_dims, + fun = .Corr, + time_dim = time_dim, method = method, + pval = pval, conf = conf, conf.lev = conf.lev, + ncores = ncores) + + } else { # correlation for each member + + # Define output_dims + if (conf & pval) { + output_dims <- list(corr = c('nexp', 'nobs', 'exp_memb', 'obs_memb'), + p.val = c('nexp', 'nobs', 'exp_memb', 'obs_memb'), + conf.lower = c('nexp', 'nobs', 'exp_memb', 'obs_memb'), + conf.upper = c('nexp', 'nobs', 'exp_memb', 'obs_memb')) + } else if (conf & !pval) { + output_dims <- list(corr = c('nexp', 'nobs', 'exp_memb', 'obs_memb'), + conf.lower = c('nexp', 'nobs', 'exp_memb', 'obs_memb'), + conf.upper = c('nexp', 'nobs', 'exp_memb', 'obs_memb')) + } else if (!conf & pval) { + output_dims <- list(corr = c('nexp', 'nobs', 'exp_memb', 'obs_memb'), + p.val = c('nexp', 'nobs', 'exp_memb', 'obs_memb')) + } else { + output_dims <- list(corr = c('nexp', 'nobs', 'exp_memb', 'obs_memb')) + } + + res <- Apply(list(exp, obs), + target_dims = list(c(time_dim, dat_dim, memb_dim), + c(time_dim, dat_dim, memb_dim)), + output_dims = output_dims, + fun = .Corr, + time_dim = time_dim, method = method, + pval = pval, conf = conf, conf.lev = conf.lev, + ncores = ncores) + + + } + } + return(res) } .Corr <- function(exp, obs, time_dim = 'sdate', method = 'pearson', conf = TRUE, pval = TRUE, conf.lev = 0.95) { + if (length(dim(exp)) == 2) { # exp: [sdate, dat_exp] # obs: [sdate, dat_obs] nexp <- as.numeric(dim(exp)[2]) nobs <- as.numeric(dim(obs)[2]) - CORR <- array(dim = c(nexp = nexp, nobs = nobs)) - eno_expand <- array(dim = c(nexp = nexp, nobs = nobs)) - p.val <- array(dim = c(nexp = nexp, nobs = nobs)) - - # ens_mean - for (i in 1:nobs) { - - CORR[, i] <- sapply(1:nexp, - function(x) { - if (any(!is.na(exp[, x])) && sum(!is.na(obs[, i])) > 2) { -cor(exp[, x], obs[, i], - use = "pairwise.complete.obs", - method = method) -} else { - CORR[, i] <- NA -} -}) +# NOTE: Use sapply to replace the for loop + CORR <- sapply(1:nobs, function(i) { + sapply(1:nexp, function (x) { + if (any(!is.na(exp[, x])) && sum(!is.na(obs[, i])) > 2) { #NOTE: Is this necessary? + cor(exp[, x], obs[, i], + use = "pairwise.complete.obs", + method = method) + } else { + NA #CORR[, i] <- NA + } + }) + }) + if (is.null(dim(CORR))) { + CORR <- array(CORR, dim = c(1, 1)) } + } else { # member + + # exp: [sdate, dat_exp, memb_exp] + # obs: [sdate, dat_obs, memb_obs] + nexp <- as.numeric(dim(exp)[2]) + nobs <- as.numeric(dim(obs)[2]) + exp_memb <- as.numeric(dim(exp)[3]) + obs_memb <- as.numeric(dim(obs)[3]) + + CORR <- array(dim = c(nexp = nexp, nobs = nobs, exp_memb = exp_memb, obs_memb = obs_memb)) + + for (j in 1:obs_memb) { + for (y in 1:exp_memb) { + CORR[, , y, j] <- sapply(1:nobs, function(i) { + sapply(1:nexp, function (x) { + if (any(!is.na(exp[, x, y])) && sum(!is.na(obs[, i, j])) > 2) { + cor(exp[, x, y], obs[, i, j], + use = "pairwise.complete.obs", + method = method) + } else { + NA #CORR[, i] <- NA + } + }) + }) + + } + } + + + } + + # if (pval) { # for (i in 1:nobs) { # p.val[, i] <- try(sapply(1:nexp, @@ -240,16 +399,29 @@ cor(exp[, x], obs[, i], if (pval | conf) { if (method == "kendall" | method == "spearman") { - tmp <- apply(obs, 2, rank) + tmp <- apply(obs, c(1:length(dim(obs)))[-1], rank) # for memb_dim = NULL, 2; for memb_dim, c(2, 3) names(dim(tmp))[1] <- time_dim eno <- Eno(tmp, time_dim) } else if (method == "pearson") { eno <- Eno(obs, time_dim) } - for (i in 1:nexp) { - eno_expand[i, ] <- eno + + if (length(dim(exp)) == 2) { + eno_expand <- array(dim = c(nexp = nexp, nobs = nobs)) + for (i in 1:nexp) { + eno_expand[i, ] <- eno + } + } else { #member + eno_expand <- array(dim = c(nexp = nexp, nobs = nobs, exp_memb = exp_memb, obs_memb = obs_memb)) + for (i in 1:nexp) { + for (j in 1:exp_memb) { + eno_expand[i, , j, ] <- eno + } + } } + } + #############old################# #This doesn't return error but it's diff from cor.test() when method is spearman and kendall if (pval) { diff --git a/man/Corr.Rd b/man/Corr.Rd index bf5575e..982a279 100644 --- a/man/Corr.Rd +++ b/man/Corr.Rd @@ -5,15 +5,15 @@ \title{Compute the correlation coefficient between an array of forecast and their corresponding observation} \usage{ Corr(exp, obs, time_dim = "sdate", dat_dim = "dataset", comp_dim = NULL, - limits = NULL, method = "pearson", pval = TRUE, conf = TRUE, - conf.lev = 0.95, ncores = NULL) + limits = NULL, method = "pearson", memb_dim = NULL, memb = TRUE, + pval = TRUE, conf = TRUE, conf.lev = 0.95, ncores = NULL) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two dimensions 'time_dim' and 'dat_dim'.} \item{obs}{A named numeric array of observational data, same dimensions as -parameter 'exp' except along dat_dim.} +parameter 'exp' except along 'dat_dim' and 'memb_dim'.} \item{time_dim}{A character string indicating the name of dimension along which the correlations are computed. The default value is 'sdate'.} @@ -31,6 +31,14 @@ be completed. The default is c(1, length(comp_dim dimension)).} \item{method}{A character string indicating the type of correlation: 'pearson', 'spearman', or 'kendall'. The default value is 'pearson'.} +\item{memb_dim}{A character string indicating the name of the member +dimension. It must be one dimension in 'exp' and 'obs'. If there is no +member dimension, set NULL. The default value is NULL.} + +\item{memb}{A logical value indicating whether to remain 'memb_dim' dimension +(TRUE) or do ensemble mean over 'memb_dim' (FALSE). Only functional when +'memb_dim' is not NULL. The default value is TRUE.} + \item{pval}{A logical value indicating whether to compute or not the p-value of the test Ho: Corr = 0. The default value is TRUE.} @@ -45,9 +53,12 @@ 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 + c(nexp, nobs, exp_memb, obs_memb, all other dimensions of exp except + time_dim and memb_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). exp_memb is the number of +member in experiment (i.e., 'memb_dim' in exp) and obs_memb is the number of +member in observation (i.e., 'memb_dim' in obs).\cr\cr \item{$corr}{ The correlation coefficient. } @@ -79,11 +90,28 @@ have inconsistent length between 'exp' and 'obs'. If all the dimensions of compute the correlation. } \examples{ -# Load sample data as in Load() example: +# Case 1: Load sample data as in Load() example: example(Load) clim <- Clim(sampleData$mod, sampleData$obs) -corr <- Corr(clim$clim_exp, clim$clim_obs, time_dim = 'ftime', dat_dim = 'member') -# Renew the example when Ano and Smoothing is ready +ano_exp <- Ano(sampleData$mod, clim$clim_exp) +ano_obs <- Ano(sampleData$obs, clim$clim_obs) +runmean_months <- 12 + +# Smooth along lead-times +smooth_ano_exp <- Smoothing(ano_exp, runmeanlen = runmean_months) +smooth_ano_obs <- Smoothing(ano_obs, runmeanlen = runmean_months) +required_complete_row <- 3 # Discard start dates which contain any NA lead-times +leadtimes_per_startdate <- 60 +corr <- Corr(MeanDims(smooth_ano_exp, 'member'), + MeanDims(smooth_ano_obs, 'member'), + comp_dim = 'ftime', + 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') +# ensemble mean +corr <- Corr(smooth_ano_exp, smooth_ano_obs, memb_dim = 'member', memb = FALSE) } diff --git a/tests/testthat/test-Corr.R b/tests/testthat/test-Corr.R index 4a06f82..9d5d4a3 100644 --- a/tests/testthat/test-Corr.R +++ b/tests/testthat/test-Corr.R @@ -1,7 +1,7 @@ context("s2dv::Corr tests") ############################################## - # dat1 + # dat1: memb_dim is NULL set.seed(1) exp1 <- array(rnorm(240), dim = c(member = 1, dataset = 2, sdate = 5, ftime = 3, lat = 2, lon = 4)) @@ -13,6 +13,33 @@ context("s2dv::Corr tests") na <- floor(runif(10, min = 1, max = 120)) obs1[na] <- NA + # dat2: memb_dim = member + set.seed(1) + exp2 <- array(rnorm(180), dim = c(member = 3, dataset = 2, sdate = 5, + lat = 2, lon = 3)) + + set.seed(2) + obs2 <- array(rnorm(30), dim = c(member = 1, dataset = 1, sdate = 5, + lat = 2, lon = 3)) + + # dat3: memb_dim = member, obs has multiple memb + set.seed(1) + exp3 <- array(rnorm(180), dim = c(member = 3, dataset = 2, sdate = 5, + lat = 2, lon = 3)) + + set.seed(2) + obs3 <- array(rnorm(120), dim = c(member = 2, dataset = 2, sdate = 5, + lat = 2, lon = 3)) + + # dat4: exp and obs have dataset = 1 (to check the return array by small func) + set.seed(1) + exp4 <- array(rnorm(10), dim = c(member = 1, dataset = 1, sdate = 5, + lat = 2)) + + set.seed(2) + obs4 <- array(rnorm(10), dim = c(member = 1, dataset = 1, sdate = 5, + lat = 2)) + ############################################## test_that("1. Input checks", { @@ -79,6 +106,18 @@ test_that("1. Input checks", { "Parameter 'method' must be one of 'kendall', 'spearman' or 'pearson'." ) expect_error( + Corr(exp1, obs1, memb_dim = 1), + "Parameter 'memb_dim' must be a character string." + ) + expect_error( + Corr(exp1, obs1, memb_dim = 'memb'), + "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." + ) + expect_error( + Corr(exp2, obs2, memb_dim = 'member', memb = 1), + "Parameter 'memb' must be one logical value." + ) + expect_error( Corr(exp1, obs1, conf = 1), "Parameter 'conf' must be one logical value." ) @@ -105,61 +144,252 @@ test_that("1. Input checks", { ############################################## test_that("2. Output checks: dat1", { - +suppressWarnings( expect_equal( dim(Corr(exp1, obs1)$corr), c(nexp = 2, nobs = 1, member = 1, ftime = 3, lat = 2, lon = 4) ) +) +suppressWarnings( expect_equal( Corr(exp1, obs1)$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))), 2 ) +) +suppressWarnings( expect_equal( max(Corr(exp1, obs1)$conf.lower, na.rm = T), 0.6332941, tolerance = 0.001 ) +) +suppressWarnings( expect_equal( length(which(is.na(Corr(exp1, obs1, comp_dim = 'ftime')$corr))), 6 ) +) +suppressWarnings( expect_equal( length(which(is.na(Corr(exp1, obs1, comp_dim = 'ftime', limits = c(2, 3))$corr))), 2 ) +) +suppressWarnings( expect_equal( min(Corr(exp1, obs1, conf.lev = 0.99)$conf.upper, na.rm = TRUE), 0.2747904, tolerance = 0.0001 ) +) +suppressWarnings( expect_equal( length(Corr(exp1, obs1, conf = FALSE, pval = FALSE)), 1 ) +) +suppressWarnings( expect_equal( length(Corr(exp1, obs1, conf = FALSE)), 2 ) +) +suppressWarnings( expect_equal( length(Corr(exp1, obs1, pval = FALSE)), 3 ) +) +suppressWarnings( expect_equal( Corr(exp1, obs1, method = 'spearman')$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), c(0.0, 0.5), tolerance = 0.001 ) +) }) ############################################## +test_that("3. Output checks: dat2", { + # individual member + expect_equal( + dim(Corr(exp2, obs2, memb_dim = 'member')$corr), + c(nexp = 2, nobs = 1, exp_memb = 3, obs_memb = 1, lat = 2, lon = 3) + ) + expect_equal( + names(Corr(exp2, obs2, memb_dim = 'member')), + c("corr", "p.val", "conf.lower", "conf.upper") + ) + expect_equal( + names(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)), + c("corr") + ) + expect_equal( + names(Corr(exp2, obs2, memb_dim = 'member', conf = FALSE)), + c("corr", "p.val") + ) + expect_equal( + names(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE)), + c("corr", "conf.lower", "conf.upper") + ) + expect_equal( + mean(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + 0.01645575, + tolerance = 0.0001 + ) + expect_equal( + median(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + 0.03024513, + tolerance = 0.0001 + ) + expect_equal( + max(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + 0.9327993, + tolerance = 0.0001 + ) + expect_equal( + min(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + -0.9361258, + tolerance = 0.0001 + ) + expect_equal( + Corr(exp2, obs2, memb_dim = 'member', conf = FALSE)$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], + c(-0.9500121, -0.9547642, -0.9883400, -0.8817478, -0.6879465), + tolerance = 0.0001 + ) + # ensemble mean + expect_equal( + dim(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE)$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), + 0.02939929, + tolerance = 0.0001 + ) + expect_equal( + median(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), + 0.03147432, + tolerance = 0.0001 + ) + expect_equal( + max(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), + 0.8048901, + tolerance = 0.0001 + ) + expect_equal( + min(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), + -0.6839388, + tolerance = 0.0001 + ) + expect_equal( + Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, conf = FALSE)$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], + c(-0.9582891, -0.7668065, -0.9316879, -0.9410621, -0.5659657), + tolerance = 0.0001 + ) + +}) +############################################## +test_that("4. Output checks: dat3", { + # individual member + expect_equal( + dim(Corr(exp3, obs3, memb_dim = 'member')$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')), + c("corr", "p.val", "conf.lower", "conf.upper") + ) + expect_equal( + mean(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + 0.006468017, + tolerance = 0.0001 + ) + expect_equal( + median(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + 0.03662394, + tolerance = 0.0001 + ) + expect_equal( + max(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + 0.9798228, + tolerance = 0.0001 + ) + expect_equal( + min(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), + -0.9464891, + tolerance = 0.0001 + ) + + # ensemble mean + expect_equal( + dim(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE)$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), + -0.01001896, + tolerance = 0.0001 + ) + expect_equal( + median(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), + -0.01895816, + tolerance = 0.0001 + ) + expect_equal( + max(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), + 0.798233, + tolerance = 0.0001 + ) + expect_equal( + min(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), + -0.6464809, + tolerance = 0.0001 + ) +}) + +############################################## +test_that("5. Output checks: dat4", { + # no member + expect_equal( + dim(Corr(exp4, obs4)$corr), + c(nexp = 1, nobs = 1, member = 1, lat = 2) + ) + # individual member + expect_equal( + dim(Corr(exp4, obs4, memb_dim = 'member')$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), + c(nexp = 1, nobs = 1, lat = 2) + ) + +}) +############################################## -- GitLab From 47738b085004ea8a785b33b4db3d300e85eebe8a Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 1 Dec 2020 10:46:19 +0100 Subject: [PATCH 003/154] Transform ACC. Create unit test --- NAMESPACE | 3 + R/ACC.R | 509 ++++++++++++++++++++++++++++++++++++++ man/ACC.Rd | 143 +++++++++++ tests/testthat/test-ACC.R | 197 +++++++++++++++ 4 files changed, 852 insertions(+) create mode 100644 R/ACC.R create mode 100644 man/ACC.Rd create mode 100644 tests/testthat/test-ACC.R diff --git a/NAMESPACE b/NAMESPACE index 6da8d0c..3052213 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(ACC) export(AMV) export(AnimateMap) export(Ano) @@ -91,6 +92,8 @@ importFrom(stats,pf) importFrom(stats,pt) importFrom(stats,qchisq) importFrom(stats,qnorm) +importFrom(stats,qt) +importFrom(stats,quantile) importFrom(stats,rnorm) importFrom(stats,sd) importFrom(stats,ts) diff --git a/R/ACC.R b/R/ACC.R new file mode 100644 index 0000000..1992090 --- /dev/null +++ b/R/ACC.R @@ -0,0 +1,509 @@ +#'Compute the anomaly correlation coefficient between the forecast and corresponding observation +#' +#'Calculate the anomaly correlation coefficient for the ensemble mean of each +#'model and the corresponding references over a spatial domain. It can return a +#'forecast time series if the data contain forest time dimension, and also the +#'start date mean if the data contain start date dimension. +#'The domain of interest can be specified by providing the list +#'of longitudes/latitudes (lon/lat) of the data together with the corners +#'of the domain: lonlatbox = c(lonmin, lonmax, latmin, latmax). +#' +#'@param exp A numeric array of experimental anomalies with named dimensions. +#' It must have at least 'dat_dim' and 'space_dim'. +#'@param obs A numeric array of observational anomalies with named dimensions. +#' It must have the same dimensions 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'. +#'@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'). +#'@param avg_dim A character string indicating the name of the dimension to be +#' dimension. It must be one of 'time_dim'. The mean ACC is calculated along +#' averaged. If no need to calculate mean ACC, set as NULL. The default value +#' is 'sdate'. +#'@param memb_dim A character string indicating the name of the member +#' dimension. If the data are not ensemble ones, set as NULL. The default +#' value is 'member'. +#'@param lat A vector of the longitudes of the exp/obs grids. Only required when +#' the domain of interested is specified. The default value is NULL. +#'@param lon A vector of the latitudes of the exp/obs grids. Only required when +#' the domain of interested is specified. The default value is NULL. +#'@param lonlatbox A numeric vector of 4 indicating the corners of the domain of +#' interested: c(lonmin, lonmax, latmin, latmax). Only required when the domain +#' of interested is specified. The default value is NULL. +#'@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". +#' "parametric" provides a confidence interval for the ACC computed by a +#' Fisher transformation and a significance level for the ACC from a one-sided +#' student-T distribution. "bootstrap" provides a confidence interval for the +#' ACC and MACC computed from bootstrapping on the members with 100 drawings +#' with replacement. To guarantee the statistical robustness of the result, +#' 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. +#' +#'@return +#'A list containing the numeric arrays:\cr +#'\item{ACC}{ +#' The ACC with the dimensions c(nexp, nobs, the rest of the dimension except +#' space_dim). 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). +#'} +#'\item{conf.lower}{ +#' The lower confidence interval with the same dimensions as ACC. Only present +#' if \code{conf = TRUE}. +#'} +#'\item{conf.upper}{ +#' The upper confidence interval with the same dimensions as ACC. Only present +#' if \code{conf = TRUE}. +#'} +#'\item{p.val}{ +#' The p-value with the same dimensions as ACC. Only present if +#'\code{pval = TRUE}. +#'} +#'\item{MACC}{ +#' The mean anomaly correlation coefficient with dimensions +#' c(nexp, nobs, the rest of the dimension except space_dim and avg_dim). Only +#' present if 'avg_dim' is not NULL. +#'} +#' +#'@examples +#'# See ?Load for explanations on the first part of this example. +#' \dontrun{ +#'data_path <- system.file('sample_data', package = 's2dverification') +#'expA <- list(name = 'experiment', path = file.path(data_path, +#' 'model/$EXP_NAME$/$STORE_FREQ$_mean/$VAR_NAME$_3hourly', +#' '$VAR_NAME$_$START_DATE$.nc')) +#'obsX <- list(name = 'observation', path = file.path(data_path, +#' '$OBS_NAME$/$STORE_FREQ$_mean/$VAR_NAME$', +#' '$VAR_NAME$_$YEAR$$MONTH$.nc')) +#' +#'# Now we are ready to use Load(). +#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +#'sampleData <- Load('tos', list(expA), list(obsX), startDates, +#' leadtimemin = 1, leadtimemax = 4, output = 'lonlat', +#' latmin = 27, latmax = 48, lonmin = -12, lonmax = 40) +#' } +#' \dontshow{ +#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), +#' c('observation'), startDates, +#' leadtimemin = 1, +#' leadtimemax = 4, +#' output = 'lonlat', +#' latmin = 27, latmax = 48, +#' lonmin = -12, lonmax = 40) +#' } +#'sampleData$mod <- Season(sampleData$mod, 4, 11, 12, 2) +#'sampleData$obs <- Season(sampleData$obs, 4, 11, 12, 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(Mean1Dim(ano_exp, 2), Mean1Dim(ano_obs, 2)) +#' \donttest{ +#'PlotACC(acc$ACC, startDates) +#' } +#'@references Joliffe and Stephenson (2012). Forecast Verification: A +#' Practitioner's Guide in Atmospheric Science. Wiley-Blackwell. +#'@import multiApply +#'@importFrom abind abind +#'@importFrom stats qt qnorm quantile +#'@importFrom ClimProjDiags Subset +#'@export +ACC <- function(exp, obs, dat_dim = 'dataset', 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, + 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))) { + stop(paste0("Parameter 'exp' and 'obs' must have at least dimensions ", + "dat_dim and space_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)) { + 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.character(dat_dim) | length(dat_dim) > 1) { + stop("Parameter 'dat_dim' must be a character string.") + } + 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.") + } + ## space_dim + if (!is.character(space_dim) | length(space_dim) != 2) { + stop("Parameter 'space_dim' must be a character vector of 2.") + } + if (any(!space_dim %in% names(dim(exp))) | any(!space_dim %in% names(dim(obs)))) { + stop("Parameter 'space_dim' is not found in 'exp' or 'obs' dimension.") + } + ## avg_dim + if (!is.null(avg_dim)) { + if (!is.character(avg_dim) | length(avg_dim) > 1) { + stop("Parameter 'avg_dim' must be a character string.") + } + if (!avg_dim %in% names(dim(exp)) | !avg_dim %in% names(dim(obs))) { + stop("Parameter 'avg_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)) | !memb_dim %in% names(dim(obs))) { + stop("Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension.") + } + } + ## lat + if (!is.null(lat)) { + if (!is.numeric(lat) | length(lat) != dim(exp)[space_dim[1]]) { + stop(paste0("Parameter 'lat' must be a numeric vector with the same ", + "length as the latitude dimension of 'exp' and 'obs'.")) + } + } + ## lon + if (!is.null(lon)) { + if (!is.numeric(lon) | length(lon) != dim(exp)[space_dim[2]]) { + stop(paste0("Parameter 'lon' must be a numeric vector with the same ", + "length as the longitude dimension of 'exp' and 'obs'.")) + } + } + ## lonlatbox + if (!is.null(lonlatbox)) { + if (!is.numeric(lonlatbox) | length(lonlatbox) != 4) { + stop("Parameter 'lonlatbox' must be a numeric vector of 4.") + } + } + ## lat, lon, and lonlatbox + if (!is.null(lon) & !is.null(lat) & !is.null(lonlatbox)) { + select_lonlat <- TRUE + } else if (is.null(lon) & is.null(lat) & is.null(lonlatbox)) { + select_lonlat <- FALSE + } else { + stop(paste0("Parameters 'lon', 'lat', and 'lonlatbox' must be used or be ", + "NULL at the same time.")) + } + ## conf + if (!is.logical(conf) | length(conf) > 1) { + stop("Parameter 'conf' must be one logical value.") + } + if (conf) { + ## conftype + if (!conftype %in% c('parametric', 'bootstrap')) { + stop("Parameter 'conftype' must be either 'parametric' or 'bootstrap'.") + } + 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) | 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.") + } + ## 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))) + name_exp <- name_exp[-which(name_exp == dat_dim)] + name_obs <- name_obs[-which(name_obs == dat_dim)] + if (!is.null(memb_dim)) { + 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])) { + stop(paste0("Parameter 'exp' and 'obs' must have same length of ", + "all the dimensions expect 'dat_dim' and 'memb_dim'.")) + } + +#----------------------------------------------------------------- + + + ############################### + # Sort dimension + name_exp <- names(dim(exp)) + name_obs <- names(dim(obs)) + order_obs <- match(name_exp, name_obs) + obs <- Reorder(obs, order_obs) + ############################### + + # Select the domain + if (select_lonlat) { + for (jind in 1:2) { + while (lonlatbox[jind] < 0) { + lonlatbox[jind] <- lonlatbox[jind] + 360 + } + while (lonlatbox[jind] > 360) { + lonlatbox[jind] <- lonlatbox[jind] - 360 + } + } + indlon <- which((lon >= lonlatbox[1] & lon <= lonlatbox[2]) | + (lonlatbox[1] > lonlatbox[2] & (lon > lonlatbox[1] | lon < lonlatbox[2]))) + indlat <- which(lat >= lonlatbox[3] & lat <= lonlatbox[4]) + + exp <- ClimProjDiags::Subset(exp, space_dim, list(indlat, indlon), drop = FALSE) + obs <- ClimProjDiags::Subset(obs, space_dim, list(indlat, indlon), drop = FALSE) + } + + # Ensemble mean + if (!is.null(memb_dim)) { + exp <- MeanDims(exp, memb_dim, na.rm = TRUE) + obs <- MeanDims(obs, memb_dim, na.rm = TRUE) + } + + if (is.null(avg_dim)) { + res <- Apply(list(exp, obs), + target_dims = list(c(space_dim, dat_dim), + c(space_dim, dat_dim)), + fun = .ACC, + dat_dim = dat_dim, + #space_dim = space_dim, + avg_dim = avg_dim, + conftype = conftype, + pval = pval, conf = conf, conf.lev = conf.lev, + ncores = ncores) + } else { + res <- Apply(list(exp, obs), + target_dims = list(c(space_dim, avg_dim, dat_dim), + c(space_dim, avg_dim, dat_dim)), + fun = .ACC, + dat_dim = dat_dim, + #space_dim = space_dim, + avg_dim = avg_dim, + conftype = conftype, + pval = pval, conf = conf, conf.lev = conf.lev, + ncores = ncores) + } + + return(res) +} + +.ACC <- function(exp, obs, dat_dim = 'dataset', #space_dim = c('lat', 'lon'), + avg_dim = 'sdate', #memb_dim = NULL, + lon = NULL, lat = NULL, lonlatbox = NULL, + conf = TRUE, conftype = "parametric", conf.lev = 0.95, pval = TRUE) { + +# if (is.null(avg_dim)) + # exp: [space_dim, dat_exp] + # obs: [space_dim, dat_obs] +# if (!is.null(avg_dim)) + # exp: [space_dim, avg_dim, dat_exp] + # obs: [space_dim, avg_dim, dat_obs] + + # .ACC() should use all the spatial points to calculate ACC. It returns [nexp, nobs]. + + nexp <- as.numeric(dim(exp)[length(dim(exp))]) + nobs <- as.numeric(dim(obs)[length(dim(obs))]) + + if (is.null(avg_dim)) { + acc <- array(dim = c(nexp = nexp, nobs = nobs)) + p.val <- array(dim = c(nexp = nexp, nobs = nobs)) + conf.upper <- array(dim = c(nexp = nexp, nobs = nobs)) + conf.lower <- array(dim = c(nexp = nexp, nobs = nobs)) + } else { + acc <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[length(dim(exp)) - 1])) + names(dim(acc))[3] <- avg_dim + macc <- array(dim = c(nexp = nexp, nobs = nobs)) + p.val <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[length(dim(exp)) - 1])) + conf.upper <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[length(dim(exp)) - 1])) + conf.lower <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[length(dim(exp)) - 1])) + } + + # Per-paired exp and obs. NAs should be in the same position in both exp and obs + for (iobs in 1:nobs) { + for (iexp in 1:nexp) { + exp_sub <- ClimProjDiags::Subset(exp, dat_dim, iexp, drop = 'selected') + obs_sub <- ClimProjDiags::Subset(obs, dat_dim, iobs, drop = 'selected') + # dim: [space_dim] + + # Variance(iexp) should not take into account any point + # that is not available in iobs and therefore not accounted for + # in covariance(iexp, iobs) and vice-versa + exp_sub[is.na(obs_sub)] <- NA + obs_sub[is.na(exp_sub)] <- NA + + if (is.null(avg_dim)) { + # ACC + top <- sum(exp_sub*obs_sub, na.rm = TRUE) #a number + bottom <- sqrt(sum(exp_sub^2, na.rm = TRUE) * sum(obs_sub^2, na.rm = TRUE)) + acc[iexp, iobs] <- top/bottom #a number + # handle bottom = 0 + if (is.infinite(acc[iexp, iobs])) acc[iexp, iobs] <- NA + # pval and conf + if (pval | conf) { + if (conftype == "parametric") { + # calculate effective sample size along space_dim + # combine space_dim into one dim first + obs_tmp <- array(obs_sub, dim = c(space = length(obs_sub))) + eno <- Eno(obs_tmp, 'space') # a number + if (pval) { + t <- qt(conf.lev, eno - 2) # a number + p.val[iexp, iobs] <- sqrt(t^2 / (t^2 + eno - 2)) + } + 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)) + } + } + } + + } else { #avg_dim is not NULL + + # MACC + top <- sum(exp_sub*obs_sub, na.rm = TRUE) #a number + bottom <- sqrt(sum(exp_sub^2, na.rm = TRUE) * sum(obs_sub^2, na.rm = TRUE)) + macc[iexp, iobs] <- top/bottom #a number + # handle bottom = 0 + if (is.infinite(macc[iexp, iobs])) macc[iexp, iobs] <- NA + # ACC + for (i in 1:dim(acc)[3]) { #NOTE: use sapply!!! + exp_sub_i <- ClimProjDiags::Subset(exp_sub, avg_dim, i, drop = 'selected') + obs_sub_i <- ClimProjDiags::Subset(obs_sub, avg_dim, i, drop = 'selected') + #dim: [space_dim] + top <- sum(exp_sub_i*obs_sub_i, na.rm = TRUE) #a number + bottom <- sqrt(sum(exp_sub_i^2, na.rm = TRUE) * sum(obs_sub_i^2, na.rm = TRUE)) + acc[iexp, iobs, i] <- top/bottom #a number + # handle bottom = 0 + if (is.infinite(acc[iexp, iobs, i])) acc[iexp, iobs, i] <- NA + } + + # pval and conf + if (pval | conf) { + if (conftype == "parametric") { + # calculate effective sample size along space_dim + # combine space_dim into one dim first + obs_tmp <- array(obs_sub, dim = c(space = prod(dim(obs_sub)[-length(dim(obs_sub))]), + dim(obs_sub)[length(dim(obs_sub))])) + eno <- Eno(obs_tmp, 'space') # 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 (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)) + } + } + } + + } # if avg_dim is not NULL + + } + } + +#------------------------------------------------ + + if (conf == TRUE & conftype == "bootstrap") { + ndraw <- 100 + #create the matrix to store the random values + ACC_draw = array(dim=c(nexp,nobs,nsdates,nltimes,ndraw)) + MACC_draw = array(dim=c(nexp,nobs,nltimes,ndraw)) + + #put the member dimension first + exp <- aperm(exp, c(2, 1, 3, 4, 5, 6)) + obs <- aperm(obs, c(2, 1, 3, 4, 5, 6)) + + for (jdraw in 1:ndraw) { + + #choose a randomly member index for each point of the matrix + indexp <- array(sample(nmembexp, size = (nexp*nmembexp*nsdates*nltimes), + replace = TRUE), dim = c(nmembexp, nexp, nsdates, nltimes, + length(indlat), length(indlon)) ) + indobs <- array(sample(nmembobs, size = (nobs*nmembobs*nsdates*nltimes), + replace = TRUE), dim = c(nmembobs, nobs, nsdates, nltimes, + length(indlat), length(indlon)) ) + + #combine maxtrix of data and random index + varindexp <- abind(exp, indexp, along = 7 ) + varindobs <- abind(obs, indobs, along = 7 ) + + #select randomly the members for each point of the matrix + varexpdraw <- aperm( array( + apply( varindexp, c(2, 3, 4, 5, 6), function(x) x[,1][x[,2]] ), + dim = c(nmembexp, nexp, nsdates, nltimes, + length(indlat), length(indlon))), + c(2, 1, 3, 4, 5, 6)) + varobsdraw <- aperm( array( + apply( varindobs, c(2, 3, 4, 5, 6), function(x) x[,1][x[,2]] ), + dim = c(nmembobs, nobs, nsdates, nltimes, + length(indlat), length(indlon))), + c(2, 1, 3, 4, 5, 6)) + + #calculate the ACC of the randomized field + tmpACC <- ACC(varexpdraw, varobsdraw, conf = FALSE) + ACC_draw[,,,,jdraw] <- tmpACC$ACC + MACC_draw[,,,jdraw] <- tmpACC$MACC + } + + #calculate the confidence interval + ACC[ , , , , 3] <- apply(ACC_draw, c(1, 2, 3, 4), function(x) + quantile(x, 1 - (1 - siglev) / 2, na.rm = TRUE)) + ACC[ , , , , 1] <- apply(ACC_draw, c(1, 2, 3, 4), function(x) + quantile(x, (1 - siglev) / 2, na.rm = TRUE)) + + MACC <- InsertDim(MACC, 4, 3) + MACC[ , , , 3] <- apply(MACC_draw, c(1, 2, 3), function(x) + quantile(x, 1 - (1 - siglev) / 2, na.rm = TRUE)) + MACC[ , , , 1] <- apply(MACC_draw, c(1, 2, 3), function(x) + quantile(x, (1 - siglev) / 2, na.rm = TRUE)) + } # bootstrap + + + 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)) + } + } 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)) + } + } + +} diff --git a/man/ACC.Rd b/man/ACC.Rd new file mode 100644 index 0000000..fc4f849 --- /dev/null +++ b/man/ACC.Rd @@ -0,0 +1,143 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ACC.R +\name{ACC} +\alias{ACC} +\title{Compute the anomaly correlation coefficient between the forecast and corresponding observation} +\usage{ +ACC(exp, obs, dat_dim = "dataset", 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, ncores = NULL) +} +\arguments{ +\item{exp}{A numeric array of experimental anomalies with named dimensions. +It must have at least 'dat_dim' and 'space_dim'.} + +\item{obs}{A numeric array of observational anomalies with named dimensions. +It must have the same dimensions 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'.} + +\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').} + +\item{avg_dim}{A character string indicating the name of the dimension to be +dimension. It must be one of 'time_dim'. The mean ACC is calculated along +averaged. If no need to calculate mean ACC, set as NULL. The default value +is 'sdate'.} + +\item{memb_dim}{A character string indicating the name of the member +dimension. If the data are not ensemble ones, set as NULL. The default +value is 'member'.} + +\item{lat}{A vector of the longitudes of the exp/obs grids. Only required when +the domain of interested is specified. The default value is NULL.} + +\item{lon}{A vector of the latitudes of the exp/obs grids. Only required when +the domain of interested is specified. The default value is NULL.} + +\item{lonlatbox}{A numeric vector of 4 indicating the corners of the domain of +interested: c(lonmin, lonmax, latmin, latmax). Only required when the domain +of interested is specified. The default value is NULL.} + +\item{conf}{A logical value indicating whether to retrieve the confidence +intervals or not. The default value is TRUE.} + +\item{conftype}{A charater string of "parametric" or "bootstrap". +"parametric" provides a confidence interval for the ACC computed by a +Fisher transformation and a significance level for the ACC from a one-sided +student-T distribution. "bootstrap" provides a confidence interval for the +ACC and MACC computed from bootstrapping on the members with 100 drawings +with replacement. To guarantee the statistical robustness of the result, +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.} +} +\value{ +A list containing the numeric arrays:\cr +\item{ACC}{ + The ACC with the dimensions c(nexp, nobs, the rest of the dimension except + space_dim). 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). +} +\item{conf.lower}{ + The lower confidence interval with the same dimensions as ACC. Only present + if \code{conf = TRUE}. +} +\item{conf.upper}{ + The upper confidence interval with the same dimensions as ACC. Only present + if \code{conf = TRUE}. +} +\item{p.val}{ + The p-value with the same dimensions as ACC. Only present if +\code{pval = TRUE}. +} +\item{MACC}{ + The mean anomaly correlation coefficient with dimensions + c(nexp, nobs, the rest of the dimension except space_dim and avg_dim). Only + present if 'avg_dim' is not NULL. +} +} +\description{ +Calculate the anomaly correlation coefficient for the ensemble mean of each +model and the corresponding references over a spatial domain. It can return a +forecast time series if the data contain forest time dimension, and also the +start date mean if the data contain start date dimension. +The domain of interest can be specified by providing the list +of longitudes/latitudes (lon/lat) of the data together with the corners +of the domain: lonlatbox = c(lonmin, lonmax, latmin, latmax). +} +\examples{ +# See ?Load for explanations on the first part of this example. + \dontrun{ +data_path <- system.file('sample_data', package = 's2dverification') +expA <- list(name = 'experiment', path = file.path(data_path, + 'model/$EXP_NAME$/$STORE_FREQ$_mean/$VAR_NAME$_3hourly', + '$VAR_NAME$_$START_DATE$.nc')) +obsX <- list(name = 'observation', path = file.path(data_path, + '$OBS_NAME$/$STORE_FREQ$_mean/$VAR_NAME$', + '$VAR_NAME$_$YEAR$$MONTH$.nc')) + +# Now we are ready to use Load(). +startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +sampleData <- Load('tos', list(expA), list(obsX), startDates, + leadtimemin = 1, leadtimemax = 4, output = 'lonlat', + latmin = 27, latmax = 48, lonmin = -12, lonmax = 40) + } + \dontshow{ +startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), + c('observation'), startDates, + leadtimemin = 1, + leadtimemax = 4, + output = 'lonlat', + latmin = 27, latmax = 48, + lonmin = -12, lonmax = 40) + } +sampleData$mod <- Season(sampleData$mod, 4, 11, 12, 2) +sampleData$obs <- Season(sampleData$obs, 4, 11, 12, 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(Mean1Dim(ano_exp, 2), Mean1Dim(ano_obs, 2)) + \donttest{ +PlotACC(acc$ACC, startDates) + } +} +\references{ +Joliffe and Stephenson (2012). Forecast Verification: A + Practitioner's Guide in Atmospheric Science. Wiley-Blackwell. +} + diff --git a/tests/testthat/test-ACC.R b/tests/testthat/test-ACC.R new file mode 100644 index 0000000..e5c99cb --- /dev/null +++ b/tests/testthat/test-ACC.R @@ -0,0 +1,197 @@ +context("s2dv::ACC tests") + +############################################## + # dat1 + set.seed(1) + exp1 <- array(rnorm(60), dim = c(dataset = 1, 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, + ftime = 1, lat = 2, lon = 3)) + # dat2 + set.seed(1) + exp2 <- array(rnorm(60), dim = c(dataset = 2, sdate = 5, + ftime = 1, lat = 2, lon = 3)) + set.seed(2) + obs2 <- array(rnorm(30), dim = c(dataset = 1, sdate = 5, + ftime = 1, lat = 2, lon = 3)) + set.seed(2) + na <- floor(runif(2, min = 1, max = 30)) + obs2[na] <- NA + +############################################## +test_that("1. Input checks", { + + expect_error( + ACC(c(), c()), + "Parameter 'exp' and 'obs' cannot be NULL." + ) + expect_error( + ACC(c('b'), c('a')), + "Parameter 'exp' and 'obs' must be a numeric array." + ) + expect_error( + ACC(c(1:10), c(2:4)), + paste0("Parameter 'exp' and 'obs' must have at least dimensions ", + "dat_dim and space_dim.") + ) + expect_error( + 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" + ) + expect_error( + ACC(exp1, obs1, dat_dim = 1), + "Parameter 'dat_dim' must be a character string." + ) + expect_error( + ACC(exp1, obs1, dat_dim = 'a'), + "Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension." + ) + expect_error( + ACC(exp1, obs1, space_dim = c('lon')), + "Parameter 'space_dim' must be a character vector of 2." + ) + expect_error( + ACC(exp1, obs1, space_dim = c('lon', 'lev')), + "Parameter 'space_dim' is not found in 'exp' or 'obs' dimension." + ) + expect_error( + ACC(exp1, obs1, avg_dim = 1), + "Parameter 'avg_dim' must be a character string." + ) + expect_error( + ACC(exp1, obs1, avg_dim = c('lev')), + "Parameter 'avg_dim' is not found in 'exp' or 'obs' dimension." + ) + expect_error( + ACC(exp1, obs1, memb_dim = TRUE), + "Parameter 'memb_dim' must be a character string." + ) + expect_error( + ACC(exp1, obs1, memb_dim = 'memb'), + "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." + ) + expect_error( + ACC(exp1, obs1, lat = c(1, 2, 3)), + paste0("Parameter \'lat\' must be a numeric vector with the same ", + "length as the latitude dimension of \'exp\' and \'obs\'.") + ) + expect_error( + ACC(exp1, obs1, lon = c(1, 3)), + paste0("Parameter \'lon\' must be a numeric vector with the same ", + "length as the longitude dimension of \'exp\' and \'obs\'.") + ) + expect_error( + ACC(exp1, obs1, lonlatbox = c(-90, 90)), + "Parameter 'lonlatbox' must be a numeric vector of 4." + ) + expect_error( + ACC(exp1, obs1, lat = c(1, 2), lon = c(1, 2, 3)), + paste0("Parameters 'lon', 'lat', and 'lonlatbox' must be used or be ", + "NULL at the same time.") + ) + expect_error( + ACC(exp1, obs1, conf = 1), + "Parameter 'conf' must be one logical value." + ) + expect_error( + ACC(exp1, obs1, conftype = 'a'), + "Parameter \'conftype\' must be either \'parametric\' or \'bootstrap\'." + ) + expect_error( + ACC(exp1, obs1, conftype = 'bootstrap'), + "Parameter 'memb_dim' cannot be NULL when parameter 'conftype' is 'bootstrap'." + ) + expect_error( + ACC(exp1, obs1, conf.lev = -1), + "Parameter 'conf.lev' must be a numeric number between 0 and 1." + ) + expect_error( + ACC(exp1, obs1, pval = 'TRUE'), + "Parameter 'pval' must be one logical value." + ) + expect_error( + ACC(exp1, obs1, ncores = 1.5), + "Parameter 'ncores' must be a positive integer." + ) + expect_error( + ACC(exp = array(1:10, dim = c(dataset = 5, member = 1, lat = 2, lon = 1)), + obs = array(1:4, dim = c(dataset = 2, member = 2, lat = 1, lon = 1)), + avg_dim = NULL), + "Parameter 'exp' and 'obs' must have same length of all the dimensions expect 'dat_dim' and 'memb_dim'." + ) + +}) + +############################################## +test_that("2. Output checks: dat1", { + + expect_equal( + dim(ACC(exp1, obs1)$acc), + c(nexp = 1, nobs = 1, sdate = 5, ftime = 1) + ) + expect_equal( + names(ACC(exp1, obs1)), + c("acc", "conf.lower", "conf.upper", "p.val", "macc") + ) + expect_equal( + mean(ACC(exp1, obs1)$acc), + -0.2001352, + tolerance = 0.00001 + ) + expect_equal( + as.vector(ACC(exp1, obs1)$p.val), + c(0.7292993, 0.7292993, 0.7292993, 0.7292993, 0.7292993), + tolerance = 0.00001 + ) + expect_equal( + as.vector(ACC(exp1, obs1)$conf.lower), + c(-0.8595534, -0.9644555, -0.9408508, -0.6887500, -0.7619374), + tolerance = 0.00001 + ) + expect_equal( + as.vector(ACC(exp1, obs1)$conf.upper), + c(0.7493799, 0.2515608, 0.4759707, 0.8890967, 0.8517117), + tolerance = 0.00001 + ) + expect_equal( + names(ACC(exp1, obs1, avg_dim = NULL)), + c("acc", "conf.lower", "conf.upper", "p.val") + ) + expect_equal( + dim(ACC(exp1, obs1, dat_dim = 'member', memb_dim = NULL)$acc), + c(nexp = 2, nobs = 1, sdate = 5, dataset = 1, ftime = 1) + ) + expect_equal( + names(ACC(exp1, obs1, conf = FALSE)), + c("acc", "p.val", "macc") + ) + expect_equal( + names(ACC(exp1, obs1, pval = FALSE)), + c("acc", "conf.lower", "conf.upper", "macc") + ) + expect_equal( + names(ACC(exp1, obs1, conf = FALSE, pval = FALSE)), + c("acc", "macc") + ) + expect_equal( + as.vector(ACC(exp1, obs1, conf = FALSE, avg_dim = NULL, conf.lev = 0.9)$p.val), + c(0.6083998, 0.6083998, 0.6083998, 0.6083998, 0.6083998), + tolerance = 0.00001 + ) + expect_equal( + mean(ACC(exp1, obs1, lat = c(10, 20), lon = c(20, 30, 40), lonlatbox = c(20, 30, 10, 20))$acc), + -0.1681097, + tolerance = 0.00001 + ) +}) + + + + + -- GitLab From eacd04eb5f990ade9197348dc1950b0921bf466a Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 1 Dec 2020 15:35:29 +0100 Subject: [PATCH 004/154] Add bootstrap method --- R/ACC.R | 230 ++++++++++++++++++++++++++++---------- tests/testthat/test-ACC.R | 2 +- 2 files changed, 172 insertions(+), 60 deletions(-) diff --git a/R/ACC.R b/R/ACC.R index 1992090..08a8850 100644 --- a/R/ACC.R +++ b/R/ACC.R @@ -278,6 +278,10 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), # Ensemble mean if (!is.null(memb_dim)) { + if (conftype == 'bootstrap') { + exp_ori <- exp + obs_ori <- obs + } exp <- MeanDims(exp, memb_dim, na.rm = TRUE) obs <- MeanDims(obs, memb_dim, na.rm = TRUE) } @@ -293,6 +297,25 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), conftype = conftype, pval = pval, conf = conf, conf.lev = conf.lev, ncores = ncores) + + if (conftype == 'bootstrap') { + res_conf <- Apply(list(exp_ori, obs_ori), + target_dims = list(c(memb_dim, dat_dim, space_dim), + c(memb_dim, dat_dim, space_dim)), + fun = .ACC_bootstrap, + dat_dim = dat_dim, memb_dim = memb_dim, + #space_dim = space_dim, + avg_dim = avg_dim, + conftype = conftype, + pval = pval, conf = conf, conf.lev = conf.lev, + ncores = ncores) + #NOTE: pval? + res <- list(acc = res$acc, + acc_conf.lower = res_conf$acc_conf.lower, acc_conf.upper = res_conf$acc_conf.upper, + macc = res$macc, + macc_conf.lower = res_conf$macc_conf.lower, macc_conf.upper = res_conf$macc_conf.upper) + } + } else { res <- Apply(list(exp, obs), target_dims = list(c(space_dim, avg_dim, dat_dim), @@ -304,6 +327,25 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), conftype = conftype, pval = pval, conf = conf, conf.lev = conf.lev, ncores = ncores) + + if (conftype == 'bootstrap') { + res_conf <- Apply(list(exp_ori, obs_ori), + target_dims = list(c(memb_dim, dat_dim, avg_dim, space_dim), + c(memb_dim, dat_dim, avg_dim, space_dim)), + fun = .ACC_bootstrap, + dat_dim = dat_dim, memb_dim = memb_dim, + #space_dim = space_dim, + avg_dim = avg_dim, + conftype = conftype, + pval = pval, conf = conf, conf.lev = conf.lev, + ncores = ncores) + res <- list(acc = res$acc, + acc_conf.lower = res_conf$acc_conf.lower, acc_conf.upper = res_conf$acc_conf.upper, + macc = res$macc, + macc_conf.lower = res_conf$macc_conf.lower, macc_conf.upper = res_conf$macc_conf.upper) + + } + } return(res) @@ -328,16 +370,30 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), if (is.null(avg_dim)) { acc <- array(dim = c(nexp = nexp, nobs = nobs)) - p.val <- array(dim = c(nexp = nexp, nobs = nobs)) - conf.upper <- array(dim = c(nexp = nexp, nobs = nobs)) - conf.lower <- array(dim = c(nexp = nexp, nobs = nobs)) + if (pval) p.val <- 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)) + if (conftype == 'bootstrap') { + ndraw <- 100 + acc_draw <- array(dim = c(nexp = nexp, nobs = nobs, ndraw)) + } + } + } else { acc <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[length(dim(exp)) - 1])) names(dim(acc))[3] <- avg_dim macc <- array(dim = c(nexp = nexp, nobs = nobs)) - p.val <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[length(dim(exp)) - 1])) + if (pval) p.val <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[length(dim(exp)) - 1])) + if (conf) { conf.upper <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[length(dim(exp)) - 1])) conf.lower <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[length(dim(exp)) - 1])) + if (conftype == 'bootstrap') { + ndraw <- 100 + acc_draw <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[length(dim(exp)) - 1], ndraw)) + macc_draw <- array(dim = c(nexp = nexp, nobs = nobs, ndraw)) + } + } } # Per-paired exp and obs. NAs should be in the same position in both exp and obs @@ -379,7 +435,6 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), } } else { #avg_dim is not NULL - # MACC top <- sum(exp_sub*obs_sub, na.rm = TRUE) #a number bottom <- sqrt(sum(exp_sub^2, na.rm = TRUE) * sum(obs_sub^2, na.rm = TRUE)) @@ -424,62 +479,9 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), #------------------------------------------------ - if (conf == TRUE & conftype == "bootstrap") { - ndraw <- 100 - #create the matrix to store the random values - ACC_draw = array(dim=c(nexp,nobs,nsdates,nltimes,ndraw)) - MACC_draw = array(dim=c(nexp,nobs,nltimes,ndraw)) - - #put the member dimension first - exp <- aperm(exp, c(2, 1, 3, 4, 5, 6)) - obs <- aperm(obs, c(2, 1, 3, 4, 5, 6)) - - for (jdraw in 1:ndraw) { - - #choose a randomly member index for each point of the matrix - indexp <- array(sample(nmembexp, size = (nexp*nmembexp*nsdates*nltimes), - replace = TRUE), dim = c(nmembexp, nexp, nsdates, nltimes, - length(indlat), length(indlon)) ) - indobs <- array(sample(nmembobs, size = (nobs*nmembobs*nsdates*nltimes), - replace = TRUE), dim = c(nmembobs, nobs, nsdates, nltimes, - length(indlat), length(indlon)) ) - - #combine maxtrix of data and random index - varindexp <- abind(exp, indexp, along = 7 ) - varindobs <- abind(obs, indobs, along = 7 ) - - #select randomly the members for each point of the matrix - varexpdraw <- aperm( array( - apply( varindexp, c(2, 3, 4, 5, 6), function(x) x[,1][x[,2]] ), - dim = c(nmembexp, nexp, nsdates, nltimes, - length(indlat), length(indlon))), - c(2, 1, 3, 4, 5, 6)) - varobsdraw <- aperm( array( - apply( varindobs, c(2, 3, 4, 5, 6), function(x) x[,1][x[,2]] ), - dim = c(nmembobs, nobs, nsdates, nltimes, - length(indlat), length(indlon))), - c(2, 1, 3, 4, 5, 6)) - - #calculate the ACC of the randomized field - tmpACC <- ACC(varexpdraw, varobsdraw, conf = FALSE) - ACC_draw[,,,,jdraw] <- tmpACC$ACC - MACC_draw[,,,jdraw] <- tmpACC$MACC - } - - #calculate the confidence interval - ACC[ , , , , 3] <- apply(ACC_draw, c(1, 2, 3, 4), function(x) - quantile(x, 1 - (1 - siglev) / 2, na.rm = TRUE)) - ACC[ , , , , 1] <- apply(ACC_draw, c(1, 2, 3, 4), function(x) - quantile(x, (1 - siglev) / 2, na.rm = TRUE)) - - MACC <- InsertDim(MACC, 4, 3) - MACC[ , , , 3] <- apply(MACC_draw, c(1, 2, 3), function(x) - quantile(x, 1 - (1 - siglev) / 2, na.rm = TRUE)) - MACC[ , , , 1] <- apply(MACC_draw, c(1, 2, 3), function(x) - quantile(x, (1 - siglev) / 2, na.rm = TRUE)) - } # bootstrap + # Return output if (is.null(avg_dim)) { if (conf & pval) { return(list(acc = acc, conf.lower = conf.lower, conf.upper = conf.upper, @@ -507,3 +509,113 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), } } + + +.ACC_bootstrap <- function(exp, obs, dat_dim = 'dataset', #space_dim = c('lat', 'lon'), + avg_dim = 'sdate', memb_dim = NULL, + lon = NULL, lat = NULL, lonlatbox = NULL, + conf = TRUE, conftype = "parametric", conf.lev = 0.95, pval = TRUE) { +# if (is.null(avg_dim)) + # exp: [memb_exp, dat_exp, space_dim] + # obs: [memb_obs, dat_obs, space_dim] +# if (!is.null(avg_dim)) + # exp: [memb_exp, dat_exp, avg_dim, space_dim] + # obs: [memb_obs, dat_obs, avg_dim, space_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]) + + ndraw <- 100 + if (is.null(avg_dim)) { + acc_draw <- array(dim = c(nexp = nexp, nobs = nobs, ndraw)) + } else { + acc_draw <- array(dim = c(nexp = nexp, nobs = nobs, dim(exp)[3], ndraw)) + macc_draw <- array(dim = c(nexp = nexp, nobs = nobs, ndraw)) + } + + for (jdraw in 1:ndraw) { + #choose a randomly member index for each point of the matrix + indexp <- array(sample(nmembexp, size = prod(dim(exp)[-c(length(dim(exp)) - 1, length(dim(exp)))]), + replace = TRUE), + dim = dim(exp)) + indobs <- array(sample(nmembobs, size = prod(dim(obs)[-c(length(dim(obs)) - 1, length(dim(obs)))]), + replace = TRUE), + dim = dim(obs)) + + #combine maxtrix of data and random index + varindexp <- abind::abind(exp, indexp, along = length(dim(exp)) + 1) + varindobs <- abind::abind(obs, indobs, along = length(dim(obs)) + 1) + + #select randomly the members for each point of the matrix +# if (is.null(avg_dim)) { + + drawexp <- array( + apply(varindexp, c(2:length(dim(exp))), function(x) x[,1][x[,2]] ), + dim = dim(exp)) + drawobs <- array( + apply(varindobs, c(2:length(dim(obs))), function(x) x[,1][x[,2]] ), + dim = dim(obs)) + + # ensemble mean before .ACC + drawexp <- MeanDims(drawexp, memb_dim, na.rm = TRUE) + drawobs <- MeanDims(drawobs, memb_dim, na.rm = TRUE) + # Reorder + if (is.null(avg_dim)) { + drawexp <- Reorder(drawexp, c(2, 3, 1)) + drawobs <- Reorder(drawobs, c(2, 3, 1)) + } else { + drawexp <- Reorder(drawexp, c(3, 4, 2, 1)) + drawobs <- Reorder(drawobs, c(3, 4, 2, 1)) + } + + #calculate the ACC of the randomized field + tmpACC <- .ACC(drawexp, drawobs, conf = FALSE, pval = FALSE, avg_dim = avg_dim) + if (is.null(avg_dim)) { + acc_draw[, , jdraw] <- tmpACC$acc + } else { + acc_draw[, , , jdraw] <- tmpACC$acc + macc_draw[, , jdraw] <- tmpACC$macc + } +if (jdraw == 1) print(acc_draw[1,1,1,1]) + } + + #calculate the confidence interval + if (is.null(avg_dim)) { + acc_conf.lower <- apply(acc_draw, c(1, 2), + function (x) { + quantile(x, 1 - (1 - conf.lev) / 2, na.rm = TRUE)}) + acc_conf.upper <- apply(acc_draw, c(1, 2), + function (x) { + quantile(x, (1 - conf.lev) / 2, na.rm = TRUE)}) + + } else { + acc_conf.lower <- apply(acc_draw, c(1, 2, 3), + function (x) { + quantile(x, 1 - (1 - conf.lev) / 2, na.rm = TRUE)}) + acc_conf.upper <- apply(acc_draw, c(1, 2, 3), + function (x) { + quantile(x, (1 - conf.lev) / 2, na.rm = TRUE)}) + macc_conf.lower <- apply(macc_draw, c(1, 2), + function (x) { + quantile(x, 1 - (1 - conf.lev) / 2, na.rm = TRUE)}) + macc_conf.upper <- apply(macc_draw, c(1, 2), + function (x) { + quantile(x, (1 - conf.lev) / 2, na.rm = TRUE)}) + } + + # Return output + if (is.null(avg_dim)) { + return(list(acc_conf.lower = acc_conf.lower, + acc_conf.upper = acc_conf.upper)) + } else { + return(list(acc_conf.lower = acc_conf.lower, + acc_conf.upper = acc_conf.upper, + macc_conf.lower = macc_conf.lower, + macc_conf.upper = macc_conf.upper)) + } + + + +} diff --git a/tests/testthat/test-ACC.R b/tests/testthat/test-ACC.R index e5c99cb..e348680 100644 --- a/tests/testthat/test-ACC.R +++ b/tests/testthat/test-ACC.R @@ -104,7 +104,7 @@ test_that("1. Input checks", { "Parameter \'conftype\' must be either \'parametric\' or \'bootstrap\'." ) expect_error( - ACC(exp1, obs1, conftype = 'bootstrap'), + ACC(exp1, obs1, memb_dim = NULL, conftype = 'bootstrap'), "Parameter 'memb_dim' cannot be NULL when parameter 'conftype' is 'bootstrap'." ) expect_error( -- GitLab From a89b2365e56c84c4745e5b54b8914cff3be077e0 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 1 Dec 2020 16:14:41 +0100 Subject: [PATCH 005/154] Revise example ACC --- R/ACC.R | 24 +++++------------------- man/ACC.Rd | 23 +++++------------------ 2 files changed, 10 insertions(+), 37 deletions(-) diff --git a/R/ACC.R b/R/ACC.R index 08a8850..a026445 100644 --- a/R/ACC.R +++ b/R/ACC.R @@ -76,22 +76,6 @@ #'} #' #'@examples -#'# See ?Load for explanations on the first part of this example. -#' \dontrun{ -#'data_path <- system.file('sample_data', package = 's2dverification') -#'expA <- list(name = 'experiment', path = file.path(data_path, -#' 'model/$EXP_NAME$/$STORE_FREQ$_mean/$VAR_NAME$_3hourly', -#' '$VAR_NAME$_$START_DATE$.nc')) -#'obsX <- list(name = 'observation', path = file.path(data_path, -#' '$OBS_NAME$/$STORE_FREQ$_mean/$VAR_NAME$', -#' '$VAR_NAME$_$YEAR$$MONTH$.nc')) -#' -#'# Now we are ready to use Load(). -#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') -#'sampleData <- Load('tos', list(expA), list(obsX), startDates, -#' leadtimemin = 1, leadtimemax = 4, output = 'lonlat', -#' latmin = 27, latmax = 48, lonmin = -12, lonmax = 40) -#' } #' \dontshow{ #'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') #'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), @@ -107,9 +91,12 @@ #'clim <- Clim(sampleData$mod, sampleData$obs) #'ano_exp <- Ano(sampleData$mod, clim$clim_exp) #'ano_obs <- Ano(sampleData$obs, clim$clim_obs) -#'acc <- ACC(Mean1Dim(ano_exp, 2), Mean1Dim(ano_obs, 2)) +#'acc <- ACC(ano_exp, ano_obs) +#'acc <- ACC(MeanDims(ano_exp, 2), MeanDims(ano_obs, 2), memb_dim = NULL) +#'# 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)) #' \donttest{ -#'PlotACC(acc$ACC, startDates) +#'PlotACC(res, startDates) #' } #'@references Joliffe and Stephenson (2012). Forecast Verification: A #' Practitioner's Guide in Atmospheric Science. Wiley-Blackwell. @@ -578,7 +565,6 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), acc_draw[, , , jdraw] <- tmpACC$acc macc_draw[, , jdraw] <- tmpACC$macc } -if (jdraw == 1) print(acc_draw[1,1,1,1]) } #calculate the confidence interval diff --git a/man/ACC.Rd b/man/ACC.Rd index fc4f849..d3eb680 100644 --- a/man/ACC.Rd +++ b/man/ACC.Rd @@ -100,22 +100,6 @@ of longitudes/latitudes (lon/lat) of the data together with the corners of the domain: lonlatbox = c(lonmin, lonmax, latmin, latmax). } \examples{ -# See ?Load for explanations on the first part of this example. - \dontrun{ -data_path <- system.file('sample_data', package = 's2dverification') -expA <- list(name = 'experiment', path = file.path(data_path, - 'model/$EXP_NAME$/$STORE_FREQ$_mean/$VAR_NAME$_3hourly', - '$VAR_NAME$_$START_DATE$.nc')) -obsX <- list(name = 'observation', path = file.path(data_path, - '$OBS_NAME$/$STORE_FREQ$_mean/$VAR_NAME$', - '$VAR_NAME$_$YEAR$$MONTH$.nc')) - -# Now we are ready to use Load(). -startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') -sampleData <- Load('tos', list(expA), list(obsX), startDates, - leadtimemin = 1, leadtimemax = 4, output = 'lonlat', - latmin = 27, latmax = 48, lonmin = -12, lonmax = 40) - } \dontshow{ startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), @@ -131,9 +115,12 @@ sampleData$obs <- Season(sampleData$obs, 4, 11, 12, 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(Mean1Dim(ano_exp, 2), Mean1Dim(ano_obs, 2)) +acc <- ACC(ano_exp, ano_obs) +acc <- ACC(MeanDims(ano_exp, 2), MeanDims(ano_obs, 2), memb_dim = NULL) +# 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)) \donttest{ -PlotACC(acc$ACC, startDates) +PlotACC(res, startDates) } } \references{ -- GitLab From f8a1e36877be68681cdcad50e28f4b55b0824fd0 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 1 Dec 2020 16:56:03 +0100 Subject: [PATCH 006/154] Correct ACC example --- R/ACC.R | 4 ++-- man/ACC.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/ACC.R b/R/ACC.R index a026445..e7891b0 100644 --- a/R/ACC.R +++ b/R/ACC.R @@ -86,8 +86,8 @@ #' latmin = 27, latmax = 48, #' lonmin = -12, lonmax = 40) #' } -#'sampleData$mod <- Season(sampleData$mod, 4, 11, 12, 2) -#'sampleData$obs <- Season(sampleData$obs, 4, 11, 12, 2) +#'sampleData$mod <- Season(sampleData$mod, monini = 11, moninf = 12, monsup = 2) +#'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) diff --git a/man/ACC.Rd b/man/ACC.Rd index d3eb680..a736c1a 100644 --- a/man/ACC.Rd +++ b/man/ACC.Rd @@ -110,8 +110,8 @@ sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), latmin = 27, latmax = 48, lonmin = -12, lonmax = 40) } -sampleData$mod <- Season(sampleData$mod, 4, 11, 12, 2) -sampleData$obs <- Season(sampleData$obs, 4, 11, 12, 2) +sampleData$mod <- Season(sampleData$mod, monini = 11, moninf = 12, monsup = 2) +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) -- GitLab From e785cbc3fc6219a0f3ee1a1515c4e8c3d7bd8363 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 1 Dec 2020 17:22:28 +0100 Subject: [PATCH 007/154] Add PlotACC --- NAMESPACE | 1 + R/PlotACC.R | 233 +++++++++++++++++++++++++++++++++++++++++++++++++ man/PlotACC.Rd | 105 ++++++++++++++++++++++ 3 files changed, 339 insertions(+) create mode 100644 R/PlotACC.R create mode 100644 man/PlotACC.Rd diff --git a/NAMESPACE b/NAMESPACE index 3052213..182ac41 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,6 +28,7 @@ export(LeapYear) export(Load) export(MeanDims) export(Persistence) +export(PlotACC) export(PlotAno) export(PlotClim) export(PlotEquiMap) diff --git a/R/PlotACC.R b/R/PlotACC.R new file mode 100644 index 0000000..7c915c7 --- /dev/null +++ b/R/PlotACC.R @@ -0,0 +1,233 @@ +#'Plot Plumes/Timeseries Of Anomaly Correlation Coefficients +#' +#'Plots plumes/timeseries of ACC from an array with dimensions +#'(output from \code{ACC()}): \cr +#'c(nexp, nobs, nsdates, nltime, 4)\cr +#'where the fourth dimension is of length 4 and contains the lower limit of +#'the 95\% confidence interval, the ACC, the upper limit of the 95\% +#'confidence interval and the 95\% significance level given by a one-sided +#'T-test. +#' +#'@param ACC An ACC array with with dimensions:\cr +#' c(nexp, nobs, nsdates, nltime, 4)\cr +#' with the fourth dimension of length 4 containing the lower limit of the +#' 95\% confidence interval, the ACC, the upper limit of the 95\% confidence +#' interval and the 95\% significance level. +#'@param sdates A character vector of startdates: c('YYYYMMDD','YYYYMMDD'). +#'@param toptitle A character string of the main title, optional. +#'@param sizetit A multiplicative factor to scale title size, optional. +#'@param ytitle A character string of the title of Y-axis for each experiment: +#' c('', ''), optional. +#'@param limits A numeric vector c(lower limit, upper limit): limits of the +#' Y-axis, optional. +#'@param legends A character vector of flags to be written in the legend, +#' optional. +#'@param freq A integer: 1 = yearly, 12 = monthly, 4 = seasonal, ... Default: 12. +#'@param biglab A logical value for presentation/paper plot, Default = FALSE. +#'@param fill A logical value if filled confidence interval. Default = FALSE. +#'@param linezero A logical value if a line at y=0 should be added. Default = FALSE. +#'@param points A logical value if points instead of lines. Default = TRUE.\cr +#' Must be TRUE if only 1 leadtime. +#'@param vlines A vector of x location where to add vertical black lines, optional. +#'@param fileout A character string of the output file name. Extensions allowed: +#' eps/ps, jpeg, png, pdf, bmp and tiff. Default is NULL. +#'@param width A numeric of the file width, in the units specified in the +#' parameter size_units (inches by default). Takes 8 by default. +#'@param height A numeric of the file height, in the units specified in the parameter +#' size_units (inches by default). Takes 5 by default. +#'@param size_units A character string of the units of the size of the device +#' (file or window) to plot in. Inches ('in') by default. See ?Devices and the +#' creator function of the corresponding device. +#'@param res Resolution of the device (file or window) to plot in. See +#' ?Devices and the creator function of the corresponding device. +#'@param \dots Arguments to be passed to the method. Only accepts the following +#' graphical parameters:\cr +#' adj ann ask bg bty cex.sub cin col.axis col.lab col.main col.sub cra crt +#' csi cxy err family fg fig fin font font.axis font.lab font.main font.sub +#' lend lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page +#' plt smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog\cr +#' For more information about the parameters see `par`. +#' +#'@examples +#' \dontshow{ +#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), +#' c('observation'), startDates, +#' leadtimemin = 1, +#' leadtimemax = 4, +#' output = 'lonlat', +#' latmin = 27, latmax = 48, +#' lonmin = -12, lonmax = 40) +#' } +#'sampleData$mod <- Season(sampleData$mod, monini = 11, moninf = 12, monsup = 2) +#'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) +#'acc <- ACC(MeanDims(ano_exp, 2), MeanDims(ano_obs, 2), memb_dim = NULL) +#'# 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)) +#' \donttest{ +#'PlotACC(res, startDates) +#' } +#'@importFrom grDevices dev.cur dev.new dev.off +#'@importFrom stats ts +#'@export +PlotACC <- function(ACC, sdates, toptitle = "", sizetit = 1, ytitle = "", + limits = NULL, legends = NULL, freq = 12, biglab = FALSE, + fill = FALSE, linezero = FALSE, points = TRUE, vlines = NULL, + fileout = NULL, + 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") + userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) + + # If there is any filenames to store the graphics, process them + # to select the right device + if (!is.null(fileout)) { + deviceInfo <- .SelectDevice(fileout = fileout, width = width, height = height, units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + # + if (length(dim(ACC)) != 5 | dim(ACC)[5] != 4) { + stop("5 dim needed : c(nexp, nobs, nsdates, nltime, 4)") + } + nexp <- dim(ACC)[1] + nobs <- dim(ACC)[2] + nleadtime <- dim(ACC)[4] + nsdates <- dim(ACC)[3] + if (is.null(limits) == TRUE) { + ll <- min(ACC, na.rm = TRUE) + ul <- max(ACC, na.rm = TRUE) + if (biglab) { + ul <- ul + 0.3 * (ul - ll) + } else { + ul <- ul + 0.2 * (ul - ll) + } + } else { + ll <- limits[1] + ul <- limits[2] + } + yearinit <- as.integer(substr(sdates[1], 1, 4)) + moninit <- as.integer(substr(sdates[1], 5, 6)) + lastyear <- as.integer(substr(sdates[nsdates], 1, 4)) + (moninit + ( + nleadtime - 1) * 12 / freq - 1) %/% 12 + lastmonth <- (moninit + (nleadtime - 1) * (12 / freq) - 1) %% 12 + 1 + empty_ts <- ts(start = c(yearinit, (moninit - 1) %/% (12 / freq) + 1), + end = c(lastyear, (lastmonth - 1) %/% (12 / freq) + 1), + frequency = freq) + color <- c("red4", "dodgerblue4", "lightgoldenrod4", "deeppink4", + "mediumpurple4", "green4", "orange4", "lightblue4", "mediumorchid4", + "olivedrab4") + colorblock <- c("red1", "dodgerblue1", "lightgoldenrod1", "deeppink1", + "mediumpurple1", "green1", "orange1", "lightblue1", + "mediumorchid1", "olivedrab1") + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, width = width, height = height) + } + + # Load the user parameters + par(userArgs) + + if (biglab) { + par(mai = c(1, 1.1, 0.5, 0), mgp = c(2.8, 0.9, 0)) + par(cex = 1.3, cex.lab = 2, cex.axis = 1.8) + cexmain <- 2.2 + legsize <- 1.5 + } else { + par(mai = c(0.8, 0.8, 0.5, 0.1), mgp = c(2, 0.5, 0)) + par(cex = 1.3, cex.lab = 1.5, cex.axis = 1.1) + cexmain <- 1.5 + legsize <- 1 + } + plot(empty_ts, ylim = c(ll, ul), xlab = "Time (years)", ylab = ytitle, + main = toptitle, cex.main = cexmain * sizetit) + for (jexp in 1:nexp) { + for (jobs in 1:nobs) { + numcol <- jobs + (jexp - 1) * nobs + for (jdate in 1:nsdates) { + year0 <- as.integer(substr(sdates[jdate], 1, 4)) + mon0 <- as.integer(substr(sdates[jdate], 5, 6)) + start <- (year0 - yearinit) * freq + 1 + end <- start + nleadtime - 1 + var <- array(dim = c(3, length(empty_ts))) + var[, start:end] <- t(ACC[jexp, jobs, jdate, , 1:3]) + if (fill) { + par(new = TRUE) + bordup <- ACC[jexp, jobs, jdate, , 3] + borddown <- ACC[jexp, jobs, jdate, , 1] + tmp <- c(start:end) + xout <- is.na(bordup + borddown) + tmp <- tmp[which(xout == FALSE)] + xx <- c(tmp, rev(tmp)) + bordup <- bordup[which(xout == FALSE)] + borddown <- borddown[which(xout == FALSE)] + yy <- c(bordup, rev(borddown)) + if (jdate == 1) { + matplot(t(var), type = "l", lty = 1, lwd = 1, ylim = c(ll, ul), + col = color[numcol], xlab = "", ylab = "", axes = FALSE) + } + polygon(xx, yy, col = colorblock[numcol], border = NA) + } + if (points) { + par(new = TRUE) + plot(var[2, ], type = "p", lty = 1, lwd = 6, ylim = c(ll, ul), + col = color[numcol], xlab = "", ylab = "", axes = FALSE, + cex = 0.6) + par(new = TRUE) + plot(var[1, ], type = "p", pch = 6, lwd = 3, ylim = c(ll, ul), + col = color[numcol], xlab = "", ylab = "", axes = FALSE, + cex = 0.6) + par(new = TRUE) + plot(var[3, ], type = "p", pch = 2, lwd = 3, ylim = c(ll, ul), + col = color[numcol], xlab = "", ylab = "", axes = FALSE, + cex = 0.6) + par(new = TRUE) + for (jind in start:end) { + lines(c(jind, jind), var[c(1, 3), jind], lwd = 1, + ylim = c(ll, ul), col = color[numcol], xlab = "", + ylab = "", axes = FALSE) + } + } else { + par(new = TRUE) + plot(var[2, ], type = "l", lty = 1, lwd = 4, ylim = c(ll, ul), + col = color[numcol], xlab = "", ylab = "", axes = FALSE) + par(new = TRUE) + plot(var[1, ], type = "l", lty = 1, lwd = 1, ylim = c(ll, ul), + col = color[numcol], xlab = "", ylab = "", axes = FALSE) + par(new = TRUE) + plot(var[3, ], type = "l", lty = 1, lwd = 1, ylim = c(ll, ul), + col = color[numcol], xlab = "", ylab = "", axes = FALSE) + } + } + } + } + if (linezero) { + abline(h = 0, col = "black") + } + if (is.null(vlines) == FALSE) { + for (x in vlines) { + abline(v = x, col = "black") + } + } + if (is.null(legends) == FALSE) { + if (points) { + legend(0, ul, legends[1:(nobs * nexp)], lty = 3, lwd = 10, + col = color[1:(nobs * nexp)], cex = legsize) + } else { + legend(0, ul, legends[1:(nobs * nexp)], lty = 1, lwd = 4, + col = color[1:(nobs * nexp)], cex = legsize) + } + } + + # If the graphic was saved to file, close the connection with the device + if(!is.null(fileout)) dev.off() +} diff --git a/man/PlotACC.Rd b/man/PlotACC.Rd new file mode 100644 index 0000000..fb3bccc --- /dev/null +++ b/man/PlotACC.Rd @@ -0,0 +1,105 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PlotACC.R +\name{PlotACC} +\alias{PlotACC} +\title{Plot Plumes/Timeseries Of Anomaly Correlation Coefficients} +\usage{ +PlotACC(ACC, sdates, toptitle = "", sizetit = 1, ytitle = "", + limits = NULL, legends = NULL, freq = 12, biglab = FALSE, + fill = FALSE, linezero = FALSE, points = TRUE, vlines = NULL, + fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, + ...) +} +\arguments{ +\item{ACC}{An ACC array with with dimensions:\cr +c(nexp, nobs, nsdates, nltime, 4)\cr +with the fourth dimension of length 4 containing the lower limit of the +95\% confidence interval, the ACC, the upper limit of the 95\% confidence +interval and the 95\% significance level.} + +\item{sdates}{A character vector of startdates: c('YYYYMMDD','YYYYMMDD').} + +\item{toptitle}{A character string of the main title, optional.} + +\item{sizetit}{A multiplicative factor to scale title size, optional.} + +\item{ytitle}{A character string of the title of Y-axis for each experiment: +c('', ''), optional.} + +\item{limits}{A numeric vector c(lower limit, upper limit): limits of the +Y-axis, optional.} + +\item{legends}{A character vector of flags to be written in the legend, +optional.} + +\item{freq}{A integer: 1 = yearly, 12 = monthly, 4 = seasonal, ... Default: 12.} + +\item{biglab}{A logical value for presentation/paper plot, Default = FALSE.} + +\item{fill}{A logical value if filled confidence interval. Default = FALSE.} + +\item{linezero}{A logical value if a line at y=0 should be added. Default = FALSE.} + +\item{points}{A logical value if points instead of lines. Default = TRUE.\cr +Must be TRUE if only 1 leadtime.} + +\item{vlines}{A vector of x location where to add vertical black lines, optional.} + +\item{fileout}{A character string of the output file name. Extensions allowed: +eps/ps, jpeg, png, pdf, bmp and tiff. Default is NULL.} + +\item{width}{A numeric of the file width, in the units specified in the +parameter size_units (inches by default). Takes 8 by default.} + +\item{height}{A numeric of the file height, in the units specified in the parameter +size_units (inches by default). Takes 5 by default.} + +\item{size_units}{A character string of the units of the size of the device +(file or window) to plot in. Inches ('in') by default. See ?Devices and the +creator function of the corresponding device.} + +\item{res}{Resolution of the device (file or window) to plot in. See +?Devices and the creator function of the corresponding device.} + +\item{\dots}{Arguments to be passed to the method. Only accepts the following +graphical parameters:\cr +adj ann ask bg bty cex.sub cin col.axis col.lab col.main col.sub cra crt +csi cxy err family fg fig fin font font.axis font.lab font.main font.sub +lend lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page +plt smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog\cr +For more information about the parameters see `par`.} +} +\description{ +Plots plumes/timeseries of ACC from an array with dimensions +(output from \code{ACC()}): \cr +c(nexp, nobs, nsdates, nltime, 4)\cr +where the fourth dimension is of length 4 and contains the lower limit of +the 95\% confidence interval, the ACC, the upper limit of the 95\% +confidence interval and the 95\% significance level given by a one-sided +T-test. +} +\examples{ + \dontshow{ +startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), + c('observation'), startDates, + leadtimemin = 1, + leadtimemax = 4, + output = 'lonlat', + latmin = 27, latmax = 48, + lonmin = -12, lonmax = 40) + } +sampleData$mod <- Season(sampleData$mod, monini = 11, moninf = 12, monsup = 2) +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) +acc <- ACC(MeanDims(ano_exp, 2), MeanDims(ano_obs, 2), memb_dim = NULL) +# 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)) + \donttest{ +PlotACC(res, startDates) + } +} + -- GitLab From 547907c818117b6e468932a0a377674ea4824a75 Mon Sep 17 00:00:00 2001 From: nperez Date: Fri, 18 Dec 2020 10:52:59 +0100 Subject: [PATCH 008/154] MeanDims using Apply --- R/MeanDims.R | 61 +++++++++++++++++++++++++++---------------------- man/MeanDims.Rd | 25 ++++++++++++-------- 2 files changed, 49 insertions(+), 37 deletions(-) diff --git a/R/MeanDims.R b/R/MeanDims.R index 2da3144..14399e8 100644 --- a/R/MeanDims.R +++ b/R/MeanDims.R @@ -3,26 +3,28 @@ #'This function returns the mean of an array along a set of dimensions and #'preserves the dimension names if it has. #' -#'@details It is recommended to use \code{'apply(x, dim, mean)'} to improve the -#' efficiency when the dimension to be averaged is only one. -#' #'@param data An array to be averaged. #'@param dims A vector of numeric or charactor string, indicating along which #' dimensions to average. #'@param na.rm A logical value indicating whether to ignore NA values (TRUE) or -#' not (FALSE). The default value is FALSE. -#' +#' not (FALSE). +#'@param ncores A integer indicating the number of cores to use in parallel computation. #'@return An array with the same dimension as parameter 'data' except the 'dims' #' dimensions. #' removed. #' +#'@keywords datagen +#'@author History:\cr +#'0.1 - 2011-04 (V. Guemas, \email{vguemas@@ic3.cat}) - Original code\cr +#'1.0 - 2013-09 (N. Manubens, \email{nicolau.manubens@@ic3.cat}) - Formatting to R CRAN\cr +#'1.1 - 2015-03 (N. Manubens, \email{nicolau.manubens@@ic3.cat}) - Improved memory usage +#'3.0 - 2020-01 (A. Ho, \email{an.ho@bsc.es}) - Preserve dimension names #'@examples -#'a <- array(rnorm(24), dim = c(a = 2, b= 3, c = 4)) -#'print(dim(MeanDims(a, 2))) -#'print(dim(MeanDims(a, c(2, 3)))) -#'print(dim(MeanDims(a, c('a', 'b')))) +#'a <- array(rnorm(24), dim = c(2, 3, 4)) +#'MeanDims(a, 2) +#'MeanDims(a, c(2, 3)) #'@export -MeanDims <- function(data, dims, na.rm = FALSE) { +MeanDims <- function(data, dims, na.rm = TRUE, ncores = NULL) { # Check inputs ## data @@ -63,26 +65,31 @@ MeanDims <- function(data, dims, na.rm = FALSE) { ############################### # Calculate MeanDims - - ## Change character dims into indices - if (is.character(dims)) { - tmp <- rep(0, length(dims)) - for (i in 1:length(dims)) { - tmp[i] <- which(names(dim(data)) == dims[i]) - } - dims <- tmp + if (length(dims) == length(dim(data)) || length(dim(data)) == 1) { + res <- mean(data, na.rm = na.rm) + } else { + res <- Apply(list(data), target_dims = list(dims), fun = mean, + na.rm = na.rm, ncores = ncores)$output1 } + ## Change character dims into indices + #if (is.character(dims)) { + # tmp <- rep(0, length(dims)) + # for (i in 1:length(dims)) { + # tmp[i] <- which(names(dim(data)) == dims[i]) + # } + #dims <- tmp + #} - if (length(dim(data)) == 1) { - res <- mean(data, na.rm = na.rm) - } else { + #if (length(dim(data)) == 1) { + # res <- mean(data, na.rm = na.rm) + #} else { - margins <- setdiff(c(1:length(dim(data))), dims) - res <- as.array(apply(data, margins, mean, na.rm = na.rm)) - if (!is.null(names(dim(data))[margins]) & is.null(names(dim(res)))) { - names(dim(res)) <- names(dim(data))[margins] - } - } + # margins <- setdiff(c(1:length(dim(data))), dims) + # res <- as.array(apply(data, margins, mean, na.rm = na.rm)) + # if (!is.null(names(dim(data))[margins]) & is.null(names(dim(res)))) { + # names(dim(res)) <- names(dim(data))[margins] + # } + #} return(res) diff --git a/man/MeanDims.Rd b/man/MeanDims.Rd index 2e6022f..f200023 100644 --- a/man/MeanDims.Rd +++ b/man/MeanDims.Rd @@ -4,7 +4,7 @@ \alias{MeanDims} \title{Average an array along multiple dimensions} \usage{ -MeanDims(data, dims, na.rm = FALSE) +MeanDims(data, dims, na.rm = TRUE, ncores = NULL) } \arguments{ \item{data}{An array to be averaged.} @@ -13,7 +13,9 @@ MeanDims(data, dims, na.rm = FALSE) dimensions to average.} \item{na.rm}{A logical value indicating whether to ignore NA values (TRUE) or -not (FALSE). The default value is FALSE.} +not (FALSE).} + +\item{ncores}{A integer indicating the number of cores to use in parallel computation.} } \value{ An array with the same dimension as parameter 'data' except the 'dims' @@ -24,14 +26,17 @@ An array with the same dimension as parameter 'data' except the 'dims' This function returns the mean of an array along a set of dimensions and preserves the dimension names if it has. } -\details{ -It is recommended to use \code{'apply(x, dim, mean)'} to improve the - efficiency when the dimension to be averaged is only one. -} \examples{ -a <- array(rnorm(24), dim = c(a = 2, b= 3, c = 4)) -print(dim(MeanDims(a, 2))) -print(dim(MeanDims(a, c(2, 3)))) -print(dim(MeanDims(a, c('a', 'b')))) +a <- array(rnorm(24), dim = c(2, 3, 4)) +MeanDims(a, 2) +MeanDims(a, c(2, 3)) +} +\author{ +History:\cr +0.1 - 2011-04 (V. Guemas, \email{vguemas@ic3.cat}) - Original code\cr +1.0 - 2013-09 (N. Manubens, \email{nicolau.manubens@ic3.cat}) - Formatting to R CRAN\cr +1.1 - 2015-03 (N. Manubens, \email{nicolau.manubens@ic3.cat}) - Improved memory usage +3.0 - 2020-01 (A. Ho, \email{an.ho@bsc.es}) - Preserve dimension names } +\keyword{datagen} -- GitLab From e7b854a6f00c6ca2a0f2fa3c137ff292cc2440e6 Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 7 Jan 2021 12:44:54 +0100 Subject: [PATCH 009/154] apply for 1 dim --- R/MeanDims.R | 27 ++++++--------------------- 1 file changed, 6 insertions(+), 21 deletions(-) diff --git a/R/MeanDims.R b/R/MeanDims.R index 14399e8..8beb41a 100644 --- a/R/MeanDims.R +++ b/R/MeanDims.R @@ -67,31 +67,16 @@ MeanDims <- function(data, dims, na.rm = TRUE, ncores = NULL) { # Calculate MeanDims if (length(dims) == length(dim(data)) || length(dim(data)) == 1) { res <- mean(data, na.rm = na.rm) + } else if (length(dims) == 1) { + if (is.character(dims)) { + pos <- which(names(dim(data)) == dims) + } + pos <- (1:length(dim(data)))[-pos] + res <- apply(data, pos, mean, na.rm = na.rm) } else { res <- Apply(list(data), target_dims = list(dims), fun = mean, na.rm = na.rm, ncores = ncores)$output1 } - ## Change character dims into indices - #if (is.character(dims)) { - # tmp <- rep(0, length(dims)) - # for (i in 1:length(dims)) { - # tmp[i] <- which(names(dim(data)) == dims[i]) - # } - #dims <- tmp - #} - - #if (length(dim(data)) == 1) { - # res <- mean(data, na.rm = na.rm) - #} else { - - # margins <- setdiff(c(1:length(dim(data))), dims) - # res <- as.array(apply(data, margins, mean, na.rm = na.rm)) - # if (!is.null(names(dim(data))[margins]) & is.null(names(dim(res)))) { - # names(dim(res)) <- names(dim(data))[margins] - # } - #} - return(res) - } -- GitLab From 9d4711883bac053371343fdcd977f82dc4324115 Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 7 Jan 2021 12:49:30 +0100 Subject: [PATCH 010/154] Fix when dims is numeric --- R/MeanDims.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/MeanDims.R b/R/MeanDims.R index 8beb41a..1a808b8 100644 --- a/R/MeanDims.R +++ b/R/MeanDims.R @@ -69,9 +69,9 @@ MeanDims <- function(data, dims, na.rm = TRUE, ncores = NULL) { res <- mean(data, na.rm = na.rm) } else if (length(dims) == 1) { if (is.character(dims)) { - pos <- which(names(dim(data)) == dims) + dims <- which(names(dim(data)) == dims) } - pos <- (1:length(dim(data)))[-pos] + pos <- (1:length(dim(data)))[-dims] res <- apply(data, pos, mean, na.rm = na.rm) } else { res <- Apply(list(data), target_dims = list(dims), fun = mean, -- GitLab From 487dcc7c6eef663679928e6d7d15dd4e1e77fd6a Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 7 Jan 2021 13:11:02 +0100 Subject: [PATCH 011/154] na.rm default to FALSE --- R/MeanDims.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/MeanDims.R b/R/MeanDims.R index 1a808b8..4b22d51 100644 --- a/R/MeanDims.R +++ b/R/MeanDims.R @@ -24,7 +24,7 @@ #'MeanDims(a, 2) #'MeanDims(a, c(2, 3)) #'@export -MeanDims <- function(data, dims, na.rm = TRUE, ncores = NULL) { +MeanDims <- function(data, dims, na.rm = FALSE, ncores = NULL) { # Check inputs ## data -- GitLab From ad36caed19ddc6a5dcd3d867e16173321b148437 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 13 Jan 2021 19:08:20 +0100 Subject: [PATCH 012/154] Transfer EOF.R from s2dverification and create unit test --- NAMESPACE | 1 + R/EOF.R | 258 ++++++++++++++++++++++++++++++++++++++ man/EOF.Rd | 92 ++++++++++++++ man/MeanDims.Rd | 2 +- tests/testthat/test-EOF.R | 213 +++++++++++++++++++++++++++++++ 5 files changed, 565 insertions(+), 1 deletion(-) create mode 100644 R/EOF.R create mode 100644 man/EOF.Rd create mode 100644 tests/testthat/test-EOF.R diff --git a/NAMESPACE b/NAMESPACE index 6da8d0c..1eb3cbb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,6 +19,7 @@ export(ConfigShowDefinitions) export(ConfigShowSimilarEntries) export(ConfigShowTable) export(Corr) +export(EOF) export(Eno) export(GMST) export(GSAT) diff --git a/R/EOF.R b/R/EOF.R new file mode 100644 index 0000000..7dcf911 --- /dev/null +++ b/R/EOF.R @@ -0,0 +1,258 @@ +#'Area-weighted empirical orthogonal function analysis using SVD +#' +#'Perform an area-weighted EOF analysis using SVD based on a covariance matrix +#'by default, based on the correlation matrix if \code{corr} argument is set to +#'\code{TRUE}. +#' +#'@param ano A numerical array of anomalies with named dimensions to calculate +#' EOF. The dimensions must have at least 'time_dim' and 'space_dim'. +#'@param time_dim A character string indicating the name of the time dimension +#' of 'ano'. +#'@param space_dim A vector of two character strings. The first is the dimension +#' name of latitude of 'ano' and the second is the dimension name of longitude +#' of 'ano'. The default value is c('lat', 'lon'). +#'@param lon A vector of longitudes of 'ano'. +#'@param lat A vector of latitudes of 'ano'. +#'@param neofs An integer of the modes to be kept. The default value is 15. +#' If time length or the product of latitude length and longitude length is +#' less than neofs, neofs is equal to the minimum of the three values. +#'@param corr A logical value indicating whether to base on a correlation (TRUE) +#' or on a covariance matrix (FALSE). 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 list containing: +#'\item{EOFs}{ +#' An array of EOF patterns normalized to 1 (unitless) with dimensions +#' (number of modes, rest of the dimensions of ano except 'time_dim'). +#' Multiplying \code{EOFs} by \code{PCs} gives the original reconstructed +#' field. +#'} +#'\item{PCs}{ +#' An array of principal components with the units of the original field to +#' the power of 2, with dimensions (number of time steps, number of modes). +#' \code{PCs} contains already the percentage of explained variance so, +#' to reconstruct the original field it's only needed to multiply \code{EOFs} +#' by \code{PCs}. +#'} +#'\item{var}{ +#' A vector indicating the percentage (%) of variance fraction of total +#' variance explained by each mode (number of modes). +#'} +#'\item{mask}{ +#' The mask with dimensions (number of latitudes, number of longitudes). +#'} +#'\item{wght}{ +#' The weights with dimensions (number of latitudes, number of longitudes). +#'} +#' +#'@seealso ProjectField, NAO, PlotBoxWhisker +#'@examples +#'# This example computes the EOFs along forecast horizons and plots the one that +#'# explains the greatest amount of variability. The example data is very low +#'# resolution so it does not make a lot of sense. +#'\dontshow{ +#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), +#' c('observation'), startDates, +#' leadtimemin = 1, +#' leadtimemax = 4, +#' output = 'lonlat', +#' latmin = 27, latmax = 48, +#' lonmin = -12, lonmax = 40) +#'} +#'ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) +#'ano <- MeanDims(ano$ano_exp, 2)[1, , 1, , ] +#'names(dim(ano)) <- c('time', 'lat', 'lon') +#'eof <- EOF(ano, sampleData$lat, sampleData$lon) +#'\dontrun{ +#'PlotEquiMap(eof$EOFs[1, , ], sampleData$lon, sampleData$lat) +#'} +#' +#'@import multiApply +#'@importFrom stats sd +#'@export +EOF <- function(ano, lat, lon, time_dim = 'time', space_dim = c('lat', 'lon'), + neofs = 15, corr = FALSE, ncores = NULL) { + + # Check inputs + ## ano + if (is.null(ano)) { + stop("Parameter 'ano' cannot be NULL.") + } + if (!is.numeric(ano)) { + stop("Parameter 'ano' must be a numeric array.") + } + if(any(is.null(names(dim(ano))))| any(nchar(names(dim(ano))) == 0)) { + stop("Parameter 'ano' 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(ano))) { + stop("Parameter 'time_dim' is not found in 'ano' dimension.") + } + ## space_dim + if (!is.character(space_dim) | length(space_dim) != 2) { + stop("Parameter 'space_dim' must be a character vector of 2.") + } + if (any(!space_dim %in% names(dim(ano)))) { + stop("Parameter 'space_dim' is not found in 'ano' dimension.") + } + ## lat + if (!is.numeric(lat) | length(lat) != dim(ano)[space_dim[1]]) { + stop(paste0("Parameter 'lat' must be a numeric vector with the same ", + "length as the latitude dimension of 'ano'.")) + } + if (any(lat > 90 | lat < -90)) { + stop("Parameter 'lat' must contain values within the range [-90, 90].") + } + ## lon + if (!is.numeric(lon) | length(lon) != dim(ano)[space_dim[2]]) { + stop(paste0("Parameter 'lon' must be a numeric vector with the same ", + "length as the longitude dimension of 'ano'.")) + } + if (any(lon > 360 | lon < -360)) { + warning("Some 'lon' is out of the range [-360, 360].") + } + ## neofs + if (!is.numeric(neofs) | neofs %% 1 != 0 | neofs < 0 | length(neofs) > 1) { + stop("Parameter 'neofs' must be a positive integer.") + } + ## corr + if (!is.logical(corr) | length(corr) > 1) { + stop("Parameter 'corr' must be one logical value.") + } + ## 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.") + } + } + + + # Replace mask of NAs with 0s for EOF analysis. + ano[!is.finite(ano)] <- 0 + + # Area weighting. Weights for EOF; needed to compute the + # fraction of variance explained by each EOFs + space_ind <- sapply(space_dim, function(a) which(names(dim(ano)) == a)) + wght <- array(cos(lat * pi/180), dim = dim(ano)[space_ind]) + + # We want the covariance matrix to be weigthed by the grid + # cell area so the anomaly field is weighted by its square + # root since the covariance matrix equals transpose(ano) + # times ano. + wght <- sqrt(wght) + + res <- Apply(ano, + target_dims = list(c(time_dim, space_dim), + c(time_dim, space_dim)), + fun = .EOF, + corr = corr, neofs = neofs, + wght = wght, + ncores = ncores) + + return(c(res, wght = list(wght))) + +} + +.EOF <- function(ano, neofs = 15, corr = FALSE, wght = wght) { + # ano: [time, lat, lon] + + # Dimensions + nt <- dim(ano)[1] + ny <- dim(ano)[2] + nx <- dim(ano)[3] + + ano <- ano * InsertDim(wght, 1, nt) + + # Build the mask + mask <- ano[1, , ] + mask[!is.finite(mask)] <- NA + mask[is.finite(mask)] <- 1 + dim(mask) <- dim(ano)[c(2, 3)] + + # The use of the correlation matrix is done under the option corr. + if (corr == TRUE) { + stdv <- apply(ano, c(2, 3), sd, na.rm = T) + ano <- ano/InsertDim(stdv, 1, nt) + } + + # Time/space matrix for SVD + dim(ano) <- c(nt, ny * nx) + dim.dat <- dim(ano) + + # 'transpose' means the array needs to be transposed before + # calling La.svd for computational efficiency because the + # spatial dimension is larger than the time dimension. This + # goes with transposing the outputs of LA.svd also. + if (dim.dat[2] > dim.dat[1]) { + transpose <- TRUE + } else { + transpose <- FALSE + } + if (transpose) { + pca <- La.svd(t(ano)) + } else { + pca <- La.svd(ano) + } + + # neofs is bounded + neofs <- min(dim.dat, neofs) + + # La.svd conventions: decomposition X = U D t(V) La.svd$u + # returns U La.svd$d returns diagonal values of D La.svd$v + # returns t(V) !! The usual convention is PC=U and EOF=V. + # If La.svd is called for ano (transpose=FALSE case): EOFs: + # $v PCs: $u If La.svd is called for t(ano) (transposed=TRUE + # case): EOFs: t($u) PCs: t($v) + + if (transpose) { + pca.EOFs <- t(pca$u) + pca.PCs <- t(pca$v) + } else { + pca.EOFs <- pca$v + pca.PCs <- pca$u + } + + # The numbers of transposition is limited to neofs + PC <- pca.PCs[, 1:neofs] + EOF <- pca.EOFs[1:neofs, ] + dim(EOF) <- c(neofs, ny, nx) + + # To sort out crash when neofs=1. + if (neofs == 1) { + PC <- InsertDim(PC, 2, 1) + } + + # Computation of the % of variance associated with each mode + W <- pca$d[1:neofs] + tot.var <- sum(pca$d^2) + var.eof <- 100 * pca$d[1:neofs]^2/tot.var + + for (e in 1:neofs) { + + # Factor to normalize the EOF. + eof.patt.nn <- EOF[e, , ] * mask + eof.patt.ms <- sum(eof.patt.nn^2, na.rm = TRUE) + + # Normalize the EOF + eof.patt <- eof.patt.nn/eof.patt.ms + + # PC is multiplied by the normalization factor and the + # weights, then the reconstruction is only EOF * PC (we have + # multiplied ano by weight) + eof.pc <- PC[, e] * eof.patt.ms * W[e] + + eof.patt <- eof.patt/wght + + EOF[e, , ] <- eof.patt + PC[, e] <- eof.pc + } + + return(list(EOFs = EOF, PCs = PC, var = var.eof, mask = mask)) +} diff --git a/man/EOF.Rd b/man/EOF.Rd new file mode 100644 index 0000000..782f6cf --- /dev/null +++ b/man/EOF.Rd @@ -0,0 +1,92 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/EOF.R +\name{EOF} +\alias{EOF} +\title{Area-weighted empirical orthogonal function analysis using SVD} +\usage{ +EOF(ano, lat, lon, time_dim = "time", space_dim = c("lat", "lon"), + neofs = 15, corr = FALSE, ncores = NULL) +} +\arguments{ +\item{ano}{A numerical array of anomalies with named dimensions to calculate +EOF. The dimensions must have at least 'time_dim' and 'space_dim'.} + +\item{lat}{A vector of latitudes of 'ano'.} + +\item{lon}{A vector of longitudes of 'ano'.} + +\item{time_dim}{A character string indicating the name of the time dimension +of 'ano'.} + +\item{space_dim}{A vector of two character strings. The first is the dimension +name of latitude of 'ano' and the second is the dimension name of longitude +of 'ano'. The default value is c('lat', 'lon').} + +\item{neofs}{An integer of the modes to be kept. The default value is 15. +If time length or the product of latitude length and longitude length is +less than neofs, neofs is equal to the minimum of the three values.} + +\item{corr}{A logical value indicating whether to base on a correlation (TRUE) +or on a covariance matrix (FALSE). The default value is FALSE.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A list containing: +\item{EOFs}{ + An array of EOF patterns normalized to 1 (unitless) with dimensions + (number of modes, rest of the dimensions of ano except 'time_dim'). + Multiplying \code{EOFs} by \code{PCs} gives the original reconstructed + field. +} +\item{PCs}{ + An array of principal components with the units of the original field to + the power of 2, with dimensions (number of time steps, number of modes). + \code{PCs} contains already the percentage of explained variance so, + to reconstruct the original field it's only needed to multiply \code{EOFs} + by \code{PCs}. +} +\item{var}{ + A vector indicating the percentage (%) of variance fraction of total + variance explained by each mode (number of modes). +} +\item{mask}{ + The mask with dimensions (number of latitudes, number of longitudes). +} +\item{wght}{ + The weights with dimensions (number of latitudes, number of longitudes). +} +} +\description{ +Perform an area-weighted EOF analysis using SVD based on a covariance matrix +by default, based on the correlation matrix if \code{corr} argument is set to +\code{TRUE}. +} +\examples{ +# This example computes the EOFs along forecast horizons and plots the one that +# explains the greatest amount of variability. The example data is very low +# resolution so it does not make a lot of sense. +\dontshow{ +startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), + c('observation'), startDates, + leadtimemin = 1, + leadtimemax = 4, + output = 'lonlat', + latmin = 27, latmax = 48, + lonmin = -12, lonmax = 40) +} +ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) +ano <- MeanDims(ano$ano_exp, 2)[1, , 1, , ] +names(dim(ano)) <- c('time', 'lat', 'lon') +eof <- EOF(ano, sampleData$lat, sampleData$lon) +\dontrun{ +PlotEquiMap(eof$EOFs[1, , ], sampleData$lon, sampleData$lat) +} + +} +\seealso{ +ProjectField, NAO, PlotBoxWhisker +} + diff --git a/man/MeanDims.Rd b/man/MeanDims.Rd index f200023..adff306 100644 --- a/man/MeanDims.Rd +++ b/man/MeanDims.Rd @@ -4,7 +4,7 @@ \alias{MeanDims} \title{Average an array along multiple dimensions} \usage{ -MeanDims(data, dims, na.rm = TRUE, ncores = NULL) +MeanDims(data, dims, na.rm = FALSE, ncores = NULL) } \arguments{ \item{data}{An array to be averaged.} diff --git a/tests/testthat/test-EOF.R b/tests/testthat/test-EOF.R new file mode 100644 index 0000000..0e0aef6 --- /dev/null +++ b/tests/testthat/test-EOF.R @@ -0,0 +1,213 @@ +context("s2dv::EOF tests") + +############################################## + # dat1 + set.seed(1) + dat1 <- array(rnorm(120), dim = c(time = 10, lat = 6, lon = 2)) + lat1 <- seq(10, 30, length.out = 6) + lon1 <- c(10, 12) + + # dat2 + set.seed(1) + dat2 <- array(rnorm(240), dim = c(lat = 6, lon = 2, time = 20)) + lat2 <- seq(-10, 10, length.out = 6) + lon2 <- c(-10, -12) + + # dat3 + set.seed(1) + dat3 <- array(rnorm(480), dim = c(dat = 2, lat = 6, lon = 2, time = 20)) + lat3 <- seq(10, 30, length.out = 6) + lon3 <- c(10, 12) + +############################################## +test_that("1. Input checks", { + + # ano + expect_error( + EOF(c()), + "Parameter 'ano' cannot be NULL." + ) + expect_error( + EOF(c(NA, NA)), + "Parameter 'ano' must be a numeric array." + ) + expect_error( + EOF(list(a = array(rnorm(50), dim = c(dat = 5, sdate = 10)), b = c(1:4))), + "Parameter 'ano' must be a numeric array." + ) + expect_error( + EOF(array(1:10, dim = c(2, 5))), + "Parameter 'ano' must have dimension names." + ) + # time_dim + expect_error( + EOF(dat1, time_dim = 2), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + EOF(dat1, time_dim = c('a','sdate')), + "Parameter 'time_dim' must be a character string." + ) + # space_dim + expect_error( + EOF(dat1, space_dim = 'lat'), + "Parameter 'space_dim' must be a character vector of 2." + ) + expect_error( + EOF(dat1, space_dim = c('latitude', 'longitude')), + "Parameter 'space_dim' is not found in 'ano' dimension." + ) + # lat + expect_error( + EOF(dat1, lat = 1:10), + paste0("Parameter 'lat' must be a numeric vector with the same ", + "length as the latitude dimension of 'ano'.") + ) + expect_error( + EOF(dat1, lat = seq(-100, -80, length.out = 6)), + "Parameter 'lat' must contain values within the range \\[-90, 90\\]." + ) + # lon + expect_error( + EOF(dat1, lat = lat1, lon = c('a', 'b')), + paste0("Parameter 'lon' must be a numeric vector with the same ", + "length as the longitude dimension of 'ano'.") + ) + expect_warning( + EOF(dat1, lat = lat1, lon = c(350, 370)), + "Some 'lon' is out of the range \\[-360, 360\\]." + ) + # neofs + expect_error( + EOF(dat1, lat = lat1, lon = lon1, neofs = -1), + "Parameter 'neofs' must be a positive integer." + ) + # corr + expect_error( + EOF(dat1, lat = lat1, lon = lon1, corr = 0.1), + "Parameter 'corr' must be one logical value." + ) + # ncores + expect_error( + EOF(dat1, lat1, lon1, ncore = 3.5), + "Parameter 'ncores' must be a positive integer." + ) + +}) +############################################## +test_that("2. dat1", { + + expect_equal( + names(EOF(dat1, lon = lon1, lat = lat1)), + c("EOFs", "PCs", "var", "mask", "wght") + ) + expect_equal( + dim(EOF(dat1, lon = lon1, lat = lat1)$EOFs), + c(10, lat = 6, lon = 2) + ) + expect_equal( + dim(EOF(dat1, lon = lon1, lat = lat1)$PCs), + c(10, 10) + ) + expect_equal( + dim(EOF(dat1, lon = lon1, lat = lat1)$var), + c(10) + ) + expect_equal( + dim(EOF(dat1, lon = lon1, lat = lat1)$mask), + c(lat = 6, lon = 2) + ) + expect_equal( + dim(EOF(dat1, lon = lon1, lat = lat1)$wght), + c(lat = 6, lon = 2) + ) + expect_equal( + EOF(dat1, lon = lon1, lat = lat1)$EOFs[1:5], + c(-0.2888168, 0.2792765, 0.1028387, 0.1883640, -0.2896943), + tolerance = 0.0001 + ) + expect_equal( + mean(EOF(dat1, lon = lon1, lat = lat1)$EOFs), + 0.01792716, + tolerance = 0.0001 + ) + expect_equal( + EOF(dat1, lon = lon1, lat = lat1)$PCs[1:5], + c(3.2061306, -0.1692669, 0.5420990, -2.5324441, -0.6143680), + tolerance = 0.0001 + ) + expect_equal( + mean(EOF(dat1, lon = lon1, lat = lat1)$PCs), + 0.08980279, + tolerance = 0.0001 + ) + expect_equal( + EOF(dat1, lon = lon1, lat = lat1)$var[1:5], + array(c(29.247073, 25.364840, 13.247046, 11.121006, 8.662517)), + tolerance = 0.0001 + ) + expect_equal( + sum(EOF(dat1, lon = lon1, lat = lat1)$mask), + 12 + ) + expect_equal( + EOF(dat1, lon = lon1, lat = lat1)$wght[1:5], + c(0.9923748, 0.9850359, 0.9752213, 0.9629039, 0.9480475), + tolerance = 0.0001 + ) + +}) +############################################## +test_that("3. dat2", { + expect_equal( + dim(EOF(dat2, lon = lon2, lat = lat2)$EOFs), + c(12, lat = 6, lon = 2) + ) + expect_equal( + dim(EOF(dat2, lon = lon2, lat = lat2)$PCs), + c(20, 12) + ) + expect_equal( + EOF(dat2, lon = lon2, lat = lat2)$EOFs[1:5], + c(0.33197201, 0.18837900, -0.19697143, 0.08305805, -0.51297585), + tolerance = 0.0001 + ) + expect_equal( + mean(EOF(dat2, lon = lon2, lat = lat2)$EOFs), + 0.02720393, + tolerance = 0.0001 + ) + +}) + +############################################## +test_that("4. dat3", { + expect_equal( + dim(EOF(dat3, lon = lon3, lat = lat3)$EOFs), + c(12, lat = 6, lon = 2, dat = 2) + ) + expect_equal( + dim(EOF(dat3, lon = lon3, lat = lat3)$PCs), + c(20, 12, dat = 2) + ) + expect_equal( + dim(EOF(dat3, lon = lon3, lat = lat3)$var), + c(12, dat = 2) + ) + expect_equal( + dim(EOF(dat3, lon = lon3, lat = lat3)$mask), + c(lat = 6, lon = 2, dat = 2) + ) + expect_equal( + mean(EOF(dat3, lon = lon3, lat = lat3)$EOFs), + 0.01214845, + tolerance = 0.0001 + ) + expect_equal( + EOF(dat3, lon = lon3, lat = lat3)$EOFs[1:5], + c(0.3292733, 0.1787016, -0.3801986, 0.1957160, -0.4377031), + tolerance = 0.0001 + ) + +}) +############################################## -- GitLab From fa11962c6ce77259d58f836e195e281acf2cf370 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 15 Jan 2021 14:40:30 +0100 Subject: [PATCH 013/154] Transfer Ano_CrossValid.R --- NAMESPACE | 1 + R/Ano_CrossValid.R | 221 +++++++++++++++++++++++++++ man/Ano_CrossValid.Rd | 63 ++++++++ tests/testthat/test-Ano_CrossValid.R | 143 +++++++++++++++++ 4 files changed, 428 insertions(+) create mode 100644 R/Ano_CrossValid.R create mode 100644 man/Ano_CrossValid.Rd create mode 100644 tests/testthat/test-Ano_CrossValid.R diff --git a/NAMESPACE b/NAMESPACE index 1eb3cbb..e35f177 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,7 @@ export(AMV) export(AnimateMap) export(Ano) +export(Ano_CrossValid) export(Clim) export(ColorBar) export(Composite) diff --git a/R/Ano_CrossValid.R b/R/Ano_CrossValid.R new file mode 100644 index 0000000..cdbf233 --- /dev/null +++ b/R/Ano_CrossValid.R @@ -0,0 +1,221 @@ +#'Compute anomalies in cross-validation mode +#' +#'Compute the anomalies from the arrays of the experimental and observational +#'data output by subtracting the climatologies computed with a cross-validation +#'technique and a per-pair method. +#' +#'@param exp A named numeric array of experimental data, with at least +#' dimensions 'time_dim' and 'dat_dim'. +#'@param obs A named numeric array of observational data, same dimensions as +#' parameter 'exp' except along 'dat_dim'. +#'@param time_dim A character string indicating the name of the time dimension. +#' The default value is 'sdate'. +#'@param dat_dim A character vector indicating the name of the dataset and +#' member dimensions. When calculating the climatology, if data at one +#' startdate (i.e., 'time_dim') is not complete along 'dat_dim', this startdate +#' along 'dat_dim' will be discarded. The default value is +#' "c('dataset', 'member')". +#'@param memb_dim A character string indicating the name of the member +#' dimension. Only used when parameter 'memb' is FALSE. It must be one element +#' in 'dat_dim'. The default value is 'member'. +#'@param memb A logical value indicating whether to remain 'memb_dim' dimension +#' (TRUE) or do ensemble mean over 'memb_dim' (FALSE) when calculating +#' climatology. The default value is TRUE. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' +#'@return +#'A list of 2: +#'\item{$ano_exp}{ +#' A numeric array with the same dimensions as 'exp'. The dimension order may +#' change. +#'} +#'\item{$ano_obs}{ +#' A numeric array with the same dimensions as 'obs'.The dimension order may +#' change. +#'} +#' +#'@examples +#'# Load sample data as in Load() example: +#'example(Load) +#'anomalies <- Ano_CrossValid(sampleData$mod, sampleData$obs) +#'\dontrun{ +#'PlotAno(anomalies$ano_exp, anomalies$ano_obs, startDates, +#' toptitle = paste('anomalies'), ytitle = c('K', 'K', 'K'), +#' legends = 'ERSST', biglab = FALSE, fileout = 'tos_ano_crossvalid.eps') +#'} +#'@import multiApply +#'@importFrom ClimProjDiags Subset +#'@export +Ano_CrossValid <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), + memb_dim = 'member', memb = TRUE, 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))) { + stop(paste0("Parameter 'exp' and 'obs' must have at least dimensions ", + "time_dim and dat_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)) { + 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.") + } + 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.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.") + } + ## 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' 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 | + 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))) + for (i in 1:length(dat_dim)) { + name_exp <- name_exp[-which(name_exp == dat_dim[i])] + name_obs <- name_obs[-which(name_obs == dat_dim[i])] + } + if(!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + stop(paste0("Parameter 'exp' and 'obs' must have same length of ", + "all dimension expect 'dat_dim'.")) + } + + ############################### + # Sort dimension + name_exp <- names(dim(exp)) + name_obs <- names(dim(obs)) + order_obs <- match(name_exp, name_obs) + if (any(order_obs != sort(order_obs))) { + obs <- Reorder(obs, order_obs) + } + + #----------------------------------- + # Per-paired method: Remove all sdate if not complete along dat_dim + pos <- rep(0, length(dat_dim)) # dat_dim: [dataset, member] + for (i in 1:length(dat_dim)) { + pos[i] <- which(names(dim(obs)) == dat_dim[i]) + } + 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]]) + } + exp_for_clim <- exp + obs_for_clim <- obs + exp_for_clim[which(is.na(outrows_exp))] <- NA + obs_for_clim[which(is.na(outrows_obs))] <- NA + + #----------------------------------- + + res <- Apply(list(exp, obs, exp_for_clim, obs_for_clim), + target_dims = c(time_dim, dat_dim), + fun = .Ano_CrossValid, + memb_dim = memb_dim, memb = memb, + ncores = ncores) + + return(res) +} + +.Ano_CrossValid <- function(exp, obs, exp_for_clim, obs_for_clim, + memb_dim = 'member', memb = TRUE, ncores = NULL) { + # exp: [sdate, dat_dim, memb_dim] + # obs: [sdate, dat_dim, memb_dim] + ano_exp_list <- vector('list', length = dim(exp)[1]) #length: [sdate] + ano_obs_list <- vector('list', length = dim(obs)[1]) + + for (tt in 1:dim(exp)[1]) { #[sdate] + # calculate clim + exp_sub <- Subset(exp_for_clim, 1, c(1:dim(exp)[1])[-tt]) + obs_sub <- Subset(obs_for_clim, 1, c(1:dim(obs)[1])[-tt]) + clim_exp <- apply(exp_sub, c(1:length(dim(exp)))[-1], mean, na.rm = TRUE) # average out time_dim -> [dat, memb] + clim_obs <- apply(obs_sub, c(1:length(dim(obs)))[-1], mean, na.rm = TRUE) + + # ensemble mean + if (!memb) { + if (is.null(dim(clim_exp)) | length(dim(clim_exp)) == 1) { #dim: [member] + clim_exp <- mean(clim_exp, na.rm = TRUE) # a number + clim_obs <- mean(clim_obs, na.rm = TRUE) + } else { + pos <- which(names(dim(clim_exp)) == memb_dim) + pos <- c(1:length(dim(clim_exp)))[-pos] + dim_name <- names(dim(clim_exp)) + dim_exp_ori <- dim(clim_exp) + dim_obs_ori <- dim(clim_obs) + + clim_exp <- apply(clim_exp, pos, mean, na.rm = TRUE) + clim_obs <- apply(clim_obs, pos, mean, na.rm = TRUE) + if (is.null(names(dim(as.array(clim_exp))))) { + clim_exp <- as.array(clim_exp) + clim_obs <- as.array(clim_obs) + names(dim(clim_exp)) <- dim_name[pos] + names(dim(clim_obs)) <- dim_name[pos] + } + + # Expand it back + clim_exp_tmp <- array(clim_exp, dim = c(dim_exp_ori[pos], dim_exp_ori[-pos])) + clim_obs_tmp <- array(clim_obs, dim = c(dim_obs_ori[pos], dim_obs_ori[-pos])) + # Reorder it back to dim(clim_exp) + tmp <- match(dim_exp_ori, dim(clim_exp_tmp)) + if (any(tmp != sort(tmp))) { + clim_exp <- Reorder(clim_exp_tmp, tmp) + clim_obs <- Reorder(clim_obs_tmp, tmp) + } else { + clim_exp <- clim_exp_tmp + clim_obs <- clim_obs_tmp + } + } + } + # calculate ano + ano_exp_list[[tt]] <- Subset(exp, 1, tt, drop = 'selected') - clim_exp + ano_obs_list[[tt]] <- Subset(obs, 1, tt, drop = 'selected') - clim_obs + } + + ano_exp <- array(unlist(ano_exp_list), dim = c(dim(exp)[-1], dim(exp)[1])) + ano_exp <- Reorder(ano_exp, c(length(dim(exp)), 1:(length(dim(exp)) - 1))) + ano_obs <- array(unlist(ano_obs_list), dim = c(dim(obs)[-1], dim(obs)[1])) + ano_obs <- Reorder(ano_obs, c(length(dim(obs)), 1:(length(dim(obs)) - 1))) + + return(list(ano_exp = ano_exp, ano_obs = ano_obs)) +} diff --git a/man/Ano_CrossValid.Rd b/man/Ano_CrossValid.Rd new file mode 100644 index 0000000..fa56a75 --- /dev/null +++ b/man/Ano_CrossValid.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Ano_CrossValid.R +\name{Ano_CrossValid} +\alias{Ano_CrossValid} +\title{Compute anomalies in cross-validation mode} +\usage{ +Ano_CrossValid(exp, obs, time_dim = "sdate", dat_dim = c("dataset", + "member"), memb_dim = "member", memb = TRUE, ncores = NULL) +} +\arguments{ +\item{exp}{A named numeric array of experimental data, with at least +dimensions 'time_dim' and 'dat_dim'.} + +\item{obs}{A named numeric array of observational data, same dimensions as +parameter 'exp' except along 'dat_dim'.} + +\item{time_dim}{A character string indicating the name of the time dimension. +The default value is 'sdate'.} + +\item{dat_dim}{A character vector indicating the name of the dataset and +member dimensions. When calculating the climatology, if data at one +startdate (i.e., 'time_dim') is not complete along 'dat_dim', this startdate +along 'dat_dim' will be discarded. The default value is +"c('dataset', 'member')".} + +\item{memb_dim}{A character string indicating the name of the member +dimension. Only used when parameter 'memb' is FALSE. It must be one element +in 'dat_dim'. The default value is 'member'.} + +\item{memb}{A logical value indicating whether to remain 'memb_dim' dimension +(TRUE) or do ensemble mean over 'memb_dim' (FALSE) when calculating +climatology. The default value is TRUE.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A list of 2: +\item{$ano_exp}{ + A numeric array with the same dimensions as 'exp'. The dimension order may + change. +} +\item{$ano_obs}{ + A numeric array with the same dimensions as 'obs'.The dimension order may + change. +} +} +\description{ +Compute the anomalies from the arrays of the experimental and observational +data output by subtracting the climatologies computed with a cross-validation +technique and a per-pair method. +} +\examples{ +# Load sample data as in Load() example: +example(Load) +anomalies <- Ano_CrossValid(sampleData$mod, sampleData$obs) +\dontrun{ +PlotAno(anomalies$ano_exp, anomalies$ano_obs, startDates, + toptitle = paste('anomalies'), ytitle = c('K', 'K', 'K'), + legends = 'ERSST', biglab = FALSE, fileout = 'tos_ano_crossvalid.eps') +} +} + diff --git a/tests/testthat/test-Ano_CrossValid.R b/tests/testthat/test-Ano_CrossValid.R new file mode 100644 index 0000000..1333f15 --- /dev/null +++ b/tests/testthat/test-Ano_CrossValid.R @@ -0,0 +1,143 @@ +context("s2dv::EOF tests") + +############################################## + # 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)) + +# dat2 +set.seed(1) +exp2 <- array(rnorm(30), dim = c(member = 3, ftime = 2, sdate = 5)) +set.seed(2) +obs2 <- array(rnorm(20), dim = c(ftime = 2, member = 2, sdate = 5)) + + +############################################## +test_that("1. Input checks", { + + # exp and obs (1) + expect_error( + Ano_CrossValid(c(), c()), + "Parameter 'exp' and 'obs' cannot be NULL." + ) + expect_error( + Ano_CrossValid(c('b'), c('a')), + "Parameter 'exp' and 'obs' must be a numeric array." + ) + expect_error( + Ano_CrossValid(c(1:10), c(2:4)), + paste0("Parameter 'exp' and 'obs' must have at least dimensions ", + "time_dim and dat_dim.") + ) + expect_error( + Ano_CrossValid(array(1:10, dim = c(2, 5)), array(1:4, dim = c(2, 2))), + "Parameter 'exp' and 'obs' must have dimension names." + ) + # time_dim + expect_error( + Ano_CrossValid(exp1, obs1, time_dim = 2), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + Ano_CrossValid(exp1, obs1, time_dim = c('a', 'sdate')), + "Parameter 'time_dim' must be a character string." + ) + # dat_dim + expect_error( + Ano_CrossValid(exp1, obs1, dat_dim = 1), + "Parameter 'dat_dim' must be a character vector." + ) + expect_error( + Ano_CrossValid(exp1, obs1, dat_dim = 'dat'), + "Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension." + ) + # memb + expect_error( + Ano_CrossValid(exp1, obs1, memb = 'member'), + "Parameter 'memb' must be one logical value." + ) + # memb_dim + expect_error( + Ano_CrossValid(exp1, obs1, memb = FALSE, memb_dim = 2), + "Parameter 'memb_dim' must be a character string." + ) + expect_error( + Ano_CrossValid(exp1, obs1, memb = FALSE, memb_dim = 'memb'), + "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." + ) + expect_error( + Ano_CrossValid(exp1, obs1, memb = FALSE, memb_dim = 'ftime'), + "Parameter 'memb_dim' must be one element in parameter 'dat_dim'." + ) + # ncores + expect_error( + Ano_CrossValid(exp1, obs1, memb = FALSE, ncores = -1), + "Parameter 'ncores' must be a positive integer." + ) + # exp and obs (2) + expect_error( + Ano_CrossValid(exp1, array(1:20, dim = c(dataset = 1, member = 2, sdate = 4, ftime = 2))), + paste0("Parameter 'exp' and 'obs' must have same length of ", + "all dimension expect 'dat_dim'.") + ) + + +}) +############################################## +test_that("2. dat1", { + + expect_equal( + names(Ano_CrossValid(exp1, obs1)), + c("ano_exp", "ano_obs") + ) + expect_equal( + dim(Ano_CrossValid(exp1, obs1)$ano_exp), + c(sdate = 5, dataset = 2, member = 3, ftime = 2) + ) + expect_equal( + Ano_CrossValid(exp1, obs1)$ano_exp[, 1, 2, 2], + c(0.2771331, 1.1675753, -1.0684010, 0.2901759, -0.6664833), + tolerance = 0.0001 + ) + expect_equal( + Ano_CrossValid(exp1, obs1)$ano_obs[, 1, 2, 2], + c(1.7024193, -0.8243579, -2.4136080, 0.5199868, 1.0155598), + tolerance = 0.0001 + ) + expect_equal( + Ano_CrossValid(exp1, obs1, memb = FALSE)$ano_exp[, 1, 2, 2], + c(0.1229714, 0.8496518, -0.9531644, 0.1548713, -0.5264025), + tolerance = 0.0001 + ) + +}) + +############################################## +test_that("3. dat2", { + expect_equal( + names(Ano_CrossValid(exp2, obs2, dat_dim = 'member')), + c("ano_exp", "ano_obs") + ) + expect_equal( + dim(Ano_CrossValid(exp2, obs2, dat_dim = 'member')$ano_exp), + c(sdate = 5, member = 3, ftime = 2) + ) + expect_equal( + Ano_CrossValid(exp2, obs2, dat_dim = 'member')$ano_exp[, 2, 2], + c(0.05650631, 1.53434806, -0.37561623, -0.26217217, -0.95306597), + tolerance = 0.0001 + ) + expect_equal( + Ano_CrossValid(exp2, obs2, dat_dim = 'member', memb = FALSE)$ano_exp[, 2, 2], + c(0.34489635, 1.56816273, -0.01926901, -0.09646066, -0.68236823), + tolerance = 0.0001 + ) + +}) + + + + + -- GitLab From f256312753c365fd4d63a1d43aea0e8349ea518d Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 21 Jan 2021 12:11:00 +0100 Subject: [PATCH 014/154] Improve EOF.R --- R/EOF.R | 54 ++++++++++++++++++++++++--------------- man/EOF.Rd | 26 +++++++++++-------- tests/testthat/test-EOF.R | 26 +++++++++++-------- 3 files changed, 64 insertions(+), 42 deletions(-) diff --git a/R/EOF.R b/R/EOF.R index 7dcf911..cf04c42 100644 --- a/R/EOF.R +++ b/R/EOF.R @@ -6,13 +6,13 @@ #' #'@param ano A numerical array of anomalies with named dimensions to calculate #' EOF. The dimensions must have at least 'time_dim' and 'space_dim'. +#'@param lat A vector of the latitudes of 'ano'. +#'@param lon A vector of the longitudes of 'ano'. #'@param time_dim A character string indicating the name of the time dimension -#' of 'ano'. +#' of 'ano'. The default value is 'sdate'. #'@param space_dim A vector of two character strings. The first is the dimension #' name of latitude of 'ano' and the second is the dimension name of longitude #' of 'ano'. The default value is c('lat', 'lon'). -#'@param lon A vector of longitudes of 'ano'. -#'@param lat A vector of latitudes of 'ano'. #'@param neofs An integer of the modes to be kept. The default value is 15. #' If time length or the product of latitude length and longitude length is #' less than neofs, neofs is equal to the minimum of the three values. @@ -31,20 +31,23 @@ #'} #'\item{PCs}{ #' An array of principal components with the units of the original field to -#' the power of 2, with dimensions (number of time steps, number of modes). +#' the power of 2, with dimensions (time_dim, number of modes, rest of the +#' dimensions except 'space_dim'). #' \code{PCs} contains already the percentage of explained variance so, #' to reconstruct the original field it's only needed to multiply \code{EOFs} #' by \code{PCs}. #'} #'\item{var}{ -#' A vector indicating the percentage (%) of variance fraction of total -#' variance explained by each mode (number of modes). +#' An array of the percentage (%) of variance fraction of total variance +#' explained by each mode (number of modes). The dimensions are (number of +#' modes, rest of the dimension except 'time_dim' and 'space_dim'). #'} #'\item{mask}{ -#' The mask with dimensions (number of latitudes, number of longitudes). +#' An array of the mask with dimensions (space_dim, rest of the dimension +#' except 'time_dim'). #'} #'\item{wght}{ -#' The weights with dimensions (number of latitudes, number of longitudes). +#' An array of the weights with dimensions (space_dim). #'} #' #'@seealso ProjectField, NAO, PlotBoxWhisker @@ -63,8 +66,9 @@ #' lonmin = -12, lonmax = 40) #'} #'ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) -#'ano <- MeanDims(ano$ano_exp, 2)[1, , 1, , ] -#'names(dim(ano)) <- c('time', 'lat', 'lon') +#'tmp <- MeanDims(ano$ano_exp, c('dataset', 'member')) +#'ano <- tmp[, 1, ,] +#'names(dim(ano)) <- names(dim(tmp))[-2] #'eof <- EOF(ano, sampleData$lat, sampleData$lon) #'\dontrun{ #'PlotEquiMap(eof$EOFs[1, , ], sampleData$lon, sampleData$lat) @@ -73,7 +77,7 @@ #'@import multiApply #'@importFrom stats sd #'@export -EOF <- function(ano, lat, lon, time_dim = 'time', space_dim = c('lat', 'lon'), +EOF <- function(ano, lat, lon, time_dim = 'sdate', space_dim = c('lat', 'lon'), neofs = 15, corr = FALSE, ncores = NULL) { # Check inputs @@ -127,15 +131,15 @@ EOF <- function(ano, lat, lon, time_dim = 'time', space_dim = c('lat', 'lon'), } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } } - # Replace mask of NAs with 0s for EOF analysis. - ano[!is.finite(ano)] <- 0 +# # Replace mask of NAs with 0s for EOF analysis. +# ano[!is.finite(ano)] <- 0 # Area weighting. Weights for EOF; needed to compute the # fraction of variance explained by each EOFs @@ -149,8 +153,11 @@ EOF <- function(ano, lat, lon, time_dim = 'time', space_dim = c('lat', 'lon'), wght <- sqrt(wght) res <- Apply(ano, - target_dims = list(c(time_dim, space_dim), - c(time_dim, space_dim)), + target_dims = c(time_dim, space_dim), + output_dims = list(EOFs = c('mode', space_dim), + PCs = c(time_dim, 'mode'), + var = 'mode', + mask = space_dim), fun = .EOF, corr = corr, neofs = neofs, wght = wght, @@ -168,14 +175,17 @@ EOF <- function(ano, lat, lon, time_dim = 'time', space_dim = c('lat', 'lon'), ny <- dim(ano)[2] nx <- dim(ano)[3] - ano <- ano * InsertDim(wght, 1, nt) - # Build the mask mask <- ano[1, , ] mask[!is.finite(mask)] <- NA mask[is.finite(mask)] <- 1 dim(mask) <- dim(ano)[c(2, 3)] + # Replace mask of NAs with 0s for EOF analysis. + ano[!is.finite(ano)] <- 0 + + ano <- ano * InsertDim(wght, 1, nt) + # The use of the correlation matrix is done under the option corr. if (corr == TRUE) { stdv <- apply(ano, c(2, 3), sd, na.rm = T) @@ -223,10 +233,10 @@ EOF <- function(ano, lat, lon, time_dim = 'time', space_dim = c('lat', 'lon'), PC <- pca.PCs[, 1:neofs] EOF <- pca.EOFs[1:neofs, ] dim(EOF) <- c(neofs, ny, nx) - + # To sort out crash when neofs=1. if (neofs == 1) { - PC <- InsertDim(PC, 2, 1) + PC <- InsertDim(PC, 2, 1, name = 'new') } # Computation of the % of variance associated with each mode @@ -254,5 +264,9 @@ EOF <- function(ano, lat, lon, time_dim = 'time', space_dim = c('lat', 'lon'), PC[, e] <- eof.pc } + if (neofs == 1) { + var.eof <- as.array(var.eof) + } + return(list(EOFs = EOF, PCs = PC, var = var.eof, mask = mask)) } diff --git a/man/EOF.Rd b/man/EOF.Rd index 782f6cf..a81f779 100644 --- a/man/EOF.Rd +++ b/man/EOF.Rd @@ -4,19 +4,19 @@ \alias{EOF} \title{Area-weighted empirical orthogonal function analysis using SVD} \usage{ -EOF(ano, lat, lon, time_dim = "time", space_dim = c("lat", "lon"), +EOF(ano, lat, lon, time_dim = "sdate", space_dim = c("lat", "lon"), neofs = 15, corr = FALSE, ncores = NULL) } \arguments{ \item{ano}{A numerical array of anomalies with named dimensions to calculate EOF. The dimensions must have at least 'time_dim' and 'space_dim'.} -\item{lat}{A vector of latitudes of 'ano'.} +\item{lat}{A vector of the latitudes of 'ano'.} -\item{lon}{A vector of longitudes of 'ano'.} +\item{lon}{A vector of the longitudes of 'ano'.} \item{time_dim}{A character string indicating the name of the time dimension -of 'ano'.} +of 'ano'. The default value is 'sdate'.} \item{space_dim}{A vector of two character strings. The first is the dimension name of latitude of 'ano' and the second is the dimension name of longitude @@ -42,20 +42,23 @@ A list containing: } \item{PCs}{ An array of principal components with the units of the original field to - the power of 2, with dimensions (number of time steps, number of modes). + the power of 2, with dimensions (time_dim, number of modes, rest of the + dimensions except 'space_dim'). \code{PCs} contains already the percentage of explained variance so, to reconstruct the original field it's only needed to multiply \code{EOFs} by \code{PCs}. } \item{var}{ - A vector indicating the percentage (%) of variance fraction of total - variance explained by each mode (number of modes). + An array of the percentage (%) of variance fraction of total variance + explained by each mode (number of modes). The dimensions are (number of + modes, rest of the dimension except 'time_dim' and 'space_dim'). } \item{mask}{ - The mask with dimensions (number of latitudes, number of longitudes). + An array of the mask with dimensions (space_dim, rest of the dimension + except 'time_dim'). } \item{wght}{ - The weights with dimensions (number of latitudes, number of longitudes). + An array of the weights with dimensions (space_dim). } } \description{ @@ -78,8 +81,9 @@ sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), lonmin = -12, lonmax = 40) } ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) -ano <- MeanDims(ano$ano_exp, 2)[1, , 1, , ] -names(dim(ano)) <- c('time', 'lat', 'lon') +tmp <- MeanDims(ano$ano_exp, c('dataset', 'member')) +ano <- tmp[, 1, ,] +names(dim(ano)) <- names(dim(tmp))[-2] eof <- EOF(ano, sampleData$lat, sampleData$lon) \dontrun{ PlotEquiMap(eof$EOFs[1, , ], sampleData$lon, sampleData$lat) diff --git a/tests/testthat/test-EOF.R b/tests/testthat/test-EOF.R index 0e0aef6..e15a971 100644 --- a/tests/testthat/test-EOF.R +++ b/tests/testthat/test-EOF.R @@ -3,19 +3,19 @@ context("s2dv::EOF tests") ############################################## # dat1 set.seed(1) - dat1 <- array(rnorm(120), dim = c(time = 10, lat = 6, lon = 2)) + dat1 <- array(rnorm(120), dim = c(sdate = 10, lat = 6, lon = 2)) lat1 <- seq(10, 30, length.out = 6) lon1 <- c(10, 12) # dat2 set.seed(1) - dat2 <- array(rnorm(240), dim = c(lat = 6, lon = 2, time = 20)) + dat2 <- array(rnorm(240), dim = c(lat = 6, lon = 2, sdate = 20)) lat2 <- seq(-10, 10, length.out = 6) lon2 <- c(-10, -12) # dat3 set.seed(1) - dat3 <- array(rnorm(480), dim = c(dat = 2, lat = 6, lon = 2, time = 20)) + dat3 <- array(rnorm(480), dim = c(dat = 2, lat = 6, lon = 2, sdate = 20)) lat3 <- seq(10, 30, length.out = 6) lon3 <- c(10, 12) @@ -103,15 +103,15 @@ test_that("2. dat1", { ) expect_equal( dim(EOF(dat1, lon = lon1, lat = lat1)$EOFs), - c(10, lat = 6, lon = 2) + c(mode = 10, lat = 6, lon = 2) ) expect_equal( dim(EOF(dat1, lon = lon1, lat = lat1)$PCs), - c(10, 10) + c(sdate = 10, mode = 10) ) expect_equal( dim(EOF(dat1, lon = lon1, lat = lat1)$var), - c(10) + c(mode = 10) ) expect_equal( dim(EOF(dat1, lon = lon1, lat = lat1)$mask), @@ -161,11 +161,11 @@ test_that("2. dat1", { test_that("3. dat2", { expect_equal( dim(EOF(dat2, lon = lon2, lat = lat2)$EOFs), - c(12, lat = 6, lon = 2) + c(mode = 12, lat = 6, lon = 2) ) expect_equal( dim(EOF(dat2, lon = lon2, lat = lat2)$PCs), - c(20, 12) + c(sdate = 20, mode = 12) ) expect_equal( EOF(dat2, lon = lon2, lat = lat2)$EOFs[1:5], @@ -184,21 +184,25 @@ test_that("3. dat2", { test_that("4. dat3", { expect_equal( dim(EOF(dat3, lon = lon3, lat = lat3)$EOFs), - c(12, lat = 6, lon = 2, dat = 2) + c(mode = 12, lat = 6, lon = 2, dat = 2) ) expect_equal( dim(EOF(dat3, lon = lon3, lat = lat3)$PCs), - c(20, 12, dat = 2) + c(sdate = 20, mode = 12, dat = 2) ) expect_equal( dim(EOF(dat3, lon = lon3, lat = lat3)$var), - c(12, dat = 2) + c(mode = 12, dat = 2) ) expect_equal( dim(EOF(dat3, lon = lon3, lat = lat3)$mask), c(lat = 6, lon = 2, dat = 2) ) expect_equal( + dim(EOF(dat3, lon = lon3, lat = lat3)$wght), + c(lat = 6, lon = 2) + ) + expect_equal( mean(EOF(dat3, lon = lon3, lat = lat3)$EOFs), 0.01214845, tolerance = 0.0001 -- GitLab From 66dbbdda180c7b81005daea2ba3ca62e8f698931 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 21 Jan 2021 12:11:30 +0100 Subject: [PATCH 015/154] Transform ProjectField.R --- NAMESPACE | 1 + R/ProjectField.R | 161 ++++++++++++++++++++++++++ man/ProjectField.Rd | 73 ++++++++++++ tests/testthat/test-ProjectField.R | 174 +++++++++++++++++++++++++++++ 4 files changed, 409 insertions(+) create mode 100644 R/ProjectField.R create mode 100644 man/ProjectField.Rd create mode 100644 tests/testthat/test-ProjectField.R diff --git a/NAMESPACE b/NAMESPACE index e35f177..9726809 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,6 +36,7 @@ export(PlotLayout) export(PlotMatrix) export(PlotSection) export(PlotStereoMap) +export(ProjectField) export(RMS) export(RMSSS) export(RandomWalkTest) diff --git a/R/ProjectField.R b/R/ProjectField.R new file mode 100644 index 0000000..82a96dd --- /dev/null +++ b/R/ProjectField.R @@ -0,0 +1,161 @@ +#'Project anomalies onto modes of variability +#' +#'Project anomalies onto modes of variability to get the temporal evolution of +#'the EOF mode selected. It returns principal components (PCs) by area-weighted +#'projection onto EOF pattern (from \code{EOF()}). The calculation removes NA +#'and returns NA if the whole spatial pattern is NA. +#' +#'@param ano A numerical array of anomalies with named dimensions. The +#' dimensions must have at least 'time_dim' and 'space_dim'. +#'@param lat A vector of the latitudes of 'ano' to calculate EOF. +#'@param lon A vector of the longitudes of 'ano' to calculate EOF. +#'@param time_dim A character string indicating the name of the time dimension +#' of 'ano'. The default value is 'sdate'. +#'@param space_dim A vector of two character strings. The first is the dimension +#' name of latitude of 'ano' and the second is the dimension name of longitude +#' of 'ano'. The default value is c('lat', 'lon'). +#'@param mode An integer of the variability mode number in the EOF to be +#' projected on. The default value is 1. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' +#'@return A numerical array of the principal components in the verification +#' format. The dimensions are the same as 'ano' except 'space_dim'. +#' +#'@seealso EOF, NAO, PlotBoxWhisker +#'@examples +#'\dontshow{ +#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), +#' c('observation'), startDates, +#' leadtimemin = 1, +#' leadtimemax = 4, +#' output = 'lonlat', +#' latmin = 27, latmax = 48, +#' lonmin = -12, lonmax = 40) +#'} +#'ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) +#'mode1_exp <- ProjectField(ano$ano_exp, sampleData$lat, sampleData$lon) +#'mode1_obs <- ProjectField(ano$ano_obs, sampleData$lat, sampleData$lon) +#' +#'\dontrun{ +#' # Plot the forecast and the observation of the first mode for the last year +#' # of forecast +#' sdate_dim_length <- dim(mode1_obs)['sdate'] +#' plot(mode1_obs[sdate_dim_length, 1, 1, ], type = "l", ylim = c(-1, 1), +#' lwd = 2) +#' for (i in 1:dim(mode1_exp)['member']) { +#' par(new = TRUE) +#' plot(mode1_exp[sdate_dim_length, 1, i, ], type = "l", col = rainbow(10)[i], +#' ylim = c(-15000, 15000)) +#' } +#'} +#' +#'@export +ProjectField <- function(ano, lat, lon, time_dim = 'sdate', + space_dim = c('lat', 'lon'), mode = 1, ncores = NULL) { + + # Check inputs + ## ano + if (is.null(ano)) { + stop("Parameter 'ano' cannot be NULL.") + } + if (!is.numeric(ano)) { + stop("Parameter 'ano' must be a numeric array.") + } + if(any(is.null(names(dim(ano))))| any(nchar(names(dim(ano))) == 0)) { + stop("Parameter 'ano' must have dimension names.") + } + if (any(lon > 360 | lon < -360)) { + warning("Some 'lon' is out of the range [-360, 360].") + } + ## 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(ano))) { + stop("Parameter 'time_dim' is not found in 'ano' dimension.") + } + ## space_dim + if (!is.character(space_dim) | length(space_dim) != 2) { + stop("Parameter 'space_dim' must be a character vector of 2.") + } + if (any(!space_dim %in% names(dim(ano)))) { + stop("Parameter 'space_dim' is not found in 'ano' dimension.") + } + ## lat + if (!is.numeric(lat) | length(lat) != dim(ano)[space_dim[1]]) { + stop(paste0("Parameter 'lat' must be a numeric vector with the same ", + "length as the latitude dimension of 'ano'.")) + } + if (any(lat > 90 | lat < -90)) { + stop("Parameter 'lat' must contain values within the range [-90, 90].") + } + ## lon + if (!is.numeric(lon) | length(lon) != dim(ano)[space_dim[2]]) { + stop(paste0("Parameter 'lon' must be a numeric vector with the same ", + "length as the longitude dimension of 'ano'.")) + } + if (any(lon > 360 | lon < -360)) { + warning("Some 'lon' is out of the range [-360, 360].") + } + ## mode + if (!is.numeric(mode) | mode %% 1 != 0 | mode < 0 | length(mode) > 1) { + stop("Parameter 'mode' must be a positive integer.") + } + ## 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.") + } + } + +#------------------------------------------------------- + + # Compute EOF + eof <- EOF(ano = ano, lat = lat, lon = lon, + time_dim = time_dim, space_dim = space_dim, + neofs = mode) + + if (mode > dim(eof$EOFs)[1]) { + stop(paste0("Parameter 'mode' is greater than the number of available ", + "modes in EOF.")) + } + + # Keep the chosen mode + eof_mode <- Subset(eof$EOFs, 'mode', mode, drop = 'selected') + + res <- Apply(list(ano, eof_mode, eof$wght), + target_dims = list(c(space_dim, time_dim), + c(space_dim), + c(space_dim)), + output_dims = time_dim, + fun = .ProjectField, + ncores = ncores)$output1 + + return(res) +} + + +.ProjectField <- function(ano, eof_mode, wght) { + # ano: [lat, lon, sdate] + # eof_mode: [lat, lon] + # wght: [lat, lon] + dim_time <- dim(ano)[3] + + # Initialization of pc.ver. + pc.ver <- array(NA, dim = dim_time) #[sdate] + + # Weigths + e.1 <- eof_mode * wght + + ano <- ano * InsertDim(wght, 3, dim_time) + na <- apply(ano, 3, mean, na.rm = TRUE) # if [lat, lon] all NA, it's NA + tmp <- ano * InsertDim(e.1, 3, dim_time) # [lat, lon, sdate] + pc.ver <- apply(tmp, 3, sum, na.rm = TRUE) + pc.ver[which(is.na(na))] <- NA + + return(pc.ver) +} + diff --git a/man/ProjectField.Rd b/man/ProjectField.Rd new file mode 100644 index 0000000..198db05 --- /dev/null +++ b/man/ProjectField.Rd @@ -0,0 +1,73 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ProjectField.R +\name{ProjectField} +\alias{ProjectField} +\title{Project anomalies onto modes of variability} +\usage{ +ProjectField(ano, lat, lon, time_dim = "sdate", space_dim = c("lat", "lon"), + mode = 1, ncores = NULL) +} +\arguments{ +\item{ano}{A numerical array of anomalies with named dimensions. The +dimensions must have at least 'time_dim' and 'space_dim'.} + +\item{lat}{A vector of the latitudes of 'ano' to calculate EOF.} + +\item{lon}{A vector of the longitudes of 'ano' to calculate EOF.} + +\item{time_dim}{A character string indicating the name of the time dimension +of 'ano'. The default value is 'sdate'.} + +\item{space_dim}{A vector of two character strings. The first is the dimension +name of latitude of 'ano' and the second is the dimension name of longitude +of 'ano'. The default value is c('lat', 'lon').} + +\item{mode}{An integer of the variability mode number in the EOF to be +projected on. The default value is 1.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A numerical array of the principal components in the verification + format. The dimensions are the same as 'ano' except 'space_dim'. +} +\description{ +Project anomalies onto modes of variability to get the temporal evolution of +the EOF mode selected. It returns principal components (PCs) by area-weighted +projection onto EOF pattern (from \code{EOF()}). The calculation removes NA +and returns NA if the whole spatial pattern is NA. +} +\examples{ +\dontshow{ +startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), + c('observation'), startDates, + leadtimemin = 1, + leadtimemax = 4, + output = 'lonlat', + latmin = 27, latmax = 48, + lonmin = -12, lonmax = 40) +} +ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) +mode1_exp <- ProjectField(ano$ano_exp, sampleData$lat, sampleData$lon) +mode1_obs <- ProjectField(ano$ano_obs, sampleData$lat, sampleData$lon) + +\dontrun{ + # Plot the forecast and the observation of the first mode for the last year + # of forecast + sdate_dim_length <- dim(mode1_obs)['sdate'] + plot(mode1_obs[sdate_dim_length, 1, 1, ], type = "l", ylim = c(-1, 1), + lwd = 2) + for (i in 1:dim(mode1_exp)['member']) { + par(new = TRUE) + plot(mode1_exp[sdate_dim_length, 1, i, ], type = "l", col = rainbow(10)[i], + ylim = c(-15000, 15000)) + } +} + +} +\seealso{ +EOF, NAO, PlotBoxWhisker +} + diff --git a/tests/testthat/test-ProjectField.R b/tests/testthat/test-ProjectField.R new file mode 100644 index 0000000..eef3692 --- /dev/null +++ b/tests/testthat/test-ProjectField.R @@ -0,0 +1,174 @@ +context("s2dv::ProjectField tests") + +############################################## + # dat1 + set.seed(1) + dat1 <- array(rnorm(120), dim = c(sdate = 10, lat = 6, lon = 2)) + lat1 <- seq(10, 30, length.out = 6) + lon1 <- c(10, 12) + + # dat2 + set.seed(1) + dat2 <- array(rnorm(48), dim = c(dat = 1, memb = 1, sdate = 6, ftime = 1, lat = 4, lon = 2)) + lat2 <- seq(10, 30, length.out = 4) + lon2 <- c(-5, 5) + + # dat3 + dat3 <- dat2 + dat3[1, 1, 1, 1, , ] <- NA + names(dim(dat3)) <- names(dim(dat2)) + lat3 <- seq(10, 30, length.out = 4) + lon3 <- c(-5, 5) + + # dat4 + set.seed(1) + dat4 <- array(rnorm(288), dim = c(dat = 1, memb = 2, sdate = 6, ftime = 3, lat = 4, lon = 2)) + lat4 <- seq(-10, -30, length.out = 4) + lon4 <- c(350, 355) + + +############################################## +test_that("1. Input checks", { + + # ano + expect_error( + ProjectField(c()), + "Parameter 'ano' cannot be NULL." + ) + expect_error( + ProjectField(c(NA, NA)), + "Parameter 'ano' must be a numeric array." + ) + expect_error( + ProjectField(list(a = array(rnorm(50), dim = c(dat = 5, sdate = 10)), b = c(1:4))), + "Parameter 'ano' must be a numeric array." + ) + expect_error( + ProjectField(array(1:10, dim = c(2, 5))), + "Parameter 'ano' must have dimension names." + ) + # lat + expect_error( + ProjectField(dat1, lat = 1:10, lon = lon1), + paste0("Parameter 'lat' must be a numeric vector with the same ", + "length as the latitude dimension of 'ano'.") + ) + expect_error( + ProjectField(dat1, lat = seq(-100, -80, length.out = 6), lon = lon1), + "Parameter 'lat' must contain values within the range \\[-90, 90\\]." + ) + # lon + expect_error( + ProjectField(dat1, lat = lat1, lon = c('a', 'b')), + paste0("Parameter 'lon' must be a numeric vector with the same ", + "length as the longitude dimension of 'ano'.") + ) + expect_warning( + EOF(dat1, lat = lat1, lon = c(350, 370)), + "Some 'lon' is out of the range \\[-360, 360\\]." + ) + # time_dim + expect_error( + ProjectField(dat1, lat1, lon1, time_dim = 2), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + ProjectField(dat1, lat1, lon1, time_dim = c('a','sdate')), + "Parameter 'time_dim' must be a character string." + ) + # space_dim + expect_error( + ProjectField(dat1, lat1, lon1, space_dim = 'lat'), + "Parameter 'space_dim' must be a character vector of 2." + ) + expect_error( + ProjectField(dat1, lat1, lon1, space_dim = c('latitude', 'longitude')), + "Parameter 'space_dim' is not found in 'ano' dimension." + ) + # mode + expect_error( + ProjectField(dat1, lat = lat1, lon = lon1, mode = -1), + "Parameter 'mode' must be a positive integer." + ) + expect_error( + ProjectField(dat1, lat = lat1, lon = lon1, mode = 15), + paste0("Parameter 'mode' is greater than the number of available ", + "modes in EOF.") + ) + # ncores + expect_error( + ProjectField(dat1, lat1, lon1, ncore = 3.5), + "Parameter 'ncores' must be a positive integer." + ) + +}) +############################################## +test_that("2. dat1", { + + expect_equal( + dim(ProjectField(dat1, lon = lon1, lat = lat1)), + c(sdate = 10) + ) + expect_equal( + as.vector(ProjectField(dat1, lon = lon1, lat = lat1))[1:5], + c(3.2061306, -0.1692669, 0.5420990, -2.5324441, -0.6143680), + tolerance = 0.0001 + ) + expect_equal( + as.vector(ProjectField(dat1, lon = lon1, lat = lat1, mode = 10))[1:5], + c(-0.24848299, -0.19311118, -0.16951195, -0.10000207, 0.04554693), + tolerance = 0.0001 + ) + +}) +############################################## +test_that("3. dat2", { + expect_equal( + dim(ProjectField(dat2, lon = lon2, lat = lat2)), + c(sdate = 6, dat = 1, memb = 1, ftime = 1) + ) + expect_equal( + ProjectField(dat2, lon = lon2, lat = lat2)[1:6], + c(0.00118771, -1.20872474, -0.00821559, -2.06064916, -0.19245169, 2.26026937), + tolerance = 0.0001 + ) + expect_equal( + mean(ProjectField(dat2, lon = lon2, lat = lat2, mode = 6)), + 0.1741076, + tolerance = 0.0001 + ) + +}) + +############################################## +test_that("4. dat3", { + expect_equal( + dim(ProjectField(dat3, lon = lon3, lat = lat3)), + c(sdate = 6, dat = 1, memb = 1, ftime = 1) + ) + expect_equal( + ProjectField(dat3, lon = lon3, lat = lat3)[1:6], + c(NA, 0, 0, 0, 0, 0), + tolerance = 0.0001 + ) + +}) +############################################## +test_that("5. dat4", { + expect_equal( + dim(ProjectField(dat4, lon = lon4, lat = lat4)), + c(sdate = 6, dat = 1, memb = 2, ftime = 3) + ) + expect_equal( + mean(ProjectField(dat4, lon = lon4, lat = lat4)), + -0.1179755, + tolerance = 0.0001 + ) + expect_equal( + ProjectField(dat4, lon = lon4, lat = lat4)[, 1, 2, 2], + c(1.73869255, -2.58156427, 0.05340228, -0.53610350, -3.13985059, 1.58785066), + tolerance = 0.0001 + ) + +}) +############################################## -- GitLab From 1620fa3cb246ca685b519b5cf0bbd5fd42b7a202 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 22 Jan 2021 13:00:15 +0100 Subject: [PATCH 016/154] Make Season accept 1D array when ncores = 1 or NULL --- R/Season.R | 20 +++++++++++++------- tests/testthat/test-Season.R | 26 ++++++++++++++++++++++++++ 2 files changed, 39 insertions(+), 7 deletions(-) diff --git a/R/Season.R b/R/Season.R index 7bc5c52..50cc429 100644 --- a/R/Season.R +++ b/R/Season.R @@ -127,14 +127,20 @@ Season <- function(data, time_dim = 'ftime', monini, moninf, monsup, } if (use_apply) { - time_dim_ind <- match(time_dim, names(dim(data))) - res <- apply(data, c(1:length(dim(data)))[-time_dim_ind], .Season, - monini = monini, moninf = moninf, monsup = monsup, - method = method, na.rm = na.rm) - if (length(dim(res)) < length(dim(data))) { - res <- InsertDim(res, posdim = 1, lendim = 1, name = time_dim) + if (length(dim(data)) == 1) { + res <- .Season(data, monini = monini, moninf = moninf, monsup = monsup, + method = method, na.rm = na.rm) + names(dim(res)) <- time_dim } else { - names(dim(res))[1] <- time_dim + time_dim_ind <- match(time_dim, names(dim(data))) + res <- apply(data, c(1:length(dim(data)))[-time_dim_ind], .Season, + monini = monini, moninf = moninf, monsup = monsup, + method = method, na.rm = na.rm) + if (length(dim(res)) < length(dim(data))) { + res <- InsertDim(res, posdim = 1, lendim = 1, name = time_dim) + } else { + names(dim(res))[1] <- time_dim + } } } else { diff --git a/tests/testthat/test-Season.R b/tests/testthat/test-Season.R index 36c3027..2482042 100644 --- a/tests/testthat/test-Season.R +++ b/tests/testthat/test-Season.R @@ -11,6 +11,10 @@ context("s2dv::Season tests") na <- floor(runif(30, min = 1, max = 144*3)) dat2[na] <- NA + # dat3 + set.seed(1) + dat3 <- array(rnorm(12), dim = c(ftime = 12)) + ############################################## test_that("1. Input checks", { @@ -161,4 +165,26 @@ test_that("3. Output checks: dat2", { }) ############################################## +test_that("3. Output checks: dat3", { + expect_equal( + Season(dat3, monini = 10, moninf = 12, monsup = 2), + 0.3630533, + tolerance = 0.0001 + ) + expect_equal( + dim(Season(dat3, monini = 10, moninf = 12, monsup = 2)), + c(ftime = 1) + ) + expect_equal( + Season(dat3, monini = 10, moninf = 12, monsup = 2, ncores = 2), + 0.3630533, + tolerance = 0.0001 + ) + expect_equal( + dim(Season(dat3, monini = 10, moninf = 12, monsup = 2, ncores = 2)), + c(ftime = 1) + ) +}) + +############################################## -- GitLab From 05c2c95f2e6a1bf65bda0f770cf0ab95bd7f7f91 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 22 Jan 2021 13:11:55 +0100 Subject: [PATCH 017/154] Remove ncores = 2 test --- tests/testthat/test-Season.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/tests/testthat/test-Season.R b/tests/testthat/test-Season.R index 2482042..0b009a6 100644 --- a/tests/testthat/test-Season.R +++ b/tests/testthat/test-Season.R @@ -167,7 +167,7 @@ test_that("3. Output checks: dat2", { ############################################## test_that("3. Output checks: dat3", { expect_equal( - Season(dat3, monini = 10, moninf = 12, monsup = 2), + as.numeric(Season(dat3, monini = 10, moninf = 12, monsup = 2)), 0.3630533, tolerance = 0.0001 ) @@ -175,16 +175,16 @@ test_that("3. Output checks: dat3", { dim(Season(dat3, monini = 10, moninf = 12, monsup = 2)), c(ftime = 1) ) - expect_equal( - Season(dat3, monini = 10, moninf = 12, monsup = 2, ncores = 2), - 0.3630533, - tolerance = 0.0001 - ) - expect_equal( - dim(Season(dat3, monini = 10, moninf = 12, monsup = 2, ncores = 2)), - c(ftime = 1) - ) +# expect_equal( +# Season(dat3, monini = 10, moninf = 12, monsup = 2, ncores = 2), +# 0.3630533, +# tolerance = 0.0001 +# ) +# expect_equal( +# dim(Season(dat3, monini = 10, moninf = 12, monsup = 2, ncores = 2)), +# c(ftime = 1) +# ) }) -############################################## +############################################### -- GitLab From d7a955dbaafe3c596ffb222327fc0ab480b46715 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 22 Jan 2021 13:25:12 +0100 Subject: [PATCH 018/154] Update MeanDims.Rd --- man/MeanDims.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/MeanDims.Rd b/man/MeanDims.Rd index f200023..adff306 100644 --- a/man/MeanDims.Rd +++ b/man/MeanDims.Rd @@ -4,7 +4,7 @@ \alias{MeanDims} \title{Average an array along multiple dimensions} \usage{ -MeanDims(data, dims, na.rm = TRUE, ncores = NULL) +MeanDims(data, dims, na.rm = FALSE, ncores = NULL) } \arguments{ \item{data}{An array to be averaged.} -- GitLab From df7b4f891e8124ae38488372300cf7b278e3500b Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 28 Jan 2021 20:44:20 +0100 Subject: [PATCH 019/154] Correct documentation and CIs when bootstrapping is used. --- R/ACC.R | 18 +++++++++--------- man/ACC.Rd | 6 +++--- tests/testthat/test-ACC.R | 2 ++ 3 files changed, 14 insertions(+), 12 deletions(-) diff --git a/R/ACC.R b/R/ACC.R index e7891b0..549496a 100644 --- a/R/ACC.R +++ b/R/ACC.R @@ -19,15 +19,15 @@ #' latitude and longitude dimensions (in order) along which ACC is computed. #' The default value is c('lat', 'lon'). #'@param avg_dim A character string indicating the name of the dimension to be -#' dimension. It must be one of 'time_dim'. The mean ACC is calculated along +#' averaged. It must be one of 'time_dim'. The mean ACC is calculated along #' averaged. If no need to calculate mean ACC, set as NULL. The default value #' is 'sdate'. #'@param memb_dim A character string indicating the name of the member #' dimension. If the data are not ensemble ones, set as NULL. The default #' value is 'member'. -#'@param lat A vector of the longitudes of the exp/obs grids. Only required when +#'@param lat A vector of the latitudes of the exp/obs grids. Only required when #' the domain of interested is specified. The default value is NULL. -#'@param lon A vector of the latitudes of the exp/obs grids. Only required when +#'@param lon A vector of the longitudes of the exp/obs grids. Only required when #' the domain of interested is specified. The default value is NULL. #'@param lonlatbox A numeric vector of 4 indicating the corners of the domain of #' interested: c(lonmin, lonmax, latmin, latmax). Only required when the domain @@ -569,24 +569,24 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), #calculate the confidence interval if (is.null(avg_dim)) { - acc_conf.lower <- apply(acc_draw, c(1, 2), + acc_conf.upper <- apply(acc_draw, c(1, 2), function (x) { quantile(x, 1 - (1 - conf.lev) / 2, na.rm = TRUE)}) - acc_conf.upper <- apply(acc_draw, c(1, 2), + acc_conf.lower <- apply(acc_draw, c(1, 2), function (x) { quantile(x, (1 - conf.lev) / 2, na.rm = TRUE)}) } else { - acc_conf.lower <- apply(acc_draw, c(1, 2, 3), + acc_conf.upper <- apply(acc_draw, c(1, 2, 3), function (x) { quantile(x, 1 - (1 - conf.lev) / 2, na.rm = TRUE)}) - acc_conf.upper <- apply(acc_draw, c(1, 2, 3), + acc_conf.lower <- apply(acc_draw, c(1, 2, 3), function (x) { quantile(x, (1 - conf.lev) / 2, na.rm = TRUE)}) - macc_conf.lower <- apply(macc_draw, c(1, 2), + macc_conf.upper <- apply(macc_draw, c(1, 2), function (x) { quantile(x, 1 - (1 - conf.lev) / 2, na.rm = TRUE)}) - macc_conf.upper <- apply(macc_draw, c(1, 2), + macc_conf.lower <- apply(macc_draw, c(1, 2), function (x) { quantile(x, (1 - conf.lev) / 2, na.rm = TRUE)}) } diff --git a/man/ACC.Rd b/man/ACC.Rd index a736c1a..f3ef274 100644 --- a/man/ACC.Rd +++ b/man/ACC.Rd @@ -25,7 +25,7 @@ latitude and longitude dimensions (in order) along which ACC is computed. The default value is c('lat', 'lon').} \item{avg_dim}{A character string indicating the name of the dimension to be -dimension. It must be one of 'time_dim'. The mean ACC is calculated along +averaged. It must be one of 'time_dim'. The mean ACC is calculated along averaged. If no need to calculate mean ACC, set as NULL. The default value is 'sdate'.} @@ -33,10 +33,10 @@ is 'sdate'.} dimension. If the data are not ensemble ones, set as NULL. The default value is 'member'.} -\item{lat}{A vector of the longitudes of the exp/obs grids. Only required when +\item{lat}{A vector of the latitudes of the exp/obs grids. Only required when the domain of interested is specified. The default value is NULL.} -\item{lon}{A vector of the latitudes of the exp/obs grids. Only required when +\item{lon}{A vector of the longitudes of the exp/obs grids. Only required when the domain of interested is specified. The default value is NULL.} \item{lonlatbox}{A numeric vector of 4 indicating the corners of the domain of diff --git a/tests/testthat/test-ACC.R b/tests/testthat/test-ACC.R index e348680..7631401 100644 --- a/tests/testthat/test-ACC.R +++ b/tests/testthat/test-ACC.R @@ -1,6 +1,8 @@ context("s2dv::ACC tests") ############################################## +##NOTE: bootstrap is not tested because sample() is used inside. + # dat1 set.seed(1) exp1 <- array(rnorm(60), dim = c(dataset = 1, member = 2, sdate = 5, -- GitLab From 5dc785fcdb199e4240f51ea14eb49ad535ad116e Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 29 Jan 2021 10:22:41 +0100 Subject: [PATCH 020/154] Revise document and example --- R/ACC.R | 44 +++++++++++++++++++++++++++++--------------- R/PlotACC.R | 9 +++++++-- man/ACC.Rd | 44 +++++++++++++++++++++++++++++--------------- man/PlotACC.Rd | 8 ++++++-- 4 files changed, 71 insertions(+), 34 deletions(-) diff --git a/R/ACC.R b/R/ACC.R index 549496a..1acebe3 100644 --- a/R/ACC.R +++ b/R/ACC.R @@ -52,27 +52,37 @@ #' #'@return #'A list containing the numeric arrays:\cr -#'\item{ACC}{ +#'\item{acc}{ #' The ACC with the dimensions c(nexp, nobs, the rest of the dimension except -#' space_dim). 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). +#' space_dim and memb_dim). 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). #'} -#'\item{conf.lower}{ -#' The lower confidence interval with the same dimensions as ACC. Only present -#' if \code{conf = TRUE}. +#'\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 +#' present if \code{conf = TRUE}. #'} -#'\item{conf.upper}{ -#' The upper confidence interval with the same dimensions as ACC. Only present -#' if \code{conf = TRUE}. +#'\item{conf.upper (if conftype = "parametric") or acc_conf.upper (if +#' conftype = "bootstrap")}{ +#' The upper confidence interval of ACC with the same dimensions as ACC. Only +#' present if \code{conf = TRUE}. #'} #'\item{p.val}{ #' The p-value with the same dimensions as ACC. Only present if -#'\code{pval = TRUE}. +#' \code{pval = TRUE} and code{conftype = "parametric"}. #'} -#'\item{MACC}{ +#'\item{macc}{ #' The mean anomaly correlation coefficient with dimensions -#' c(nexp, nobs, the rest of the dimension except space_dim and avg_dim). Only -#' present if 'avg_dim' is not NULL. +#' c(nexp, nobs, the rest of the dimension except space_dim, memb_dim, and +#' avg_dim). Only present if 'avg_dim' is not NULL. +#'} +#'\item{macc_conf.lower}{ +#' The lower confidence interval of MACC with the same dimensions as MACC. +#' Only present if \code{conftype = "bootstrap"}. +#'} +#'\item{macc_conf.upper}{ +#' The upper confidence interval of MACC with the same dimensions as MACC. +#' Only present if \code{conftype = "bootstrap"}. #'} #' #'@examples @@ -92,11 +102,15 @@ #'ano_exp <- Ano(sampleData$mod, clim$clim_exp) #'ano_obs <- Ano(sampleData$obs, clim$clim_obs) #'acc <- ACC(ano_exp, ano_obs) -#'acc <- ACC(MeanDims(ano_exp, 2), MeanDims(ano_obs, 2), memb_dim = NULL) +#'acc_bootstrap <- ACC(ano_exp, ano_obs, conftype = 'bootstrap') #'# 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)) +#'res <- array(c(acc$conf.lower, acc$acc, acc$conf.upper, acc$p.val), +#' dim = c(dim(acc$acc), 4)) +#'res_bootstrap <- array(c(acc$acc_conf.lower, acc$acc, acc$acc_conf.upper, acc$p.val), +#' dim = c(dim(acc$acc), 4)) #' \donttest{ #'PlotACC(res, startDates) +#'PlotACC(res_bootstrap, startDates) #' } #'@references Joliffe and Stephenson (2012). Forecast Verification: A #' Practitioner's Guide in Atmospheric Science. Wiley-Blackwell. diff --git a/R/PlotACC.R b/R/PlotACC.R index 7c915c7..3bffa68 100644 --- a/R/PlotACC.R +++ b/R/PlotACC.R @@ -64,12 +64,17 @@ #'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) -#'acc <- ACC(MeanDims(ano_exp, 2), MeanDims(ano_obs, 2), memb_dim = NULL) +#'acc_bootstrap <- ACC(ano_exp, ano_obs, conftype = 'bootstrap') #'# 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)) +#'res <- array(c(acc$conf.lower, acc$acc, acc$conf.upper, acc$p.val), +#' dim = c(dim(acc$acc), 4)) +#'res_bootstrap <- array(c(acc$acc_conf.lower, acc$acc, acc$acc_conf.upper, acc$p.val), +#' dim = c(dim(acc$acc), 4)) #' \donttest{ #'PlotACC(res, startDates) +#'PlotACC(res_bootstrap, startDates) #' } #'@importFrom grDevices dev.cur dev.new dev.off #'@importFrom stats ts diff --git a/man/ACC.Rd b/man/ACC.Rd index f3ef274..d48d6b8 100644 --- a/man/ACC.Rd +++ b/man/ACC.Rd @@ -67,27 +67,37 @@ computation. The default value is NULL.} } \value{ A list containing the numeric arrays:\cr -\item{ACC}{ +\item{acc}{ The ACC with the dimensions c(nexp, nobs, the rest of the dimension except - space_dim). 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). + space_dim and memb_dim). 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). } -\item{conf.lower}{ - The lower confidence interval with the same dimensions as ACC. Only present - if \code{conf = TRUE}. +\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 + present if \code{conf = TRUE}. } -\item{conf.upper}{ - The upper confidence interval with the same dimensions as ACC. Only present - if \code{conf = TRUE}. +\item{conf.upper (if conftype = "parametric") or acc_conf.upper (if + conftype = "bootstrap")}{ + The upper confidence interval of ACC with the same dimensions as ACC. Only + present if \code{conf = TRUE}. } \item{p.val}{ The p-value with the same dimensions as ACC. Only present if -\code{pval = TRUE}. + \code{pval = TRUE} and code{conftype = "parametric"}. } -\item{MACC}{ +\item{macc}{ The mean anomaly correlation coefficient with dimensions - c(nexp, nobs, the rest of the dimension except space_dim and avg_dim). Only - present if 'avg_dim' is not NULL. + c(nexp, nobs, the rest of the dimension except space_dim, memb_dim, and + avg_dim). Only present if 'avg_dim' is not NULL. +} +\item{macc_conf.lower}{ + The lower confidence interval of MACC with the same dimensions as MACC. + Only present if \code{conftype = "bootstrap"}. +} +\item{macc_conf.upper}{ + The upper confidence interval of MACC with the same dimensions as MACC. + Only present if \code{conftype = "bootstrap"}. } } \description{ @@ -116,11 +126,15 @@ 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) -acc <- ACC(MeanDims(ano_exp, 2), MeanDims(ano_obs, 2), memb_dim = NULL) +acc_bootstrap <- ACC(ano_exp, ano_obs, conftype = 'bootstrap') # 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)) +res <- array(c(acc$conf.lower, acc$acc, acc$conf.upper, acc$p.val), + dim = c(dim(acc$acc), 4)) +res_bootstrap <- array(c(acc$acc_conf.lower, acc$acc, acc$acc_conf.upper, acc$p.val), + dim = c(dim(acc$acc), 4)) \donttest{ PlotACC(res, startDates) +PlotACC(res_bootstrap, startDates) } } \references{ diff --git a/man/PlotACC.Rd b/man/PlotACC.Rd index fb3bccc..1dbd7cf 100644 --- a/man/PlotACC.Rd +++ b/man/PlotACC.Rd @@ -95,11 +95,15 @@ 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) -acc <- ACC(MeanDims(ano_exp, 2), MeanDims(ano_obs, 2), memb_dim = NULL) +acc_bootstrap <- ACC(ano_exp, ano_obs, conftype = 'bootstrap') # 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)) +res <- array(c(acc$conf.lower, acc$acc, acc$conf.upper, acc$p.val), + dim = c(dim(acc$acc), 4)) +res_bootstrap <- array(c(acc$acc_conf.lower, acc$acc, acc$acc_conf.upper, acc$p.val), + dim = c(dim(acc$acc), 4)) \donttest{ PlotACC(res, startDates) +PlotACC(res_bootstrap, startDates) } } -- GitLab From f22e5c1feb972d18af0964e5c908d1f518daefb7 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 3 Feb 2021 22:30:19 +0100 Subject: [PATCH 021/154] Use EOF() output as input instead of calculating EOF internally. --- R/ProjectField.R | 82 +++++++++++++++++++++++++++++++----------------- 1 file changed, 53 insertions(+), 29 deletions(-) diff --git a/R/ProjectField.R b/R/ProjectField.R index 82a96dd..16ab178 100644 --- a/R/ProjectField.R +++ b/R/ProjectField.R @@ -7,8 +7,9 @@ #' #'@param ano A numerical array of anomalies with named dimensions. The #' dimensions must have at least 'time_dim' and 'space_dim'. -#'@param lat A vector of the latitudes of 'ano' to calculate EOF. -#'@param lon A vector of the longitudes of 'ano' to calculate EOF. +#'@param eof A list contains at least 'EOFs' and 'wght', which are both arrays. +#' 'EOFs' has dimensions same as 'ano' except 'EOFs' has 'mode' and 'ano' has +#' time_dim. 'wght' has dimensions space_dim. It can be generated by EOF(). #'@param time_dim A character string indicating the name of the time dimension #' of 'ano'. The default value is 'sdate'. #'@param space_dim A vector of two character strings. The first is the dimension @@ -35,8 +36,10 @@ #' lonmin = -12, lonmax = 40) #'} #'ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) -#'mode1_exp <- ProjectField(ano$ano_exp, sampleData$lat, sampleData$lon) -#'mode1_obs <- ProjectField(ano$ano_obs, sampleData$lat, sampleData$lon) +#'eof_exp <- EOF(ano$ano_exp, sampleData$lat, sampleData$lon) +#'eof_obs <- EOF(ano$ano_obs, sampleData$lat, sampleData$lon) +#'mode1_exp <- ProjectField(ano$ano_exp, eof_exp) +#'mode1_obs <- ProjectField(ano$ano_obs, eof_obs) #' #'\dontrun{ #' # Plot the forecast and the observation of the first mode for the last year @@ -52,7 +55,7 @@ #'} #' #'@export -ProjectField <- function(ano, lat, lon, time_dim = 'sdate', +ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon'), mode = 1, ncores = NULL) { # Check inputs @@ -66,8 +69,21 @@ ProjectField <- function(ano, lat, lon, time_dim = 'sdate', if(any(is.null(names(dim(ano))))| any(nchar(names(dim(ano))) == 0)) { stop("Parameter 'ano' must have dimension names.") } - if (any(lon > 360 | lon < -360)) { - warning("Some 'lon' is out of the range [-360, 360].") + ## eof (1) + if (is.null(eof)) { + stop("Parameter 'eof' cannot be NULL.") + } + if (!is.list(eof)) { + stop("Parameter 'eof' must be a list generated by EOF().") + } + if (!all(c('EOFs', 'wght') %in% names(eof))) { + stop("Parameter 'eof' must contain 'EOFs' and 'wght' generated by EOF().") + } + if (!is.numeric(eof$EOFs) || !is.array(eof$EOFs)) { + stop("The component 'EOFs' of parameter 'eof' must be a numeric array.") + } + if (!is.numeric(eof$wght) || !is.array(eof$wght)) { + stop("The component 'wght' of parameter 'eof' must be a numeric array.") } ## time_dim if (!is.character(time_dim) | length(time_dim) > 1) { @@ -83,26 +99,44 @@ ProjectField <- function(ano, lat, lon, time_dim = 'sdate', if (any(!space_dim %in% names(dim(ano)))) { stop("Parameter 'space_dim' is not found in 'ano' dimension.") } - ## lat - if (!is.numeric(lat) | length(lat) != dim(ano)[space_dim[1]]) { - stop(paste0("Parameter 'lat' must be a numeric vector with the same ", - "length as the latitude dimension of 'ano'.")) + ## eof (2) + if (!all(space_dim %in% names(dim(eof$EOFs))) | + !'mode' %in% names(dim(eof$EOFs))) { + stop(paste0("The component 'EOFs' of parameter 'eof' must be an array ", + "with dimensions named as parameter 'space_dim' and 'mode'.")) } - if (any(lat > 90 | lat < -90)) { - stop("Parameter 'lat' must contain values within the range [-90, 90].") + # eof$EOFs should have the same dimensions as 'ano' except that ano doesn't have 'mode' and EOFs doesn't have time_dim + common_dim_ano <- dim(ano)[-which(names(dim(ano)) == time_dim)] + common_dim_eofs <- dim(eof$EOFs)[-which(names(dim(eof$EOFs)) == 'mode')] + raise_error <- FALSE + if (length(common_dim_ano) != length(common_dim_eofs)) { + raise_error <- TRUE + } else if (!all(names(common_dim_ano) %in% names(common_dim_eofs)) | + !all(names(common_dim_eofs) %in% names(common_dim_ano))) { + raise_error <- TRUE + } else { + order <- match(names(common_dim_ano), names(common_dim_eofs)) + if (any(common_dim_eofs[order] != common_dim_ano)) { + raise_error <- TRUE + } } - ## lon - if (!is.numeric(lon) | length(lon) != dim(ano)[space_dim[2]]) { - stop(paste0("Parameter 'lon' must be a numeric vector with the same ", - "length as the longitude dimension of 'ano'.")) + if (raise_error) { + stop(paste0("The component 'EOFs' of parameter 'eof' must have the ", + "same dimensions as 'ano' except that 'ano' does not have ", + "'mode' and 'EOFs' does not have time_dim.")) } - if (any(lon > 360 | lon < -360)) { - warning("Some 'lon' is out of the range [-360, 360].") + if (length(dim(eof$wght)) != 2 | !all(names(dim(eof$wght)) %in% space_dim)) { + stop(paste0("The component 'wght' of parameter 'eof' must be an array ", + "with dimensions named as parameter 'space_dim'.")) } ## mode if (!is.numeric(mode) | mode %% 1 != 0 | mode < 0 | length(mode) > 1) { stop("Parameter 'mode' must be a positive integer.") } + if (mode > dim(eof$EOFs)['mode']) { + stop(paste0("Parameter 'mode' is greater than the number of available ", + "modes in EOF.")) + } ## ncores if (!is.null(ncores)) { if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | @@ -113,16 +147,6 @@ ProjectField <- function(ano, lat, lon, time_dim = 'sdate', #------------------------------------------------------- - # Compute EOF - eof <- EOF(ano = ano, lat = lat, lon = lon, - time_dim = time_dim, space_dim = space_dim, - neofs = mode) - - if (mode > dim(eof$EOFs)[1]) { - stop(paste0("Parameter 'mode' is greater than the number of available ", - "modes in EOF.")) - } - # Keep the chosen mode eof_mode <- Subset(eof$EOFs, 'mode', mode, drop = 'selected') -- GitLab From e89c260638b226856f9125a0994a9592dc284850 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 3 Feb 2021 22:30:48 +0100 Subject: [PATCH 022/154] Use EOF() output as input instead of calculating EOF internally. --- tests/testthat/test-ProjectField.R | 94 ++++++++++++++++++++---------- 1 file changed, 62 insertions(+), 32 deletions(-) diff --git a/tests/testthat/test-ProjectField.R b/tests/testthat/test-ProjectField.R index eef3692..c306a7a 100644 --- a/tests/testthat/test-ProjectField.R +++ b/tests/testthat/test-ProjectField.R @@ -6,12 +6,14 @@ context("s2dv::ProjectField tests") dat1 <- array(rnorm(120), dim = c(sdate = 10, lat = 6, lon = 2)) lat1 <- seq(10, 30, length.out = 6) lon1 <- c(10, 12) + eof1 <- EOF(dat1, lat1, lon1) # dat2 set.seed(1) dat2 <- array(rnorm(48), dim = c(dat = 1, memb = 1, sdate = 6, ftime = 1, lat = 4, lon = 2)) lat2 <- seq(10, 30, length.out = 4) lon2 <- c(-5, 5) + eof2 <- EOF(dat2, lat2, lon2) # dat3 dat3 <- dat2 @@ -19,13 +21,14 @@ context("s2dv::ProjectField tests") names(dim(dat3)) <- names(dim(dat2)) lat3 <- seq(10, 30, length.out = 4) lon3 <- c(-5, 5) + eof3 <- EOF(dat3, lat3, lon3) # dat4 set.seed(1) dat4 <- array(rnorm(288), dim = c(dat = 1, memb = 2, sdate = 6, ftime = 3, lat = 4, lon = 2)) lat4 <- seq(-10, -30, length.out = 4) lon4 <- c(350, 355) - + eof4 <- EOF(dat4, lat4, lon4) ############################################## test_that("1. Input checks", { @@ -47,57 +50,84 @@ test_that("1. Input checks", { ProjectField(array(1:10, dim = c(2, 5))), "Parameter 'ano' must have dimension names." ) - # lat + # eof expect_error( - ProjectField(dat1, lat = 1:10, lon = lon1), - paste0("Parameter 'lat' must be a numeric vector with the same ", - "length as the latitude dimension of 'ano'.") + ProjectField(dat1, c()), + "Parameter 'eof' cannot be NULL." ) expect_error( - ProjectField(dat1, lat = seq(-100, -80, length.out = 6), lon = lon1), - "Parameter 'lat' must contain values within the range \\[-90, 90\\]." + ProjectField(dat1, c(1, 2, 3)), + "Parameter 'eof' must be a list generated by EOF()." ) - # lon expect_error( - ProjectField(dat1, lat = lat1, lon = c('a', 'b')), - paste0("Parameter 'lon' must be a numeric vector with the same ", - "length as the longitude dimension of 'ano'.") + ProjectField(dat1, list(a = 1)), + "Parameter 'eof' must contain 'EOFs' and 'wght' generated by EOF()." ) - expect_warning( - EOF(dat1, lat = lat1, lon = c(350, 370)), - "Some 'lon' is out of the range \\[-360, 360\\]." + eof_fake <- list(EOFs = 'a', wght = 1:10) + expect_error( + ProjectField(dat1, eof_fake), + "The component 'EOFs' of parameter 'eof' must be a numeric array." + ) + eof_fake <- list(EOFs = array(rnorm(10), dim = c(mode = 1, lat = 2, lon = 5)), + wght = c(1:10)) + expect_error( + ProjectField(dat1, eof_fake), + "The component 'wght' of parameter 'eof' must be a numeric array." ) # time_dim expect_error( - ProjectField(dat1, lat1, lon1, time_dim = 2), + ProjectField(dat1, eof1, time_dim = 2), "Parameter 'time_dim' must be a character string." ) expect_error( - ProjectField(dat1, lat1, lon1, time_dim = c('a','sdate')), + ProjectField(dat1, eof1, time_dim = c('a','sdate')), "Parameter 'time_dim' must be a character string." ) # space_dim expect_error( - ProjectField(dat1, lat1, lon1, space_dim = 'lat'), + ProjectField(dat1, eof1, space_dim = 'lat'), "Parameter 'space_dim' must be a character vector of 2." ) expect_error( - ProjectField(dat1, lat1, lon1, space_dim = c('latitude', 'longitude')), + ProjectField(dat1, eof1, space_dim = c('latitude', 'longitude')), "Parameter 'space_dim' is not found in 'ano' dimension." ) + # eof (2) + eof_fake <- list(EOFs = array(rnorm(10), dim = c(lat = 2, lon = 5)), + wght = array(rnorm(10), dim = c(lat = 2, lon = 5))) + expect_error( + ProjectField(dat1, eof_fake), + paste0("The component 'EOFs' of parameter 'eof' must be an array ", + "with dimensions named as parameter 'space_dim' and 'mode'.") + ) + eof_fake <- list(EOFs = array(rnorm(10), dim = c(mode = 1, lat = 6, lon = 3)), + wght = array(rnorm(10), dim = c(lat = 6, lon = 2))) + expect_error( + ProjectField(dat1, eof_fake), + paste0("The component 'EOFs' of parameter 'eof' must have the ", + "same dimensions as 'ano' except that 'ano' does not have ", + "'mode' and 'EOFs' does not have time_dim.") + ) + eof_fake <- list(EOFs = array(rnorm(10), dim = c(mode = 1, lat = 6, lon = 2)), + wght = array(rnorm(10), dim = c(level = 6, lon = 2))) + expect_error( + ProjectField(dat1, eof_fake), + paste0("The component 'wght' of parameter 'eof' must be an array ", + "with dimensions named as parameter 'space_dim'.") + ) # mode expect_error( - ProjectField(dat1, lat = lat1, lon = lon1, mode = -1), + ProjectField(dat1, eof1, mode = -1), "Parameter 'mode' must be a positive integer." ) expect_error( - ProjectField(dat1, lat = lat1, lon = lon1, mode = 15), + ProjectField(dat1, eof1, mode = 15), paste0("Parameter 'mode' is greater than the number of available ", "modes in EOF.") ) # ncores expect_error( - ProjectField(dat1, lat1, lon1, ncore = 3.5), + ProjectField(dat1, eof1, ncore = 3.5), "Parameter 'ncores' must be a positive integer." ) @@ -106,16 +136,16 @@ test_that("1. Input checks", { test_that("2. dat1", { expect_equal( - dim(ProjectField(dat1, lon = lon1, lat = lat1)), + dim(ProjectField(dat1, eof = eof1)), c(sdate = 10) ) expect_equal( - as.vector(ProjectField(dat1, lon = lon1, lat = lat1))[1:5], + as.vector(ProjectField(dat1, eof1))[1:5], c(3.2061306, -0.1692669, 0.5420990, -2.5324441, -0.6143680), tolerance = 0.0001 ) expect_equal( - as.vector(ProjectField(dat1, lon = lon1, lat = lat1, mode = 10))[1:5], + as.vector(ProjectField(dat1, eof1, mode = 10))[1:5], c(-0.24848299, -0.19311118, -0.16951195, -0.10000207, 0.04554693), tolerance = 0.0001 ) @@ -124,16 +154,16 @@ test_that("2. dat1", { ############################################## test_that("3. dat2", { expect_equal( - dim(ProjectField(dat2, lon = lon2, lat = lat2)), + dim(ProjectField(dat2, eof2)), c(sdate = 6, dat = 1, memb = 1, ftime = 1) ) expect_equal( - ProjectField(dat2, lon = lon2, lat = lat2)[1:6], + ProjectField(dat2, eof2)[1:6], c(0.00118771, -1.20872474, -0.00821559, -2.06064916, -0.19245169, 2.26026937), tolerance = 0.0001 ) expect_equal( - mean(ProjectField(dat2, lon = lon2, lat = lat2, mode = 6)), + mean(ProjectField(dat2, eof2, mode = 6)), 0.1741076, tolerance = 0.0001 ) @@ -143,11 +173,11 @@ test_that("3. dat2", { ############################################## test_that("4. dat3", { expect_equal( - dim(ProjectField(dat3, lon = lon3, lat = lat3)), + dim(ProjectField(dat3, eof3)), c(sdate = 6, dat = 1, memb = 1, ftime = 1) ) expect_equal( - ProjectField(dat3, lon = lon3, lat = lat3)[1:6], + ProjectField(dat3, eof3)[1:6], c(NA, 0, 0, 0, 0, 0), tolerance = 0.0001 ) @@ -156,16 +186,16 @@ test_that("4. dat3", { ############################################## test_that("5. dat4", { expect_equal( - dim(ProjectField(dat4, lon = lon4, lat = lat4)), + dim(ProjectField(dat4, eof4)), c(sdate = 6, dat = 1, memb = 2, ftime = 3) ) expect_equal( - mean(ProjectField(dat4, lon = lon4, lat = lat4)), + mean(ProjectField(dat4, eof4)), -0.1179755, tolerance = 0.0001 ) expect_equal( - ProjectField(dat4, lon = lon4, lat = lat4)[, 1, 2, 2], + ProjectField(dat4, eof4)[, 1, 2, 2], c(1.73869255, -2.58156427, 0.05340228, -0.53610350, -3.13985059, 1.58785066), tolerance = 0.0001 ) -- GitLab From 9b3915ae3b00c1b2c2afed8122ba92598d6ea4ba Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 5 Feb 2021 09:24:22 +0100 Subject: [PATCH 023/154] Transform NAO.R and PlotBoxWhisker.R from s2dverification --- R/NAO.R | 414 ++++++++++++++++++++++++++++++++++++++ R/PlotBoxWhisker.R | 242 ++++++++++++++++++++++ man/NAO.Rd | 124 ++++++++++++ man/PlotBoxWhisker.Rd | 146 ++++++++++++++ tests/testthat/test-NAO.R | 222 ++++++++++++++++++++ 5 files changed, 1148 insertions(+) create mode 100644 R/NAO.R create mode 100644 R/PlotBoxWhisker.R create mode 100644 man/NAO.Rd create mode 100644 man/PlotBoxWhisker.Rd create mode 100644 tests/testthat/test-NAO.R diff --git a/R/NAO.R b/R/NAO.R new file mode 100644 index 0000000..a73536a --- /dev/null +++ b/R/NAO.R @@ -0,0 +1,414 @@ +#'Compute the North Atlantic Oscillation (NAO) Index +#' +#'Compute the North Atlantic Oscillation (NAO) index based on the leading EOF +#'of the sea level pressure (SLP) anomalies over the north Atlantic region +#'(20N-80N, 80W-40E). The PCs are obtained by projecting the forecast and +#'observed anomalies onto the observed EOF pattern (Pobs) or the forecast +#'anomalies onto the EOF pattern of the other years of the forecast (Pmod). +#'By default (ftime_avg = 2:4) NAO() computes the NAO index for 1-month +#'lead seasonal forecasts that can be plotted with PlotBoxWhisker(). It returns +#'cross-validated PCs of the NAO index for forecast (exp) and observations +#'(obs) based on the leading EOF pattern. +#' +#'@param exp A named numeric array of North Atlantic SLP (20N-80N, 80W-40E) +#' forecast anomalies from \code{Ano()} or \code{Ano_CrossValid()} with +#' dimensions 'time_dim', 'memb_dim', 'ftime_dim', and 'space_dim' at least. +#' If only NAO of observational data needs to be computed, this parameter can +#' be left to NULL. The default value is NULL. +#'@param obs A named numeric array of North Atlantic SLP (20N-80N, 80W-40E) +#' observed anomalies from \code{Ano()} or \code{Ano_CrossValid()} with +#' dimensions 'time_dim', 'memb_dim', 'ftime_dim', and 'space_dim' at least. +#' If only NAO of experimental data needs to be computed, this parameter can +#' be left to NULL. The default value is NULL. +#'@param lat A vector of the latitudes of 'exp' and 'obs'. +#'@param lon A vector of the longitudes of 'exp' and 'obs'. +#'@param time_dim A character string indicating the name of the time dimension +#' of 'exp' and 'obs'. The default value is 'sdate'. +#'@param memb_dim A character string indicating the name of the member +#' dimension of 'exp' and 'obs'. The default value is 'member'. +#'@param space_dim A vector of two character strings. The first is the dimension +#' name of latitude of 'ano' and the second is the dimension name of longitude +#' of 'ano'. The default value is c('lat', 'lon'). +#'@param ftime_dim A character string indicating the name of the forecast time +#' dimension of 'exp' and 'obs'. The default value is 'ftime'. +#'@param ftime_avg A numeric vector of the forecast time steps to average +#' across the target period. The default value is 2:4, i.e., from 2nd to 4th +#' forecast time steps. +#'@param obsproj A logical value indicating whether to compute the NAO index by +#' projecting the forecast anomalies onto the leading EOF of observational +#' reference (TRUE) or compute the NAO by first computing the leading +#' EOF of the forecast anomalies (in cross-validation mode, i.e. leaving the +#' year you are evaluating out), and then projecting forecast anomalies onto +#' this EOF (FALSE). The default value is TRUE. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' +#'@return +#'A list which contains: +#'\item{exp}{ +#' A numeric array of forecast NAO index in verification format with the same +#' dimensions as 'exp' except space_dim and ftime_dim. +#' } +#'\item{obs}{ +#' A numeric array of observed NAO index in verification format with the same +#' dimensions as 'obs' except space_dim and ftime_dim. +#'} +#' +#'@references +#'Doblas-Reyes, F.J., Pavan, V. and Stephenson, D. (2003). The skill of +#' multi-model seasonal forecasts of the wintertime North Atlantic +#' Oscillation. Climate Dynamics, 21, 501-514. +#' DOI: 10.1007/s00382-003-0350-4 +#' +#'@examples +#' \dontshow{ +#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), +#' c('observation'), startDates, +#' leadtimemin = 1, +#' leadtimemax = 4, +#' output = 'lonlat', +#' latmin = 27, latmax = 48, +#' lonmin = -12, lonmax = 40) +#'# No example data is available over NAO region, so in this example we will +#'# tweak the available data. In a real use case, one can Load() the data over +#'# the NAO region directly. +#'sampleData$lon[] <- c(40, 280, 340) +#'sampleData$lat[] <- c(20, 80) +#' } +#' +#'# Now ready to compute the EOFs and project on, for example, the first +#'# variability mode. +#'ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) +#'# Note that computing the NAO over the region for which there is available +#'# example data is not the full NAO area: NAO() will raise a warning. +#'nao <- NAO(ano$exp, ano$obs, sampleData$lat, sampleData$lon) +#'# Finally plot the NAO index +#' \dontrun{ +#'nao$exp <- Reorder(nao$exp, c(2, 1)) +#'nao$obs <- Reorder(nao$obs, c(2, 1)) +#'PlotBoxWhisker(nao$exp, nao$obs, "NAO index, DJF", "NAO index (PC1) TOS", +#' monini = 12, yearini = 1985, freq = 1, "Exp. A", "Obs. X") +#' } +#' +#'@import multiApply +#'@importFrom ClimProjDiags Subset +#'@export +NAO <- function(exp = NULL, obs = NULL, lat, lon, time_dim = 'sdate', + memb_dim = 'member', space_dim = c('lat', 'lon'), + ftime_dim = 'ftime', ftime_avg = 2:4, + obsproj = TRUE, ncores = NULL) { + + # Check inputs + ## exp and obs (1) + if (is.null(obs) & is.null(exp)) { + stop("Parameter 'exp' and 'obs' cannot both be NULL.") + } + if (!is.null(exp)) { + if (!is.numeric(exp)) { + stop("Parameter 'exp' must be a numeric array.") + } + if (is.null(dim(exp))) { + stop(paste0("Parameter 'exp' and must have at least dimensions ", + "time_dim, memb_dim, space_dim, and ftime_dim.")) + } + if(any(is.null(names(dim(exp)))) | any(nchar(names(dim(exp))) == 0)) { + stop("Parameter 'exp' must have dimension names.") + } + } + if (!is.null(obs)) { + if (!is.numeric(obs)) { + stop("Parameter 'obs' must be a numeric array.") + } + if (is.null(dim(obs))) { + stop(paste0("Parameter 'obs' and must have at least dimensions ", + "time_dim, memb_dim, space_dim, and ftime_dim.")) + } + if(any(is.null(names(dim(obs)))) | any(nchar(names(dim(obs))) == 0)) { + stop("Parameter 'obs' 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 (!is.null(exp)) { + if (!time_dim %in% names(dim(exp))) { + stop("Parameter 'time_dim' is not found in 'exp' or 'obs' dimension.") + } + } + if (!is.null(obs)) { + if (!time_dim %in% names(dim(obs))) { + stop("Parameter 'time_dim' is not found in 'exp' or 'obs' dimension.") + } + } + ## memb_dim + if (!is.character(memb_dim) | length(memb_dim) > 1) { + stop("Parameter 'memb_dim' must be a character string.") + } + if (!is.null(exp)) { + if (!memb_dim %in% names(dim(exp))) { + stop("Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension.") + } + } + if (!is.null(obs)) { + if (!memb_dim %in% names(dim(obs))) { + stop("Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension.") + } + } + ## space_dim + if (!is.character(space_dim) | length(space_dim) != 2) { + stop("Parameter 'space_dim' must be a character vector of 2.") + } + if (!is.null(exp)) { + if (any(!space_dim %in% names(dim(exp)))) { + stop("Parameter 'space_dim' is not found in 'exp' or 'obs' dimension.") + } + } + if (!is.null(obs)) { + if (any(!space_dim %in% names(dim(obs)))) { + stop("Parameter 'space_dim' is not found in 'exp' or 'obs' dimension.") + } + } + ## ftime_dim + if (!is.character(ftime_dim) | length(ftime_dim) > 1) { + stop("Parameter 'ftime_dim' must be a character string.") + } + if (!is.null(exp)) { + if (!ftime_dim %in% names(dim(exp))) { + stop("Parameter 'ftime_dim' is not found in 'exp' or 'obs' dimension.") + } + } + if (!is.null(obs)) { + if (!ftime_dim %in% names(dim(obs))) { + stop("Parameter 'ftime_dim' is not found in 'exp' or 'obs' dimension.") + } + } + ## exp and obs (2) + if (!is.null(exp) & !is.null(obs)) { + name_exp <- sort(names(dim(exp))) + name_obs <- sort(names(dim(obs))) + 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])) { + stop(paste0("Parameter 'exp' and 'obs' must have the same length of ", + "all dimensions except 'memb_dim'.")) + } + } + ## ftime_avg + if (!is.vector(ftime_avg) | !is.integer(ftime_avg)) { + stop("Parameter 'ftime_avg' must be an integer vector.") + } + if (!is.null(exp)) { + if (max(ftime_avg) > dim(exp)[ftime_dim] | min(ftime_avg) < 1) { + stop("Parameter 'ftime_avg' must be within the range of ftime_dim length.") + } + } else { + if (max(ftime_avg) > dim(obs)[ftime_dim] | min(ftime_avg) < 1) { + stop("Parameter 'ftime_avg' must be within the range of ftime_dim length.") + } + } + ## sdate >= 2 + if (!is.null(exp)) { + if (dim(exp)[time_dim] < 2) { + stop("The length of time_dim must be at least 2.") + } + } else { + if (dim(obs)[time_dim] < 2) { + stop("The length of time_dim must be at least 2.") + } + } + ## lat and lon + if (!is.null(exp)) { + if (!is.numeric(lat) | length(lat) != dim(exp)[space_dim[1]]) { + stop(paste0("Parameter 'lat' must be a numeric vector with the same ", + "length as the latitude dimension of 'exp' and 'obs'.")) + } + if (!is.numeric(lon) | length(lon) != dim(exp)[space_dim[2]]) { + stop(paste0("Parameter 'lon' must be a numeric vector with the same ", + "length as the longitude dimension of 'exp' and 'obs'.")) + } + } else { + if (!is.numeric(lat) | length(lat) != dim(obs)[space_dim[1]]) { + stop(paste0("Parameter 'lat' must be a numeric vector with the same ", + "length as the latitude dimension of 'exp' and 'obs'.")) + } + if (!is.numeric(lon) | length(lon) != dim(obs)[space_dim[2]]) { + stop(paste0("Parameter 'lon' must be a numeric vector with the same ", + "length as the longitude dimension of 'exp' and 'obs'.")) + } + } + stop_needed <- FALSE + if (tail(lat, 1) < 70 | tail(lat, 1) > 90 | + head(lat, 1) > 30 | head(lat, 1) < 10) { + stop_needed <- TRUE + } + #NOTE: different from s2dverification + # lon is not used in the calculation actually. EOF only uses lat to do the + # weight. So we just need to ensure the data is in this region, regardless + # the order. + if (any(lon < 0)) { #[-180, 180] + if (!(min(lon) > -90 & min(lon) < -70 & max(lon) < 50 & max(lon) > 30)) { + stop_needed <- TRUE + } + } else { #[0, 360] + if (any(lon >= 50 & lon <= 270)) { + stop_needed <- TRUE + } else { + lon_E <- lon[which(lon < 50)] + lon_W <- lon[-which(lon < 50)] + if (max(lon_E) < 30 | min(lon_W) > 290) { + stop_needed <- TRUE + } + } + } + if (stop_needed) { + stop(paste0("The typical domain used to compute the NAO is 20N-80N, ", + "80W-40E. 'lat' or 'lon' is out of range.")) + } + ## obsproj + if (!is.logical(obsproj) | length(obsproj) > 1) { + stop("Parameter 'obsproj' must be either TRUE or FALSE.") + } + if (obsproj) { + if (is.null(obs)) { + stop("Parameter 'obsproj' set to TRUE but no 'obs' provided.") + } + if (is.null(exp)) { + .warning("parameter 'obsproj' set to TRUE but no 'exp' provided.") + } + } + ## 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.") + } + } + + #-------- Average ftime ----------- + if (!is.null(exp)) { + exp_sub <- ClimProjDiags::Subset(exp, ftime_dim, ftime_avg, drop = FALSE) + exp <- MeanDims(exp_sub, ftime_dim, na.rm = TRUE) + ## Cross-validated PCs. Fabian. This should be extended to + ## nmod and nlt by simple loops. Virginie + } + + if (!is.null(obs)) { + obs_sub <- ClimProjDiags::Subset(obs, ftime_dim, ftime_avg, drop = FALSE) + obs <- MeanDims(obs_sub, ftime_dim, na.rm = TRUE) + } + + if (!is.null(exp) & !is.null(obs)) { + res <- Apply(list(exp, obs), + target_dims = list(exp = c(memb_dim, time_dim, space_dim), + obs = c(memb_dim, time_dim, space_dim)), + fun = .NAO, + obsproj = obsproj, lat = lat, lon = lon, + ncores = ncores) + } else if (!is.null(exp)) { + res <- Apply(list(exp = exp), + target_dims = list(exp = c(memb_dim, time_dim, space_dim)), + fun = .NAO, + obsproj = obsproj, lat = lat, lon = lon, obs = NULL, + ncores = ncores) + } else if (!is.null(obs)) { + res <- Apply(list(obs = obs), + target_dims = list(obs = c(memb_dim, time_dim, space_dim)), + fun = .NAO, + obsproj = obsproj, lat = lat, lon = lon, exp = NULL, + ncores = ncores) + } + return(res) +} + +.NAO <- function(exp = NULL, obs = NULL, lat, lon, + obsproj = TRUE, ncores = NULL) { + # exp: [memb_exp, sdate, lat, lon] + # obs: [memb_obs, sdate, lat, lon] + if (!is.null(exp)) { + ntime <- dim(exp)[2] + nlat <- dim(exp)[3] + nlon <- dim(exp)[4] + nmemb_exp <- dim(exp)[1] + nmemb_obs <- dim(obs)[1] + } else { + ntime <- dim(obs)[2] + nlat <- dim(obs)[3] + nlon <- dim(obs)[4] + nmemb_obs <- dim(obs)[1] + } + + if (!is.null(obs)) NAOO.ver <- array(NA, dim = c(ntime, nmemb_obs)) + if (!is.null(exp)) NAOF.ver <- array(NA, dim = c(ntime, nmemb_exp)) + + for (tt in 1:ntime) { #sdate + + if (!is.null(obs)) { + ## Observed EOF excluding one forecast start year. + obs_sub <- ClimProjDiags::Subset(obs, 2, c(1:ntime)[-tt], drop = FALSE) + obs_EOF <- EOF(obs_sub, lat = lat, lon = lon, time_dim = names(ntime), + space_dim = c(names(nlat), names(nlon)), neofs = 1) + + ## Correct polarity of pattern. + #NOTE: different from s2dverification + # dim(obs_EOF$EOFs): [mode, lat, lon, member] + for (imemb in 1:nmemb_obs) { + if (0 < mean(obs_EOF$EOFs[1, which.min(abs(lat - 65)), , ], na.rm = T)) { + obs_EOF$EOFs[1, , , imemb] <- obs_EOF$EOFs[1, , , imemb] * (-1) + } + } +# obs_EOF$PCs <- obs_EOF$PCs * sign # not used + + ## Project observed anomalies. + PF <- ProjectField(obs, eof = obs_EOF, time_dim = names(ntime), + space_dim = c(names(nlat), names(nlon)), mode = 1) + NAOO.ver[tt, ] <- PF[tt, ] + ## Keep PCs of excluded forecast start year. Fabian. + } + + if (!is.null(exp)) { + if (!obsproj) { + exp_sub <- ClimProjDiags::Subset(exp, 2, c(1:ntime)[-tt], drop = FALSE) + #NOTE: different from s2dverification. Here, 'member' is considered. + exp_EOF <- EOF(exp_sub, lat = lat, lon = lon, time_dim = names(ntime), + space_dim = c(names(nlat), names(nlon)), neofs = 1) + + ## Correct polarity of pattern. + #NOTE: different from s2dverification + for (imemb in 1:nmemb_exp) { + if (0 < mean(exp_EOF$EOFs[1, which.min(abs(lat - 65)), , imemb], na.rm = T)) { + exp_EOF$EOFs[1, , , imemb] <- exp_EOF$EOFs[1, , , imemb] * (-1) + } + } +# exp_EOF$PCs <- exp_EOF$PCs * sign # not used + + ### Lines below could be simplified further by computing + ### ProjectField() only on the year of interest... (though this is + ### not vital). Lauriane + PF <- ProjectField(exp, eof = exp_EOF, time_dim = names(ntime), + space_dim = c(names(nlat), names(nlon)), mode = 1) + NAOF.ver[tt, ] <- PF[tt, ] + + } else { + ## Project forecast anomalies on obs EOF + #NOTE: Because obs and exp have different nmemb, do ensemble mean to + # obs_EOF$EOFs first, then expand the memb dim to be the same as exp. + obs_EOF$EOFs <- apply(obs_EOF$EOFs, c(1, 2, 3), mean, na.rm = T) + obs_EOF$EOFs <- array(obs_EOF$EOFs, dim = c(dim(obs_EOF$EOFs), as.numeric(nmemb_exp))) + names(dim(obs_EOF$EOFs))[4] <- names(nmemb_obs) + PF <- ProjectField(exp, obs_EOF, mode = 1) + NAOF.ver[tt, ] <- PF[tt, ] + } + } + } + #NOTE: EOFs_obs is not returned because it's only the result of the last sdate + # (It is returned in s2dverification.) + if (!is.null(exp) & !is.null(obs)) { + return(list(exp = NAOF.ver, obs = NAOO.ver)) #, EOFs_obs = obs_EOF)) + } else if (!is.null(exp)) { + return(list(exp = NAOF.ver)) + } else if (!is.null(obs)) { + return(list(obs = NAOO.ver)) + } +} diff --git a/R/PlotBoxWhisker.R b/R/PlotBoxWhisker.R new file mode 100644 index 0000000..2ddcec0 --- /dev/null +++ b/R/PlotBoxWhisker.R @@ -0,0 +1,242 @@ +#'Box-And-Whisker Plot of Time Series with Ensemble Distribution +#' +#'Produce time series of box-and-whisker plot showing the distribution of the +#'members of a forecast vs. the observed evolution. The correlation between +#'forecast and observational data is calculated and displayed. Only works for +#'n-monthly to n-yearly time series. +#' +#'@param exp Forecast array of multi-member time series, e.g., the NAO index +#' of one experiment. The expected dimensions are +#' c(members, start dates/forecast horizons). A vector with only the time +#' dimension can also be provided. Only monthly or lower frequency time +#' series are supported. See parameter freq. +#'@param obs Observational vector or array of time series, e.g., the NAO index +#' of the observations that correspond the forecast data in \code{exp}. +#' The expected dimensions are c(start dates/forecast horizons) or +#' c(1, start dates/forecast horizons). Only monthly or lower frequency time +#' series are supported. See parameter freq. +#'@param toptitle Character string to be drawn as figure title. +#'@param ytitle Character string to be drawn as y-axis title. +#'@param monini Number of the month of the first time step, from 1 to 12. +#'@param yearini Year of the first time step. +#'@param freq Frequency of the provided time series: 1 = yearly, 12 = monthly, +# 4 = seasonal, ... Default = 12. +#'@param expname Experimental dataset name. +#'@param obsname Name of the observational reference dataset. +#'@param drawleg TRUE/FALSE: whether to draw the legend or not. +#'@param fileout Name of output file. Extensions allowed: eps/ps, jpeg, png, +#' pdf, bmp and tiff. \cr +#' Default = 'output_PlotBox.ps'. +#'@param width File width, in the units specified in the parameter size_units +#' (inches by default). Takes 8 by default. +#'@param height File height, in the units specified in the parameter +#' size_units (inches by default). Takes 5 by default. +#'@param size_units Units of the size of the device (file or window) to plot +#' in. Inches ('in') by default. See ?Devices and the creator function of the +#' corresponding device. +#'@param res Resolution of the device (file or window) to plot in. See +#' ?Devices and the creator function of the corresponding device. +#'@param ... Arguments to be passed to the method. Only accepts the following +#' graphical parameters:\cr +#' ann ask bg cex.lab cex.sub cin col.axis col.lab col.main col.sub cra crt +#' csi cxy err family fg fig font font.axis font.lab font.main font.sub lend +#' lheight ljoin lmitre mex mfcol mfrow mfg mkh oma omd omi page pin plt pty +#' smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +#' For more information about the parameters see `par`. +#' +#'@return Generates a file at the path specified via \code{fileout}. +#' +#'@seealso EOF, ProjectField, NAO +#'@keywords datagen +#'@author History:\cr +#'0.1 - 2013-09 (F. Lienert, \email{flienert@@ic3.cat}) - Original code\cr +#'0.2 - 2015-03 (L. Batte, \email{lauriane.batte@@ic3.cat}) - Removed all\cr +#' normalization for sake of clarity. +#'1.0 - 2016-03 (N. Manubens, \email{nicolau.manubens@@bsc.es}) - Formatting to R CRAN +#'@examples +#'# See examples on Load() to understand the first lines in this example +#' \dontrun{ +#'data_path <- system.file('sample_data', package = 's2dverification') +#'expA <- list(name = 'experiment', path = file.path(data_path, +#' 'model/$EXP_NAME$/$STORE_FREQ$_mean/$VAR_NAME$_3hourly', +#' '$VAR_NAME$_$START_DATE$.nc')) +#'obsX <- list(name = 'observation', path = file.path(data_path, +#' '$OBS_NAME$/$STORE_FREQ$_mean/$VAR_NAME$', +#' '$VAR_NAME$_$YEAR$$MONTH$.nc')) +#' +#'# Now we are ready to use Load(). +#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +#'sampleData <- Load('tos', list(expA), list(obsX), startDates, +#' leadtimemin = 1, leadtimemax = 4, output = 'lonlat', +#' latmin = 27, latmax = 48, lonmin = -12, lonmax = 40) +#' } +#' \dontshow{ +#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), +#' c('observation'), startDates, +#' leadtimemin = 1, +#' leadtimemax = 4, +#' output = 'lonlat', +#' latmin = 20, latmax = 80, +#' lonmin = -80, lonmax = 40) +#'# No example data is available over NAO region, so in this example we will +#'# tweak the available data. In a real use case, one can Load() the data over +#'# NAO region directly. +#'sampleData$lon[] <- c(40, 280, 340) +#'sampleData$lat[] <- c(20, 80) +#' } +#'# Now ready to compute the EOFs and project on, for example, the first +#'# variability mode. +#'ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) +#'ano_exp <- array(ano$exp, dim = dim(ano$exp)[-2]) +#'ano_obs <- array(ano$obs, dim = dim(ano$obs)[-2]) +#'nao <- NAO(ano_exp, ano_obs, sampleData$lat, sampleData$lon) +#'# Finally plot the nao index +#' \dontrun{ +#'nao$exp <- Reorder(nao$exp, c(2, 1)) +#'nao$obs <- Reorder(nao$obs, c(2, 1)) +#'PlotBoxWhisker(nao$exp, nao$obs, "NAO index, DJF", "NAO index (PC1) TOS", +#' monini = 12, yearini = 1985, freq = 1, "Exp. A", "Obs. X") +#' } +#' +#'@importFrom grDevices dev.cur dev.new dev.off +#'@importFrom stats cor +#'@export +PlotBoxWhisker <- function(exp, obs, toptitle = '', ytitle = '', monini = 1, + yearini = 0, freq = 1, expname = "exp 1", + obsname = "obs 1", drawleg = TRUE, + fileout = NULL, + 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("adj", "bty", "cex", "cex.axis", "cex.main", "col", "din", "fin", "lab", "las", "lty", "lwd", "mai", "mar", "mgp", "new", "pch", "ps") + userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) + + # If there is any filenames to store the graphics, process them + # to select the right device + if (!is.null(fileout)) { + deviceInfo <- .SelectDevice(fileout = fileout, width = width, height = height, units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + # Checking exp + if (is.numeric(exp)) { + if (is.null(dim(exp)) || length(dim(exp)) == 1) { + dim(exp) <- c(1, length(exp)) + } + } + if (!is.numeric(exp) || length(dim(exp)) != 2) { + stop("Parameter 'exp' must be a numeric vector or array of dimensions c(forecast horizons/start dates) or c(ensemble members, forecast horizons/start dates)") + } + + # Checking obs + if (is.numeric(obs)) { + if (is.null(dim(obs)) || length(dim(obs)) == 1) { + dim(obs) <- c(1, length(obs)) + } + } + if (!is.numeric(obs) || length(dim(obs)) != 2) { + stop("Parameter 'obs' must be a numeric vector or array of dimensions c(forecast horizons/start dates) or c(1, forecast horizons/start dates)") + } + + # Checking consistency in exp and obs + if (dim(exp)[2] != dim(obs)[2]) { + stop("'exp' and 'obs' must have data for the same amount of time steps.") + } + + if (!is.character(toptitle) || !is.character(ytitle)) { + stop("Parameters 'ytitle' and 'toptitle' must be character strings.") + } + + if (!is.numeric(monini)) { + stop("'monini' must be a month number, from 1 to 12.") + } + if (monini < 1 || monini > 12) { + stop("'monini' must be >= 1 and <= 12.") + } + + if (!is.numeric(yearini)) { + stop("'yearini' must be a month number, from 1 to 12.") + } + + if (!is.numeric(freq)) { + stop("'freq' must be a number <= 12.") + } + + if (!is.character(expname) || !is.character(obsname)) { + stop("'expname' and 'obsname' must be character strings.") + } + + if (!is.logical(drawleg)) { + stop("Parameter 'drawleg' must be either TRUE or FALSE.") + } + + if (!is.character(fileout) && !is.null(fileout)) { + stop("Parameter 'fileout' must be a character string.") + } + + ntimesteps <- dim(exp)[2] + lastyear <- (monini + (ntimesteps - 1) * 12 / freq - 1) %/% 12 + yearini + lastmonth <- (monini + (ntimesteps - 1) * 12 / freq - 1) %% 12 + 1 + # + # Define some plot parameters + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + labind <- seq(1, ntimesteps) + months <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", + "Oct", "Nov", "Dec") + labyear <- ((labind - 1) * 12 / freq + monini - 1) %/% 12 + yearini + labmonth <- months[((labind - 1) * 12 / freq + monini - 1) %% 12 + 1] + for (jx in 1:length(labmonth)) { + y2o3dig <- paste("0", as.character(labyear[jx]), sep = "") + labmonth[jx] <- paste(labmonth[jx], "\nYr ", substr(y2o3dig, + nchar(y2o3dig) - 1, nchar(y2o3dig)), sep = "") + } + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, width = width, height = height) + } + + # Load the user parameters + par(userArgs) + + ## Observed time series. + #pc.o <- ts(obs[1, ], deltat = 1, start = yr1, end = yr2) + pc.o <- obs[1, ] + ## Normalization of obs, forecast members. Fabian + ## Normalization of forecast should be according to ensemble + ## mean, to keep info on ensemble spread, no? Lauriane pc.o <- + ## pc.o/sd(pc.o) sd.fc <- apply(exp,c(1),sd) + ## exp <- exp/sd.fc mn.fc <- + ## apply(exp,2, mean) exp <- + ## exp/sd(mn.fc) Produce plot. + par(mar = c(5, 6, 4, 2)) + boxplot(exp, add = FALSE, main = toptitle, + ylab = "", xlab = "", col = "red", lwd = 2, t = "b", + axes = FALSE, cex.main = 2, ylim = c(-max(abs(c(exp, pc.o))), max(abs(c(exp, pc.o))))) + lines(1:ntimesteps, pc.o, lwd = 3, col = "blue") + abline(h = 0, lty = 1) + if (drawleg) { + legend("bottomleft", c(obsname, expname), lty = c(1, 1), lwd = c(3, + 3), pch = c(NA, NA), col = c("blue", "red"), horiz = FALSE, + bty = "n", inset = 0.05) + } + ##mtext(1, line = 3, text = tar, cex = 1.9) + mtext(3, line = -2, text = paste(" AC =", round(cor(pc.o, + apply(exp, c(2), mean)), 2)), cex = 1.9, adj = 0) + axis(2, cex.axis = 2) + mtext(2, line = 3, text = ytitle, cex = 1.9) + par(mgp = c(0, 4, 0)) + ##axis(1, c(1:ntimesteps), NA, cex.axis = 2) + axis(1, seq(1, ntimesteps, by = 1), labmonth, cex.axis = 2) + box() + + # If the graphic was saved to file, close the connection with the device + if(!is.null(fileout)) dev.off() +} + diff --git a/man/NAO.Rd b/man/NAO.Rd new file mode 100644 index 0000000..c61a5ac --- /dev/null +++ b/man/NAO.Rd @@ -0,0 +1,124 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/NAO.R +\name{NAO} +\alias{NAO} +\title{Compute the North Atlantic Oscillation (NAO) Index} +\usage{ +NAO( + exp = NULL, + obs = NULL, + lat, + lon, + time_dim = "sdate", + memb_dim = "member", + space_dim = c("lat", "lon"), + ftime_dim = "ftime", + ftime_avg = 2:4, + obsproj = TRUE, + ncores = NULL +) +} +\arguments{ +\item{exp}{A named numeric array of North Atlantic SLP (20N-80N, 80W-40E) +forecast anomalies from \code{Ano()} or \code{Ano_CrossValid()} with +dimensions 'time_dim', 'memb_dim', 'ftime_dim', and 'space_dim' at least. +If only NAO of observational data needs to be computed, this parameter can +be left to NULL. The default value is NULL.} + +\item{obs}{A named numeric array of North Atlantic SLP (20N-80N, 80W-40E) +observed anomalies from \code{Ano()} or \code{Ano_CrossValid()} with +dimensions 'time_dim', 'memb_dim', 'ftime_dim', and 'space_dim' at least. +If only NAO of experimental data needs to be computed, this parameter can +be left to NULL. The default value is NULL.} + +\item{lat}{A vector of the latitudes of 'exp' and 'obs'.} + +\item{lon}{A vector of the longitudes of 'exp' and 'obs'.} + +\item{time_dim}{A character string indicating the name of the time dimension +of 'exp' and 'obs'. The default value is 'sdate'.} + +\item{memb_dim}{A character string indicating the name of the member +dimension of 'exp' and 'obs'. The default value is 'member'.} + +\item{space_dim}{A vector of two character strings. The first is the dimension +name of latitude of 'ano' and the second is the dimension name of longitude +of 'ano'. The default value is c('lat', 'lon').} + +\item{ftime_dim}{A character string indicating the name of the forecast time +dimension of 'exp' and 'obs'. The default value is 'ftime'.} + +\item{ftime_avg}{A numeric vector of the forecast time steps to average +across the target period. The default value is 2:4, i.e., from 2nd to 4th +forecast time steps.} + +\item{obsproj}{A logical value indicating whether to compute the NAO index by +projecting the forecast anomalies onto the leading EOF of observational +reference (TRUE) or compute the NAO by first computing the leading +EOF of the forecast anomalies (in cross-validation mode, i.e. leaving the +year you are evaluating out), and then projecting forecast anomalies onto +this EOF (FALSE). The default value is TRUE.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A list which contains: +\item{exp}{ + A numeric array of forecast NAO index in verification format with the same + dimensions as 'exp' except space_dim and ftime_dim. + } +\item{obs}{ + A numeric array of observed NAO index in verification format with the same + dimensions as 'obs' except space_dim and ftime_dim. +} +} +\description{ +Compute the North Atlantic Oscillation (NAO) index based on the leading EOF +of the sea level pressure (SLP) anomalies over the north Atlantic region +(20N-80N, 80W-40E). The PCs are obtained by projecting the forecast and +observed anomalies onto the observed EOF pattern (Pobs) or the forecast +anomalies onto the EOF pattern of the other years of the forecast (Pmod). +By default (ftime_avg = 2:4) NAO() computes the NAO index for 1-month +lead seasonal forecasts that can be plotted with PlotBoxWhisker(). It returns +cross-validated PCs of the NAO index for forecast (exp) and observations +(obs) based on the leading EOF pattern. +} +\examples{ + \dontshow{ +startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), + c('observation'), startDates, + leadtimemin = 1, + leadtimemax = 4, + output = 'lonlat', + latmin = 27, latmax = 48, + lonmin = -12, lonmax = 40) +# No example data is available over NAO region, so in this example we will +# tweak the available data. In a real use case, one can Load() the data over +# the NAO region directly. +sampleData$lon[] <- c(40, 280, 340) +sampleData$lat[] <- c(20, 80) + } + +# Now ready to compute the EOFs and project on, for example, the first +# variability mode. +ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) +# Note that computing the NAO over the region for which there is available +# example data is not the full NAO area: NAO() will raise a warning. +nao <- NAO(ano$exp, ano$obs, sampleData$lat, sampleData$lon) +# Finally plot the NAO index + \dontrun{ +nao$exp <- Reorder(nao$exp, c(2, 1)) +nao$obs <- Reorder(nao$obs, c(2, 1)) +PlotBoxWhisker(nao$exp, nao$obs, "NAO index, DJF", "NAO index (PC1) TOS", + monini = 12, yearini = 1985, freq = 1, "Exp. A", "Obs. X") + } + +} +\references{ +Doblas-Reyes, F.J., Pavan, V. and Stephenson, D. (2003). The skill of + multi-model seasonal forecasts of the wintertime North Atlantic + Oscillation. Climate Dynamics, 21, 501-514. + DOI: 10.1007/s00382-003-0350-4 +} diff --git a/man/PlotBoxWhisker.Rd b/man/PlotBoxWhisker.Rd new file mode 100644 index 0000000..9c5a3f4 --- /dev/null +++ b/man/PlotBoxWhisker.Rd @@ -0,0 +1,146 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PlotBoxWhisker.R +\name{PlotBoxWhisker} +\alias{PlotBoxWhisker} +\title{Box-And-Whisker Plot of Time Series with Ensemble Distribution} +\usage{ +PlotBoxWhisker( + exp, + obs, + toptitle = "", + ytitle = "", + monini = 1, + yearini = 0, + freq = 1, + expname = "exp 1", + obsname = "obs 1", + drawleg = TRUE, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) +} +\arguments{ +\item{exp}{Forecast array of multi-member time series, e.g., the NAO index +of one experiment. The expected dimensions are +c(members, start dates/forecast horizons). A vector with only the time +dimension can also be provided. Only monthly or lower frequency time +series are supported. See parameter freq.} + +\item{obs}{Observational vector or array of time series, e.g., the NAO index +of the observations that correspond the forecast data in \code{exp}. +The expected dimensions are c(start dates/forecast horizons) or +c(1, start dates/forecast horizons). Only monthly or lower frequency time +series are supported. See parameter freq.} + +\item{toptitle}{Character string to be drawn as figure title.} + +\item{ytitle}{Character string to be drawn as y-axis title.} + +\item{monini}{Number of the month of the first time step, from 1 to 12.} + +\item{yearini}{Year of the first time step.} + +\item{freq}{Frequency of the provided time series: 1 = yearly, 12 = monthly,} + +\item{expname}{Experimental dataset name.} + +\item{obsname}{Name of the observational reference dataset.} + +\item{drawleg}{TRUE/FALSE: whether to draw the legend or not.} + +\item{fileout}{Name of output file. Extensions allowed: eps/ps, jpeg, png, +pdf, bmp and tiff. \cr +Default = 'output_PlotBox.ps'.} + +\item{width}{File width, in the units specified in the parameter size_units +(inches by default). Takes 8 by default.} + +\item{height}{File height, in the units specified in the parameter +size_units (inches by default). Takes 5 by default.} + +\item{size_units}{Units of the size of the device (file or window) to plot +in. Inches ('in') by default. See ?Devices and the creator function of the +corresponding device.} + +\item{res}{Resolution of the device (file or window) to plot in. See +?Devices and the creator function of the corresponding device.} + +\item{...}{Arguments to be passed to the method. Only accepts the following +graphical parameters:\cr +ann ask bg cex.lab cex.sub cin col.axis col.lab col.main col.sub cra crt +csi cxy err family fg fig font font.axis font.lab font.main font.sub lend +lheight ljoin lmitre mex mfcol mfrow mfg mkh oma omd omi page pin plt pty +smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +For more information about the parameters see `par`.} +} +\value{ +Generates a file at the path specified via \code{fileout}. +} +\description{ +Produce time series of box-and-whisker plot showing the distribution of the +members of a forecast vs. the observed evolution. The correlation between +forecast and observational data is calculated and displayed. Only works for +n-monthly to n-yearly time series. +} +\examples{ +# See examples on Load() to understand the first lines in this example + \dontrun{ +data_path <- system.file('sample_data', package = 's2dverification') +expA <- list(name = 'experiment', path = file.path(data_path, + 'model/$EXP_NAME$/$STORE_FREQ$_mean/$VAR_NAME$_3hourly', + '$VAR_NAME$_$START_DATE$.nc')) +obsX <- list(name = 'observation', path = file.path(data_path, + '$OBS_NAME$/$STORE_FREQ$_mean/$VAR_NAME$', + '$VAR_NAME$_$YEAR$$MONTH$.nc')) + +# Now we are ready to use Load(). +startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +sampleData <- Load('tos', list(expA), list(obsX), startDates, + leadtimemin = 1, leadtimemax = 4, output = 'lonlat', + latmin = 27, latmax = 48, lonmin = -12, lonmax = 40) + } + \dontshow{ +startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), + c('observation'), startDates, + leadtimemin = 1, + leadtimemax = 4, + output = 'lonlat', + latmin = 20, latmax = 80, + lonmin = -80, lonmax = 40) +# No example data is available over NAO region, so in this example we will +# tweak the available data. In a real use case, one can Load() the data over +# NAO region directly. +sampleData$lon[] <- c(40, 280, 340) +sampleData$lat[] <- c(20, 80) + } +# Now ready to compute the EOFs and project on, for example, the first +# variability mode. +ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) +ano_exp <- array(ano$exp, dim = dim(ano$exp)[-2]) +ano_obs <- array(ano$obs, dim = dim(ano$obs)[-2]) +nao <- NAO(ano_exp, ano_obs, sampleData$lat, sampleData$lon) +# Finally plot the nao index + \dontrun{ +nao$exp <- Reorder(nao$exp, c(2, 1)) +nao$obs <- Reorder(nao$obs, c(2, 1)) +PlotBoxWhisker(nao$exp, nao$obs, "NAO index, DJF", "NAO index (PC1) TOS", + monini = 12, yearini = 1985, freq = 1, "Exp. A", "Obs. X") + } + +} +\seealso{ +EOF, ProjectField, NAO +} +\author{ +History:\cr +0.1 - 2013-09 (F. Lienert, \email{flienert@ic3.cat}) - Original code\cr +0.2 - 2015-03 (L. Batte, \email{lauriane.batte@ic3.cat}) - Removed all\cr + normalization for sake of clarity. +1.0 - 2016-03 (N. Manubens, \email{nicolau.manubens@bsc.es}) - Formatting to R CRAN +} +\keyword{datagen} diff --git a/tests/testthat/test-NAO.R b/tests/testthat/test-NAO.R new file mode 100644 index 0000000..d0acbd5 --- /dev/null +++ b/tests/testthat/test-NAO.R @@ -0,0 +1,222 @@ +context("s2dv::NAO tests") + +############################################## + # dat1 + set.seed(1) + exp1 <- array(rnorm(144), dim = c(member = 2, sdate = 3, ftime = 4, lat = 2, lon = 3)) + set.seed(2) + obs1 <- array(rnorm(72), dim = c(member = 1, sdate = 3, ftime = 4, lat = 2, lon = 3)) + lat1 <- c(20, 80) + lon1 <- c(40, 280, 350) + + # dat2 + set.seed(1) + exp2 <- array(rnorm(144), dim = c(sdate = 3, ftime = 4, member = 2, lat = 2, lon = 3)) + set.seed(2) + obs2 <- array(rnorm(144), dim = c(member = 2, sdate = 3, ftime = 4, lat = 2, lon = 3)) + lat2 <- c(20, 80) + lon2 <- c(-80, 0, 40) + +############################################## +test_that("1. Input checks", { + + # exp and obs (1) + expect_error( + NAO(c(), c()), + "Parameter 'exp' and 'obs' cannot both be NULL." + ) + expect_error( + NAO(exp = c(NA, NA)), + "Parameter 'exp' must be a numeric array." + ) + expect_error( + NAO(exp = c(1:10)), + paste0("Parameter 'exp' and must have at least dimensions ", + "time_dim, memb_dim, space_dim, and ftime_dim.") + ) + expect_error( + NAO(array(1:10, dim = c(2, 5))), + "Parameter 'exp' must have dimension names." + ) + expect_error( + NAO(exp = exp1, obs = c(NA, NA)), + "Parameter 'obs' must be a numeric array." + ) + expect_error( + NAO(exp = exp1, obs = c(1:10)), + paste0("Parameter 'obs' and must have at least dimensions ", + "time_dim, memb_dim, space_dim, and ftime_dim.") + ) + expect_error( + NAO(exp = exp1, obs = array(1:10, dim = c(2, 5))), + "Parameter 'obs' must have dimension names." + ) + # time_dim + expect_error( + NAO(exp1, obs1, time_dim = 2), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + NAO(exp1, obs1, time_dim = 'a'), + "Parameter 'time_dim' is not found in 'exp' or 'obs' dimension." + ) + # memb_dim + expect_error( + NAO(exp1, obs1, memb_dim = 2), + "Parameter 'memb_dim' must be a character string." + ) + expect_error( + NAO(exp1, obs1, memb_dim = 'a'), + "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." + ) + # space_dim + expect_error( + NAO(exp1, obs1, space_dim = 'lat'), + "Parameter 'space_dim' must be a character vector of 2." + ) + expect_error( + NAO(exp1, obs1, space_dim = c('latitude', 'longitude')), + "Parameter 'space_dim' is not found in 'exp' or 'obs' dimension." + ) + # ftime_dim + expect_error( + NAO(exp1, obs1, ftime_dim = 2), + "Parameter 'ftime_dim' must be a character string." + ) + expect_error( + NAO(exp1, obs1, ftime_dim = 'a'), + "Parameter 'ftime_dim' is not found in 'exp' or 'obs' dimension." + ) + # exp and obs (2) + expect_error( + NAO(exp1, array(rnorm(10), dim = c(member = 10, sdate = 3, ftime = 4, lat = 2, lon = 2))), + paste0("Parameter 'exp' and 'obs' must have the same length of ", + "all dimensions except 'memb_dim'.") + ) + # ftime_avg + expect_error( + NAO(exp1, obs1, ftime_avg = T), + "Parameter 'ftime_avg' must be an integer vector." + ) + expect_error( + NAO(exp1, obs1, ftime_avg = 1:10), +"Parameter 'ftime_avg' must be within the range of ftime_dim length." + ) + # sdate >= 2 + expect_error( + NAO(exp = array(rnorm(10), dim = c(member = 10, sdate = 1, ftime = 4, lat = 2, lon = 2)), + obs = array(rnorm(10), dim = c(member = 10, sdate = 1, ftime = 4, lat = 2, lon = 2))), + "The length of time_dim must be at least 2." + ) + # lat and lon + expect_error( + NAO(exp1, obs1, lat = 1:10), + paste0("Parameter 'lat' must be a numeric vector with the same ", + "length as the latitude dimension of 'exp' and 'obs'.") + ) + expect_error( + NAO(exp1, obs1, lat = lat1, lon = c('a', 'b')), + paste0("Parameter 'lon' must be a numeric vector with the same ", + "length as the longitude dimension of 'exp' and 'obs'.") + ) + expect_error( + NAO(exp1, obs1, lat = c(1, 2), lon = lon1), + paste0("The typical domain used to compute the NAO is 20N-80N, ", + "80W-40E. 'lat' or 'lon' is out of range.") + ) + expect_error( + NAO(exp1, obs1, lat = c(-10, -5), lon = lon1), + paste0("The typical domain used to compute the NAO is 20N-80N, ", + "80W-40E. 'lat' or 'lon' is out of range.") + ) + expect_error( + NAO(exp1, obs1, lat = lat1, lon = c(40, 50, 60)), + paste0("The typical domain used to compute the NAO is 20N-80N, ", + "80W-40E. 'lat' or 'lon' is out of range.") + ) + # obsproj + expect_error( + NAO(exp1, obs1, lat = lat1, lon = lon1, obsproj = 1), + "Parameter 'obsproj' must be either TRUE or FALSE." + ) + expect_error( + NAO(exp = exp1, lat = lat1, lon = lon1), + "Parameter 'obsproj' set to TRUE but no 'obs' provided." + ) + # ncores + expect_error( + NAO(exp1, obs1, lat1, lon1, ncore = 3.5), + "Parameter 'ncores' must be a positive integer." + ) + +}) +############################################## +test_that("2. dat1", { + + expect_equal( + names(NAO(exp1, obs1, lat = lat1, lon = lon1)), + c("exp", "obs") + ) + expect_equal( + dim(NAO(exp1, obs1, lat = lat1, lon = lon1)$exp), + c(sdate = 3, member = 2) + ) + expect_equal( + dim(NAO(exp1, obs1, lat = lat1, lon = lon1)$obs), + c(sdate = 3, member = 1) + ) + expect_equal( + NAO(exp1, obs1, lat = lat1, lon = lon1)$exp[1:5], + c(-0.1995564, -0.2996030, 0.7340010, -0.2747980, -0.3606155), + tolerance = 0.0001 + ) + expect_equal( + NAO(exp1, obs1, lat = lat1, lon = lon1)$obs[1:3], + c(-0.1139683, 0.1056687, 0.1889449), + tolerance = 0.0001 + ) + expect_equal( + mean(NAO(exp1, obs1, lat = lat1, lon = lon1, obsproj = FALSE)$exp), + -0.1362706, + tolerance = 0.0001 + ) + expect_equal( + names(NAO(exp = exp1, lat = lat1, lon = lon1, obsproj = FALSE)), + c("exp") + ) + suppressWarnings( + expect_equal( + names(NAO(obs = obs1, lat = lat1, lon = lon1)), + c("obs") + ) + ) + +}) +############################################## +test_that("3. dat2", { + expect_equal( + dim(NAO(exp2, obs2, lat = lat2, lon = lon2)$exp), + c(sdate = 3, member = 2) + ) + expect_equal( + dim(NAO(exp2, obs2, lat = lat2, lon = lon2)$obs), + c(sdate = 3, member = 2) + ) + expect_equal( + mean(NAO(exp2, obs2, lat = lat2, lon = lon2)$exp), + -0.01566486, + tolerance = 0.00001 + ) + expect_equal( + NAO(exp2, obs2, lat = lat2, lon = lon2)$exp[2:4], + c(0.16231137, -0.10984650, -0.01871716), + tolerance = 0.00001 + ) + expect_equal( + NAO(exp2, obs2, lat = lat2, lon = lon2, ftime_avg = 1:3)$exp[2:4], + c(-0.30102528, -0.06366782, 0.01639220), + tolerance = 0.00001 + ) +}) + +############################################## -- GitLab From 34596b670fb6ee7140f607cb37c2c9bbed32afc3 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 5 Feb 2021 09:25:43 +0100 Subject: [PATCH 024/154] Update documentation with devtools_2.2.1 --- DESCRIPTION | 2 +- NAMESPACE | 2 + R/Ano_CrossValid.R | 16 +++--- R/EOF.R | 2 +- R/ProjectField.R | 8 +-- man/AMV.Rd | 21 +++++-- man/AnimateMap.Rd | 33 ++++++++--- man/Ano.Rd | 1 - man/Ano_CrossValid.Rd | 18 ++++-- man/Clim.Rd | 16 ++++-- man/ColorBar.Rd | 32 ++++++++--- man/Composite.Rd | 14 ++++- man/ConfigApplyMatchingEntries.Rd | 11 +++- man/ConfigEditDefinition.Rd | 1 - man/ConfigEditEntry.Rd | 45 +++++++++++---- man/ConfigFileOpen.Rd | 3 +- man/ConfigShowSimilarEntries.Rd | 17 ++++-- man/ConfigShowTable.Rd | 3 +- man/Corr.Rd | 17 ++++-- man/EOF.Rd | 15 +++-- man/Eno.Rd | 1 - man/GMST.Rd | 24 ++++++-- man/GSAT.Rd | 21 +++++-- man/InsertDim.Rd | 1 - man/LeapYear.Rd | 1 - man/Load.Rd | 40 +++++++++---- man/MeanDims.Rd | 1 - man/Persistence.Rd | 17 ++++-- man/PlotAno.Rd | 31 +++++++--- man/PlotClim.Rd | 26 +++++++-- man/PlotEquiMap.Rd | 86 +++++++++++++++++++++------- man/PlotLayout.Rd | 73 ++++++++++++++++------- man/PlotMatrix.Rd | 29 +++++++--- man/PlotSection.Rd | 25 ++++++-- man/PlotStereoMap.Rd | 61 +++++++++++++++----- man/ProjectField.Rd | 23 +++++--- man/RMS.Rd | 14 ++++- man/RMSSS.Rd | 11 +++- man/RandomWalkTest.Rd | 1 - man/Regression.Rd | 14 ++++- man/Reorder.Rd | 1 - man/SPOD.Rd | 21 +++++-- man/Season.Rd | 13 ++++- man/Smoothing.Rd | 1 - man/TPI.Rd | 21 +++++-- man/ToyModel.Rd | 15 ++++- man/Trend.Rd | 13 ++++- man/clim.palette.Rd | 3 +- man/s2dv-package.Rd | 47 +++++++++++---- man/sampleDepthData.Rd | 1 - man/sampleMap.Rd | 1 - man/sampleTimeSeries.Rd | 1 - tests/testthat/test-Ano_CrossValid.R | 18 +++--- 53 files changed, 681 insertions(+), 252 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 126179a..30fd237 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -45,4 +45,4 @@ BugReports: https://earth.bsc.es/gitlab/es/s2dv/-/issues LazyData: true SystemRequirements: cdo Encoding: UTF-8 -RoxygenNote: 5.0.0 +RoxygenNote: 7.0.1 diff --git a/NAMESPACE b/NAMESPACE index 9726809..5264aec 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,8 +28,10 @@ export(InsertDim) export(LeapYear) export(Load) export(MeanDims) +export(NAO) export(Persistence) export(PlotAno) +export(PlotBoxWhisker) export(PlotClim) export(PlotEquiMap) export(PlotLayout) diff --git a/R/Ano_CrossValid.R b/R/Ano_CrossValid.R index cdbf233..e4a8b77 100644 --- a/R/Ano_CrossValid.R +++ b/R/Ano_CrossValid.R @@ -26,11 +26,11 @@ #' #'@return #'A list of 2: -#'\item{$ano_exp}{ +#'\item{$exp}{ #' A numeric array with the same dimensions as 'exp'. The dimension order may #' change. #'} -#'\item{$ano_obs}{ +#'\item{$obs}{ #' A numeric array with the same dimensions as 'obs'.The dimension order may #' change. #'} @@ -40,7 +40,7 @@ #'example(Load) #'anomalies <- Ano_CrossValid(sampleData$mod, sampleData$obs) #'\dontrun{ -#'PlotAno(anomalies$ano_exp, anomalies$ano_obs, startDates, +#'PlotAno(anomalies$exp, anomalies$obs, startDates, #' toptitle = paste('anomalies'), ytitle = c('K', 'K', 'K'), #' legends = 'ERSST', biglab = FALSE, fileout = 'tos_ano_crossvalid.eps') #'} @@ -115,8 +115,8 @@ 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])) { - stop(paste0("Parameter 'exp' and 'obs' must have same length of ", - "all dimension expect 'dat_dim'.")) + stop(paste0("Parameter 'exp' and 'obs' must have the same length of ", + "all dimensions except 'dat_dim'.")) } ############################### @@ -167,8 +167,8 @@ Ano_CrossValid <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', for (tt in 1:dim(exp)[1]) { #[sdate] # calculate clim - exp_sub <- Subset(exp_for_clim, 1, c(1:dim(exp)[1])[-tt]) - obs_sub <- Subset(obs_for_clim, 1, c(1:dim(obs)[1])[-tt]) + exp_sub <- ClimProjDiags::Subset(exp_for_clim, 1, c(1:dim(exp)[1])[-tt]) + obs_sub <- ClimProjDiags::Subset(obs_for_clim, 1, c(1:dim(obs)[1])[-tt]) clim_exp <- apply(exp_sub, c(1:length(dim(exp)))[-1], mean, na.rm = TRUE) # average out time_dim -> [dat, memb] clim_obs <- apply(obs_sub, c(1:length(dim(obs)))[-1], mean, na.rm = TRUE) @@ -217,5 +217,5 @@ Ano_CrossValid <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', ano_obs <- array(unlist(ano_obs_list), dim = c(dim(obs)[-1], dim(obs)[1])) ano_obs <- Reorder(ano_obs, c(length(dim(obs)), 1:(length(dim(obs)) - 1))) - return(list(ano_exp = ano_exp, ano_obs = ano_obs)) + return(list(exp = ano_exp, obs = ano_obs)) } diff --git a/R/EOF.R b/R/EOF.R index cf04c42..c595d4b 100644 --- a/R/EOF.R +++ b/R/EOF.R @@ -66,7 +66,7 @@ #' lonmin = -12, lonmax = 40) #'} #'ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) -#'tmp <- MeanDims(ano$ano_exp, c('dataset', 'member')) +#'tmp <- MeanDims(ano$exp, c('dataset', 'member')) #'ano <- tmp[, 1, ,] #'names(dim(ano)) <- names(dim(tmp))[-2] #'eof <- EOF(ano, sampleData$lat, sampleData$lon) diff --git a/R/ProjectField.R b/R/ProjectField.R index 16ab178..03ad210 100644 --- a/R/ProjectField.R +++ b/R/ProjectField.R @@ -36,10 +36,10 @@ #' lonmin = -12, lonmax = 40) #'} #'ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) -#'eof_exp <- EOF(ano$ano_exp, sampleData$lat, sampleData$lon) -#'eof_obs <- EOF(ano$ano_obs, sampleData$lat, sampleData$lon) -#'mode1_exp <- ProjectField(ano$ano_exp, eof_exp) -#'mode1_obs <- ProjectField(ano$ano_obs, eof_obs) +#'eof_exp <- EOF(ano$exp, sampleData$lat, sampleData$lon) +#'eof_obs <- EOF(ano$obs, sampleData$lat, sampleData$lon) +#'mode1_exp <- ProjectField(ano$exp, eof_exp) +#'mode1_obs <- ProjectField(ano$obs, eof_obs) #' #'\dontrun{ #' # Plot the forecast and the observation of the first mode for the last year diff --git a/man/AMV.Rd b/man/AMV.Rd index 5aa6d30..881e136 100644 --- a/man/AMV.Rd +++ b/man/AMV.Rd @@ -4,10 +4,22 @@ \alias{AMV} \title{Compute the Atlantic Multidecadal Variability (AMV) index} \usage{ -AMV(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +AMV( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -106,4 +118,3 @@ lon <- seq(0, 360, 10) index_dcpp <- AMV(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/AnimateMap.Rd b/man/AnimateMap.Rd index d2003ee..2ec930d 100644 --- a/man/AnimateMap.Rd +++ b/man/AnimateMap.Rd @@ -4,13 +4,33 @@ \alias{AnimateMap} \title{Animate Maps of Forecast/Observed Values or Scores Over Forecast Time} \usage{ -AnimateMap(var, lon, lat, toptitle = rep("", 11), sizetit = 1, units = "", - monini = 1, freq = 12, msk95lev = FALSE, brks = NULL, cols = NULL, - filled.continents = FALSE, lonmin = 0, lonmax = 360, latmin = -90, - latmax = 90, intlon = 20, intlat = 30, drawleg = TRUE, - subsampleg = 1, colNA = "white", equi = TRUE, +AnimateMap( + var, + lon, + lat, + toptitle = rep("", 11), + sizetit = 1, + units = "", + monini = 1, + freq = 12, + msk95lev = FALSE, + brks = NULL, + cols = NULL, + filled.continents = FALSE, + lonmin = 0, + lonmax = 360, + latmin = -90, + latmax = 90, + intlon = 20, + intlat = 30, + drawleg = TRUE, + subsampleg = 1, + colNA = "white", + equi = TRUE, fileout = c("output1_animvsltime.gif", "output2_animvsltime.gif", - "output3_animvsltime.gif"), ...) + "output3_animvsltime.gif"), + ... +) } \arguments{ \item{var}{Matrix of dimensions (nltime, nlat, nlon) or @@ -162,4 +182,3 @@ AnimateMap(clim$clim_exp, sampleData$lon, sampleData$lat, # More examples in s2dverification but are deleted for now } - diff --git a/man/Ano.Rd b/man/Ano.Rd index 2dd4dea..8e423af 100644 --- a/man/Ano.Rd +++ b/man/Ano.Rd @@ -41,4 +41,3 @@ PlotAno(ano_exp, ano_obs, startDates, legends = 'ERSST', biglab = FALSE, fileout = 'tos_ano.png') } } - diff --git a/man/Ano_CrossValid.Rd b/man/Ano_CrossValid.Rd index fa56a75..bef1524 100644 --- a/man/Ano_CrossValid.Rd +++ b/man/Ano_CrossValid.Rd @@ -4,8 +4,15 @@ \alias{Ano_CrossValid} \title{Compute anomalies in cross-validation mode} \usage{ -Ano_CrossValid(exp, obs, time_dim = "sdate", dat_dim = c("dataset", - "member"), memb_dim = "member", memb = TRUE, ncores = NULL) +Ano_CrossValid( + exp, + obs, + time_dim = "sdate", + dat_dim = c("dataset", "member"), + memb_dim = "member", + memb = TRUE, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least @@ -36,11 +43,11 @@ computation. The default value is NULL.} } \value{ A list of 2: -\item{$ano_exp}{ +\item{$exp}{ A numeric array with the same dimensions as 'exp'. The dimension order may change. } -\item{$ano_obs}{ +\item{$obs}{ A numeric array with the same dimensions as 'obs'.The dimension order may change. } @@ -55,9 +62,8 @@ technique and a per-pair method. example(Load) anomalies <- Ano_CrossValid(sampleData$mod, sampleData$obs) \dontrun{ -PlotAno(anomalies$ano_exp, anomalies$ano_obs, startDates, +PlotAno(anomalies$exp, anomalies$obs, startDates, toptitle = paste('anomalies'), ytitle = c('K', 'K', 'K'), legends = 'ERSST', biglab = FALSE, fileout = 'tos_ano_crossvalid.eps') } } - diff --git a/man/Clim.Rd b/man/Clim.Rd index a997a7f..78559bd 100644 --- a/man/Clim.Rd +++ b/man/Clim.Rd @@ -4,9 +4,18 @@ \alias{Clim} \title{Compute Bias Corrected Climatologies} \usage{ -Clim(exp, obs, time_dim = "sdate", dat_dim = c("dataset", "member"), - method = "clim", ftime_dim = "ftime", memb = TRUE, - memb_dim = "member", na.rm = TRUE, ncores = NULL) +Clim( + exp, + obs, + time_dim = "sdate", + dat_dim = c("dataset", "member"), + method = "clim", + ftime_dim = "ftime", + memb = TRUE, + memb_dim = "member", + na.rm = TRUE, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -82,4 +91,3 @@ PlotClim(clim$clim_exp, clim$clim_obs, listobs = c('ERSST'), biglab = FALSE, fileout = 'tos_clim.eps') } } - diff --git a/man/ColorBar.Rd b/man/ColorBar.Rd index 1287b70..6d62f15 100644 --- a/man/ColorBar.Rd +++ b/man/ColorBar.Rd @@ -4,13 +4,30 @@ \alias{ColorBar} \title{Draws a Color Bar} \usage{ -ColorBar(brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, - bar_limits = NULL, var_limits = NULL, triangle_ends = NULL, - col_inf = NULL, col_sup = NULL, color_fun = clim.palette(), - plot = TRUE, draw_ticks = TRUE, draw_separators = FALSE, - triangle_ends_scale = 1, extra_labels = NULL, title = NULL, - title_scale = 1, label_scale = 1, tick_scale = 1, - extra_margin = rep(0, 4), label_digits = 4, ...) +ColorBar( + brks = NULL, + cols = NULL, + vertical = TRUE, + subsampleg = NULL, + bar_limits = NULL, + var_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + color_fun = clim.palette(), + plot = TRUE, + draw_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + extra_labels = NULL, + title = NULL, + title_scale = 1, + label_scale = 1, + tick_scale = 1, + extra_margin = rep(0, 4), + label_digits = 4, + ... +) } \arguments{ \item{brks}{Can be provided in two formats: @@ -175,4 +192,3 @@ cols <- c("dodgerblue4", "dodgerblue1", "forestgreen", "yellowgreen", "white", lims <- seq(-1, 1, 0.2) ColorBar(lims, cols) } - diff --git a/man/Composite.Rd b/man/Composite.Rd index 64d5bfc..cc21d38 100644 --- a/man/Composite.Rd +++ b/man/Composite.Rd @@ -4,8 +4,17 @@ \alias{Composite} \title{Compute composites} \usage{ -Composite(data, occ, time_dim = "time", space_dim = c("lon", "lat"), - lag = 0, eno = FALSE, K = NULL, fileout = NULL, ncores = NULL) +Composite( + data, + occ, + time_dim = "time", + space_dim = c("lon", "lat"), + lag = 0, + eno = FALSE, + K = NULL, + fileout = NULL, + ncores = NULL +) } \arguments{ \item{data}{A numeric array containing two spatial and one temporal @@ -101,4 +110,3 @@ occ <- c(1, 1, 2, 2, 3, 3) res <- Composite(data, occ, time_dim = 'case', K = 4) } - diff --git a/man/ConfigApplyMatchingEntries.Rd b/man/ConfigApplyMatchingEntries.Rd index 5f0efb1..ee4cb5a 100644 --- a/man/ConfigApplyMatchingEntries.Rd +++ b/man/ConfigApplyMatchingEntries.Rd @@ -4,8 +4,14 @@ \alias{ConfigApplyMatchingEntries} \title{Apply Matching Entries To Dataset Name And Variable Name To Find Related Info} \usage{ -ConfigApplyMatchingEntries(configuration, var, exp = NULL, obs = NULL, - show_entries = FALSE, show_result = TRUE) +ConfigApplyMatchingEntries( + configuration, + var, + exp = NULL, + obs = NULL, + show_entries = FALSE, + show_result = TRUE +) } \arguments{ \item{configuration}{Configuration object obtained from ConfigFileOpen() @@ -68,4 +74,3 @@ ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigEditDefinition.Rd b/man/ConfigEditDefinition.Rd index 8e1e968..223e95a 100644 --- a/man/ConfigEditDefinition.Rd +++ b/man/ConfigEditDefinition.Rd @@ -57,4 +57,3 @@ match_info <- ConfigApplyMatchingEntries(configuration, 'tas', [ConfigEditEntry()], [ConfigFileOpen()], [ConfigShowSimilarEntries()], [ConfigShowTable()]. } - diff --git a/man/ConfigEditEntry.Rd b/man/ConfigEditEntry.Rd index 9abf3e5..e597709 100644 --- a/man/ConfigEditEntry.Rd +++ b/man/ConfigEditEntry.Rd @@ -1,22 +1,46 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigEditEntry.R \name{ConfigEditEntry} -\alias{ConfigAddEntry} \alias{ConfigEditEntry} +\alias{ConfigAddEntry} \alias{ConfigRemoveEntry} \title{Add, Remove Or Edit Entries In The Configuration} \usage{ -ConfigEditEntry(configuration, dataset_type, position, dataset_name = NULL, - var_name = NULL, main_path = NULL, file_path = NULL, - nc_var_name = NULL, suffix = NULL, varmin = NULL, varmax = NULL) +ConfigEditEntry( + configuration, + dataset_type, + position, + dataset_name = NULL, + var_name = NULL, + main_path = NULL, + file_path = NULL, + nc_var_name = NULL, + suffix = NULL, + varmin = NULL, + varmax = NULL +) -ConfigAddEntry(configuration, dataset_type, position = "last", - dataset_name = ".*", var_name = ".*", main_path = "*", - file_path = "*", nc_var_name = "*", suffix = "*", varmin = "*", - varmax = "*") +ConfigAddEntry( + configuration, + dataset_type, + position = "last", + dataset_name = ".*", + var_name = ".*", + main_path = "*", + file_path = "*", + nc_var_name = "*", + suffix = "*", + varmin = "*", + varmax = "*" +) -ConfigRemoveEntry(configuration, dataset_type, dataset_name = NULL, - var_name = NULL, position = NULL) +ConfigRemoveEntry( + configuration, + dataset_type, + dataset_name = NULL, + var_name = NULL, + position = NULL +) } \arguments{ \item{configuration}{Configuration object obtained via ConfigFileOpen() @@ -99,4 +123,3 @@ ConfigFileSave(configuration, config_file, confirm = FALSE) ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigFileOpen.Rd b/man/ConfigFileOpen.Rd index eee183f..893900b 100644 --- a/man/ConfigFileOpen.Rd +++ b/man/ConfigFileOpen.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigFileOpen.R \name{ConfigFileOpen} -\alias{ConfigFileCreate} \alias{ConfigFileOpen} +\alias{ConfigFileCreate} \alias{ConfigFileSave} \title{Functions To Create Open And Save Configuration File} \usage{ @@ -194,4 +194,3 @@ ConfigFileSave(configuration, config_file, confirm = FALSE) ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigShowSimilarEntries.Rd b/man/ConfigShowSimilarEntries.Rd index b9f80ce..72b77e1 100644 --- a/man/ConfigShowSimilarEntries.Rd +++ b/man/ConfigShowSimilarEntries.Rd @@ -4,10 +4,18 @@ \alias{ConfigShowSimilarEntries} \title{Find Similar Entries In Tables Of Datasets} \usage{ -ConfigShowSimilarEntries(configuration, dataset_name = NULL, - var_name = NULL, main_path = NULL, file_path = NULL, - nc_var_name = NULL, suffix = NULL, varmin = NULL, varmax = NULL, - n_results = 10) +ConfigShowSimilarEntries( + configuration, + dataset_name = NULL, + var_name = NULL, + main_path = NULL, + file_path = NULL, + nc_var_name = NULL, + suffix = NULL, + varmin = NULL, + varmax = NULL, + n_results = 10 +) } \arguments{ \item{configuration}{Configuration object obtained either from @@ -79,4 +87,3 @@ ConfigShowSimilarEntries(configuration, dataset_name = "Exper", ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigShowTable.Rd b/man/ConfigShowTable.Rd index 7c08053..5e4172a 100644 --- a/man/ConfigShowTable.Rd +++ b/man/ConfigShowTable.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigShowTable.R \name{ConfigShowTable} -\alias{ConfigShowDefinitions} \alias{ConfigShowTable} +\alias{ConfigShowDefinitions} \title{Show Configuration Tables And Definitions} \usage{ ConfigShowTable(configuration, dataset_type, line_numbers = NULL) @@ -54,4 +54,3 @@ ConfigShowDefinitions(configuration) [ConfigEditEntry()], [ConfigFileOpen()], [ConfigShowSimilarEntries()], [ConfigShowTable()]. } - diff --git a/man/Corr.Rd b/man/Corr.Rd index bf5575e..9c20ec1 100644 --- a/man/Corr.Rd +++ b/man/Corr.Rd @@ -4,9 +4,19 @@ \alias{Corr} \title{Compute the correlation coefficient between an array of forecast and their corresponding observation} \usage{ -Corr(exp, obs, time_dim = "sdate", dat_dim = "dataset", comp_dim = NULL, - limits = NULL, method = "pearson", pval = TRUE, conf = TRUE, - conf.lev = 0.95, ncores = NULL) +Corr( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + comp_dim = NULL, + limits = NULL, + method = "pearson", + pval = TRUE, + conf = TRUE, + conf.lev = 0.95, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -86,4 +96,3 @@ corr <- Corr(clim$clim_exp, clim$clim_obs, time_dim = 'ftime', dat_dim = 'member # Renew the example when Ano and Smoothing is ready } - diff --git a/man/EOF.Rd b/man/EOF.Rd index a81f779..32fd999 100644 --- a/man/EOF.Rd +++ b/man/EOF.Rd @@ -4,8 +4,16 @@ \alias{EOF} \title{Area-weighted empirical orthogonal function analysis using SVD} \usage{ -EOF(ano, lat, lon, time_dim = "sdate", space_dim = c("lat", "lon"), - neofs = 15, corr = FALSE, ncores = NULL) +EOF( + ano, + lat, + lon, + time_dim = "sdate", + space_dim = c("lat", "lon"), + neofs = 15, + corr = FALSE, + ncores = NULL +) } \arguments{ \item{ano}{A numerical array of anomalies with named dimensions to calculate @@ -81,7 +89,7 @@ sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), lonmin = -12, lonmax = 40) } ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) -tmp <- MeanDims(ano$ano_exp, c('dataset', 'member')) +tmp <- MeanDims(ano$exp, c('dataset', 'member')) ano <- tmp[, 1, ,] names(dim(ano)) <- names(dim(tmp))[-2] eof <- EOF(ano, sampleData$lat, sampleData$lon) @@ -93,4 +101,3 @@ PlotEquiMap(eof$EOFs[1, , ], sampleData$lon, sampleData$lat) \seealso{ ProjectField, NAO, PlotBoxWhisker } - diff --git a/man/Eno.Rd b/man/Eno.Rd index 32468bd..03c3b4f 100644 --- a/man/Eno.Rd +++ b/man/Eno.Rd @@ -39,4 +39,3 @@ data[na] <- NA res <- Eno(data) } - diff --git a/man/GMST.Rd b/man/GMST.Rd index 208ff75..03d1092 100644 --- a/man/GMST.Rd +++ b/man/GMST.Rd @@ -4,10 +4,25 @@ \alias{GMST} \title{Compute the Global Mean Surface Temperature (GMST) anomalies} \usage{ -GMST(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_value, type, - mask = NULL, lat_dim = "lat", lon_dim = "lon", monini = 11, - fmonth_dim = "fmonth", sdate_dim = "sdate", indices_for_clim = NULL, - year_dim = "year", month_dim = "month", member_dim = "member") +GMST( + data_tas, + data_tos, + data_lats, + data_lons, + mask_sea_land, + sea_value, + type, + mask = NULL, + lat_dim = "lat", + lon_dim = "lon", + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data_tas}{A numerical array indicating the surface air temperature data @@ -134,4 +149,3 @@ index_dcpp <- GMST(data_tas = dcpp_tas, data_tos = dcpp_tos, data_lats = lat, sea_value = sea_value) } - diff --git a/man/GSAT.Rd b/man/GSAT.Rd index 9d3fbb6..370900d 100644 --- a/man/GSAT.Rd +++ b/man/GSAT.Rd @@ -4,10 +4,22 @@ \alias{GSAT} \title{Compute the Global Surface Air Temperature (GSAT) anomalies} \usage{ -GSAT(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +GSAT( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -101,4 +113,3 @@ lon <- seq(0, 360, 10) index_dcpp <- GSAT(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/InsertDim.Rd b/man/InsertDim.Rd index 8ab628d..c0dd7d8 100644 --- a/man/InsertDim.Rd +++ b/man/InsertDim.Rd @@ -32,4 +32,3 @@ res <- InsertDim(InsertDim(a, posdim = 2, lendim = 1, name = 'e'), 4, c(f = 2)) dim(res) } - diff --git a/man/LeapYear.Rd b/man/LeapYear.Rd index d261b0a..c2960f3 100644 --- a/man/LeapYear.Rd +++ b/man/LeapYear.Rd @@ -21,4 +21,3 @@ print(LeapYear(1991)) print(LeapYear(1992)) print(LeapYear(1993)) } - diff --git a/man/Load.Rd b/man/Load.Rd index 214f984..10c03f9 100644 --- a/man/Load.Rd +++ b/man/Load.Rd @@ -4,15 +4,36 @@ \alias{Load} \title{Loads Experimental And Observational Data} \usage{ -Load(var, exp = NULL, obs = NULL, sdates, nmember = NULL, - nmemberobs = NULL, nleadtime = NULL, leadtimemin = 1, - leadtimemax = NULL, storefreq = "monthly", sampleperiod = 1, - lonmin = 0, lonmax = 360, latmin = -90, latmax = 90, - output = "areave", method = "conservative", grid = NULL, - maskmod = vector("list", 15), maskobs = vector("list", 15), - configfile = NULL, varmin = NULL, varmax = NULL, silent = FALSE, - nprocs = NULL, dimnames = NULL, remapcells = 2, - path_glob_permissive = "partial") +Load( + var, + exp = NULL, + obs = NULL, + sdates, + nmember = NULL, + nmemberobs = NULL, + nleadtime = NULL, + leadtimemin = 1, + leadtimemax = NULL, + storefreq = "monthly", + sampleperiod = 1, + lonmin = 0, + lonmax = 360, + latmin = -90, + latmax = 90, + output = "areave", + method = "conservative", + grid = NULL, + maskmod = vector("list", 15), + maskobs = vector("list", 15), + configfile = NULL, + varmin = NULL, + varmax = NULL, + silent = FALSE, + nprocs = NULL, + dimnames = NULL, + remapcells = 2, + path_glob_permissive = "partial" +) } \arguments{ \item{var}{Short name of the variable to load. It should coincide with the @@ -874,4 +895,3 @@ sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), lonmin = -12, lonmax = 40) } } - diff --git a/man/MeanDims.Rd b/man/MeanDims.Rd index adff306..9c874fc 100644 --- a/man/MeanDims.Rd +++ b/man/MeanDims.Rd @@ -39,4 +39,3 @@ History:\cr 3.0 - 2020-01 (A. Ho, \email{an.ho@bsc.es}) - Preserve dimension names } \keyword{datagen} - diff --git a/man/Persistence.Rd b/man/Persistence.Rd index 33d4868..3582633 100644 --- a/man/Persistence.Rd +++ b/man/Persistence.Rd @@ -4,9 +4,19 @@ \alias{Persistence} \title{Compute persistence} \usage{ -Persistence(data, dates, time_dim = "time", start, end, ft_start, - ft_end = ft_start, max_ft = 10, nmemb = 1, na.action = 10, - ncores = NULL) +Persistence( + data, + dates, + time_dim = "time", + start, + end, + ft_start, + ft_end = ft_start, + max_ft = 10, + nmemb = 1, + na.action = 10, + ncores = NULL +) } \arguments{ \item{data}{A numeric array corresponding to the observational data @@ -98,4 +108,3 @@ persist <- Persistence(obs1, dates = dates, start = 1961, end = 2005, ft_start = nmemb = 40) } - diff --git a/man/PlotAno.Rd b/man/PlotAno.Rd index 18bf0c9..6591ef1 100644 --- a/man/PlotAno.Rd +++ b/man/PlotAno.Rd @@ -4,12 +4,30 @@ \alias{PlotAno} \title{Plot Anomaly time series} \usage{ -PlotAno(exp_ano, obs_ano = NULL, sdates, toptitle = rep("", 15), - ytitle = rep("", 15), limits = NULL, legends = NULL, freq = 12, - biglab = FALSE, fill = TRUE, memb = TRUE, ensmean = TRUE, - linezero = FALSE, points = FALSE, vlines = NULL, sizetit = 1, - fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, - ...) +PlotAno( + exp_ano, + obs_ano = NULL, + sdates, + toptitle = rep("", 15), + ytitle = rep("", 15), + limits = NULL, + legends = NULL, + freq = 12, + biglab = FALSE, + fill = TRUE, + memb = TRUE, + ensmean = TRUE, + linezero = FALSE, + points = FALSE, + vlines = NULL, + sizetit = 1, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{exp_ano}{A numerical array containing the experimental data:\cr @@ -100,4 +118,3 @@ PlotAno(smooth_ano_exp, smooth_ano_obs, startDates, legends = 'ERSST', biglab = FALSE) } - diff --git a/man/PlotClim.Rd b/man/PlotClim.Rd index b62ff44..9b3381e 100644 --- a/man/PlotClim.Rd +++ b/man/PlotClim.Rd @@ -4,11 +4,26 @@ \alias{PlotClim} \title{Plots Climatologies} \usage{ -PlotClim(exp_clim, obs_clim = NULL, toptitle = "", ytitle = "", - monini = 1, freq = 12, limits = NULL, listexp = c("exp1", "exp2", - "exp3"), listobs = c("obs1", "obs2", "obs3"), biglab = FALSE, - leg = TRUE, sizetit = 1, fileout = NULL, width = 8, height = 5, - size_units = "in", res = 100, ...) +PlotClim( + exp_clim, + obs_clim = NULL, + toptitle = "", + ytitle = "", + monini = 1, + freq = 12, + limits = NULL, + listexp = c("exp1", "exp2", "exp3"), + listobs = c("obs1", "obs2", "obs3"), + biglab = FALSE, + leg = TRUE, + sizetit = 1, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{exp_clim}{Matrix containing the experimental data with dimensions:\cr @@ -79,4 +94,3 @@ PlotClim(clim$clim_exp, clim$clim_obs, toptitle = paste('climatologies'), listobs = c('ERSST'), biglab = FALSE, fileout = NULL) } - diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index cf45ead..fbd7042 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -4,25 +4,72 @@ \alias{PlotEquiMap} \title{Maps A Two-Dimensional Variable On A Cylindrical Equidistant Projection} \usage{ -PlotEquiMap(var, lon, lat, varu = NULL, varv = NULL, toptitle = NULL, - sizetit = NULL, units = NULL, brks = NULL, cols = NULL, - bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, - col_sup = NULL, colNA = NULL, color_fun = clim.palette(), - square = TRUE, filled.continents = NULL, coast_color = NULL, - coast_width = 1, contours = NULL, brks2 = NULL, contour_lwd = 0.5, - contour_color = "black", contour_lty = 1, contour_label_scale = 1, - dots = NULL, dot_symbol = 4, dot_size = 1, - arr_subsamp = floor(length(lon)/30), arr_scale = 1, arr_ref_len = 15, - arr_units = "m/s", arr_scale_shaft = 1, arr_scale_shaft_angle = 1, - axelab = TRUE, labW = FALSE, intylat = 20, intxlon = 20, - axes_tick_scale = 1, axes_label_scale = 1, drawleg = TRUE, - subsampleg = NULL, bar_extra_labels = NULL, draw_bar_ticks = TRUE, - draw_separators = FALSE, triangle_ends_scale = 1, bar_label_digits = 4, - bar_label_scale = 1, units_scale = 1, bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), boxlim = NULL, boxcol = "purple2", - boxlwd = 5, margin_scale = rep(1, 4), title_scale = 1, numbfig = NULL, - fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, - ...) +PlotEquiMap( + var, + lon, + lat, + varu = NULL, + varv = NULL, + toptitle = NULL, + sizetit = NULL, + units = NULL, + brks = NULL, + cols = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + colNA = NULL, + color_fun = clim.palette(), + square = TRUE, + filled.continents = NULL, + coast_color = NULL, + coast_width = 1, + contours = NULL, + brks2 = NULL, + contour_lwd = 0.5, + contour_color = "black", + contour_lty = 1, + contour_label_scale = 1, + dots = NULL, + dot_symbol = 4, + dot_size = 1, + arr_subsamp = floor(length(lon)/30), + arr_scale = 1, + arr_ref_len = 15, + arr_units = "m/s", + arr_scale_shaft = 1, + arr_scale_shaft_angle = 1, + axelab = TRUE, + labW = FALSE, + intylat = 20, + intxlon = 20, + axes_tick_scale = 1, + axes_label_scale = 1, + drawleg = TRUE, + subsampleg = NULL, + bar_extra_labels = NULL, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_label_digits = 4, + bar_label_scale = 1, + units_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + boxlim = NULL, + boxcol = "purple2", + boxlwd = 5, + margin_scale = rep(1, 4), + title_scale = 1, + numbfig = NULL, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Array with the values at each cell of a grid on a regular @@ -278,4 +325,3 @@ 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) } - diff --git a/man/PlotLayout.Rd b/man/PlotLayout.Rd index f01fdf9..453cf2e 100644 --- a/man/PlotLayout.Rd +++ b/man/PlotLayout.Rd @@ -4,20 +4,52 @@ \alias{PlotLayout} \title{Arrange and Fill Multi-Pannel Layouts With Optional Colour Bar} \usage{ -PlotLayout(fun, plot_dims, var, ..., special_args = NULL, nrow = NULL, - ncol = NULL, toptitle = NULL, row_titles = NULL, col_titles = NULL, - bar_scale = 1, title_scale = 1, title_margin_scale = 1, - title_left_shift_scale = 1, subtitle_scale = 1, - subtitle_margin_scale = 1, brks = NULL, cols = NULL, drawleg = "S", - titles = NULL, subsampleg = NULL, bar_limits = NULL, - triangle_ends = NULL, col_inf = NULL, col_sup = NULL, - color_fun = clim.colors, draw_bar_ticks = TRUE, draw_separators = FALSE, - triangle_ends_scale = 1, bar_extra_labels = NULL, units = NULL, - units_scale = 1, bar_label_scale = 1, bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), bar_left_shift_scale = 1, - bar_label_digits = 4, extra_margin = rep(0, 4), fileout = NULL, - width = NULL, height = NULL, size_units = "in", res = 100, - close_device = TRUE) +PlotLayout( + fun, + plot_dims, + var, + ..., + special_args = NULL, + nrow = NULL, + ncol = NULL, + toptitle = NULL, + row_titles = NULL, + col_titles = NULL, + bar_scale = 1, + title_scale = 1, + title_margin_scale = 1, + title_left_shift_scale = 1, + subtitle_scale = 1, + subtitle_margin_scale = 1, + brks = NULL, + cols = NULL, + drawleg = "S", + titles = NULL, + subsampleg = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + color_fun = clim.colors, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_extra_labels = NULL, + units = NULL, + units_scale = 1, + bar_label_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + bar_left_shift_scale = 1, + bar_label_digits = 4, + extra_margin = rep(0, 4), + fileout = NULL, + width = NULL, + height = NULL, + size_units = "in", + res = 100, + close_device = TRUE +) } \arguments{ \item{fun}{Plot function (or name of the function) to be called on the @@ -48,6 +80,12 @@ applied to each of them. NAs can be passed to the list: a NA will yield a blank cell in the layout, which can be populated after (see .SwitchToFigure).} +\item{\dots}{Parameters to be sent to the plotting function 'fun'. If +multiple arrays are provided in 'var' and multiple functions are provided +in 'fun', the parameters provided through \dots will be sent to all the +plot functions, as common parameters. To specify concrete arguments for +each of the plot functions see parameter 'special_args'.} + \item{special_args}{List of sub-lists, each sub-list having specific extra arguments for each of the plot functions provided in 'fun'. If you want to fix a different value for each plot in the layout you can do so by @@ -164,12 +202,6 @@ the layout and a 'fileout' has been specified. This is useful to avoid closing the device when saving the layout into a file and willing to add extra elements or figures. Takes TRUE by default. Disregarded if no 'fileout' has been specified.} - -\item{\dots}{Parameters to be sent to the plotting function 'fun'. If -multiple arrays are provided in 'var' and multiple functions are provided -in 'fun', the parameters provided through \dots will be sent to all the -plot functions, as common parameters. To specify concrete arguments for -each of the plot functions see parameter 'special_args'.} } \value{ \item{brks}{ @@ -244,4 +276,3 @@ PlotLayout(PlotEquiMap, c('lat', 'lon'), sampleData$mod[1, , 1, 1, , ], titles = paste('Member', 1:15)) } - diff --git a/man/PlotMatrix.Rd b/man/PlotMatrix.Rd index 24f046d..5275df0 100644 --- a/man/PlotMatrix.Rd +++ b/man/PlotMatrix.Rd @@ -4,12 +4,28 @@ \alias{PlotMatrix} \title{Function to convert any numerical table to a grid of coloured squares.} \usage{ -PlotMatrix(var, brks = NULL, cols = NULL, toptitle = NULL, - title.color = "royalblue4", xtitle = NULL, ytitle = NULL, - xlabels = NULL, xvert = FALSE, ylabels = NULL, line = 3, - figure.width = 1, legend = TRUE, legend.width = 0.15, - xlab_dist = NULL, ylab_dist = NULL, fileout = NULL, size_units = "px", - res = 100, ...) +PlotMatrix( + var, + brks = NULL, + cols = NULL, + toptitle = NULL, + title.color = "royalblue4", + xtitle = NULL, + ytitle = NULL, + xlabels = NULL, + xvert = FALSE, + ylabels = NULL, + line = 3, + figure.width = 1, + legend = TRUE, + legend.width = 0.15, + xlab_dist = NULL, + ylab_dist = NULL, + fileout = NULL, + size_units = "px", + res = 100, + ... +) } \arguments{ \item{var}{A numerical matrix containing the values to be displayed in a @@ -93,4 +109,3 @@ PlotMatrix(var = matrix(rnorm(n = 120, mean = 0.3), 10, 12), xlabels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")) } - diff --git a/man/PlotSection.Rd b/man/PlotSection.Rd index 413ef63..1627339 100644 --- a/man/PlotSection.Rd +++ b/man/PlotSection.Rd @@ -4,10 +4,26 @@ \alias{PlotSection} \title{Plots A Vertical Section} \usage{ -PlotSection(var, horiz, depth, toptitle = "", sizetit = 1, units = "", - brks = NULL, cols = NULL, axelab = TRUE, intydep = 200, - intxhoriz = 20, drawleg = TRUE, fileout = NULL, width = 8, - height = 5, size_units = "in", res = 100, ...) +PlotSection( + var, + horiz, + depth, + toptitle = "", + sizetit = 1, + units = "", + brks = NULL, + cols = NULL, + axelab = TRUE, + intydep = 200, + intxhoriz = 20, + drawleg = TRUE, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Matrix to plot with (longitude/latitude, depth) dimensions.} @@ -69,4 +85,3 @@ sampleData <- s2dv::sampleDepthData PlotSection(sampleData$mod[1, 1, 1, 1, , ], sampleData$lat, sampleData$depth, toptitle = 'temperature 1995-11 member 0') } - diff --git a/man/PlotStereoMap.Rd b/man/PlotStereoMap.Rd index 4b910a9..95c2f71 100644 --- a/man/PlotStereoMap.Rd +++ b/man/PlotStereoMap.Rd @@ -4,19 +4,53 @@ \alias{PlotStereoMap} \title{Maps A Two-Dimensional Variable On A Polar Stereographic Projection} \usage{ -PlotStereoMap(var, lon, lat, latlims = c(60, 90), toptitle = NULL, - sizetit = NULL, units = NULL, brks = NULL, cols = NULL, - bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, - col_sup = NULL, colNA = NULL, color_fun = clim.palette(), - filled.continents = FALSE, coast_color = NULL, coast_width = 1, - dots = NULL, dot_symbol = 4, dot_size = 0.8, intlat = 10, - drawleg = TRUE, subsampleg = NULL, bar_extra_labels = NULL, - draw_bar_ticks = TRUE, draw_separators = FALSE, triangle_ends_scale = 1, - bar_label_digits = 4, bar_label_scale = 1, units_scale = 1, - bar_tick_scale = 1, bar_extra_margin = rep(0, 4), boxlim = NULL, - boxcol = "purple2", boxlwd = 5, margin_scale = rep(1, 4), - title_scale = 1, numbfig = NULL, fileout = NULL, width = 6, - height = 5, size_units = "in", res = 100, ...) +PlotStereoMap( + var, + lon, + lat, + latlims = c(60, 90), + toptitle = NULL, + sizetit = NULL, + units = NULL, + brks = NULL, + cols = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + colNA = NULL, + color_fun = clim.palette(), + filled.continents = FALSE, + coast_color = NULL, + coast_width = 1, + dots = NULL, + dot_symbol = 4, + dot_size = 0.8, + intlat = 10, + drawleg = TRUE, + subsampleg = NULL, + bar_extra_labels = NULL, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_label_digits = 4, + bar_label_scale = 1, + units_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + boxlim = NULL, + boxcol = "purple2", + boxlwd = 5, + margin_scale = rep(1, 4), + title_scale = 1, + numbfig = NULL, + fileout = NULL, + width = 6, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Array with the values at each cell of a grid on a regular @@ -183,4 +217,3 @@ y <- seq(from = -90, to = 90, length.out = 50) PlotStereoMap(data, x, y, latlims = c(60, 90), brks = 50, toptitle = "This is the title") } - diff --git a/man/ProjectField.Rd b/man/ProjectField.Rd index 198db05..d2bd9fb 100644 --- a/man/ProjectField.Rd +++ b/man/ProjectField.Rd @@ -4,16 +4,22 @@ \alias{ProjectField} \title{Project anomalies onto modes of variability} \usage{ -ProjectField(ano, lat, lon, time_dim = "sdate", space_dim = c("lat", "lon"), - mode = 1, ncores = NULL) +ProjectField( + ano, + eof, + time_dim = "sdate", + space_dim = c("lat", "lon"), + mode = 1, + ncores = NULL +) } \arguments{ \item{ano}{A numerical array of anomalies with named dimensions. The dimensions must have at least 'time_dim' and 'space_dim'.} -\item{lat}{A vector of the latitudes of 'ano' to calculate EOF.} - -\item{lon}{A vector of the longitudes of 'ano' to calculate EOF.} +\item{eof}{A list contains at least 'EOFs' and 'wght', which are both arrays. +'EOFs' has dimensions same as 'ano' except 'EOFs' has 'mode' and 'ano' has + time_dim. 'wght' has dimensions space_dim. It can be generated by EOF().} \item{time_dim}{A character string indicating the name of the time dimension of 'ano'. The default value is 'sdate'.} @@ -50,8 +56,10 @@ sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), lonmin = -12, lonmax = 40) } ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) -mode1_exp <- ProjectField(ano$ano_exp, sampleData$lat, sampleData$lon) -mode1_obs <- ProjectField(ano$ano_obs, sampleData$lat, sampleData$lon) +eof_exp <- EOF(ano$exp, sampleData$lat, sampleData$lon) +eof_obs <- EOF(ano$obs, sampleData$lat, sampleData$lon) +mode1_exp <- ProjectField(ano$exp, eof_exp) +mode1_obs <- ProjectField(ano$obs, eof_obs) \dontrun{ # Plot the forecast and the observation of the first mode for the last year @@ -70,4 +78,3 @@ mode1_obs <- ProjectField(ano$ano_obs, sampleData$lat, sampleData$lon) \seealso{ EOF, NAO, PlotBoxWhisker } - diff --git a/man/RMS.Rd b/man/RMS.Rd index 7bd33b3..4391df4 100644 --- a/man/RMS.Rd +++ b/man/RMS.Rd @@ -4,8 +4,17 @@ \alias{RMS} \title{Compute root mean square error} \usage{ -RMS(exp, obs, time_dim = "sdate", dat_dim = "dataset", comp_dim = NULL, - limits = NULL, conf = TRUE, conf.lev = 0.95, ncores = NULL) +RMS( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + comp_dim = NULL, + limits = NULL, + conf = TRUE, + conf.lev = 0.95, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -79,4 +88,3 @@ The confidence interval is computed by the chi2 distribution.\cr # Renew example when Ano and Smoothing are ready } - diff --git a/man/RMSSS.Rd b/man/RMSSS.Rd index 1b8274f..9ebcf65 100644 --- a/man/RMSSS.Rd +++ b/man/RMSSS.Rd @@ -4,8 +4,14 @@ \alias{RMSSS} \title{Compute root mean square error skill score} \usage{ -RMSSS(exp, obs, time_dim = "sdate", dat_dim = "dataset", pval = TRUE, - ncores = NULL) +RMSSS( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + pval = TRUE, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data which contains at least @@ -66,4 +72,3 @@ obs <- array(rnorm(15), dim = c(time = 3, memb = 5, dataset = 1)) res <- RMSSS(exp, obs, time_dim = 'time') } - diff --git a/man/RandomWalkTest.Rd b/man/RandomWalkTest.Rd index 33b226f..1110648 100644 --- a/man/RandomWalkTest.Rd +++ b/man/RandomWalkTest.Rd @@ -49,4 +49,3 @@ skill_B <- abs(fcst_B - reference) RandomWalkTest(skill_A = skill_A, skill_B = skill_B, time_dim = 'sdate', ncores = 1) } - diff --git a/man/Regression.Rd b/man/Regression.Rd index 4faafc1..8e27295 100644 --- a/man/Regression.Rd +++ b/man/Regression.Rd @@ -4,8 +4,17 @@ \alias{Regression} \title{Compute the regression of an array on another along one dimension.} \usage{ -Regression(datay, datax, reg_dim = "sdate", formula = y ~ x, pval = TRUE, - conf = TRUE, conf.lev = 0.95, na.action = na.omit, ncores = NULL) +Regression( + datay, + datax, + reg_dim = "sdate", + formula = y ~ x, + pval = TRUE, + conf = TRUE, + conf.lev = 0.95, + na.action = na.omit, + ncores = NULL +) } \arguments{ \item{datay}{An numeric array as predictand including the dimension along @@ -92,4 +101,3 @@ res1 <- Regression(datay, datax, formula = y~poly(x, 2, raw = TRUE)) res2 <- Regression(datay, datax, conf.lev = 0.9) } - diff --git a/man/Reorder.Rd b/man/Reorder.Rd index 0afa07e..8748aaf 100644 --- a/man/Reorder.Rd +++ b/man/Reorder.Rd @@ -26,4 +26,3 @@ Reorder the dimension order of a multi-dimensional array dat2 <- array(c(1:10), dim = c(2, 1, 5)) print(dim(Reorder(dat2, c(2, 1, 3)))) } - diff --git a/man/SPOD.Rd b/man/SPOD.Rd index cbbbf1a..5a20a3f 100644 --- a/man/SPOD.Rd +++ b/man/SPOD.Rd @@ -4,10 +4,22 @@ \alias{SPOD} \title{Compute the South Pacific Ocean Dipole (SPOD) index} \usage{ -SPOD(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +SPOD( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -104,4 +116,3 @@ lon <- seq(0, 360, 10) index_dcpp <- SPOD(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/Season.Rd b/man/Season.Rd index cb10dee..3c1e3ff 100644 --- a/man/Season.Rd +++ b/man/Season.Rd @@ -4,8 +4,16 @@ \alias{Season} \title{Compute seasonal mean} \usage{ -Season(data, time_dim = "ftime", monini, moninf, monsup, method = mean, - na.rm = TRUE, ncores = NULL) +Season( + data, + time_dim = "ftime", + monini, + moninf, + monsup, + method = mean, + na.rm = TRUE, + ncores = NULL +) } \arguments{ \item{data}{A named numeric array with at least one dimension 'time_dim'.} @@ -53,4 +61,3 @@ dat2[na] <- NA res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2) res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2, na.rm = FALSE) } - diff --git a/man/Smoothing.Rd b/man/Smoothing.Rd index ba62ca1..8d4a558 100644 --- a/man/Smoothing.Rd +++ b/man/Smoothing.Rd @@ -43,4 +43,3 @@ PlotAno(smooth_ano_exp, smooth_ano_obs, startDates, fileout = "tos_smoothed_ano.png") } } - diff --git a/man/TPI.Rd b/man/TPI.Rd index 6968f22..fdbc2b8 100644 --- a/man/TPI.Rd +++ b/man/TPI.Rd @@ -4,10 +4,22 @@ \alias{TPI} \title{Compute the Tripole Index (TPI) for the Interdecadal Pacific Oscillation (IPO)} \usage{ -TPI(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +TPI( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -103,4 +115,3 @@ lon = seq(0, 360, 10) index_dcpp = TPI(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/ToyModel.Rd b/man/ToyModel.Rd index 379ed3b..ee7a98e 100644 --- a/man/ToyModel.Rd +++ b/man/ToyModel.Rd @@ -7,8 +7,18 @@ components of a forecast: (1) predictabiltiy (2) forecast error (3) non-stationarity and (4) ensemble generation. The forecast can be computed for real observations or observations generated artifically.} \usage{ -ToyModel(alpha = 0.1, beta = 0.4, gamma = 1, sig = 1, trend = 0, - nstartd = 30, nleadt = 4, nmemb = 10, obsini = NULL, fxerr = NULL) +ToyModel( + alpha = 0.1, + beta = 0.4, + gamma = 1, + sig = 1, + trend = 0, + nstartd = 30, + nleadt = 4, + nmemb = 10, + obsini = NULL, + fxerr = NULL +) } \arguments{ \item{alpha}{Predicabiltiy of the forecast on the observed residuals @@ -120,4 +130,3 @@ toyforecast <- ToyModel(alpha = a, beta = b, gamma = g, nmemb = nm, # } } - diff --git a/man/Trend.Rd b/man/Trend.Rd index a641041..d283ee6 100644 --- a/man/Trend.Rd +++ b/man/Trend.Rd @@ -4,8 +4,16 @@ \alias{Trend} \title{Compute the trend} \usage{ -Trend(data, time_dim = "ftime", interval = 1, polydeg = 1, conf = TRUE, - conf.lev = 0.95, pval = TRUE, ncores = NULL) +Trend( + data, + time_dim = "ftime", + interval = 1, + polydeg = 1, + conf = TRUE, + conf.lev = 0.95, + pval = TRUE, + ncores = NULL +) } \arguments{ \item{data}{An numeric array including the dimension along which the trend @@ -80,4 +88,3 @@ months_between_startdates <- 60 trend <- Trend(sampleData$obs, polydeg = 2, interval = months_between_startdates) } - diff --git a/man/clim.palette.Rd b/man/clim.palette.Rd index d912f47..5d17947 100644 --- a/man/clim.palette.Rd +++ b/man/clim.palette.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/clim.palette.R \name{clim.palette} -\alias{clim.colors} \alias{clim.palette} +\alias{clim.colors} \title{Generate Climate Color Palettes} \usage{ clim.palette(palette = "bluered") @@ -30,4 +30,3 @@ cols <- clim.colors(20) ColorBar(lims, cols) } - diff --git a/man/s2dv-package.Rd b/man/s2dv-package.Rd index cb52214..043b081 100644 --- a/man/s2dv-package.Rd +++ b/man/s2dv-package.Rd @@ -4,20 +4,45 @@ \name{s2dv-package} \alias{s2dv} \alias{s2dv-package} -\title{A Set of Common Tools for Seasonal to Decadal Verification} +\title{s2dv: A Set of Common Tools for Seasonal to Decadal Verification} \description{ -The advanced version of package 's2dverification'. It is -intended for 'seasonal to decadal' (s2d) climate forecast verification, but -it can also be used in other kinds of forecasts or general climate analysis. -This package is specially designed for the comparison between the experimental -and observational datasets. The functionality of the included functions covers -from data retrieval, data post-processing, skill scores against observation, -to visualization. Compared to 's2dverification', 's2dv' is more compatible -with the package 'startR', able to use multiple cores for computation and -handle multi-dimensional arrays with a higher flexibility. +The advanced version of package 's2dverification'. It is + intended for 'seasonal to decadal' (s2d) climate forecast verification, but + it can also be used in other kinds of forecasts or general climate analysis. + This package is specially designed for the comparison between the experimental + and observational datasets. The functionality of the included functions covers + from data retrieval, data post-processing, skill scores against observation, + to visualization. Compared to 's2dverification', 's2dv' is more compatible + with the package 'startR', able to use multiple cores for computation and + handle multi-dimensional arrays with a higher flexibility. } \references{ \url{https://earth.bsc.es/gitlab/es/s2dv/} } -\keyword{internal} +\seealso{ +Useful links: +\itemize{ + \item \url{https://earth.bsc.es/gitlab/es/s2dv/} + \item Report bugs at \url{https://earth.bsc.es/gitlab/es/s2dv/-/issues} +} + +} +\author{ +\strong{Maintainer}: An-Chi Ho \email{an.ho@bsc.es} + +Authors: +\itemize{ + \item BSC-CNS [copyright holder] + \item Nuria Perez-Zanon \email{nuria.perez@bsc.es} +} + +Other contributors: +\itemize{ + \item Roberto Bilbao \email{roberto.bilbao@bsc.es} [contributor] + \item Carlos Delgado \email{carlos.delgado@bsc.es} [contributor] + \item Andrea Manrique \email{andrea.manrique@bsc.es} [contributor] + \item Deborah Verfaillie \email{deborah.verfaillie@bsc.es} [contributor] +} +} +\keyword{internal} diff --git a/man/sampleDepthData.Rd b/man/sampleDepthData.Rd index 869af86..77e4a7a 100644 --- a/man/sampleDepthData.Rd +++ b/man/sampleDepthData.Rd @@ -28,4 +28,3 @@ variable 'tos', i.e. sea surface temperature, from the decadal climate prediction experiment run at IC3 in the context of the CMIP5 project.\cr Its name within IC3 local database is 'i00k'. } - diff --git a/man/sampleMap.Rd b/man/sampleMap.Rd index 651d185..eaf8aa5 100644 --- a/man/sampleMap.Rd +++ b/man/sampleMap.Rd @@ -43,4 +43,3 @@ sampleData <- Load('tos', list(exp), list(obs), startDates, } Check the documentation on 'Load()' in the package 's2dv' for more information. } - diff --git a/man/sampleTimeSeries.Rd b/man/sampleTimeSeries.Rd index 280277e..05a8e79 100644 --- a/man/sampleTimeSeries.Rd +++ b/man/sampleTimeSeries.Rd @@ -47,4 +47,3 @@ sampleData <- Load('tos', list(exp), list(obs), startDates, } Check the documentation on 'Load()' in the package 's2dv' for more information. } - diff --git a/tests/testthat/test-Ano_CrossValid.R b/tests/testthat/test-Ano_CrossValid.R index 1333f15..52dcf73 100644 --- a/tests/testthat/test-Ano_CrossValid.R +++ b/tests/testthat/test-Ano_CrossValid.R @@ -90,24 +90,24 @@ test_that("2. dat1", { expect_equal( names(Ano_CrossValid(exp1, obs1)), - c("ano_exp", "ano_obs") + c("exp", "obs") ) expect_equal( - dim(Ano_CrossValid(exp1, obs1)$ano_exp), + dim(Ano_CrossValid(exp1, obs1)$exp), c(sdate = 5, dataset = 2, member = 3, ftime = 2) ) expect_equal( - Ano_CrossValid(exp1, obs1)$ano_exp[, 1, 2, 2], + Ano_CrossValid(exp1, obs1)$exp[, 1, 2, 2], c(0.2771331, 1.1675753, -1.0684010, 0.2901759, -0.6664833), tolerance = 0.0001 ) expect_equal( - Ano_CrossValid(exp1, obs1)$ano_obs[, 1, 2, 2], + Ano_CrossValid(exp1, obs1)$obs[, 1, 2, 2], c(1.7024193, -0.8243579, -2.4136080, 0.5199868, 1.0155598), tolerance = 0.0001 ) expect_equal( - Ano_CrossValid(exp1, obs1, memb = FALSE)$ano_exp[, 1, 2, 2], + Ano_CrossValid(exp1, obs1, memb = FALSE)$exp[, 1, 2, 2], c(0.1229714, 0.8496518, -0.9531644, 0.1548713, -0.5264025), tolerance = 0.0001 ) @@ -118,19 +118,19 @@ test_that("2. dat1", { test_that("3. dat2", { expect_equal( names(Ano_CrossValid(exp2, obs2, dat_dim = 'member')), - c("ano_exp", "ano_obs") + c("exp", "obs") ) expect_equal( - dim(Ano_CrossValid(exp2, obs2, dat_dim = 'member')$ano_exp), + dim(Ano_CrossValid(exp2, obs2, dat_dim = 'member')$exp), c(sdate = 5, member = 3, ftime = 2) ) expect_equal( - Ano_CrossValid(exp2, obs2, dat_dim = 'member')$ano_exp[, 2, 2], + Ano_CrossValid(exp2, obs2, dat_dim = 'member')$exp[, 2, 2], c(0.05650631, 1.53434806, -0.37561623, -0.26217217, -0.95306597), tolerance = 0.0001 ) expect_equal( - Ano_CrossValid(exp2, obs2, dat_dim = 'member', memb = FALSE)$ano_exp[, 2, 2], + Ano_CrossValid(exp2, obs2, dat_dim = 'member', memb = FALSE)$exp[, 2, 2], c(0.34489635, 1.56816273, -0.01926901, -0.09646066, -0.68236823), tolerance = 0.0001 ) -- GitLab From 29ad2d9ef39f2738287f18e6c890c35f340e1634 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 8 Feb 2021 19:59:55 +0100 Subject: [PATCH 025/154] Transform Histo2Hindcast() from s2dverification --- R/Histo2Hindcast.R | 161 +++++++++++++++++++++++ man/Histo2Hindcast.Rd | 74 +++++++++++ tests/testthat/test-Histo2Hindcast.R | 183 +++++++++++++++++++++++++++ 3 files changed, 418 insertions(+) create mode 100644 R/Histo2Hindcast.R create mode 100644 man/Histo2Hindcast.Rd create mode 100644 tests/testthat/test-Histo2Hindcast.R diff --git a/R/Histo2Hindcast.R b/R/Histo2Hindcast.R new file mode 100644 index 0000000..860f56b --- /dev/null +++ b/R/Histo2Hindcast.R @@ -0,0 +1,161 @@ +#'Chunk long simulations for comparison with hindcasts +#' +#'Reorganize a long run (historical typically) with only one start date into +#'chunks corresponding to a set of start dates. The time frequency of the data +#'should be monthly. +#' +#'@param data A numeric array of model or observational data with dimensions +#' at least sdate_dim and ftime_dim. +#'@param sdatesin A character string of the start date of 'data'. The format +#' should be 'YYYYMMDD' or 'YYYYMM'. +#'@param sdatesout A vector of character string indicating the expected start +#' dates of the output. The format should be 'YYYYMMDD' or 'YYYYMM'. +#'@param nleadtimesout A positive integer indicating the length of leadtimes of +#' the output. +#'@param sdate_dim A character string indicating the name of the sdate date +#' dimension of 'data'. The default value is 'sdate'. +#'@param ftime_dim A character string indicating the name of the lead time +#' dimension of 'data'. The default value is 'ftime'. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' +#'@return A numeric array with the same dimensions as data, except the length +#' of sdate_dim is 'sdatesout' and the length of ftime_dim is nleadtimesout. +#' +#'@examples +#' \dontshow{ +#'startDates <- c('19901101') +#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), +#' c('observation'), startDates, +#' leadtimemin = 1, +#' leadtimemax = 60, +#' output = 'areave', +#' latmin = 27, latmax = 48, +#' lonmin = -12, lonmax = 40) +#' } +#' +#'sdates_out <- c('19901101', '19911101', '19921101', '19931101', '19941101') +#'leadtimes_per_startdate <- 12 +#'exp_data <- Histo2Hindcast(sampleData$mod, startDates, +#' sdates_out, leadtimes_per_startdate) +#'obs_data <- Histo2Hindcast(sampleData$obs, startDates, +#' sdates_out, leadtimes_per_startdate) +#' \dontrun{ +#'exp_data <- Reorder(exp_data, c(3, 4, 1, 2)) +#'obs_data <- Reorder(obs_data, c(3, 4, 1, 2)) +#'PlotAno(exp_data, obs_data, sdates_out, +#' toptitle = paste('Anomalies reorganized into shorter chunks'), +#' ytitle = 'K', fileout = NULL) +#' } +#' +#'@import multiApply +#'@export +Histo2Hindcast <- function(data, sdatesin, sdatesout, nleadtimesout, + sdate_dim = 'sdate', ftime_dim = 'ftime', + ncores = NULL) { + + ## Input Checks + # data + if (is.null(data)) { + stop("Parameter 'data' cannot be NULL.") + } + if (!is.numeric(data)) { + stop("Parameter 'data' must be a numeric array.") + } + # sdatesin + if (is.null(sdatesin)) { + stop("Parameter 'sdatesin' cannot be NULL.") + } + if (!is.character(sdatesin) | length(sdatesin) > 1) { + stop(paste0("Parameter 'sdatesin' must be a character string in the format", + " 'YYYYMMDD' or 'YYYYMM'.")) + } else if (!nchar(sdatesin) %in% c(6, 8) | is.na(as.numeric(sdatesin))) { + stop(paste0("Parameter 'sdatesin' must be a character string in the format", + " 'YYYYMMDD' or 'YYYYMM'.")) + } + # sdatesout + if (is.null(sdatesout)) { + stop("Parameter 'sdatesout' cannot be NULL.") + } + if (!is.character(sdatesout) | !is.vector(sdatesout)) { + stop(paste0("Parameter 'sdatesout' must be a vector of character in the ", + "format 'YYYYMMDD' or 'YYYYMM'.")) + } else if (!all(nchar(sdatesout) %in% c(6, 8)) | any(is.na(as.numeric(sdatesin)))) { + stop(paste0("Parameter 'sdatesout' must be a vector of character in the ", + "format 'YYYYMMDD' or 'YYYYMM'.")) + } + # nleadtimesout + if (is.null(nleadtimesout)) { + stop("Parameter 'nleadtimesout' cannot be NULL.") + } + if (!is.numeric(nleadtimesout) | nleadtimesout %% 1 != 0 | + nleadtimesout < 0 | length(nleadtimesout) > 1) { + stop("Parameter 'nleadtimesout' must be a positive integer.") + } + # sdate_dim + if (!is.character(sdate_dim) | length(sdate_dim) > 1) { + stop("Parameter 'sdate_dim' must be a character string.") + } + if (!sdate_dim %in% names(dim(data))) { + stop("Parameter 'sdate_dim' is not found in 'data' dimension.") + } + if (dim(data)[sdate_dim] > 1) { + stop("The dimension length of sdate_dim of 'data' must be 1.") + } + # ftime_dim + if (!is.character(ftime_dim) | length(ftime_dim) > 1) { + stop("Parameter 'ftime_dim' must be a character string.") + } + if (!ftime_dim %in% names(dim(data))) { + stop("Parameter 'ftime_dim' is not found in 'data' dimension.") + } + # 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.") + } + } + + + yrin <- as.numeric(substr(sdatesin, 1, 4)) + yrout <- as.numeric(substr(sdatesout, 1, 4)) + mthin <- as.numeric(substr(sdatesin, 5, 6)) + if (mthin > 12) { + stop(paste0("Parameter 'sdatesin' must be in the format 'YYYYMMDD' or ", + "'YYYYMM'. Found the month is over 12.")) + } + mthout <- as.numeric(substr(sdatesout, 5, 6)) + if (any(mthout > 12)) { + stop(paste0("Parameter 'sdatesout' must be a vector of character in the ", + "format 'YYYYMMDD' or 'YYYYMM'. Found certain month is over 12.")) + } + + res <- Apply(data, + target_dims = c(sdate_dim, ftime_dim), + output_dims = c(sdate_dim, ftime_dim), + fun = .Histo2Hindcast, + yrin = yrin, yrout = yrout, + mthin = mthin, mthout = mthout, + nleadtimesout = nleadtimesout, + ncores = ncores)$output1 + + return(res) + +} + +.Histo2Hindcast <- function(data, yrin = yrin, yrout = yrout, mthin = mthin, mthout = mthout, nleadtimesout) { + # data: [sdate = 1, ftime] + + res <- array(dim = c(sdate = length(yrout), ftime = nleadtimesout)) + + diff_mth <- (yrout - yrin) * 12 + (mthout - mthin) + for (i in 1:length(diff_mth)) { + if (diff_mth[i] < dim(data)[2]) { + ftime_ind <- max(1 + diff_mth[i], 1):min(nleadtimesout + diff_mth[i], dim(data)[2]) + res[i, 1:length(ftime_ind)] <- data[1, ftime_ind] + } + } + + return(res) +} diff --git a/man/Histo2Hindcast.Rd b/man/Histo2Hindcast.Rd new file mode 100644 index 0000000..a2bc5ca --- /dev/null +++ b/man/Histo2Hindcast.Rd @@ -0,0 +1,74 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Histo2Hindcast.R +\name{Histo2Hindcast} +\alias{Histo2Hindcast} +\title{Chunk long simulations for comparison with hindcasts} +\usage{ +Histo2Hindcast( + data, + sdatesin, + sdatesout, + nleadtimesout, + sdate_dim = "sdate", + ftime_dim = "ftime", + ncores = NULL +) +} +\arguments{ +\item{data}{A numeric array of model or observational data with dimensions +at least sdate_dim and ftime_dim.} + +\item{sdatesin}{A character string of the start date of 'data'. The format +should be 'YYYYMMDD' or 'YYYYMM'.} + +\item{sdatesout}{A vector of character string indicating the expected start +dates of the output. The format should be 'YYYYMMDD' or 'YYYYMM'.} + +\item{nleadtimesout}{A positive integer indicating the length of leadtimes of +the output.} + +\item{sdate_dim}{A character string indicating the name of the sdate date +dimension of 'data'. The default value is 'sdate'.} + +\item{ftime_dim}{A character string indicating the name of the lead time +dimension of 'data'. The default value is 'ftime'.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A numeric array with the same dimensions as data, except the length + of sdate_dim is 'sdatesout' and the length of ftime_dim is nleadtimesout. +} +\description{ +Reorganize a long run (historical typically) with only one start date into +chunks corresponding to a set of start dates. The time frequency of the data +should be monthly. +} +\examples{ + \dontshow{ +startDates <- c('19901101') +sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), + c('observation'), startDates, + leadtimemin = 1, + leadtimemax = 60, + output = 'areave', + latmin = 27, latmax = 48, + lonmin = -12, lonmax = 40) + } + +sdates_out <- c('19901101', '19911101', '19921101', '19931101', '19941101') +leadtimes_per_startdate <- 12 +exp_data <- Histo2Hindcast(sampleData$mod, startDates, + sdates_out, leadtimes_per_startdate) +obs_data <- Histo2Hindcast(sampleData$obs, startDates, + sdates_out, leadtimes_per_startdate) + \dontrun{ +exp_data <- Reorder(exp_data, c(3, 4, 1, 2)) +obs_data <- Reorder(obs_data, c(3, 4, 1, 2)) +PlotAno(exp_data, obs_data, sdates_out, + toptitle = paste('Anomalies reorganized into shorter chunks'), + ytitle = 'K', fileout = NULL) + } + +} diff --git a/tests/testthat/test-Histo2Hindcast.R b/tests/testthat/test-Histo2Hindcast.R new file mode 100644 index 0000000..025f003 --- /dev/null +++ b/tests/testthat/test-Histo2Hindcast.R @@ -0,0 +1,183 @@ +context("s2dv::Histo2Hindcast tests") + +############################################## +# dat1 +set.seed(1) +dat1 <- array(rnorm(24), dim = c(sdate = 1, ftime = 24)) +sdatesin1 <- '19901101' +sdatesout1 <- c('19901101', '19911101') +nleadtimesout1 <- 12 + +# dat2 +set.seed(1) +dat2 <- array(rnorm(288), dim = c(dat = 1, member = 2, sdate = 1, ftime = 24, lat = 2, lon = 3)) +sdatesin2 <- '19901101' +sdatesout2 <- c('19901101', '19911101') +nleadtimesout2 <- 12 + +############################################## +test_that("1. Input checks", { + + # dat + expect_error( + Histo2Hindcast(c()), + "Parameter 'data' cannot be NULL." + ) + expect_error( + Histo2Hindcast(c(NA, NA)), + "Parameter 'data' must be a numeric array." + ) + # sdatesin + expect_error( + Histo2Hindcast(dat1, c()), + "Parameter 'sdatesin' cannot be NULL." + ) + expect_error( + Histo2Hindcast(dat1, sdatesin = '1999'), + paste0("Parameter 'sdatesin' must be a character string in the format", + " 'YYYYMMDD' or 'YYYYMM'.") + ) + expect_error( + Histo2Hindcast(dat1, sdatesin = c('19991101', '19991201')), + paste0("Parameter 'sdatesin' must be a character string in the format", + " 'YYYYMMDD' or 'YYYYMM'.") + ) + # sdatesout + expect_error( + Histo2Hindcast(dat1, sdatesin = sdatesin1, c()), + "Parameter 'sdatesout' cannot be NULL." + ) + expect_error( + Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = 1999:2000), + paste0("Parameter 'sdatesout' must be a vector of character in the ", + "format 'YYYYMMDD' or 'YYYYMM'.") + ) + # nleadtimesout + expect_error( + Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, c()), + "Parameter 'nleadtimesout' cannot be NULL." + ) + expect_error( + Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = c(10, 12)), + "Parameter 'nleadtimesout' must be a positive integer." + ) + # sdate_dim + expect_error( + Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1, sdate_dim = 1), + "Parameter 'sdate_dim' must be a character string." + ) + expect_error( + Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1, sdate_dim = 'time'), + "Parameter 'sdate_dim' is not found in 'data' dimension." + ) + expect_error( + Histo2Hindcast(array(1:10, dim = c(sdate = 2, ftime = 5)), + sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1), + "The dimension length of sdate_dim of 'data' must be 1." + ) + # ftime_dim + expect_error( + Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1, ftime_dim = 2), + "Parameter 'ftime_dim' must be a character string." + ) + expect_error( + Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1, ftime_dim = 'time'), + "Parameter 'ftime_dim' is not found in 'data' dimension." + ) + # ncores + expect_error( + Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1, ncores = 0), + "Parameter 'ncores' must be a positive integer." + ) + +}) +############################################## +test_that("2. dat1", { + + expect_equal( + dim(Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1)), + c(sdate = 2, ftime = 12) + ) + expect_equal( + mean(Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1)), + 0.1498669, + tolerance = 0.00001 + ) + expect_equal( + Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1)[1, 5:7], + c(0.3295078, -0.8204684, 0.4874291), + tolerance = 0.00001 + ) + expect_equal( + Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1)[2, 5:7], + c(-0.01619026, 0.94383621, 0.82122120), + tolerance = 0.00001 + ) + +sdatesout1 <- c('19901101', '19910101') +nleadtimesout1 <- 6 + + expect_equal( + dim(Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1)), + c(sdate = 2, ftime = 6) + ) + expect_equal( + mean(Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1)), + 0.1100272, + tolerance = 0.00001 + ) + expect_equal( + Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1)[1, 3:5], + Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1)[2, 1:3], + tolerance = 0.00001 + ) + + +sdatesout1 <- c('19901101', '19911101') +nleadtimesout1 <- 15 + + expect_equal( + mean(Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1), na.rm = T), + 0.06984426, + tolerance = 0.00001 + ) + expect_equal( + length(which(is.na(Histo2Hindcast(dat1, sdatesin = sdatesin1, + sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1)))), + 3 + ) + expect_equal( + Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1)[1, 13:15], + Histo2Hindcast(dat1, sdatesin = sdatesin1, sdatesout = sdatesout1, + nleadtimesout = nleadtimesout1)[2, 1:3] + ) + +}) +############################################## +test_that("3. dat2", { + + expect_equal( + dim(Histo2Hindcast(dat2, sdatesin = sdatesin2, sdatesout = sdatesout2, + nleadtimesout = nleadtimesout2)), + c(sdate = 2, ftime = 12, dat = 1, member = 2, lat = 2, lon = 3) + ) + +}) -- GitLab From 8ac41b518f3fc37d98845f57394c681f64bff011 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 8 Feb 2021 20:00:27 +0100 Subject: [PATCH 026/154] Regenerate the .md file by newer devtools version --- DESCRIPTION | 2 +- NAMESPACE | 1 + man/AMV.Rd | 21 ++++++-- man/AnimateMap.Rd | 33 +++++++++--- man/Ano.Rd | 1 - man/Clim.Rd | 16 ++++-- man/ColorBar.Rd | 32 +++++++++--- man/Composite.Rd | 14 +++-- man/ConfigApplyMatchingEntries.Rd | 11 ++-- man/ConfigEditDefinition.Rd | 1 - man/ConfigEditEntry.Rd | 45 ++++++++++++---- man/ConfigFileOpen.Rd | 3 +- man/ConfigShowSimilarEntries.Rd | 17 ++++-- man/ConfigShowTable.Rd | 3 +- man/Corr.Rd | 17 ++++-- man/Eno.Rd | 1 - man/GMST.Rd | 24 +++++++-- man/GSAT.Rd | 21 ++++++-- man/InsertDim.Rd | 1 - man/LeapYear.Rd | 1 - man/Load.Rd | 40 ++++++++++---- man/MeanDims.Rd | 3 +- man/Persistence.Rd | 17 ++++-- man/PlotAno.Rd | 31 ++++++++--- man/PlotClim.Rd | 26 +++++++--- man/PlotEquiMap.Rd | 86 ++++++++++++++++++++++++------- man/PlotLayout.Rd | 73 ++++++++++++++++++-------- man/PlotMatrix.Rd | 29 ++++++++--- man/PlotSection.Rd | 25 +++++++-- man/PlotStereoMap.Rd | 61 +++++++++++++++++----- man/RMS.Rd | 14 +++-- man/RMSSS.Rd | 11 ++-- man/RandomWalkTest.Rd | 1 - man/Regression.Rd | 14 +++-- man/Reorder.Rd | 1 - man/SPOD.Rd | 21 ++++++-- man/Season.Rd | 13 +++-- man/Smoothing.Rd | 1 - man/TPI.Rd | 21 ++++++-- man/ToyModel.Rd | 15 ++++-- man/Trend.Rd | 13 +++-- man/clim.palette.Rd | 3 +- man/s2dv-package.Rd | 47 +++++++++++++---- man/sampleDepthData.Rd | 1 - man/sampleMap.Rd | 1 - man/sampleTimeSeries.Rd | 1 - 46 files changed, 621 insertions(+), 213 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 126179a..30fd237 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -45,4 +45,4 @@ BugReports: https://earth.bsc.es/gitlab/es/s2dv/-/issues LazyData: true SystemRequirements: cdo Encoding: UTF-8 -RoxygenNote: 5.0.0 +RoxygenNote: 7.0.1 diff --git a/NAMESPACE b/NAMESPACE index 6da8d0c..a08603d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -22,6 +22,7 @@ export(Corr) export(Eno) export(GMST) export(GSAT) +export(Histo2Hindcast) export(InsertDim) export(LeapYear) export(Load) diff --git a/man/AMV.Rd b/man/AMV.Rd index 5aa6d30..881e136 100644 --- a/man/AMV.Rd +++ b/man/AMV.Rd @@ -4,10 +4,22 @@ \alias{AMV} \title{Compute the Atlantic Multidecadal Variability (AMV) index} \usage{ -AMV(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +AMV( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -106,4 +118,3 @@ lon <- seq(0, 360, 10) index_dcpp <- AMV(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/AnimateMap.Rd b/man/AnimateMap.Rd index d2003ee..2ec930d 100644 --- a/man/AnimateMap.Rd +++ b/man/AnimateMap.Rd @@ -4,13 +4,33 @@ \alias{AnimateMap} \title{Animate Maps of Forecast/Observed Values or Scores Over Forecast Time} \usage{ -AnimateMap(var, lon, lat, toptitle = rep("", 11), sizetit = 1, units = "", - monini = 1, freq = 12, msk95lev = FALSE, brks = NULL, cols = NULL, - filled.continents = FALSE, lonmin = 0, lonmax = 360, latmin = -90, - latmax = 90, intlon = 20, intlat = 30, drawleg = TRUE, - subsampleg = 1, colNA = "white", equi = TRUE, +AnimateMap( + var, + lon, + lat, + toptitle = rep("", 11), + sizetit = 1, + units = "", + monini = 1, + freq = 12, + msk95lev = FALSE, + brks = NULL, + cols = NULL, + filled.continents = FALSE, + lonmin = 0, + lonmax = 360, + latmin = -90, + latmax = 90, + intlon = 20, + intlat = 30, + drawleg = TRUE, + subsampleg = 1, + colNA = "white", + equi = TRUE, fileout = c("output1_animvsltime.gif", "output2_animvsltime.gif", - "output3_animvsltime.gif"), ...) + "output3_animvsltime.gif"), + ... +) } \arguments{ \item{var}{Matrix of dimensions (nltime, nlat, nlon) or @@ -162,4 +182,3 @@ AnimateMap(clim$clim_exp, sampleData$lon, sampleData$lat, # More examples in s2dverification but are deleted for now } - diff --git a/man/Ano.Rd b/man/Ano.Rd index 2dd4dea..8e423af 100644 --- a/man/Ano.Rd +++ b/man/Ano.Rd @@ -41,4 +41,3 @@ PlotAno(ano_exp, ano_obs, startDates, legends = 'ERSST', biglab = FALSE, fileout = 'tos_ano.png') } } - diff --git a/man/Clim.Rd b/man/Clim.Rd index a997a7f..78559bd 100644 --- a/man/Clim.Rd +++ b/man/Clim.Rd @@ -4,9 +4,18 @@ \alias{Clim} \title{Compute Bias Corrected Climatologies} \usage{ -Clim(exp, obs, time_dim = "sdate", dat_dim = c("dataset", "member"), - method = "clim", ftime_dim = "ftime", memb = TRUE, - memb_dim = "member", na.rm = TRUE, ncores = NULL) +Clim( + exp, + obs, + time_dim = "sdate", + dat_dim = c("dataset", "member"), + method = "clim", + ftime_dim = "ftime", + memb = TRUE, + memb_dim = "member", + na.rm = TRUE, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -82,4 +91,3 @@ PlotClim(clim$clim_exp, clim$clim_obs, listobs = c('ERSST'), biglab = FALSE, fileout = 'tos_clim.eps') } } - diff --git a/man/ColorBar.Rd b/man/ColorBar.Rd index 1287b70..6d62f15 100644 --- a/man/ColorBar.Rd +++ b/man/ColorBar.Rd @@ -4,13 +4,30 @@ \alias{ColorBar} \title{Draws a Color Bar} \usage{ -ColorBar(brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, - bar_limits = NULL, var_limits = NULL, triangle_ends = NULL, - col_inf = NULL, col_sup = NULL, color_fun = clim.palette(), - plot = TRUE, draw_ticks = TRUE, draw_separators = FALSE, - triangle_ends_scale = 1, extra_labels = NULL, title = NULL, - title_scale = 1, label_scale = 1, tick_scale = 1, - extra_margin = rep(0, 4), label_digits = 4, ...) +ColorBar( + brks = NULL, + cols = NULL, + vertical = TRUE, + subsampleg = NULL, + bar_limits = NULL, + var_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + color_fun = clim.palette(), + plot = TRUE, + draw_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + extra_labels = NULL, + title = NULL, + title_scale = 1, + label_scale = 1, + tick_scale = 1, + extra_margin = rep(0, 4), + label_digits = 4, + ... +) } \arguments{ \item{brks}{Can be provided in two formats: @@ -175,4 +192,3 @@ cols <- c("dodgerblue4", "dodgerblue1", "forestgreen", "yellowgreen", "white", lims <- seq(-1, 1, 0.2) ColorBar(lims, cols) } - diff --git a/man/Composite.Rd b/man/Composite.Rd index 64d5bfc..cc21d38 100644 --- a/man/Composite.Rd +++ b/man/Composite.Rd @@ -4,8 +4,17 @@ \alias{Composite} \title{Compute composites} \usage{ -Composite(data, occ, time_dim = "time", space_dim = c("lon", "lat"), - lag = 0, eno = FALSE, K = NULL, fileout = NULL, ncores = NULL) +Composite( + data, + occ, + time_dim = "time", + space_dim = c("lon", "lat"), + lag = 0, + eno = FALSE, + K = NULL, + fileout = NULL, + ncores = NULL +) } \arguments{ \item{data}{A numeric array containing two spatial and one temporal @@ -101,4 +110,3 @@ occ <- c(1, 1, 2, 2, 3, 3) res <- Composite(data, occ, time_dim = 'case', K = 4) } - diff --git a/man/ConfigApplyMatchingEntries.Rd b/man/ConfigApplyMatchingEntries.Rd index 5f0efb1..ee4cb5a 100644 --- a/man/ConfigApplyMatchingEntries.Rd +++ b/man/ConfigApplyMatchingEntries.Rd @@ -4,8 +4,14 @@ \alias{ConfigApplyMatchingEntries} \title{Apply Matching Entries To Dataset Name And Variable Name To Find Related Info} \usage{ -ConfigApplyMatchingEntries(configuration, var, exp = NULL, obs = NULL, - show_entries = FALSE, show_result = TRUE) +ConfigApplyMatchingEntries( + configuration, + var, + exp = NULL, + obs = NULL, + show_entries = FALSE, + show_result = TRUE +) } \arguments{ \item{configuration}{Configuration object obtained from ConfigFileOpen() @@ -68,4 +74,3 @@ ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigEditDefinition.Rd b/man/ConfigEditDefinition.Rd index 8e1e968..223e95a 100644 --- a/man/ConfigEditDefinition.Rd +++ b/man/ConfigEditDefinition.Rd @@ -57,4 +57,3 @@ match_info <- ConfigApplyMatchingEntries(configuration, 'tas', [ConfigEditEntry()], [ConfigFileOpen()], [ConfigShowSimilarEntries()], [ConfigShowTable()]. } - diff --git a/man/ConfigEditEntry.Rd b/man/ConfigEditEntry.Rd index 9abf3e5..e597709 100644 --- a/man/ConfigEditEntry.Rd +++ b/man/ConfigEditEntry.Rd @@ -1,22 +1,46 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigEditEntry.R \name{ConfigEditEntry} -\alias{ConfigAddEntry} \alias{ConfigEditEntry} +\alias{ConfigAddEntry} \alias{ConfigRemoveEntry} \title{Add, Remove Or Edit Entries In The Configuration} \usage{ -ConfigEditEntry(configuration, dataset_type, position, dataset_name = NULL, - var_name = NULL, main_path = NULL, file_path = NULL, - nc_var_name = NULL, suffix = NULL, varmin = NULL, varmax = NULL) +ConfigEditEntry( + configuration, + dataset_type, + position, + dataset_name = NULL, + var_name = NULL, + main_path = NULL, + file_path = NULL, + nc_var_name = NULL, + suffix = NULL, + varmin = NULL, + varmax = NULL +) -ConfigAddEntry(configuration, dataset_type, position = "last", - dataset_name = ".*", var_name = ".*", main_path = "*", - file_path = "*", nc_var_name = "*", suffix = "*", varmin = "*", - varmax = "*") +ConfigAddEntry( + configuration, + dataset_type, + position = "last", + dataset_name = ".*", + var_name = ".*", + main_path = "*", + file_path = "*", + nc_var_name = "*", + suffix = "*", + varmin = "*", + varmax = "*" +) -ConfigRemoveEntry(configuration, dataset_type, dataset_name = NULL, - var_name = NULL, position = NULL) +ConfigRemoveEntry( + configuration, + dataset_type, + dataset_name = NULL, + var_name = NULL, + position = NULL +) } \arguments{ \item{configuration}{Configuration object obtained via ConfigFileOpen() @@ -99,4 +123,3 @@ ConfigFileSave(configuration, config_file, confirm = FALSE) ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigFileOpen.Rd b/man/ConfigFileOpen.Rd index eee183f..893900b 100644 --- a/man/ConfigFileOpen.Rd +++ b/man/ConfigFileOpen.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigFileOpen.R \name{ConfigFileOpen} -\alias{ConfigFileCreate} \alias{ConfigFileOpen} +\alias{ConfigFileCreate} \alias{ConfigFileSave} \title{Functions To Create Open And Save Configuration File} \usage{ @@ -194,4 +194,3 @@ ConfigFileSave(configuration, config_file, confirm = FALSE) ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigShowSimilarEntries.Rd b/man/ConfigShowSimilarEntries.Rd index b9f80ce..72b77e1 100644 --- a/man/ConfigShowSimilarEntries.Rd +++ b/man/ConfigShowSimilarEntries.Rd @@ -4,10 +4,18 @@ \alias{ConfigShowSimilarEntries} \title{Find Similar Entries In Tables Of Datasets} \usage{ -ConfigShowSimilarEntries(configuration, dataset_name = NULL, - var_name = NULL, main_path = NULL, file_path = NULL, - nc_var_name = NULL, suffix = NULL, varmin = NULL, varmax = NULL, - n_results = 10) +ConfigShowSimilarEntries( + configuration, + dataset_name = NULL, + var_name = NULL, + main_path = NULL, + file_path = NULL, + nc_var_name = NULL, + suffix = NULL, + varmin = NULL, + varmax = NULL, + n_results = 10 +) } \arguments{ \item{configuration}{Configuration object obtained either from @@ -79,4 +87,3 @@ ConfigShowSimilarEntries(configuration, dataset_name = "Exper", ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigShowTable.Rd b/man/ConfigShowTable.Rd index 7c08053..5e4172a 100644 --- a/man/ConfigShowTable.Rd +++ b/man/ConfigShowTable.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigShowTable.R \name{ConfigShowTable} -\alias{ConfigShowDefinitions} \alias{ConfigShowTable} +\alias{ConfigShowDefinitions} \title{Show Configuration Tables And Definitions} \usage{ ConfigShowTable(configuration, dataset_type, line_numbers = NULL) @@ -54,4 +54,3 @@ ConfigShowDefinitions(configuration) [ConfigEditEntry()], [ConfigFileOpen()], [ConfigShowSimilarEntries()], [ConfigShowTable()]. } - diff --git a/man/Corr.Rd b/man/Corr.Rd index bf5575e..9c20ec1 100644 --- a/man/Corr.Rd +++ b/man/Corr.Rd @@ -4,9 +4,19 @@ \alias{Corr} \title{Compute the correlation coefficient between an array of forecast and their corresponding observation} \usage{ -Corr(exp, obs, time_dim = "sdate", dat_dim = "dataset", comp_dim = NULL, - limits = NULL, method = "pearson", pval = TRUE, conf = TRUE, - conf.lev = 0.95, ncores = NULL) +Corr( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + comp_dim = NULL, + limits = NULL, + method = "pearson", + pval = TRUE, + conf = TRUE, + conf.lev = 0.95, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -86,4 +96,3 @@ corr <- Corr(clim$clim_exp, clim$clim_obs, time_dim = 'ftime', dat_dim = 'member # Renew the example when Ano and Smoothing is ready } - diff --git a/man/Eno.Rd b/man/Eno.Rd index 32468bd..03c3b4f 100644 --- a/man/Eno.Rd +++ b/man/Eno.Rd @@ -39,4 +39,3 @@ data[na] <- NA res <- Eno(data) } - diff --git a/man/GMST.Rd b/man/GMST.Rd index 208ff75..03d1092 100644 --- a/man/GMST.Rd +++ b/man/GMST.Rd @@ -4,10 +4,25 @@ \alias{GMST} \title{Compute the Global Mean Surface Temperature (GMST) anomalies} \usage{ -GMST(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_value, type, - mask = NULL, lat_dim = "lat", lon_dim = "lon", monini = 11, - fmonth_dim = "fmonth", sdate_dim = "sdate", indices_for_clim = NULL, - year_dim = "year", month_dim = "month", member_dim = "member") +GMST( + data_tas, + data_tos, + data_lats, + data_lons, + mask_sea_land, + sea_value, + type, + mask = NULL, + lat_dim = "lat", + lon_dim = "lon", + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data_tas}{A numerical array indicating the surface air temperature data @@ -134,4 +149,3 @@ index_dcpp <- GMST(data_tas = dcpp_tas, data_tos = dcpp_tos, data_lats = lat, sea_value = sea_value) } - diff --git a/man/GSAT.Rd b/man/GSAT.Rd index 9d3fbb6..370900d 100644 --- a/man/GSAT.Rd +++ b/man/GSAT.Rd @@ -4,10 +4,22 @@ \alias{GSAT} \title{Compute the Global Surface Air Temperature (GSAT) anomalies} \usage{ -GSAT(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +GSAT( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -101,4 +113,3 @@ lon <- seq(0, 360, 10) index_dcpp <- GSAT(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/InsertDim.Rd b/man/InsertDim.Rd index 8ab628d..c0dd7d8 100644 --- a/man/InsertDim.Rd +++ b/man/InsertDim.Rd @@ -32,4 +32,3 @@ res <- InsertDim(InsertDim(a, posdim = 2, lendim = 1, name = 'e'), 4, c(f = 2)) dim(res) } - diff --git a/man/LeapYear.Rd b/man/LeapYear.Rd index d261b0a..c2960f3 100644 --- a/man/LeapYear.Rd +++ b/man/LeapYear.Rd @@ -21,4 +21,3 @@ print(LeapYear(1991)) print(LeapYear(1992)) print(LeapYear(1993)) } - diff --git a/man/Load.Rd b/man/Load.Rd index 214f984..10c03f9 100644 --- a/man/Load.Rd +++ b/man/Load.Rd @@ -4,15 +4,36 @@ \alias{Load} \title{Loads Experimental And Observational Data} \usage{ -Load(var, exp = NULL, obs = NULL, sdates, nmember = NULL, - nmemberobs = NULL, nleadtime = NULL, leadtimemin = 1, - leadtimemax = NULL, storefreq = "monthly", sampleperiod = 1, - lonmin = 0, lonmax = 360, latmin = -90, latmax = 90, - output = "areave", method = "conservative", grid = NULL, - maskmod = vector("list", 15), maskobs = vector("list", 15), - configfile = NULL, varmin = NULL, varmax = NULL, silent = FALSE, - nprocs = NULL, dimnames = NULL, remapcells = 2, - path_glob_permissive = "partial") +Load( + var, + exp = NULL, + obs = NULL, + sdates, + nmember = NULL, + nmemberobs = NULL, + nleadtime = NULL, + leadtimemin = 1, + leadtimemax = NULL, + storefreq = "monthly", + sampleperiod = 1, + lonmin = 0, + lonmax = 360, + latmin = -90, + latmax = 90, + output = "areave", + method = "conservative", + grid = NULL, + maskmod = vector("list", 15), + maskobs = vector("list", 15), + configfile = NULL, + varmin = NULL, + varmax = NULL, + silent = FALSE, + nprocs = NULL, + dimnames = NULL, + remapcells = 2, + path_glob_permissive = "partial" +) } \arguments{ \item{var}{Short name of the variable to load. It should coincide with the @@ -874,4 +895,3 @@ sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), lonmin = -12, lonmax = 40) } } - diff --git a/man/MeanDims.Rd b/man/MeanDims.Rd index f200023..9c874fc 100644 --- a/man/MeanDims.Rd +++ b/man/MeanDims.Rd @@ -4,7 +4,7 @@ \alias{MeanDims} \title{Average an array along multiple dimensions} \usage{ -MeanDims(data, dims, na.rm = TRUE, ncores = NULL) +MeanDims(data, dims, na.rm = FALSE, ncores = NULL) } \arguments{ \item{data}{An array to be averaged.} @@ -39,4 +39,3 @@ History:\cr 3.0 - 2020-01 (A. Ho, \email{an.ho@bsc.es}) - Preserve dimension names } \keyword{datagen} - diff --git a/man/Persistence.Rd b/man/Persistence.Rd index 33d4868..3582633 100644 --- a/man/Persistence.Rd +++ b/man/Persistence.Rd @@ -4,9 +4,19 @@ \alias{Persistence} \title{Compute persistence} \usage{ -Persistence(data, dates, time_dim = "time", start, end, ft_start, - ft_end = ft_start, max_ft = 10, nmemb = 1, na.action = 10, - ncores = NULL) +Persistence( + data, + dates, + time_dim = "time", + start, + end, + ft_start, + ft_end = ft_start, + max_ft = 10, + nmemb = 1, + na.action = 10, + ncores = NULL +) } \arguments{ \item{data}{A numeric array corresponding to the observational data @@ -98,4 +108,3 @@ persist <- Persistence(obs1, dates = dates, start = 1961, end = 2005, ft_start = nmemb = 40) } - diff --git a/man/PlotAno.Rd b/man/PlotAno.Rd index 18bf0c9..6591ef1 100644 --- a/man/PlotAno.Rd +++ b/man/PlotAno.Rd @@ -4,12 +4,30 @@ \alias{PlotAno} \title{Plot Anomaly time series} \usage{ -PlotAno(exp_ano, obs_ano = NULL, sdates, toptitle = rep("", 15), - ytitle = rep("", 15), limits = NULL, legends = NULL, freq = 12, - biglab = FALSE, fill = TRUE, memb = TRUE, ensmean = TRUE, - linezero = FALSE, points = FALSE, vlines = NULL, sizetit = 1, - fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, - ...) +PlotAno( + exp_ano, + obs_ano = NULL, + sdates, + toptitle = rep("", 15), + ytitle = rep("", 15), + limits = NULL, + legends = NULL, + freq = 12, + biglab = FALSE, + fill = TRUE, + memb = TRUE, + ensmean = TRUE, + linezero = FALSE, + points = FALSE, + vlines = NULL, + sizetit = 1, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{exp_ano}{A numerical array containing the experimental data:\cr @@ -100,4 +118,3 @@ PlotAno(smooth_ano_exp, smooth_ano_obs, startDates, legends = 'ERSST', biglab = FALSE) } - diff --git a/man/PlotClim.Rd b/man/PlotClim.Rd index b62ff44..9b3381e 100644 --- a/man/PlotClim.Rd +++ b/man/PlotClim.Rd @@ -4,11 +4,26 @@ \alias{PlotClim} \title{Plots Climatologies} \usage{ -PlotClim(exp_clim, obs_clim = NULL, toptitle = "", ytitle = "", - monini = 1, freq = 12, limits = NULL, listexp = c("exp1", "exp2", - "exp3"), listobs = c("obs1", "obs2", "obs3"), biglab = FALSE, - leg = TRUE, sizetit = 1, fileout = NULL, width = 8, height = 5, - size_units = "in", res = 100, ...) +PlotClim( + exp_clim, + obs_clim = NULL, + toptitle = "", + ytitle = "", + monini = 1, + freq = 12, + limits = NULL, + listexp = c("exp1", "exp2", "exp3"), + listobs = c("obs1", "obs2", "obs3"), + biglab = FALSE, + leg = TRUE, + sizetit = 1, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{exp_clim}{Matrix containing the experimental data with dimensions:\cr @@ -79,4 +94,3 @@ PlotClim(clim$clim_exp, clim$clim_obs, toptitle = paste('climatologies'), listobs = c('ERSST'), biglab = FALSE, fileout = NULL) } - diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index cf45ead..fbd7042 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -4,25 +4,72 @@ \alias{PlotEquiMap} \title{Maps A Two-Dimensional Variable On A Cylindrical Equidistant Projection} \usage{ -PlotEquiMap(var, lon, lat, varu = NULL, varv = NULL, toptitle = NULL, - sizetit = NULL, units = NULL, brks = NULL, cols = NULL, - bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, - col_sup = NULL, colNA = NULL, color_fun = clim.palette(), - square = TRUE, filled.continents = NULL, coast_color = NULL, - coast_width = 1, contours = NULL, brks2 = NULL, contour_lwd = 0.5, - contour_color = "black", contour_lty = 1, contour_label_scale = 1, - dots = NULL, dot_symbol = 4, dot_size = 1, - arr_subsamp = floor(length(lon)/30), arr_scale = 1, arr_ref_len = 15, - arr_units = "m/s", arr_scale_shaft = 1, arr_scale_shaft_angle = 1, - axelab = TRUE, labW = FALSE, intylat = 20, intxlon = 20, - axes_tick_scale = 1, axes_label_scale = 1, drawleg = TRUE, - subsampleg = NULL, bar_extra_labels = NULL, draw_bar_ticks = TRUE, - draw_separators = FALSE, triangle_ends_scale = 1, bar_label_digits = 4, - bar_label_scale = 1, units_scale = 1, bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), boxlim = NULL, boxcol = "purple2", - boxlwd = 5, margin_scale = rep(1, 4), title_scale = 1, numbfig = NULL, - fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, - ...) +PlotEquiMap( + var, + lon, + lat, + varu = NULL, + varv = NULL, + toptitle = NULL, + sizetit = NULL, + units = NULL, + brks = NULL, + cols = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + colNA = NULL, + color_fun = clim.palette(), + square = TRUE, + filled.continents = NULL, + coast_color = NULL, + coast_width = 1, + contours = NULL, + brks2 = NULL, + contour_lwd = 0.5, + contour_color = "black", + contour_lty = 1, + contour_label_scale = 1, + dots = NULL, + dot_symbol = 4, + dot_size = 1, + arr_subsamp = floor(length(lon)/30), + arr_scale = 1, + arr_ref_len = 15, + arr_units = "m/s", + arr_scale_shaft = 1, + arr_scale_shaft_angle = 1, + axelab = TRUE, + labW = FALSE, + intylat = 20, + intxlon = 20, + axes_tick_scale = 1, + axes_label_scale = 1, + drawleg = TRUE, + subsampleg = NULL, + bar_extra_labels = NULL, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_label_digits = 4, + bar_label_scale = 1, + units_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + boxlim = NULL, + boxcol = "purple2", + boxlwd = 5, + margin_scale = rep(1, 4), + title_scale = 1, + numbfig = NULL, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Array with the values at each cell of a grid on a regular @@ -278,4 +325,3 @@ 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) } - diff --git a/man/PlotLayout.Rd b/man/PlotLayout.Rd index f01fdf9..453cf2e 100644 --- a/man/PlotLayout.Rd +++ b/man/PlotLayout.Rd @@ -4,20 +4,52 @@ \alias{PlotLayout} \title{Arrange and Fill Multi-Pannel Layouts With Optional Colour Bar} \usage{ -PlotLayout(fun, plot_dims, var, ..., special_args = NULL, nrow = NULL, - ncol = NULL, toptitle = NULL, row_titles = NULL, col_titles = NULL, - bar_scale = 1, title_scale = 1, title_margin_scale = 1, - title_left_shift_scale = 1, subtitle_scale = 1, - subtitle_margin_scale = 1, brks = NULL, cols = NULL, drawleg = "S", - titles = NULL, subsampleg = NULL, bar_limits = NULL, - triangle_ends = NULL, col_inf = NULL, col_sup = NULL, - color_fun = clim.colors, draw_bar_ticks = TRUE, draw_separators = FALSE, - triangle_ends_scale = 1, bar_extra_labels = NULL, units = NULL, - units_scale = 1, bar_label_scale = 1, bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), bar_left_shift_scale = 1, - bar_label_digits = 4, extra_margin = rep(0, 4), fileout = NULL, - width = NULL, height = NULL, size_units = "in", res = 100, - close_device = TRUE) +PlotLayout( + fun, + plot_dims, + var, + ..., + special_args = NULL, + nrow = NULL, + ncol = NULL, + toptitle = NULL, + row_titles = NULL, + col_titles = NULL, + bar_scale = 1, + title_scale = 1, + title_margin_scale = 1, + title_left_shift_scale = 1, + subtitle_scale = 1, + subtitle_margin_scale = 1, + brks = NULL, + cols = NULL, + drawleg = "S", + titles = NULL, + subsampleg = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + color_fun = clim.colors, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_extra_labels = NULL, + units = NULL, + units_scale = 1, + bar_label_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + bar_left_shift_scale = 1, + bar_label_digits = 4, + extra_margin = rep(0, 4), + fileout = NULL, + width = NULL, + height = NULL, + size_units = "in", + res = 100, + close_device = TRUE +) } \arguments{ \item{fun}{Plot function (or name of the function) to be called on the @@ -48,6 +80,12 @@ applied to each of them. NAs can be passed to the list: a NA will yield a blank cell in the layout, which can be populated after (see .SwitchToFigure).} +\item{\dots}{Parameters to be sent to the plotting function 'fun'. If +multiple arrays are provided in 'var' and multiple functions are provided +in 'fun', the parameters provided through \dots will be sent to all the +plot functions, as common parameters. To specify concrete arguments for +each of the plot functions see parameter 'special_args'.} + \item{special_args}{List of sub-lists, each sub-list having specific extra arguments for each of the plot functions provided in 'fun'. If you want to fix a different value for each plot in the layout you can do so by @@ -164,12 +202,6 @@ the layout and a 'fileout' has been specified. This is useful to avoid closing the device when saving the layout into a file and willing to add extra elements or figures. Takes TRUE by default. Disregarded if no 'fileout' has been specified.} - -\item{\dots}{Parameters to be sent to the plotting function 'fun'. If -multiple arrays are provided in 'var' and multiple functions are provided -in 'fun', the parameters provided through \dots will be sent to all the -plot functions, as common parameters. To specify concrete arguments for -each of the plot functions see parameter 'special_args'.} } \value{ \item{brks}{ @@ -244,4 +276,3 @@ PlotLayout(PlotEquiMap, c('lat', 'lon'), sampleData$mod[1, , 1, 1, , ], titles = paste('Member', 1:15)) } - diff --git a/man/PlotMatrix.Rd b/man/PlotMatrix.Rd index 24f046d..5275df0 100644 --- a/man/PlotMatrix.Rd +++ b/man/PlotMatrix.Rd @@ -4,12 +4,28 @@ \alias{PlotMatrix} \title{Function to convert any numerical table to a grid of coloured squares.} \usage{ -PlotMatrix(var, brks = NULL, cols = NULL, toptitle = NULL, - title.color = "royalblue4", xtitle = NULL, ytitle = NULL, - xlabels = NULL, xvert = FALSE, ylabels = NULL, line = 3, - figure.width = 1, legend = TRUE, legend.width = 0.15, - xlab_dist = NULL, ylab_dist = NULL, fileout = NULL, size_units = "px", - res = 100, ...) +PlotMatrix( + var, + brks = NULL, + cols = NULL, + toptitle = NULL, + title.color = "royalblue4", + xtitle = NULL, + ytitle = NULL, + xlabels = NULL, + xvert = FALSE, + ylabels = NULL, + line = 3, + figure.width = 1, + legend = TRUE, + legend.width = 0.15, + xlab_dist = NULL, + ylab_dist = NULL, + fileout = NULL, + size_units = "px", + res = 100, + ... +) } \arguments{ \item{var}{A numerical matrix containing the values to be displayed in a @@ -93,4 +109,3 @@ PlotMatrix(var = matrix(rnorm(n = 120, mean = 0.3), 10, 12), xlabels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")) } - diff --git a/man/PlotSection.Rd b/man/PlotSection.Rd index 413ef63..1627339 100644 --- a/man/PlotSection.Rd +++ b/man/PlotSection.Rd @@ -4,10 +4,26 @@ \alias{PlotSection} \title{Plots A Vertical Section} \usage{ -PlotSection(var, horiz, depth, toptitle = "", sizetit = 1, units = "", - brks = NULL, cols = NULL, axelab = TRUE, intydep = 200, - intxhoriz = 20, drawleg = TRUE, fileout = NULL, width = 8, - height = 5, size_units = "in", res = 100, ...) +PlotSection( + var, + horiz, + depth, + toptitle = "", + sizetit = 1, + units = "", + brks = NULL, + cols = NULL, + axelab = TRUE, + intydep = 200, + intxhoriz = 20, + drawleg = TRUE, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Matrix to plot with (longitude/latitude, depth) dimensions.} @@ -69,4 +85,3 @@ sampleData <- s2dv::sampleDepthData PlotSection(sampleData$mod[1, 1, 1, 1, , ], sampleData$lat, sampleData$depth, toptitle = 'temperature 1995-11 member 0') } - diff --git a/man/PlotStereoMap.Rd b/man/PlotStereoMap.Rd index 4b910a9..95c2f71 100644 --- a/man/PlotStereoMap.Rd +++ b/man/PlotStereoMap.Rd @@ -4,19 +4,53 @@ \alias{PlotStereoMap} \title{Maps A Two-Dimensional Variable On A Polar Stereographic Projection} \usage{ -PlotStereoMap(var, lon, lat, latlims = c(60, 90), toptitle = NULL, - sizetit = NULL, units = NULL, brks = NULL, cols = NULL, - bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, - col_sup = NULL, colNA = NULL, color_fun = clim.palette(), - filled.continents = FALSE, coast_color = NULL, coast_width = 1, - dots = NULL, dot_symbol = 4, dot_size = 0.8, intlat = 10, - drawleg = TRUE, subsampleg = NULL, bar_extra_labels = NULL, - draw_bar_ticks = TRUE, draw_separators = FALSE, triangle_ends_scale = 1, - bar_label_digits = 4, bar_label_scale = 1, units_scale = 1, - bar_tick_scale = 1, bar_extra_margin = rep(0, 4), boxlim = NULL, - boxcol = "purple2", boxlwd = 5, margin_scale = rep(1, 4), - title_scale = 1, numbfig = NULL, fileout = NULL, width = 6, - height = 5, size_units = "in", res = 100, ...) +PlotStereoMap( + var, + lon, + lat, + latlims = c(60, 90), + toptitle = NULL, + sizetit = NULL, + units = NULL, + brks = NULL, + cols = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + colNA = NULL, + color_fun = clim.palette(), + filled.continents = FALSE, + coast_color = NULL, + coast_width = 1, + dots = NULL, + dot_symbol = 4, + dot_size = 0.8, + intlat = 10, + drawleg = TRUE, + subsampleg = NULL, + bar_extra_labels = NULL, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_label_digits = 4, + bar_label_scale = 1, + units_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + boxlim = NULL, + boxcol = "purple2", + boxlwd = 5, + margin_scale = rep(1, 4), + title_scale = 1, + numbfig = NULL, + fileout = NULL, + width = 6, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Array with the values at each cell of a grid on a regular @@ -183,4 +217,3 @@ y <- seq(from = -90, to = 90, length.out = 50) PlotStereoMap(data, x, y, latlims = c(60, 90), brks = 50, toptitle = "This is the title") } - diff --git a/man/RMS.Rd b/man/RMS.Rd index 7bd33b3..4391df4 100644 --- a/man/RMS.Rd +++ b/man/RMS.Rd @@ -4,8 +4,17 @@ \alias{RMS} \title{Compute root mean square error} \usage{ -RMS(exp, obs, time_dim = "sdate", dat_dim = "dataset", comp_dim = NULL, - limits = NULL, conf = TRUE, conf.lev = 0.95, ncores = NULL) +RMS( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + comp_dim = NULL, + limits = NULL, + conf = TRUE, + conf.lev = 0.95, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -79,4 +88,3 @@ The confidence interval is computed by the chi2 distribution.\cr # Renew example when Ano and Smoothing are ready } - diff --git a/man/RMSSS.Rd b/man/RMSSS.Rd index 1b8274f..9ebcf65 100644 --- a/man/RMSSS.Rd +++ b/man/RMSSS.Rd @@ -4,8 +4,14 @@ \alias{RMSSS} \title{Compute root mean square error skill score} \usage{ -RMSSS(exp, obs, time_dim = "sdate", dat_dim = "dataset", pval = TRUE, - ncores = NULL) +RMSSS( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + pval = TRUE, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data which contains at least @@ -66,4 +72,3 @@ obs <- array(rnorm(15), dim = c(time = 3, memb = 5, dataset = 1)) res <- RMSSS(exp, obs, time_dim = 'time') } - diff --git a/man/RandomWalkTest.Rd b/man/RandomWalkTest.Rd index 33b226f..1110648 100644 --- a/man/RandomWalkTest.Rd +++ b/man/RandomWalkTest.Rd @@ -49,4 +49,3 @@ skill_B <- abs(fcst_B - reference) RandomWalkTest(skill_A = skill_A, skill_B = skill_B, time_dim = 'sdate', ncores = 1) } - diff --git a/man/Regression.Rd b/man/Regression.Rd index 4faafc1..8e27295 100644 --- a/man/Regression.Rd +++ b/man/Regression.Rd @@ -4,8 +4,17 @@ \alias{Regression} \title{Compute the regression of an array on another along one dimension.} \usage{ -Regression(datay, datax, reg_dim = "sdate", formula = y ~ x, pval = TRUE, - conf = TRUE, conf.lev = 0.95, na.action = na.omit, ncores = NULL) +Regression( + datay, + datax, + reg_dim = "sdate", + formula = y ~ x, + pval = TRUE, + conf = TRUE, + conf.lev = 0.95, + na.action = na.omit, + ncores = NULL +) } \arguments{ \item{datay}{An numeric array as predictand including the dimension along @@ -92,4 +101,3 @@ res1 <- Regression(datay, datax, formula = y~poly(x, 2, raw = TRUE)) res2 <- Regression(datay, datax, conf.lev = 0.9) } - diff --git a/man/Reorder.Rd b/man/Reorder.Rd index 0afa07e..8748aaf 100644 --- a/man/Reorder.Rd +++ b/man/Reorder.Rd @@ -26,4 +26,3 @@ Reorder the dimension order of a multi-dimensional array dat2 <- array(c(1:10), dim = c(2, 1, 5)) print(dim(Reorder(dat2, c(2, 1, 3)))) } - diff --git a/man/SPOD.Rd b/man/SPOD.Rd index cbbbf1a..5a20a3f 100644 --- a/man/SPOD.Rd +++ b/man/SPOD.Rd @@ -4,10 +4,22 @@ \alias{SPOD} \title{Compute the South Pacific Ocean Dipole (SPOD) index} \usage{ -SPOD(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +SPOD( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -104,4 +116,3 @@ lon <- seq(0, 360, 10) index_dcpp <- SPOD(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/Season.Rd b/man/Season.Rd index cb10dee..3c1e3ff 100644 --- a/man/Season.Rd +++ b/man/Season.Rd @@ -4,8 +4,16 @@ \alias{Season} \title{Compute seasonal mean} \usage{ -Season(data, time_dim = "ftime", monini, moninf, monsup, method = mean, - na.rm = TRUE, ncores = NULL) +Season( + data, + time_dim = "ftime", + monini, + moninf, + monsup, + method = mean, + na.rm = TRUE, + ncores = NULL +) } \arguments{ \item{data}{A named numeric array with at least one dimension 'time_dim'.} @@ -53,4 +61,3 @@ dat2[na] <- NA res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2) res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2, na.rm = FALSE) } - diff --git a/man/Smoothing.Rd b/man/Smoothing.Rd index ba62ca1..8d4a558 100644 --- a/man/Smoothing.Rd +++ b/man/Smoothing.Rd @@ -43,4 +43,3 @@ PlotAno(smooth_ano_exp, smooth_ano_obs, startDates, fileout = "tos_smoothed_ano.png") } } - diff --git a/man/TPI.Rd b/man/TPI.Rd index 6968f22..fdbc2b8 100644 --- a/man/TPI.Rd +++ b/man/TPI.Rd @@ -4,10 +4,22 @@ \alias{TPI} \title{Compute the Tripole Index (TPI) for the Interdecadal Pacific Oscillation (IPO)} \usage{ -TPI(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +TPI( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -103,4 +115,3 @@ lon = seq(0, 360, 10) index_dcpp = TPI(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/ToyModel.Rd b/man/ToyModel.Rd index 379ed3b..ee7a98e 100644 --- a/man/ToyModel.Rd +++ b/man/ToyModel.Rd @@ -7,8 +7,18 @@ components of a forecast: (1) predictabiltiy (2) forecast error (3) non-stationarity and (4) ensemble generation. The forecast can be computed for real observations or observations generated artifically.} \usage{ -ToyModel(alpha = 0.1, beta = 0.4, gamma = 1, sig = 1, trend = 0, - nstartd = 30, nleadt = 4, nmemb = 10, obsini = NULL, fxerr = NULL) +ToyModel( + alpha = 0.1, + beta = 0.4, + gamma = 1, + sig = 1, + trend = 0, + nstartd = 30, + nleadt = 4, + nmemb = 10, + obsini = NULL, + fxerr = NULL +) } \arguments{ \item{alpha}{Predicabiltiy of the forecast on the observed residuals @@ -120,4 +130,3 @@ toyforecast <- ToyModel(alpha = a, beta = b, gamma = g, nmemb = nm, # } } - diff --git a/man/Trend.Rd b/man/Trend.Rd index a641041..d283ee6 100644 --- a/man/Trend.Rd +++ b/man/Trend.Rd @@ -4,8 +4,16 @@ \alias{Trend} \title{Compute the trend} \usage{ -Trend(data, time_dim = "ftime", interval = 1, polydeg = 1, conf = TRUE, - conf.lev = 0.95, pval = TRUE, ncores = NULL) +Trend( + data, + time_dim = "ftime", + interval = 1, + polydeg = 1, + conf = TRUE, + conf.lev = 0.95, + pval = TRUE, + ncores = NULL +) } \arguments{ \item{data}{An numeric array including the dimension along which the trend @@ -80,4 +88,3 @@ months_between_startdates <- 60 trend <- Trend(sampleData$obs, polydeg = 2, interval = months_between_startdates) } - diff --git a/man/clim.palette.Rd b/man/clim.palette.Rd index d912f47..5d17947 100644 --- a/man/clim.palette.Rd +++ b/man/clim.palette.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/clim.palette.R \name{clim.palette} -\alias{clim.colors} \alias{clim.palette} +\alias{clim.colors} \title{Generate Climate Color Palettes} \usage{ clim.palette(palette = "bluered") @@ -30,4 +30,3 @@ cols <- clim.colors(20) ColorBar(lims, cols) } - diff --git a/man/s2dv-package.Rd b/man/s2dv-package.Rd index cb52214..043b081 100644 --- a/man/s2dv-package.Rd +++ b/man/s2dv-package.Rd @@ -4,20 +4,45 @@ \name{s2dv-package} \alias{s2dv} \alias{s2dv-package} -\title{A Set of Common Tools for Seasonal to Decadal Verification} +\title{s2dv: A Set of Common Tools for Seasonal to Decadal Verification} \description{ -The advanced version of package 's2dverification'. It is -intended for 'seasonal to decadal' (s2d) climate forecast verification, but -it can also be used in other kinds of forecasts or general climate analysis. -This package is specially designed for the comparison between the experimental -and observational datasets. The functionality of the included functions covers -from data retrieval, data post-processing, skill scores against observation, -to visualization. Compared to 's2dverification', 's2dv' is more compatible -with the package 'startR', able to use multiple cores for computation and -handle multi-dimensional arrays with a higher flexibility. +The advanced version of package 's2dverification'. It is + intended for 'seasonal to decadal' (s2d) climate forecast verification, but + it can also be used in other kinds of forecasts or general climate analysis. + This package is specially designed for the comparison between the experimental + and observational datasets. The functionality of the included functions covers + from data retrieval, data post-processing, skill scores against observation, + to visualization. Compared to 's2dverification', 's2dv' is more compatible + with the package 'startR', able to use multiple cores for computation and + handle multi-dimensional arrays with a higher flexibility. } \references{ \url{https://earth.bsc.es/gitlab/es/s2dv/} } -\keyword{internal} +\seealso{ +Useful links: +\itemize{ + \item \url{https://earth.bsc.es/gitlab/es/s2dv/} + \item Report bugs at \url{https://earth.bsc.es/gitlab/es/s2dv/-/issues} +} + +} +\author{ +\strong{Maintainer}: An-Chi Ho \email{an.ho@bsc.es} + +Authors: +\itemize{ + \item BSC-CNS [copyright holder] + \item Nuria Perez-Zanon \email{nuria.perez@bsc.es} +} + +Other contributors: +\itemize{ + \item Roberto Bilbao \email{roberto.bilbao@bsc.es} [contributor] + \item Carlos Delgado \email{carlos.delgado@bsc.es} [contributor] + \item Andrea Manrique \email{andrea.manrique@bsc.es} [contributor] + \item Deborah Verfaillie \email{deborah.verfaillie@bsc.es} [contributor] +} +} +\keyword{internal} diff --git a/man/sampleDepthData.Rd b/man/sampleDepthData.Rd index 869af86..77e4a7a 100644 --- a/man/sampleDepthData.Rd +++ b/man/sampleDepthData.Rd @@ -28,4 +28,3 @@ variable 'tos', i.e. sea surface temperature, from the decadal climate prediction experiment run at IC3 in the context of the CMIP5 project.\cr Its name within IC3 local database is 'i00k'. } - diff --git a/man/sampleMap.Rd b/man/sampleMap.Rd index 651d185..eaf8aa5 100644 --- a/man/sampleMap.Rd +++ b/man/sampleMap.Rd @@ -43,4 +43,3 @@ sampleData <- Load('tos', list(exp), list(obs), startDates, } Check the documentation on 'Load()' in the package 's2dv' for more information. } - diff --git a/man/sampleTimeSeries.Rd b/man/sampleTimeSeries.Rd index 280277e..05a8e79 100644 --- a/man/sampleTimeSeries.Rd +++ b/man/sampleTimeSeries.Rd @@ -47,4 +47,3 @@ sampleData <- Load('tos', list(exp), list(obs), startDates, } Check the documentation on 'Load()' in the package 's2dv' for more information. } - -- GitLab From 5eba00394f52f614a7b42a15e4f68ea7d28fd74b Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 12 Feb 2021 09:55:45 +0100 Subject: [PATCH 027/154] Specify the package name of Subset() to avoid confusion. --- R/Ano_CrossValid.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Ano_CrossValid.R b/R/Ano_CrossValid.R index e4a8b77..f00a267 100644 --- a/R/Ano_CrossValid.R +++ b/R/Ano_CrossValid.R @@ -208,8 +208,8 @@ Ano_CrossValid <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', } } # calculate ano - ano_exp_list[[tt]] <- Subset(exp, 1, tt, drop = 'selected') - clim_exp - ano_obs_list[[tt]] <- Subset(obs, 1, tt, drop = 'selected') - clim_obs + ano_exp_list[[tt]] <- ClimProjDiags::Subset(exp, 1, tt, drop = 'selected') - clim_exp + ano_obs_list[[tt]] <- ClimProjDiags::Subset(obs, 1, tt, drop = 'selected') - clim_obs } ano_exp <- array(unlist(ano_exp_list), dim = c(dim(exp)[-1], dim(exp)[1])) -- GitLab From 21386eb8e39bebae22b63851058790b31a733474 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 16 Feb 2021 13:34:19 +0100 Subject: [PATCH 028/154] Add param 'ncores' in the s2dv functions used inside --- R/Clim.R | 22 +++++++++++----------- R/MeanDims.R | 1 + 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/R/Clim.R b/R/Clim.R index d879fc4..fead92b 100644 --- a/R/Clim.R +++ b/R/Clim.R @@ -172,13 +172,13 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), ## dat_dim: [dataset, member] pos[i] <- which(names(dim(obs)) == dat_dim[i]) } - outrows_exp <- MeanDims(exp, pos, na.rm = FALSE) + - MeanDims(obs, pos, na.rm = FALSE) + outrows_exp <- MeanDims(exp, pos, na.rm = FALSE, ncores = ncores) + + MeanDims(obs, pos, na.rm = FALSE, ncores = ncores) 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]]) + outrows_exp <- InsertDim(outrows_exp, pos[i], dim(exp)[pos[i]], ncores = ncores) + outrows_obs <- InsertDim(outrows_obs, pos[i], dim(obs)[pos[i]], ncores = ncores) } exp[which(is.na(outrows_exp))] <- NA obs[which(is.na(outrows_obs))] <- NA @@ -227,7 +227,7 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), .Clim <- function(exp, obs, method = 'clim', time_dim = 'sdate', dat_dim = c('dataset', 'member'), ftime_dim = 'ftime', memb_dim = 'member', memb = TRUE, - na.rm = TRUE) { + na.rm = TRUE, ncores = NULL) { if (method == 'clim') { # exp: [sdate, dat_dim_exp] @@ -269,9 +269,9 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), # exp clim ##--- NEW trend ---## tmp_obs <- Trend(data = obs, time_dim = time_dim, interval = 1, - polydeg = 1, conf = FALSE)$trend + polydeg = 1, conf = FALSE, ncores = ncores)$trend tmp_exp <- Trend(data = exp, time_dim = time_dim, interval = 1, - polydeg = 1, conf = FALSE)$trend + polydeg = 1, conf = FALSE, ncores = ncores)$trend # tmp_exp: [stats, dat_dim)] tmp_obs_mean <- apply(tmp_obs, 1, mean) #average out dat_dim (dat and member) @@ -331,16 +331,16 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), # Create initial data set (i.e., only first ftime) tmp <- Subset(exp, ftime_dim, 1, drop = 'selected') - ini_exp <- InsertDim(tmp, pos_ftime, dim_ftime) #only first ftime + ini_exp <- InsertDim(tmp, pos_ftime, dim_ftime, ncores = ncores) #only first ftime tmp <- Subset(obs, ftime_dim, 1, drop = 'selected') - ini_obs <- InsertDim(tmp, pos_ftime, dim_ftime) #only first ftime + ini_obs <- InsertDim(tmp, pos_ftime, dim_ftime, ncores = ncores) #only first ftime #ini_: [sdate, dat_dim, ftime] tmp_exp <- Regression(datay = exp, datax = ini_exp, reg_dim = time_dim, na.action = na.omit, - pval = FALSE, conf = FALSE)$regression + pval = FALSE, conf = FALSE, ncores = ncores)$regression tmp_obs <- Regression(datay = obs, datax = ini_obs, reg_dim = time_dim, na.action = na.omit, - pval = FALSE, conf = FALSE)$regression + pval = FALSE, conf = FALSE, ncores = ncores)$regression #tmp_: [stats = 2, dat_dim, ftime] tmp_obs_mean <- apply(tmp_obs, c(1, length(dim(tmp_obs))), mean) #average out dat_dim (dat and member) #tmp_obs_mean: [stats = 2, ftime] diff --git a/R/MeanDims.R b/R/MeanDims.R index 4b22d51..3ee8ba8 100644 --- a/R/MeanDims.R +++ b/R/MeanDims.R @@ -23,6 +23,7 @@ #'a <- array(rnorm(24), dim = c(2, 3, 4)) #'MeanDims(a, 2) #'MeanDims(a, c(2, 3)) +#'@import multiApply #'@export MeanDims <- function(data, dims, na.rm = FALSE, ncores = NULL) { -- GitLab From c4abca60154f9e047066b6889c8a0ea134aa2932 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 16 Feb 2021 13:34:54 +0100 Subject: [PATCH 029/154] Update Rd file format with newer devtools version --- DESCRIPTION | 2 +- man/AMV.Rd | 21 ++++++-- man/AnimateMap.Rd | 33 +++++++++--- man/Ano.Rd | 1 - man/Clim.Rd | 16 ++++-- man/ColorBar.Rd | 32 +++++++++--- man/Composite.Rd | 14 +++-- man/ConfigApplyMatchingEntries.Rd | 11 ++-- man/ConfigEditDefinition.Rd | 1 - man/ConfigEditEntry.Rd | 45 ++++++++++++---- man/ConfigFileOpen.Rd | 3 +- man/ConfigShowSimilarEntries.Rd | 17 ++++-- man/ConfigShowTable.Rd | 3 +- man/Corr.Rd | 17 ++++-- man/Eno.Rd | 1 - man/GMST.Rd | 24 +++++++-- man/GSAT.Rd | 21 ++++++-- man/InsertDim.Rd | 1 - man/LeapYear.Rd | 1 - man/Load.Rd | 40 ++++++++++---- man/MeanDims.Rd | 3 +- man/Persistence.Rd | 17 ++++-- man/PlotAno.Rd | 31 ++++++++--- man/PlotClim.Rd | 26 +++++++--- man/PlotEquiMap.Rd | 86 ++++++++++++++++++++++++------- man/PlotLayout.Rd | 73 ++++++++++++++++++-------- man/PlotMatrix.Rd | 29 ++++++++--- man/PlotSection.Rd | 25 +++++++-- man/PlotStereoMap.Rd | 61 +++++++++++++++++----- man/RMS.Rd | 14 +++-- man/RMSSS.Rd | 11 ++-- man/RandomWalkTest.Rd | 1 - man/Regression.Rd | 14 +++-- man/Reorder.Rd | 1 - man/SPOD.Rd | 21 ++++++-- man/Season.Rd | 13 +++-- man/Smoothing.Rd | 1 - man/TPI.Rd | 21 ++++++-- man/ToyModel.Rd | 15 ++++-- man/Trend.Rd | 13 +++-- man/clim.palette.Rd | 3 +- man/s2dv-package.Rd | 47 +++++++++++++---- man/sampleDepthData.Rd | 1 - man/sampleMap.Rd | 1 - man/sampleTimeSeries.Rd | 1 - 45 files changed, 620 insertions(+), 213 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 126179a..30fd237 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -45,4 +45,4 @@ BugReports: https://earth.bsc.es/gitlab/es/s2dv/-/issues LazyData: true SystemRequirements: cdo Encoding: UTF-8 -RoxygenNote: 5.0.0 +RoxygenNote: 7.0.1 diff --git a/man/AMV.Rd b/man/AMV.Rd index 5aa6d30..881e136 100644 --- a/man/AMV.Rd +++ b/man/AMV.Rd @@ -4,10 +4,22 @@ \alias{AMV} \title{Compute the Atlantic Multidecadal Variability (AMV) index} \usage{ -AMV(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +AMV( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -106,4 +118,3 @@ lon <- seq(0, 360, 10) index_dcpp <- AMV(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/AnimateMap.Rd b/man/AnimateMap.Rd index d2003ee..2ec930d 100644 --- a/man/AnimateMap.Rd +++ b/man/AnimateMap.Rd @@ -4,13 +4,33 @@ \alias{AnimateMap} \title{Animate Maps of Forecast/Observed Values or Scores Over Forecast Time} \usage{ -AnimateMap(var, lon, lat, toptitle = rep("", 11), sizetit = 1, units = "", - monini = 1, freq = 12, msk95lev = FALSE, brks = NULL, cols = NULL, - filled.continents = FALSE, lonmin = 0, lonmax = 360, latmin = -90, - latmax = 90, intlon = 20, intlat = 30, drawleg = TRUE, - subsampleg = 1, colNA = "white", equi = TRUE, +AnimateMap( + var, + lon, + lat, + toptitle = rep("", 11), + sizetit = 1, + units = "", + monini = 1, + freq = 12, + msk95lev = FALSE, + brks = NULL, + cols = NULL, + filled.continents = FALSE, + lonmin = 0, + lonmax = 360, + latmin = -90, + latmax = 90, + intlon = 20, + intlat = 30, + drawleg = TRUE, + subsampleg = 1, + colNA = "white", + equi = TRUE, fileout = c("output1_animvsltime.gif", "output2_animvsltime.gif", - "output3_animvsltime.gif"), ...) + "output3_animvsltime.gif"), + ... +) } \arguments{ \item{var}{Matrix of dimensions (nltime, nlat, nlon) or @@ -162,4 +182,3 @@ AnimateMap(clim$clim_exp, sampleData$lon, sampleData$lat, # More examples in s2dverification but are deleted for now } - diff --git a/man/Ano.Rd b/man/Ano.Rd index 2dd4dea..8e423af 100644 --- a/man/Ano.Rd +++ b/man/Ano.Rd @@ -41,4 +41,3 @@ PlotAno(ano_exp, ano_obs, startDates, legends = 'ERSST', biglab = FALSE, fileout = 'tos_ano.png') } } - diff --git a/man/Clim.Rd b/man/Clim.Rd index a997a7f..78559bd 100644 --- a/man/Clim.Rd +++ b/man/Clim.Rd @@ -4,9 +4,18 @@ \alias{Clim} \title{Compute Bias Corrected Climatologies} \usage{ -Clim(exp, obs, time_dim = "sdate", dat_dim = c("dataset", "member"), - method = "clim", ftime_dim = "ftime", memb = TRUE, - memb_dim = "member", na.rm = TRUE, ncores = NULL) +Clim( + exp, + obs, + time_dim = "sdate", + dat_dim = c("dataset", "member"), + method = "clim", + ftime_dim = "ftime", + memb = TRUE, + memb_dim = "member", + na.rm = TRUE, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -82,4 +91,3 @@ PlotClim(clim$clim_exp, clim$clim_obs, listobs = c('ERSST'), biglab = FALSE, fileout = 'tos_clim.eps') } } - diff --git a/man/ColorBar.Rd b/man/ColorBar.Rd index 1287b70..6d62f15 100644 --- a/man/ColorBar.Rd +++ b/man/ColorBar.Rd @@ -4,13 +4,30 @@ \alias{ColorBar} \title{Draws a Color Bar} \usage{ -ColorBar(brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, - bar_limits = NULL, var_limits = NULL, triangle_ends = NULL, - col_inf = NULL, col_sup = NULL, color_fun = clim.palette(), - plot = TRUE, draw_ticks = TRUE, draw_separators = FALSE, - triangle_ends_scale = 1, extra_labels = NULL, title = NULL, - title_scale = 1, label_scale = 1, tick_scale = 1, - extra_margin = rep(0, 4), label_digits = 4, ...) +ColorBar( + brks = NULL, + cols = NULL, + vertical = TRUE, + subsampleg = NULL, + bar_limits = NULL, + var_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + color_fun = clim.palette(), + plot = TRUE, + draw_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + extra_labels = NULL, + title = NULL, + title_scale = 1, + label_scale = 1, + tick_scale = 1, + extra_margin = rep(0, 4), + label_digits = 4, + ... +) } \arguments{ \item{brks}{Can be provided in two formats: @@ -175,4 +192,3 @@ cols <- c("dodgerblue4", "dodgerblue1", "forestgreen", "yellowgreen", "white", lims <- seq(-1, 1, 0.2) ColorBar(lims, cols) } - diff --git a/man/Composite.Rd b/man/Composite.Rd index 64d5bfc..cc21d38 100644 --- a/man/Composite.Rd +++ b/man/Composite.Rd @@ -4,8 +4,17 @@ \alias{Composite} \title{Compute composites} \usage{ -Composite(data, occ, time_dim = "time", space_dim = c("lon", "lat"), - lag = 0, eno = FALSE, K = NULL, fileout = NULL, ncores = NULL) +Composite( + data, + occ, + time_dim = "time", + space_dim = c("lon", "lat"), + lag = 0, + eno = FALSE, + K = NULL, + fileout = NULL, + ncores = NULL +) } \arguments{ \item{data}{A numeric array containing two spatial and one temporal @@ -101,4 +110,3 @@ occ <- c(1, 1, 2, 2, 3, 3) res <- Composite(data, occ, time_dim = 'case', K = 4) } - diff --git a/man/ConfigApplyMatchingEntries.Rd b/man/ConfigApplyMatchingEntries.Rd index 5f0efb1..ee4cb5a 100644 --- a/man/ConfigApplyMatchingEntries.Rd +++ b/man/ConfigApplyMatchingEntries.Rd @@ -4,8 +4,14 @@ \alias{ConfigApplyMatchingEntries} \title{Apply Matching Entries To Dataset Name And Variable Name To Find Related Info} \usage{ -ConfigApplyMatchingEntries(configuration, var, exp = NULL, obs = NULL, - show_entries = FALSE, show_result = TRUE) +ConfigApplyMatchingEntries( + configuration, + var, + exp = NULL, + obs = NULL, + show_entries = FALSE, + show_result = TRUE +) } \arguments{ \item{configuration}{Configuration object obtained from ConfigFileOpen() @@ -68,4 +74,3 @@ ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigEditDefinition.Rd b/man/ConfigEditDefinition.Rd index 8e1e968..223e95a 100644 --- a/man/ConfigEditDefinition.Rd +++ b/man/ConfigEditDefinition.Rd @@ -57,4 +57,3 @@ match_info <- ConfigApplyMatchingEntries(configuration, 'tas', [ConfigEditEntry()], [ConfigFileOpen()], [ConfigShowSimilarEntries()], [ConfigShowTable()]. } - diff --git a/man/ConfigEditEntry.Rd b/man/ConfigEditEntry.Rd index 9abf3e5..e597709 100644 --- a/man/ConfigEditEntry.Rd +++ b/man/ConfigEditEntry.Rd @@ -1,22 +1,46 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigEditEntry.R \name{ConfigEditEntry} -\alias{ConfigAddEntry} \alias{ConfigEditEntry} +\alias{ConfigAddEntry} \alias{ConfigRemoveEntry} \title{Add, Remove Or Edit Entries In The Configuration} \usage{ -ConfigEditEntry(configuration, dataset_type, position, dataset_name = NULL, - var_name = NULL, main_path = NULL, file_path = NULL, - nc_var_name = NULL, suffix = NULL, varmin = NULL, varmax = NULL) +ConfigEditEntry( + configuration, + dataset_type, + position, + dataset_name = NULL, + var_name = NULL, + main_path = NULL, + file_path = NULL, + nc_var_name = NULL, + suffix = NULL, + varmin = NULL, + varmax = NULL +) -ConfigAddEntry(configuration, dataset_type, position = "last", - dataset_name = ".*", var_name = ".*", main_path = "*", - file_path = "*", nc_var_name = "*", suffix = "*", varmin = "*", - varmax = "*") +ConfigAddEntry( + configuration, + dataset_type, + position = "last", + dataset_name = ".*", + var_name = ".*", + main_path = "*", + file_path = "*", + nc_var_name = "*", + suffix = "*", + varmin = "*", + varmax = "*" +) -ConfigRemoveEntry(configuration, dataset_type, dataset_name = NULL, - var_name = NULL, position = NULL) +ConfigRemoveEntry( + configuration, + dataset_type, + dataset_name = NULL, + var_name = NULL, + position = NULL +) } \arguments{ \item{configuration}{Configuration object obtained via ConfigFileOpen() @@ -99,4 +123,3 @@ ConfigFileSave(configuration, config_file, confirm = FALSE) ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigFileOpen.Rd b/man/ConfigFileOpen.Rd index eee183f..893900b 100644 --- a/man/ConfigFileOpen.Rd +++ b/man/ConfigFileOpen.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigFileOpen.R \name{ConfigFileOpen} -\alias{ConfigFileCreate} \alias{ConfigFileOpen} +\alias{ConfigFileCreate} \alias{ConfigFileSave} \title{Functions To Create Open And Save Configuration File} \usage{ @@ -194,4 +194,3 @@ ConfigFileSave(configuration, config_file, confirm = FALSE) ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigShowSimilarEntries.Rd b/man/ConfigShowSimilarEntries.Rd index b9f80ce..72b77e1 100644 --- a/man/ConfigShowSimilarEntries.Rd +++ b/man/ConfigShowSimilarEntries.Rd @@ -4,10 +4,18 @@ \alias{ConfigShowSimilarEntries} \title{Find Similar Entries In Tables Of Datasets} \usage{ -ConfigShowSimilarEntries(configuration, dataset_name = NULL, - var_name = NULL, main_path = NULL, file_path = NULL, - nc_var_name = NULL, suffix = NULL, varmin = NULL, varmax = NULL, - n_results = 10) +ConfigShowSimilarEntries( + configuration, + dataset_name = NULL, + var_name = NULL, + main_path = NULL, + file_path = NULL, + nc_var_name = NULL, + suffix = NULL, + varmin = NULL, + varmax = NULL, + n_results = 10 +) } \arguments{ \item{configuration}{Configuration object obtained either from @@ -79,4 +87,3 @@ ConfigShowSimilarEntries(configuration, dataset_name = "Exper", ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigShowTable.Rd b/man/ConfigShowTable.Rd index 7c08053..5e4172a 100644 --- a/man/ConfigShowTable.Rd +++ b/man/ConfigShowTable.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigShowTable.R \name{ConfigShowTable} -\alias{ConfigShowDefinitions} \alias{ConfigShowTable} +\alias{ConfigShowDefinitions} \title{Show Configuration Tables And Definitions} \usage{ ConfigShowTable(configuration, dataset_type, line_numbers = NULL) @@ -54,4 +54,3 @@ ConfigShowDefinitions(configuration) [ConfigEditEntry()], [ConfigFileOpen()], [ConfigShowSimilarEntries()], [ConfigShowTable()]. } - diff --git a/man/Corr.Rd b/man/Corr.Rd index bf5575e..9c20ec1 100644 --- a/man/Corr.Rd +++ b/man/Corr.Rd @@ -4,9 +4,19 @@ \alias{Corr} \title{Compute the correlation coefficient between an array of forecast and their corresponding observation} \usage{ -Corr(exp, obs, time_dim = "sdate", dat_dim = "dataset", comp_dim = NULL, - limits = NULL, method = "pearson", pval = TRUE, conf = TRUE, - conf.lev = 0.95, ncores = NULL) +Corr( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + comp_dim = NULL, + limits = NULL, + method = "pearson", + pval = TRUE, + conf = TRUE, + conf.lev = 0.95, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -86,4 +96,3 @@ corr <- Corr(clim$clim_exp, clim$clim_obs, time_dim = 'ftime', dat_dim = 'member # Renew the example when Ano and Smoothing is ready } - diff --git a/man/Eno.Rd b/man/Eno.Rd index 32468bd..03c3b4f 100644 --- a/man/Eno.Rd +++ b/man/Eno.Rd @@ -39,4 +39,3 @@ data[na] <- NA res <- Eno(data) } - diff --git a/man/GMST.Rd b/man/GMST.Rd index 208ff75..03d1092 100644 --- a/man/GMST.Rd +++ b/man/GMST.Rd @@ -4,10 +4,25 @@ \alias{GMST} \title{Compute the Global Mean Surface Temperature (GMST) anomalies} \usage{ -GMST(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_value, type, - mask = NULL, lat_dim = "lat", lon_dim = "lon", monini = 11, - fmonth_dim = "fmonth", sdate_dim = "sdate", indices_for_clim = NULL, - year_dim = "year", month_dim = "month", member_dim = "member") +GMST( + data_tas, + data_tos, + data_lats, + data_lons, + mask_sea_land, + sea_value, + type, + mask = NULL, + lat_dim = "lat", + lon_dim = "lon", + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data_tas}{A numerical array indicating the surface air temperature data @@ -134,4 +149,3 @@ index_dcpp <- GMST(data_tas = dcpp_tas, data_tos = dcpp_tos, data_lats = lat, sea_value = sea_value) } - diff --git a/man/GSAT.Rd b/man/GSAT.Rd index 9d3fbb6..370900d 100644 --- a/man/GSAT.Rd +++ b/man/GSAT.Rd @@ -4,10 +4,22 @@ \alias{GSAT} \title{Compute the Global Surface Air Temperature (GSAT) anomalies} \usage{ -GSAT(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +GSAT( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -101,4 +113,3 @@ lon <- seq(0, 360, 10) index_dcpp <- GSAT(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/InsertDim.Rd b/man/InsertDim.Rd index 8ab628d..c0dd7d8 100644 --- a/man/InsertDim.Rd +++ b/man/InsertDim.Rd @@ -32,4 +32,3 @@ res <- InsertDim(InsertDim(a, posdim = 2, lendim = 1, name = 'e'), 4, c(f = 2)) dim(res) } - diff --git a/man/LeapYear.Rd b/man/LeapYear.Rd index d261b0a..c2960f3 100644 --- a/man/LeapYear.Rd +++ b/man/LeapYear.Rd @@ -21,4 +21,3 @@ print(LeapYear(1991)) print(LeapYear(1992)) print(LeapYear(1993)) } - diff --git a/man/Load.Rd b/man/Load.Rd index 214f984..10c03f9 100644 --- a/man/Load.Rd +++ b/man/Load.Rd @@ -4,15 +4,36 @@ \alias{Load} \title{Loads Experimental And Observational Data} \usage{ -Load(var, exp = NULL, obs = NULL, sdates, nmember = NULL, - nmemberobs = NULL, nleadtime = NULL, leadtimemin = 1, - leadtimemax = NULL, storefreq = "monthly", sampleperiod = 1, - lonmin = 0, lonmax = 360, latmin = -90, latmax = 90, - output = "areave", method = "conservative", grid = NULL, - maskmod = vector("list", 15), maskobs = vector("list", 15), - configfile = NULL, varmin = NULL, varmax = NULL, silent = FALSE, - nprocs = NULL, dimnames = NULL, remapcells = 2, - path_glob_permissive = "partial") +Load( + var, + exp = NULL, + obs = NULL, + sdates, + nmember = NULL, + nmemberobs = NULL, + nleadtime = NULL, + leadtimemin = 1, + leadtimemax = NULL, + storefreq = "monthly", + sampleperiod = 1, + lonmin = 0, + lonmax = 360, + latmin = -90, + latmax = 90, + output = "areave", + method = "conservative", + grid = NULL, + maskmod = vector("list", 15), + maskobs = vector("list", 15), + configfile = NULL, + varmin = NULL, + varmax = NULL, + silent = FALSE, + nprocs = NULL, + dimnames = NULL, + remapcells = 2, + path_glob_permissive = "partial" +) } \arguments{ \item{var}{Short name of the variable to load. It should coincide with the @@ -874,4 +895,3 @@ sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), lonmin = -12, lonmax = 40) } } - diff --git a/man/MeanDims.Rd b/man/MeanDims.Rd index f200023..9c874fc 100644 --- a/man/MeanDims.Rd +++ b/man/MeanDims.Rd @@ -4,7 +4,7 @@ \alias{MeanDims} \title{Average an array along multiple dimensions} \usage{ -MeanDims(data, dims, na.rm = TRUE, ncores = NULL) +MeanDims(data, dims, na.rm = FALSE, ncores = NULL) } \arguments{ \item{data}{An array to be averaged.} @@ -39,4 +39,3 @@ History:\cr 3.0 - 2020-01 (A. Ho, \email{an.ho@bsc.es}) - Preserve dimension names } \keyword{datagen} - diff --git a/man/Persistence.Rd b/man/Persistence.Rd index 33d4868..3582633 100644 --- a/man/Persistence.Rd +++ b/man/Persistence.Rd @@ -4,9 +4,19 @@ \alias{Persistence} \title{Compute persistence} \usage{ -Persistence(data, dates, time_dim = "time", start, end, ft_start, - ft_end = ft_start, max_ft = 10, nmemb = 1, na.action = 10, - ncores = NULL) +Persistence( + data, + dates, + time_dim = "time", + start, + end, + ft_start, + ft_end = ft_start, + max_ft = 10, + nmemb = 1, + na.action = 10, + ncores = NULL +) } \arguments{ \item{data}{A numeric array corresponding to the observational data @@ -98,4 +108,3 @@ persist <- Persistence(obs1, dates = dates, start = 1961, end = 2005, ft_start = nmemb = 40) } - diff --git a/man/PlotAno.Rd b/man/PlotAno.Rd index 18bf0c9..6591ef1 100644 --- a/man/PlotAno.Rd +++ b/man/PlotAno.Rd @@ -4,12 +4,30 @@ \alias{PlotAno} \title{Plot Anomaly time series} \usage{ -PlotAno(exp_ano, obs_ano = NULL, sdates, toptitle = rep("", 15), - ytitle = rep("", 15), limits = NULL, legends = NULL, freq = 12, - biglab = FALSE, fill = TRUE, memb = TRUE, ensmean = TRUE, - linezero = FALSE, points = FALSE, vlines = NULL, sizetit = 1, - fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, - ...) +PlotAno( + exp_ano, + obs_ano = NULL, + sdates, + toptitle = rep("", 15), + ytitle = rep("", 15), + limits = NULL, + legends = NULL, + freq = 12, + biglab = FALSE, + fill = TRUE, + memb = TRUE, + ensmean = TRUE, + linezero = FALSE, + points = FALSE, + vlines = NULL, + sizetit = 1, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{exp_ano}{A numerical array containing the experimental data:\cr @@ -100,4 +118,3 @@ PlotAno(smooth_ano_exp, smooth_ano_obs, startDates, legends = 'ERSST', biglab = FALSE) } - diff --git a/man/PlotClim.Rd b/man/PlotClim.Rd index b62ff44..9b3381e 100644 --- a/man/PlotClim.Rd +++ b/man/PlotClim.Rd @@ -4,11 +4,26 @@ \alias{PlotClim} \title{Plots Climatologies} \usage{ -PlotClim(exp_clim, obs_clim = NULL, toptitle = "", ytitle = "", - monini = 1, freq = 12, limits = NULL, listexp = c("exp1", "exp2", - "exp3"), listobs = c("obs1", "obs2", "obs3"), biglab = FALSE, - leg = TRUE, sizetit = 1, fileout = NULL, width = 8, height = 5, - size_units = "in", res = 100, ...) +PlotClim( + exp_clim, + obs_clim = NULL, + toptitle = "", + ytitle = "", + monini = 1, + freq = 12, + limits = NULL, + listexp = c("exp1", "exp2", "exp3"), + listobs = c("obs1", "obs2", "obs3"), + biglab = FALSE, + leg = TRUE, + sizetit = 1, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{exp_clim}{Matrix containing the experimental data with dimensions:\cr @@ -79,4 +94,3 @@ PlotClim(clim$clim_exp, clim$clim_obs, toptitle = paste('climatologies'), listobs = c('ERSST'), biglab = FALSE, fileout = NULL) } - diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index cf45ead..fbd7042 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -4,25 +4,72 @@ \alias{PlotEquiMap} \title{Maps A Two-Dimensional Variable On A Cylindrical Equidistant Projection} \usage{ -PlotEquiMap(var, lon, lat, varu = NULL, varv = NULL, toptitle = NULL, - sizetit = NULL, units = NULL, brks = NULL, cols = NULL, - bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, - col_sup = NULL, colNA = NULL, color_fun = clim.palette(), - square = TRUE, filled.continents = NULL, coast_color = NULL, - coast_width = 1, contours = NULL, brks2 = NULL, contour_lwd = 0.5, - contour_color = "black", contour_lty = 1, contour_label_scale = 1, - dots = NULL, dot_symbol = 4, dot_size = 1, - arr_subsamp = floor(length(lon)/30), arr_scale = 1, arr_ref_len = 15, - arr_units = "m/s", arr_scale_shaft = 1, arr_scale_shaft_angle = 1, - axelab = TRUE, labW = FALSE, intylat = 20, intxlon = 20, - axes_tick_scale = 1, axes_label_scale = 1, drawleg = TRUE, - subsampleg = NULL, bar_extra_labels = NULL, draw_bar_ticks = TRUE, - draw_separators = FALSE, triangle_ends_scale = 1, bar_label_digits = 4, - bar_label_scale = 1, units_scale = 1, bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), boxlim = NULL, boxcol = "purple2", - boxlwd = 5, margin_scale = rep(1, 4), title_scale = 1, numbfig = NULL, - fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, - ...) +PlotEquiMap( + var, + lon, + lat, + varu = NULL, + varv = NULL, + toptitle = NULL, + sizetit = NULL, + units = NULL, + brks = NULL, + cols = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + colNA = NULL, + color_fun = clim.palette(), + square = TRUE, + filled.continents = NULL, + coast_color = NULL, + coast_width = 1, + contours = NULL, + brks2 = NULL, + contour_lwd = 0.5, + contour_color = "black", + contour_lty = 1, + contour_label_scale = 1, + dots = NULL, + dot_symbol = 4, + dot_size = 1, + arr_subsamp = floor(length(lon)/30), + arr_scale = 1, + arr_ref_len = 15, + arr_units = "m/s", + arr_scale_shaft = 1, + arr_scale_shaft_angle = 1, + axelab = TRUE, + labW = FALSE, + intylat = 20, + intxlon = 20, + axes_tick_scale = 1, + axes_label_scale = 1, + drawleg = TRUE, + subsampleg = NULL, + bar_extra_labels = NULL, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_label_digits = 4, + bar_label_scale = 1, + units_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + boxlim = NULL, + boxcol = "purple2", + boxlwd = 5, + margin_scale = rep(1, 4), + title_scale = 1, + numbfig = NULL, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Array with the values at each cell of a grid on a regular @@ -278,4 +325,3 @@ 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) } - diff --git a/man/PlotLayout.Rd b/man/PlotLayout.Rd index f01fdf9..453cf2e 100644 --- a/man/PlotLayout.Rd +++ b/man/PlotLayout.Rd @@ -4,20 +4,52 @@ \alias{PlotLayout} \title{Arrange and Fill Multi-Pannel Layouts With Optional Colour Bar} \usage{ -PlotLayout(fun, plot_dims, var, ..., special_args = NULL, nrow = NULL, - ncol = NULL, toptitle = NULL, row_titles = NULL, col_titles = NULL, - bar_scale = 1, title_scale = 1, title_margin_scale = 1, - title_left_shift_scale = 1, subtitle_scale = 1, - subtitle_margin_scale = 1, brks = NULL, cols = NULL, drawleg = "S", - titles = NULL, subsampleg = NULL, bar_limits = NULL, - triangle_ends = NULL, col_inf = NULL, col_sup = NULL, - color_fun = clim.colors, draw_bar_ticks = TRUE, draw_separators = FALSE, - triangle_ends_scale = 1, bar_extra_labels = NULL, units = NULL, - units_scale = 1, bar_label_scale = 1, bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), bar_left_shift_scale = 1, - bar_label_digits = 4, extra_margin = rep(0, 4), fileout = NULL, - width = NULL, height = NULL, size_units = "in", res = 100, - close_device = TRUE) +PlotLayout( + fun, + plot_dims, + var, + ..., + special_args = NULL, + nrow = NULL, + ncol = NULL, + toptitle = NULL, + row_titles = NULL, + col_titles = NULL, + bar_scale = 1, + title_scale = 1, + title_margin_scale = 1, + title_left_shift_scale = 1, + subtitle_scale = 1, + subtitle_margin_scale = 1, + brks = NULL, + cols = NULL, + drawleg = "S", + titles = NULL, + subsampleg = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + color_fun = clim.colors, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_extra_labels = NULL, + units = NULL, + units_scale = 1, + bar_label_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + bar_left_shift_scale = 1, + bar_label_digits = 4, + extra_margin = rep(0, 4), + fileout = NULL, + width = NULL, + height = NULL, + size_units = "in", + res = 100, + close_device = TRUE +) } \arguments{ \item{fun}{Plot function (or name of the function) to be called on the @@ -48,6 +80,12 @@ applied to each of them. NAs can be passed to the list: a NA will yield a blank cell in the layout, which can be populated after (see .SwitchToFigure).} +\item{\dots}{Parameters to be sent to the plotting function 'fun'. If +multiple arrays are provided in 'var' and multiple functions are provided +in 'fun', the parameters provided through \dots will be sent to all the +plot functions, as common parameters. To specify concrete arguments for +each of the plot functions see parameter 'special_args'.} + \item{special_args}{List of sub-lists, each sub-list having specific extra arguments for each of the plot functions provided in 'fun'. If you want to fix a different value for each plot in the layout you can do so by @@ -164,12 +202,6 @@ the layout and a 'fileout' has been specified. This is useful to avoid closing the device when saving the layout into a file and willing to add extra elements or figures. Takes TRUE by default. Disregarded if no 'fileout' has been specified.} - -\item{\dots}{Parameters to be sent to the plotting function 'fun'. If -multiple arrays are provided in 'var' and multiple functions are provided -in 'fun', the parameters provided through \dots will be sent to all the -plot functions, as common parameters. To specify concrete arguments for -each of the plot functions see parameter 'special_args'.} } \value{ \item{brks}{ @@ -244,4 +276,3 @@ PlotLayout(PlotEquiMap, c('lat', 'lon'), sampleData$mod[1, , 1, 1, , ], titles = paste('Member', 1:15)) } - diff --git a/man/PlotMatrix.Rd b/man/PlotMatrix.Rd index 24f046d..5275df0 100644 --- a/man/PlotMatrix.Rd +++ b/man/PlotMatrix.Rd @@ -4,12 +4,28 @@ \alias{PlotMatrix} \title{Function to convert any numerical table to a grid of coloured squares.} \usage{ -PlotMatrix(var, brks = NULL, cols = NULL, toptitle = NULL, - title.color = "royalblue4", xtitle = NULL, ytitle = NULL, - xlabels = NULL, xvert = FALSE, ylabels = NULL, line = 3, - figure.width = 1, legend = TRUE, legend.width = 0.15, - xlab_dist = NULL, ylab_dist = NULL, fileout = NULL, size_units = "px", - res = 100, ...) +PlotMatrix( + var, + brks = NULL, + cols = NULL, + toptitle = NULL, + title.color = "royalblue4", + xtitle = NULL, + ytitle = NULL, + xlabels = NULL, + xvert = FALSE, + ylabels = NULL, + line = 3, + figure.width = 1, + legend = TRUE, + legend.width = 0.15, + xlab_dist = NULL, + ylab_dist = NULL, + fileout = NULL, + size_units = "px", + res = 100, + ... +) } \arguments{ \item{var}{A numerical matrix containing the values to be displayed in a @@ -93,4 +109,3 @@ PlotMatrix(var = matrix(rnorm(n = 120, mean = 0.3), 10, 12), xlabels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")) } - diff --git a/man/PlotSection.Rd b/man/PlotSection.Rd index 413ef63..1627339 100644 --- a/man/PlotSection.Rd +++ b/man/PlotSection.Rd @@ -4,10 +4,26 @@ \alias{PlotSection} \title{Plots A Vertical Section} \usage{ -PlotSection(var, horiz, depth, toptitle = "", sizetit = 1, units = "", - brks = NULL, cols = NULL, axelab = TRUE, intydep = 200, - intxhoriz = 20, drawleg = TRUE, fileout = NULL, width = 8, - height = 5, size_units = "in", res = 100, ...) +PlotSection( + var, + horiz, + depth, + toptitle = "", + sizetit = 1, + units = "", + brks = NULL, + cols = NULL, + axelab = TRUE, + intydep = 200, + intxhoriz = 20, + drawleg = TRUE, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Matrix to plot with (longitude/latitude, depth) dimensions.} @@ -69,4 +85,3 @@ sampleData <- s2dv::sampleDepthData PlotSection(sampleData$mod[1, 1, 1, 1, , ], sampleData$lat, sampleData$depth, toptitle = 'temperature 1995-11 member 0') } - diff --git a/man/PlotStereoMap.Rd b/man/PlotStereoMap.Rd index 4b910a9..95c2f71 100644 --- a/man/PlotStereoMap.Rd +++ b/man/PlotStereoMap.Rd @@ -4,19 +4,53 @@ \alias{PlotStereoMap} \title{Maps A Two-Dimensional Variable On A Polar Stereographic Projection} \usage{ -PlotStereoMap(var, lon, lat, latlims = c(60, 90), toptitle = NULL, - sizetit = NULL, units = NULL, brks = NULL, cols = NULL, - bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, - col_sup = NULL, colNA = NULL, color_fun = clim.palette(), - filled.continents = FALSE, coast_color = NULL, coast_width = 1, - dots = NULL, dot_symbol = 4, dot_size = 0.8, intlat = 10, - drawleg = TRUE, subsampleg = NULL, bar_extra_labels = NULL, - draw_bar_ticks = TRUE, draw_separators = FALSE, triangle_ends_scale = 1, - bar_label_digits = 4, bar_label_scale = 1, units_scale = 1, - bar_tick_scale = 1, bar_extra_margin = rep(0, 4), boxlim = NULL, - boxcol = "purple2", boxlwd = 5, margin_scale = rep(1, 4), - title_scale = 1, numbfig = NULL, fileout = NULL, width = 6, - height = 5, size_units = "in", res = 100, ...) +PlotStereoMap( + var, + lon, + lat, + latlims = c(60, 90), + toptitle = NULL, + sizetit = NULL, + units = NULL, + brks = NULL, + cols = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + colNA = NULL, + color_fun = clim.palette(), + filled.continents = FALSE, + coast_color = NULL, + coast_width = 1, + dots = NULL, + dot_symbol = 4, + dot_size = 0.8, + intlat = 10, + drawleg = TRUE, + subsampleg = NULL, + bar_extra_labels = NULL, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_label_digits = 4, + bar_label_scale = 1, + units_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + boxlim = NULL, + boxcol = "purple2", + boxlwd = 5, + margin_scale = rep(1, 4), + title_scale = 1, + numbfig = NULL, + fileout = NULL, + width = 6, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Array with the values at each cell of a grid on a regular @@ -183,4 +217,3 @@ y <- seq(from = -90, to = 90, length.out = 50) PlotStereoMap(data, x, y, latlims = c(60, 90), brks = 50, toptitle = "This is the title") } - diff --git a/man/RMS.Rd b/man/RMS.Rd index 7bd33b3..4391df4 100644 --- a/man/RMS.Rd +++ b/man/RMS.Rd @@ -4,8 +4,17 @@ \alias{RMS} \title{Compute root mean square error} \usage{ -RMS(exp, obs, time_dim = "sdate", dat_dim = "dataset", comp_dim = NULL, - limits = NULL, conf = TRUE, conf.lev = 0.95, ncores = NULL) +RMS( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + comp_dim = NULL, + limits = NULL, + conf = TRUE, + conf.lev = 0.95, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -79,4 +88,3 @@ The confidence interval is computed by the chi2 distribution.\cr # Renew example when Ano and Smoothing are ready } - diff --git a/man/RMSSS.Rd b/man/RMSSS.Rd index 1b8274f..9ebcf65 100644 --- a/man/RMSSS.Rd +++ b/man/RMSSS.Rd @@ -4,8 +4,14 @@ \alias{RMSSS} \title{Compute root mean square error skill score} \usage{ -RMSSS(exp, obs, time_dim = "sdate", dat_dim = "dataset", pval = TRUE, - ncores = NULL) +RMSSS( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + pval = TRUE, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data which contains at least @@ -66,4 +72,3 @@ obs <- array(rnorm(15), dim = c(time = 3, memb = 5, dataset = 1)) res <- RMSSS(exp, obs, time_dim = 'time') } - diff --git a/man/RandomWalkTest.Rd b/man/RandomWalkTest.Rd index 33b226f..1110648 100644 --- a/man/RandomWalkTest.Rd +++ b/man/RandomWalkTest.Rd @@ -49,4 +49,3 @@ skill_B <- abs(fcst_B - reference) RandomWalkTest(skill_A = skill_A, skill_B = skill_B, time_dim = 'sdate', ncores = 1) } - diff --git a/man/Regression.Rd b/man/Regression.Rd index 4faafc1..8e27295 100644 --- a/man/Regression.Rd +++ b/man/Regression.Rd @@ -4,8 +4,17 @@ \alias{Regression} \title{Compute the regression of an array on another along one dimension.} \usage{ -Regression(datay, datax, reg_dim = "sdate", formula = y ~ x, pval = TRUE, - conf = TRUE, conf.lev = 0.95, na.action = na.omit, ncores = NULL) +Regression( + datay, + datax, + reg_dim = "sdate", + formula = y ~ x, + pval = TRUE, + conf = TRUE, + conf.lev = 0.95, + na.action = na.omit, + ncores = NULL +) } \arguments{ \item{datay}{An numeric array as predictand including the dimension along @@ -92,4 +101,3 @@ res1 <- Regression(datay, datax, formula = y~poly(x, 2, raw = TRUE)) res2 <- Regression(datay, datax, conf.lev = 0.9) } - diff --git a/man/Reorder.Rd b/man/Reorder.Rd index 0afa07e..8748aaf 100644 --- a/man/Reorder.Rd +++ b/man/Reorder.Rd @@ -26,4 +26,3 @@ Reorder the dimension order of a multi-dimensional array dat2 <- array(c(1:10), dim = c(2, 1, 5)) print(dim(Reorder(dat2, c(2, 1, 3)))) } - diff --git a/man/SPOD.Rd b/man/SPOD.Rd index cbbbf1a..5a20a3f 100644 --- a/man/SPOD.Rd +++ b/man/SPOD.Rd @@ -4,10 +4,22 @@ \alias{SPOD} \title{Compute the South Pacific Ocean Dipole (SPOD) index} \usage{ -SPOD(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +SPOD( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -104,4 +116,3 @@ lon <- seq(0, 360, 10) index_dcpp <- SPOD(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/Season.Rd b/man/Season.Rd index cb10dee..3c1e3ff 100644 --- a/man/Season.Rd +++ b/man/Season.Rd @@ -4,8 +4,16 @@ \alias{Season} \title{Compute seasonal mean} \usage{ -Season(data, time_dim = "ftime", monini, moninf, monsup, method = mean, - na.rm = TRUE, ncores = NULL) +Season( + data, + time_dim = "ftime", + monini, + moninf, + monsup, + method = mean, + na.rm = TRUE, + ncores = NULL +) } \arguments{ \item{data}{A named numeric array with at least one dimension 'time_dim'.} @@ -53,4 +61,3 @@ dat2[na] <- NA res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2) res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2, na.rm = FALSE) } - diff --git a/man/Smoothing.Rd b/man/Smoothing.Rd index ba62ca1..8d4a558 100644 --- a/man/Smoothing.Rd +++ b/man/Smoothing.Rd @@ -43,4 +43,3 @@ PlotAno(smooth_ano_exp, smooth_ano_obs, startDates, fileout = "tos_smoothed_ano.png") } } - diff --git a/man/TPI.Rd b/man/TPI.Rd index 6968f22..fdbc2b8 100644 --- a/man/TPI.Rd +++ b/man/TPI.Rd @@ -4,10 +4,22 @@ \alias{TPI} \title{Compute the Tripole Index (TPI) for the Interdecadal Pacific Oscillation (IPO)} \usage{ -TPI(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +TPI( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -103,4 +115,3 @@ lon = seq(0, 360, 10) index_dcpp = TPI(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/ToyModel.Rd b/man/ToyModel.Rd index 379ed3b..ee7a98e 100644 --- a/man/ToyModel.Rd +++ b/man/ToyModel.Rd @@ -7,8 +7,18 @@ components of a forecast: (1) predictabiltiy (2) forecast error (3) non-stationarity and (4) ensemble generation. The forecast can be computed for real observations or observations generated artifically.} \usage{ -ToyModel(alpha = 0.1, beta = 0.4, gamma = 1, sig = 1, trend = 0, - nstartd = 30, nleadt = 4, nmemb = 10, obsini = NULL, fxerr = NULL) +ToyModel( + alpha = 0.1, + beta = 0.4, + gamma = 1, + sig = 1, + trend = 0, + nstartd = 30, + nleadt = 4, + nmemb = 10, + obsini = NULL, + fxerr = NULL +) } \arguments{ \item{alpha}{Predicabiltiy of the forecast on the observed residuals @@ -120,4 +130,3 @@ toyforecast <- ToyModel(alpha = a, beta = b, gamma = g, nmemb = nm, # } } - diff --git a/man/Trend.Rd b/man/Trend.Rd index a641041..d283ee6 100644 --- a/man/Trend.Rd +++ b/man/Trend.Rd @@ -4,8 +4,16 @@ \alias{Trend} \title{Compute the trend} \usage{ -Trend(data, time_dim = "ftime", interval = 1, polydeg = 1, conf = TRUE, - conf.lev = 0.95, pval = TRUE, ncores = NULL) +Trend( + data, + time_dim = "ftime", + interval = 1, + polydeg = 1, + conf = TRUE, + conf.lev = 0.95, + pval = TRUE, + ncores = NULL +) } \arguments{ \item{data}{An numeric array including the dimension along which the trend @@ -80,4 +88,3 @@ months_between_startdates <- 60 trend <- Trend(sampleData$obs, polydeg = 2, interval = months_between_startdates) } - diff --git a/man/clim.palette.Rd b/man/clim.palette.Rd index d912f47..5d17947 100644 --- a/man/clim.palette.Rd +++ b/man/clim.palette.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/clim.palette.R \name{clim.palette} -\alias{clim.colors} \alias{clim.palette} +\alias{clim.colors} \title{Generate Climate Color Palettes} \usage{ clim.palette(palette = "bluered") @@ -30,4 +30,3 @@ cols <- clim.colors(20) ColorBar(lims, cols) } - diff --git a/man/s2dv-package.Rd b/man/s2dv-package.Rd index cb52214..043b081 100644 --- a/man/s2dv-package.Rd +++ b/man/s2dv-package.Rd @@ -4,20 +4,45 @@ \name{s2dv-package} \alias{s2dv} \alias{s2dv-package} -\title{A Set of Common Tools for Seasonal to Decadal Verification} +\title{s2dv: A Set of Common Tools for Seasonal to Decadal Verification} \description{ -The advanced version of package 's2dverification'. It is -intended for 'seasonal to decadal' (s2d) climate forecast verification, but -it can also be used in other kinds of forecasts or general climate analysis. -This package is specially designed for the comparison between the experimental -and observational datasets. The functionality of the included functions covers -from data retrieval, data post-processing, skill scores against observation, -to visualization. Compared to 's2dverification', 's2dv' is more compatible -with the package 'startR', able to use multiple cores for computation and -handle multi-dimensional arrays with a higher flexibility. +The advanced version of package 's2dverification'. It is + intended for 'seasonal to decadal' (s2d) climate forecast verification, but + it can also be used in other kinds of forecasts or general climate analysis. + This package is specially designed for the comparison between the experimental + and observational datasets. The functionality of the included functions covers + from data retrieval, data post-processing, skill scores against observation, + to visualization. Compared to 's2dverification', 's2dv' is more compatible + with the package 'startR', able to use multiple cores for computation and + handle multi-dimensional arrays with a higher flexibility. } \references{ \url{https://earth.bsc.es/gitlab/es/s2dv/} } -\keyword{internal} +\seealso{ +Useful links: +\itemize{ + \item \url{https://earth.bsc.es/gitlab/es/s2dv/} + \item Report bugs at \url{https://earth.bsc.es/gitlab/es/s2dv/-/issues} +} + +} +\author{ +\strong{Maintainer}: An-Chi Ho \email{an.ho@bsc.es} + +Authors: +\itemize{ + \item BSC-CNS [copyright holder] + \item Nuria Perez-Zanon \email{nuria.perez@bsc.es} +} + +Other contributors: +\itemize{ + \item Roberto Bilbao \email{roberto.bilbao@bsc.es} [contributor] + \item Carlos Delgado \email{carlos.delgado@bsc.es} [contributor] + \item Andrea Manrique \email{andrea.manrique@bsc.es} [contributor] + \item Deborah Verfaillie \email{deborah.verfaillie@bsc.es} [contributor] +} +} +\keyword{internal} diff --git a/man/sampleDepthData.Rd b/man/sampleDepthData.Rd index 869af86..77e4a7a 100644 --- a/man/sampleDepthData.Rd +++ b/man/sampleDepthData.Rd @@ -28,4 +28,3 @@ variable 'tos', i.e. sea surface temperature, from the decadal climate prediction experiment run at IC3 in the context of the CMIP5 project.\cr Its name within IC3 local database is 'i00k'. } - diff --git a/man/sampleMap.Rd b/man/sampleMap.Rd index 651d185..eaf8aa5 100644 --- a/man/sampleMap.Rd +++ b/man/sampleMap.Rd @@ -43,4 +43,3 @@ sampleData <- Load('tos', list(exp), list(obs), startDates, } Check the documentation on 'Load()' in the package 's2dv' for more information. } - diff --git a/man/sampleTimeSeries.Rd b/man/sampleTimeSeries.Rd index 280277e..05a8e79 100644 --- a/man/sampleTimeSeries.Rd +++ b/man/sampleTimeSeries.Rd @@ -47,4 +47,3 @@ sampleData <- Load('tos', list(exp), list(obs), startDates, } Check the documentation on 'Load()' in the package 's2dv' for more information. } - -- GitLab From 548f3c51cba9e7af22572583de92844ee397c91b Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 16 Feb 2021 19:43:22 +0100 Subject: [PATCH 030/154] Add 'ncores' to s2dv functions that are used internally --- R/AMV.R | 15 ++++++++++++--- R/Ano.R | 2 +- R/Clim.R | 22 +++++++++++----------- R/Composite.R | 14 +++++++------- R/Corr.R | 14 +++++++------- R/Eno.R | 2 +- R/GMST.R | 14 ++++++++++++-- R/GSAT.R | 13 +++++++++++-- R/InsertDim.R | 7 +++---- R/MeanDims.R | 8 +++++++- R/RMS.R | 11 ++++++----- R/RMSSS.R | 11 ++++++----- R/RandomWalkTest.R | 2 +- R/Regression.R | 2 +- R/SPOD.R | 13 +++++++++++-- R/Season.R | 4 ++-- R/Smoothing.R | 2 +- R/TPI.R | 13 +++++++++++-- R/Trend.R | 2 +- man/AMV.Rd | 6 +++++- man/GMST.Rd | 3 +++ man/GSAT.Rd | 6 +++++- man/SPOD.Rd | 6 +++++- man/TPI.Rd | 6 +++++- 24 files changed, 135 insertions(+), 63 deletions(-) diff --git a/R/AMV.R b/R/AMV.R index 9854449..1895fa6 100644 --- a/R/AMV.R +++ b/R/AMV.R @@ -55,6 +55,8 @@ #'@param member_dim A character string indicating the name of the member #' dimension. The default value is 'member'. Only used if parameter 'type' is #' 'dcpp' or 'hist'. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. #' #'@return A numerical array of the AMV index with the dimensions of: #' 1) sdate, forecast year, and member (in case of decadal predictions); @@ -86,7 +88,7 @@ AMV <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lon', mask = NULL, monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, year_dim = 'year', month_dim = 'month', - member_dim = 'member') { + member_dim = 'member', ncores = NULL) { ## Input Checks # data @@ -130,6 +132,13 @@ AMV <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo stop(paste0("The longitude dimension of parameter 'data' must be the same", " length of parameter 'data_lons'.")) } + # 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.") + } + } # mask if (!is.null(mask)) { if (is.array(mask) & identical(names(dim(mask)), c(lat_dim,lon_dim)) & @@ -141,7 +150,7 @@ AMV <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo return(data) } data <- multiApply::Apply(data = data, target_dims = c(lat_dim, lon_dim), - fun = fun_mask, mask = mask)$output1 + fun = fun_mask, mask = mask, ncores = ncores)$output1 } else { stop(paste0("Parameter 'mask' must be NULL (no mask) or a numerical array ", "with c(lat_dim, lon_dim) dimensions and 0 in those grid ", @@ -209,7 +218,7 @@ AMV <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo stop("Parameter 'member_dim' is not found in 'data' dimension.") } } - + ## Regions for AMV (Doblas-Reyes et al., 2013) lat_min_1 <- 0; lat_max_1 <- 60 lon_min_1 <- 280; lon_max_1 <- 359.9 diff --git a/R/Ano.R b/R/Ano.R index 75a3edf..13ee211 100644 --- a/R/Ano.R +++ b/R/Ano.R @@ -74,7 +74,7 @@ } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } diff --git a/R/Clim.R b/R/Clim.R index fead92b..caf96ca 100644 --- a/R/Clim.R +++ b/R/Clim.R @@ -136,7 +136,7 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } @@ -191,7 +191,7 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), fun = .Clim, method = method, time_dim = time_dim, dat_dim = dat_dim, memb_dim = memb_dim, - memb = memb, na.rm = na.rm, + memb = memb, na.rm = na.rm, ncores_input = ncores, ncores = ncores) # Add member dimension name back if (memb) { @@ -207,7 +207,7 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), fun = .Clim, method = method, time_dim = time_dim, dat_dim = dat_dim, ftime_dim = ftime_dim, memb_dim = memb_dim, - memb = memb, na.rm = na.rm, + memb = memb, na.rm = na.rm, ncores_input = ncores, ncores = ncores) } else if (method == 'NDV') { @@ -216,7 +216,7 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), fun = .Clim, method = method, time_dim = time_dim, dat_dim = dat_dim, ftime_dim = ftime_dim, memb_dim = memb_dim, - memb = memb, na.rm = na.rm, + memb = memb, na.rm = na.rm, ncores_input = ncores, ncores = ncores) } @@ -227,7 +227,7 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), .Clim <- function(exp, obs, method = 'clim', time_dim = 'sdate', dat_dim = c('dataset', 'member'), ftime_dim = 'ftime', memb_dim = 'member', memb = TRUE, - na.rm = TRUE, ncores = NULL) { + na.rm = TRUE, ncores_input = NULL) { if (method == 'clim') { # exp: [sdate, dat_dim_exp] @@ -269,9 +269,9 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), # exp clim ##--- NEW trend ---## tmp_obs <- Trend(data = obs, time_dim = time_dim, interval = 1, - polydeg = 1, conf = FALSE, ncores = ncores)$trend + polydeg = 1, conf = FALSE, ncores = ncores_input)$trend tmp_exp <- Trend(data = exp, time_dim = time_dim, interval = 1, - polydeg = 1, conf = FALSE, ncores = ncores)$trend + polydeg = 1, conf = FALSE, ncores = ncores_input)$trend # tmp_exp: [stats, dat_dim)] tmp_obs_mean <- apply(tmp_obs, 1, mean) #average out dat_dim (dat and member) @@ -331,16 +331,16 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), # Create initial data set (i.e., only first ftime) tmp <- Subset(exp, ftime_dim, 1, drop = 'selected') - ini_exp <- InsertDim(tmp, pos_ftime, dim_ftime, ncores = ncores) #only first ftime + ini_exp <- InsertDim(tmp, pos_ftime, dim_ftime, ncores = ncores_input) #only first ftime tmp <- Subset(obs, ftime_dim, 1, drop = 'selected') - ini_obs <- InsertDim(tmp, pos_ftime, dim_ftime, ncores = ncores) #only first ftime + ini_obs <- InsertDim(tmp, pos_ftime, dim_ftime, ncores = ncores_input) #only first ftime #ini_: [sdate, dat_dim, ftime] tmp_exp <- Regression(datay = exp, datax = ini_exp, reg_dim = time_dim, na.action = na.omit, - pval = FALSE, conf = FALSE, ncores = ncores)$regression + pval = FALSE, conf = FALSE, ncores = ncores_input)$regression tmp_obs <- Regression(datay = obs, datax = ini_obs, reg_dim = time_dim, na.action = na.omit, - pval = FALSE, conf = FALSE, ncores = ncores)$regression + pval = FALSE, conf = FALSE, ncores = ncores_input)$regression #tmp_: [stats = 2, dat_dim, ftime] tmp_obs_mean <- apply(tmp_obs, c(1, length(dim(tmp_obs))), mean) #average out dat_dim (dat and member) #tmp_obs_mean: [stats = 2, ftime] diff --git a/R/Composite.R b/R/Composite.R index ebab247..01b7acf 100644 --- a/R/Composite.R +++ b/R/Composite.R @@ -157,7 +157,7 @@ Composite <- function(data, occ, time_dim = 'time', space_dim = c('lon', 'lat'), } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } @@ -181,7 +181,7 @@ Composite <- function(data, occ, time_dim = 'time', space_dim = c('lon', 'lat'), fun = .Composite, output_dims = output_dims, occ = occ, time_dim = time_dim, space_dim = space_dim, - K = K, lag = lag, eno = eno, + K = K, lag = lag, eno = eno, ncores_input = ncores, ncores = ncores) if (!is.null(fileout)) { @@ -192,7 +192,7 @@ Composite <- function(data, occ, time_dim = 'time', space_dim = c('lon', 'lat'), } .Composite <- function(data, occ, time_dim = 'time', space_dim = c('lon', 'lat'), - K = NULL, lag = 0, eno = FALSE) { + K = NULL, lag = 0, eno = FALSE, ncores_input = NULL) { # data: [lon, lat, time] # occ: [time] if (is.null(K)) { @@ -204,12 +204,12 @@ Composite <- function(data, occ, time_dim = 'time', space_dim = c('lon', 'lat'), pval <- array(dim = c(dim(data)[1:2], composite = K)) if (eno == TRUE) { - n_tot <- Eno(data, time_dim = time_dim) + n_tot <- Eno(data, time_dim = time_dim, ncores = ncores_input) } else { n_tot <- length(occ) } - mean_tot <- MeanDims(data, dims = 3, na.rm = TRUE) + mean_tot <- MeanDims(data, dims = 3, na.rm = TRUE, ncores = ncores_input) stdv_tot <- apply(data, c(1, 2), sd, na.rm = TRUE) for (k in 1:K) { @@ -224,14 +224,14 @@ Composite <- function(data, occ, time_dim = 'time', space_dim = c('lon', 'lat'), if (eno == TRUE) { data_tmp <- data[, , indices] names(dim(data_tmp)) <- names(dim(data)) - n_k <- Eno(data_tmp, time_dim = time_dim) + n_k <- Eno(data_tmp, time_dim = time_dim, ncores = ncores_input) } else { n_k <- length(indices) } if (length(indices) == 1) { composite[, , k] <- data[, , indices] } else { - composite[, , k] <- MeanDims(data[, , indices], dims = 3, na.rm = TRUE) + composite[, , k] <- MeanDims(data[, , indices], dims = 3, na.rm = TRUE, ncores = ncores_input) } stdv_k <- apply(data[, , indices], c(1, 2), sd, na.rm = TRUE) diff --git a/R/Corr.R b/R/Corr.R index a74725f..5a68cfb 100644 --- a/R/Corr.R +++ b/R/Corr.R @@ -147,7 +147,7 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } @@ -184,8 +184,8 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', } 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]) + outrows <- is.na(MeanDims(obs_sub, pos, na.rm = FALSE, ncores = ncores)) + outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim], ncores = ncores) obs[which(outrows)] <- NA } @@ -194,13 +194,13 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', c(time_dim, dat_dim)), fun = .Corr, time_dim = time_dim, method = method, - pval = pval, conf = conf, conf.lev = conf.lev, + pval = pval, conf = conf, conf.lev = conf.lev, ncores_input = ncores, ncores = ncores) return(res) } .Corr <- function(exp, obs, time_dim = 'sdate', method = 'pearson', - conf = TRUE, pval = TRUE, conf.lev = 0.95) { + conf = TRUE, pval = TRUE, conf.lev = 0.95, ncores_input = NULL) { # exp: [sdate, dat_exp] # obs: [sdate, dat_obs] @@ -242,9 +242,9 @@ cor(exp[, x], obs[, i], if (method == "kendall" | method == "spearman") { tmp <- apply(obs, 2, rank) names(dim(tmp))[1] <- time_dim - eno <- Eno(tmp, time_dim) + eno <- Eno(tmp, time_dim, ncores = ncores_input) } else if (method == "pearson") { - eno <- Eno(obs, time_dim) + eno <- Eno(obs, time_dim, ncores = ncores_input) } for (i in 1:nexp) { eno_expand[i, ] <- eno diff --git a/R/Eno.R b/R/Eno.R index 9375b78..8c8d16b 100644 --- a/R/Eno.R +++ b/R/Eno.R @@ -65,7 +65,7 @@ Eno <- function(data, time_dim = 'sdate', na.action = na.pass, ncores = NULL) { } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } diff --git a/R/GMST.R b/R/GMST.R index c922eae..ec3c920 100644 --- a/R/GMST.R +++ b/R/GMST.R @@ -65,6 +65,8 @@ #'@param member_dim A character string indicating the name of the member #' dimension. The default value is 'member'. Only used if parameter 'type' is #' 'dcpp' or 'hist'. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. #' #'@return A numerical array of the GMST anomalies with the dimensions of: #' 1) sdate, forecast year, and member (in case of decadal predictions); @@ -243,6 +245,14 @@ GMST <- function(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_va stop("Parameter 'member_dim' is not found in 'data_tas' or 'data_tos' dimension.") } } + # 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.") + } + } + ## combination of tas and tos (data) mask_tas_tos <- function(data_tas, data_tos, mask_sea_land, sea_value) { @@ -254,7 +264,7 @@ GMST <- function(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_va data <- multiApply::Apply(data = list(data_tas, data_tos), target_dims = c(lat_dim, lon_dim), fun = mask_tas_tos, mask_sea_land = mask_sea_land, - sea_value = sea_value)$output1 + sea_value = sea_value, ncores = ncores)$output1 data <- drop(data) rm(data_tas, data_tos) @@ -266,7 +276,7 @@ GMST <- function(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_va return(data) } data <- multiApply::Apply(data = data, target_dims = c(lat_dim, lon_dim), - fun = fun_mask, mask = mask)$output1 + fun = fun_mask, mask = mask, ncores = ncores)$output1 } data <- ClimProjDiags::WeightedMean(data = data, lon = data_lons, lat = data_lats, diff --git a/R/GSAT.R b/R/GSAT.R index d764843..0c50a34 100644 --- a/R/GSAT.R +++ b/R/GSAT.R @@ -50,6 +50,8 @@ #'@param member_dim A character string indicating the name of the member #' dimension. The default value is 'member'. Only used if parameter 'type' is #' 'dcpp' or 'hist'. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. #' #'@return A numerical array of the GSAT anomalies with the dimensions of: #' 1) sdate, forecast year, and member (in case of decadal predictions); @@ -81,7 +83,7 @@ GSAT <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lon', mask = NULL, monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, year_dim = 'year', month_dim = 'month', - member_dim = 'member') { + member_dim = 'member', ncores = NULL) { ## Input Checks # data @@ -125,6 +127,13 @@ GSAT <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'l stop(paste0("The longitude dimension of parameter 'data' must be the same", " length of parameter 'data_lons'.")) } + # 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.") + } + } # mask if (!is.null(mask)) { if (is.array(mask) & identical(names(dim(mask)), c(lat_dim,lon_dim)) & @@ -136,7 +145,7 @@ GSAT <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'l return(data) } data <- multiApply::Apply(data = data, target_dims = c(lat_dim, lon_dim), - fun = fun_mask, mask = mask)$output1 + fun = fun_mask, mask = mask, ncores = ncores)$output1 } else { stop(paste0("Parameter 'mask' must be NULL (no mask) or a numerical array ", "with c(lat_dim, lon_dim) dimensions and 0 in those grid ", diff --git a/R/InsertDim.R b/R/InsertDim.R index 195b806..e2daccb 100644 --- a/R/InsertDim.R +++ b/R/InsertDim.R @@ -61,11 +61,10 @@ InsertDim <- function(data, posdim, lendim, name = NULL, ncores = NULL) { stop("Parameter 'name' must be a character string.") } } - ## ncores + # ncores if (!is.null(ncores)) { - if (!is.numeric(ncores)) { - stop("Parameter 'ncores' must be a positive integer.") - } else if (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.") } } diff --git a/R/MeanDims.R b/R/MeanDims.R index 3ee8ba8..cf4f929 100644 --- a/R/MeanDims.R +++ b/R/MeanDims.R @@ -61,7 +61,13 @@ MeanDims <- function(data, dims, na.rm = FALSE, ncores = NULL) { if (!is.logical(na.rm) | length(na.rm) > 1) { stop("Parameter 'na.rm' must be one logical value.") } - + ## 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.") + } + } ############################### diff --git a/R/RMS.R b/R/RMS.R index c2cb8bc..86d4461 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -143,7 +143,7 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } @@ -181,7 +181,7 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', 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]) + outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim], ncores = ncores) obs[which(outrows)] <- NA } @@ -190,12 +190,13 @@ 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 = ncores) + conf = conf, conf.lev = conf.lev, ncores_input = ncores, + ncores = ncores) return(res) } .RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', - conf = TRUE, conf.lev = 0.95) { + conf = TRUE, conf.lev = 0.95, ncores_input = NULL) { # exp: [sdate, dat_exp] # obs: [sdate, dat_obs] @@ -220,7 +221,7 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', if (conf) { #eno <- Eno(dif, 1) #count effective sample along sdate. dim = c(nexp, nobs) - eno <- Eno(dif, time_dim) #change to this line when Eno() is done + eno <- Eno(dif, time_dim, ncores = ncores_input) #change to this line when Eno() is done # conf.lower chi <- sapply(1:nobs, function(i) { diff --git a/R/RMSSS.R b/R/RMSSS.R index a006066..5fa9659 100644 --- a/R/RMSSS.R +++ b/R/RMSSS.R @@ -108,7 +108,7 @@ RMSSS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } @@ -143,13 +143,14 @@ RMSSS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', c(time_dim, dat_dim)), fun = .RMSSS, time_dim = time_dim, dat_dim = dat_dim, - pval = pval, #conf = conf, conf.lev = conf.lev, + pval = pval, ncores_input = ncores, ncores = ncores) return(res) } -.RMSSS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', pval = TRUE) { +.RMSSS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', pval = TRUE, + ncores_input = NULL) { # exp: [sdate, dat_exp] # obs: [sdate, dat_obs] nexp <- as.numeric(dim(exp)[2]) @@ -189,8 +190,8 @@ RMSSS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', ## pval and conf if (pval) { - eno1 <- Eno(dif1, time_dim) - eno2 <- Eno(obs, time_dim) + eno1 <- Eno(dif1, time_dim, ncores = ncores_input) + eno2 <- Eno(obs, time_dim, ncores = ncores_input) eno2 <- array(eno2, dim = c(nobs = nobs, nexp = nexp)) eno2 <- Reorder(eno2, c(2, 1)) } diff --git a/R/RandomWalkTest.R b/R/RandomWalkTest.R index e818f57..494be65 100644 --- a/R/RandomWalkTest.R +++ b/R/RandomWalkTest.R @@ -57,7 +57,7 @@ RandomWalkTest <- function(skill_A, skill_B, time_dim = 'sdate', ncores = NULL){ stop("Parameter 'time_dim' is not found in 'skill_A' or 'skill_B' dimensions.") } 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.") } } diff --git a/R/Regression.R b/R/Regression.R index 8e5d8af..244ddc7 100644 --- a/R/Regression.R +++ b/R/Regression.R @@ -153,7 +153,7 @@ Regression <- function(datay, datax, reg_dim = 'sdate', formula = y ~ x, } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } diff --git a/R/SPOD.R b/R/SPOD.R index 30527f1..5e8812d 100644 --- a/R/SPOD.R +++ b/R/SPOD.R @@ -53,6 +53,8 @@ #'@param member_dim A character string indicating the name of the member #' dimension. The default value is 'member'. Only used if parameter 'type' is #' 'dcpp' or 'hist'. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. #' #'@return A numerical array of the SPOD index with the dimensions of: #' 1) sdate, forecast year, and member (in case of decadal predictions); @@ -84,7 +86,7 @@ SPOD <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lon', mask = NULL, monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, year_dim = 'year', month_dim = 'month', - member_dim = 'member') { + member_dim = 'member', ncores = NULL) { ## Input Checks # data @@ -128,6 +130,13 @@ SPOD <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'l stop(paste0("The longitude dimension of parameter 'data' must be the same", " length of parameter 'data_lons'.")) } + # 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.") + } + } # mask if (!is.null(mask)) { if (is.array(mask) & identical(names(dim(mask)), c(lat_dim,lon_dim)) & @@ -139,7 +148,7 @@ SPOD <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'l return(data) } data <- multiApply::Apply(data = data, target_dims = c(lat_dim, lon_dim), - fun = fun_mask, mask = mask)$output1 + fun = fun_mask, mask = mask, ncores = ncores)$output1 } else { stop(paste0("Parameter 'mask' must be NULL (no mask) or a numerical array ", "with c(lat_dim, lon_dim) dimensions and 0 in those grid ", diff --git a/R/Season.R b/R/Season.R index 7bc5c52..8745d26 100644 --- a/R/Season.R +++ b/R/Season.R @@ -96,7 +96,7 @@ Season <- function(data, time_dim = 'ftime', monini, moninf, monsup, } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } @@ -132,7 +132,7 @@ Season <- function(data, time_dim = 'ftime', monini, moninf, monsup, monini = monini, moninf = moninf, monsup = monsup, method = method, na.rm = na.rm) if (length(dim(res)) < length(dim(data))) { - res <- InsertDim(res, posdim = 1, lendim = 1, name = time_dim) + res <- InsertDim(res, posdim = 1, lendim = 1, name = time_dim, ncores = ncores) } else { names(dim(res))[1] <- time_dim } diff --git a/R/Smoothing.R b/R/Smoothing.R index b2b11c7..d5fd2a5 100644 --- a/R/Smoothing.R +++ b/R/Smoothing.R @@ -72,7 +72,7 @@ Smoothing <- function(data, time_dim = 'ftime', runmeanlen = 12, ncores = NULL) } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } diff --git a/R/TPI.R b/R/TPI.R index a041c69..e127ab1 100644 --- a/R/TPI.R +++ b/R/TPI.R @@ -52,6 +52,8 @@ #'@param member_dim A character string indicating the name of the member #' dimension. The default value is 'member'. Only used if parameter 'type' is #' 'dcpp' or 'hist'. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. #' #'@return A numerical array of the TPI index with the dimensions of: #' 1) sdate, forecast year, and member (in case of decadal predictions); @@ -83,7 +85,7 @@ TPI <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lon', mask = NULL, monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, year_dim = 'year', month_dim = 'month', - member_dim = 'member') { + member_dim = 'member', ncores = NULL) { ## Input Checks # data @@ -127,6 +129,13 @@ TPI <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo stop(paste0("The longitude dimension of parameter 'data' must be the same", " length of parameter 'data_lons'.")) } + # 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.") + } + } # mask if (!is.null(mask)) { if (is.array(mask) & identical(names(dim(mask)), c(lat_dim,lon_dim)) & @@ -138,7 +147,7 @@ TPI <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo return(data) } data <- multiApply::Apply(data = data, target_dims = c(lat_dim, lon_dim), - fun = fun_mask, mask = mask)$output1 + fun = fun_mask, mask = mask, ncores = ncores)$output1 } else { stop(paste0("Parameter 'mask' must be NULL (no mask) or a numerical array ", "with c(lat_dim, lon_dim) dimensions and 0 in those grid ", diff --git a/R/Trend.R b/R/Trend.R index 4afb523..211babb 100644 --- a/R/Trend.R +++ b/R/Trend.R @@ -115,7 +115,7 @@ Trend <- function(data, time_dim = 'ftime', interval = 1, polydeg = 1, } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 | + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } diff --git a/man/AMV.Rd b/man/AMV.Rd index 881e136..0f81652 100644 --- a/man/AMV.Rd +++ b/man/AMV.Rd @@ -18,7 +18,8 @@ AMV( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member" + member_dim = "member", + ncores = NULL ) } \arguments{ @@ -82,6 +83,9 @@ dimension. The default value is 'month'. Only used if parameter 'type' is \item{member_dim}{A character string indicating the name of the member dimension. The default value is 'member'. Only used if parameter 'type' is 'dcpp' or 'hist'.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} } \value{ A numerical array of the AMV index with the dimensions of: diff --git a/man/GMST.Rd b/man/GMST.Rd index 03d1092..548eabd 100644 --- a/man/GMST.Rd +++ b/man/GMST.Rd @@ -102,6 +102,9 @@ dimension. The default value is 'month'. Only used if parameter 'type' is \item{member_dim}{A character string indicating the name of the member dimension. The default value is 'member'. Only used if parameter 'type' is 'dcpp' or 'hist'.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} } \value{ A numerical array of the GMST anomalies with the dimensions of: diff --git a/man/GSAT.Rd b/man/GSAT.Rd index 370900d..d7fe3cf 100644 --- a/man/GSAT.Rd +++ b/man/GSAT.Rd @@ -18,7 +18,8 @@ GSAT( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member" + member_dim = "member", + ncores = NULL ) } \arguments{ @@ -82,6 +83,9 @@ dimension. The default value is 'month'. Only used if parameter 'type' is \item{member_dim}{A character string indicating the name of the member dimension. The default value is 'member'. Only used if parameter 'type' is 'dcpp' or 'hist'.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} } \value{ A numerical array of the GSAT anomalies with the dimensions of: diff --git a/man/SPOD.Rd b/man/SPOD.Rd index 5a20a3f..0491739 100644 --- a/man/SPOD.Rd +++ b/man/SPOD.Rd @@ -18,7 +18,8 @@ SPOD( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member" + member_dim = "member", + ncores = NULL ) } \arguments{ @@ -82,6 +83,9 @@ dimension. The default value is 'month'. Only used if parameter 'type' is \item{member_dim}{A character string indicating the name of the member dimension. The default value is 'member'. Only used if parameter 'type' is 'dcpp' or 'hist'.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} } \value{ A numerical array of the SPOD index with the dimensions of: diff --git a/man/TPI.Rd b/man/TPI.Rd index fdbc2b8..3bdc17c 100644 --- a/man/TPI.Rd +++ b/man/TPI.Rd @@ -18,7 +18,8 @@ TPI( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member" + member_dim = "member", + ncores = NULL ) } \arguments{ @@ -82,6 +83,9 @@ dimension. The default value is 'month'. Only used if parameter 'type' is \item{member_dim}{A character string indicating the name of the member dimension. The default value is 'member'. Only used if parameter 'type' is 'dcpp' or 'hist'.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} } \value{ A numerical array of the TPI index with the dimensions of: -- GitLab From 2dea529f08dc08d2d4567c1c8adae0f4dfd85ed0 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 16 Feb 2021 19:52:20 +0100 Subject: [PATCH 031/154] Fix missing param. --- R/GMST.R | 2 +- man/GMST.Rd | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/R/GMST.R b/R/GMST.R index ec3c920..4a0193a 100644 --- a/R/GMST.R +++ b/R/GMST.R @@ -113,7 +113,7 @@ GMST <- function(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_value, type, mask = NULL, lat_dim = 'lat', lon_dim = 'lon', monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, - year_dim = 'year', month_dim = 'month', member_dim = 'member') { + year_dim = 'year', month_dim = 'month', member_dim = 'member', ncores = NULL) { ## Input Checks # data_tas and data_tos diff --git a/man/GMST.Rd b/man/GMST.Rd index 548eabd..8021943 100644 --- a/man/GMST.Rd +++ b/man/GMST.Rd @@ -21,7 +21,8 @@ GMST( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member" + member_dim = "member", + ncores = NULL ) } \arguments{ -- GitLab From 71f3967b672dee6d7ba5263828a9bfd2af45f082 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 17 Feb 2021 17:41:36 +0100 Subject: [PATCH 032/154] Add 'ncores' in those functions used internally. --- R/ACC.R | 79 +++++++++++++++++++++++++++------------------------------ 1 file changed, 38 insertions(+), 41 deletions(-) diff --git a/R/ACC.R b/R/ACC.R index 1acebe3..bf3daa2 100644 --- a/R/ACC.R +++ b/R/ACC.R @@ -283,8 +283,8 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), exp_ori <- exp obs_ori <- obs } - exp <- MeanDims(exp, memb_dim, na.rm = TRUE) - obs <- MeanDims(obs, memb_dim, na.rm = TRUE) + exp <- MeanDims(exp, memb_dim, na.rm = TRUE, ncores = ncores) + obs <- MeanDims(obs, memb_dim, na.rm = TRUE, ncores = ncores) } if (is.null(avg_dim)) { @@ -292,11 +292,9 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), target_dims = list(c(space_dim, dat_dim), c(space_dim, dat_dim)), fun = .ACC, - dat_dim = dat_dim, - #space_dim = space_dim, - avg_dim = avg_dim, - conftype = conftype, - pval = pval, conf = conf, conf.lev = conf.lev, + dat_dim = dat_dim, avg_dim = avg_dim, + conftype = conftype, pval = pval, conf = conf, conf.lev = conf.lev, + ncores_input = ncores, ncores = ncores) if (conftype == 'bootstrap') { @@ -304,17 +302,17 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), target_dims = list(c(memb_dim, dat_dim, space_dim), c(memb_dim, dat_dim, space_dim)), fun = .ACC_bootstrap, - dat_dim = dat_dim, memb_dim = memb_dim, - #space_dim = space_dim, - avg_dim = avg_dim, - conftype = conftype, - pval = pval, conf = conf, conf.lev = conf.lev, + dat_dim = dat_dim, memb_dim = memb_dim, avg_dim = avg_dim, + conftype = conftype, pval = pval, conf = conf, conf.lev = conf.lev, + ncores_input = ncores, ncores = ncores) #NOTE: pval? res <- list(acc = res$acc, - acc_conf.lower = res_conf$acc_conf.lower, acc_conf.upper = res_conf$acc_conf.upper, + acc_conf.lower = res_conf$acc_conf.lower, + acc_conf.upper = res_conf$acc_conf.upper, macc = res$macc, - macc_conf.lower = res_conf$macc_conf.lower, macc_conf.upper = res_conf$macc_conf.upper) + macc_conf.lower = res_conf$macc_conf.lower, + macc_conf.upper = res_conf$macc_conf.upper) } } else { @@ -322,28 +320,26 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), target_dims = list(c(space_dim, avg_dim, dat_dim), c(space_dim, avg_dim, dat_dim)), fun = .ACC, - dat_dim = dat_dim, - #space_dim = space_dim, - avg_dim = avg_dim, - conftype = conftype, - pval = pval, conf = conf, conf.lev = conf.lev, + dat_dim = dat_dim, avg_dim = avg_dim, + conftype = conftype, pval = pval, conf = conf, conf.lev = conf.lev, + ncores_input = ncores, ncores = ncores) if (conftype == 'bootstrap') { res_conf <- Apply(list(exp_ori, obs_ori), - target_dims = list(c(memb_dim, dat_dim, avg_dim, space_dim), - c(memb_dim, dat_dim, avg_dim, space_dim)), - fun = .ACC_bootstrap, - dat_dim = dat_dim, memb_dim = memb_dim, - #space_dim = space_dim, - avg_dim = avg_dim, - conftype = conftype, - pval = pval, conf = conf, conf.lev = conf.lev, - ncores = ncores) + target_dims = list(c(memb_dim, dat_dim, avg_dim, space_dim), + c(memb_dim, dat_dim, avg_dim, space_dim)), + fun = .ACC_bootstrap, + dat_dim = dat_dim, memb_dim = memb_dim, avg_dim = avg_dim, + conftype = conftype, pval = pval, conf = conf, conf.lev = conf.lev, + ncores_input = ncores, + ncores = ncores) res <- list(acc = res$acc, - acc_conf.lower = res_conf$acc_conf.lower, acc_conf.upper = res_conf$acc_conf.upper, + acc_conf.lower = res_conf$acc_conf.lower, + acc_conf.upper = res_conf$acc_conf.upper, macc = res$macc, - macc_conf.lower = res_conf$macc_conf.lower, macc_conf.upper = res_conf$macc_conf.upper) + macc_conf.lower = res_conf$macc_conf.lower, + macc_conf.upper = res_conf$macc_conf.upper) } @@ -355,7 +351,8 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), .ACC <- function(exp, obs, dat_dim = 'dataset', #space_dim = c('lat', 'lon'), avg_dim = 'sdate', #memb_dim = NULL, lon = NULL, lat = NULL, lonlatbox = NULL, - conf = TRUE, conftype = "parametric", conf.lev = 0.95, pval = TRUE) { + conf = TRUE, conftype = "parametric", conf.lev = 0.95, pval = TRUE, + ncores_input = NULL) { # if (is.null(avg_dim)) # exp: [space_dim, dat_exp] @@ -423,7 +420,7 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), # calculate effective sample size along space_dim # combine space_dim into one dim first obs_tmp <- array(obs_sub, dim = c(space = length(obs_sub))) - eno <- Eno(obs_tmp, 'space') # a number + eno <- Eno(obs_tmp, 'space', ncores = ncores_input) # a number if (pval) { t <- qt(conf.lev, eno - 2) # a number p.val[iexp, iobs] <- sqrt(t^2 / (t^2 + eno - 2)) @@ -461,7 +458,7 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), # combine space_dim into one dim first obs_tmp <- array(obs_sub, dim = c(space = prod(dim(obs_sub)[-length(dim(obs_sub))]), dim(obs_sub)[length(dim(obs_sub))])) - eno <- Eno(obs_tmp, 'space') # a vector of avg_dim + eno <- Eno(obs_tmp, 'space', ncores = ncores_input) # 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)) @@ -513,9 +510,10 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), .ACC_bootstrap <- function(exp, obs, dat_dim = 'dataset', #space_dim = c('lat', 'lon'), - avg_dim = 'sdate', memb_dim = NULL, - lon = NULL, lat = NULL, lonlatbox = NULL, - conf = TRUE, conftype = "parametric", conf.lev = 0.95, pval = TRUE) { + avg_dim = 'sdate', memb_dim = NULL, + lon = NULL, lat = NULL, lonlatbox = NULL, + conf = TRUE, conftype = "parametric", conf.lev = 0.95, pval = TRUE, + ncores_input = NULL) { # if (is.null(avg_dim)) # exp: [memb_exp, dat_exp, space_dim] # obs: [memb_obs, dat_obs, space_dim] @@ -560,8 +558,8 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), dim = dim(obs)) # ensemble mean before .ACC - drawexp <- MeanDims(drawexp, memb_dim, na.rm = TRUE) - drawobs <- MeanDims(drawobs, memb_dim, na.rm = TRUE) + drawexp <- MeanDims(drawexp, memb_dim, na.rm = TRUE, ncores = ncores_input) + drawobs <- MeanDims(drawobs, memb_dim, na.rm = TRUE, ncores = ncores_input) # Reorder if (is.null(avg_dim)) { drawexp <- Reorder(drawexp, c(2, 3, 1)) @@ -572,7 +570,8 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), } #calculate the ACC of the randomized field - tmpACC <- .ACC(drawexp, drawobs, conf = FALSE, pval = FALSE, avg_dim = avg_dim) + tmpACC <- .ACC(drawexp, drawobs, conf = FALSE, pval = FALSE, avg_dim = avg_dim, + ncores_input = ncores_input) if (is.null(avg_dim)) { acc_draw[, , jdraw] <- tmpACC$acc } else { @@ -616,6 +615,4 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), macc_conf.upper = macc_conf.upper)) } - - } -- GitLab From 5afb45a8f5ed26e519c0727244f720ae6c1f8968 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 17 Feb 2021 20:10:16 +0100 Subject: [PATCH 033/154] Not use Apply() in InsertDim --- R/Clim.R | 8 ++--- R/Corr.R | 2 +- R/InsertDim.R | 60 ++++++++------------------------- R/RMS.R | 2 +- R/Season.R | 2 +- man/ACC.Rd | 21 +++++++++--- man/InsertDim.Rd | 5 +-- man/PlotACC.Rd | 27 +++++++++++---- tests/testthat/test-InsertDim.R | 16 ++++----- 9 files changed, 67 insertions(+), 76 deletions(-) diff --git a/R/Clim.R b/R/Clim.R index caf96ca..0de6f82 100644 --- a/R/Clim.R +++ b/R/Clim.R @@ -177,8 +177,8 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), outrows_obs <- outrows_exp for (i in 1:length(pos)) { - outrows_exp <- InsertDim(outrows_exp, pos[i], dim(exp)[pos[i]], ncores = ncores) - outrows_obs <- InsertDim(outrows_obs, pos[i], dim(obs)[pos[i]], ncores = ncores) + outrows_exp <- InsertDim(outrows_exp, pos[i], dim(exp)[pos[i]]) + outrows_obs <- InsertDim(outrows_obs, pos[i], dim(obs)[pos[i]]) } exp[which(is.na(outrows_exp))] <- NA obs[which(is.na(outrows_obs))] <- NA @@ -331,9 +331,9 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), # Create initial data set (i.e., only first ftime) tmp <- Subset(exp, ftime_dim, 1, drop = 'selected') - ini_exp <- InsertDim(tmp, pos_ftime, dim_ftime, ncores = ncores_input) #only first ftime + ini_exp <- InsertDim(tmp, pos_ftime, dim_ftime) #only first ftime tmp <- Subset(obs, ftime_dim, 1, drop = 'selected') - ini_obs <- InsertDim(tmp, pos_ftime, dim_ftime, ncores = ncores_input) #only first ftime + ini_obs <- InsertDim(tmp, pos_ftime, dim_ftime) #only first ftime #ini_: [sdate, dat_dim, ftime] tmp_exp <- Regression(datay = exp, datax = ini_exp, reg_dim = time_dim, na.action = na.omit, diff --git a/R/Corr.R b/R/Corr.R index 14f5c58..463d5f8 100644 --- a/R/Corr.R +++ b/R/Corr.R @@ -228,7 +228,7 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', 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, ncores = ncores)) - outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim], ncores = ncores) + outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim]) obs[which(outrows)] <- NA } diff --git a/R/InsertDim.R b/R/InsertDim.R index e2daccb..950479c 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. #' #'@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,54 +59,24 @@ InsertDim <- function(data, posdim, lendim, name = NULL, ncores = NULL) { stop("Parameter 'name' must be a character string.") } } - # 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.") - } - } ############################### # Calculate InsertDim + names(lendim) <- name - ## create output dimension - if (posdim == 1) { # first dim - outdim <- c(lendim, dim(data)) - } else { - if (posdim > length(dim(data))) { # last dim - outdim <- c(dim(data), lendim) - } else { # middle dim - outdim <- c(dim(data)[1:(posdim - 1)], lendim, dim(data)[posdim:length(dim(data))]) - } - } - - ## create output array - outvar <- array(dim = c(outdim)) - ## give temporary names for Apply(). The name will be replaced by data in the end - names(dim(outvar)) <- paste0('D', 1:length(outdim)) - names(dim(outvar))[posdim] <- name + ## Put the new dim at the end first + data <- array(data, dim = c(dim(data), lendim)) - res <- Apply(list(outvar), - margins = name, - fun = .InsertDim, - val = data, - ncores = ncores)$output1 - - if (posdim != 1) { - if (posdim < length(outdim)) { - res <- Reorder(res, c(1:(posdim - 1), length(outdim), posdim:(length(outdim) - 1))) - } else { #posdim = length(outdim) - res <- Reorder(res, c(1:(posdim - 1), length(outdim))) - } - } else { - res <- Reorder(res, c(length(outdim), 1:(length(outdim) - 1))) + ## Reorder dimension + if (posdim == 1) { + order <- c(length(dim(data)), 1:(length(dim(data)) - 1)) + data <- Reorder(data, order) + } else if (posdim == length(dim(data))) { # last dim + + } else { # middle dim + order <- c(1:(posdim - 1), length(dim(data)), posdim:(length(dim(data)) - 1)) + data <- Reorder(data, order) } - return(res) -} - -.InsertDim <- function(x, val) { - x <- val - return(x) + return(data) } diff --git a/R/RMS.R b/R/RMS.R index 86d4461..b3c8ad4 100644 --- a/R/RMS.R +++ b/R/RMS.R @@ -181,7 +181,7 @@ RMS <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', 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], ncores = ncores) + outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim]) obs[which(outrows)] <- NA } diff --git a/R/Season.R b/R/Season.R index a1402af..d56aa16 100644 --- a/R/Season.R +++ b/R/Season.R @@ -137,7 +137,7 @@ Season <- function(data, time_dim = 'ftime', monini, moninf, monsup, monini = monini, moninf = moninf, monsup = monsup, method = method, na.rm = na.rm) if (length(dim(res)) < length(dim(data))) { - res <- InsertDim(res, posdim = 1, lendim = 1, name = time_dim, ncores = ncores) + res <- InsertDim(res, posdim = 1, lendim = 1, name = time_dim) } else { names(dim(res))[1] <- time_dim } diff --git a/man/ACC.Rd b/man/ACC.Rd index d48d6b8..d1389fd 100644 --- a/man/ACC.Rd +++ b/man/ACC.Rd @@ -4,10 +4,22 @@ \alias{ACC} \title{Compute the anomaly correlation coefficient between the forecast and corresponding observation} \usage{ -ACC(exp, obs, dat_dim = "dataset", 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, ncores = NULL) +ACC( + exp, + obs, + dat_dim = "dataset", + 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, + ncores = NULL +) } \arguments{ \item{exp}{A numeric array of experimental anomalies with named dimensions. @@ -141,4 +153,3 @@ PlotACC(res_bootstrap, startDates) Joliffe and Stephenson (2012). Forecast Verification: A Practitioner's Guide in Atmospheric Science. Wiley-Blackwell. } - diff --git a/man/InsertDim.Rd b/man/InsertDim.Rd index c0dd7d8..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.} } \value{ An array as parameter 'data' but with the added named dimension. diff --git a/man/PlotACC.Rd b/man/PlotACC.Rd index 1dbd7cf..cd2b357 100644 --- a/man/PlotACC.Rd +++ b/man/PlotACC.Rd @@ -4,11 +4,27 @@ \alias{PlotACC} \title{Plot Plumes/Timeseries Of Anomaly Correlation Coefficients} \usage{ -PlotACC(ACC, sdates, toptitle = "", sizetit = 1, ytitle = "", - limits = NULL, legends = NULL, freq = 12, biglab = FALSE, - fill = FALSE, linezero = FALSE, points = TRUE, vlines = NULL, - fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, - ...) +PlotACC( + ACC, + sdates, + toptitle = "", + sizetit = 1, + ytitle = "", + limits = NULL, + legends = NULL, + freq = 12, + biglab = FALSE, + fill = FALSE, + linezero = FALSE, + points = TRUE, + vlines = NULL, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{ACC}{An ACC array with with dimensions:\cr @@ -106,4 +122,3 @@ PlotACC(res, startDates) PlotACC(res_bootstrap, startDates) } } - diff --git a/tests/testthat/test-InsertDim.R b/tests/testthat/test-InsertDim.R index c4d3226..f3cfab8 100644 --- a/tests/testthat/test-InsertDim.R +++ b/tests/testthat/test-InsertDim.R @@ -42,14 +42,14 @@ test_that("1. Input checks", { InsertDim(1:10, posdim = 1, lendim = 1, name = 1), "Parameter 'name' must be a character string." ) - expect_error( - InsertDim(1:10, posdim = 1, lendim = 1, ncores = 'a'), - "Parameter 'ncores' must be a positive integer." - ) - expect_error( - InsertDim(1:10, posdim = 1, lendim = 1, ncores = 0), - "Parameter 'ncores' must be a positive integer." - ) +# expect_error( +# InsertDim(1:10, posdim = 1, lendim = 1, ncores = 'a'), +# "Parameter 'ncores' must be a positive integer." +# ) +# expect_error( +# InsertDim(1:10, posdim = 1, lendim = 1, ncores = 0), +# "Parameter 'ncores' must be a positive integer." +# ) }) -- GitLab From 4b33b4c25fab73f10cef2b7a891624a44778f68b Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 18 Feb 2021 10:37:57 +0100 Subject: [PATCH 034/154] Refine code to improve efficiency --- R/Reorder.R | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/R/Reorder.R b/R/Reorder.R index 8a248e9..0431207 100644 --- a/R/Reorder.R +++ b/R/Reorder.R @@ -58,11 +58,7 @@ Reorder <- function(data, order) { ## If order is character string, find the indices if (is.character(order)) { - tmp <- rep(0, length(order)) - for (i in 1:length(order)) { - tmp[i] <- which(names(dim(data)) == order[i]) - } - order <- tmp + order <- match(order, names(dim(data))) } ## reorder -- GitLab From 8dd06d5ba8b342a095643ff84fce73d34505c2aa Mon Sep 17 00:00:00 2001 From: nperez Date: Mon, 22 Feb 2021 09:11:37 +0100 Subject: [PATCH 035/154] ProbBins first version --- R/ProbBins.R | 168 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 168 insertions(+) create mode 100644 R/ProbBins.R diff --git a/R/ProbBins.R b/R/ProbBins.R new file mode 100644 index 0000000..b0bc279 --- /dev/null +++ b/R/ProbBins.R @@ -0,0 +1,168 @@ +#'Computes Probabilistic Information of a Forecast Relative to a Threshold or a Quantile +#' +#'Compute probabilistic bins of a set of forecast years ('fcyr') relative to +#'the forecast climatology over the whole period of anomalies, optionally excluding +#'the selected forecast years ('fcyr') or the forecast year for which the +#'probabilistic bins are being computed (see 'compPeriod'). +#' +#'@param ano Array of anomalies from Ano().\cr +#' Must be of dimension (nexp/nobs, nmemb, nsdates, nleadtime, nlat, nlon) +#'@param fcyr Indices of the forecast years of the anomalies which to compute +#' the probabilistic bins for, or 'all' to compute the bins for all the +#' years.\cr +#' E.g., c(1:5), c(1, 4), 4 or 'all'. +#'@param thr Values used as thresholds to bin the anomalies. +#'@param quantile If quantile is TRUE (default), the threshold ('thr') +#' are quantiles.\cr +#' If quantile is FALSE the thresholds ('thr') introduced are the absolute +#' thresholds of the bins. +#'@param posdates Position of the dimension in \code{ano} that corresponds to +#' the start dates (default = 3). +#'@param posdim Position of the dimension in \code{ano} which will be combined +#' with 'posdates' to compute the quantiles (default = 2, ensemble members). +#'@param compPeriod Three options: +#' "Full period"/"Without fcyr"/"Cross-validation" (The probabilities are +#' computed with the terciles based on ano/ano with all 'fcyr's +#' removed/cross-validation). The default is "Full period". +#' +#'@return Array with probabilistic information and dimensions:\cr +#' c(length('thr') + 1, length(fcyr), nmemb/nparam, nmod/nexp/nobs, +#' nltime, nlat, nlon)\cr +#' The values along the first dimension take values 0 or 1 depending on which +#' of the 'thr'+1 cathegories the forecast/observation at the corresponding +#' grid point, time step, member and starting date belongs to. +#' +#'@keywords datagen +#'@examples +#'# See examples on Load() to understand the first lines in this example +#' \dontrun{ +#'data_path <- system.file('sample_data', package = 's2dverification') +#'expA <- list(name = 'experiment', path = file.path(data_path, +#' 'model/$EXP_NAME$/$STORE_FREQ$_mean/$VAR_NAME$_3hourly', +#' '$VAR_NAME$_$START_DATE$.nc')) +#'obsX <- list(name = 'observation', path = file.path(data_path, +#' '$OBS_NAME$/$STORE_FREQ$_mean/$VAR_NAME$', +#' '$VAR_NAME$_$YEAR$$MONTH$.nc')) +#' +#'# Now we are ready to use Load(). +#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +#'sampleData <- Load('tos', list(expA), list(obsX), startDates, +#' output = 'lonlat', latmin = 27, latmax = 48, +#' lonmin = -12, lonmax = 40) +#' } +#' \dontshow{ +#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +#'sampleData <- s2dverification:::.LoadSampleData('tos', c('experiment'), +#' c('observation'), startDates, +#' output = 'lonlat', +#' latmin = 27, latmax = 48, +#' lonmin = -12, lonmax = 40) +#' } +#'clim <- Clim(sampleMap$mod, sampleMap$obs) +#'ano_exp <- Ano(sampleMap$mod, clim$clim_exp) +#'PB <- ProbBins(ano_exp, fcyr = 3, thr = c(1/3, 2/3), quantile = TRUE, posdates = 3, +#' posdim = 2) +#' +#'@export + +ProbBins_new <- function(data, len = 'all', thr, quantile, sdate_dim = 'sdate', + memb_dim = 'member', + compPeriod = "Full period", ncores) { + + # Check inputs + ## dims + if (is.null(memb_dim) && compPeriod != "Cross-validation") { + dims <- sdate_dim + } else { + dims <- c(sdate_dim, memb_dim) + } + + ## data + if (is.null(data)) { + stop("Parameter 'data' cannot be NULL.") + } + if (!is.numeric(data)) { + stop("Parameter 'data' must be a numeric array.") + } + if (is.null(dim(data))) { #is vector, turn into array + data <- array(data, c(dim = length(data))) + dims <- 'dim' + } + ## forecast year + if (length(len) == 1) { + if (len == 'all') { + if (length(dim(data)) == 1) { + len <- array(1:length(data), length(data)) + names(dim(len)) <- names(dim(data)) + } else { + len <- array(1:dim(data)[sdate_dim], dim(data)[sdate_dim]) + } + } + } + if (compPeriod == "Cross-validation") { + result <- lapply(len, function(x) { + if (quantile) { + thr <- Apply(list(ClimProjDiags::Subset(data, + along = sdate_dim, indices = -x)), target_dims = c(dims), + fun = function(x) {quantile(as.vector(x), probs = thr, + na.rm = TRUE, names = FALSE, type = 8)}, + output_dims = 'bin', ncores = ncores)$output1 + } + data <- ClimProjDiags::Subset(data, along = sdate_dim, indices = x) + Apply(list(data, thr), target_dims = list(c(dims), 'bin'), + fun = .bin, ncores = ncores)$output1 + }) + dims <- c(sdate = length(len), dim(result[[1]])[-1]) + result <- unlist(result) + dim(result) <- dims + } else if (compPeriod == "Without fcyr") { + if (quantile) { + thr <- Apply(list(ClimProjDiags::Subset(data, + along = sdate_dim, indices = -len)), target_dims = c(dims), + fun = function(x) {quantile(as.vector(x), probs = thr, + na.rm = TRUE, names = FALSE, type = 8)}, + output_dims = 'bin', ncores = ncores)$output1 + } + data <- ClimProjDiags::Subset(data, along = sdate_dim, indices = len) + result <- Apply(list(data, thr), target_dims = list(c(dims), 'bin'), + fun = .bin, ncores = ncores)$output1 + } else if (compPeriod == "Full period") { + if (quantile) { + thr <- Apply(list(data), target_dims = c(dims), + fun = function(x) {quantile(as.vector(x), probs = thr, + na.rm = TRUE, names = FALSE, type = 8)}, + output_dims = 'bin', ncores = ncores)$output1 + } + result <- Apply(list(data, thr), target_dims = list(c(dims), 'bin'), + fun = .bin, ncores = ncores)$output1 + } else { + stop("Parameter 'compPeriod' must be one of 'Full period', ", + "'Without fcyr' or 'Cross-validation'.") + } + return(result) +} + +.PBF <- function(data, thr, quantile, dims = c('posdate', 'member'), + ncores) { + if (quantile) { + thr <- Apply(list(data), target_dims = c(dims), + fun = function(x) {quantile(as.vector(x), probs = thr, + na.rm = TRUE, names = FALSE, type = 8)}, + output_dims = 'bin', ncores = ncores)$output1 + } + PBF <- Apply(list(data, thr), target_dims = list(c(dims), 'bin'), + fun = .bin, ncores = ncores)$output1 +} +# data <- array(1:15, c(x = 15)) +# thres <- c(5,10) +.bin <- function(data, thres) { + res <- 1 * (data <= thres[1]) + if (length(thres) > 1) { + res <- c(res, unlist(lapply(2:length(thres), function (i) { + return(1 * ((data > thres[i - 1]) & (data <= thres[i]))) + }))) + } + res <- c(res, 1 * (data > thres[length(thres)])) + dim(res) <- c(dim(data), bin = length(thres) + 1) + return(res) +} -- GitLab From 76c435f3a3a3b34c620232d39870a27d18075c3c Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 24 Feb 2021 15:52:46 +0100 Subject: [PATCH 036/154] Remove Apply from MeanDims for faster speed --- R/Corr.R | 8 +++++--- R/MeanDims.R | 32 +++++++------------------------- man/MeanDims.Rd | 12 +----------- 3 files changed, 13 insertions(+), 39 deletions(-) diff --git a/R/Corr.R b/R/Corr.R index 463d5f8..61e0ed7 100644 --- a/R/Corr.R +++ b/R/Corr.R @@ -222,14 +222,16 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', # Remove data along comp_dim dim if there is at least one NA between limits if (!is.null(comp_dim)) { + pos <- which(names(dim(obs)) == comp_dim) if (is.null(limits)) { - limits <- c(1, dim(obs)[comp_dim]) + obs_sub <- obs + } else { + obs_sub <- ClimProjDiags::Subset(obs, pos, list(limits[1]:limits[2])) } - 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, ncores = ncores)) outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim]) obs[which(outrows)] <- NA + rm(obs_sub, outrows) } if (is.null(memb_dim)) { diff --git a/R/MeanDims.R b/R/MeanDims.R index cf4f929..7d3cb44 100644 --- a/R/MeanDims.R +++ b/R/MeanDims.R @@ -8,24 +8,17 @@ #' dimensions to average. #'@param na.rm A logical value indicating whether to ignore NA values (TRUE) or #' not (FALSE). -#'@param ncores A integer indicating the number of cores to use in parallel computation. #'@return An array with the same dimension as parameter 'data' except the 'dims' #' dimensions. #' removed. #' -#'@keywords datagen -#'@author History:\cr -#'0.1 - 2011-04 (V. Guemas, \email{vguemas@@ic3.cat}) - Original code\cr -#'1.0 - 2013-09 (N. Manubens, \email{nicolau.manubens@@ic3.cat}) - Formatting to R CRAN\cr -#'1.1 - 2015-03 (N. Manubens, \email{nicolau.manubens@@ic3.cat}) - Improved memory usage -#'3.0 - 2020-01 (A. Ho, \email{an.ho@bsc.es}) - Preserve dimension names #'@examples #'a <- array(rnorm(24), dim = c(2, 3, 4)) #'MeanDims(a, 2) #'MeanDims(a, c(2, 3)) #'@import multiApply #'@export -MeanDims <- function(data, dims, na.rm = FALSE, ncores = NULL) { +MeanDims <- function(data, dims, na.rm = FALSE) { # Check inputs ## data @@ -61,29 +54,18 @@ MeanDims <- function(data, dims, na.rm = FALSE, ncores = NULL) { if (!is.logical(na.rm) | length(na.rm) > 1) { stop("Parameter 'na.rm' must be one logical value.") } - ## 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.") - } - } - ############################### # Calculate MeanDims - if (length(dims) == length(dim(data)) || length(dim(data)) == 1) { - res <- mean(data, na.rm = na.rm) - } else if (length(dims) == 1) { + if (length(dims) == length(dim(data))) { + data <- mean(data, na.rm = na.rm) + } else { if (is.character(dims)) { - dims <- which(names(dim(data)) == dims) + dims <- which(names(dim(data)) %in% dims) } pos <- (1:length(dim(data)))[-dims] - res <- apply(data, pos, mean, na.rm = na.rm) - } else { - res <- Apply(list(data), target_dims = list(dims), fun = mean, - na.rm = na.rm, ncores = ncores)$output1 + data <- apply(data, pos, mean, na.rm = na.rm) } - return(res) + return(data) } diff --git a/man/MeanDims.Rd b/man/MeanDims.Rd index 9c874fc..f70b78b 100644 --- a/man/MeanDims.Rd +++ b/man/MeanDims.Rd @@ -4,7 +4,7 @@ \alias{MeanDims} \title{Average an array along multiple dimensions} \usage{ -MeanDims(data, dims, na.rm = FALSE, ncores = NULL) +MeanDims(data, dims, na.rm = FALSE) } \arguments{ \item{data}{An array to be averaged.} @@ -14,8 +14,6 @@ dimensions to average.} \item{na.rm}{A logical value indicating whether to ignore NA values (TRUE) or not (FALSE).} - -\item{ncores}{A integer indicating the number of cores to use in parallel computation.} } \value{ An array with the same dimension as parameter 'data' except the 'dims' @@ -31,11 +29,3 @@ a <- array(rnorm(24), dim = c(2, 3, 4)) MeanDims(a, 2) MeanDims(a, c(2, 3)) } -\author{ -History:\cr -0.1 - 2011-04 (V. Guemas, \email{vguemas@ic3.cat}) - Original code\cr -1.0 - 2013-09 (N. Manubens, \email{nicolau.manubens@ic3.cat}) - Formatting to R CRAN\cr -1.1 - 2015-03 (N. Manubens, \email{nicolau.manubens@ic3.cat}) - Improved memory usage -3.0 - 2020-01 (A. Ho, \email{an.ho@bsc.es}) - Preserve dimension names -} -\keyword{datagen} -- GitLab From f2b440cb14c37c7b3d0f7fd4a4e2276681de9f34 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 24 Feb 2021 17:23:20 +0100 Subject: [PATCH 037/154] Remove param 'ncores' in MeanDims --- R/ACC.R | 8 ++++---- R/Clim.R | 4 ++-- R/Corr.R | 2 +- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/R/ACC.R b/R/ACC.R index bf3daa2..0f1040c 100644 --- a/R/ACC.R +++ b/R/ACC.R @@ -283,8 +283,8 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), exp_ori <- exp obs_ori <- obs } - exp <- MeanDims(exp, memb_dim, na.rm = TRUE, ncores = ncores) - obs <- MeanDims(obs, memb_dim, na.rm = TRUE, ncores = ncores) + exp <- MeanDims(exp, memb_dim, na.rm = TRUE) + obs <- MeanDims(obs, memb_dim, na.rm = TRUE) } if (is.null(avg_dim)) { @@ -558,8 +558,8 @@ ACC <- function(exp, obs, dat_dim = 'dataset', space_dim = c('lat', 'lon'), dim = dim(obs)) # ensemble mean before .ACC - drawexp <- MeanDims(drawexp, memb_dim, na.rm = TRUE, ncores = ncores_input) - drawobs <- MeanDims(drawobs, memb_dim, na.rm = TRUE, ncores = ncores_input) + drawexp <- MeanDims(drawexp, memb_dim, na.rm = TRUE) + drawobs <- MeanDims(drawobs, memb_dim, na.rm = TRUE) # Reorder if (is.null(avg_dim)) { drawexp <- Reorder(drawexp, c(2, 3, 1)) diff --git a/R/Clim.R b/R/Clim.R index 0de6f82..21f97b6 100644 --- a/R/Clim.R +++ b/R/Clim.R @@ -172,8 +172,8 @@ Clim <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', 'member'), ## dat_dim: [dataset, member] pos[i] <- which(names(dim(obs)) == dat_dim[i]) } - outrows_exp <- MeanDims(exp, pos, na.rm = FALSE, ncores = ncores) + - MeanDims(obs, pos, na.rm = FALSE, ncores = ncores) + outrows_exp <- MeanDims(exp, pos, na.rm = FALSE) + + MeanDims(obs, pos, na.rm = FALSE) outrows_obs <- outrows_exp for (i in 1:length(pos)) { diff --git a/R/Corr.R b/R/Corr.R index 61e0ed7..0382a39 100644 --- a/R/Corr.R +++ b/R/Corr.R @@ -228,7 +228,7 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = 'dataset', } else { obs_sub <- ClimProjDiags::Subset(obs, pos, list(limits[1]:limits[2])) } - outrows <- is.na(MeanDims(obs_sub, pos, na.rm = FALSE, ncores = ncores)) + outrows <- is.na(MeanDims(obs_sub, pos, na.rm = FALSE)) outrows <- InsertDim(outrows, pos, dim(obs)[comp_dim]) obs[which(outrows)] <- NA rm(obs_sub, outrows) -- GitLab From 33c5e84e5e0a5cba350e09aa80c1bc9f275f3fb7 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Fri, 26 Feb 2021 15:45:21 +0100 Subject: [PATCH 038/154] removed member_dim parameter. added na.rm parameter. now it uses multiApply --- R/AMV.R | 51 +++++++++++----------- R/Utils.R | 124 +++++++++++++++++------------------------------------- 2 files changed, 65 insertions(+), 110 deletions(-) diff --git a/R/AMV.R b/R/AMV.R index 1895fa6..6de7425 100644 --- a/R/AMV.R +++ b/R/AMV.R @@ -8,11 +8,10 @@ #'weighted-averaged SST anomalies over 60ºS-60ºN, 0ºE-360ºE (Trenberth & #'Dennis, 2005; Doblas-Reyes et al., 2013). #' -#'@param data A numerical array to be used for the index computation with the -#' dimensions: 1) latitude, longitude, start date, forecast month, and member -#' (in case of decadal predictions), 2) latitude, longitude, year, month and -#' member (in case of historical simulations), or 3) latitude, longitude, year -#' and month (in case of observations or reanalyses). This data has to be +#'@param data A numerical array to be used for the index computation with, at least, the +#' dimensions: 1) latitude, longitude, start date and forecast month +#' (in case of decadal predictions), 2) latitude, longitude, year and month +#' (in case of historical simulations or observations). This data has to be #' provided, at least, over the whole region needed to compute the index. #'@param data_lats A numeric vector indicating the latitudes of the data. #'@param data_lons A numeric vector indicating the longitudes of the data. @@ -45,7 +44,7 @@ #' anomalies, set it to FALSE. The default value is NULL.\cr #' In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative #' to the first forecast year, and the climatology is automatically computed -#' over the actual common period for the different forecast years. +#' over the common calendar period for the different forecast years. #'@param year_dim A character string indicating the name of the year dimension #' The default value is 'year'. Only used if parameter 'type' is 'hist' or #' 'obs'. @@ -55,13 +54,14 @@ #'@param member_dim A character string indicating the name of the member #' dimension. The default value is 'member'. Only used if parameter 'type' is #' 'dcpp' or 'hist'. +#'@param na.rm A logical value indicanting whether to remove NA values. The default +#' value is TRUE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' -#'@return A numerical array of the AMV index with the dimensions of: -#' 1) sdate, forecast year, and member (in case of decadal predictions); -#' 2) year and member (in case of historical simulations); or -#' 3) year (in case of observations or reanalyses). +#'@return A numerical array with the AMV index with the same dimensions as data except +#' the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions +#' (historical simulations or observations) #' #'@examples #' ## Observations or reanalyses @@ -88,7 +88,7 @@ AMV <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lon', mask = NULL, monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, year_dim = 'year', month_dim = 'month', - member_dim = 'member', ncores = NULL) { + na.rm = TRUE, ncores = NULL) { ## Input Checks # data @@ -209,16 +209,11 @@ AMV <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo stop("Parameter 'month_dim' is not found in 'data' dimension.") } } - # member_dim - if (type == 'hist' | type == 'dcpp') { - if (!(is.character(member_dim) & length(member_dim) == 1)) { - stop("Parameter 'member_dim' must be a character string.") - } - if (!member_dim %in% names(dim(data))) { - stop("Parameter 'member_dim' is not found in 'data' dimension.") - } + # na.rm + if (!na.rm %in% c(TRUE,FALSE)) { + stop("Parameter 'na.rm' must be TRUE or FALSE") } - + ## Regions for AMV (Doblas-Reyes et al., 2013) lat_min_1 <- 0; lat_max_1 <- 60 lon_min_1 <- 280; lon_max_1 <- 359.9 @@ -239,9 +234,17 @@ AMV <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo data <- ClimProjDiags::CombineIndices(indices = list(mean_1,mean_2), weights = NULL, operation = 'subtract') # (mean_1 - mean_2) - INDEX <- .Indices(data = data, type = type, monini = monini, - indices_for_clim = indices_for_clim, fmonth_dim = fmonth_dim, - sdate_dim = sdate_dim, year_dim = year_dim, - month_dim = month_dim, member_dim = member_dim) + if (type == 'dcpp'){ + target_dims <- c(sdate_dim, fmonth_dim) + } else if (type %in% c('hist','obs')){ + target_dims <- c(year_dim, month_dim) + } + + source('/esarchive/scratch/cdelgado/gitlab/s2dv/R/Utils.R') + INDEX <- multiApply::Apply(data = data, target_dims = target_dims, fun = .Indices, + type = type, monini = monini, indices_for_clim = indices_for_clim, + fmonth_dim = fmonth_dim, sdate_dim = sdate_dim, + year_dim = year_dim, month_dim = month_dim, + na.rm = na.rm, ncores = ncores)$output1 return(INDEX) } diff --git a/R/Utils.R b/R/Utils.R index 6e781e1..fa19d5c 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -1670,107 +1670,59 @@ } # to be used in AMV.R, TPI.R, SPOD.R, GSAT.R and GMST.R -.Indices <- function(data, type, monini, indices_for_clim, - fmonth_dim, sdate_dim, year_dim, month_dim, member_dim) { +.Indices <- function(data, type, monini, indices_for_clim, + fmonth_dim, sdate_dim, year_dim, month_dim, na.rm) { - data = drop(data) - - if(member_dim %in% names(dim(data))){ - if (type == 'dcpp'){ - data = s2dv::Reorder(data = data, order = c(sdate_dim,fmonth_dim,member_dim)) - } else if (type %in% c('hist','obs')){ - data = s2dv::Reorder(data = data, order = c(year_dim,month_dim,member_dim)) - } - } - - if (type == 'dcpp'){ + if (type == 'dcpp') { - data = s2dv::Season(data = data, time_dim = fmonth_dim, - monini = monini, moninf = 1, monsup = 12, - method = mean, na.rm = FALSE) - names(dim(data))[which(names(dim(data))==fmonth_dim)] = 'fyear' - if (member_dim %in% names(dim(data))){ - data = s2dv::Reorder(data = data, order = c('fyear',sdate_dim,member_dim)) - } else { - data = s2dv::Reorder(data = data, order = c('fyear',sdate_dim)) - } + fyear_dim <- 'fyear' + data <- s2dv::Season(data = data, time_dim = fmonth_dim, + monini = monini, moninf = 1, monsup = 12, + method = mean, na.rm = na.rm) + names(dim(data))[which(names(dim(data))==fmonth_dim)] <- fyear_dim - if (is.logical(indices_for_clim)) { - if(!any(indices_for_clim)) { - # indices_for_clim == FALSE -> anomalies are directly given - anom = data - } + if (identical(indices_for_clim, FALSE)) { ## data is already anomalies - } else { - - ## Different indices_for_clim for each forecast year (same actual years) + anom <- data - n_fyears = as.numeric(dim(data)['fyear']) - n_sdates = as.numeric(dim(data)[sdate_dim]) + } else { ## Different indices_for_clim for each forecast year (to use the same calendar years) - if (is.null(indices_for_clim)){ - - # indices_for_clim == NULL -> anomalies based on the whole (common) period - first_years_for_clim = n_fyears : 1 - last_years_for_clim = n_sdates : (n_sdates - n_fyears + 1) - - } else { - - first_years_for_clim = seq(from = indices_for_clim[1], by = -1, length.out = n_fyears) - last_years_for_clim = seq(from = indices_for_clim[length(indices_for_clim)], by = -1, length.out = n_fyears) - - } - - anom = array(data = NA, dim = dim(data)) - if (member_dim %in% names(dim(data))){ - clim = array(data = NA, dim = c(dim(data)['fyear'],dim(data)[member_dim])) - } else { - clim = array(data = NA, dim = c(dim(data)['fyear'])) + n_fyears <- as.numeric(dim(data)[fyear_dim]) + n_sdates <- as.numeric(dim(data)[sdate_dim]) + + if (is.null(indices_for_clim)) { ## climatology over the whole (common) period + first_years_for_clim <- n_fyears : 1 + last_years_for_clim <- n_sdates : (n_sdates - n_fyears + 1) + } else { ## indices_for_clim specified as a numeric vector + first_years_for_clim <- seq(from = indices_for_clim[1], by = -1, length.out = n_fyears) + last_years_for_clim <- seq(from = indices_for_clim[length(indices_for_clim)], by = -1, length.out = n_fyears) } - for (i in 1:n_fyears){ - if (member_dim %in% names(dim(data))){ - for (m in 1:as.numeric(dim(data)[member_dim])){ - clim[i,m] = mean(data[i,first_years_for_clim[i]:last_years_for_clim[i],m]) - anom[i,,m] = data[i,,m] - clim[i,m] - } - } else { - clim = mean(data[i,first_years_for_clim[i]:last_years_for_clim[i]]) - anom[i,] = data[i,] - clim - } + + data <- s2dv::Reorder(data = data, order = c(fyear_dim, sdate_dim)) + anom <- array(data = NA, dim = dim(data)) + clim <- array(data = NA, dim = c(dim(data)[fyear_dim])) + for (i in 1:n_fyears) { + clim <- mean(data[i,first_years_for_clim[i]:last_years_for_clim[i]], na.rm = na.rm) + anom[i,] <- data[i,] - clim } } - } else if (type %in% c('obs','hist')){ + } else if (type %in% c('obs','hist')) { - data = multiApply::Apply(data = data, target_dims = month_dim, fun = mean)$output1 + data <- multiApply::Apply(data = data, target_dims = month_dim, fun = mean, na.rm = na.rm)$output1 - if (is.logical(indices_for_clim)) { - if(!any(indices_for_clim)) { - anom = data - } - - } else { - - if (is.null(indices_for_clim)){ - - clim = multiApply::Apply(data = data, target_dims = year_dim, fun = mean)$output1 - - } else { - - if (member_dim %in% names(dim(data))){ - target_dims = c(year_dim,member_dim) - } else { - target_dims = year_dim - } - clim = multiApply::Apply(data = ClimProjDiags::Subset(x = data, along = year_dim, indices = indices_for_clim), - target_dims = target_dims, fun = mean)$output1 - } - anom = multiApply::Apply(data = data, target_dims = year_dim, - fun = function(data,clim){data-clim}, clim = clim)$output1 + if (identical(indices_for_clim, FALSE)) { ## data is already anomalies + clim <- 0 + } else if (is.null(indices_for_clim)) { ## climatology over the whole period + clim <- multiApply::Apply(data = data, target_dims = year_dim, fun = mean, na.rm = na.rm)$output1 + } else { ## indices_for_clim specified as a numeric vector + clim <- multiApply::Apply(data = ClimProjDiags::Subset(x = data, along = year_dim, indices = indices_for_clim), + target_dims = year_dim, fun = mean, na.rm = na.rm)$output1 } + anom <- data - clim + } else {stop('type must be dcpp, hist or obs')} return(anom) } - -- GitLab From 928077a392c87fba396ea9d8db5a32fa08a4cc97 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Fri, 26 Feb 2021 15:52:55 +0100 Subject: [PATCH 039/154] removed member_dim in documentation --- R/AMV.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/R/AMV.R b/R/AMV.R index 6de7425..88e7777 100644 --- a/R/AMV.R +++ b/R/AMV.R @@ -51,9 +51,6 @@ #'@param month_dim A character string indicating the name of the month #' dimension. The default value is 'month'. Only used if parameter 'type' is #' 'hist' or 'obs'. -#'@param member_dim A character string indicating the name of the member -#' dimension. The default value is 'member'. Only used if parameter 'type' is -#' 'dcpp' or 'hist'. #'@param na.rm A logical value indicanting whether to remove NA values. The default #' value is TRUE. #'@param ncores An integer indicating the number of cores to use for parallel -- GitLab From 8b21a132f4ee9be4bdfc74c2d1ebad9ce3069d79 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Fri, 26 Feb 2021 17:27:54 +0100 Subject: [PATCH 040/154] updated documentation --- R/AMV.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/AMV.R b/R/AMV.R index 88e7777..0a791bc 100644 --- a/R/AMV.R +++ b/R/AMV.R @@ -58,7 +58,8 @@ #' #'@return A numerical array with the AMV index with the same dimensions as data except #' the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions -#' (historical simulations or observations) +#' (historical simulations or observations). In case of decadal predictions, a new dimension +#' 'fyear' is added. #' #'@examples #' ## Observations or reanalyses -- GitLab From a2ff73d5bbf2fc115985b17163d7c5d7505471a8 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Fri, 26 Feb 2021 17:28:51 +0100 Subject: [PATCH 041/154] updated the rest of the indices functions (removed member_dim, added na.rm, now they use multiApply, updated documentation) --- R/GMST.R | 75 ++++++++++++++++++++++++++++---------------------------- R/GSAT.R | 53 +++++++++++++++++++-------------------- R/SPOD.R | 53 +++++++++++++++++++-------------------- R/TPI.R | 53 +++++++++++++++++++-------------------- 4 files changed, 118 insertions(+), 116 deletions(-) diff --git a/R/GMST.R b/R/GMST.R index 4a0193a..d21c731 100644 --- a/R/GMST.R +++ b/R/GMST.R @@ -4,22 +4,20 @@ #'weighted-averaged surface air temperature anomalies over land and sea surface #'temperature anomalies over the ocean. #' -#'@param data_tas A numerical array indicating the surface air temperature data -#' to be used for the index computation with the dimensions: 1) latitude, -#' longitude, start date, forecast month, and member (in case of decadal -#' predictions), 2) latitude, longitude, year, month and member (in case of -#' historical simulations), or 3) latitude, longitude, year and month (in case -#' of observations or reanalyses). This data has to be provided, at least, -#' over the whole region needed to compute the index. The dimensions must be -#' identical to those of data_tos. -#'@param data_tos A numerical array indicating the sea surface temperature data -#' to be used for the index computation with the dimensions: 1) latitude, -#' longitude, start date, forecast month, and member (in case of decadal -#' predictions), 2) latitude, longitude, year, month and member (in case of -#' historical simulations), or 3) latitude, longitude, year and month (in case -#' of observations or reanalyses). This data has to be provided, at least, -#' over the whole region needed to compute the index. The dimensions must be -#' identical to those of data_tas. +#'@param data_tas A numerical array with the surface air temperature data +#' to be used for the index computation with, at least, the +#' dimensions: 1) latitude, longitude, start date and forecast month +#' (in case of decadal predictions), 2) latitude, longitude, year and month +#' (in case of historical simulations or observations). This data has to be +#' provided, at least, over the whole region needed to compute the index. +#' The dimensions must be identical to thos of data_tos. +#' #'@param data_tos A numerical array with the sea surface temperature data +#' to be used for the index computation with, at least, the +#' dimensions: 1) latitude, longitude, start date and forecast month +#' (in case of decadal predictions), 2) latitude, longitude, year and month +#' (in case of historical simulations or observations). This data has to be +#' provided, at least, over the whole region needed to compute the index. +#' The dimensions must be identical to thos of data_tas. #'@param data_lats A numeric vector indicating the latitudes of the data. #'@param data_lons A numeric vector indicating the longitudes of the data. #'@param mask_sea_land An array with dimensions [lat_dim = data_lats, lon_dim = @@ -55,23 +53,22 @@ #' anomalies, set it to FALSE. The default value is NULL.\cr #' In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative #' to the first forecast year, and the climatology is automatically computed -#' over the actual common period for the different forecast years. +#' over the common calendar period for the different forecast years. #'@param year_dim A character string indicating the name of the year dimension #' The default value is 'year'. Only used if parameter 'type' is 'hist' or #' 'obs'. #'@param month_dim A character string indicating the name of the month #' dimension. The default value is 'month'. Only used if parameter 'type' is #' 'hist' or 'obs'. -#'@param member_dim A character string indicating the name of the member -#' dimension. The default value is 'member'. Only used if parameter 'type' is -#' 'dcpp' or 'hist'. +#'@param na.rm A logical value indicanting whether to remove NA values. The default +#' value is TRUE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' -#'@return A numerical array of the GMST anomalies with the dimensions of: -#' 1) sdate, forecast year, and member (in case of decadal predictions); -#' 2) year and member (in case of historical simulations); or -#' 3) year (in case of observations or reanalyses). +#'@return A numerical array with the GMST anomalies with the same dimensions as data_tas except +#' the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions +#' (historical simulations or observations). In case of decadal predictions, a new dimension +#' 'fyear' is added. #' #'@examples #' ## Observations or reanalyses @@ -113,7 +110,7 @@ GMST <- function(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_value, type, mask = NULL, lat_dim = 'lat', lon_dim = 'lon', monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, - year_dim = 'year', month_dim = 'month', member_dim = 'member', ncores = NULL) { + year_dim = 'year', month_dim = 'month', na.rm = TRUE, ncores = NULL) { ## Input Checks # data_tas and data_tos @@ -236,14 +233,9 @@ GMST <- function(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_va stop("Parameter 'month_dim' is not found in 'data_tas' or 'data_tos' dimension.") } } - # member_dim - if (type == 'hist' | type == 'dcpp') { - if (!(is.character(member_dim) & length(member_dim) == 1)) { - stop("Parameter 'member_dim' must be a character string.") - } - if (!member_dim %in% names(dim(data_tas)) | !member_dim %in% names(dim(data_tos))) { - stop("Parameter 'member_dim' is not found in 'data_tas' or 'data_tos' dimension.") - } + # na.rm + if (!na.rm %in% c(TRUE,FALSE)) { + stop("Parameter 'na.rm' must be TRUE or FALSE") } # ncores if (!is.null(ncores)) { @@ -253,7 +245,6 @@ GMST <- function(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_va } } - ## combination of tas and tos (data) mask_tas_tos <- function(data_tas, data_tos, mask_sea_land, sea_value) { data <- data_tas @@ -284,9 +275,17 @@ GMST <- function(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_va londim = which(names(dim(data)) == lon_dim), latdim = which(names(dim(data)) == lat_dim)) - INDEX <- .Indices(data = data, type = type, monini = monini, - indices_for_clim = indices_for_clim, fmonth_dim = fmonth_dim, - sdate_dim = sdate_dim, year_dim = year_dim, - month_dim = month_dim, member_dim = member_dim) + if (type == 'dcpp'){ + target_dims <- c(sdate_dim, fmonth_dim) + } else if (type %in% c('hist','obs')){ + target_dims <- c(year_dim, month_dim) + } + + source('/esarchive/scratch/cdelgado/gitlab/s2dv/R/Utils.R') + INDEX <- multiApply::Apply(data = data, target_dims = target_dims, fun = .Indices, + type = type, monini = monini, indices_for_clim = indices_for_clim, + fmonth_dim = fmonth_dim, sdate_dim = sdate_dim, + year_dim = year_dim, month_dim = month_dim, + na.rm = na.rm, ncores = ncores)$output1 return(INDEX) } diff --git a/R/GSAT.R b/R/GSAT.R index 0c50a34..a278689 100644 --- a/R/GSAT.R +++ b/R/GSAT.R @@ -3,11 +3,10 @@ #'The Global Surface Air Temperature (GSAT) anomalies are computed as the #'weighted-averaged surface air temperature anomalies over the global region. #' -#'@param data A numerical array to be used for the index computation with the -#' dimensions: 1) latitude, longitude, start date, forecast month, and member -#' (in case of decadal predictions), 2) latitude, longitude, year, month and -#' member (in case of historical simulations), or 3) latitude, longitude, year -#' and month (in case of observations or reanalyses). This data has to be +#'@param data A numerical array to be used for the index computation with, at least, the +#' dimensions: 1) latitude, longitude, start date and forecast month +#' (in case of decadal predictions), 2) latitude, longitude, year and month +#' (in case of historical simulations or observations). This data has to be #' provided, at least, over the whole region needed to compute the index. #'@param data_lats A numeric vector indicating the latitudes of the data. #'@param data_lons A numeric vector indicating the longitudes of the data. @@ -40,23 +39,22 @@ #' anomalies, set it to FALSE. The default value is NULL.\cr #' In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative #' to the first forecast year, and the climatology is automatically computed -#' over the actual common period for the different forecast years. +#' over the common calendar period for the different forecast years. #'@param year_dim A character string indicating the name of the year dimension #' The default value is 'year'. Only used if parameter 'type' is 'hist' or #' 'obs'. #'@param month_dim A character string indicating the name of the month #' dimension. The default value is 'month'. Only used if parameter 'type' is #' 'hist' or 'obs'. -#'@param member_dim A character string indicating the name of the member -#' dimension. The default value is 'member'. Only used if parameter 'type' is -#' 'dcpp' or 'hist'. +#'@param na.rm A logical value indicanting whether to remove NA values. The default +#' value is TRUE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' -#'@return A numerical array of the GSAT anomalies with the dimensions of: -#' 1) sdate, forecast year, and member (in case of decadal predictions); -#' 2) year and member (in case of historical simulations); or -#' 3) year (in case of observations or reanalyses). +#'@return A numerical array with the GSAT anomalies with the same dimensions as data except +#' the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions +#' (historical simulations or observations). In case of decadal predictions, a new dimension +#' 'fyear' is added. #' #'@examples #' ## Observations or reanalyses @@ -83,7 +81,7 @@ GSAT <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lon', mask = NULL, monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, year_dim = 'year', month_dim = 'month', - member_dim = 'member', ncores = NULL) { + na.rm = TRUE, ncores = NULL) { ## Input Checks # data @@ -204,14 +202,9 @@ GSAT <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'l stop("Parameter 'month_dim' is not found in 'data' dimension.") } } - # member_dim - if (type == 'hist' | type == 'dcpp') { - if (!(is.character(member_dim) & length(member_dim) == 1)) { - stop("Parameter 'member_dim' must be a character string.") - } - if (!member_dim %in% names(dim(data))) { - stop("Parameter 'member_dim' is not found in 'data' dimension.") - } + # na.rm + if (!na.rm %in% c(TRUE,FALSE)) { + stop("Parameter 'na.rm' must be TRUE or FALSE") } data <- ClimProjDiags::WeightedMean(data = data, lon = data_lons, lat = data_lats, @@ -219,9 +212,17 @@ GSAT <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'l londim = which(names(dim(data)) == lon_dim), latdim = which(names(dim(data)) == lat_dim)) - INDEX <- .Indices(data = data, type = type, monini = monini, - indices_for_clim = indices_for_clim, fmonth_dim = fmonth_dim, - sdate_dim = sdate_dim, year_dim = year_dim, - month_dim = month_dim, member_dim = member_dim) + if (type == 'dcpp'){ + target_dims <- c(sdate_dim, fmonth_dim) + } else if (type %in% c('hist','obs')){ + target_dims <- c(year_dim, month_dim) + } + + source('/esarchive/scratch/cdelgado/gitlab/s2dv/R/Utils.R') + INDEX <- multiApply::Apply(data = data, target_dims = target_dims, fun = .Indices, + type = type, monini = monini, indices_for_clim = indices_for_clim, + fmonth_dim = fmonth_dim, sdate_dim = sdate_dim, + year_dim = year_dim, month_dim = month_dim, + na.rm = na.rm, ncores = ncores)$output1 return(INDEX) } diff --git a/R/SPOD.R b/R/SPOD.R index 5e8812d..eb9225e 100644 --- a/R/SPOD.R +++ b/R/SPOD.R @@ -6,11 +6,10 @@ #'anomalies over 20ºS-48ºS, 165ºE-190ºE (NW pole) and the weighted-averaged SST #' anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). #' -#'@param data A numerical array to be used for the index computation with the -#' dimensions: 1) latitude, longitude, start date, forecast month, and member -#' (in case of decadal predictions), 2) latitude, longitude, year, month and -#' member (in case of historical simulations), or 3) latitude, longitude, year -#' and month (in case of observations or reanalyses). This data has to be +#'@param data A numerical array to be used for the index computation with, at least, the +#' dimensions: 1) latitude, longitude, start date and forecast month +#' (in case of decadal predictions), 2) latitude, longitude, year and month +#' (in case of historical simulations or observations). This data has to be #' provided, at least, over the whole region needed to compute the index. #'@param data_lats A numeric vector indicating the latitudes of the data. #'@param data_lons A numeric vector indicating the longitudes of the data. @@ -43,23 +42,22 @@ #' anomalies, set it to FALSE. The default value is NULL.\cr #' In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative #' to the first forecast year, and the climatology is automatically computed -#' over the actual common period for the different forecast years. +#' over the common calendar period for the different forecast years. #'@param year_dim A character string indicating the name of the year dimension #' The default value is 'year'. Only used if parameter 'type' is 'hist' or #' 'obs'. #'@param month_dim A character string indicating the name of the month #' dimension. The default value is 'month'. Only used if parameter 'type' is #' 'hist' or 'obs'. -#'@param member_dim A character string indicating the name of the member -#' dimension. The default value is 'member'. Only used if parameter 'type' is -#' 'dcpp' or 'hist'. +#'@param na.rm A logical value indicanting whether to remove NA values. The default +#' value is TRUE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' -#'@return A numerical array of the SPOD index with the dimensions of: -#' 1) sdate, forecast year, and member (in case of decadal predictions); -#' 2) year and member (in case of historical simulations); or -#' 3) year (in case of observations or reanalyses). +#'@return A numerical array with the SPOD index with the same dimensions as data except +#' the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions +#' (historical simulations or observations). In case of decadal predictions, a new dimension +#' 'fyear' is added. #' #'@examples #' ## Observations or reanalyses @@ -86,7 +84,7 @@ SPOD <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lon', mask = NULL, monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, year_dim = 'year', month_dim = 'month', - member_dim = 'member', ncores = NULL) { + na.rm = TRUE, ncores = NULL) { ## Input Checks # data @@ -207,14 +205,9 @@ SPOD <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'l stop("Parameter 'month_dim' is not found in 'data' dimension.") } } - # member_dim - if (type == 'hist' | type == 'dcpp') { - if (!(is.character(member_dim) & length(member_dim) == 1)) { - stop("Parameter 'member_dim' must be a character string.") - } - if (!member_dim %in% names(dim(data))) { - stop("Parameter 'member_dim' is not found in 'data' dimension.") - } + # na.rm + if (!na.rm %in% c(TRUE,FALSE)) { + stop("Parameter 'na.rm' must be TRUE or FALSE") } ## Regions for IPO_SPOD (Saurral et al., 2020) @@ -238,9 +231,17 @@ SPOD <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'l data <- ClimProjDiags::CombineIndices(indices = list(mean_1,mean_2), weights = NULL, operation = 'subtract') # (mean_1 - mean_2) - INDEX <- .Indices(data = data, type = type, monini = monini, - indices_for_clim = indices_for_clim, fmonth_dim = fmonth_dim, - sdate_dim = sdate_dim, year_dim = year_dim, - month_dim = month_dim, member_dim = member_dim) + if (type == 'dcpp'){ + target_dims <- c(sdate_dim, fmonth_dim) + } else if (type %in% c('hist','obs')){ + target_dims <- c(year_dim, month_dim) + } + + source('/esarchive/scratch/cdelgado/gitlab/s2dv/R/Utils.R') + INDEX <- multiApply::Apply(data = data, target_dims = target_dims, fun = .Indices, + type = type, monini = monini, indices_for_clim = indices_for_clim, + fmonth_dim = fmonth_dim, sdate_dim = sdate_dim, + year_dim = year_dim, month_dim = month_dim, + na.rm = na.rm, ncores = ncores)$output1 return(INDEX) } diff --git a/R/TPI.R b/R/TPI.R index e127ab1..74c3846 100644 --- a/R/TPI.R +++ b/R/TPI.R @@ -5,11 +5,10 @@ #'170ºE-270ºE minus the mean of the weighted-averaged SST anomalies over #'25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). #' -#'@param data A numerical array to be used for the index computation with the -#' dimensions: 1) latitude, longitude, start date, forecast month, and member -#' (in case of decadal predictions), 2) latitude, longitude, year, month and -#' member (in case of historical simulations), or 3) latitude, longitude, year -#' and month (in case of observations or reanalyses). This data has to be +#'@param data A numerical array to be used for the index computation with, at least, the +#' dimensions: 1) latitude, longitude, start date and forecast month +#' (in case of decadal predictions), 2) latitude, longitude, year and month +#' (in case of historical simulations or observations). This data has to be #' provided, at least, over the whole region needed to compute the index. #'@param data_lats A numeric vector indicating the latitudes of the data. #'@param data_lons A numeric vector indicating the longitudes of the data. @@ -42,23 +41,22 @@ #' anomalies, set it to FALSE. The default value is NULL.\cr #' In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative #' to the first forecast year, and the climatology is automatically computed -#' over the actual common period for the different forecast years. +#' over the common calendar period for the different forecast years. #'@param year_dim A character string indicating the name of the year dimension #' The default value is 'year'. Only used if parameter 'type' is 'hist' or #' 'obs'. #'@param month_dim A character string indicating the name of the month #' dimension. The default value is 'month'. Only used if parameter 'type' is #' 'hist' or 'obs'. -#'@param member_dim A character string indicating the name of the member -#' dimension. The default value is 'member'. Only used if parameter 'type' is -#' 'dcpp' or 'hist'. +#'@param na.rm A logical value indicanting whether to remove NA values. The default +#' value is TRUE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' -#'@return A numerical array of the TPI index with the dimensions of: -#' 1) sdate, forecast year, and member (in case of decadal predictions); -#' 2) year and member (in case of historical simulations); or -#' 3) year (in case of observations or reanalyses). +#'@return A numerical array with the TPI index with the same dimensions as data except +#' the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions +#' (historical simulations or observations). In case of decadal predictions, a new dimension +#' 'fyear' is added. #' #'@examples #' ## Observations or reanalyses @@ -85,7 +83,7 @@ TPI <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lon', mask = NULL, monini = 11, fmonth_dim = 'fmonth', sdate_dim = 'sdate', indices_for_clim = NULL, year_dim = 'year', month_dim = 'month', - member_dim = 'member', ncores = NULL) { + na.rm = TRUE, ncores = NULL) { ## Input Checks # data @@ -206,14 +204,9 @@ TPI <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo stop("Parameter 'month_dim' is not found in 'data' dimension.") } } - # member_dim - if (type == 'hist' | type == 'dcpp') { - if (!(is.character(member_dim) & length(member_dim) == 1)) { - stop("Parameter 'member_dim' must be a character string.") - } - if (!member_dim %in% names(dim(data))) { - stop("Parameter 'member_dim' is not found in 'data' dimension.") - } + # na.rm + if (!na.rm %in% c(TRUE,FALSE)) { + stop("Parameter 'na.rm' must be TRUE or FALSE") } # Regions for IPO_TPI (psl.noaa.gov/data/timeseries/IPOTPI) @@ -247,9 +240,17 @@ TPI <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo data <- ClimProjDiags::CombineIndices(indices = list(mean_2, mean_1_3), weights = NULL, operation = 'subtract') # mean_2 - ((mean_1 + mean_3)/2) - INDEX <- .Indices(data = data, type = type, monini = monini, - indices_for_clim = indices_for_clim, fmonth_dim = fmonth_dim, - sdate_dim = sdate_dim, year_dim = year_dim, - month_dim = month_dim, member_dim = member_dim) + if (type == 'dcpp'){ + target_dims <- c(sdate_dim, fmonth_dim) + } else if (type %in% c('hist','obs')){ + target_dims <- c(year_dim, month_dim) + } + + source('/esarchive/scratch/cdelgado/gitlab/s2dv/R/Utils.R') + INDEX <- multiApply::Apply(data = data, target_dims = target_dims, fun = .Indices, + type = type, monini = monini, indices_for_clim = indices_for_clim, + fmonth_dim = fmonth_dim, sdate_dim = sdate_dim, + year_dim = year_dim, month_dim = month_dim, + na.rm = na.rm, ncores = ncores)$output1 return(INDEX) } -- GitLab From 9dae893d99ec25bd4d76f0ecce7f7b0e7bf8afd8 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 3 Mar 2021 10:14:44 +0100 Subject: [PATCH 042/154] Improve Ano.R speed by using apply(), and create markdown file to record the profiling tests. --- R/Ano.R | 67 +++++++++++++------- R/Trend.R | 18 +++--- inst/doc/profiling_compare_apply.md | 95 +++++++++++++++++++++++++++++ man/Ano.Rd | 5 +- tests/testthat/test-Ano.R | 41 ++++++++++++- 5 files changed, 187 insertions(+), 39 deletions(-) create mode 100644 inst/doc/profiling_compare_apply.md diff --git a/R/Ano.R b/R/Ano.R index 13ee211..f66c60a 100644 --- a/R/Ano.R +++ b/R/Ano.R @@ -13,8 +13,7 @@ #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' -#'@return An array with same dimensions as parameter 'data' but with different -#' dimension order. The dimensions in parameter 'clim' are ordered first. +#'@return An array with same dimensions as parameter 'data'. #' #'@examples #'# Load sample data as in Load() example: @@ -22,8 +21,6 @@ #'clim <- Clim(sampleData$mod, sampleData$obs) #'ano_exp <- Ano(sampleData$mod, clim$clim_exp) #'ano_obs <- Ano(sampleData$obs, clim$clim_obs) -#'ano_exp <- Reorder(ano_exp, c(1, 2, 4, 3)) -#'ano_obs <- Reorder(ano_obs, c(1, 2, 4, 3)) #'\donttest{ #'PlotAno(ano_exp, ano_obs, startDates, #' toptitle = 'Anomaly', ytitle = c('K', 'K', 'K'), @@ -62,38 +59,62 @@ if (any(is.null(names(dim(clim))))| any(nchar(names(dim(clim))) == 0)) { stop("Parameter 'clim' must have dimension names.") } - for (i in 1:length(dim(clim))) { - if (!(names(dim(clim))[i] %in% names(dim(data)))) { - stop("Parameter 'data' must have all the dimensions of parameter 'clim'.") - } else { - pos <- names(dim(data))[which(names(dim(clim))[i] == names(dim(data)))] - if ((dim(clim)[i] != dim(data)[pos])) { - stop("Some dimensions of parameter 'clim' have different length from parameter 'data'.") - } + ## data and clim + if (!all(names(dim(clim)) %in% names(dim(data)))) { + stop("Parameter 'data' must have all the dimensions of parameter 'clim'.") + } else { + pos <- names(dim(data))[match(names(dim(clim)), names(dim(data)))] + if (any(dim(clim) != dim(data)[pos])) { + stop("Some dimensions of parameter 'clim' have different length from parameter 'data'.") } } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | - length(ncores) > 1) { + if (!is.numeric(ncores)) { + stop("Parameter 'ncores' must be a positive integer.") + } else if (ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } } ############################### # Calculate Ano + parallel_compute <- TRUE + if (is.null(ncores)) { + parallel_compute <- FALSE + } else if (ncores == 1) { + parallel_compute <- FALSE + } + if (!parallel_compute) { + target_dims_ind <- match(names(dim(clim)), names(dim(data))) + if (any(target_dims_ind != sort(target_dims_ind))) { + clim <- Reorder(clim, match(sort(target_dims_ind), target_dims_ind)) + } + if (length(dim(data)) == length(dim(clim))) { + res <- data - clim + } else { + target_dims_ind <- match(dim(clim), dim(data)) + margin_dims_ind <- c(1:length(dim(data)))[-target_dims_ind] + res <- apply(data, margin_dims_ind, .Ano, clim) + res <- array(res, dim = dim(data)[c(target_dims_ind, margin_dims_ind)]) + } + } else { + res <- Apply(list(data), + target_dims = names(dim(clim)), + output_dims = names(dim(clim)), + fun = .Ano, + clim = clim, + ncores = ncores)$output1 + } - res <- Apply(list(data), - target_dims = names(dim(clim)), - output_dims = names(dim(clim)), - fun = .Ano, - clim = clim, - ncores = ncores)$output1 + # Reorder dim back to data + if (any(dim(res) != dim(data))) { + res <- Reorder(res, names(dim(data))) + } - return(invisible(res)) + return(invisible(res)) } .Ano <- function(data, clim) { - ano <- data - clim - return(ano) + data - clim } diff --git a/R/Trend.R b/R/Trend.R index 211babb..1f714a6 100644 --- a/R/Trend.R +++ b/R/Trend.R @@ -115,16 +115,15 @@ Trend <- function(data, time_dim = 'ftime', interval = 1, polydeg = 1, } ## ncores if (!is.null(ncores)) { - if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | - length(ncores) > 1) { + if (!is.numeric(ncores)) { + stop("Parameter 'ncores' must be a positive integer.") + } else if (ncores %% 1 != 0 | ncores <= 0 | length(ncores) > 1) { stop("Parameter 'ncores' must be a positive integer.") } } ############################### # Calculate Trend - dim_names <- names(dim(data)) - if (conf & pval) { output_dims <- list(trend = 'stats', conf.lower = 'stats', conf.upper = 'stats', p.val = 'stats', detrended = time_dim) @@ -136,22 +135,22 @@ Trend <- function(data, time_dim = 'ftime', interval = 1, polydeg = 1, } else { output_dims <- list(trend = 'stats', detrended = time_dim) } - - + output <- Apply(list(data), target_dims = time_dim, fun = .Trend, output_dims = output_dims, - time_dim = time_dim, interval = interval, + interval = interval, polydeg = polydeg, conf = conf, conf.lev = conf.lev, pval = pval, ncores = ncores) - return(output) + return(invisible(output)) } -.Trend <- function(x, time_dim = 'ftime', interval = 1, polydeg = 1, +.Trend <- function(x, interval = 1, polydeg = 1, conf = TRUE, conf.lev = 0.95, pval = TRUE) { + # x: [ftime] mon <- seq(x) * interval @@ -193,7 +192,6 @@ Trend <- function(data, time_dim = 'ftime', interval = 1, polydeg = 1, } } - if (conf & pval) { return(list(trend = trend, conf.lower = conf.lower, conf.upper = conf.upper, p.val = p.val, detrended = detrended)) diff --git a/inst/doc/profiling_compare_apply.md b/inst/doc/profiling_compare_apply.md new file mode 100644 index 0000000..967785c --- /dev/null +++ b/inst/doc/profiling_compare_apply.md @@ -0,0 +1,95 @@ +This document records the profiling tests of those functions using apply() and Apply() +depending on 'ncores'. The comparison is among apply(), Apply() with one core, and Apply() with two cores. Two different data sizes are tested. The testing package is "peakRAM". + + +- Ano() +For small data, apply() is better than Apply() both in time and memory usage. However, if +the data size is larger, apply() requires more memory even if it saves time still. Using +2 cores can save memory usage but time is even longer. + + - small data +```r + set.seed(1) + dat1 <- array(rnorm(10000), c(dat = 10, member = 30, sdate = 400, ftime = 10)) + set.seed(2) + clim1 <- array(rnorm(10000), c(dat = 10, member = 30, sdate = 400)) + pryr::object_size(dat1) + 9.6 MB + + # (1) apply + Elapsed_Time_sec Total_RAM_Used_MiB Peak_RAM_Used_MiB + 0.016 9.1 68.6 + + # (2) Apply, 1 core + Elapsed_Time_sec Total_RAM_Used_MiB Peak_RAM_Used_MiB + 0.039 9.1 82.4 + + # (3) Apply, 2 cores + Elapsed_Time_sec Total_RAM_Used_MiB Peak_RAM_Used_MiB + 0.117 9.1 50.4 +``` + + - large data +```r + set.seed(1) + dat2 <- array(rnorm(10000), c(dat = 10, member = 30, sdate = 400, ftime = 10, lon = 150)) + set.seed(2) + clim2 <- array(rnorm(10000), c(dat = 10, member = 30, sdate = 400)) + pryr::object_size(dat2) + 1.44GB + + # (1) apply + Elapsed_Time_sec Total_RAM_Used_MiB Peak_RAM_Used_MiB + 6.368 1373.3 6004 + + # (2) Apply, 1 core + Elapsed_Time_sec Total_RAM_Used_MiB Peak_RAM_Used_MiB + 15.211 1373.3 5844.3 + + # (3) Apply, 2 cores + Elapsed_Time_sec Total_RAM_Used_MiB Peak_RAM_Used_MiB + 20.193 1373.3 4718.9 +``` + +- Trend +Because the returned value is list, apply() is not suitable for Trend(). For small data, +2 cores is twice faster than 1 core. The peak RAM is around 6-7x of data. For larger data, +1 core is a bit faster than 2 cores. The peak RAM is around 4-5x of data. + - small data +```r + set.seed(1) + dat1 <- array(rnorm(10000), c(dat = 10, member = 30, sdate = 40, ftime = 100)) + pryr::object_size(dat1) + 9.6 MB + + # (1) Apply, 1 core + Elapsed_Time_sec Total_RAM_Used_MiB Peak_RAM_Used_MiB + 21.324 9.8 56.4 + + # (2) Apply, 2 cores + Elapsed_Time_sec Total_RAM_Used_MiB Peak_RAM_Used_MiB + 11.327 9.8 63.1 + + # (3) Apply, 4 cores + +``` + + - large data +```r + set.seed(1) + dat2 <- array(rnorm(10000), c(dat = 10, member = 10, sdate = 400, ftime = 1000, lon = 4)) + pryr::object_size(dat2) + 1.28GB + + # (1) Apply, 1 core + Elapsed_Time_sec Total_RAM_Used_MiB Peak_RAM_Used_MiB + 602.273 1230.4 6004.3 + + # (2) Apply, 2 cores + Elapsed_Time_sec Total_RAM_Used_MiB Peak_RAM_Used_MiB + 632.638 1229.8 5979.2 + +``` + + + diff --git a/man/Ano.Rd b/man/Ano.Rd index 8e423af..d15ffd1 100644 --- a/man/Ano.Rd +++ b/man/Ano.Rd @@ -20,8 +20,7 @@ same length.} computation. The default value is NULL.} } \value{ -An array with same dimensions as parameter 'data' but with different - dimension order. The dimensions in parameter 'clim' are ordered first. +An array with same dimensions as parameter 'data'. } \description{ This function computes anomalies from a multidimensional data array and a @@ -33,8 +32,6 @@ example(Load) clim <- Clim(sampleData$mod, sampleData$obs) ano_exp <- Ano(sampleData$mod, clim$clim_exp) ano_obs <- Ano(sampleData$obs, clim$clim_obs) -ano_exp <- Reorder(ano_exp, c(1, 2, 4, 3)) -ano_obs <- Reorder(ano_obs, c(1, 2, 4, 3)) \donttest{ PlotAno(ano_exp, ano_obs, startDates, toptitle = 'Anomaly', ytitle = c('K', 'K', 'K'), diff --git a/tests/testthat/test-Ano.R b/tests/testthat/test-Ano.R index 4d64ce6..a74c7c9 100644 --- a/tests/testthat/test-Ano.R +++ b/tests/testthat/test-Ano.R @@ -3,11 +3,14 @@ context("s2dv::Ano test") ############################################## # dat1 set.seed(1) - dat1 <- array(rnorm(72), c(dat = 1,member = 3, sdate = 4, ftime = 6)) + dat1 <- array(rnorm(72), c(dat = 1, member = 3, sdate = 4, ftime = 6)) set.seed(2) - clim1 <- array(rnorm(12), c(dat = 1,member = 3, sdate = 4)) + clim1 <- array(rnorm(12), c(dat = 1, member = 3, sdate = 4)) #dat2 + set.seed(1) + dat2 <- array(rnorm(72), c(dat = 1, sdate = 4, ftime = 6, member = 3)) + clim2 <- clim1 ############################################## @@ -75,5 +78,39 @@ test_that("2. Output checks: dat1", { c(-0.24416258, -0.08427184, 0.79636122, -0.05306879), tolerance = 0.0001 ) + expect_equal( + Ano(dat1, clim1, ncores = 1), + Ano(dat1, clim1, ncores = 2) + ) }) + +test_that("3. Output checks: dat2", { + + expect_equal( + dim(Ano(dat2, clim2)), + dim(dat2) + ) + expect_equal( + mean(Ano(dat2, clim2)), + -0.1434844, + tolerance = 0.0001 + ) + expect_equal( + min(Ano(dat2, clim2)), + -3.789433, + tolerance = 0.0001 + ) + expect_equal( + Ano(dat2, clim2)[1, 2, , 3], + c(0.74868744, -1.26178338, -1.17655491, -0.17166029, 0.05637202, 2.04019139), + tolerance = 0.0001 + ) + expect_equal( + Ano(dat2, clim2, ncores = 1), + Ano(dat2, clim2, ncores = 2) + ) + +}) + + -- GitLab From 68e817fe5ea41ac975ea38325ca83ba25b83dcd3 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 3 Mar 2021 11:22:46 +0100 Subject: [PATCH 043/154] Remove unused param in MeanDims --- R/Composite.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Composite.R b/R/Composite.R index 01b7acf..be03ac9 100644 --- a/R/Composite.R +++ b/R/Composite.R @@ -209,7 +209,7 @@ Composite <- function(data, occ, time_dim = 'time', space_dim = c('lon', 'lat'), n_tot <- length(occ) } - mean_tot <- MeanDims(data, dims = 3, na.rm = TRUE, ncores = ncores_input) + mean_tot <- MeanDims(data, dims = 3, na.rm = TRUE) stdv_tot <- apply(data, c(1, 2), sd, na.rm = TRUE) for (k in 1:K) { @@ -231,7 +231,7 @@ Composite <- function(data, occ, time_dim = 'time', space_dim = c('lon', 'lat'), if (length(indices) == 1) { composite[, , k] <- data[, , indices] } else { - composite[, , k] <- MeanDims(data[, , indices], dims = 3, na.rm = TRUE, ncores = ncores_input) + composite[, , k] <- MeanDims(data[, , indices], dims = 3, na.rm = TRUE) } stdv_k <- apply(data[, , indices], c(1, 2), sd, na.rm = TRUE) -- GitLab From 73224115a1cf0f331300fd63e90cd1d2bb89a942 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Wed, 3 Mar 2021 12:18:23 +0100 Subject: [PATCH 044/154] removed unnecessary line --- R/Utils.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/Utils.R b/R/Utils.R index fa19d5c..03439dd 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -1700,7 +1700,6 @@ data <- s2dv::Reorder(data = data, order = c(fyear_dim, sdate_dim)) anom <- array(data = NA, dim = dim(data)) - clim <- array(data = NA, dim = c(dim(data)[fyear_dim])) for (i in 1:n_fyears) { clim <- mean(data[i,first_years_for_clim[i]:last_years_for_clim[i]], na.rm = na.rm) anom[i,] <- data[i,] - clim -- GitLab From c81976604e2ad70e1e736224b1077b04ba9939b5 Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Wed, 3 Mar 2021 16:36:40 +0100 Subject: [PATCH 045/154] removed source of .Indices() --- R/AMV.R | 1 - R/GMST.R | 1 - R/GSAT.R | 1 - R/SPOD.R | 1 - R/TPI.R | 1 - 5 files changed, 5 deletions(-) diff --git a/R/AMV.R b/R/AMV.R index 0a791bc..a0a67c9 100644 --- a/R/AMV.R +++ b/R/AMV.R @@ -238,7 +238,6 @@ AMV <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo target_dims <- c(year_dim, month_dim) } - source('/esarchive/scratch/cdelgado/gitlab/s2dv/R/Utils.R') INDEX <- multiApply::Apply(data = data, target_dims = target_dims, fun = .Indices, type = type, monini = monini, indices_for_clim = indices_for_clim, fmonth_dim = fmonth_dim, sdate_dim = sdate_dim, diff --git a/R/GMST.R b/R/GMST.R index d21c731..13ceb55 100644 --- a/R/GMST.R +++ b/R/GMST.R @@ -281,7 +281,6 @@ GMST <- function(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_va target_dims <- c(year_dim, month_dim) } - source('/esarchive/scratch/cdelgado/gitlab/s2dv/R/Utils.R') INDEX <- multiApply::Apply(data = data, target_dims = target_dims, fun = .Indices, type = type, monini = monini, indices_for_clim = indices_for_clim, fmonth_dim = fmonth_dim, sdate_dim = sdate_dim, diff --git a/R/GSAT.R b/R/GSAT.R index a278689..949bfbd 100644 --- a/R/GSAT.R +++ b/R/GSAT.R @@ -218,7 +218,6 @@ GSAT <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'l target_dims <- c(year_dim, month_dim) } - source('/esarchive/scratch/cdelgado/gitlab/s2dv/R/Utils.R') INDEX <- multiApply::Apply(data = data, target_dims = target_dims, fun = .Indices, type = type, monini = monini, indices_for_clim = indices_for_clim, fmonth_dim = fmonth_dim, sdate_dim = sdate_dim, diff --git a/R/SPOD.R b/R/SPOD.R index eb9225e..b87ef15 100644 --- a/R/SPOD.R +++ b/R/SPOD.R @@ -237,7 +237,6 @@ SPOD <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'l target_dims <- c(year_dim, month_dim) } - source('/esarchive/scratch/cdelgado/gitlab/s2dv/R/Utils.R') INDEX <- multiApply::Apply(data = data, target_dims = target_dims, fun = .Indices, type = type, monini = monini, indices_for_clim = indices_for_clim, fmonth_dim = fmonth_dim, sdate_dim = sdate_dim, diff --git a/R/TPI.R b/R/TPI.R index 74c3846..57255b6 100644 --- a/R/TPI.R +++ b/R/TPI.R @@ -246,7 +246,6 @@ TPI <- function(data, data_lats, data_lons, type, lat_dim = 'lat', lon_dim = 'lo target_dims <- c(year_dim, month_dim) } - source('/esarchive/scratch/cdelgado/gitlab/s2dv/R/Utils.R') INDEX <- multiApply::Apply(data = data, target_dims = target_dims, fun = .Indices, type = type, monini = monini, indices_for_clim = indices_for_clim, fmonth_dim = fmonth_dim, sdate_dim = sdate_dim, -- GitLab From ca7cef771913f6578c8c8420a579cc29a2b8a95c Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 8 Mar 2021 18:25:44 +0100 Subject: [PATCH 046/154] Move CDORemap here and create FAQ for CDORemap version combination issue --- NAMESPACE | 3 + R/CDORemap.R | 1031 +++++++++++++++++++++++++++++++++++++++++++++++ inst/doc/FAQ.md | 28 ++ man/CDORemap.Rd | 232 +++++++++++ 4 files changed, 1294 insertions(+) create mode 100644 R/CDORemap.R create mode 100644 man/CDORemap.Rd diff --git a/NAMESPACE b/NAMESPACE index b12cd82..07dff52 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,7 @@ export(ACC) export(AMV) export(AnimateMap) export(Ano) +export(CDORemap) export(Clim) export(ColorBar) export(Composite) @@ -91,6 +92,7 @@ importFrom(stats,na.fail) importFrom(stats,na.omit) importFrom(stats,na.pass) importFrom(stats,pf) +importFrom(stats,predict) importFrom(stats,pt) importFrom(stats,qchisq) importFrom(stats,qnorm) @@ -98,5 +100,6 @@ importFrom(stats,qt) importFrom(stats,quantile) importFrom(stats,rnorm) importFrom(stats,sd) +importFrom(stats,setNames) importFrom(stats,ts) importFrom(stats,window) diff --git a/R/CDORemap.R b/R/CDORemap.R new file mode 100644 index 0000000..ae3c988 --- /dev/null +++ b/R/CDORemap.R @@ -0,0 +1,1031 @@ +#'Interpolates arrays with longitude and latitude dimensions using CDO +#' +#'This function takes as inputs a multidimensional array (optional), a vector +#'or matrix of longitudes, a vector or matrix of latitudes, a destination grid +#'specification, and the name of a method to be used to interpolate (one of +#'those available in the 'remap' utility in CDO). The interpolated array is +#'returned (if provided) together with the new longitudes and latitudes.\cr\cr +#'\code{CDORemap()} permutes by default the dimensions of the input array (if +#'needed), splits it in chunks (CDO can work with data arrays of up to 4 +#'dimensions), generates a file with the data of each chunk, interpolates it +#'with CDO, reads it back into R and merges it into a result array. If no +#'input array is provided, the longitude and latitude vectors will be +#'transformed only. If the array is already on the desired destination grid, +#'no transformation is performed (this behvaiour works only for lonlat and +#'gaussian grids). \cr\cr +#'Any metadata attached to the input data array, longitudes or latitudes will +#'be preserved or accordingly modified. +#' +#'@param data_array Multidimensional numeric array to be interpolated. If +#' provided, it must have at least a longitude and a latitude dimensions, +#' identified by the array dimension names. The names for these dimensions +#' must be one of the recognized by s2dverification (can be checked with +#' \code{s2dverification:::.KnownLonNames()} and +#' \code{s2dverification:::.KnownLatNames()}). +#'@param lons Numeric vector or array of longitudes of the centers of the grid +#' cells. Its size must match the size of the longitude/latitude dimensions +#' of the input array. +#'@param lats Numeric vector or array of latitudes of the centers of the grid +#' cells. Its size must match the size of the longitude/latitude dimensions +#' of the input array. +#'@param grid Character string specifying either a name of a target grid +#' (recognized by CDO; e.g.: 'r256x128', 't106grid') or a path to another +#' NetCDF file which to read the target grid from (a single grid must be +#' defined in such file). +#'@param method Character string specifying an interpolation method +#' (recognized by CDO; e.g.: 'con', 'bil', 'bic', 'dis'). The following +#' long names are also supported: 'conservative', 'bilinear', 'bicubic' and +#' 'distance-weighted'. +#'@param avoid_writes The step of permutation is needed when the input array +#' has more than 3 dimensions and none of the longitude or latitude dimensions +#' in the right-most position (CDO would not accept it without permuting +#' previously). This step, executed by default when needed, can be avoided +#' for the price of writing more intermediate files (whis usually is +#' unconvenient) by setting the parameter \code{avoid_writes = TRUE}. +#'@param crop Whether to crop the data after interpolation with +#' 'cdo sellonlatbox' (TRUE) or to extend interpolated data to the whole +#' world as CDO does by default (FALSE). If \code{crop = TRUE} then the +#' longitude and latitude borders which to crop at are taken as the limits of +#' the cells at the borders ('lons' and 'lats' are perceived as cell centers), +#' i.e. the resulting array will contain data that covers the same area as +#' the input array. This is equivalent to specifying \code{crop = 'preserve'}, +#' i.e. preserving area. If \code{crop = 'tight'} then the borders which to +#' crop at are taken as the minimum and maximum cell centers in 'lons' and +#' 'lats', i.e. the area covered by the resulting array may be smaller if +#' interpolating from a coarse grid to a fine grid. The parameter 'crop' also +#' accepts a numeric vector of custom borders which to crop at: +#' c(western border, eastern border, southern border, northern border). +#'@param force_remap Whether to force remapping, even if the input data array +#' is already on the target grid. +#'@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()}). +#' +#'@return A list with the following components: +#' \item{'data_array'}{The interpolated data array (if an input array +#' is provided at all, NULL otherwise).} +#' \item{'lons'}{The longitudes of the data on the destination grid.} +#' \item{'lats'}{The latitudes of the data on the destination grid.} +#'@examples +#' \dontrun{ +#'# Interpolating only vectors of longitudes and latitudes +#'lon <- seq(0, 360 - 360/50, length.out = 50) +#'lat <- seq(-90, 90, length.out = 25) +#'tas2 <- CDORemap(NULL, lon, lat, 't170grid', 'bil', TRUE) +#' +#'# Minimal array interpolation +#'tas <- array(1:50, dim = c(25, 50)) +#'names(dim(tas)) <- c('lat', 'lon') +#'lon <- seq(0, 360 - 360/50, length.out = 50) +#'lat <- seq(-90, 90, length.out = 25) +#'tas2 <- CDORemap(tas, lon, lat, 't170grid', 'bil', TRUE) +#' +#'# Metadata can be attached to the inputs. It will be preserved and +#'# accordignly modified. +#'tas <- array(1:50, dim = c(25, 50)) +#'names(dim(tas)) <- c('lat', 'lon') +#'lon <- seq(0, 360 - 360/50, length.out = 50) +#'metadata <- list(lon = list(units = 'degrees_east')) +#'attr(lon, 'variables') <- metadata +#'lat <- seq(-90, 90, length.out = 25) +#'metadata <- list(lat = list(units = 'degrees_north')) +#'attr(lat, 'variables') <- metadata +#'metadata <- list(tas = list(dim = list(lat = list(len = 25, +#' vals = lat), +#' lon = list(len = 50, +#' vals = lon) +#' ))) +#'attr(tas, 'variables') <- metadata +#'tas2 <- CDORemap(tas, lon, lat, 't170grid', 'bil', TRUE) +#' +#'# Arrays of any number of dimensions in any order can be provided. +#'num_lats <- 25 +#'num_lons <- 50 +#'tas <- array(1:(10*num_lats*10*num_lons*10), +#' dim = c(10, num_lats, 10, num_lons, 10)) +#'names(dim(tas)) <- c('a', 'lat', 'b', 'lon', 'c') +#'lon <- seq(0, 360 - 360/num_lons, length.out = num_lons) +#'metadata <- list(lon = list(units = 'degrees_east')) +#'attr(lon, 'variables') <- metadata +#'lat <- seq(-90, 90, length.out = num_lats) +#'metadata <- list(lat = list(units = 'degrees_north')) +#'attr(lat, 'variables') <- metadata +#'metadata <- list(tas = list(dim = list(a = list(), +#' lat = list(len = num_lats, +#' vals = lat), +#' b = list(), +#' lon = list(len = num_lons, +#' vals = lon), +#' c = list() +#' ))) +#'attr(tas, 'variables') <- metadata +#'tas2 <- CDORemap(tas, lon, lat, 't17grid', 'bil', TRUE) +#'# The step of permutation can be avoided but more intermediate file writes +#'# will be performed. +#'tas2 <- CDORemap(tas, lon, lat, 't17grid', 'bil', FALSE) +#' +#'# If the provided array has the longitude or latitude dimension in the +#'# right-most position, the same number of file writes will be performed, +#'# even if avoid_wrties = FALSE. +#'num_lats <- 25 +#'num_lons <- 50 +#'tas <- array(1:(10*num_lats*10*num_lons*10), +#' dim = c(10, num_lats, 10, num_lons)) +#'names(dim(tas)) <- c('a', 'lat', 'b', 'lon') +#'lon <- seq(0, 360 - 360/num_lons, length.out = num_lons) +#'metadata <- list(lon = list(units = 'degrees_east')) +#'attr(lon, 'variables') <- metadata +#'lat <- seq(-90, 90, length.out = num_lats) +#'metadata <- list(lat = list(units = 'degrees_north')) +#'attr(lat, 'variables') <- metadata +#'metadata <- list(tas = list(dim = list(a = list(), +#' lat = list(len = num_lats, +#' vals = lat), +#' b = list(), +#' lon = list(len = num_lons, +#' vals = lon) +#' ))) +#'attr(tas, 'variables') <- metadata +#'tas2 <- CDORemap(tas, lon, lat, 't17grid', 'bil', TRUE) +#'tas2 <- CDORemap(tas, lon, lat, 't17grid', 'bil', FALSE) +#' +#'# An example of an interpolation from and onto a rectangular regular grid +#'num_lats <- 25 +#'num_lons <- 50 +#'tas <- array(1:(1*num_lats*num_lons), dim = c(num_lats, num_lons)) +#'names(dim(tas)) <- c('y', 'x') +#'lon <- array(seq(0, 360 - 360/num_lons, length.out = num_lons), +#' dim = c(num_lons, num_lats)) +#'metadata <- list(lon = list(units = 'degrees_east')) +#'names(dim(lon)) <- c('x', 'y') +#'attr(lon, 'variables') <- metadata +#'lat <- t(array(seq(-90, 90, length.out = num_lats), +#' dim = c(num_lats, num_lons))) +#'metadata <- list(lat = list(units = 'degrees_north')) +#'names(dim(lat)) <- c('x', 'y') +#'attr(lat, 'variables') <- metadata +#'tas2 <- CDORemap(tas, lon, lat, 'r100x50', 'bil') +#' +#'# An example of an interpolation from an irregular grid onto a gaussian grid +#'num_lats <- 25 +#'num_lons <- 50 +#'tas <- array(1:(10*num_lats*10*num_lons*10), +#' dim = c(10, num_lats, 10, num_lons)) +#'names(dim(tas)) <- c('a', 'j', 'b', 'i') +#'lon <- array(seq(0, 360 - 360/num_lons, length.out = num_lons), +#' dim = c(num_lons, num_lats)) +#'metadata <- list(lon = list(units = 'degrees_east')) +#'names(dim(lon)) <- c('i', 'j') +#'attr(lon, 'variables') <- metadata +#'lat <- t(array(seq(-90, 90, length.out = num_lats), +#' dim = c(num_lats, num_lons))) +#'metadata <- list(lat = list(units = 'degrees_north')) +#'names(dim(lat)) <- c('i', 'j') +#'attr(lat, 'variables') <- metadata +#'tas2 <- CDORemap(tas, lon, lat, 't17grid', 'bil') +#' +#'# Again, the dimensions can be in any order +#'num_lats <- 25 +#'num_lons <- 50 +#'tas <- array(1:(10*num_lats*10*num_lons), +#' dim = c(10, num_lats, 10, num_lons)) +#'names(dim(tas)) <- c('a', 'j', 'b', 'i') +#'lon <- array(seq(0, 360 - 360/num_lons, length.out = num_lons), +#' dim = c(num_lons, num_lats)) +#'names(dim(lon)) <- c('i', 'j') +#'lat <- t(array(seq(-90, 90, length.out = num_lats), +#' dim = c(num_lats, num_lons))) +#'names(dim(lat)) <- c('i', 'j') +#'tas2 <- CDORemap(tas, lon, lat, 't17grid', 'bil') +#'tas2 <- CDORemap(tas, lon, lat, 't17grid', 'bil', FALSE) +#'# It is ossible to specify an external NetCDF file as target grid reference +#'tas2 <- CDORemap(tas, lon, lat, 'external_file.nc', 'bil') +#'} +#'@import ncdf4 +#'@importFrom stats lm predict setNames +#'@export +CDORemap <- function(data_array = NULL, lons, lats, grid, method, + avoid_writes = TRUE, crop = TRUE, + force_remap = FALSE, write_dir = tempdir()) { #, mask = NULL) { + .isRegularVector <- function(x, tol = 0.1) { + if (length(x) < 2) { + #stop("The provided vector must be of length 2 or greater.") + TRUE + } else { + spaces <- x[2:length(x)] - x[1:(length(x) - 1)] + (sum(abs(spaces - mean(spaces)) > mean(spaces) / (1 / tol)) < 2) + } + } + # Check parameters data_array, lons and lats. + known_lon_names <- .KnownLonNames() + known_lat_names <- .KnownLatNames() + if (!is.numeric(lons) || !is.numeric(lats)) { + stop("Expected numeric 'lons' and 'lats'.") + } + if (any(is.na(lons > 0))) { + stop("Found invalid values in 'lons'.") + } + if (any(is.na(lats > 0))) { + stop("Found invalid values in 'lats'.") + } + if (is.null(dim(lons))) { + dim(lons) <- length(lons) + } + if (is.null(dim(lats))) { + dim(lats) <- length(lats) + } + if (length(dim(lons)) > 2 || length(dim(lats)) > 2) { + stop("'lons' and 'lats' can only have up to 2 dimensions.") + } + if (length(dim(lons)) != length(dim(lats))) { + stop("'lons' and 'lats' must have the same number of dimensions.") + } + if (length(dim(lons)) == 2 && !all(dim(lons) == dim(lats))) { + stop("'lons' and 'lats' must have the same dimension sizes.") + } + return_array <- TRUE + if (is.null(data_array)) { + return_array <- FALSE + if (length(dim(lons)) == 1) { + array_dims <- c(length(lats), length(lons)) + new_lon_dim_name <- 'lon' + new_lat_dim_name <- 'lat' + } else { + array_dims <- dim(lons) + new_lon_dim_name <- 'i' + new_lat_dim_name <- 'j' + } + if (!is.null(names(dim(lons)))) { + if (any(known_lon_names %in% names(dim(lons)))) { + new_lon_dim_name <- known_lon_names[which(known_lon_names %in% names(dim(lons)))[1]] + } + } + if (!is.null(names(dim(lats)))) { + if (any(known_lat_names %in% names(dim(lats)))) { + new_lat_dim_name <- known_lat_names[which(known_lat_names %in% names(dim(lats)))[1]] + } + } + names(array_dims) <- c(new_lat_dim_name, new_lon_dim_name) + data_array <- array(as.numeric(NA), array_dims) + } + if (!(is.logical(data_array) || is.numeric(data_array)) || !is.array(data_array)) { + stop("Parameter 'data_array' must be a numeric array.") + } + if (is.null(names(dim(data_array)))) { + stop("Parameter 'data_array' must have named dimensions.") + } + lon_dim <- which(known_lon_names %in% names(dim(data_array))) + if (length(lon_dim) < 1) { + stop("Could not find a known longitude dimension name in the provided 'data_array'.") + } + if (length(lon_dim) > 1) { + stop("Found more than one known longitude dimension names in the provided 'data_array'.") + } + lon_dim <- known_lon_names[lon_dim] + lat_dim <- which(known_lat_names %in% names(dim(data_array))) + if (length(lat_dim) < 1) { + stop("Could not find a known latitude dimension name in the provided 'data_array'.") + } + if (length(lat_dim) > 1) { + stop("Found more than one known latitude dimension name in the provided 'data_array'.") + } + lat_dim <- known_lat_names[lat_dim] + if (is.null(names(dim(lons)))) { + if (length(dim(lons)) == 1) { + names(dim(lons)) <- lon_dim + } else { + stop("Parameter 'lons' must be provided with dimension names.") + } + } else { + if (!(lon_dim %in% names(dim(lons)))) { + stop("Parameter 'lon' must have the same longitude dimension name as the 'data_array'.") + } + if (length(dim(lons)) > 1 && !(lat_dim %in% names(dim(lons)))) { + stop("Parameter 'lon' must have the same latitude dimension name as the 'data_array'.") + } + } + if (is.null(names(dim(lats)))) { + if (length(dim(lats)) == 1) { + names(dim(lats)) <- lat_dim + } else { + stop("Parameter 'lats' must be provided with dimension names.") + } + } else { + if (!(lat_dim %in% names(dim(lats)))) { + stop("Parameter 'lat' must have the same latitude dimension name as the 'data_array'.") + } + if (length(dim(lats)) > 1 && !(lon_dim %in% names(dim(lats)))) { + stop("Parameter 'lat' must have the same longitude dimension name as the 'data_array'.") + } + } + lons_attr_bk <- attributes(lons) + if (is.null(lons_attr_bk)) { + lons_attr_bk <- list() + } + lats_attr_bk <- attributes(lats) + if (is.null(lats_attr_bk)) { + lats_attr_bk <- list() + } + if (length(attr(lons, 'variables')) == 0) { + new_metadata <- list(list()) + if (length(dim(lons)) == 1) { + names(new_metadata) <- lon_dim + } else { + names(new_metadata) <- paste0(lon_dim, '_var') + } + attr(lons, 'variables') <- new_metadata + } + if (!('units' %in% names(attr(lons, 'variables')[[1]]))) { + new_metadata <- attr(lons, 'variables') + #names(new_metadata)[1] <- lon_dim + new_metadata[[1]][['units']] <- 'degrees_east' + attr(lons, 'variables') <- new_metadata + } + if (length(attr(lats, 'variables')) == 0) { + new_metadata <- list(list()) + if (length(dim(lats)) == 1) { + names(new_metadata) <- lat_dim + } else { + names(new_metadata) <- paste0(lat_dim, '_var') + } + attr(lats, 'variables') <- new_metadata + } + if (!('units' %in% names(attr(lats, 'variables')[[1]]))) { + new_metadata <- attr(lats, 'variables') + #names(new_metadata)[1] <- lat_dim + new_metadata[[1]][['units']] <- 'degrees_north' + attr(lats, 'variables') <- new_metadata + } + # Check grid. + if (!is.character(grid)) { + stop("Parameter 'grid' must be a character string specifying a ", + "target CDO grid, 'rXxY' or 'tRESgrid', or a path to another ", + "NetCDF file.") + } + if (grepl('^r[0-9]{1,}x[0-9]{1,}$', grid)) { + grid_type <- 'regular' + grid_lons <- as.numeric(strsplit(strsplit(grid, 'x')[[1]][1], 'r')[[1]][2]) + grid_lats <- as.numeric(strsplit(grid, 'x')[[1]][2]) + } else if (grepl('^t[0-9]{1,}grid$', grid)) { + grid_type <- 'gaussian' + grid_t <- as.numeric(strsplit(strsplit(grid, 'grid')[[1]][1], 't')[[1]][2]) + grid_size <- .t2nlatlon(grid_t) + grid_lons <- grid_size[2] + grid_lats <- grid_size[1] + } else { + grid_type <- 'custom' + } + # Check method. + if (method %in% c('bil', 'bilinear')) { + method <- 'bil' + } else if (method %in% c('bic', 'bicubic')) { + method <- 'bic' + } else if (method %in% c('con', 'conservative')) { + method <- 'con' + } else if (method %in% c('dis', 'distance-weighted')) { + method <- 'dis' + } else { + stop("Unsupported CDO remap method. 'bilinear', 'bicubic', 'conservative' or 'distance-weighted' supported only.") + } + # Check avoid_writes + if (!is.logical(avoid_writes)) { + stop("Parameter 'avoid_writes' must be a logical value.") + } + # Check crop + crop_tight <- FALSE + if (is.character(crop)) { + if (crop == 'tight') { + crop_tight <- TRUE + } else if (crop != 'preserve') { + stop("Parameter 'crop' can only take the values 'tight' or 'preserve' if specified as a character string.") + } + crop <- TRUE + } + if (is.logical(crop)) { + if (crop) { + warning("Parameter 'crop' = 'TRUE'. The output grid range will follow the input lons and lats.") + if (length(lons) == 1 || length(lats) == 1) { + stop("CDORemap cannot remap if crop = TRUE and values for only one ", + "longitude or one latitude are provided. Either a) provide ", + "values for more than one longitude/latitude, b) explicitly ", + "specify the crop limits in the parameter crop, or c) set ", + "crop = FALSE.") + } + if (crop_tight) { + lon_extremes <- c(min(lons), max(lons)) + lat_extremes <- c(min(lats), max(lats)) + } else { + # Here we are trying to look for the extreme lons and lats in the data. + # Not the centers of the extreme cells, but the borders of the extreme cells. +###--- + if (length(dim(lons)) == 1) { + tmp_lon <- lons + } else { + min_pos <- which(lons == min(lons), arr.ind = TRUE)[1, ] + tmp_lon <- Subset(lons, lat_dim, min_pos[which(names(dim(lons)) == lat_dim)], drop = 'selected') + } + i <- 1:length(tmp_lon) + degree <- min(3, length(i) - 1) + lon_model <- lm(tmp_lon ~ poly(i, degree)) + lon_extremes <- c(NA, NA) + left_is_min <- FALSE + right_is_max <- FALSE + if (which.min(tmp_lon) == 1) { + left_is_min <- TRUE + prev_lon <- predict(lon_model, data.frame(i = 0)) + first_lon_cell_width <- (tmp_lon[1] - prev_lon) + # The signif is needed because cdo sellonlatbox crashes with too many digits + lon_extremes[1] <- tmp_lon[1] - first_lon_cell_width / 2 + } else { + lon_extremes[1] <- min(tmp_lon) + } + if (which.max(tmp_lon) == length(tmp_lon)) { + right_is_max <- TRUE + next_lon <- predict(lon_model, data.frame(i = length(tmp_lon) + 1)) + last_lon_cell_width <- (next_lon - tmp_lon[length(tmp_lon)]) + lon_extremes[2] <- tmp_lon[length(tmp_lon)] + last_lon_cell_width / 2 + } else { + lon_extremes[2] <- max(tmp_lon) + } + # Adjust the crop window if possible in order to keep lons from 0 to 360 + # or from -180 to 180 when the extremes of the cropped window are contiguous. + if (right_is_max) { + if (lon_extremes[1] < -180) { + if (!((lon_extremes[2] < 180) && !((180 - lon_extremes[2]) <= last_lon_cell_width / 2))) { + lon_extremes[1] <- -180 + lon_extremes[2] <- 180 + } + } else if (lon_extremes[1] < 0) { + if (!((lon_extremes[2] < 360) && !((360 - lon_extremes[2]) <= last_lon_cell_width / 2))) { + lon_extremes[1] <- 0 + lon_extremes[2] <- 360 + } + } + } + if (left_is_min) { + if (lon_extremes[2] > 360) { + if (!((lon_extremes[1] > 0) && !(lon_extremes[1] <= first_lon_cell_width / 2))) { + lon_extremes[1] <- 0 + lon_extremes[2] <- 360 + } + } else if (lon_extremes[2] > 180) { + if (!((lon_extremes[1] > -180) && !((180 + lon_extremes[1]) <= first_lon_cell_width / 2))) { + lon_extremes[1] <- -180 + lon_extremes[2] <- 180 + } + } + } +## lon_extremes <- signif(lon_extremes, 5) +## lon_extremes <- lon_extremes + 0.00001 +###--- + if (length(dim(lats)) == 1) { + tmp_lat <- lats + } else { + min_pos <- which(lats == min(lats), arr.ind = TRUE)[1, ] + tmp_lat <- Subset(lats, lon_dim, min_pos[which(names(dim(lats)) == lon_dim)], drop = 'selected') + } + i <- 1:length(tmp_lat) + degree <- min(3, length(i) - 1) + lat_model <- lm(tmp_lat ~ poly(i, degree)) + lat_extremes <- c(NA, NA) + if (which.min(tmp_lat) == 1) { + prev_lat <- predict(lat_model, data.frame(i = 0)) + lat_extremes[1] <- tmp_lat[1] - (tmp_lat[1] - prev_lat) / 2 + } else { + lat_extremes[1] <- min(tmp_lat) + } + if (which.max(tmp_lat) == length(tmp_lat)) { + next_lat <- predict(lat_model, data.frame(i = length(tmp_lat) + 1)) + lat_extremes[2] <- tmp_lat[length(tmp_lat)] + (next_lat - tmp_lat[length(tmp_lat)]) / 2 + } else { + lat_extremes[2] <- max(tmp_lat) + } +## lat_extremes <- signif(lat_extremes, 5) + # Adjust crop window + if (lat_extremes[1] < -90) { + lat_extremes[1] <- -90 + } else if (lat_extremes[1] > 90) { + lat_extremes[1] <- 90 + } + if (lat_extremes[2] < -90) { + lat_extremes[2] <- -90 + } else if (lat_extremes[2] > 90) { + lat_extremes[2] <- 90 + } +###--- + } + } else if (crop == FALSE) { + warning("Parameter 'crop' = 'FALSE'. The output grid range will follow parameter 'grid'.") + } + } else if (is.numeric(crop)) { + if (length(crop) != 4) { + stop("Paramrter 'crop' must be a logical value or a numeric vector of length 4: c(western border, eastern border, southern border, northern border.") + } else { + lon_extremes <- crop[1:2] + lat_extremes <- crop[3:4] + crop <- TRUE + } + } else { + stop("Parameter 'crop' must be a logical value or a numeric vector.") + } + # Check force_remap + if (!is.logical(force_remap)) { + stop("Parameter 'force_remap' must be a logical value.") + } + # Check write_dir + if (!is.character(write_dir)) { + stop("Parameter 'write_dir' must be a character string.") + } + if (!dir.exists(write_dir)) { + stop("Parameter 'write_dir' must point to an existing directory.") + } +# if (!is.null(mask)) { +# if (!is.numeric(mask) || !is.array(mask)) { +# stop("Parameter 'mask' must be a numeric array.") +# } +# if (length(dim(mask)) != 2) { +# stop("Parameter 'mask' must have two dimensions.") +# } +# if (is.null(names(dim(mask)))) { +# if (dim(data_array)[lat_dim] == dim(data_array)[lon_dim]) { +# stop("Cannot disambiguate which is the longitude dimension of ", +# "the provided 'mask'. Provide it with dimension names.") +# } +# names(dim(mask)) <- c('', '') +# found_lon_dim <- which(dim(mask) == dim(data_array)[lon_dim]) +# if (length(found_lon_dim) < 0) { +# stop("The dimension sizes of the provided 'mask' do not match ", +# "the spatial dimension sizes of the array to interpolate.") +# } else { +# names(dim(mask)[found_lon_dim]) <- lon_dim +# } +# found_lat_dim <- which(dim(mask) == dim(data_array)[lat_dim]) +# if (length(found_lat_dim) < 0) { +# stop("The dimension sizes of the provided 'mask' do not match ", +# "the spatial dimension sizes of the array to interpolate.") +# } else { +# names(dim(mask)[found_lat_dim]) <- lat_dim +# } +# } +# lon_position <- which(names(dim(data_array)) == lon_dim) +# lat_position <- which(names(dim(data_array)) == lat_dim) +# if (lon_position > lat_position) { +# if (names(dim(mask))[1] == lon_dim) { +# mask <- t(mask) +# } +# } else { +# if (names(dim(mask))[1] == lat_dim) { +# mask <- t(mask) +# } +# } +# ## TODO: Apply mask!!! Preserve attributes +# } + # Check if interpolation can be skipped. + interpolation_needed <- TRUE + if (!force_remap) { + if (!(grid_type == 'custom')) { + if (length(lons) == grid_lons && length(lats) == grid_lats) { + if (grid_type == 'regular') { + if (.isRegularVector(lons) && .isRegularVector(lats)) { + interpolation_needed <- FALSE + } + } else if (grid_type == 'gaussian') { + # TODO: improve this check. Gaussian quadrature should be used. + if (.isRegularVector(lons) && !.isRegularVector(lats)) { + interpolation_needed <- FALSE + } + } + } + } + } + found_lons <- lons + found_lats <- lats + if (interpolation_needed) { + if (nchar(Sys.which('cdo')[1]) < 1) { + stop("CDO must be installed in order to use the .CDORemap.") + } + cdo_version <- as.numeric_version( + strsplit(suppressWarnings(system2("cdo", args = '-V', stderr = TRUE))[[1]], ' ')[[1]][5] + ) + warning("CDORemap: Using CDO version ", cdo_version, ".") + if ((cdo_version >= as.numeric_version('1.7.0')) && (method == 'con')) { + method <- 'ycon' + } + # CDO takes arrays of 3 dimensions or 4 if one of them is unlimited. + # The unlimited dimension can only be the left-most (right-most in R). + # There are no restrictions for the dimension names or variable names. + # The longitude and latitude are detected by their units. + # There are no restrictions for the order of the limited dimensions. + # The longitude/latitude variables and dimensions must have the same name. + # The procedure consists in: + # - take out the array metadata + # - be aware of var dimension (replacing the dimension names would do). + # - take arrays of 4 dimensions always if possible + # - make the last dimension unlimited when saving to netcdf + # - if the last dimension is lon or lat, either reorder the array and + # then reorder back or iterate over the dimensions at the right + # side of lon AND lat. + # If the input array has more than 4 dimensions, it is needed to + # run CDO on each sub-array of 4 dimensions because it can handle + # only up to 4 dimensions. The shortest dimensions are chosen to + # iterate over. + is_irregular <- FALSE + if (length(dim(lats)) > 1 && length(dim(lons)) > 1) { + is_irregular <- TRUE + } + attribute_backup <- attributes(data_array) + other_dims <- which(!(names(dim(data_array)) %in% c(lon_dim, lat_dim))) + permutation <- NULL + unlimited_dim <- NULL + dims_to_iterate <- NULL + total_slices <- 1 + other_dims_per_chunk <- ifelse(is_irregular, 1, 2) # 4 (the maximum accepted by CDO) - 2 (lon, lat) = 2. + if (length(other_dims) > 1 || (length(other_dims) > 0 && (is_irregular))) { + if (!(length(dim(data_array)) %in% other_dims)) { + if (avoid_writes || is_irregular) { + dims_mod <- dim(data_array) + dims_mod[which(names(dim(data_array)) %in% + c(lon_dim, lat_dim))] <- 0 + dim_to_move <- which.max(dims_mod) + permutation <- (1:length(dim(data_array)))[-dim_to_move] + permutation <- c(permutation, dim_to_move) + permutation_back <- sort(permutation, index.return = TRUE)$ix + dim_backup <- dim(data_array) + data_array <- aperm(data_array, permutation) + dim(data_array) <- dim_backup[permutation] + other_dims <- which(!(names(dim(data_array)) %in% c(lon_dim, lat_dim))) + } else { + # We allow only lon, lat and 1 more dimension per chunk, so + # CDO has no restrictions in the order. + other_dims_per_chunk <- 1 + } + } + other_dims_ordered_by_size <- other_dims[sort(dim(data_array)[other_dims], index.return = TRUE)$ix] + dims_to_iterate <- sort(head(other_dims_ordered_by_size, length(other_dims) - other_dims_per_chunk)) + if (length(dims_to_iterate) == 0) { + dims_to_iterate <- NULL + } else { + slices_to_iterate <- array(1:prod(dim(data_array)[dims_to_iterate]), + dim(data_array)[dims_to_iterate]) + total_slices <- prod(dim(slices_to_iterate)) + } + if ((other_dims_per_chunk > 1) || (other_dims_per_chunk > 0 && is_irregular)) { + unlimited_dim <- tail(sort(tail(other_dims_ordered_by_size, other_dims_per_chunk)), 1) + #unlimited_dim <- tail(other_dims) + } + } + + result_array <- NULL + lon_pos <- which(names(dim(data_array)) == lon_dim) + lat_pos <- which(names(dim(data_array)) == lat_dim) + dim_backup <- dim(data_array) + attributes(data_array) <- NULL + dim(data_array) <- dim_backup + names(dim(data_array)) <- paste0('dim', 1:length(dim(data_array))) + names(dim(data_array))[c(lon_pos, lat_pos)] <- c(lon_dim, lat_dim) + if (!is.null(unlimited_dim)) { + # This will make ArrayToNetCDF create this dim as unlimited. + names(dim(data_array))[unlimited_dim] <- 'time' + } + if (length(dim(lons)) == 1) { + names(dim(lons)) <- lon_dim + } + if (length(dim(lats)) == 1) { + names(dim(lats)) <- lat_dim + } + if (length(dim(lons)) > 1) { + lon_var_name <- paste0(lon_dim, '_var') + } else { + lon_var_name <- lon_dim + } + if (length(dim(lats)) > 1) { + lat_var_name <- paste0(lat_dim, '_var') + } else { + lat_var_name <- lat_dim + } + if (is_irregular) { + metadata <- list(list(coordinates = paste(lon_var_name, lat_var_name))) + names(metadata) <- 'var' + attr(data_array, 'variables') <- metadata + } + names(attr(lons, 'variables')) <- lon_var_name + names(attr(lats, 'variables')) <- lat_var_name + if (!is.null(attr(lons, 'variables')[[1]][['dim']])) { + attr(lons, 'variables')[[1]][['dim']] <- NULL + } + if (!is.null(attr(lats, 'variables')[[1]][['dim']])) { + attr(lats, 'variables')[[1]][['dim']] <- NULL + } + lons_lats_taken <- FALSE + for (i in 1:total_slices) { + tmp_file <- tempfile('R_CDORemap_', write_dir, fileext = '.nc') + tmp_file2 <- tempfile('R_CDORemap_', write_dir, fileext = '.nc') + if (!is.null(dims_to_iterate)) { + slice_indices <- which(slices_to_iterate == i, arr.ind = TRUE) + subset <- Subset(data_array, dims_to_iterate, as.list(slice_indices), drop = 'selected') +# dims_before_crop <- dim(subset) + # Make sure subset goes along with metadata + ArrayToNetCDF(setNames(list(subset, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) + } else { +# dims_before_crop <- dim(data_array) + ArrayToNetCDF(setNames(list(data_array, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) + } + sellonlatbox <- '' + if (crop) { + sellonlatbox <- paste0('sellonlatbox,', format(lon_extremes[1], scientific = FALSE), + ',', format(lon_extremes[2], scientific = FALSE), + ',', format(lat_extremes[1], scientific = FALSE), + ',', format(lat_extremes[2], scientific = FALSE), ' -') + } + err <- try({ + system(paste0("cdo -s ", sellonlatbox, "remap", method, ",", grid, " ", tmp_file, " ", tmp_file2)) + }) + file.remove(tmp_file) + if (('try-error' %in% class(err)) || err > 0) { + stop("CDO remap failed.") + } + ncdf_remapped <- nc_open(tmp_file2) + if (!lons_lats_taken) { + found_dim_names <- sapply(ncdf_remapped$var$var$dim, '[[', 'name') + found_lon_dim <- found_dim_names[which(found_dim_names %in% .KnownLonNames())[1]] + found_lat_dim <- found_dim_names[which(found_dim_names %in% .KnownLatNames())[1]] + found_lon_dim_size <- length(ncdf_remapped$dim[[found_lon_dim]]$vals) + found_lat_dim_size <- length(ncdf_remapped$dim[[found_lat_dim]]$vals) + found_var_names <- names(ncdf_remapped$var) + found_lon_var_name <- which(found_var_names %in% .KnownLonNames()) + found_lat_var_name <- which(found_var_names %in% .KnownLatNames()) + if (length(found_lon_var_name) > 0) { + found_lon_var_name <- found_var_names[found_lon_var_name[1]] + } else { + found_lon_var_name <- NULL + } + if (length(found_lat_var_name) > 0) { + found_lat_var_name <- found_var_names[found_lat_var_name[1]] + } else { + found_lat_var_name <- NULL + } + if (length(found_lon_var_name) > 0) { + found_lons <- ncvar_get(ncdf_remapped, found_lon_var_name, + collapse_degen = FALSE) + } else { + found_lons <- ncdf_remapped$dim[[found_lon_dim]]$vals + dim(found_lons) <- found_lon_dim_size + } + if (length(found_lat_var_name) > 0) { + found_lats <- ncvar_get(ncdf_remapped, found_lat_var_name, + collapse_degen = FALSE) + } else { + found_lats <- ncdf_remapped$dim[[found_lat_dim]]$vals + dim(found_lats) <- found_lat_dim_size + } + if (length(dim(lons)) == length(dim(found_lons))) { + new_lon_name <- lon_dim + } else { + new_lon_name <- found_lon_dim + } + if (length(dim(lats)) == length(dim(found_lats))) { + new_lat_name <- lat_dim + } else { + new_lat_name <- found_lat_dim + } + if (length(dim(found_lons)) > 1) { + if (which(sapply(ncdf_remapped$var$lon$dim, '[[', 'name') == found_lon_dim) < + which(sapply(ncdf_remapped$var$lon$dim, '[[', 'name') == found_lat_dim)) { + names(dim(found_lons)) <- c(new_lon_name, new_lat_name) + } else { + names(dim(found_lons)) <- c(new_lat_name, new_lon_name) + } + } else { + names(dim(found_lons)) <- new_lon_name + } + if (length(dim(found_lats)) > 1) { + if (which(sapply(ncdf_remapped$var$lat$dim, '[[', 'name') == found_lon_dim) < + which(sapply(ncdf_remapped$var$lat$dim, '[[', 'name') == found_lat_dim)) { + names(dim(found_lats)) <- c(new_lon_name, new_lat_name) + } else { + names(dim(found_lats)) <- c(new_lat_name, new_lon_name) + } + } else { + names(dim(found_lats)) <- new_lat_name + } + lons_lats_taken <- TRUE + } + if (!is.null(dims_to_iterate)) { + if (is.null(result_array)) { + if (return_array) { + new_dims <- dim(data_array) + new_dims[c(lon_dim, lat_dim)] <- c(found_lon_dim_size, found_lat_dim_size) + result_array <- array(dim = new_dims) + store_indices <- as.list(rep(TRUE, length(dim(result_array)))) + } + } + if (return_array) { + store_indices[dims_to_iterate] <- as.list(slice_indices) + result_array <- do.call('[<-', c(list(x = result_array), store_indices, + list(value = ncvar_get(ncdf_remapped, 'var', collapse_degen = FALSE)))) + } + } else { + new_dims <- dim(data_array) + new_dims[c(lon_dim, lat_dim)] <- c(found_lon_dim_size, found_lat_dim_size) + result_array <- ncvar_get(ncdf_remapped, 'var', collapse_degen = FALSE) + dim(result_array) <- new_dims + } + nc_close(ncdf_remapped) + file.remove(tmp_file2) + } + if (!is.null(permutation)) { + dim_backup <- dim(result_array) + result_array <- aperm(result_array, permutation_back) + dim(result_array) <- dim_backup[permutation_back] + } + # Now restore the metadata + result_is_irregular <- FALSE + if (length(dim(found_lats)) > 1 && length(dim(found_lons)) > 1) { + result_is_irregular <- TRUE + } + attribute_backup[['dim']][which(names(dim(result_array)) == lon_dim)] <- dim(result_array)[lon_dim] + attribute_backup[['dim']][which(names(dim(result_array)) == lat_dim)] <- dim(result_array)[lat_dim] + names(attribute_backup[['dim']])[which(names(dim(result_array)) == lon_dim)] <- new_lon_name + names(attribute_backup[['dim']])[which(names(dim(result_array)) == lat_dim)] <- new_lat_name + if (!is.null(attribute_backup[['variables']]) && (length(attribute_backup[['variables']]) > 0)) { + for (var in 1:length(attribute_backup[['variables']])) { + if (length(attribute_backup[['variables']][[var]][['dim']]) > 0) { + for (dim in 1:length(attribute_backup[['variables']][[var]][['dim']])) { + dim_name <- NULL + if ('name' %in% names(attribute_backup[['variables']][[var]][['dim']][[dim]])) { + dim_name <- attribute_backup[['variables']][[var]][['dim']][[dim]][['name']] + if (dim_name %in% c(lon_dim, lat_dim)) { + if (dim_name == lon_dim) { + attribute_backup[['variables']][[var]][['dim']][[dim]][['name']] <- new_lon_name + } else { + attribute_backup[['variables']][[var]][['dim']][[dim]][['name']] <- new_lat_name + } + } + } else if (!is.null(names(attribute_backup[['variables']][[var]][['dim']]))) { + dim_name <- names(attribute_backup[['variables']][[var]][['dim']])[dim] + if (dim_name %in% c(lon_dim, lat_dim)) { + if (dim_name == lon_dim) { + names(attribute_backup[['variables']][[var]][['dim']])[which(names(attribute_backup[['variables']][[var]][['dim']]) == lon_dim)] <- new_lon_name + } else { + names(attribute_backup[['variables']][[var]][['dim']])[which(names(attribute_backup[['variables']][[var]][['dim']]) == lat_dim)] <- new_lat_name + } + } + } + if (!is.null(dim_name)) { + if (dim_name %in% c(lon_dim, lat_dim)) { + if (dim_name == lon_dim) { + new_vals <- found_lons[TRUE] + } else if (dim_name == lat_dim) { + new_vals <- found_lats[TRUE] + } + if (!is.null(attribute_backup[['variables']][[var]][['dim']][[dim]][['len']])) { + attribute_backup[['variables']][[var]][['dim']][[dim]][['len']] <- length(new_vals) + } + if (!is.null(attribute_backup[['variables']][[var]][['dim']][[dim]][['vals']])) { + if (!result_is_irregular) { + attribute_backup[['variables']][[var]][['dim']][[dim]][['vals']] <- new_vals + } else { + attribute_backup[['variables']][[var]][['dim']][[dim]][['vals']] <- 1:length(new_vals) + } + } + } + } + } + } + if (!is_irregular && result_is_irregular) { + attribute_backup[['coordinates']] <- paste(lon_var_name, lat_var_name) + } else if (is_irregular && !result_is_irregular) { + attribute_backup[['coordinates']] <- NULL + } + } + } + attributes(result_array) <- attribute_backup + lons_attr_bk[['dim']] <- dim(found_lons) + if (!is.null(lons_attr_bk[['variables']]) && (length(lons_attr_bk[['variables']]) > 0)) { + for (var in 1:length(lons_attr_bk[['variables']])) { + if (length(lons_attr_bk[['variables']][[var]][['dim']]) > 0) { + dims_to_remove <- NULL + for (dim in 1:length(lons_attr_bk[['variables']][[var]][['dim']])) { + dim_name <- NULL + if ('name' %in% names(lons_attr_bk[['variables']][[var]][['dim']][[dim]])) { + dim_name <- lons_attr_bk[['variables']][[var]][['dim']][[dim]][['name']] + if (dim_name %in% c(lon_dim, lat_dim)) { + if (dim_name == lon_dim) { + lons_attr_bk[['variables']][[var]][['dim']][[dim]][['name']] <- new_lon_name + } else { + lons_attr_bk[['variables']][[var]][['dim']][[dim]][['name']] <- new_lat_name + } + } + } else if (!is.null(names(lons_attr_bk[['variables']][[var]][['dim']]))) { + dim_name <- names(lons_attr_bk[['variables']][[var]][['dim']])[dim] + if (dim_name %in% c(lon_dim, lat_dim)) { + if (dim_name == lon_dim) { + names(lons_attr_bk[['variables']][[var]][['dim']])[which(names(lons_attr_bk[['variables']][[var]][['dim']]) == lon_dim)] <- new_lon_name + } else { + names(lons_attr_bk[['variables']][[var]][['dim']])[which(names(lons_attr_bk[['variables']][[var]][['dim']]) == lat_dim)] <- new_lat_name + } + } + } + if (!is.null(dim_name)) { + if (dim_name %in% c(lon_dim, lat_dim)) { + if (dim_name == lon_dim) { + new_vals <- found_lons[TRUE] + } else if (dim_name == lat_dim) { + new_vals <- found_lats[TRUE] + if (!result_is_irregular) { + dims_to_remove <- c(dims_to_remove, dim) + } + } + if (!is.null(lons_attr_bk[['variables']][[var]][['dim']][[dim]][['len']])) { + lons_attr_bk[['variables']][[var]][['dim']][[dim]][['len']] <- length(new_vals) + } + if (!is.null(lons_attr_bk[['variables']][[var]][['dim']][[dim]][['vals']])) { + if (!result_is_irregular) { + lons_attr_bk[['variables']][[var]][['dim']][[dim]][['vals']] <- new_vals + } else { + lons_attr_bk[['variables']][[var]][['dim']][[dim]][['vals']] <- 1:length(new_vals) + } + } + } + } + } + if (length(dims_to_remove) > 1) { + lons_attr_bk[['variables']][[var]][['dim']] <- lons_attr_bk[['variables']][[var]][['dim']][[-dims_to_remove]] + } + } + } + names(lons_attr_bk[['variables']])[1] <- lon_var_name + lons_attr_bk[['variables']][[1]][['units']] <- 'degrees_east' + } + attributes(found_lons) <- lons_attr_bk + lats_attr_bk[['dim']] <- dim(found_lats) + if (!is.null(lats_attr_bk[['variables']]) && (length(lats_attr_bk[['variables']]) > 0)) { + for (var in 1:length(lats_attr_bk[['variables']])) { + if (length(lats_attr_bk[['variables']][[var]][['dim']]) > 0) { + dims_to_remove <- NULL + for (dim in 1:length(lats_attr_bk[['variables']][[var]][['dim']])) { + dim_name <- NULL + if ('name' %in% names(lats_attr_bk[['variables']][[var]][['dim']][[dim]])) { + dim_name <- lats_attr_bk[['variables']][[var]][['dim']][[dim]][['name']] + if (dim_name %in% c(lon_dim, lat_dim)) { + if (dim_name == lon_dim) { + lons_attr_bk[['variables']][[var]][['dim']][[dim]][['name']] <- new_lon_name + } else { + lons_attr_bk[['variables']][[var]][['dim']][[dim]][['name']] <- new_lat_name + } + } + } else if (!is.null(names(lats_attr_bk[['variables']][[var]][['dim']]))) { + dim_name <- names(lats_attr_bk[['variables']][[var]][['dim']])[dim] + if (dim_name %in% c(lon_dim, lat_dim)) { + if (dim_name == lon_dim) { + names(lats_attr_bk[['variables']][[var]][['dim']])[which(names(lats_attr_bk[['variables']][[var]][['dim']]) == lon_dim)] <- new_lon_name + } else { + names(lats_attr_bk[['variables']][[var]][['dim']])[which(names(lats_attr_bk[['variables']][[var]][['dim']]) == lat_dim)] <- new_lat_name + } + } + } + if (!is.null(dim_name)) { + if (dim_name %in% c(lon_dim, lat_dim)) { + if (dim_name == lon_dim) { + new_vals <- found_lons[TRUE] + if (!result_is_irregular) { + dims_to_remove <- c(dims_to_remove, dim) + } + } else if (dim_name == lat_dim) { + new_vals <- found_lats[TRUE] + } + if (!is.null(lats_attr_bk[['variables']][[var]][['dim']][[dim]][['len']])) { + lats_attr_bk[['variables']][[var]][['dim']][[dim]][['len']] <- length(new_vals) + } + if (!is.null(lats_attr_bk[['variables']][[var]][['dim']][[dim]][['vals']])) { + if (!result_is_irregular) { + lats_attr_bk[['variables']][[var]][['dim']][[dim]][['vals']] <- new_vals + } else { + lats_attr_bk[['variables']][[var]][['dim']][[dim]][['vals']] <- 1:length(new_vals) + } + } + } + } + } + if (length(dims_to_remove) > 1) { + lats_attr_bk[['variables']][[var]][['dim']] <- lats_attr_bk[['variables']][[var]][['dim']][[-dims_to_remove]] + } + } + } + names(lats_attr_bk[['variables']])[1] <- lat_var_name + lats_attr_bk[['variables']][[1]][['units']] <- 'degrees_north' + } + attributes(found_lats) <- lats_attr_bk + } + list(data_array = if (return_array) { + if (interpolation_needed) { + result_array + } else { + data_array + } + } else { + NULL + }, + lons = found_lons, lats = found_lats) +} + diff --git a/inst/doc/FAQ.md b/inst/doc/FAQ.md index e6a58be..a8e49db 100644 --- a/inst/doc/FAQ.md +++ b/inst/doc/FAQ.md @@ -6,6 +6,10 @@ This document intends to be the first reference for any doubts that you may have 1. **How to** 1. [Global Map with non-standard longitudinal boundaries](#1-global-map-with-non-standard-longitudinal-boundaries) +2. **Something goes wrong...** + 1. [CDORemap() returns errors or warnings with specific module versions](#1-cdoremap-returns-errors-or-warnings-with-specific-module-versions) + + ## 1. How to ### 1. Global Map with non-standard longitudinal boundaries @@ -40,3 +44,27 @@ Note: You can adjust many parameters to visualize the plot, here we are just sho If you want to add other information to the plot (e.g.: hatching, points, countours, ...), you can add it just before ColorBar() function. + + +## 2. Something goes wrong... + +### 1. CDORemap() returns errors or warnings with specific module versions +CDORemap() uses cdo and ncdf4 inside, and the performance is impacted by those tools a lot. +Some instances may work with a specific set of module combination but not with another. +Since the incompatibility is not from the R code, it is hard to improve or prevent the failure. +Here are some detected cases that specific versions need to be used. +(1) The 'grid' parameter is a file +- The workable version combination: +CDO/1.9.8-foss-2015a +R/3.6.1-foss-2015a-bare +HDF5/1.8.14-foss-2015a +- The unworkable version combination: +_It returns a warning about HDF5._ +CDO/1.6.3-foss-2015a +R/3.6.1-foss-2015a-bare +HDF5/1.10.5-foss-2015a + + + + + diff --git a/man/CDORemap.Rd b/man/CDORemap.Rd new file mode 100644 index 0000000..aabb434 --- /dev/null +++ b/man/CDORemap.Rd @@ -0,0 +1,232 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CDORemap.R +\name{CDORemap} +\alias{CDORemap} +\title{Interpolates arrays with longitude and latitude dimensions using CDO} +\usage{ +CDORemap( + data_array = NULL, + lons, + lats, + grid, + method, + avoid_writes = TRUE, + crop = TRUE, + force_remap = FALSE, + write_dir = tempdir() +) +} +\arguments{ +\item{data_array}{Multidimensional numeric array to be interpolated. If +provided, it must have at least a longitude and a latitude dimensions, +identified by the array dimension names. The names for these dimensions +must be one of the recognized by s2dverification (can be checked with +\code{s2dverification:::.KnownLonNames()} and +\code{s2dverification:::.KnownLatNames()}).} + +\item{lons}{Numeric vector or array of longitudes of the centers of the grid +cells. Its size must match the size of the longitude/latitude dimensions +of the input array.} + +\item{lats}{Numeric vector or array of latitudes of the centers of the grid +cells. Its size must match the size of the longitude/latitude dimensions +of the input array.} + +\item{grid}{Character string specifying either a name of a target grid +(recognized by CDO; e.g.: 'r256x128', 't106grid') or a path to another +NetCDF file which to read the target grid from (a single grid must be +defined in such file).} + +\item{method}{Character string specifying an interpolation method +(recognized by CDO; e.g.: 'con', 'bil', 'bic', 'dis'). The following +long names are also supported: 'conservative', 'bilinear', 'bicubic' and +'distance-weighted'.} + +\item{avoid_writes}{The step of permutation is needed when the input array +has more than 3 dimensions and none of the longitude or latitude dimensions + in the right-most position (CDO would not accept it without permuting +previously). This step, executed by default when needed, can be avoided +for the price of writing more intermediate files (whis usually is +unconvenient) by setting the parameter \code{avoid_writes = TRUE}.} + +\item{crop}{Whether to crop the data after interpolation with +'cdo sellonlatbox' (TRUE) or to extend interpolated data to the whole +world as CDO does by default (FALSE). If \code{crop = TRUE} then the +longitude and latitude borders which to crop at are taken as the limits of +the cells at the borders ('lons' and 'lats' are perceived as cell centers), +i.e. the resulting array will contain data that covers the same area as +the input array. This is equivalent to specifying \code{crop = 'preserve'}, +i.e. preserving area. If \code{crop = 'tight'} then the borders which to +crop at are taken as the minimum and maximum cell centers in 'lons' and +'lats', i.e. the area covered by the resulting array may be smaller if +interpolating from a coarse grid to a fine grid. The parameter 'crop' also +accepts a numeric vector of custom borders which to crop at: +c(western border, eastern border, southern border, northern border).} + +\item{force_remap}{Whether to force remapping, even if the input data array +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()}).} +} +\value{ +A list with the following components: + \item{'data_array'}{The interpolated data array (if an input array + is provided at all, NULL otherwise).} + \item{'lons'}{The longitudes of the data on the destination grid.} + \item{'lats'}{The latitudes of the data on the destination grid.} +} +\description{ +This function takes as inputs a multidimensional array (optional), a vector +or matrix of longitudes, a vector or matrix of latitudes, a destination grid +specification, and the name of a method to be used to interpolate (one of +those available in the 'remap' utility in CDO). The interpolated array is +returned (if provided) together with the new longitudes and latitudes.\cr\cr +\code{CDORemap()} permutes by default the dimensions of the input array (if +needed), splits it in chunks (CDO can work with data arrays of up to 4 +dimensions), generates a file with the data of each chunk, interpolates it +with CDO, reads it back into R and merges it into a result array. If no +input array is provided, the longitude and latitude vectors will be +transformed only. If the array is already on the desired destination grid, +no transformation is performed (this behvaiour works only for lonlat and +gaussian grids). \cr\cr +Any metadata attached to the input data array, longitudes or latitudes will +be preserved or accordingly modified. +} +\examples{ + \dontrun{ +# Interpolating only vectors of longitudes and latitudes +lon <- seq(0, 360 - 360/50, length.out = 50) +lat <- seq(-90, 90, length.out = 25) +tas2 <- CDORemap(NULL, lon, lat, 't170grid', 'bil', TRUE) + +# Minimal array interpolation +tas <- array(1:50, dim = c(25, 50)) +names(dim(tas)) <- c('lat', 'lon') +lon <- seq(0, 360 - 360/50, length.out = 50) +lat <- seq(-90, 90, length.out = 25) +tas2 <- CDORemap(tas, lon, lat, 't170grid', 'bil', TRUE) + +# Metadata can be attached to the inputs. It will be preserved and +# accordignly modified. +tas <- array(1:50, dim = c(25, 50)) +names(dim(tas)) <- c('lat', 'lon') +lon <- seq(0, 360 - 360/50, length.out = 50) +metadata <- list(lon = list(units = 'degrees_east')) +attr(lon, 'variables') <- metadata +lat <- seq(-90, 90, length.out = 25) +metadata <- list(lat = list(units = 'degrees_north')) +attr(lat, 'variables') <- metadata +metadata <- list(tas = list(dim = list(lat = list(len = 25, + vals = lat), + lon = list(len = 50, + vals = lon) + ))) +attr(tas, 'variables') <- metadata +tas2 <- CDORemap(tas, lon, lat, 't170grid', 'bil', TRUE) + +# Arrays of any number of dimensions in any order can be provided. +num_lats <- 25 +num_lons <- 50 +tas <- array(1:(10*num_lats*10*num_lons*10), + dim = c(10, num_lats, 10, num_lons, 10)) +names(dim(tas)) <- c('a', 'lat', 'b', 'lon', 'c') +lon <- seq(0, 360 - 360/num_lons, length.out = num_lons) +metadata <- list(lon = list(units = 'degrees_east')) +attr(lon, 'variables') <- metadata +lat <- seq(-90, 90, length.out = num_lats) +metadata <- list(lat = list(units = 'degrees_north')) +attr(lat, 'variables') <- metadata +metadata <- list(tas = list(dim = list(a = list(), + lat = list(len = num_lats, + vals = lat), + b = list(), + lon = list(len = num_lons, + vals = lon), + c = list() + ))) +attr(tas, 'variables') <- metadata +tas2 <- CDORemap(tas, lon, lat, 't17grid', 'bil', TRUE) +# The step of permutation can be avoided but more intermediate file writes +# will be performed. +tas2 <- CDORemap(tas, lon, lat, 't17grid', 'bil', FALSE) + +# If the provided array has the longitude or latitude dimension in the +# right-most position, the same number of file writes will be performed, +# even if avoid_wrties = FALSE. +num_lats <- 25 +num_lons <- 50 +tas <- array(1:(10*num_lats*10*num_lons*10), + dim = c(10, num_lats, 10, num_lons)) +names(dim(tas)) <- c('a', 'lat', 'b', 'lon') +lon <- seq(0, 360 - 360/num_lons, length.out = num_lons) +metadata <- list(lon = list(units = 'degrees_east')) +attr(lon, 'variables') <- metadata +lat <- seq(-90, 90, length.out = num_lats) +metadata <- list(lat = list(units = 'degrees_north')) +attr(lat, 'variables') <- metadata +metadata <- list(tas = list(dim = list(a = list(), + lat = list(len = num_lats, + vals = lat), + b = list(), + lon = list(len = num_lons, + vals = lon) + ))) +attr(tas, 'variables') <- metadata +tas2 <- CDORemap(tas, lon, lat, 't17grid', 'bil', TRUE) +tas2 <- CDORemap(tas, lon, lat, 't17grid', 'bil', FALSE) + +# An example of an interpolation from and onto a rectangular regular grid +num_lats <- 25 +num_lons <- 50 +tas <- array(1:(1*num_lats*num_lons), dim = c(num_lats, num_lons)) +names(dim(tas)) <- c('y', 'x') +lon <- array(seq(0, 360 - 360/num_lons, length.out = num_lons), + dim = c(num_lons, num_lats)) +metadata <- list(lon = list(units = 'degrees_east')) +names(dim(lon)) <- c('x', 'y') +attr(lon, 'variables') <- metadata +lat <- t(array(seq(-90, 90, length.out = num_lats), + dim = c(num_lats, num_lons))) +metadata <- list(lat = list(units = 'degrees_north')) +names(dim(lat)) <- c('x', 'y') +attr(lat, 'variables') <- metadata +tas2 <- CDORemap(tas, lon, lat, 'r100x50', 'bil') + +# An example of an interpolation from an irregular grid onto a gaussian grid +num_lats <- 25 +num_lons <- 50 +tas <- array(1:(10*num_lats*10*num_lons*10), + dim = c(10, num_lats, 10, num_lons)) +names(dim(tas)) <- c('a', 'j', 'b', 'i') +lon <- array(seq(0, 360 - 360/num_lons, length.out = num_lons), + dim = c(num_lons, num_lats)) +metadata <- list(lon = list(units = 'degrees_east')) +names(dim(lon)) <- c('i', 'j') +attr(lon, 'variables') <- metadata +lat <- t(array(seq(-90, 90, length.out = num_lats), + dim = c(num_lats, num_lons))) +metadata <- list(lat = list(units = 'degrees_north')) +names(dim(lat)) <- c('i', 'j') +attr(lat, 'variables') <- metadata +tas2 <- CDORemap(tas, lon, lat, 't17grid', 'bil') + +# Again, the dimensions can be in any order +num_lats <- 25 +num_lons <- 50 +tas <- array(1:(10*num_lats*10*num_lons), + dim = c(10, num_lats, 10, num_lons)) +names(dim(tas)) <- c('a', 'j', 'b', 'i') +lon <- array(seq(0, 360 - 360/num_lons, length.out = num_lons), + dim = c(num_lons, num_lats)) +names(dim(lon)) <- c('i', 'j') +lat <- t(array(seq(-90, 90, length.out = num_lats), + dim = c(num_lats, num_lons))) +names(dim(lat)) <- c('i', 'j') +tas2 <- CDORemap(tas, lon, lat, 't17grid', 'bil') +tas2 <- CDORemap(tas, lon, lat, 't17grid', 'bil', FALSE) +# It is ossible to specify an external NetCDF file as target grid reference +tas2 <- CDORemap(tas, lon, lat, 'external_file.nc', 'bil') +} +} -- GitLab From 911bdc204bbc4762b742ffc79d8d5c7a9ad29762 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 17 Mar 2021 13:49:35 +0100 Subject: [PATCH 047/154] Transform Cluster from s2dverification --- NAMESPACE | 3 + R/Cluster.R | 230 ++++++++++++++++++++++++++++++++++ man/Cluster.Rd | 130 +++++++++++++++++++ tests/testthat/test-Cluster.R | 120 ++++++++++++++++++ 4 files changed, 483 insertions(+) create mode 100644 R/Cluster.R create mode 100644 man/Cluster.Rd create mode 100644 tests/testthat/test-Cluster.R diff --git a/NAMESPACE b/NAMESPACE index b12cd82..23ed4ea 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ export(AMV) export(AnimateMap) export(Ano) export(Clim) +export(Cluster) export(ColorBar) export(Composite) export(ConfigAddEntry) @@ -51,6 +52,7 @@ export(Trend) export(clim.colors) export(clim.palette) import(GEOmap) +import(NbClust) import(bigmemory) import(geomapdata) import(graphics) @@ -85,6 +87,7 @@ importFrom(stats,acf) importFrom(stats,anova) importFrom(stats,confint) importFrom(stats,cor) +importFrom(stats,kmeans) importFrom(stats,lm) importFrom(stats,median) importFrom(stats,na.fail) diff --git a/R/Cluster.R b/R/Cluster.R new file mode 100644 index 0000000..5ccce7d --- /dev/null +++ b/R/Cluster.R @@ -0,0 +1,230 @@ +#'K-means Clustering +#' +#'Compute cluster centers and their time series of occurrences, with the +#'K-means clustering method using Euclidean distance, of an array of input data +#'with any number of dimensions that at least contain time_dim. +#'Specifically, it partitions the array along time axis in K groups or clusters +#'in which each space vector/array belongs to (i.e., is a member of) the +#'cluster with the nearest center or centroid. This function relies on the +#'NbClust package (Charrad et al., 2014 JSS). +#' +#'@param data A numeric array with named dimensions that at least have +#' 'time_dim' corresponding to time and the dimensions of 'weights' +#' corresponding to either area-averages over a series of domains or the grid +#' points for any sptial grid structure. +#'@param weights A numeric array with named dimension of multiplicative weights +#' based on the areas covering each domain/region or grid-cell of 'data'. The +#' dimensions must also be part of the 'data' dimensions. +#'@param time_dim A character string indicating the name of time dimension in +#' 'data'. The default value is 'sdate'. +#'@param nclusters A positive integer K that must be bigger than 1 indicating +#' the number of clusters to be computed, or K initial cluster centers to be +#' used in the method. The default is NULL, and users have to specify which +#' index from NbClust and the associated criteria for selecting the optimal +#' number of clusters will be used for K-means clustering of 'data'. +#'@param index A character string of the validity index from NbClust package +#' that can be used to determine optimal K if K is not specified with +#' 'nclusters'. The default value is 'sdindex' (Halkidi et al. 2001, JIIS). +#' Other indices available in NBClust are "kl", "ch", "hartigan", "ccc", +#' "scott", "marriot", "trcovw", "tracew", "friedman", "rubin", "cindex", "db", +#' "silhouette", "duda", "pseudot2", "beale", "ratkowsky", "ball", +#' "ptbiserial", "gap", "frey", "mcclain", "gamma", "gplus", "tau", "dunn", +#' "hubert", "sdindex", and "sdbw".\n +#' One can also use all of them with the option 'alllong' or almost all indices +# except gap, gamma, gplus and tau with 'all', when the optimal number of +#' clusters K is detremined by the majority rule (the maximum of histogram of +#' the results of all indices with finite solutions). Use of some indices on +#' a big and/or unstructured dataset can be computationally intense and/or +#' could lead to numerical singularity. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' +#'@return +#'A list containing: +#'\item{$cluster}{ +#' An integer vector of the occurrence of a cluster along time, i.e., when +#' certain data member in time is allocated to a specific cluster. +#'} +#'\item{$centers}{ +#' A matrix of cluster centres or centroids (e.g. [1:K, 1:spatial degrees of freedom]). +#'} +#'\item{$totss}{ +#' A number of the total sum of squares. +#'} +#'\item{$withinss}{ +#' A vector of within-cluster sum of squares, one component per cluster. +#'} +#'\item{$tot.withinss}{ +#' A number of the total within-cluster sum of squares, i.e., sum(withinss). +#'} +#'\item{$betweenss}{ +#' A number of the between-cluster sum of squares, i.e. totss-tot.withinss. +#'} +#'\item{$size}{ +#' A vector of the number of points in each cluster. +#'} +#'\item{$iter}{ +#' An interger as the number of (outer) iterations. +#'} +#'\item{$ifault}{ +#' An integer as an indicator of a possible algorithm problem. +#'} +#' +#'@references +#'Wilks, 2011, Statistical Methods in the Atmospheric Sciences, 3rd ed., Elsevire, pp 676. +#' +#'@examples +#'# Generating synthetic data +#'a1 <- array(dim = c(200, 4)) +#'mean1 <- 0 +#'sd1 <- 0.3 +#' +#'c0 <- seq(1, 200) +#'c1 <- sort(sample(x = 1:200, size = sample(x = 50:150, size = 1), replace = FALSE)) +#'x1 <- c(1, 1, 1, 1) +#'for (i1 in c1) { +#' a1[i1, ] <- x1 + rnorm(4, mean = mean1, sd = sd1) +#'} +#' +#'c1p5 <- c0[!(c0 %in% c1)] +#'c2 <- c1p5[seq(1, length(c1p5), 2)] +#'x2 <- c(2, 2, 4, 4) +#'for (i2 in c2) { +#' a1[i2, ] <- x2 + rnorm(4, mean = mean1, sd = sd1) +#'} +#' +#'c3 <- c1p5[seq(2, length(c1p5), 2)] +#'x3 <- c(3, 3, 1, 1) +#'for (i3 in c3) { +#' a1[i3, ] <- x3 + rnorm(4, mean = mean1, sd = sd1) +#'} +#' +#'# Computing the clusters +#'res1 <- Cluster(var = a1, weights = array(1, dim = dim(a1)[2]), nclusters = 3) +#'print(res1$cluster) +#'print(res1$centers) +#' +#'res2 <- Cluster(var = a1, weights = array(1, dim = dim(a1)[2])) +#'print(res2$cluster) +#'print(res2$centers) +#' +#'@import NbClust multiApply +#'@importFrom abind abind +#'@importFrom stats kmeans +#'@importFrom grDevices pdf dev.off +#'@export +Cluster <- function(data, weights, time_dim = 'sdate', + nclusters = NULL, index = 'sdindex', 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 (is.null(dim(data))) { #is vector + dim(data) <- c(length(data)) + names(dim(data)) <- time_dim + } + if(any(is.null(names(dim(data))))| any(nchar(names(dim(data))) == 0)) { + stop("Parameter 'data' must have dimension names.") + } + + ## weights + if (is.null(weights)) { + stop("Parameter 'weights' cannot be NULL.") + } + if (!is.numeric(weights)) { + stop("Parameter 'weights' must be a numeric array.") + } + if (is.null(dim(weights))) { #is vector + dim(weights) <- c(length(weights)) + } + if(any(is.null(names(dim(weights))))| any(nchar(names(dim(weights))) == 0)) { + stop("Parameter 'weights' must have dimension names.") + } + if (any(!names(dim(weights)) %in% names(dim(data)) | + !dim(weights) %in% dim(data))) { + stop("Parameter 'weights' must have dimensions that can be found in 'data' dimensions.") + } + + ## 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.") + } + + ## nclusters + if (!is.null(nclusters)) { + if (!is.numeric(nclusters) | length(nclusters) != 1) { + stop("Parameter 'nclusters' must be an integer bigger than 1.") + } else if (nclusters <= 1) { + stop("Parameter 'nclusters' must be an integer bigger than 1.") + } + } + + ## index + if (!is.character(index) | length(index) > 1) { + stop("Parameter 'index' should be a character strings accepted as 'index' by the function NbClust::NbClust.") + } + + ## 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.") + } + } + + ############################### + # Calculate Cluster + + output <- Apply(list(data), + target_dims = c(time_dim, names(dim(weights))), + fun = .Cluster, + weights = weights, nclusters = nclusters, index = index, + ncores = ncores) + + return(output) +} + +.Cluster <- function(data, weights, nclusters = NULL, index = 'sdindex') { + # data: [time, lat, lon] + dat_dim <- dim(data) + + # Reshape data into two dims + dim(data) <- c(dat_dim[1], prod(dat_dim[-1])) + dim(weights) <- prod(dim(weights)) # a vector + + # weights + data_list <- lapply(1:dat_dim[1], + function(x) { data[x, ] * weights }) + data <- do.call(abind::abind, c(data_list, along = 0)) + + if (!is.null(nclusters)) { + kmeans.results <- kmeans(data, centers = nclusters, iter.max = 300, + nstart = 30) + } else { + pdf(file = NULL) + nbclust.results <- NbClust::NbClust(data, distance = 'euclidean', + min.nc = 2, max.nc = 20, + method = 'kmeans', index = index) + dev.off() + + if (index == 'all' || index == 'alllong') { + kmc <- hist(nbclust.results$Best.nc[1, ], breaks = seq(0, 20), + plot = FALSE)$counts + kmc1 <- which(kmc == max(kmc)) + } else { + kmc1 <- nbclust.results$Best.nc[1] + } + + kmeans.results <- kmeans(data, centers = kmc1, iter.max = 300, + nstart = 30) + } + + invisible(kmeans.results) +} diff --git a/man/Cluster.Rd b/man/Cluster.Rd new file mode 100644 index 0000000..2750e6a --- /dev/null +++ b/man/Cluster.Rd @@ -0,0 +1,130 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Cluster.R +\name{Cluster} +\alias{Cluster} +\title{K-means Clustering} +\usage{ +Cluster( + data, + weights, + time_dim = "sdate", + nclusters = NULL, + index = "sdindex", + ncores = NULL +) +} +\arguments{ +\item{data}{A numeric array with named dimensions that at least have +'time_dim' corresponding to time and the dimensions of 'weights' +corresponding to either area-averages over a series of domains or the grid +points for any sptial grid structure.} + +\item{weights}{A numeric array with named dimension of multiplicative weights +based on the areas covering each domain/region or grid-cell of 'data'. The +dimensions must also be part of the 'data' dimensions.} + +\item{time_dim}{A character string indicating the name of time dimension in +'data'. The default value is 'sdate'.} + +\item{nclusters}{A positive integer K that must be bigger than 1 indicating +the number of clusters to be computed, or K initial cluster centers to be +used in the method. The default is NULL, and users have to specify which +index from NbClust and the associated criteria for selecting the optimal +number of clusters will be used for K-means clustering of 'data'.} + +\item{index}{A character string of the validity index from NbClust package +that can be used to determine optimal K if K is not specified with +'nclusters'. The default value is 'sdindex' (Halkidi et al. 2001, JIIS). +Other indices available in NBClust are "kl", "ch", "hartigan", "ccc", +"scott", "marriot", "trcovw", "tracew", "friedman", "rubin", "cindex", "db", +"silhouette", "duda", "pseudot2", "beale", "ratkowsky", "ball", +"ptbiserial", "gap", "frey", "mcclain", "gamma", "gplus", "tau", "dunn", +"hubert", "sdindex", and "sdbw".\n +One can also use all of them with the option 'alllong' or almost all indices +clusters K is detremined by the majority rule (the maximum of histogram of +the results of all indices with finite solutions). Use of some indices on +a big and/or unstructured dataset can be computationally intense and/or +could lead to numerical singularity.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A list containing: +\item{$cluster}{ + An integer vector of the occurrence of a cluster along time, i.e., when + certain data member in time is allocated to a specific cluster. +} +\item{$centers}{ + A matrix of cluster centres or centroids (e.g. [1:K, 1:spatial degrees of freedom]). +} +\item{$totss}{ + A number of the total sum of squares. +} +\item{$withinss}{ + A vector of within-cluster sum of squares, one component per cluster. +} +\item{$tot.withinss}{ + A number of the total within-cluster sum of squares, i.e., sum(withinss). +} +\item{$betweenss}{ + A number of the between-cluster sum of squares, i.e. totss-tot.withinss. +} +\item{$size}{ + A vector of the number of points in each cluster. +} +\item{$iter}{ + An interger as the number of (outer) iterations. +} +\item{$ifault}{ + An integer as an indicator of a possible algorithm problem. +} +} +\description{ +Compute cluster centers and their time series of occurrences, with the +K-means clustering method using Euclidean distance, of an array of input data +with any number of dimensions that at least contain time_dim. +Specifically, it partitions the array along time axis in K groups or clusters +in which each space vector/array belongs to (i.e., is a member of) the +cluster with the nearest center or centroid. This function relies on the +NbClust package (Charrad et al., 2014 JSS). +} +\examples{ +# Generating synthetic data +a1 <- array(dim = c(200, 4)) +mean1 <- 0 +sd1 <- 0.3 + +c0 <- seq(1, 200) +c1 <- sort(sample(x = 1:200, size = sample(x = 50:150, size = 1), replace = FALSE)) +x1 <- c(1, 1, 1, 1) +for (i1 in c1) { + a1[i1, ] <- x1 + rnorm(4, mean = mean1, sd = sd1) +} + +c1p5 <- c0[!(c0 \%in\% c1)] +c2 <- c1p5[seq(1, length(c1p5), 2)] +x2 <- c(2, 2, 4, 4) +for (i2 in c2) { + a1[i2, ] <- x2 + rnorm(4, mean = mean1, sd = sd1) +} + +c3 <- c1p5[seq(2, length(c1p5), 2)] +x3 <- c(3, 3, 1, 1) +for (i3 in c3) { + a1[i3, ] <- x3 + rnorm(4, mean = mean1, sd = sd1) +} + +# Computing the clusters +res1 <- Cluster(var = a1, weights = array(1, dim = dim(a1)[2]), nclusters = 3) +print(res1$cluster) +print(res1$centers) + +res2 <- Cluster(var = a1, weights = array(1, dim = dim(a1)[2])) +print(res2$cluster) +print(res2$centers) + +} +\references{ +Wilks, 2011, Statistical Methods in the Atmospheric Sciences, 3rd ed., Elsevire, pp 676. +} diff --git a/tests/testthat/test-Cluster.R b/tests/testthat/test-Cluster.R new file mode 100644 index 0000000..be44f3f --- /dev/null +++ b/tests/testthat/test-Cluster.R @@ -0,0 +1,120 @@ +context("s2dv::Cluster tests") + +############################################## + # dat1 + set.seed(1) + dat1 <- array(rnorm(100), + dim = c(sdate = 50, space = 2)) + weights1 <- array(c(0.9, 1.1), dim = c(space = 2)) + + # dat2 + set.seed(2) + dat2 <- array(rnorm(300), + dim = c(sdate = 50, lat = 2, lon = 3)) + weights2 <- array(c(0.9, 1.1), dim = c(lat = 2, lon = 3)) + + +############################################## + +test_that("1. Input checks", { + # data + expect_error( + Cluster(c()), + "Parameter 'data' cannot be NULL." + ) + expect_error( + Cluster(c(NA, NA)), + "Parameter 'data' must be a numeric array." + ) + expect_error( + Cluster(array(1:10, dim = c(2, 5))), + "Parameter 'data' must have dimension names." + ) + # weights + expect_error( + Cluster(dat1, weights = c()), + "Parameter 'weights' cannot be NULL." + ) + expect_error( + Cluster(dat1, weights = 'lat'), + "Parameter 'weights' must be a numeric array." + ) + expect_error( + Cluster(dat1, weights = 2), + "Parameter 'weights' must have dimension names." + ) + expect_error( + Cluster(dat1, weights = array(2, dim = c(lat = 2))), + "Parameter 'weights' must have dimensions that can be found in 'data' dimensions." + ) + # time_dim + expect_error( + Cluster(dat1, weights1, time_dim = 'a'), + "Parameter 'time_dim' is not found in 'data' dimension." + ) + expect_error( + Cluster(array(c(1:25), dim = c(dat = 1, time = 5, space = 2)), weights1), + "Parameter 'time_dim' is not found in 'data' dimension." + ) + expect_error( + Cluster(dat1, weights1, time_dim = 2), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + Cluster(dat1, weights1, time_dim = c('a', 'sdate')), + "Parameter 'time_dim' must be a character string." + ) + # nclusters + expect_error( + Cluster(dat1, weights1, ncluster = 1), + "Parameter 'nclusters' must be an integer bigger than 1." + ) + # index + expect_error( + Cluster(dat1, weights1, index = 1), + "Parameter 'index' should be a character strings accepted as 'index' by the function NbClust::NbClust." + ) + # ncores + expect_error( + Cluster(dat1, weights1, ncore = 0), + "Parameter 'ncores' must be a positive integer." + ) +}) + +############################################## +test_that("2. Output checks: dat1", { +# The output is random. Only check dimensions. + expect_equal( + length(Cluster(dat1, weights1)$cluster), + 50 + ) + expect_equal( + dim(Cluster(dat1, weights1)$centers), + c(8, 2) + ) + expect_equal( + dim(Cluster(dat1, weights1, nclusters = 3)$centers), + c(3, 2) + ) + +}) + + +############################################## +test_that("3. Output checks: dat2", { + + expect_equal( + length(Cluster(dat2, weights2)$cluster), + 50 + ) + expect_equal( + dim(Cluster(dat2, weights2)$centers), + c(7, 6) + ) + expect_equal( + dim(Cluster(dat2, weights2, nclusters = 5)$centers), + c(5, 6) + ) + +}) + -- GitLab From 684720af5dc960da1c9193a53cf67e0f1b895225 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 17 Mar 2021 13:53:12 +0100 Subject: [PATCH 048/154] Fix syntax --- R/Cluster.R | 2 +- man/Cluster.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Cluster.R b/R/Cluster.R index 5ccce7d..4e57fbf 100644 --- a/R/Cluster.R +++ b/R/Cluster.R @@ -29,7 +29,7 @@ #' "scott", "marriot", "trcovw", "tracew", "friedman", "rubin", "cindex", "db", #' "silhouette", "duda", "pseudot2", "beale", "ratkowsky", "ball", #' "ptbiserial", "gap", "frey", "mcclain", "gamma", "gplus", "tau", "dunn", -#' "hubert", "sdindex", and "sdbw".\n +#' "hubert", "sdindex", and "sdbw". #' One can also use all of them with the option 'alllong' or almost all indices # except gap, gamma, gplus and tau with 'all', when the optimal number of #' clusters K is detremined by the majority rule (the maximum of histogram of diff --git a/man/Cluster.Rd b/man/Cluster.Rd index 2750e6a..bca9872 100644 --- a/man/Cluster.Rd +++ b/man/Cluster.Rd @@ -39,7 +39,7 @@ Other indices available in NBClust are "kl", "ch", "hartigan", "ccc", "scott", "marriot", "trcovw", "tracew", "friedman", "rubin", "cindex", "db", "silhouette", "duda", "pseudot2", "beale", "ratkowsky", "ball", "ptbiserial", "gap", "frey", "mcclain", "gamma", "gplus", "tau", "dunn", -"hubert", "sdindex", and "sdbw".\n +"hubert", "sdindex", and "sdbw". One can also use all of them with the option 'alllong' or almost all indices clusters K is detremined by the majority rule (the maximum of histogram of the results of all indices with finite solutions). Use of some indices on -- GitLab From f4ae59590c0f6485a93e8584d237b9b3d8de3f5f Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 17 Mar 2021 13:57:01 +0100 Subject: [PATCH 049/154] Fix bad format --- R/Persistence.R | 14 +++++++------- man/Persistence.Rd | 14 +++++++------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/R/Persistence.R b/R/Persistence.R index f569e63..1840927 100644 --- a/R/Persistence.R +++ b/R/Persistence.R @@ -39,32 +39,32 @@ #' #'@return #'A list containing: -#'\item{$persistence} { +#'\item{$persistence}{ #' A numeric array with dimensions 'memb', time (start dates), latitudes and longitudes #' containing the persistence forecast. #'} -#'\item{$persistence.mean} { +#'\item{$persistence.mean}{ #' A numeric array with same dimensions as 'persistence', except the 'memb' dimension #' which is of length 1, containing the ensemble mean persistence forecast. #'} -#'\item{$persistence.predint} { +#'\item{$persistence.predint}{ #' A numeric array with same dimensions as 'persistence', except the 'memb' dimension #' which is of length 1, containing the prediction interval of the persistence forecast. #'} -#'\item{$AR.slope} { +#'\item{$AR.slope}{ #' A numeric array with same dimensions as 'persistence', except the 'memb' dimension #' which is of length 1, containing the slope coefficient of the autoregression. #'} -#'\item{$AR.intercept} { +#'\item{$AR.intercept}{ #' A numeric array with same dimensions as 'persistence', except the 'memb' dimension #' which is of length 1, containing the intercept coefficient of the autoregression. #'} -#'\item{$AR.lowCI} { +#'\item{$AR.lowCI}{ #' A numeric array with same dimensions as 'persistence', except the 'memb' dimension #' which is of length 1, containing the lower value of the confidence interval of the #' autoregression. #'} -#'\item{$AR.highCI} { +#'\item{$AR.highCI}{ #' A numeric array with same dimensions as 'persistence', except the 'memb' dimension #' which is of length 1, containing the upper value of the confidence interval of the #' autoregression. diff --git a/man/Persistence.Rd b/man/Persistence.Rd index 84b8464..b2bd276 100644 --- a/man/Persistence.Rd +++ b/man/Persistence.Rd @@ -64,32 +64,32 @@ computation. The default value is NULL.} } \value{ A list containing: -\item{$persistence} { +\item{$persistence}{ A numeric array with dimensions 'memb', time (start dates), latitudes and longitudes containing the persistence forecast. } -\item{$persistence.mean} { +\item{$persistence.mean}{ A numeric array with same dimensions as 'persistence', except the 'memb' dimension which is of length 1, containing the ensemble mean persistence forecast. } -\item{$persistence.predint} { +\item{$persistence.predint}{ A numeric array with same dimensions as 'persistence', except the 'memb' dimension which is of length 1, containing the prediction interval of the persistence forecast. } -\item{$AR.slope} { +\item{$AR.slope}{ A numeric array with same dimensions as 'persistence', except the 'memb' dimension which is of length 1, containing the slope coefficient of the autoregression. } -\item{$AR.intercept} { +\item{$AR.intercept}{ A numeric array with same dimensions as 'persistence', except the 'memb' dimension which is of length 1, containing the intercept coefficient of the autoregression. } -\item{$AR.lowCI} { +\item{$AR.lowCI}{ A numeric array with same dimensions as 'persistence', except the 'memb' dimension which is of length 1, containing the lower value of the confidence interval of the autoregression. } -\item{$AR.highCI} { +\item{$AR.highCI}{ A numeric array with same dimensions as 'persistence', except the 'memb' dimension which is of length 1, containing the upper value of the confidence interval of the autoregression. -- GitLab From b74b50a759c1f34c1920efdec31adbc67eabc71b Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 17 Mar 2021 14:06:43 +0100 Subject: [PATCH 050/154] Add NbClust --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 30fd237..f8f5567 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,6 +35,7 @@ Imports: stats, plyr, ncdf4, + NbClust, multiApply (>= 2.1.1) Suggests: easyVerification, -- GitLab From 2679bbb364d664041473506b00418474e09d859b Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 17 Mar 2021 14:06:54 +0100 Subject: [PATCH 051/154] Revise example --- R/Cluster.R | 9 ++------- man/Cluster.Rd | 9 ++------- 2 files changed, 4 insertions(+), 14 deletions(-) diff --git a/R/Cluster.R b/R/Cluster.R index 4e57fbf..24f2d86 100644 --- a/R/Cluster.R +++ b/R/Cluster.R @@ -100,13 +100,8 @@ #'} #' #'# Computing the clusters -#'res1 <- Cluster(var = a1, weights = array(1, dim = dim(a1)[2]), nclusters = 3) -#'print(res1$cluster) -#'print(res1$centers) -#' -#'res2 <- Cluster(var = a1, weights = array(1, dim = dim(a1)[2])) -#'print(res2$cluster) -#'print(res2$centers) +#'res1 <- Cluster(data = a1, weights = array(1, dim = dim(a1)[2]), nclusters = 3) +#'res2 <- Cluster(data = a1, weights = array(1, dim = dim(a1)[2])) #' #'@import NbClust multiApply #'@importFrom abind abind diff --git a/man/Cluster.Rd b/man/Cluster.Rd index bca9872..2449137 100644 --- a/man/Cluster.Rd +++ b/man/Cluster.Rd @@ -116,13 +116,8 @@ for (i3 in c3) { } # Computing the clusters -res1 <- Cluster(var = a1, weights = array(1, dim = dim(a1)[2]), nclusters = 3) -print(res1$cluster) -print(res1$centers) - -res2 <- Cluster(var = a1, weights = array(1, dim = dim(a1)[2])) -print(res2$cluster) -print(res2$centers) +res1 <- Cluster(data = a1, weights = array(1, dim = dim(a1)[2]), nclusters = 3) +res2 <- Cluster(data = a1, weights = array(1, dim = dim(a1)[2])) } \references{ -- GitLab From bfa18f5eb3f087599cf123154fe5764a72cb4a72 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 17 Mar 2021 14:13:29 +0100 Subject: [PATCH 052/154] Fix example --- R/Cluster.R | 1 + man/Cluster.Rd | 1 + 2 files changed, 2 insertions(+) diff --git a/R/Cluster.R b/R/Cluster.R index 24f2d86..015b65c 100644 --- a/R/Cluster.R +++ b/R/Cluster.R @@ -100,6 +100,7 @@ #'} #' #'# Computing the clusters +#'names(dim(a1)) <- c('sdate', 'space') #'res1 <- Cluster(data = a1, weights = array(1, dim = dim(a1)[2]), nclusters = 3) #'res2 <- Cluster(data = a1, weights = array(1, dim = dim(a1)[2])) #' diff --git a/man/Cluster.Rd b/man/Cluster.Rd index 2449137..ce0e5ad 100644 --- a/man/Cluster.Rd +++ b/man/Cluster.Rd @@ -116,6 +116,7 @@ for (i3 in c3) { } # Computing the clusters +names(dim(a1)) <- c('sdate', 'space') res1 <- Cluster(data = a1, weights = array(1, dim = dim(a1)[2]), nclusters = 3) res2 <- Cluster(data = a1, weights = array(1, dim = dim(a1)[2])) -- GitLab From af9866b8d152d6abe8fc40e797a92e2b4a2075f2 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 17 Mar 2021 14:44:44 +0100 Subject: [PATCH 053/154] Fix bug regarding apply() --- R/Ano.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Ano.R b/R/Ano.R index f66c60a..e0a69db 100644 --- a/R/Ano.R +++ b/R/Ano.R @@ -93,7 +93,7 @@ if (length(dim(data)) == length(dim(clim))) { res <- data - clim } else { - target_dims_ind <- match(dim(clim), dim(data)) + target_dims_ind <- match(names(dim(clim)), names(dim(data))) margin_dims_ind <- c(1:length(dim(data)))[-target_dims_ind] res <- apply(data, margin_dims_ind, .Ano, clim) res <- array(res, dim = dim(data)[c(target_dims_ind, margin_dims_ind)]) -- GitLab From 800216dc7a502fee73dc9e2a9218c484a2fb5d58 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 18 Mar 2021 14:25:46 +0100 Subject: [PATCH 054/154] Supplement the method explanation for Ano_CrossValid and the explanation for the general named dimension usage in README --- R/Ano_CrossValid.R | 11 ++++++++--- README.md | 21 +++++++++++++++++++++ man/Ano_CrossValid.Rd | 9 +++++++-- 3 files changed, 36 insertions(+), 5 deletions(-) diff --git a/R/Ano_CrossValid.R b/R/Ano_CrossValid.R index f00a267..3cfc424 100644 --- a/R/Ano_CrossValid.R +++ b/R/Ano_CrossValid.R @@ -1,8 +1,13 @@ #'Compute anomalies in cross-validation mode #' #'Compute the anomalies from the arrays of the experimental and observational -#'data output by subtracting the climatologies computed with a cross-validation -#'technique and a per-pair method. +#'data output by subtracting the climatologies computed with a leave-one-out +#'cross validation technique and a per-pair method (Garcia-Serrano and +#'Doblas-Reyes, CD, 2012). +#'Per-pair climatology means that only the start dates covered by the +#'whole experiments/observational datasets will be used. In other words, the +#'startdates which do not all have values along 'dat_dim' dimension of both +#'the 'exp' and 'obs' are excluded when computing the climatologies. #' #'@param exp A named numeric array of experimental data, with at least #' dimensions 'time_dim' and 'dat_dim'. @@ -129,7 +134,7 @@ Ano_CrossValid <- function(exp, obs, time_dim = 'sdate', dat_dim = c('dataset', } #----------------------------------- - # Per-paired method: Remove all sdate if not complete along dat_dim + # Per-paired method: If any sdate along dat_dim is NA, turn all sdate points along dat_dim into NA. pos <- rep(0, length(dat_dim)) # dat_dim: [dataset, member] for (i in 1:length(dat_dim)) { pos[i] <- which(names(dim(obs)) == dat_dim[i]) diff --git a/README.md b/README.md index f9cce38..63b261d 100644 --- a/README.md +++ b/README.md @@ -64,6 +64,27 @@ correlation with reliability indicators such as p-values and confidence interval - **Visualization** module: Plotting functions are also provided to plot the results obtained from any of the modules above. +One important feature of s2dv is the named dimension of the data array. All the +data input of the functions should have names for all the dimensions. It should +not be a problem since the data retrieved by s2dv::Load or startR::Start have +named dimension inherently. Take the sample data in s2dv as an example: +```r +sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), c('observation'), + '19901101', leadtimemin = 1, leadtimemax = 4, + output = 'lonlat', + latmin = 27, latmax = 48, + lonmin = -12, lonmax = 40) +# It returns an object 'sampleData' +dim(sampleData$mod) +dataset member sdate ftime lat lon + 1 3 1 4 2 3 +dim(sampleData$obs) +dataset member sdate ftime lat lon + 1 1 1 4 2 3 +``` +The feature provides security during the analysis, ensuring that the dimensions +under operation are the desired ones. + Contribute ---------- diff --git a/man/Ano_CrossValid.Rd b/man/Ano_CrossValid.Rd index bef1524..e0123d2 100644 --- a/man/Ano_CrossValid.Rd +++ b/man/Ano_CrossValid.Rd @@ -54,8 +54,13 @@ A list of 2: } \description{ Compute the anomalies from the arrays of the experimental and observational -data output by subtracting the climatologies computed with a cross-validation -technique and a per-pair method. +data output by subtracting the climatologies computed with a leave-one-out +cross validation technique and a per-pair method (Garcia-Serrano and +Doblas-Reyes, CD, 2012). +Per-pair climatology means that only the start dates covered by the +whole experiments/observational datasets will be used. In other words, the +startdates which do not all have values along 'dat_dim' dimension of both +the 'exp' and 'obs' are excluded when computing the climatologies. } \examples{ # Load sample data as in Load() example: -- GitLab From 63811c7fb3865b64c7c2a92c1d40f16713045df6 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 18 Mar 2021 16:06:10 +0100 Subject: [PATCH 055/154] Improve documentation of param 'memb'. --- R/Ano_CrossValid.R | 6 +++--- man/Ano_CrossValid.Rd | 5 ++--- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/R/Ano_CrossValid.R b/R/Ano_CrossValid.R index 3cfc424..f625ccc 100644 --- a/R/Ano_CrossValid.R +++ b/R/Ano_CrossValid.R @@ -23,9 +23,9 @@ #'@param memb_dim A character string indicating the name of the member #' dimension. Only used when parameter 'memb' is FALSE. It must be one element #' in 'dat_dim'. The default value is 'member'. -#'@param memb A logical value indicating whether to remain 'memb_dim' dimension -#' (TRUE) or do ensemble mean over 'memb_dim' (FALSE) when calculating -#' climatology. The default value is TRUE. +#'@param memb A logical value indicating whether to subtract the climatology +#' based on the individual members (TRUE) or the ensemble mean over all +# members (FALSE) when calculating the anomalies. The default value is TRUE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' diff --git a/man/Ano_CrossValid.Rd b/man/Ano_CrossValid.Rd index e0123d2..3fe1e60 100644 --- a/man/Ano_CrossValid.Rd +++ b/man/Ano_CrossValid.Rd @@ -34,9 +34,8 @@ along 'dat_dim' will be discarded. The default value is dimension. Only used when parameter 'memb' is FALSE. It must be one element in 'dat_dim'. The default value is 'member'.} -\item{memb}{A logical value indicating whether to remain 'memb_dim' dimension -(TRUE) or do ensemble mean over 'memb_dim' (FALSE) when calculating -climatology. The default value is TRUE.} +\item{memb}{A logical value indicating whether to subtract the climatology +based on the individual members (TRUE) or the ensemble mean over all} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} -- GitLab From 971376ccd69cede9903499fb4cf9c0c47a7ce5da Mon Sep 17 00:00:00 2001 From: Carlos Delgado Date: Tue, 23 Mar 2021 15:29:19 +0100 Subject: [PATCH 056/154] improved documentation --- R/AMV.R | 3 ++- R/GMST.R | 3 ++- R/GSAT.R | 4 +++- R/SPOD.R | 4 +++- R/TPI.R | 4 +++- 5 files changed, 13 insertions(+), 5 deletions(-) diff --git a/R/AMV.R b/R/AMV.R index a0a67c9..a51a819 100644 --- a/R/AMV.R +++ b/R/AMV.R @@ -6,7 +6,8 @@ #'time scales. The AMV index is computed as the difference of weighted-averaged #'SST anomalies over the North Atlantic region (0ºN-60ºN, 280ºE-360ºE) and the #'weighted-averaged SST anomalies over 60ºS-60ºN, 0ºE-360ºE (Trenberth & -#'Dennis, 2005; Doblas-Reyes et al., 2013). +#'Dennis, 2005; Doblas-Reyes et al., 2013). If different members and/or datasets are provided, +#'the climatology (used to calculate the anomalies) is computed individually for all of them. #' #'@param data A numerical array to be used for the index computation with, at least, the #' dimensions: 1) latitude, longitude, start date and forecast month diff --git a/R/GMST.R b/R/GMST.R index 13ceb55..a1d8d85 100644 --- a/R/GMST.R +++ b/R/GMST.R @@ -2,7 +2,8 @@ #' #'The Global Mean Surface Temperature (GMST) anomalies are computed as the #'weighted-averaged surface air temperature anomalies over land and sea surface -#'temperature anomalies over the ocean. +#'temperature anomalies over the ocean. If different members and/or datasets are provided, +#'the climatology (used to calculate the anomalies) is computed individually for all of them. #' #'@param data_tas A numerical array with the surface air temperature data #' to be used for the index computation with, at least, the diff --git a/R/GSAT.R b/R/GSAT.R index 949bfbd..1774bd6 100644 --- a/R/GSAT.R +++ b/R/GSAT.R @@ -1,7 +1,9 @@ #'Compute the Global Surface Air Temperature (GSAT) anomalies #' #'The Global Surface Air Temperature (GSAT) anomalies are computed as the -#'weighted-averaged surface air temperature anomalies over the global region. +#'weighted-averaged surface air temperature anomalies over the global region. +#'If different members and/or datasets are provided, the climatology (used to +#'calculate the anomalies) is computed individually for all of them. #' #'@param data A numerical array to be used for the index computation with, at least, the #' dimensions: 1) latitude, longitude, start date and forecast month diff --git a/R/SPOD.R b/R/SPOD.R index b87ef15..51717b3 100644 --- a/R/SPOD.R +++ b/R/SPOD.R @@ -4,7 +4,9 @@ #'Nino-Southern Oscillation (ENSO) and the Inderdecadal Pacific Oscillation #'(IPO). The SPOD index is computed as the difference of weighted-averaged SST #'anomalies over 20ºS-48ºS, 165ºE-190ºE (NW pole) and the weighted-averaged SST -#' anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). +#'anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). +#'If different members and/or datasets are provided, the climatology (used to +#'calculate the anomalies) is computed individually for all of them. #' #'@param data A numerical array to be used for the index computation with, at least, the #' dimensions: 1) latitude, longitude, start date and forecast month diff --git a/R/TPI.R b/R/TPI.R index 57255b6..80d958e 100644 --- a/R/TPI.R +++ b/R/TPI.R @@ -3,7 +3,9 @@ #'The Tripole Index (TPI) for the Interdecadal Pacific Oscillation (IPO) is #'computed as the difference of weighted-averaged SST anomalies over 10ºS-10ºN, #'170ºE-270ºE minus the mean of the weighted-averaged SST anomalies over -#'25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). +#'25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). +#'If different members and/or datasets are provided, the climatology (used to +#'calculate the anomalies) is computed individually for all of them. #' #'@param data A numerical array to be used for the index computation with, at least, the #' dimensions: 1) latitude, longitude, start date and forecast month -- GitLab From 4144a32a6690fd28ffa18c4f7a130af1d635a06f Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 30 Mar 2021 11:04:19 +0200 Subject: [PATCH 057/154] Update indices function .md file, and revise EOF documentation for params 'weights' and 'mask'. --- R/EOF.R | 16 +++++++++++----- man/AMV.Rd | 29 ++++++++++++++--------------- man/EOF.Rd | 16 +++++++++++----- man/GMST.Rd | 51 ++++++++++++++++++++++++--------------------------- man/GSAT.Rd | 30 +++++++++++++++--------------- man/SPOD.Rd | 30 +++++++++++++++--------------- man/TPI.Rd | 30 +++++++++++++++--------------- 7 files changed, 105 insertions(+), 97 deletions(-) diff --git a/R/EOF.R b/R/EOF.R index c595d4b..f37fa8f 100644 --- a/R/EOF.R +++ b/R/EOF.R @@ -44,17 +44,23 @@ #'} #'\item{mask}{ #' An array of the mask with dimensions (space_dim, rest of the dimension -#' except 'time_dim'). +#' except 'time_dim'). It is made from 'ano', 1 for the positions that 'ano' +#' has value and NA for the positions that 'ano' has NA. It is used to +#' replace NAs with 0s for EOF calculation and mask the result with NAs again +#' after the calculation. #'} #'\item{wght}{ -#' An array of the weights with dimensions (space_dim). +#' An array of the area weighting with dimensions 'space_dim'. It is calculated +#' by cosine of 'lat' and used to compute the fraction of variance explained by +#' each EOFs. #'} #' #'@seealso ProjectField, NAO, PlotBoxWhisker #'@examples -#'# This example computes the EOFs along forecast horizons and plots the one that -#'# explains the greatest amount of variability. The example data is very low -#'# resolution so it does not make a lot of sense. +#'# This example computes the EOFs along forecast horizons and plots the one +#'# that explains the greatest amount of variability. The example data has low +#'# resolution so the result may not be explanatory, but it displays how to +#'# use this function. #'\dontshow{ #'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') #'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), diff --git a/man/AMV.Rd b/man/AMV.Rd index 0f81652..3cc4113 100644 --- a/man/AMV.Rd +++ b/man/AMV.Rd @@ -18,16 +18,15 @@ AMV( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,18 +79,17 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the AMV index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the AMV index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Atlantic Multidecadal Variability (AMV), also known as Atlantic @@ -100,7 +98,8 @@ surface temperatures (SST) over the North Atlantic Ocean on multi-decadal time scales. The AMV index is computed as the difference of weighted-averaged SST anomalies over the North Atlantic region (0ºN-60ºN, 280ºE-360ºE) and the weighted-averaged SST anomalies over 60ºS-60ºN, 0ºE-360ºE (Trenberth & -Dennis, 2005; Doblas-Reyes et al., 2013). +Dennis, 2005; Doblas-Reyes et al., 2013). If different members and/or datasets are provided, +the climatology (used to calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/EOF.Rd b/man/EOF.Rd index 32fd999..b460cd5 100644 --- a/man/EOF.Rd +++ b/man/EOF.Rd @@ -63,10 +63,15 @@ A list containing: } \item{mask}{ An array of the mask with dimensions (space_dim, rest of the dimension - except 'time_dim'). + except 'time_dim'). It is made from 'ano', 1 for the positions that 'ano' + has value and NA for the positions that 'ano' has NA. It is used to + replace NAs with 0s for EOF calculation and mask the result with NAs again + after the calculation. } \item{wght}{ - An array of the weights with dimensions (space_dim). + An array of the area weighting with dimensions 'space_dim'. It is calculated + by cosine of 'lat' and used to compute the fraction of variance explained by + each EOFs. } } \description{ @@ -75,9 +80,10 @@ by default, based on the correlation matrix if \code{corr} argument is set to \code{TRUE}. } \examples{ -# This example computes the EOFs along forecast horizons and plots the one that -# explains the greatest amount of variability. The example data is very low -# resolution so it does not make a lot of sense. +# This example computes the EOFs along forecast horizons and plots the one +# that explains the greatest amount of variability. The example data has low +# resolution so the result may not be explanatory, but it displays how to +# use this function. \dontshow{ startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), diff --git a/man/GMST.Rd b/man/GMST.Rd index 8021943..f23e60d 100644 --- a/man/GMST.Rd +++ b/man/GMST.Rd @@ -21,28 +21,25 @@ GMST( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data_tas}{A numerical array indicating the surface air temperature data -to be used for the index computation with the dimensions: 1) latitude, -longitude, start date, forecast month, and member (in case of decadal -predictions), 2) latitude, longitude, year, month and member (in case of -historical simulations), or 3) latitude, longitude, year and month (in case -of observations or reanalyses). This data has to be provided, at least, -over the whole region needed to compute the index. The dimensions must be -identical to those of data_tos.} - -\item{data_tos}{A numerical array indicating the sea surface temperature data -to be used for the index computation with the dimensions: 1) latitude, -longitude, start date, forecast month, and member (in case of decadal -predictions), 2) latitude, longitude, year, month and member (in case of -historical simulations), or 3) latitude, longitude, year and month (in case -of observations or reanalyses). This data has to be provided, at least, -over the whole region needed to compute the index. The dimensions must be -identical to those of data_tas.} +\item{data_tas}{A numerical array with the surface air temperature data +to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be +provided, at least, over the whole region needed to compute the index. +The dimensions must be identical to thos of data_tos. +#'@param data_tos A numerical array with the sea surface temperature data +to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be +provided, at least, over the whole region needed to compute the index. +The dimensions must be identical to thos of data_tas.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -90,7 +87,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -100,23 +97,23 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the GMST anomalies with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the GMST anomalies with the same dimensions as data_tas except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Global Mean Surface Temperature (GMST) anomalies are computed as the weighted-averaged surface air temperature anomalies over land and sea surface -temperature anomalies over the ocean. +temperature anomalies over the ocean. If different members and/or datasets are provided, +the climatology (used to calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/GSAT.Rd b/man/GSAT.Rd index d7fe3cf..9f03ff2 100644 --- a/man/GSAT.Rd +++ b/man/GSAT.Rd @@ -18,16 +18,15 @@ GSAT( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,22 +79,23 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the GSAT anomalies with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the GSAT anomalies with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Global Surface Air Temperature (GSAT) anomalies are computed as the -weighted-averaged surface air temperature anomalies over the global region. +weighted-averaged surface air temperature anomalies over the global region. +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/SPOD.Rd b/man/SPOD.Rd index 0491739..4c4ed29 100644 --- a/man/SPOD.Rd +++ b/man/SPOD.Rd @@ -18,16 +18,15 @@ SPOD( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,25 +79,26 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the SPOD index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the SPOD index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The South Pacific Ocean Dipole (SPOD) index is related to the El Nino-Southern Oscillation (ENSO) and the Inderdecadal Pacific Oscillation (IPO). The SPOD index is computed as the difference of weighted-averaged SST anomalies over 20ºS-48ºS, 165ºE-190ºE (NW pole) and the weighted-averaged SST -anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). +anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/TPI.Rd b/man/TPI.Rd index 3bdc17c..5e8f716 100644 --- a/man/TPI.Rd +++ b/man/TPI.Rd @@ -18,16 +18,15 @@ TPI( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,24 +79,25 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the TPI index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the TPI index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Tripole Index (TPI) for the Interdecadal Pacific Oscillation (IPO) is computed as the difference of weighted-averaged SST anomalies over 10ºS-10ºN, 170ºE-270ºE minus the mean of the weighted-averaged SST anomalies over -25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). +25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses -- GitLab From 327d6d55401e5b3f65a68947709462f59cd2807c Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 1 Apr 2021 15:14:36 +0200 Subject: [PATCH 058/154] Add Spectrum from s2dverification --- R/Spectrum.R | 72 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 72 insertions(+) create mode 100644 R/Spectrum.R diff --git a/R/Spectrum.R b/R/Spectrum.R new file mode 100644 index 0000000..e99d323 --- /dev/null +++ b/R/Spectrum.R @@ -0,0 +1,72 @@ +#'Estimates Frequency Spectrum +#' +#'This function estimates the frequency spectrum of the data array together +#'with its 95\% and 99\% significance level. The output is provided as an +#'array with dimensions c(number of frequencies, 4). The column contains the +#'frequency values, the power, the 95\% significance level and the 99\% one.\cr +#'The spectrum estimation relies on a R built-in function and the significance +#'levels are estimated by a Monte-Carlo method. +#' +#'@param data A vector or numeric array of which the frequency spectrum is +#' required. If it's a vector, it should be a time series. If it's an array, +#' the dimensions must have at least 'time_dim'. The data is assumed to be +#' evenly spaced in time. +#' +#'@return Frequency spectrum with dimensions c(number of frequencies, 4). The +#' column contains the frequency values, the power, the 95\% significance +#' level and the 99\% one. +#' +#'@examples +#'# Load sample data as in Load() example: +#'example(Load) +#' +#'ensmod <- Mean1Dim(sampleData$mod, 2) +#'for (jstartdate in 1:3) { +#' spectrum <- Spectrum(ensmod[1, jstartdate, ]) +#' for (jlen in 1:dim(spectrum)[1]) { +#' if (spectrum[jlen, 2] > spectrum[jlen, 4]) { +#' ensmod[1, jstartdate, ] <- Filter(ensmod[1, jstartdate, ], +#' spectrum[jlen, 1]) +#' } +#' } +#'} +#' \donttest{ +#'PlotAno(InsertDim(ensmod, 2, 1), sdates = startDates, fileout = +#' 'filtered_ensemble_mean.eps') +#' } +#' +#'@importFrom stats spectrum cor rnorm sd quantile +#'@export +Spectrum <- function(data) { + + data <- data[is.na(data) == FALSE] + ndat <- length(data) + + if (ndat >= 3) { + tmp <- spectrum(data, plot = FALSE) + output <- array(dim = c(length(tmp$spec), 4)) + output[, 1] <- tmp$freq + output[, 2] <- tmp$spec + ntir <- 100 + store <- array(dim = c(ntir, length(tmp$spec))) + for (jt in 1:ntir) { + toto <- mean(data) + alpha1 <- cor(data[2:ndat], data[1:(ndat - 1)]) + for (ind in 2:ndat) { + b <- rnorm(1, mean(data) * (1 - alpha1), sd(data) * sqrt(1 - + alpha1 ^ 2)) + toto <- c(toto, toto[ind - 1] * alpha1 + b) + } + toto2 <- spectrum(toto, plot = FALSE) + store[jt, ] <- toto2$spec + } + for (jx in 1:length(tmp$spec)) { + output[jx, 3] <- quantile(store[, jx], 0.95) + output[jx, 4] <- quantile(store[, jx], 0.99) + } + } else { + output <- NA + } + + output +} -- GitLab From e5bfaaab866d7f7399b2b25f8616fd9c78f6f4b4 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 6 Apr 2021 16:40:55 +0200 Subject: [PATCH 059/154] Revise ProjectField.R to accept 'ano' and 'eof' have different dimensions. --- R/ProjectField.R | 93 +++++++++++++++++++----------- man/ProjectField.Rd | 9 +-- tests/testthat/test-ProjectField.R | 46 ++++++++++----- 3 files changed, 96 insertions(+), 52 deletions(-) diff --git a/R/ProjectField.R b/R/ProjectField.R index 03ad210..3684e23 100644 --- a/R/ProjectField.R +++ b/R/ProjectField.R @@ -6,10 +6,11 @@ #'and returns NA if the whole spatial pattern is NA. #' #'@param ano A numerical array of anomalies with named dimensions. The -#' dimensions must have at least 'time_dim' and 'space_dim'. -#'@param eof A list contains at least 'EOFs' and 'wght', which are both arrays. -#' 'EOFs' has dimensions same as 'ano' except 'EOFs' has 'mode' and 'ano' has -#' time_dim. 'wght' has dimensions space_dim. It can be generated by EOF(). +#' dimensions must have at least 'time_dim' and 'space_dim'. It can be +#' generated by Ano(). +#'@param eof A list that contains at least 'EOFs' and 'wght', which are both +#' arrays. 'EOFs' must have dimensions 'mode' and 'space_dim' at least. +#' 'wght' has dimensions space_dim. It can be generated by EOF(). #'@param time_dim A character string indicating the name of the time dimension #' of 'ano'. The default value is 'sdate'. #'@param space_dim A vector of two character strings. The first is the dimension @@ -55,11 +56,13 @@ #'} #' #'@export -ProjectField <- function(ano, eof, time_dim = 'sdate', - space_dim = c('lat', 'lon'), mode = 1, ncores = NULL) { +ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon'), + mode = 1, ncores = NULL) { + +#oh ok. So the rule of input 'eof' dim is to have [mode, lat, lon] at least. And for input 'ano' dim is [sdate, lat, lon] at least. Is it correct? # Check inputs - ## ano + ## ano (1) if (is.null(ano)) { stop("Parameter 'ano' cannot be NULL.") } @@ -99,32 +102,17 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', if (any(!space_dim %in% names(dim(ano)))) { stop("Parameter 'space_dim' is not found in 'ano' dimension.") } + ## ano (2) + if (!all(space_dim %in% names(dim(ano))) | !time_dim %in% names(dim(ano))) { + stop(paste0("Parameter 'ano' must be an array with dimensions named as ", + "parameter 'space_dim' and 'time_dim'.")) + } ## eof (2) if (!all(space_dim %in% names(dim(eof$EOFs))) | !'mode' %in% names(dim(eof$EOFs))) { stop(paste0("The component 'EOFs' of parameter 'eof' must be an array ", "with dimensions named as parameter 'space_dim' and 'mode'.")) } - # eof$EOFs should have the same dimensions as 'ano' except that ano doesn't have 'mode' and EOFs doesn't have time_dim - common_dim_ano <- dim(ano)[-which(names(dim(ano)) == time_dim)] - common_dim_eofs <- dim(eof$EOFs)[-which(names(dim(eof$EOFs)) == 'mode')] - raise_error <- FALSE - if (length(common_dim_ano) != length(common_dim_eofs)) { - raise_error <- TRUE - } else if (!all(names(common_dim_ano) %in% names(common_dim_eofs)) | - !all(names(common_dim_eofs) %in% names(common_dim_ano))) { - raise_error <- TRUE - } else { - order <- match(names(common_dim_ano), names(common_dim_eofs)) - if (any(common_dim_eofs[order] != common_dim_ano)) { - raise_error <- TRUE - } - } - if (raise_error) { - stop(paste0("The component 'EOFs' of parameter 'eof' must have the ", - "same dimensions as 'ano' except that 'ano' does not have ", - "'mode' and 'EOFs' does not have time_dim.")) - } if (length(dim(eof$wght)) != 2 | !all(names(dim(eof$wght)) %in% space_dim)) { stop(paste0("The component 'wght' of parameter 'eof' must be an array ", "with dimensions named as parameter 'space_dim'.")) @@ -150,13 +138,47 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', # Keep the chosen mode eof_mode <- Subset(eof$EOFs, 'mode', mode, drop = 'selected') - res <- Apply(list(ano, eof_mode, eof$wght), - target_dims = list(c(space_dim, time_dim), - c(space_dim), - c(space_dim)), - output_dims = time_dim, - fun = .ProjectField, - ncores = ncores)$output1 + if (all(names(dim(eof_mode)) %in% space_dim)) { # eof_mode: [lat, lon] + + res <- Apply(list(ano), + target_dims = list(c(space_dim, time_dim)), + output_dims = time_dim, + eof_mode = eof_mode, + wght = eof$wght, + fun = .ProjectField, + ncores = ncores)$output1 + + } else { + if (!all(names(dim(eof_mode)) %in% names(dim(ano)))) { + stop(paste0("The array 'EOF' in parameter 'eof' has dimension not in parameter ", + "'ano'. Check if 'ano' and 'eof' are compatible.")) + } + + common_dim_ano <- dim(ano)[which(names(dim(ano)) %in% names(dim(eof_mode)))] + if (any(sort(common_dim_ano) != sort(dim(eof_mode)))) { + stop(paste0("Found paramter 'ano' and 'EOF' in parameter 'eof' have different ", + "common dimensions. Check if 'ano' and 'eof' are compatible.")) + } + + # Enlarge eof/ano is needed. The margin_dims of Apply() must be consistent + # between ano and eof. + additional_dims <- dim(ano)[-which(names(dim(ano)) %in% names(dim(eof_mode)))] + additional_dims <- additional_dims[-which(names(additional_dims) == time_dim)] + if (length(additional_dims) != 0) { + for (i in 1:length(additional_dims)) { + eof_mode <- InsertDim(eof_mode, posdim = (length(dim(eof_mode)) + 1), + lendim = additional_dims[i], name = names(additional_dims)[i]) + } + } + + res <- Apply(list(ano, eof_mode), + target_dims = list(c(space_dim, time_dim), + c(space_dim)), + output_dims = time_dim, + wght = eof$wght, + fun = .ProjectField, + ncores = ncores)$output1 + } return(res) } @@ -166,6 +188,7 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', # ano: [lat, lon, sdate] # eof_mode: [lat, lon] # wght: [lat, lon] + dim_time <- dim(ano)[3] # Initialization of pc.ver. @@ -173,8 +196,8 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', # Weigths e.1 <- eof_mode * wght - ano <- ano * InsertDim(wght, 3, dim_time) + na <- apply(ano, 3, mean, na.rm = TRUE) # if [lat, lon] all NA, it's NA tmp <- ano * InsertDim(e.1, 3, dim_time) # [lat, lon, sdate] pc.ver <- apply(tmp, 3, sum, na.rm = TRUE) diff --git a/man/ProjectField.Rd b/man/ProjectField.Rd index d2bd9fb..97353ff 100644 --- a/man/ProjectField.Rd +++ b/man/ProjectField.Rd @@ -15,11 +15,12 @@ ProjectField( } \arguments{ \item{ano}{A numerical array of anomalies with named dimensions. The -dimensions must have at least 'time_dim' and 'space_dim'.} +dimensions must have at least 'time_dim' and 'space_dim'. It can be +generated by Ano().} -\item{eof}{A list contains at least 'EOFs' and 'wght', which are both arrays. -'EOFs' has dimensions same as 'ano' except 'EOFs' has 'mode' and 'ano' has - time_dim. 'wght' has dimensions space_dim. It can be generated by EOF().} +\item{eof}{A list that contains at least 'EOFs' and 'wght', which are both +arrays. 'EOFs' must have dimensions 'mode' and 'space_dim' at least. +'wght' has dimensions space_dim. It can be generated by EOF().} \item{time_dim}{A character string indicating the name of the time dimension of 'ano'. The default value is 'sdate'.} diff --git a/tests/testthat/test-ProjectField.R b/tests/testthat/test-ProjectField.R index c306a7a..3cf14d2 100644 --- a/tests/testthat/test-ProjectField.R +++ b/tests/testthat/test-ProjectField.R @@ -25,10 +25,21 @@ context("s2dv::ProjectField tests") # dat4 set.seed(1) - dat4 <- array(rnorm(288), dim = c(dat = 1, memb = 2, sdate = 6, ftime = 3, lat = 4, lon = 2)) + dat4 <- array(rnorm(288*2), dim = c(dat = 2, memb = 2, sdate = 6, ftime = 3, lat = 4, lon = 2)) lat4 <- seq(-10, -30, length.out = 4) lon4 <- c(350, 355) - eof4 <- EOF(dat4, lat4, lon4) + set.seed(2) + tmp <- array(rnorm(144), dim = c(dat = 2, sdate = 6, lat = 4, lon = 2)) + eof4 <- EOF(tmp, lat4, lon4) + + # dat5 + set.seed(1) + dat5 <- array(rnorm(144*3), dim = c(dat = 1, memb = 2, sdate = 6, ftime = 3, lat = 4, lon = 3)) + lat5 <- seq(-10, 10, length.out = 4) + lon5 <- c(0, 5, 10) + set.seed(2) + tmp <- array(rnorm(72), dim = c(sdate = 6, lat = 4, lon = 3)) + eof5 <- EOF(tmp, lat5, lon5) ############################################## test_that("1. Input checks", { @@ -100,14 +111,6 @@ test_that("1. Input checks", { paste0("The component 'EOFs' of parameter 'eof' must be an array ", "with dimensions named as parameter 'space_dim' and 'mode'.") ) - eof_fake <- list(EOFs = array(rnorm(10), dim = c(mode = 1, lat = 6, lon = 3)), - wght = array(rnorm(10), dim = c(lat = 6, lon = 2))) - expect_error( - ProjectField(dat1, eof_fake), - paste0("The component 'EOFs' of parameter 'eof' must have the ", - "same dimensions as 'ano' except that 'ano' does not have ", - "'mode' and 'EOFs' does not have time_dim.") - ) eof_fake <- list(EOFs = array(rnorm(10), dim = c(mode = 1, lat = 6, lon = 2)), wght = array(rnorm(10), dim = c(level = 6, lon = 2))) expect_error( @@ -187,18 +190,35 @@ test_that("4. dat3", { test_that("5. dat4", { expect_equal( dim(ProjectField(dat4, eof4)), - c(sdate = 6, dat = 1, memb = 2, ftime = 3) + c(sdate = 6, dat = 2, memb = 2, ftime = 3) ) expect_equal( mean(ProjectField(dat4, eof4)), - -0.1179755, + 0.078082, tolerance = 0.0001 ) expect_equal( ProjectField(dat4, eof4)[, 1, 2, 2], - c(1.73869255, -2.58156427, 0.05340228, -0.53610350, -3.13985059, 1.58785066), + c(0.28137048, -0.17616154, -0.39155370, 0.08288953, 1.18465521, 0.81850535), tolerance = 0.0001 ) }) ############################################## +test_that("6. dat5", { + expect_equal( + dim(ProjectField(dat5, eof5)), + c(sdate = 6, dat = 1, memb = 2, ftime = 3) + ) + expect_equal( + mean(ProjectField(dat5, eof5)), + 0.0907149, + tolerance = 0.0001 + ) + expect_equal( + ProjectField(dat5, eof5)[, 1, 2, 2], + c(0.60881970, 0.93588392, 0.01982465, 0.82376024, -0.33147699, -1.35488289), + tolerance = 0.0001 + ) + +}) -- GitLab From 34ba71016756478d5e4c6a2264cbd9601bd1ad28 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 6 Apr 2021 19:35:01 +0200 Subject: [PATCH 060/154] Remove comment. --- R/ProjectField.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/ProjectField.R b/R/ProjectField.R index 3684e23..aa30a40 100644 --- a/R/ProjectField.R +++ b/R/ProjectField.R @@ -59,8 +59,6 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon'), mode = 1, ncores = NULL) { -#oh ok. So the rule of input 'eof' dim is to have [mode, lat, lon] at least. And for input 'ano' dim is [sdate, lat, lon] at least. Is it correct? - # Check inputs ## ano (1) if (is.null(ano)) { -- GitLab From 08ba27ce3e14a3627d1ca6d7e2a62812e7310331 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 6 Apr 2021 19:51:40 +0200 Subject: [PATCH 061/154] Improve documentation --- R/Cluster.R | 13 ++++++++----- man/Cluster.Rd | 13 ++++++++----- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/R/Cluster.R b/R/Cluster.R index 015b65c..af0901d 100644 --- a/R/Cluster.R +++ b/R/Cluster.R @@ -5,8 +5,10 @@ #'with any number of dimensions that at least contain time_dim. #'Specifically, it partitions the array along time axis in K groups or clusters #'in which each space vector/array belongs to (i.e., is a member of) the -#'cluster with the nearest center or centroid. This function relies on the -#'NbClust package (Charrad et al., 2014 JSS). +#'cluster with the nearest center or centroid. This function is a wrapper of +#'kmeans() and relies on the NbClust package (Charrad et al., 2014 JSS) to +#'determine the optimal number of clusters used for K-means clustering if it is +#'not provided by users. #' #'@param data A numeric array with named dimensions that at least have #' 'time_dim' corresponding to time and the dimensions of 'weights' @@ -19,9 +21,10 @@ #' 'data'. The default value is 'sdate'. #'@param nclusters A positive integer K that must be bigger than 1 indicating #' the number of clusters to be computed, or K initial cluster centers to be -#' used in the method. The default is NULL, and users have to specify which -#' index from NbClust and the associated criteria for selecting the optimal -#' number of clusters will be used for K-means clustering of 'data'. +#' used in the method. The default value is NULL, which means that the number +#' of clusters will be determined by NbClust(). The parameter 'index' +#' therefore needs to be specified for NbClust() to find the optimal number of +#' clusters to be used for K-means clustering calculation. #'@param index A character string of the validity index from NbClust package #' that can be used to determine optimal K if K is not specified with #' 'nclusters'. The default value is 'sdindex' (Halkidi et al. 2001, JIIS). diff --git a/man/Cluster.Rd b/man/Cluster.Rd index ce0e5ad..5a05c5d 100644 --- a/man/Cluster.Rd +++ b/man/Cluster.Rd @@ -28,9 +28,10 @@ dimensions must also be part of the 'data' dimensions.} \item{nclusters}{A positive integer K that must be bigger than 1 indicating the number of clusters to be computed, or K initial cluster centers to be -used in the method. The default is NULL, and users have to specify which -index from NbClust and the associated criteria for selecting the optimal -number of clusters will be used for K-means clustering of 'data'.} +used in the method. The default value is NULL, which means that the number +of clusters will be determined by NbClust(). The parameter 'index' +therefore needs to be specified for NbClust() to find the optimal number of +clusters to be used for K-means clustering calculation.} \item{index}{A character string of the validity index from NbClust package that can be used to determine optimal K if K is not specified with @@ -86,8 +87,10 @@ K-means clustering method using Euclidean distance, of an array of input data with any number of dimensions that at least contain time_dim. Specifically, it partitions the array along time axis in K groups or clusters in which each space vector/array belongs to (i.e., is a member of) the -cluster with the nearest center or centroid. This function relies on the -NbClust package (Charrad et al., 2014 JSS). +cluster with the nearest center or centroid. This function is a wrapper of +kmeans() and relies on the NbClust package (Charrad et al., 2014 JSS) to +determine the optimal number of clusters used for K-means clustering if it is +not provided by users. } \examples{ # Generating synthetic data -- GitLab From 127814c33ea70eb837f4fccbb22e68061293ce12 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 7 Apr 2021 19:05:34 +0200 Subject: [PATCH 062/154] Set 'weights' default to NULL and add parameter 'space_dim' --- R/Cluster.R | 93 ++++++++++++++++++++++------------- man/Cluster.Rd | 15 ++++-- tests/testthat/test-Cluster.R | 17 +++++-- 3 files changed, 81 insertions(+), 44 deletions(-) diff --git a/R/Cluster.R b/R/Cluster.R index af0901d..36534a2 100644 --- a/R/Cluster.R +++ b/R/Cluster.R @@ -11,14 +11,17 @@ #'not provided by users. #' #'@param data A numeric array with named dimensions that at least have -#' 'time_dim' corresponding to time and the dimensions of 'weights' -#' corresponding to either area-averages over a series of domains or the grid -#' points for any sptial grid structure. +#' 'time_dim' corresponding to time and 'space_dim' (optional) corresponding +#' to either area-averages over a series of domains or the grid points for any +#' sptial grid structure. #'@param weights A numeric array with named dimension of multiplicative weights #' based on the areas covering each domain/region or grid-cell of 'data'. The -#' dimensions must also be part of the 'data' dimensions. +#' dimensions must be equal to the 'space_dim' in 'data'. The default value is +#' NULL which means no weighting is applied. #'@param time_dim A character string indicating the name of time dimension in #' 'data'. The default value is 'sdate'. +#'@param space_dim A character vector indicating the names of spatial dimensions +#' in 'data'. The default value is NULL. #'@param nclusters A positive integer K that must be bigger than 1 indicating #' the number of clusters to be computed, or K initial cluster centers to be #' used in the method. The default value is NULL, which means that the number @@ -112,7 +115,7 @@ #'@importFrom stats kmeans #'@importFrom grDevices pdf dev.off #'@export -Cluster <- function(data, weights, time_dim = 'sdate', +Cluster <- function(data, weights = NULL, time_dim = 'sdate', space_dim = NULL, nclusters = NULL, index = 'sdindex', ncores = NULL) { # Check inputs ## data @@ -131,23 +134,21 @@ Cluster <- function(data, weights, time_dim = 'sdate', } ## weights - if (is.null(weights)) { - stop("Parameter 'weights' cannot be NULL.") - } - if (!is.numeric(weights)) { - stop("Parameter 'weights' must be a numeric array.") - } - if (is.null(dim(weights))) { #is vector - dim(weights) <- c(length(weights)) - } - if(any(is.null(names(dim(weights))))| any(nchar(names(dim(weights))) == 0)) { - stop("Parameter 'weights' must have dimension names.") - } - if (any(!names(dim(weights)) %in% names(dim(data)) | - !dim(weights) %in% dim(data))) { - stop("Parameter 'weights' must have dimensions that can be found in 'data' dimensions.") + if (!is.null(weights)) { + if (!is.numeric(weights)) { + stop("Parameter 'weights' must be a numeric array.") + } + if (is.null(dim(weights))) { #is vector + dim(weights) <- c(length(weights)) + } + if (any(is.null(names(dim(weights))))| any(nchar(names(dim(weights))) == 0)) { + stop("Parameter 'weights' must have dimension names.") + } + if (any(!names(dim(weights)) %in% names(dim(data)) | + !dim(weights) %in% dim(data))) { + stop("Parameter 'weights' must have dimensions that can be found in 'data' dimensions.") + } } - ## time_dim if (!is.character(time_dim) | length(time_dim) > 1) { stop("Parameter 'time_dim' must be a character string.") @@ -155,7 +156,28 @@ Cluster <- function(data, weights, time_dim = 'sdate', if (!time_dim %in% names(dim(data))) { stop("Parameter 'time_dim' is not found in 'data' dimensions.") } - + ## space_dim + if (!is.null(space_dim)) { + if (!is.character(space_dim)) { + stop("Parameter 'space_dim' must be a character vector.") + } + if (any(!space_dim %in% names(dim(data)))) { + stop("Parameter 'space_dim' is not found in 'data' dimensions.") + } + if (!is.null(weights)) { + if (!(length(space_dim) == length(dim(weights)) & all(space_dim %in% names(dim(weights))))) { + stop("Parameter 'weights' must have dimension names the same as 'space_dim'.") + } + if (space_dim != names(dim(weights))) { + space_dim <- names(dim(weights)) + } + } + } + if (is.null(space_dim) & !is.null(weights)) { + space_dim <- names(dim(weights)) + .warning(paste0("Parameter 'weights' is assigned but not 'space_dim'. Define 'space_dim' ", + "by the dimensions of 'weights'.")) + } ## nclusters if (!is.null(nclusters)) { if (!is.numeric(nclusters) | length(nclusters) != 1) { @@ -182,7 +204,7 @@ Cluster <- function(data, weights, time_dim = 'sdate', # Calculate Cluster output <- Apply(list(data), - target_dims = c(time_dim, names(dim(weights))), + target_dims = c(time_dim, space_dim), fun = .Cluster, weights = weights, nclusters = nclusters, index = index, ncores = ncores) @@ -190,18 +212,22 @@ Cluster <- function(data, weights, time_dim = 'sdate', return(output) } -.Cluster <- function(data, weights, nclusters = NULL, index = 'sdindex') { - # data: [time, lat, lon] +.Cluster <- function(data, weights = NULL, nclusters = NULL, index = 'sdindex') { + # data: [time, (lat, lon)] dat_dim <- dim(data) - # Reshape data into two dims - dim(data) <- c(dat_dim[1], prod(dat_dim[-1])) - dim(weights) <- prod(dim(weights)) # a vector - - # weights - data_list <- lapply(1:dat_dim[1], - function(x) { data[x, ] * weights }) - data <- do.call(abind::abind, c(data_list, along = 0)) + if (length(dim(data)) != 1) { + # Reshape data into two dims + dim(data) <- c(dat_dim[1], prod(dat_dim[-1])) + + # weights + if (!is.null(weights)) { + dim(weights) <- prod(dim(weights)) # a vector + data_list <- lapply(1:dat_dim[1], + function(x) { data[x, ] * weights }) + data <- do.call(abind::abind, c(data_list, along = 0)) + } + } if (!is.null(nclusters)) { kmeans.results <- kmeans(data, centers = nclusters, iter.max = 300, @@ -224,6 +250,5 @@ Cluster <- function(data, weights, time_dim = 'sdate', kmeans.results <- kmeans(data, centers = kmc1, iter.max = 300, nstart = 30) } - invisible(kmeans.results) } diff --git a/man/Cluster.Rd b/man/Cluster.Rd index 5a05c5d..0c1f59c 100644 --- a/man/Cluster.Rd +++ b/man/Cluster.Rd @@ -6,8 +6,9 @@ \usage{ Cluster( data, - weights, + weights = NULL, time_dim = "sdate", + space_dim = NULL, nclusters = NULL, index = "sdindex", ncores = NULL @@ -15,17 +16,21 @@ Cluster( } \arguments{ \item{data}{A numeric array with named dimensions that at least have -'time_dim' corresponding to time and the dimensions of 'weights' -corresponding to either area-averages over a series of domains or the grid -points for any sptial grid structure.} +'time_dim' corresponding to time and 'space_dim' (optional) corresponding +to either area-averages over a series of domains or the grid points for any +sptial grid structure.} \item{weights}{A numeric array with named dimension of multiplicative weights based on the areas covering each domain/region or grid-cell of 'data'. The -dimensions must also be part of the 'data' dimensions.} +dimensions must be equal to the 'space_dim' in 'data'. The default value is +NULL which means no weighting is applied.} \item{time_dim}{A character string indicating the name of time dimension in 'data'. The default value is 'sdate'.} +\item{space_dim}{A character vector indicating the names of spatial dimensions +in 'data'. The default value is NULL.} + \item{nclusters}{A positive integer K that must be bigger than 1 indicating the number of clusters to be computed, or K initial cluster centers to be used in the method. The default value is NULL, which means that the number diff --git a/tests/testthat/test-Cluster.R b/tests/testthat/test-Cluster.R index be44f3f..9071cd8 100644 --- a/tests/testthat/test-Cluster.R +++ b/tests/testthat/test-Cluster.R @@ -13,7 +13,6 @@ context("s2dv::Cluster tests") dim = c(sdate = 50, lat = 2, lon = 3)) weights2 <- array(c(0.9, 1.1), dim = c(lat = 2, lon = 3)) - ############################################## test_that("1. Input checks", { @@ -32,10 +31,6 @@ test_that("1. Input checks", { ) # weights expect_error( - Cluster(dat1, weights = c()), - "Parameter 'weights' cannot be NULL." - ) - expect_error( Cluster(dat1, weights = 'lat'), "Parameter 'weights' must be a numeric array." ) @@ -88,6 +83,10 @@ test_that("2. Output checks: dat1", { length(Cluster(dat1, weights1)$cluster), 50 ) + expect_equal( + length(Cluster(dat1)$cluster), + 100 + ) expect_equal( dim(Cluster(dat1, weights1)$centers), c(8, 2) @@ -107,6 +106,14 @@ test_that("3. Output checks: dat2", { length(Cluster(dat2, weights2)$cluster), 50 ) + expect_equal( + length(Cluster(dat2)$cluster), + 300 + ) + expect_equal( + length(Cluster(dat2, space_dim = c('lon', 'lat'))$cluster), + 50 + ) expect_equal( dim(Cluster(dat2, weights2)$centers), c(7, 6) -- GitLab From b503ce0b0550b6bba40c8494838bc0b0b28b19e6 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 7 Apr 2021 20:02:57 +0200 Subject: [PATCH 063/154] Revise the documentation about return values --- R/Cluster.R | 33 +++++++++++++++++++++++---------- man/Cluster.Rd | 33 +++++++++++++++++++++++---------- 2 files changed, 46 insertions(+), 20 deletions(-) diff --git a/R/Cluster.R b/R/Cluster.R index 36534a2..33527ae 100644 --- a/R/Cluster.R +++ b/R/Cluster.R @@ -48,32 +48,45 @@ #'@return #'A list containing: #'\item{$cluster}{ -#' An integer vector of the occurrence of a cluster along time, i.e., when -#' certain data member in time is allocated to a specific cluster. +#' An integer array of the occurrence of a cluster along time, i.e., when +#' certain data member in time is allocated to a specific cluster. The dimensions +#' are same as 'data' without 'space_dim'. #'} #'\item{$centers}{ -#' A matrix of cluster centres or centroids (e.g. [1:K, 1:spatial degrees of freedom]). +#' A nemeric array of cluster centres or centroids (e.g. [1:K, 1:spatial degrees +#' of freedom]). The rest dimensions are same as 'data' except 'time_dim' +#' and 'space_dim'. #'} #'\item{$totss}{ -#' A number of the total sum of squares. +#' A numeric array of the total sum of squares. The dimensions are same as 'data' +#' except 'time_dim' and 'space_dim'. #'} #'\item{$withinss}{ -#' A vector of within-cluster sum of squares, one component per cluster. +#' A numeric array of within-cluster sum of squares, one component per cluster. +#' The first dimenion is the number of cluster, and the rest dimensions are +#' same as 'data' except 'time_dim' and 'space_dim'. #'} #'\item{$tot.withinss}{ -#' A number of the total within-cluster sum of squares, i.e., sum(withinss). +#' A numeric array of the total within-cluster sum of squares, i.e., +#' sum(withinss). The dimensions are same as 'data' except 'time_dim' and +#' 'space_dim'. #'} #'\item{$betweenss}{ -#' A number of the between-cluster sum of squares, i.e. totss-tot.withinss. +#' A numeric array of the between-cluster sum of squares, i.e. totss-tot.withinss. +#' The dimensions are same as 'data' except 'time_dim' and 'space_dim'. #'} #'\item{$size}{ -#' A vector of the number of points in each cluster. +#' A numeric array of the number of points in each cluster. The first dimenion +#' is the number of cluster, and the rest dimensions are same as 'data' except +#' 'time_dim' and 'space_dim'. #'} #'\item{$iter}{ -#' An interger as the number of (outer) iterations. +#' A numeric array of the number of (outer) iterations. The dimensions are +#' same as 'data' except 'time_dim' and 'space_dim'. #'} #'\item{$ifault}{ -#' An integer as an indicator of a possible algorithm problem. +#' A numeric array of an indicator of a possible algorithm problem. The +#' dimensions are same as 'data' except 'time_dim' and 'space_dim'. #'} #' #'@references diff --git a/man/Cluster.Rd b/man/Cluster.Rd index 0c1f59c..7ea25de 100644 --- a/man/Cluster.Rd +++ b/man/Cluster.Rd @@ -58,32 +58,45 @@ computation. The default value is NULL.} \value{ A list containing: \item{$cluster}{ - An integer vector of the occurrence of a cluster along time, i.e., when - certain data member in time is allocated to a specific cluster. + An integer array of the occurrence of a cluster along time, i.e., when + certain data member in time is allocated to a specific cluster. The dimensions + are same as 'data' without 'space_dim'. } \item{$centers}{ - A matrix of cluster centres or centroids (e.g. [1:K, 1:spatial degrees of freedom]). + A nemeric array of cluster centres or centroids (e.g. [1:K, 1:spatial degrees + of freedom]). The rest dimensions are same as 'data' except 'time_dim' + and 'space_dim'. } \item{$totss}{ - A number of the total sum of squares. + A numeric array of the total sum of squares. The dimensions are same as 'data' + except 'time_dim' and 'space_dim'. } \item{$withinss}{ - A vector of within-cluster sum of squares, one component per cluster. + A numeric array of within-cluster sum of squares, one component per cluster. + The first dimenion is the number of cluster, and the rest dimensions are + same as 'data' except 'time_dim' and 'space_dim'. } \item{$tot.withinss}{ - A number of the total within-cluster sum of squares, i.e., sum(withinss). + A numeric array of the total within-cluster sum of squares, i.e., + sum(withinss). The dimensions are same as 'data' except 'time_dim' and + 'space_dim'. } \item{$betweenss}{ - A number of the between-cluster sum of squares, i.e. totss-tot.withinss. + A numeric array of the between-cluster sum of squares, i.e. totss-tot.withinss. + The dimensions are same as 'data' except 'time_dim' and 'space_dim'. } \item{$size}{ - A vector of the number of points in each cluster. + A numeric array of the number of points in each cluster. The first dimenion + is the number of cluster, and the rest dimensions are same as 'data' except + 'time_dim' and 'space_dim'. } \item{$iter}{ - An interger as the number of (outer) iterations. + A numeric array of the number of (outer) iterations. The dimensions are + same as 'data' except 'time_dim' and 'space_dim'. } \item{$ifault}{ - An integer as an indicator of a possible algorithm problem. + A numeric array of an indicator of a possible algorithm problem. The + dimensions are same as 'data' except 'time_dim' and 'space_dim'. } } \description{ -- GitLab From aebdc0a50949c8993da2d9e3e3ec2d2dad88756d Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 8 Apr 2021 17:34:26 +0200 Subject: [PATCH 064/154] Add Spectrum() --- NAMESPACE | 2 + R/Spectrum.R | 93 ++++++++++++++++++++++------- man/Spectrum.Rd | 52 ++++++++++++++++ tests/testthat/test-Spectrum.R | 105 +++++++++++++++++++++++++++++++++ 4 files changed, 230 insertions(+), 22 deletions(-) create mode 100644 man/Spectrum.Rd create mode 100644 tests/testthat/test-Spectrum.R diff --git a/NAMESPACE b/NAMESPACE index b12cd82..341ae3a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -45,6 +45,7 @@ export(Reorder) export(SPOD) export(Season) export(Smoothing) +export(Spectrum) export(TPI) export(ToyModel) export(Trend) @@ -98,5 +99,6 @@ importFrom(stats,qt) importFrom(stats,quantile) importFrom(stats,rnorm) importFrom(stats,sd) +importFrom(stats,spectrum) importFrom(stats,ts) importFrom(stats,window) diff --git a/R/Spectrum.R b/R/Spectrum.R index e99d323..6890536 100644 --- a/R/Spectrum.R +++ b/R/Spectrum.R @@ -1,43 +1,92 @@ -#'Estimates Frequency Spectrum +#'Estimate frequency spectrum #' -#'This function estimates the frequency spectrum of the data array together -#'with its 95\% and 99\% significance level. The output is provided as an -#'array with dimensions c(number of frequencies, 4). The column contains the -#'frequency values, the power, the 95\% significance level and the 99\% one.\cr -#'The spectrum estimation relies on a R built-in function and the significance -#'levels are estimated by a Monte-Carlo method. +#'Estimate the frequency spectrum of the data array together with its 95\% and +#'99\% significance level. The output is provided as an array with dimensions +#"c(number of frequencies, 4). The column contains the frequency values, the +#'power, the 95\% significance level and the 99\% one.\cr +#'The spectrum estimation relies on a R built-in function \code{spectrum()} +#'and the significance levels are estimated by a Monte-Carlo method. #' #'@param data A vector or numeric array of which the frequency spectrum is #' required. If it's a vector, it should be a time series. If it's an array, #' the dimensions must have at least 'time_dim'. The data is assumed to be #' 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 ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. #' -#'@return Frequency spectrum with dimensions c(number of frequencies, 4). The -#' column contains the frequency values, the power, the 95\% significance -#' level and the 99\% one. +#'@return A numeric array of the frequency spectrum with dimensions +#' c( = number of frequencies, stats = 4, the rest of the +#' dimensions of 'data'). The 'stats' dimension contains the frequency values, +#' the power, the 95\% significance level and the 99\% one. #' #'@examples #'# Load sample data as in Load() example: #'example(Load) #' -#'ensmod <- Mean1Dim(sampleData$mod, 2) -#'for (jstartdate in 1:3) { -#' spectrum <- Spectrum(ensmod[1, jstartdate, ]) -#' for (jlen in 1:dim(spectrum)[1]) { -#' if (spectrum[jlen, 2] > spectrum[jlen, 4]) { -#' ensmod[1, jstartdate, ] <- Filter(ensmod[1, jstartdate, ], -#' spectrum[jlen, 1]) +#'ensmod <- MeanDims(sampleData$mod, c(1, 2)) +#'spectrum <- Spectrum(ensmod) +#'for (jsdate in 1:dim(spectrum)['sdate']) { +#' for (jlen in 1:dim(spectrum)['ftime']) { +#' if (spectrum[jlen, 2, jsdate] > spectrum[jlen, 4, jsdate]) { +#' ensmod[jsdate, ] <- Filter(ensmod[jsdate, ], +#' spectrum[jlen, 1, jsdate]) #' } #' } #'} #' \donttest{ -#'PlotAno(InsertDim(ensmod, 2, 1), sdates = startDates, fileout = -#' 'filtered_ensemble_mean.eps') +#'PlotAno(InsertDim(ensmod, 2, 1), sdates = startDates) #' } #' #'@importFrom stats spectrum cor rnorm sd quantile #'@export -Spectrum <- function(data) { +Spectrum <- function(data, time_dim = 'ftime', 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 (is.null(dim(data))) { #is vector + dim(data) <- c(length(data)) + names(dim(data)) <- time_dim + } + 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' dimension.") + } + ## 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.") + } + } + + ############################### + # Calculate Spectrum + + output <- Apply(list(data), + target_dims = time_dim, + fun = .Spectrum, + output_dims = c(time_dim, 'stats'), + ncores = ncores)$output1 + + return(output) +} + +.Spectrum <- function(data) { + # data: [time] data <- data[is.na(data) == FALSE] ndat <- length(data) @@ -67,6 +116,6 @@ Spectrum <- function(data) { } else { output <- NA } - - output + + return(invisible(output)) } diff --git a/man/Spectrum.Rd b/man/Spectrum.Rd new file mode 100644 index 0000000..7f23d40 --- /dev/null +++ b/man/Spectrum.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Spectrum.R +\name{Spectrum} +\alias{Spectrum} +\title{Estimate frequency spectrum} +\usage{ +Spectrum(data, time_dim = "ftime", ncores = NULL) +} +\arguments{ +\item{data}{A vector or numeric array of which the frequency spectrum is +required. If it's a vector, it should be a time series. If it's an array, +the dimensions must have at least 'time_dim'. The data is assumed to be +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{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A numeric array of the frequency spectrum with dimensions + c( = number of frequencies, stats = 4, the rest of the + dimensions of 'data'). The 'stats' dimension contains the frequency values, + the power, the 95\% significance level and the 99\% one. +} +\description{ +Estimate the frequency spectrum of the data array together with its 95\% and +99\% significance level. The output is provided as an array with dimensions +power, the 95\% significance level and the 99\% one.\cr +The spectrum estimation relies on a R built-in function \code{spectrum()} +and the significance levels are estimated by a Monte-Carlo method. +} +\examples{ +# Load sample data as in Load() example: +example(Load) + +ensmod <- MeanDims(sampleData$mod, c(1, 2)) +spectrum <- Spectrum(ensmod) +for (jsdate in 1:dim(spectrum)['sdate']) { + for (jlen in 1:dim(spectrum)['ftime']) { + if (spectrum[jlen, 2, jsdate] > spectrum[jlen, 4, jsdate]) { + ensmod[jsdate, ] <- Filter(ensmod[jsdate, ], + spectrum[jlen, 1, jsdate]) + } + } +} + \donttest{ +PlotAno(InsertDim(ensmod, 2, 1), sdates = startDates) + } + +} diff --git a/tests/testthat/test-Spectrum.R b/tests/testthat/test-Spectrum.R new file mode 100644 index 0000000..0a54101 --- /dev/null +++ b/tests/testthat/test-Spectrum.R @@ -0,0 +1,105 @@ +context("s2dv::Spectrum tests") + +############################################## + # dat1 + set.seed(1) + dat1 <- array(rnorm(10), dim = c(dat = 1, ftime = 5, sdate = 2)) + + # dat2 + set.seed(10) + dat2 <- c(1:10) + rnorm(10) + + # dat3 + dat3 <- dat2 + dat3[2] <- NA +############################################## + +test_that("1. Input checks", { + + # data + expect_error( + Spectrum(c()), + "Parameter 'data' cannot be NULL." + ) + expect_error( + Spectrum(c(NA, NA)), + "Parameter 'data' must be a numeric array." + ) + expect_error( + Spectrum(array(1:10, dim = c(2, 5))), + "Parameter 'data' must have dimension names." + ) + # time_dim + expect_error( + Spectrum(array(c(1:25), dim = c(dat = 1, date = 5, sdate = 5))), + "Parameter 'time_dim' is not found in 'data' dimension." + ) + expect_error( + Spectrum(dat1, time_dim = 2), + "Parameter 'time_dim' must be a character string." + ) + # ncores + expect_error( + Spectrum(dat1, ncore = 3.5), + "Parameter 'ncores' must be a positive integer." + ) +}) + +############################################## +test_that("2. Output checks: dat1", { + + expect_equal( + dim(Spectrum(dat1)), + c(ftime = 2, stats = 4, dat = 1, sdate = 2) + ) + expect_equal( + Spectrum(dat1)[, 1, 1, 2], + c(0.2, 0.4), + tolerance = 0.0001 + ) + expect_equal( + Spectrum(dat1)[, 2, 1, 2], + c(0.89583007, 0.05516983), + tolerance = 0.0001 + ) + +}) + +############################################## +test_that("3. Output checks: dat2", { + + expect_equal( + dim(Spectrum(dat2)), + c(ftime = 5, stats = 4) + ) + expect_equal( + Spectrum(dat2)[, 1], + c(0.1, 0.2, 0.3, 0.4, 0.5), + tolerance = 0.0001 + ) + expect_equal( + Spectrum(dat2)[, 2], + c(0.1767994, 1.0113808, 0.3341372, 0.1807377, 1.0594528), + tolerance = 0.0001 + ) + +}) + +############################################## +test_that("4. Output checks: dat3", { + expect_equal( + dim(Spectrum(dat3)), + c(ftime = 4, stats = 4) + ) + expect_equal( + Spectrum(dat3)[, 1], + c(0.1111111, 0.2222222, 0.3333333, 0.4444444), + tolerance = 0.0001 + ) + expect_equal( + Spectrum(dat3)[, 2], + c(0.7204816, 0.6529411, 0.2605188, 0.7009824), + tolerance = 0.0001 + ) + +}) -- GitLab From 8c5bb47bf6326b745e2b504c5dcb7ab3d47b64de Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 8 Apr 2021 17:34:35 +0200 Subject: [PATCH 065/154] Update doc --- man/AMV.Rd | 29 ++++++++++++++--------------- man/GMST.Rd | 51 ++++++++++++++++++++++++--------------------------- man/GSAT.Rd | 30 +++++++++++++++--------------- man/SPOD.Rd | 30 +++++++++++++++--------------- man/TPI.Rd | 30 +++++++++++++++--------------- 5 files changed, 83 insertions(+), 87 deletions(-) diff --git a/man/AMV.Rd b/man/AMV.Rd index 0f81652..3cc4113 100644 --- a/man/AMV.Rd +++ b/man/AMV.Rd @@ -18,16 +18,15 @@ AMV( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,18 +79,17 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the AMV index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the AMV index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Atlantic Multidecadal Variability (AMV), also known as Atlantic @@ -100,7 +98,8 @@ surface temperatures (SST) over the North Atlantic Ocean on multi-decadal time scales. The AMV index is computed as the difference of weighted-averaged SST anomalies over the North Atlantic region (0ºN-60ºN, 280ºE-360ºE) and the weighted-averaged SST anomalies over 60ºS-60ºN, 0ºE-360ºE (Trenberth & -Dennis, 2005; Doblas-Reyes et al., 2013). +Dennis, 2005; Doblas-Reyes et al., 2013). If different members and/or datasets are provided, +the climatology (used to calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/GMST.Rd b/man/GMST.Rd index 8021943..f23e60d 100644 --- a/man/GMST.Rd +++ b/man/GMST.Rd @@ -21,28 +21,25 @@ GMST( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data_tas}{A numerical array indicating the surface air temperature data -to be used for the index computation with the dimensions: 1) latitude, -longitude, start date, forecast month, and member (in case of decadal -predictions), 2) latitude, longitude, year, month and member (in case of -historical simulations), or 3) latitude, longitude, year and month (in case -of observations or reanalyses). This data has to be provided, at least, -over the whole region needed to compute the index. The dimensions must be -identical to those of data_tos.} - -\item{data_tos}{A numerical array indicating the sea surface temperature data -to be used for the index computation with the dimensions: 1) latitude, -longitude, start date, forecast month, and member (in case of decadal -predictions), 2) latitude, longitude, year, month and member (in case of -historical simulations), or 3) latitude, longitude, year and month (in case -of observations or reanalyses). This data has to be provided, at least, -over the whole region needed to compute the index. The dimensions must be -identical to those of data_tas.} +\item{data_tas}{A numerical array with the surface air temperature data +to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be +provided, at least, over the whole region needed to compute the index. +The dimensions must be identical to thos of data_tos. +#'@param data_tos A numerical array with the sea surface temperature data +to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be +provided, at least, over the whole region needed to compute the index. +The dimensions must be identical to thos of data_tas.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -90,7 +87,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -100,23 +97,23 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the GMST anomalies with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the GMST anomalies with the same dimensions as data_tas except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Global Mean Surface Temperature (GMST) anomalies are computed as the weighted-averaged surface air temperature anomalies over land and sea surface -temperature anomalies over the ocean. +temperature anomalies over the ocean. If different members and/or datasets are provided, +the climatology (used to calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/GSAT.Rd b/man/GSAT.Rd index d7fe3cf..9f03ff2 100644 --- a/man/GSAT.Rd +++ b/man/GSAT.Rd @@ -18,16 +18,15 @@ GSAT( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,22 +79,23 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the GSAT anomalies with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the GSAT anomalies with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Global Surface Air Temperature (GSAT) anomalies are computed as the -weighted-averaged surface air temperature anomalies over the global region. +weighted-averaged surface air temperature anomalies over the global region. +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/SPOD.Rd b/man/SPOD.Rd index 0491739..4c4ed29 100644 --- a/man/SPOD.Rd +++ b/man/SPOD.Rd @@ -18,16 +18,15 @@ SPOD( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,25 +79,26 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the SPOD index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the SPOD index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The South Pacific Ocean Dipole (SPOD) index is related to the El Nino-Southern Oscillation (ENSO) and the Inderdecadal Pacific Oscillation (IPO). The SPOD index is computed as the difference of weighted-averaged SST anomalies over 20ºS-48ºS, 165ºE-190ºE (NW pole) and the weighted-averaged SST -anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). +anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/TPI.Rd b/man/TPI.Rd index 3bdc17c..5e8f716 100644 --- a/man/TPI.Rd +++ b/man/TPI.Rd @@ -18,16 +18,15 @@ TPI( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,24 +79,25 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the TPI index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the TPI index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Tripole Index (TPI) for the Interdecadal Pacific Oscillation (IPO) is computed as the difference of weighted-averaged SST anomalies over 10ºS-10ºN, 170ºE-270ºE minus the mean of the weighted-averaged SST anomalies over -25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). +25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses -- GitLab From e705eafb1984f4473b287bd74ae5fafa7d82c494 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 9 Apr 2021 13:31:23 +0200 Subject: [PATCH 066/154] Add Filter() --- NAMESPACE | 1 + R/Filter.R | 120 +++++++++++++++++++++++++++++++++++ man/Filter.Rd | 51 +++++++++++++++ tests/testthat/test-Filter.R | 101 +++++++++++++++++++++++++++++ 4 files changed, 273 insertions(+) create mode 100644 R/Filter.R create mode 100644 man/Filter.Rd create mode 100644 tests/testthat/test-Filter.R diff --git a/NAMESPACE b/NAMESPACE index 341ae3a..ec36da5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ export(ConfigShowSimilarEntries) export(ConfigShowTable) export(Corr) export(Eno) +export(Filter) export(GMST) export(GSAT) export(Histo2Hindcast) diff --git a/R/Filter.R b/R/Filter.R new file mode 100644 index 0000000..5293d54 --- /dev/null +++ b/R/Filter.R @@ -0,0 +1,120 @@ +#'Filter frequency peaks from an array +#' +#'Filter out the selected frequency from a time series. The filtering is +#'performed by dichotomy, seeking for a frequency around the parameter 'freq' +#'and the phase that maximizes the signal to subtract from the time series. +#'The maximization of the signal to subtract relies on a minimization of the +#'mean square differences between the time series ('data') and the cosine of +#'the specified frequency and phase. +#' +#'@param data A numeric vector or array of the data to be filtered. +#' If it's a vector, it should be a time series. If it's an array, +#' the dimensions must have at least 'time_dim'. +#'@param freq A number of the frequency to filter. +#'@param time_dim A character string indicating the dimension along which to +#' compute the filtering. The default value is 'ftime'. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' +#'@return A numeric vector or array of the filtered data with the dimensions +#' the same as 'data'. +#' +#'@examples +#'# Load sample data as in Load() example: +#'example(Load) +#'ensmod <- MeanDims(sampleData$mod, c(1, 2)) +#'spectrum <- Spectrum(ensmod) +#'for (jsdate in 1:dim(spectrum)['sdate']) { +#' for (jlen in 1:dim(spectrum)['ftime']) { +#' if (spectrum[jlen, 2, jsdate] > spectrum[jlen, 4, jsdate]) { +#' ensmod[jsdate, ] <- Filter(ensmod[jsdate, ], +#' spectrum[jlen, 1, jsdate]) +#' } +#' } +#'} +#' \donttest{ +#'PlotAno(InsertDim(ensmod, 2, 1), sdates = startDates) +#' } +#' +#'@importFrom stats lm +#'@export +Filter <- function(data, freq, time_dim = 'ftime', 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 (is.null(dim(data))) { #is vector + dim(data) <- c(length(data)) + names(dim(data)) <- time_dim + } + if(any(is.null(names(dim(data))))| any(nchar(names(dim(data))) == 0)) { + stop("Parameter 'data' must have dimension names.") + } + ## freq + if (is.null(freq)) { + stop("Parameter 'freq' cannot be NULL.") + } + if (!is.numeric(freq) | length(freq) != 1) { + stop("Parameter 'freq' must be a number.") + } + ## 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' dimension.") + } + ## 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.") + } + } + + ############################### + # Calculate Filter + output <- Apply(list(data), + target_dims = time_dim, + fun = .Filter, + freq = freq, + output_dims = time_dim, + ncores = ncores)$output1 + + return(output) +} + +.Filter <- function(data, freq) { + # data: [ftime] + + fac1 <- 1 + fac2 <- 1 + ndat <- length(data) + ndat2 <- length(which(!is.na(data))) + maxi <- 0 + endphase <- 0 + + for (jfreq in seq(freq - 0.5 / ndat2, freq + 0.5 / ndat2, 0.1 / (ndat2 * fac1))) { + for (phase in seq(0, pi, (pi / (10 * fac2)))) { + xtest <- cos(phase + c(1:ndat) * jfreq * 2 * pi) + test <- lm(data[is.na(data) == FALSE] ~ xtest[ + is.na(data) == FALSE])$fitted.values + if (sum(test ^ 2) > maxi) { + endphase <- phase + endfreq <- jfreq + } + maxi <- max(sum(test ^ 2), maxi) + } + } + xend <- cos(endphase + c(1:ndat) * endfreq * 2 * pi) + data[is.na(data) == FALSE] <- data[is.na(data) == FALSE] - lm( + data[is.na(data) == FALSE] ~ xend[is.na(data) == FALSE] + )$fitted.values + + return(invisible(data)) +} diff --git a/man/Filter.Rd b/man/Filter.Rd new file mode 100644 index 0000000..42f374c --- /dev/null +++ b/man/Filter.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Filter.R +\name{Filter} +\alias{Filter} +\title{Filter frequency peaks from an array} +\usage{ +Filter(data, freq, time_dim = "ftime", ncores = NULL) +} +\arguments{ +\item{data}{A numeric vector or array of the data to be filtered. +If it's a vector, it should be a time series. If it's an array, +the dimensions must have at least 'time_dim'.} + +\item{freq}{A number of the frequency to filter.} + +\item{time_dim}{A character string indicating the dimension along which to +compute the filtering. The default value is 'ftime'.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A numeric vector or array of the filtered data with the dimensions + the same as 'data'. +} +\description{ +Filter out the selected frequency from a time series. The filtering is +performed by dichotomy, seeking for a frequency around the parameter 'freq' +and the phase that maximizes the signal to subtract from the time series. +The maximization of the signal to subtract relies on a minimization of the +mean square differences between the time series ('data') and the cosine of +the specified frequency and phase. +} +\examples{ +# Load sample data as in Load() example: +example(Load) +ensmod <- MeanDims(sampleData$mod, c(1, 2)) +spectrum <- Spectrum(ensmod) +for (jsdate in 1:dim(spectrum)['sdate']) { + for (jlen in 1:dim(spectrum)['ftime']) { + if (spectrum[jlen, 2, jsdate] > spectrum[jlen, 4, jsdate]) { + ensmod[jsdate, ] <- Filter(ensmod[jsdate, ], + spectrum[jlen, 1, jsdate]) + } + } +} + \donttest{ +PlotAno(InsertDim(ensmod, 2, 1), sdates = startDates) + } + +} diff --git a/tests/testthat/test-Filter.R b/tests/testthat/test-Filter.R new file mode 100644 index 0000000..cf271e1 --- /dev/null +++ b/tests/testthat/test-Filter.R @@ -0,0 +1,101 @@ +context("s2dv::Filter tests") + +############################################## + # dat1 + set.seed(1) + dat1 <- array(rnorm(10), dim = c(dat = 1, ftime = 5, sdate = 2)) + freq1 <- 0.015 + # dat2 + set.seed(10) + dat2 <- c(1:10) + rnorm(10) + freq2 <- freq1 + + # dat3 + dat3 <- dat2 + dat3[2] <- NA + freq3 <- freq1 +############################################## + +test_that("1. Input checks", { + + # data + expect_error( + Filter(c()), + "Parameter 'data' cannot be NULL." + ) + expect_error( + Filter(c(NA, NA)), + "Parameter 'data' must be a numeric array." + ) + expect_error( + Filter(array(1:10, dim = c(2, 5))), + "Parameter 'data' must have dimension names." + ) + # freq + expect_error( + Filter(dat1, c()), + "Parameter 'freq' cannot be NULL." + ) + expect_error( + Filter(dat1, c(0.1, 0.2)), + "Parameter 'freq' must be a number." + ) + # time_dim + expect_error( + Filter(array(c(1:25), dim = c(dat = 1, date = 5, sdate = 5)), freq1), + "Parameter 'time_dim' is not found in 'data' dimension." + ) + expect_error( + Filter(dat1, freq1, time_dim = 2), + "Parameter 'time_dim' must be a character string." + ) + # ncores + expect_error( + Filter(dat1, freq1, ncore = 3.5), + "Parameter 'ncores' must be a positive integer." + ) +}) + +############################################## +test_that("2. Output checks: dat1", { + + expect_equal( + dim(Filter(dat1, freq1)), + c(ftime = 5, dat = 1, sdate = 2) + ) + expect_equal( + Filter(dat1, freq1)[, 1, 2], + c(-0.080093110, 0.141328669, -0.105230299, -0.004168101, 0.048162841), + tolerance = 0.0001 + ) + +}) + +############################################## +test_that("3. Output checks: dat2", { + + expect_equal( + dim(Filter(dat2, freq2)), + c(ftime = 10) + ) + expect_equal( + as.vector(Filter(dat2, freq2)[2:5]), + c(0.1215244, -1.0229749, -0.2053940, 0.7375181), + tolerance = 0.0001 + ) + +}) + +############################################## +test_that("4. Output checks: dat3", { + expect_equal( + dim(Filter(dat3, freq3)), + c(ftime = 10) + ) + expect_equal( + as.vector(Filter(dat3, freq3)[2:5]), + c(NA, -0.9414294, -0.1265448, 0.7910344), + tolerance = 0.0001 + ) + +}) -- GitLab From 9d86a39a5376d74c6ba36676077808cc5c8d29ac Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 9 Apr 2021 13:47:26 +0200 Subject: [PATCH 067/154] Correct examples --- R/Filter.R | 8 ++++---- R/Spectrum.R | 9 ++++----- man/Filter.Rd | 8 ++++---- man/Spectrum.Rd | 9 ++++----- 4 files changed, 16 insertions(+), 18 deletions(-) diff --git a/R/Filter.R b/R/Filter.R index 5293d54..77efd11 100644 --- a/R/Filter.R +++ b/R/Filter.R @@ -22,13 +22,13 @@ #'@examples #'# Load sample data as in Load() example: #'example(Load) -#'ensmod <- MeanDims(sampleData$mod, c(1, 2)) +#'ensmod <- MeanDims(sampleData$mod, 2) #'spectrum <- Spectrum(ensmod) +#' #'for (jsdate in 1:dim(spectrum)['sdate']) { #' for (jlen in 1:dim(spectrum)['ftime']) { -#' if (spectrum[jlen, 2, jsdate] > spectrum[jlen, 4, jsdate]) { -#' ensmod[jsdate, ] <- Filter(ensmod[jsdate, ], -#' spectrum[jlen, 1, jsdate]) +#' if (spectrum[jlen, 2, 1, jsdate] > spectrum[jlen, 4, 1, jsdate]) { +#' ensmod[1, jsdate, ] <- Filter(ensmod[1, jsdate, ], spectrum[jlen, 1, 1, jsdate]) #' } #' } #'} diff --git a/R/Spectrum.R b/R/Spectrum.R index 6890536..6cb2113 100644 --- a/R/Spectrum.R +++ b/R/Spectrum.R @@ -24,14 +24,13 @@ #'@examples #'# Load sample data as in Load() example: #'example(Load) -#' -#'ensmod <- MeanDims(sampleData$mod, c(1, 2)) +#'ensmod <- MeanDims(sampleData$mod, 2) #'spectrum <- Spectrum(ensmod) +#' #'for (jsdate in 1:dim(spectrum)['sdate']) { #' for (jlen in 1:dim(spectrum)['ftime']) { -#' if (spectrum[jlen, 2, jsdate] > spectrum[jlen, 4, jsdate]) { -#' ensmod[jsdate, ] <- Filter(ensmod[jsdate, ], -#' spectrum[jlen, 1, jsdate]) +#' if (spectrum[jlen, 2, 1, jsdate] > spectrum[jlen, 4, 1, jsdate]) { +#' ensmod[1, jsdate, ] <- Filter(ensmod[1, jsdate, ], spectrum[jlen, 1, 1, jsdate]) #' } #' } #'} diff --git a/man/Filter.Rd b/man/Filter.Rd index 42f374c..814acf1 100644 --- a/man/Filter.Rd +++ b/man/Filter.Rd @@ -34,13 +34,13 @@ the specified frequency and phase. \examples{ # Load sample data as in Load() example: example(Load) -ensmod <- MeanDims(sampleData$mod, c(1, 2)) +ensmod <- MeanDims(sampleData$mod, 2) spectrum <- Spectrum(ensmod) + for (jsdate in 1:dim(spectrum)['sdate']) { for (jlen in 1:dim(spectrum)['ftime']) { - if (spectrum[jlen, 2, jsdate] > spectrum[jlen, 4, jsdate]) { - ensmod[jsdate, ] <- Filter(ensmod[jsdate, ], - spectrum[jlen, 1, jsdate]) + if (spectrum[jlen, 2, 1, jsdate] > spectrum[jlen, 4, 1, jsdate]) { + ensmod[1, jsdate, ] <- Filter(ensmod[1, jsdate, ], spectrum[jlen, 1, 1, jsdate]) } } } diff --git a/man/Spectrum.Rd b/man/Spectrum.Rd index 7f23d40..d1ebe9e 100644 --- a/man/Spectrum.Rd +++ b/man/Spectrum.Rd @@ -34,14 +34,13 @@ and the significance levels are estimated by a Monte-Carlo method. \examples{ # Load sample data as in Load() example: example(Load) - -ensmod <- MeanDims(sampleData$mod, c(1, 2)) +ensmod <- MeanDims(sampleData$mod, 2) spectrum <- Spectrum(ensmod) + for (jsdate in 1:dim(spectrum)['sdate']) { for (jlen in 1:dim(spectrum)['ftime']) { - if (spectrum[jlen, 2, jsdate] > spectrum[jlen, 4, jsdate]) { - ensmod[jsdate, ] <- Filter(ensmod[jsdate, ], - spectrum[jlen, 1, jsdate]) + if (spectrum[jlen, 2, 1, jsdate] > spectrum[jlen, 4, 1, jsdate]) { + ensmod[1, jsdate, ] <- Filter(ensmod[1, jsdate, ], spectrum[jlen, 1, 1, jsdate]) } } } -- GitLab From 85c8d3bbef0eca53543def5edf492f7c1934b9a0 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 12 Apr 2021 10:14:18 +0200 Subject: [PATCH 068/154] Include BrierScore.R --- R/BrierScore.R | 243 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 243 insertions(+) create mode 100644 R/BrierScore.R diff --git a/R/BrierScore.R b/R/BrierScore.R new file mode 100644 index 0000000..8a9b11a --- /dev/null +++ b/R/BrierScore.R @@ -0,0 +1,243 @@ +#'Compute Brier score and its decomposition and Brier skill score +#' +#'Compute the Brier score (BS) and the components of its standard decompostion +#'as well with the two within-bin components described in Stephenson et al., +#'(2008). It also returns the bias-corrected decomposition of the BS (Ferro and +#'Fricker, 2012). BSS has the climatology as the reference forecast. + +#'.BrierScore provides the same functionality, but taking a matrix of ensemble +#'members (exp) as input. +#' +#'@param obs Vector of binary observations (1 or 0). +#'@param pred Vector of probablistic predictions with values in the range [0,1]. +#'@param thresholds Values used to bin the forecasts. By default the bins are +#' {[0,0.1), [0.1, 0.2), ... [0.9, 1]}. +#'@param exp Matrix of predictions with values in the range [0,1] for the +#' .BrierScore function +#' +#'@return Both BrierScore and .Brier score provide the same outputs: +#'\itemize{ +#' \item{$rel}{standard reliability} +#' \item{$res}{standard resolution} +#' \item{$unc}{standard uncertainty} +#' \item{$bs}{Brier score} +#' \item{$bs_check_res}{rel-res+unc} +#' \item{$bss_res}{res-rel/unc} +#' \item{$gres}{generalized resolution} +#' \item{$bs_check_gres}{rel-gres+unc} +#' \item{$bss_gres}{gres-rel/unc} +#' \item{$rel_bias_corrected}{bias-corrected rel} +#' \item{$gres_bias_corrected}{bias-corrected gres} +#' \item{$unc_bias_corrected}{bias-corrected unc} +#' \item{$bss_bias_corrected}{gres_bias_corrected-rel_bias_corrected/unc_bias_corrected} +#' \item{$nk}{number of forecast in each bin} +#' \item{$fkbar}{average probability of each bin} +#' \item{$okbar}{relative frequency that the observed event occurred} +#' \item{$bins}{bins used} +#' \item{$pred}{values with which the forecasts are verified} +#' \item{$obs}{probability forecasts of the event} +#'} +#' +#'@references +#'Wilks (2006) Statistical Methods in the Atmospheric Sciences.\cr +#'Stephenson et al. (2008). Two extra components in the Brier score decomposition. +#' Weather and Forecasting, 23: 752-757.\cr +#'Ferro and Fricker (2012). A bias-corrected decomposition of the BS. +#' Quarterly Journal of the Royal Meteorological Society, DOI: 10.1002/qj.1924. +#' +#'@examples +#'# Minimalist examples with BrierScore +#'a <- runif(10) +#'b <- round(a) +#'x <- BrierScore(b, a) +#'x$bs - x$bs_check_res +#'x$bs - x$bs_check_gres +#'x$rel_bias_corrected - x$gres_bias_corrected + x$unc_bias_corrected +#' \dontrun{ +#'a <- runif(10) +#'b <- cbind(round(a),round(a)) # matrix containing 2 identical ensemble members... +#'x2 <- BrierScore(a, b) +#' } +#' +#'# Example of BrierScore using UltimateBrier +#'# See ?UltimateBrier for more information +#'example(Load) +#'clim <- Clim(sampleData$mod, sampleData$obs) +#'ano_exp <- Ano(sampleData$mod, clim$clim_exp) +#'ano_obs <- Ano(sampleData$obs, clim$clim_obs) +#'bs <- UltimateBrier(ano_exp, ano_obs, thr = c(1/3, 2/3)) +#' +#' \dontrun{ +#'# Example of .BrierScore with veriApply +#'require(easyVerification) +#'BrierScore2 <- s2dverification:::.BrierScore +#'bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3), posdates = 3, posdim = 2) +#'bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3), posdates = 3, posdim = 2) +#'bs2 <- veriApply("BrierScore2", bins_ano_exp, Mean1Dim(bins_ano_ob,s 3), +#' tdim = 2, ensdim = 3) +#' } +#'@import multiApply +#'@export +BrierScore <- function(obs, pred, thresholds = seq(0, 1, 0.1)) { + if (max(pred) > 1 | min(pred) < 0) { + stop("Predictions outside [0,1] range. Are you certain this is a probability forecast? \n") + } else if (max(obs) != 1 & min(obs) != 0) { + .message("Binary events must be either 0 or 1. Are you certain this is a binary event? ") + } else { + nbins <- length(thresholds) - 1 # Number of bins + n <- length(pred) + bins <- as.list(paste("bin", 1:nbins,sep = "")) + for (i in 1:nbins) { + if (i == nbins) { + bins[[i]] <- list(which(pred >= thresholds[i] & pred <= thresholds[i + 1])) + } else { + bins[[i]] <- list(which(pred >= thresholds[i] & pred < thresholds[i + 1])) + } + } + + fkbar <- okbar <- nk <- array(0, dim = nbins) + for (i in 1:nbins) { + nk[i] <- length(bins[[i]][[1]]) + fkbar[i] <- sum(pred[bins[[i]][[1]]]) / nk[i] + okbar[i] <- sum(obs[bins[[i]][[1]]]) / nk[i] + } + + obar <- sum(obs) / length(obs) + relsum <- ressum <- term1 <- term2 <- 0 + for (i in 1:nbins) { + if (nk[i] > 0) { + relsum <- relsum + nk[i] * (fkbar[i] - okbar[i])^2 + ressum <- ressum + nk[i] * (okbar[i] - obar)^2 + for (j in 1:nk[i]) { + term1 <- term1 + (pred[bins[[i]][[1]][j]] - fkbar[i])^2 + term2 <- term2 + (pred[bins[[i]][[1]][j]] - fkbar[i]) * (obs[bins[[i]][[1]][j]] - okbar[i]) + } + } + } + rel <- relsum / n + res <- ressum / n + unc <- obar * (1 - obar) + bs <- sum((pred - obs)^2) / n + bs_check_res <- rel - res + unc + bss_res <- (res - rel) / unc + gres <- res - term1 * (1 / n) + term2 * (2 / n) # Generalized resolution + bs_check_gres <- rel - gres + unc # BS using GRES + bss_gres <- (gres - rel) / unc # BSS using GRES + + # + # Estimating the bias-corrected components of the BS + # + term3 <- array(0, nbins) + for (i in 1:nbins) { + term3[i] <- (nk[i] / (nk[i] - 1)) * okbar[i] * (1 - okbar[i]) + } + term_a <- sum(term3, na.rm = T) / n + term_b <- (obar * (1 - obar)) / (n - 1) + rel_bias_corrected <- rel - term_a + gres_bias_corrected <- gres - term_a + term_b + if (rel_bias_corrected < 0 || gres_bias_corrected < 0) { + rel_bias_corrected2 <- max(rel_bias_corrected, rel_bias_corrected - gres_bias_corrected, 0) + gres_bias_corrected2 <- max(gres_bias_corrected, gres_bias_corrected - rel_bias_corrected, 0) + rel_bias_corrected <- rel_bias_corrected2 + gres_bias_corrected <- gres_bias_corrected2 + } + unc_bias_corrected <- unc + term_b + bss_bias_corrected <- (gres_bias_corrected - rel_bias_corrected) / unc_bias_corrected + + #if (round(bs, 8) == round(bs_check_gres, 8) & round(bs_check_gres, 8) == round((rel_bias_corrected - gres_bias_corrected + unc_bias_corrected), 8)) { + # cat("No error found \ n") + # cat("BS = REL - GRES + UNC = REL_lessbias - GRES_lessbias + UNC_lessbias \ n") + #} + + invisible(list(rel = rel, res = res, unc = unc, bs = bs, bs_check_res = bs_check_res, bss_res = bss_res, gres = gres, bs_check_gres = bs_check_gres, bss_gres = bss_gres, rel_bias_corrected = rel_bias_corrected, gres_bias_corrected = gres_bias_corrected, unc_bias_corrected = unc_bias_corrected, bss_bias_corrected = bss_bias_corrected, nk = nk, fkbar = fkbar, okbar = okbar, bins = bins, pred = pred, obs = obs)) + } +} + +#'@rdname BrierScore +#'@export +.BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1)) { + if (max(exp) > 1 || min(exp) < 0) { + stop("Parameter 'exp' contains predictions outside [0,1] range. Are you certain this is a probability forecast?") + } else if (max(obs) != 1 && min(obs) != 0) { + .message("Binary events in 'obs' must be either 0 or 1. Are you certain this is a binary event?") + } else { + nbins <- length(thresholds) - 1 # Number of bins + n <- dim(exp)[1] # Number of observations + ens_mean <- rowMeans(exp, na.rm = TRUE) + n.ens <- seq(1, dim(exp)[2], 1) # Number of ensemble members + bins <- as.list(paste("bin", 1:nbins, sep = "")) + for (i in 1:nbins) { + if (i == nbins) { + bins[[i]] <- list(which(ens_mean >= thresholds[i] & ens_mean <= thresholds[i + 1])) + } else { + bins[[i]] <- list(which(ens_mean >= thresholds[i] & ens_mean < thresholds[i + 1])) + } + } + + fkbar <- okbar <- nk <- array(0, dim = nbins) + for (i in 1:nbins) { + nk[i] <- length(bins[[i]][[1]]) + fkbar[i] <- sum(ens_mean[bins[[i]][[1]]]) / nk[i] + okbar[i] <- sum(obs[bins[[i]][[1]]]) / nk[i] + } + + fkbar[fkbar == Inf] <- 0 + okbar[is.nan(okbar)] <- 0 + obar <- sum(obs) / length(obs) + relsum <- ressum <- relsum1 <- ressum1 <- term1 <- term1a <- term2 <- term2a <- 0 + + for (i in 1:nbins) { + if (nk[i] > 0) { + relsum <- relsum + nk[i] * (fkbar[i] - okbar[i]) ^ 2 + ressum <- ressum + nk[i] * (okbar[i] - obar) ^ 2 + for (j in 1:nk[i]) { + term1 <- term1 + (ens_mean[bins[[i]][[1]][j]] - fkbar[i]) ^ 2 + term2 <- term2 + (ens_mean[bins[[i]][[1]][j]] - fkbar[i]) * (obs[bins[[i]][[1]][j]] - okbar[i]) + } + } + } + } + rel <- relsum / n + res <- ressum / n + unc <- obar * (1 - obar) + #bs <- apply(ens, MARGIN = 2, FUN = function(x) sum((x - obs)^2) / n) + bs <- sum((rowMeans(exp, na.rm = T) - obs) ^ 2) / n + bs_check_res <- rel - res + unc + bss_res <- (res - rel) / unc + gres <- res - term1 * (1 / n) + term2 * (2 / n) # Generalized resolution + bs_check_gres <- rel - gres + unc # BS using GRES + bss_gres <- (gres - rel) / unc # BSS using GRES + + # + # Estimating the bias-corrected components of the BS + # + term3 <- array(0, nbins) + for (i in 1:nbins) { + term3[i] <- (nk[i] / (nk[i] - 1)) * okbar[i] * (1 - okbar[i]) + } + term_a <- sum(term3, na.rm = T) / n + term_b <- (obar * (1 - obar)) / (n - 1) + rel_bias_corrected <- rel - term_a + gres_bias_corrected <- gres - term_a + term_b + if (rel_bias_corrected < 0 || gres_bias_corrected < 0) { + rel_bias_corrected2 <- max(rel_bias_corrected, rel_bias_corrected - gres_bias_corrected, 0) + gres_bias_corrected2 <- max(gres_bias_corrected, gres_bias_corrected - rel_bias_corrected, 0) + rel_bias_corrected <- rel_bias_corrected2 + gres_bias_corrected <- gres_bias_corrected2 + } + unc_bias_corrected <- unc + term_b + bss_bias_corrected <- (gres_bias_corrected - rel_bias_corrected) / unc_bias_corrected + + #if (round(bs, 8) == round(bs_check_gres, 8) & round(bs_check_gres, 8) == round((rel_bias_corrected - gres_bias_corrected + unc_bias_corrected), 8)) { + # cat("No error found \ n") + # cat("BS = REL - GRES + UNC = REL_lessbias - GRES_lessbias + UNC_lessbias \ n") + #} + + invisible(list(rel = rel, res = res, unc = unc, bs = bs, + bs_check_res = bs_check_res, bss_res = bss_res, gres = gres, + bs_check_gres = bs_check_gres, bss_gres = bss_gres, + rel_bias_corrected = rel_bias_corrected, + gres_bias_corrected = gres_bias_corrected, + unc_bias_corrected = unc_bias_corrected, + bss_bias_corrected = bss_bias_corrected)) +} -- GitLab From 8313fc08abdd459a7b5eaf791444a9bcd432ee28 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 12 Apr 2021 10:17:58 +0200 Subject: [PATCH 069/154] Add @import multiApply --- R/ProjectField.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/ProjectField.R b/R/ProjectField.R index aa30a40..2e9d26f 100644 --- a/R/ProjectField.R +++ b/R/ProjectField.R @@ -55,6 +55,7 @@ #' } #'} #' +#'@import multiApply #'@export ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon'), mode = 1, ncores = NULL) { -- GitLab From 2fa6de5c0bea630c1a32fae49995ee855310dc1d Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 12 Apr 2021 10:19:20 +0200 Subject: [PATCH 070/154] Add @import multiApply --- R/Filter.R | 1 + R/Spectrum.R | 1 + 2 files changed, 2 insertions(+) diff --git a/R/Filter.R b/R/Filter.R index 77efd11..94472a2 100644 --- a/R/Filter.R +++ b/R/Filter.R @@ -36,6 +36,7 @@ #'PlotAno(InsertDim(ensmod, 2, 1), sdates = startDates) #' } #' +#'@import multiApply #'@importFrom stats lm #'@export Filter <- function(data, freq, time_dim = 'ftime', ncores = NULL) { diff --git a/R/Spectrum.R b/R/Spectrum.R index 6cb2113..019b421 100644 --- a/R/Spectrum.R +++ b/R/Spectrum.R @@ -38,6 +38,7 @@ #'PlotAno(InsertDim(ensmod, 2, 1), sdates = startDates) #' } #' +#'@import multiApply #'@importFrom stats spectrum cor rnorm sd quantile #'@export Spectrum <- function(data, time_dim = 'ftime', ncores = NULL) { -- GitLab From 5eff14bc8f78ecd36d8b0270025165c6a2c9e431 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 12 Apr 2021 20:13:00 +0200 Subject: [PATCH 071/154] Modify BrierScore() and create unit test --- NAMESPACE | 1 + R/BrierScore.R | 354 ++++++++++++++++--------------- man/AMV.Rd | 29 ++- man/BrierScore.Rd | 89 ++++++++ man/GMST.Rd | 51 +++-- man/GSAT.Rd | 30 +-- man/SPOD.Rd | 30 +-- man/TPI.Rd | 30 +-- tests/testthat/test-BrierScore.R | 169 +++++++++++++++ 9 files changed, 521 insertions(+), 262 deletions(-) create mode 100644 man/BrierScore.Rd create mode 100644 tests/testthat/test-BrierScore.R diff --git a/NAMESPACE b/NAMESPACE index 87937e2..0e54899 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,7 @@ export(ACC) export(AMV) export(AnimateMap) export(Ano) +export(BrierScore) export(CDORemap) export(Clim) export(Cluster) diff --git a/R/BrierScore.R b/R/BrierScore.R index 8a9b11a..bf456a5 100644 --- a/R/BrierScore.R +++ b/R/BrierScore.R @@ -4,39 +4,45 @@ #'as well with the two within-bin components described in Stephenson et al., #'(2008). It also returns the bias-corrected decomposition of the BS (Ferro and #'Fricker, 2012). BSS has the climatology as the reference forecast. - -#'.BrierScore provides the same functionality, but taking a matrix of ensemble -#'members (exp) as input. #' -#'@param obs Vector of binary observations (1 or 0). -#'@param pred Vector of probablistic predictions with values in the range [0,1]. -#'@param thresholds Values used to bin the forecasts. By default the bins are -#' {[0,0.1), [0.1, 0.2), ... [0.9, 1]}. -#'@param exp Matrix of predictions with values in the range [0,1] for the -#' .BrierScore function +#'@param exp A vector or a numeric array with named dimensions of the probablistic +#' prediction data. The dimension must at least have 'time_dim'. It may have +#' 'memb_dim' for performing ensemble mean. The values should be within the +#' range [0, 1]. +#'@param obs A numeric array with named dimensions of the binary observations +#' (0 or 1). The dimension must at least have 'time_dim' and other dimensions +#' of 'exp' except 'memb_dim'. +#'@param thresholds A numeric vector used to bin the forecasts. The default +#' value is \code{seq(0, 1, 0,1)}, which means that the bins are +#' \code{[0,0.1), [0.1, 0.2), ... [0.9, 1]}. +#'@param time_dim A character string indicating the name of dimension along +#' which Brier score is computed. The default value is 'sdate'. +#'@param memb_dim A character string of the name of the member dimension. It +#' must be one dimension of 'exp'. The function will do the ensemble mean +#' over this dimension. If there is no member dimension, set NULL. The default +#' value is NULL. #' -#'@return Both BrierScore and .Brier score provide the same outputs: -#'\itemize{ -#' \item{$rel}{standard reliability} -#' \item{$res}{standard resolution} -#' \item{$unc}{standard uncertainty} -#' \item{$bs}{Brier score} -#' \item{$bs_check_res}{rel-res+unc} -#' \item{$bss_res}{res-rel/unc} -#' \item{$gres}{generalized resolution} -#' \item{$bs_check_gres}{rel-gres+unc} -#' \item{$bss_gres}{gres-rel/unc} -#' \item{$rel_bias_corrected}{bias-corrected rel} -#' \item{$gres_bias_corrected}{bias-corrected gres} -#' \item{$unc_bias_corrected}{bias-corrected unc} -#' \item{$bss_bias_corrected}{gres_bias_corrected-rel_bias_corrected/unc_bias_corrected} -#' \item{$nk}{number of forecast in each bin} -#' \item{$fkbar}{average probability of each bin} -#' \item{$okbar}{relative frequency that the observed event occurred} -#' \item{$bins}{bins used} -#' \item{$pred}{values with which the forecasts are verified} -#' \item{$obs}{probability forecasts of the event} -#'} +#'@return A list that contains: +#'The numeric arrays with all 'exp' and 'obs' dimensions expect 'time_dim' and +#''memb_dim': +#'\item{$rel}{standard reliability} +#'\item{$res}{standard resolution} +#'\item{$unc}{standard uncertainty} +#'\item{$bs}{Brier score} +#'\item{$bs_check_res}{rel - res + unc} +#'\item{$bss_res}{res - rel / unc} +#'\item{$gres}{generalized resolution} +#'\item{$bs_check_gres}{rel - gres + unc} +#'\item{$bss_gres}{gres - rel / unc} +#'\item{$rel_bias_corrected}{bias - corrected rel} +#'\item{$gres_bias_corrected}{bias - corrected gres} +#'\item{$unc_bias_corrected}{bias - corrected unc} +#'\item{$bss_bias_corrected}{gres_bias_corrected - rel_bias_corrected / unc_bias_corrected} +#'The numeric arrays with the same dimensions as above and one additional +#'dimension 'bin': +#'\item{$nk}{number of forecast in each bin} +#'\item{$fkbar}{average probability of each bin} +#'\item{$okbar}{relative frequency that the observed event occurred} #' #'@references #'Wilks (2006) Statistical Methods in the Atmospheric Sciences.\cr @@ -46,171 +52,162 @@ #' Quarterly Journal of the Royal Meteorological Society, DOI: 10.1002/qj.1924. #' #'@examples -#'# Minimalist examples with BrierScore -#'a <- runif(10) -#'b <- round(a) -#'x <- BrierScore(b, a) -#'x$bs - x$bs_check_res -#'x$bs - x$bs_check_gres -#'x$rel_bias_corrected - x$gres_bias_corrected + x$unc_bias_corrected -#' \dontrun{ -#'a <- runif(10) -#'b <- cbind(round(a),round(a)) # matrix containing 2 identical ensemble members... -#'x2 <- BrierScore(a, b) -#' } +#'# Inputs are vectors +#'exp <- runif(10) +#'obs <- round(a) +#'x <- BrierScore(exp, obs) +#'res <- x$bs - x$bs_check_res +#'res <- x$bs - x$bs_check_gres +#'res <- x$rel_bias_corrected - x$gres_bias_corrected + x$unc_bias_corrected #' -#'# Example of BrierScore using UltimateBrier -#'# See ?UltimateBrier for more information +#'# Inputs are arrays #'example(Load) -#'clim <- Clim(sampleData$mod, sampleData$obs) -#'ano_exp <- Ano(sampleData$mod, clim$clim_exp) -#'ano_obs <- Ano(sampleData$obs, clim$clim_obs) -#'bs <- UltimateBrier(ano_exp, ano_obs, thr = c(1/3, 2/3)) -#' -#' \dontrun{ -#'# Example of .BrierScore with veriApply -#'require(easyVerification) -#'BrierScore2 <- s2dverification:::.BrierScore #'bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3), posdates = 3, posdim = 2) #'bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3), posdates = 3, posdim = 2) -#'bs2 <- veriApply("BrierScore2", bins_ano_exp, Mean1Dim(bins_ano_ob,s 3), -#' tdim = 2, ensdim = 3) -#' } +#'res <- BrierScore(bins_ano_exp, MeanDims(bins_ano_obs, 'member'), memb_dim = 'member') +#' #'@import multiApply #'@export -BrierScore <- function(obs, pred, thresholds = seq(0, 1, 0.1)) { - if (max(pred) > 1 | min(pred) < 0) { - stop("Predictions outside [0,1] range. Are you certain this is a probability forecast? \n") - } else if (max(obs) != 1 & min(obs) != 0) { - .message("Binary events must be either 0 or 1. Are you certain this is a binary event? ") - } else { - nbins <- length(thresholds) - 1 # Number of bins - n <- length(pred) - bins <- as.list(paste("bin", 1:nbins,sep = "")) - for (i in 1:nbins) { - if (i == nbins) { - bins[[i]] <- list(which(pred >= thresholds[i] & pred <= thresholds[i + 1])) - } else { - bins[[i]] <- list(which(pred >= thresholds[i] & pred < thresholds[i + 1])) - } - } - - fkbar <- okbar <- nk <- array(0, dim = nbins) - for (i in 1:nbins) { - nk[i] <- length(bins[[i]][[1]]) - fkbar[i] <- sum(pred[bins[[i]][[1]]]) / nk[i] - okbar[i] <- sum(obs[bins[[i]][[1]]]) / nk[i] - } - - obar <- sum(obs) / length(obs) - relsum <- ressum <- term1 <- term2 <- 0 - for (i in 1:nbins) { - if (nk[i] > 0) { - relsum <- relsum + nk[i] * (fkbar[i] - okbar[i])^2 - ressum <- ressum + nk[i] * (okbar[i] - obar)^2 - for (j in 1:nk[i]) { - term1 <- term1 + (pred[bins[[i]][[1]][j]] - fkbar[i])^2 - term2 <- term2 + (pred[bins[[i]][[1]][j]] - fkbar[i]) * (obs[bins[[i]][[1]][j]] - okbar[i]) - } - } +BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate', + memb_dim = NULL, ncores = NULL) { + + # Check inputs + ## exp and obs + 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 vector or a numeric array.") + } + if (is.null(dim(exp))) { #is vector + dim(exp) <- c(length(exp)) + names(dim(exp)) <- time_dim + } + if (is.null(dim(obs))) { #is vector + dim(obs) <- c(length(obs)) + names(dim(obs)) <- 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)) { + stop("Parameter 'exp' and 'obs' must have dimension names.") + } + if (max(exp) > 1 | min(exp) < 0) { + stop("Parameter 'exp' must be within [0, 1] range.") + } + if (any(!obs %in% c(0, 1))) { + stop("Parameter 'obs' must be binary events (0 or 1).") + } + 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 (any(name_exp != name_obs)) { + stop(paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", + "of all the dimensions expect 'exp' may have 'memb_dim'.")) + } + if (!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + stop(paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", + "of all the dimensions expect 'exp' may have 'memb_dim'.")) + } + ## thresholds + if (!is.numeric(thresholds) | !is.vector(thresholds)) { + stop("Parameter 'thresholds' must be a numeric vector.") + } + ## 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))) { + stop("Parameter 'time_dim' is not found in 'exp' and '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.") } - rel <- relsum / n - res <- ressum / n - unc <- obar * (1 - obar) - bs <- sum((pred - obs)^2) / n - bs_check_res <- rel - res + unc - bss_res <- (res - rel) / unc - gres <- res - term1 * (1 / n) + term2 * (2 / n) # Generalized resolution - bs_check_gres <- rel - gres + unc # BS using GRES - bss_gres <- (gres - rel) / unc # BSS using GRES - - # - # Estimating the bias-corrected components of the BS - # - term3 <- array(0, nbins) - for (i in 1:nbins) { - term3[i] <- (nk[i] / (nk[i] - 1)) * okbar[i] * (1 - okbar[i]) + if (!memb_dim %in% names(dim(exp))) { + stop("Parameter 'memb_dim' is not found in 'exp' dimension.") } - term_a <- sum(term3, na.rm = T) / n - term_b <- (obar * (1 - obar)) / (n - 1) - rel_bias_corrected <- rel - term_a - gres_bias_corrected <- gres - term_a + term_b - if (rel_bias_corrected < 0 || gres_bias_corrected < 0) { - rel_bias_corrected2 <- max(rel_bias_corrected, rel_bias_corrected - gres_bias_corrected, 0) - gres_bias_corrected2 <- max(gres_bias_corrected, gres_bias_corrected - rel_bias_corrected, 0) - rel_bias_corrected <- rel_bias_corrected2 - gres_bias_corrected <- gres_bias_corrected2 + } + ## 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.") } - unc_bias_corrected <- unc + term_b - bss_bias_corrected <- (gres_bias_corrected - rel_bias_corrected) / unc_bias_corrected - - #if (round(bs, 8) == round(bs_check_gres, 8) & round(bs_check_gres, 8) == round((rel_bias_corrected - gres_bias_corrected + unc_bias_corrected), 8)) { - # cat("No error found \ n") - # cat("BS = REL - GRES + UNC = REL_lessbias - GRES_lessbias + UNC_lessbias \ n") - #} - - invisible(list(rel = rel, res = res, unc = unc, bs = bs, bs_check_res = bs_check_res, bss_res = bss_res, gres = gres, bs_check_gres = bs_check_gres, bss_gres = bss_gres, rel_bias_corrected = rel_bias_corrected, gres_bias_corrected = gres_bias_corrected, unc_bias_corrected = unc_bias_corrected, bss_bias_corrected = bss_bias_corrected, nk = nk, fkbar = fkbar, okbar = okbar, bins = bins, pred = pred, obs = obs)) + } + + ############################### + # Calculate Brier score + + ## ensemble mean + if (!is.null(memb_dim)) { + exp <- MeanDims(exp, memb_dim) } + + res <- Apply(list(exp, obs), + target_dims = list(c(time_dim), + c(time_dim)), + fun = .BrierScore, + thresholds = thresholds, + ncores = ncores) + + return(res) } -#'@rdname BrierScore -#'@export .BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1)) { - if (max(exp) > 1 || min(exp) < 0) { - stop("Parameter 'exp' contains predictions outside [0,1] range. Are you certain this is a probability forecast?") - } else if (max(obs) != 1 && min(obs) != 0) { - .message("Binary events in 'obs' must be either 0 or 1. Are you certain this is a binary event?") - } else { - nbins <- length(thresholds) - 1 # Number of bins - n <- dim(exp)[1] # Number of observations - ens_mean <- rowMeans(exp, na.rm = TRUE) - n.ens <- seq(1, dim(exp)[2], 1) # Number of ensemble members - bins <- as.list(paste("bin", 1:nbins, sep = "")) - for (i in 1:nbins) { - if (i == nbins) { - bins[[i]] <- list(which(ens_mean >= thresholds[i] & ens_mean <= thresholds[i + 1])) - } else { - bins[[i]] <- list(which(ens_mean >= thresholds[i] & ens_mean < thresholds[i + 1])) - } - } - fkbar <- okbar <- nk <- array(0, dim = nbins) - for (i in 1:nbins) { - nk[i] <- length(bins[[i]][[1]]) - fkbar[i] <- sum(ens_mean[bins[[i]][[1]]]) / nk[i] - okbar[i] <- sum(obs[bins[[i]][[1]]]) / nk[i] + # exp: [sdate] + # obs: [sdate] + + n <- length(exp) + nbins <- length(thresholds) - 1 # Number of bins + bins <- as.list(paste("bin", 1:nbins, sep = "")) + for (i in 1:nbins) { + if (i == nbins) { + bins[[i]] <- list(which(exp >= thresholds[i] & exp <= thresholds[i + 1])) + } else { + bins[[i]] <- list(which(exp >= thresholds[i] & exp < thresholds[i + 1])) } + } - fkbar[fkbar == Inf] <- 0 - okbar[is.nan(okbar)] <- 0 - obar <- sum(obs) / length(obs) - relsum <- ressum <- relsum1 <- ressum1 <- term1 <- term1a <- term2 <- term2a <- 0 + fkbar <- okbar <- nk <- array(0, dim = nbins) + for (i in 1:nbins) { + nk[i] <- length(bins[[i]][[1]]) + fkbar[i] <- sum(exp[bins[[i]][[1]]]) / nk[i] + okbar[i] <- sum(obs[bins[[i]][[1]]]) / nk[i] + } + +#-----in old .BrierScore()--------- +# fkbar[fkbar == Inf] <- 0 +# okbar[is.nan(okbar)] <- 0 +#---------------------------------- - for (i in 1:nbins) { - if (nk[i] > 0) { - relsum <- relsum + nk[i] * (fkbar[i] - okbar[i]) ^ 2 - ressum <- ressum + nk[i] * (okbar[i] - obar) ^ 2 - for (j in 1:nk[i]) { - term1 <- term1 + (ens_mean[bins[[i]][[1]][j]] - fkbar[i]) ^ 2 - term2 <- term2 + (ens_mean[bins[[i]][[1]][j]] - fkbar[i]) * (obs[bins[[i]][[1]][j]] - okbar[i]) - } + obar <- sum(obs) / length(obs) + relsum <- ressum <- term1 <- term2 <- 0 + for (i in 1:nbins) { + if (nk[i] > 0) { + relsum <- relsum + nk[i] * (fkbar[i] - okbar[i])^2 + ressum <- ressum + nk[i] * (okbar[i] - obar)^2 + for (j in 1:nk[i]) { + term1 <- term1 + (exp[bins[[i]][[1]][j]] - fkbar[i])^2 + term2 <- term2 + (exp[bins[[i]][[1]][j]] - fkbar[i]) * (obs[bins[[i]][[1]][j]] - okbar[i]) } } } rel <- relsum / n res <- ressum / n unc <- obar * (1 - obar) - #bs <- apply(ens, MARGIN = 2, FUN = function(x) sum((x - obs)^2) / n) - bs <- sum((rowMeans(exp, na.rm = T) - obs) ^ 2) / n + bs <- sum((exp - obs)^2) / n bs_check_res <- rel - res + unc bss_res <- (res - rel) / unc gres <- res - term1 * (1 / n) + term2 * (2 / n) # Generalized resolution bs_check_gres <- rel - gres + unc # BS using GRES bss_gres <- (gres - rel) / unc # BSS using GRES + - # # Estimating the bias-corrected components of the BS - # term3 <- array(0, nbins) for (i in 1:nbins) { term3[i] <- (nk[i] / (nk[i] - 1)) * okbar[i] * (1 - okbar[i]) @@ -227,17 +224,24 @@ BrierScore <- function(obs, pred, thresholds = seq(0, 1, 0.1)) { } unc_bias_corrected <- unc + term_b bss_bias_corrected <- (gres_bias_corrected - rel_bias_corrected) / unc_bias_corrected - + #if (round(bs, 8) == round(bs_check_gres, 8) & round(bs_check_gres, 8) == round((rel_bias_corrected - gres_bias_corrected + unc_bias_corrected), 8)) { # cat("No error found \ n") # cat("BS = REL - GRES + UNC = REL_lessbias - GRES_lessbias + UNC_lessbias \ n") #} - - invisible(list(rel = rel, res = res, unc = unc, bs = bs, - bs_check_res = bs_check_res, bss_res = bss_res, gres = gres, - bs_check_gres = bs_check_gres, bss_gres = bss_gres, - rel_bias_corrected = rel_bias_corrected, - gres_bias_corrected = gres_bias_corrected, - unc_bias_corrected = unc_bias_corrected, - bss_bias_corrected = bss_bias_corrected)) + + # Add name for nk, fkbar, okbar + names(dim(nk)) <- 'bin' + names(dim(fkbar)) <- 'bin' + names(dim(okbar)) <- 'bin' + + res_list <- list(rel = rel, res = res, unc = unc, bs = bs, bs_check_res = bs_check_res, + bss_res = bss_res, gres = gres, bs_check_gres = bs_check_gres, + bss_gres = bss_gres, rel_bias_corrected = rel_bias_corrected, + gres_bias_corrected = gres_bias_corrected, + unc_bias_corrected = unc_bias_corrected, + bss_bias_corrected = bss_bias_corrected, nk = nk, fkbar = fkbar, + okbar = okbar) #bins = list(bins), + + return(invisible(res_list)) } diff --git a/man/AMV.Rd b/man/AMV.Rd index 0f81652..3cc4113 100644 --- a/man/AMV.Rd +++ b/man/AMV.Rd @@ -18,16 +18,15 @@ AMV( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,18 +79,17 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the AMV index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the AMV index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Atlantic Multidecadal Variability (AMV), also known as Atlantic @@ -100,7 +98,8 @@ surface temperatures (SST) over the North Atlantic Ocean on multi-decadal time scales. The AMV index is computed as the difference of weighted-averaged SST anomalies over the North Atlantic region (0ºN-60ºN, 280ºE-360ºE) and the weighted-averaged SST anomalies over 60ºS-60ºN, 0ºE-360ºE (Trenberth & -Dennis, 2005; Doblas-Reyes et al., 2013). +Dennis, 2005; Doblas-Reyes et al., 2013). If different members and/or datasets are provided, +the climatology (used to calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/BrierScore.Rd b/man/BrierScore.Rd new file mode 100644 index 0000000..9217718 --- /dev/null +++ b/man/BrierScore.Rd @@ -0,0 +1,89 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/BrierScore.R +\name{BrierScore} +\alias{BrierScore} +\title{Compute Brier score and its decomposition and Brier skill score} +\usage{ +BrierScore( + exp, + obs, + thresholds = seq(0, 1, 0.1), + time_dim = "sdate", + memb_dim = NULL, + ncores = NULL +) +} +\arguments{ +\item{exp}{A vector or a numeric array with named dimensions of the probablistic +prediction data. The dimension must at least have 'time_dim'. It may have +'memb_dim' for performing ensemble mean. The values should be within the +range [0, 1].} + +\item{obs}{A numeric array with named dimensions of the binary observations +(0 or 1). The dimension must at least have 'time_dim' and other dimensions +of 'exp' except 'memb_dim'.} + +\item{thresholds}{A numeric vector used to bin the forecasts. The default +value is \code{seq(0, 1, 0,1)}, which means that the bins are + \code{[0,0.1), [0.1, 0.2), ... [0.9, 1]}.} + +\item{time_dim}{A character string indicating the name of dimension along +which Brier score is computed. The default value is 'sdate'.} + +\item{memb_dim}{A character string of the name of the member dimension. It +must be one dimension of 'exp'. The function will do the ensemble mean +over this dimension. If there is no member dimension, set NULL. The default +value is NULL.} +} +\value{ +A list that contains: +The numeric arrays with all 'exp' and 'obs' dimensions expect 'time_dim' and +'memb_dim': +\item{$rel}{standard reliability} +\item{$res}{standard resolution} +\item{$unc}{standard uncertainty} +\item{$bs}{Brier score} +\item{$bs_check_res}{rel - res + unc} +\item{$bss_res}{res - rel / unc} +\item{$gres}{generalized resolution} +\item{$bs_check_gres}{rel - gres + unc} +\item{$bss_gres}{gres - rel / unc} +\item{$rel_bias_corrected}{bias - corrected rel} +\item{$gres_bias_corrected}{bias - corrected gres} +\item{$unc_bias_corrected}{bias - corrected unc} +\item{$bss_bias_corrected}{gres_bias_corrected - rel_bias_corrected / unc_bias_corrected} +The numeric arrays with the same dimensions as above and one additional +dimension 'bin': +\item{$nk}{number of forecast in each bin} +\item{$fkbar}{average probability of each bin} +\item{$okbar}{relative frequency that the observed event occurred} +} +\description{ +Compute the Brier score (BS) and the components of its standard decompostion +as well with the two within-bin components described in Stephenson et al., +(2008). It also returns the bias-corrected decomposition of the BS (Ferro and +Fricker, 2012). BSS has the climatology as the reference forecast. +} +\examples{ +# Inputs are vectors +exp <- runif(10) +obs <- round(a) +x <- BrierScore(exp, obs) +res <- x$bs - x$bs_check_res +res <- x$bs - x$bs_check_gres +res <- x$rel_bias_corrected - x$gres_bias_corrected + x$unc_bias_corrected + +# Inputs are arrays +example(Load) +bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3), posdates = 3, posdim = 2) +bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3), posdates = 3, posdim = 2) +res <- BrierScore(bins_ano_exp, MeanDims(bins_ano_obs, 'member'), memb_dim = 'member') + +} +\references{ +Wilks (2006) Statistical Methods in the Atmospheric Sciences.\cr +Stephenson et al. (2008). Two extra components in the Brier score decomposition. + Weather and Forecasting, 23: 752-757.\cr +Ferro and Fricker (2012). A bias-corrected decomposition of the BS. + Quarterly Journal of the Royal Meteorological Society, DOI: 10.1002/qj.1924. +} diff --git a/man/GMST.Rd b/man/GMST.Rd index 8021943..f23e60d 100644 --- a/man/GMST.Rd +++ b/man/GMST.Rd @@ -21,28 +21,25 @@ GMST( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data_tas}{A numerical array indicating the surface air temperature data -to be used for the index computation with the dimensions: 1) latitude, -longitude, start date, forecast month, and member (in case of decadal -predictions), 2) latitude, longitude, year, month and member (in case of -historical simulations), or 3) latitude, longitude, year and month (in case -of observations or reanalyses). This data has to be provided, at least, -over the whole region needed to compute the index. The dimensions must be -identical to those of data_tos.} - -\item{data_tos}{A numerical array indicating the sea surface temperature data -to be used for the index computation with the dimensions: 1) latitude, -longitude, start date, forecast month, and member (in case of decadal -predictions), 2) latitude, longitude, year, month and member (in case of -historical simulations), or 3) latitude, longitude, year and month (in case -of observations or reanalyses). This data has to be provided, at least, -over the whole region needed to compute the index. The dimensions must be -identical to those of data_tas.} +\item{data_tas}{A numerical array with the surface air temperature data +to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be +provided, at least, over the whole region needed to compute the index. +The dimensions must be identical to thos of data_tos. +#'@param data_tos A numerical array with the sea surface temperature data +to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be +provided, at least, over the whole region needed to compute the index. +The dimensions must be identical to thos of data_tas.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -90,7 +87,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -100,23 +97,23 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the GMST anomalies with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the GMST anomalies with the same dimensions as data_tas except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Global Mean Surface Temperature (GMST) anomalies are computed as the weighted-averaged surface air temperature anomalies over land and sea surface -temperature anomalies over the ocean. +temperature anomalies over the ocean. If different members and/or datasets are provided, +the climatology (used to calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/GSAT.Rd b/man/GSAT.Rd index d7fe3cf..9f03ff2 100644 --- a/man/GSAT.Rd +++ b/man/GSAT.Rd @@ -18,16 +18,15 @@ GSAT( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,22 +79,23 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the GSAT anomalies with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the GSAT anomalies with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Global Surface Air Temperature (GSAT) anomalies are computed as the -weighted-averaged surface air temperature anomalies over the global region. +weighted-averaged surface air temperature anomalies over the global region. +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/SPOD.Rd b/man/SPOD.Rd index 0491739..4c4ed29 100644 --- a/man/SPOD.Rd +++ b/man/SPOD.Rd @@ -18,16 +18,15 @@ SPOD( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,25 +79,26 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the SPOD index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the SPOD index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The South Pacific Ocean Dipole (SPOD) index is related to the El Nino-Southern Oscillation (ENSO) and the Inderdecadal Pacific Oscillation (IPO). The SPOD index is computed as the difference of weighted-averaged SST anomalies over 20ºS-48ºS, 165ºE-190ºE (NW pole) and the weighted-averaged SST -anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). +anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/TPI.Rd b/man/TPI.Rd index 3bdc17c..5e8f716 100644 --- a/man/TPI.Rd +++ b/man/TPI.Rd @@ -18,16 +18,15 @@ TPI( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,24 +79,25 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the TPI index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the TPI index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Tripole Index (TPI) for the Interdecadal Pacific Oscillation (IPO) is computed as the difference of weighted-averaged SST anomalies over 10ºS-10ºN, 170ºE-270ºE minus the mean of the weighted-averaged SST anomalies over -25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). +25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/tests/testthat/test-BrierScore.R b/tests/testthat/test-BrierScore.R new file mode 100644 index 0000000..d4080b4 --- /dev/null +++ b/tests/testthat/test-BrierScore.R @@ -0,0 +1,169 @@ +context("s2dv::BrierScore tests") + +############################################## +# dat1 +set.seed(1) +exp1 <- array(runif(30), dim = c(dataset = 1, member = 3, sdate = 5, ftime = 2)) +set.seed(2) +obs1 <- array(round(runif(10)), dim = c(dataset = 1, sdate = 5, ftime = 2)) + +# dat2 +set.seed(1) +exp2 <- runif(10) +set.seed(2) +obs2 <- round(runif(10)) + + +############################################## +test_that("1. Input checks", { + # exp and obs + expect_error( + BrierScore(exp1, c()), + "Parameter 'exp' and 'obs' cannot be NULL." + ) + expect_error( + BrierScore(c('b'), obs1), + "Parameter 'exp' and 'obs' must be a vector or a numeric array." + ) + expect_error( + BrierScore(array(1:10, dim = c(2, 5)), array(1:4, dim = c(2, 2))), + "Parameter 'exp' and 'obs' must have dimension names." + ) + expect_error( + BrierScore(exp = 1:10, obs = obs1), + "Parameter 'exp' must be within \\[0, 1\\] range." + ) + expect_error( + BrierScore(exp1, runif(10)), + "Parameter 'obs' must be binary events \\(0 or 1\\)." + ) + expect_error( + BrierScore(exp1, obs1), + paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", + "of all the dimensions expect 'exp' may have 'memb_dim'.") + ) + # thresholds + expect_error( + BrierScore(exp2, obs2, thresholds = TRUE), + "Parameter 'thresholds' must be a numeric vector." + ) + # time_dim + expect_error( + BrierScore(exp2, obs2, time_dim = 1), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + BrierScore(exp1, obs1, memb_dim = 'member', time_dim = 'time'), + "Parameter 'time_dim' is not found in 'exp' and 'obs' dimension." + ) + expect_error( + BrierScore(exp2, obs2, memb_dim = 2), + "Parameter 'memb_dim' must be a character string." + ) + expect_error( + BrierScore(exp2, obs2, memb_dim = 'ensemble'), + "Parameter 'memb_dim' is not found in 'exp' dimension." + ) + expect_error( + BrierScore(exp2, obs2, ncores = 0), + "Parameter 'ncores' must be a positive integer." + ) + +}) + +############################################## +test_that("2. Output checks: dat1", { + +expect_equal( +length(BrierScore(exp1, obs1, memb_dim = 'member')), +16 +) +expect_equal( +names(BrierScore(exp1, obs1, memb_dim = 'member')), +c('rel', 'res', 'unc', 'bs', 'bs_check_res', 'bss_res', 'gres', + 'bs_check_gres', 'bss_gres', 'rel_bias_corrected', 'gres_bias_corrected', + 'unc_bias_corrected', 'bss_bias_corrected', 'nk', 'fkbar', 'okbar') +) +expect_equal( +dim(BrierScore(exp1, obs1, memb_dim = 'member')$rel), +c(dataset = 1, ftime = 2) +) +expect_equal( +BrierScore(exp1, obs1, memb_dim = 'member')$rel[1, ], +c(0.1013649, 0.2549810), +tolerance = 0.0001 +) +expect_equal( +BrierScore(exp1, obs1, memb_dim = 'member')$res[1, ], +c(0.24, 0.24), +tolerance = 0.0001 +) +expect_equal( +BrierScore(exp1, obs1, memb_dim = 'member')$bs[1, ], +c(0.1016759, 0.2549810), +tolerance = 0.0001 +) +expect_equal( +dim(BrierScore(exp1, obs1, memb_dim = 'member')$okbar), +c(bin = 10, dataset = 1, ftime = 2) +) +expect_equal( +BrierScore(exp1, obs1, memb_dim = 'member')$okbar[, 1, 1], +c(NaN, 0, NaN, NaN, 0, NaN, 1, 1, NaN, NaN) +) +expect_equal( +BrierScore(exp1, obs1, memb_dim = 'member')$fkbar[, 1, 1], +c(NaN, 0.1481059, NaN, NaN, 0.4034953, NaN, 0.6415412, 0.7448624, NaN, NaN), +tolerance = 0.0001 +) +expect_equal( +BrierScore(exp1, obs1, memb_dim = 'member')$nk[, 1, 1], +c(0, 1, 0, 0, 1, 0, 2, 1, 0, 0) +) + +}) + + +############################################## +test_that("3. Output checks: dat2", { +expect_equal( +length(BrierScore(exp2, obs2)), +16 +) +expect_equal( +dim(BrierScore(exp2, obs2))$bss, +NULL +) +expect_equal( +length(BrierScore(exp2, obs2)$bss_res), +1 +) +expect_equal( +dim(BrierScore(exp2, obs2))$nk, +NULL +) +expect_equal( +length(BrierScore(exp2, obs2)$nk), +10 +) +expect_equal( +BrierScore(exp2, obs2)$bs, +0.4403154, +tolerance = 0.0001 +) +expect_equal( +BrierScore(exp2, obs2)$gres_bias_corrected, +0.06313199, +tolerance = 0.0001 +) +expect_equal( +BrierScore(exp2, obs2)$bss_bias_corrected, +-0.6511828, +tolerance = 0.0001 +) +expect_equal( +as.vector(BrierScore(exp2, obs2)$nk), +c(1, 0, 2, 1, 0, 1, 2, 0, 1, 2) +) + +}) -- GitLab From 2bcbbc04d8a0fb2ed0b7e08c63cf064055fbc23e Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 13 Apr 2021 17:52:33 +0200 Subject: [PATCH 072/154] Transform Spread() from s2dverification --- NAMESPACE | 4 + R/Spread.R | 203 ++++++++++++++++++++++++++++++++++++++++++++++++++ man/Spread.Rd | 100 +++++++++++++++++++++++++ 3 files changed, 307 insertions(+) create mode 100644 R/Spread.R create mode 100644 man/Spread.Rd diff --git a/NAMESPACE b/NAMESPACE index 87937e2..ea090db 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -47,6 +47,7 @@ export(Reorder) export(SPOD) export(Season) export(Smoothing) +export(Spread) export(TPI) export(ToyModel) export(Trend) @@ -84,12 +85,14 @@ importFrom(grDevices,rainbow) importFrom(grDevices,rgb) importFrom(grDevices,svg) importFrom(grDevices,tiff) +importFrom(stats,IQR) importFrom(stats,acf) importFrom(stats,anova) importFrom(stats,confint) importFrom(stats,cor) importFrom(stats,kmeans) importFrom(stats,lm) +importFrom(stats,mad) importFrom(stats,median) importFrom(stats,na.fail) importFrom(stats,na.omit) @@ -102,6 +105,7 @@ importFrom(stats,qnorm) importFrom(stats,qt) importFrom(stats,quantile) importFrom(stats,rnorm) +importFrom(stats,runif) importFrom(stats,sd) importFrom(stats,setNames) importFrom(stats,ts) diff --git a/R/Spread.R b/R/Spread.R new file mode 100644 index 0000000..d808dc7 --- /dev/null +++ b/R/Spread.R @@ -0,0 +1,203 @@ +#'Compute interquartile range, maximum-minimum, standard deviation and median +#'absolute deviation +#' +#'Compute interquartile range, maximum-minimum, standard deviation and median +#'absolute deviation along the list of dimensions provided by the compute_dim +#'argument (typically along the ensemble member and start date dimension). +#'The confidence interval is computed by bootstrapping. The input data can +#'be the output of \code{Load()}, \code{Ano()}, or \code{Ano_CrossValid()}, for +#'example. +#' +#'@param data A numeric vector or array with named dimensions to compute the +#' statistics. The dimensions should at least include 'compute_dim'. +#'@param compute_dim A vector of character strings of the dimension names along +#' which to compute the statistics. The default value is 'member'. +#'@param na.rm A logical value indicating if NAs should be removed (TRUE) or +#' 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 ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' +#'@return +#'A list of numeric arrays with the same dimensions as 'data' but without +#''compute_dim' and with the first dimension 'stats'. If 'conf' is TRUE, the +#'length of 'stats' is 3 corresponding to the lower limit of the confidence +#'interval, the spread, and the upper limit of the confidence interval. If +#''conf' is FALSE, the length of 'stats' is 1 corresponding to the spread. +#'\item{$iqr}{ +#' InterQuartile Range. +#'} +#'\item{$maxmin}{ +#' Maximum - Minimum. +#'} +#'\item{$sd}{ +#' Standard Deviation. +#'} +#'\item{$mad}{ +#' Median Absolute Deviation. +#'} +#' +#'@examples +#'# Load sample data as in Load() example: +#'example(Load) +#'clim <- Clim(sampleData$mod, sampleData$obs) +#'ano_exp <- Ano(sampleData$mod, clim$clim_exp) +#'runmean_months <- 12 +#'smooth_ano_exp <- Smoothing(ano_exp, runmeanlen = runmean_months) +#'smooth_ano_exp_m_sub <- smooth_ano_exp - InsertDim(MeanDims(smooth_ano_exp, 'member', +#' na.rm = TRUE), +#' posdim = 'member', +#' lendim = dim(smooth_ano_exp)['member'], +#' name = 'member') +#'spread <- Spread(smooth_ano_exp_m_sub, compute_dim = c('member', 'sdate')) +#' +#'\donttest{ +#'PlotVsLTime(Reorder(spread$iqr, c('dataset', 'stats', 'ftime')), +#' toptitle = "Inter-Quartile Range between ensemble members", +#' ytitle = "K", monini = 11, limits = NULL, +#' listexp = c('CMIP5 IC3'), listobs = c('ERSST'), biglab = FALSE, +#' hlines = c(0), fileout = 'tos_iqr.png') +#'PlotVsLTime(Reorder(spread$maxmin, c('dataset', 'stats', 'ftime')), +#' toptitle = "Maximum minus minimum of the members", +#' ytitle = "K", monini = 11, limits = NULL, +#' listexp = c('CMIP5 IC3'), listobs = c('ERSST'), biglab = FALSE, +#' hlines = c(0), fileout = 'tos_maxmin.png') +#'PlotVsLTime(Reorder(spread$sd, c('dataset', 'stats', 'ftime')), +#' toptitle = "Standard deviation of the members", +#' ytitle = "K", monini = 11, limits = NULL, +#' listexp = c('CMIP5 IC3'), listobs = c('ERSST'), biglab = FALSE, +#' hlines = c(0), fileout = 'tos_sd.png') +#'PlotVsLTime(Reorder(spread$mad, c('dataset', 'stats', 'ftime')), +#' toptitle = "Median Absolute Deviation of the members", +#' ytitle = "K", monini = 11, limits = NULL, +#' listexp = c('CMIP5 IC3'), listobs = c('ERSST'), biglab = FALSE, +#' hlines = c(0), fileout = 'tos_mad.png') +#'} +#' +#'@import multiApply +#'@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) { + + # 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 (is.null(dim(data))) { #is vector + dim(data) <- c(length(data)) + names(dim(data)) <- compute_dim[1] + } + if(any(is.null(names(dim(data))))| any(nchar(names(dim(data))) == 0)) { + stop("Parameter 'data' must have dimension names.") + } + ## compute_dim + if (!is.character(compute_dim)) { + stop("Parameter 'compute_dim' must be a character vector.") + } + if (any(!compute_dim %in% names(dim(data)))) { + stop("Parameter 'compute_dim' has some element not in 'data' dimension names.") + } + ## na.rm + if (!is.logical(na.rm) | length(na.rm) > 1) { + stop("Parameter 'na.rm' 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.") + } + ## 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.") + } + } + + ############################### + # Calculate Spread + + output <- Apply(list(data), + target_dims = compute_dim, + fun = .Spread, + output_dims = list(iqr = 'stats', maxmin = 'stats', + sd = 'stats', mad = 'stats'), + na.rm = na.rm, + conf = conf, conf.lev = conf.lev, + ncores = ncores) + + return(output) +} + +.Spread <- function(data, compute_dim = 'member', na.rm = TRUE, + conf = TRUE, conf.lev = 0.95) { + + # data: compute_dim. [member] or [member, sdate] for example + + # Compute spread + res_iqr <- IQR(data, na.rm = na.rm) + res_maxmin <- max(data, na.rm = na.rm) - min(data, na.rm = na.rm) + res_sd <- sd(data, na.rm = na.rm) + res_mad <- mad(data, na.rm = na.rm) + + # Compute conf (bootstrapping) + if (conf) { + # The output length is 3, [conf.low, spread, conf.high] + res_iqr <- rep(res_iqr, 3) + res_maxmin <- rep(res_maxmin, 3) + res_sd <- rep(res_sd, 3) + res_mad <- rep(res_mad, 3) + + conf_low <- (1 - conf.lev) / 2 + conf_high <- 1 - conf_low + + # Create vector for saving bootstrap result + iqr_bs <- c() + maxmin_bs <- c() + sd_bs <- c() + mad_bs <- c() + + # 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)) + } + + # Calculate confidence interval with the bootstrapping results + res_iqr[1] <- quantile(iqr_bs, conf_low, na.rm = na.rm) + res_iqr[3] <- quantile(iqr_bs, conf_high, na.rm = na.rm) + res_maxmin[1] <- res_maxmin[2] + (quantile(maxmin_bs, conf_low, na.rm = na.rm) - + quantile(maxmin_bs, conf_high, na.rm = na.rm)) / 2 + res_maxmin[3] <- res_maxmin[2] - (quantile(maxmin_bs, conf_low, na.rm = na.rm) - + quantile(maxmin_bs, conf_high, na.rm = na.rm)) / 2 + res_sd[1] <- quantile(sd_bs, conf_low, na.rm = na.rm) + res_sd[3] <- quantile(sd_bs, conf_high, na.rm = na.rm) + res_mad[1] <- res_mad[2] + (quantile(mad_bs, conf_low, na.rm = na.rm) - + quantile(mad_bs, conf_high, na.rm = na.rm)) + res_mad[3] <- res_mad[2] - (quantile(mad_bs, conf_low, na.rm = na.rm) - + quantile(mad_bs, conf_high, na.rm = na.rm)) + + } + + # Turn infinite to NA + res_maxmin[which(is.infinite(res_maxmin))] <- NA + + + return(invisible(list(iqr = res_iqr, maxmin = res_maxmin, sd = res_sd, mad = res_mad))) +} diff --git a/man/Spread.Rd b/man/Spread.Rd new file mode 100644 index 0000000..7eca295 --- /dev/null +++ b/man/Spread.Rd @@ -0,0 +1,100 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Spread.R +\name{Spread} +\alias{Spread} +\title{Compute interquartile range, maximum-minimum, standard deviation and median +absolute deviation} +\usage{ +Spread( + data, + compute_dim = "member", + na.rm = TRUE, + conf = TRUE, + conf.lev = 0.95, + ncores = NULL +) +} +\arguments{ +\item{data}{A numeric vector or array with named dimensions to compute the +statistics. The dimensions should at least include 'compute_dim'.} + +\item{compute_dim}{A vector of character strings of the dimension names along +which to compute the statistics. The default value is 'member'.} + +\item{na.rm}{A logical value indicating if NAs should be removed (TRUE) or +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{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A list of numeric arrays with the same dimensions as 'data' but without +'compute_dim' and with the first dimension 'stats'. If 'conf' is TRUE, the +length of 'stats' is 3 corresponding to the lower limit of the confidence +interval, the spread, and the upper limit of the confidence interval. If +'conf' is FALSE, the length of 'stats' is 1 corresponding to the spread. +\item{$iqr}{ + InterQuartile Range. +} +\item{$maxmin}{ + Maximum - Minimum. +} +\item{$sd}{ + Standard Deviation. +} +\item{$mad}{ + Median Absolute Deviation. +} +} +\description{ +Compute interquartile range, maximum-minimum, standard deviation and median +absolute deviation along the list of dimensions provided by the compute_dim +argument (typically along the ensemble member and start date dimension). +The confidence interval is computed by bootstrapping. The input data can +be the output of \code{Load()}, \code{Ano()}, or \code{Ano_CrossValid()}, for +example. +} +\examples{ +# Load sample data as in Load() example: +example(Load) +clim <- Clim(sampleData$mod, sampleData$obs) +ano_exp <- Ano(sampleData$mod, clim$clim_exp) +runmean_months <- 12 +smooth_ano_exp <- Smoothing(ano_exp, runmeanlen = runmean_months) +smooth_ano_exp_m_sub <- smooth_ano_exp - InsertDim(MeanDims(smooth_ano_exp, 'member', + na.rm = TRUE), + posdim = 'member', + lendim = dim(smooth_ano_exp)['member'], + name = 'member') +spread <- Spread(smooth_ano_exp_m_sub, compute_dim = c('member', 'sdate')) + +\donttest{ +PlotVsLTime(Reorder(spread$iqr, c('dataset', 'stats', 'ftime')), + toptitle = "Inter-Quartile Range between ensemble members", + ytitle = "K", monini = 11, limits = NULL, + listexp = c('CMIP5 IC3'), listobs = c('ERSST'), biglab = FALSE, + hlines = c(0), fileout = 'tos_iqr.png') +PlotVsLTime(Reorder(spread$maxmin, c('dataset', 'stats', 'ftime')), + toptitle = "Maximum minus minimum of the members", + ytitle = "K", monini = 11, limits = NULL, + listexp = c('CMIP5 IC3'), listobs = c('ERSST'), biglab = FALSE, + hlines = c(0), fileout = 'tos_maxmin.png') +PlotVsLTime(Reorder(spread$sd, c('dataset', 'stats', 'ftime')), + toptitle = "Standard deviation of the members", + ytitle = "K", monini = 11, limits = NULL, + listexp = c('CMIP5 IC3'), listobs = c('ERSST'), biglab = FALSE, + hlines = c(0), fileout = 'tos_sd.png') +PlotVsLTime(Reorder(spread$mad, c('dataset', 'stats', 'ftime')), + toptitle = "Median Absolute Deviation of the members", + ytitle = "K", monini = 11, limits = NULL, + listexp = c('CMIP5 IC3'), listobs = c('ERSST'), biglab = FALSE, + hlines = c(0), fileout = 'tos_mad.png') +} + +} -- GitLab From 45758f3f50bc14e999729b681e35c76cb668b901 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 13 Apr 2021 17:52:47 +0200 Subject: [PATCH 073/154] Update indices .Rd --- man/AMV.Rd | 29 ++++++++++++++--------------- man/GMST.Rd | 51 ++++++++++++++++++++++++--------------------------- man/GSAT.Rd | 30 +++++++++++++++--------------- man/SPOD.Rd | 30 +++++++++++++++--------------- man/TPI.Rd | 30 +++++++++++++++--------------- 5 files changed, 83 insertions(+), 87 deletions(-) diff --git a/man/AMV.Rd b/man/AMV.Rd index 0f81652..3cc4113 100644 --- a/man/AMV.Rd +++ b/man/AMV.Rd @@ -18,16 +18,15 @@ AMV( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,18 +79,17 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the AMV index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the AMV index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Atlantic Multidecadal Variability (AMV), also known as Atlantic @@ -100,7 +98,8 @@ surface temperatures (SST) over the North Atlantic Ocean on multi-decadal time scales. The AMV index is computed as the difference of weighted-averaged SST anomalies over the North Atlantic region (0ºN-60ºN, 280ºE-360ºE) and the weighted-averaged SST anomalies over 60ºS-60ºN, 0ºE-360ºE (Trenberth & -Dennis, 2005; Doblas-Reyes et al., 2013). +Dennis, 2005; Doblas-Reyes et al., 2013). If different members and/or datasets are provided, +the climatology (used to calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/GMST.Rd b/man/GMST.Rd index 8021943..f23e60d 100644 --- a/man/GMST.Rd +++ b/man/GMST.Rd @@ -21,28 +21,25 @@ GMST( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data_tas}{A numerical array indicating the surface air temperature data -to be used for the index computation with the dimensions: 1) latitude, -longitude, start date, forecast month, and member (in case of decadal -predictions), 2) latitude, longitude, year, month and member (in case of -historical simulations), or 3) latitude, longitude, year and month (in case -of observations or reanalyses). This data has to be provided, at least, -over the whole region needed to compute the index. The dimensions must be -identical to those of data_tos.} - -\item{data_tos}{A numerical array indicating the sea surface temperature data -to be used for the index computation with the dimensions: 1) latitude, -longitude, start date, forecast month, and member (in case of decadal -predictions), 2) latitude, longitude, year, month and member (in case of -historical simulations), or 3) latitude, longitude, year and month (in case -of observations or reanalyses). This data has to be provided, at least, -over the whole region needed to compute the index. The dimensions must be -identical to those of data_tas.} +\item{data_tas}{A numerical array with the surface air temperature data +to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be +provided, at least, over the whole region needed to compute the index. +The dimensions must be identical to thos of data_tos. +#'@param data_tos A numerical array with the sea surface temperature data +to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be +provided, at least, over the whole region needed to compute the index. +The dimensions must be identical to thos of data_tas.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -90,7 +87,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -100,23 +97,23 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the GMST anomalies with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the GMST anomalies with the same dimensions as data_tas except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Global Mean Surface Temperature (GMST) anomalies are computed as the weighted-averaged surface air temperature anomalies over land and sea surface -temperature anomalies over the ocean. +temperature anomalies over the ocean. If different members and/or datasets are provided, +the climatology (used to calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/GSAT.Rd b/man/GSAT.Rd index d7fe3cf..9f03ff2 100644 --- a/man/GSAT.Rd +++ b/man/GSAT.Rd @@ -18,16 +18,15 @@ GSAT( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,22 +79,23 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the GSAT anomalies with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the GSAT anomalies with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Global Surface Air Temperature (GSAT) anomalies are computed as the -weighted-averaged surface air temperature anomalies over the global region. +weighted-averaged surface air temperature anomalies over the global region. +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/SPOD.Rd b/man/SPOD.Rd index 0491739..4c4ed29 100644 --- a/man/SPOD.Rd +++ b/man/SPOD.Rd @@ -18,16 +18,15 @@ SPOD( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,25 +79,26 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the SPOD index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the SPOD index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The South Pacific Ocean Dipole (SPOD) index is related to the El Nino-Southern Oscillation (ENSO) and the Inderdecadal Pacific Oscillation (IPO). The SPOD index is computed as the difference of weighted-averaged SST anomalies over 20ºS-48ºS, 165ºE-190ºE (NW pole) and the weighted-averaged SST -anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). +anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/TPI.Rd b/man/TPI.Rd index 3bdc17c..5e8f716 100644 --- a/man/TPI.Rd +++ b/man/TPI.Rd @@ -18,16 +18,15 @@ TPI( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,24 +79,25 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the TPI index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the TPI index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Tripole Index (TPI) for the Interdecadal Pacific Oscillation (IPO) is computed as the difference of weighted-averaged SST anomalies over 10ºS-10ºN, 170ºE-270ºE minus the mean of the weighted-averaged SST anomalies over -25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). +25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses -- GitLab From 52529d35be4d6830435cf9b34ce844bd9a56d328 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 13 Apr 2021 20:41:32 +0200 Subject: [PATCH 074/154] Create unit test and improve document --- R/Spread.R | 10 +-- man/Spread.Rd | 6 +- tests/testthat/test-Spread.R | 164 +++++++++++++++++++++++++++++++++++ 3 files changed, 172 insertions(+), 8 deletions(-) create mode 100644 tests/testthat/test-Spread.R diff --git a/R/Spread.R b/R/Spread.R index d808dc7..9589fae 100644 --- a/R/Spread.R +++ b/R/Spread.R @@ -4,9 +4,9 @@ #'Compute interquartile range, maximum-minimum, standard deviation and median #'absolute deviation along the list of dimensions provided by the compute_dim #'argument (typically along the ensemble member and start date dimension). -#'The confidence interval is computed by bootstrapping. The input data can -#'be the output of \code{Load()}, \code{Ano()}, or \code{Ano_CrossValid()}, for -#'example. +#'The confidence interval is computed by bootstrapping by 100 times. The input +#'data can be the output of \code{Load()}, \code{Ano()}, or +#'\code{Ano_CrossValid()}, for example. #' #'@param data A numeric vector or array with named dimensions to compute the #' statistics. The dimensions should at least include 'compute_dim'. @@ -198,6 +198,6 @@ Spread <- function(data, compute_dim = 'member', na.rm = TRUE, # Turn infinite to NA res_maxmin[which(is.infinite(res_maxmin))] <- NA - - return(invisible(list(iqr = res_iqr, maxmin = res_maxmin, sd = res_sd, mad = res_mad))) + return(invisible(list(iqr = as.array(res_iqr), maxmin = as.array(res_maxmin), + sd = as.array(res_sd), mad = as.array(res_mad)))) } diff --git a/man/Spread.Rd b/man/Spread.Rd index 7eca295..e5f3edd 100644 --- a/man/Spread.Rd +++ b/man/Spread.Rd @@ -56,9 +56,9 @@ interval, the spread, and the upper limit of the confidence interval. If Compute interquartile range, maximum-minimum, standard deviation and median absolute deviation along the list of dimensions provided by the compute_dim argument (typically along the ensemble member and start date dimension). -The confidence interval is computed by bootstrapping. The input data can -be the output of \code{Load()}, \code{Ano()}, or \code{Ano_CrossValid()}, for -example. +The confidence interval is computed by bootstrapping by 100 times. The input +data can be the output of \code{Load()}, \code{Ano()}, or +\code{Ano_CrossValid()}, for example. } \examples{ # Load sample data as in Load() example: diff --git a/tests/testthat/test-Spread.R b/tests/testthat/test-Spread.R new file mode 100644 index 0000000..1d299a6 --- /dev/null +++ b/tests/testthat/test-Spread.R @@ -0,0 +1,164 @@ +context("s2dv::Spread test") + +############################################## + # dat1 + set.seed(1) + dat1 <- array(rnorm(240), c(member = 3, sdate = 4, ftime = 20)) + + # dat2 + set.seed(2) + dat2 <- rnorm(20) + +############################################## + +test_that("1. Input checks", { + + # data + expect_error( + Spread(c()), + "Parameter 'data' cannot be NULL." + ) + expect_error( + Spread(c(NA, NA)), + "Parameter 'data' must be a numeric array." + ) + expect_error( + Spread(array(1:10, dim = c(2, 5))), + "Parameter 'data' must have dimension names." + ) + # compute_dim + expect_error( + Spread(dat1, compute_dim = 1), + "Parameter 'compute_dim' must be a character vector." + ) + expect_error( + Spread(dat1, compute_dim = 'memb'), + "Parameter 'compute_dim' has some element not in 'data' dimension names." + ) + # na.rm + expect_error( + Spread(dat1, na.rm = 1), + "Parameter 'na.rm' must be one logical value." + ) + # conf + expect_error( + Spread(dat1, conf = 0.1), + "Parameter 'conf' must be one logical value." + ) + # conf.lev + expect_error( + Spread(dat1, conf.lev = c(0.05, 0.95)), + "Parameter 'conf.lev' must be a numeric number between 0 and 1." + ) + # ncores + expect_error( + Spread(dat1, ncores = 0), + "Parameter 'ncores' must be a positive integer." + ) + +}) + +############################################## +test_that("2. dat1", { + +res1_1 <- Spread(dat1) + +expect_equal( +names(res1_1), +c('iqr', 'maxmin', 'sd', 'mad') +) +expect_equal( +dim(res1_1$iqr), +c(stats = 3, sdate = 4, ftime = 20) +) +expect_equal( +dim(res1_1$maxmin), +c(stats = 3, sdate = 4, ftime = 20) +) +expect_equal( +dim(res1_1$sd), +c(stats = 3, sdate = 4, ftime = 20) +) +expect_equal( +dim(res1_1$mad), +c(stats = 3, sdate = 4, ftime = 20) +) + +res1_2 <- Spread(dat1, conf = F) + +expect_equal( +names(res1_2), +c('iqr', 'maxmin', 'sd', 'mad') +) +expect_equal( +dim(res1_2$iqr), +c(stats = 1, sdate = 4, ftime = 20) +) +expect_equal( +dim(res1_2$iqr), +dim(res1_2$maxmin) +) +expect_equal( +dim(res1_2$iqr), +dim(res1_2$sd) +) +expect_equal( +dim(res1_2$iqr), +dim(res1_2$mad) +) + +}) + +############################################## + +test_that("3. dat2", { + +res2_1 <- Spread(dat2) + +expect_equal( +names(res2_1), +c('iqr', 'maxmin', 'sd', 'mad') +) +expect_equal( +dim(res2_1$iqr), +c(stats = 3) +) +expect_equal( +dim(res2_1$maxmin), +c(stats = 3) +) +expect_equal( +dim(res2_1$sd), +c(stats = 3) +) +expect_equal( +dim(res2_1$mad), +c(stats = 3) +) + +res2_2 <- Spread(dat2, conf = F) + +expect_equal( +names(res2_2), +c('iqr', 'maxmin', 'sd', 'mad') +) +expect_equal( +dim(res2_2$iqr), +c(stats = 1) +) +expect_equal( +dim(res2_2$maxmin), +c(stats = 1) +) +expect_equal( +dim(res2_2$sd), +c(stats = 1) +) +expect_equal( +dim(res2_2$mad), +c(stats = 1) +) + +}) + + -- GitLab From 81316b0f146b30ef8d0acec6a71108238516ecce Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 15 Apr 2021 15:33:47 +0200 Subject: [PATCH 075/154] Transform StatSeasAtlHurr.R --- NAMESPACE | 1 + R/StatSeasAtlHurr.R | 225 ++++++++++++++++++++++++++ man/StatSeasAtlHurr.Rd | 65 ++++++++ tests/testthat/test-StatSeasAtlHurr.R | 110 +++++++++++++ 4 files changed, 401 insertions(+) create mode 100644 R/StatSeasAtlHurr.R create mode 100644 man/StatSeasAtlHurr.Rd create mode 100644 tests/testthat/test-StatSeasAtlHurr.R diff --git a/NAMESPACE b/NAMESPACE index 87937e2..a19a297 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -47,6 +47,7 @@ export(Reorder) export(SPOD) export(Season) export(Smoothing) +export(StatSeasAtlHurr) export(TPI) export(ToyModel) export(Trend) diff --git a/R/StatSeasAtlHurr.R b/R/StatSeasAtlHurr.R new file mode 100644 index 0000000..358849d --- /dev/null +++ b/R/StatSeasAtlHurr.R @@ -0,0 +1,225 @@ +#'Compute estimate of seasonal mean of Atlantic hurricane activity +#' +#'Compute one of G. Villarini's statistically downscaled measure of mean +#'Atlantic hurricane activity and its variance. The hurricane activity is +#'estimated using seasonal averages of sea surface temperature anomalies over +#'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 +#'The statistical models used in this function are described in references. +#' +#'@param atlano A numeric array with named dimensions of Atlantic sea surface +#' temperature anomalies. It must have the same dimensions as 'tropano'. +#'@param tropano A numeric array with named dimensions of tropical sea surface +#' temperature anomalies. It must have the same dimensions as 'atlano'. +#'@param hrvar A character string of the seasonal average to be estimated. The +#' options are either "HR" (hurricanes), "TC" (tropical cyclones with lifetime +#' >=48h), or "PDI" (power dissipation index). The default value is 'HR'. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' +#'@return A list composed of two arrays with the same dimensions as 'atlano' +#' and 'tropano'. +#'\item{ +#' A matrix (mean) with the seasonal average values of the desired quantity.\cr +#'} +#'\item{ +#' A matrix (var) of the variance of that quantity.\cr +#'} +#' +#'@references +#'Villarini et al. (2010) Mon Wea Rev, 138, 2681-2705.\cr +#'Villarini et al. (2012) Mon Wea Rev, 140, 44-65.\cr +#'Villarini et al. (2012) J Clim, 25, 625-637.\cr +#'An example of how the function can be used in hurricane forecast studies +#' is given in\cr +#'Caron, L.-P. et al. (2014) Multi-year prediction skill of Atlantic hurricane +#' activity in CMIP5 decadal hindcasts. Climate Dynamics, 42, 2675-2690. +#' doi:10.1007/s00382-013-1773-1. +#' +#'@examples +#'# Let AtlAno represents 5 different 5-year forecasts of seasonally averaged +#'# Atlantic sea surface temperature anomalies. +#'AtlAno <- array(runif(25, -1, 1), dim = c(sdate = 5, ftime = 5)) +#'# Let TropAno represents 5 corresponding 5-year forecasts of seasonally +#'# averaged tropical sea surface temperature anomalies. +#'TropAno <- array(runif(25, -1, 1), dim = c(sdate = 5, ftime = 5)) +#'# The seasonal average of hurricanes for each of the five forecasted years, +#'# for each forecast, would then be given by. +#'hr_count <- StatSeasAtlHurr(atlano = AtlAno, tropano = TropAno, hrvar = 'HR') +#' +#'@import multiApply +#'@export +StatSeasAtlHurr <- function(atlano, tropano, hrvar = "HR", ncores = NULL) { + + # Check inputs + ## atlano and tropano + if (is.null(atlano) | is.null(tropano)) { + stop("Parameter 'atlano' and 'tropano' cannot be NULL.") + } + if (!is.numeric(atlano) | !is.numeric(tropano)) { + stop("Parameter 'atlano' and 'tropano' must be a numeric array.") + } + if (is.null(dim(atlano))) { #is vector + dim(atlano) <- c(length(atlano)) + names(dim(atlano)) <- 'dim1' + } + if (is.null(dim(tropano))) { #is vector + dim(tropano) <- c(length(tropano)) + names(dim(tropano)) <- 'dim1' + } + if(any(is.null(names(dim(atlano))))| any(nchar(names(dim(atlano))) == 0) | + any(is.null(names(dim(tropano))))| any(nchar(names(dim(tropano))) == 0)) { + stop("Parameter 'atlano' and 'tropano' must have dimension names.") + } + if(!all(names(dim(atlano)) %in% names(dim(tropano))) | + !all(names(dim(tropano)) %in% names(dim(atlano)))) { + stop("Parameter 'atlano' and 'tropano' must have same dimension names.") + } + name_1 <- sort(names(dim(atlano))) + name_2 <- sort(names(dim(tropano))) + if (!all(dim(atlano)[name_1] == dim(tropano)[name_2])) { + stop(paste0("Parameter 'atlano' and 'tropano' must have the same length of ", + "all the dimensions.")) + } + ## hrvar + if (hrvar != "HR" & hrvar != "TC" & hrvar != "PDI") { + stop("The parameter 'hrvar' must be either 'HR', 'TC', or 'PDI'.") + } + ## 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.") + } + } + + + ############################### + # Calculate StatSeasAtlHurr + if (is.null(ncores)) { + use_Apply <- FALSE + } else if (ncores == 1) { + use_Apply <- FALSE + } else { + use_Apply <- TRUE + } + + if (use_Apply) { + res <- Apply(list(atlano, tropano), + target_dims = list(c(names(which.max(dim(AtlAno)))), + c(names(which.max(dim(AtlAno))))), + fun = .StatSeasAtlHurr, + hrvar = hrvar, + ncores = ncores) + } else { + + # Get the values of the betas according to the hurricane + # activity measure we specified. + # ------------------------------------------------------ + if (hrvar == "HR") { + # beta's are derived from Villarini et al. (2012), Mon Wea + # Rev, 140, 44-65. beta's are for corrected hurricane data + + # ERSST with SBC criteria (table 2) + beta0 <- 1.85 + betaAtl <- 1.05 + betaTrop <- -1.17 + } else if (hrvar == "TC") { + # beta's are from Villarini et al. (2010), Mon Wea Rev, 138, + # 2681-2705. beta's are for corrected TC data (lifetime >= + # 48h) + ERSST (table 5) + beta0 <- 2.1 + betaAtl <- 1.02 + betaTrop <- -1.05 + } else if (hrvar == "PDI") { + # beta's are from Villarini et al. (2012), J Clim, 25, + # 625-637. beta's are from ERSST, with SBC penalty criterion + # (table 1) + beta0 <- 0.76 + betaAtl <- 1.94 + betaTrop <- -1.78 + } + # Create matrix of similar dimension as atlano for beta0. + # ------------------------------------------------------- + intercept <- array(beta0, dim(atlano)) + # Compute statistical relationship b/w SSTAs and mean + # hurricane activity. + # --------------------------------------------------- + atl <- betaAtl * atlano + trop <- betaTrop * tropano + # + temp <- intercept + atl + trop + # + res <- list(mean = array(NA, dim(atl)), var = array(NA, dim(atl))) + res$mean[] <- vapply(X = temp, FUN = exp, numeric(1)) + # Compute the variance of the distribution. TC and HR follow + # a Poisson distribution, so the variance is equal to the + # mean. PDI follows a gamma distribution, with sigma = + # -0.57. (variance = sigma^2 * mean^2). + # ----------------------------------------------------------- + if (hrvar == "HR" | hrvar == "TC") { + res$var <- res$mean + } else { + sigma <- -0.57 + res$var[] <- sigma^2 * vapply(X = res$mean, FUN = function(x) x^2, numeric(1)) + } + + } + + return(res) +} + +.StatSeasAtlHurr <- function(atlano, tropano, hrvar = "HR") { + + # atlano and tropano: a vector with same length + + # Get the values of the betas according to the hurricane activity measure we + # specified. + # ------------------------------------------------------ + if (hrvar == "HR") { + # beta's are derived from Villarini et al. (2012), Mon Wea + # Rev, 140, 44-65. beta's are for corrected hurricane data + + # ERSST with SBC criteria (table 2) + beta0 <- 1.85 + betaAtl <- 1.05 + betaTrop <- -1.17 + } else if (hrvar == "TC") { + # beta's are from Villarini et al. (2010), Mon Wea Rev, 138, + # 2681-2705. beta's are for corrected TC data (lifetime >= + # 48h) + ERSST (table 5) + beta0 <- 2.1 + betaAtl <- 1.02 + betaTrop <- -1.05 + } else if (hrvar == "PDI") { + # beta's are from Villarini et al. (2012), J Clim, 25, + # 625-637. beta's are from ERSST, with SBC penalty criterion + # (table 1) + beta0 <- 0.76 + betaAtl <- 1.94 + betaTrop <- -1.78 + } + + # Compute statistical relationship b/w SSTAs and mean + # hurricane activity. + # --------------------------------------------------- + atl <- betaAtl * atlano + trop <- betaTrop * tropano + temp <- beta0 + atl + trop + stat_mean <- exp(temp) + + # Compute the variance of the distribution. TC and HR follow + # a Poisson distribution, so the variance is equal to the + # mean. PDI follows a gamma distribution, with sigma = + # -0.57. (variance = sigma^2 * mean^2). + # ----------------------------------------------------------- + if (hrvar == "HR" | hrvar == "TC") { + stat_var <- stat_mean + } else { + sigma <- -0.57 + stat_var <- sigma^2 * stat_mean^2 + } + + return(invisible(list(mean = stat_mean, var = stat_var))) +} diff --git a/man/StatSeasAtlHurr.Rd b/man/StatSeasAtlHurr.Rd new file mode 100644 index 0000000..dd7dd8f --- /dev/null +++ b/man/StatSeasAtlHurr.Rd @@ -0,0 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/StatSeasAtlHurr.R +\name{StatSeasAtlHurr} +\alias{StatSeasAtlHurr} +\title{Compute estimate of seasonal mean of Atlantic hurricane activity} +\usage{ +StatSeasAtlHurr(atlano, tropano, hrvar = "HR", ncores = NULL) +} +\arguments{ +\item{atlano}{A numeric array with named dimensions of Atlantic sea surface +temperature anomalies. It must have the same dimensions as 'tropano'.} + +\item{tropano}{A numeric array with named dimensions of tropical sea surface +temperature anomalies. It must have the same dimensions as 'atlano'.} + +\item{hrvar}{A character string of the seasonal average to be estimated. The +options are either "HR" (hurricanes), "TC" (tropical cyclones with lifetime +>=48h), or "PDI" (power dissipation index). The default value is 'HR'.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A list composed of two arrays with the same dimensions as 'atlano' + and 'tropano'. +\item{ + A matrix (mean) with the seasonal average values of the desired quantity.\cr +} +\item{ + A matrix (var) of the variance of that quantity.\cr +} +} +\description{ +Compute one of G. Villarini's statistically downscaled measure of mean +Atlantic hurricane activity and its variance. The hurricane activity is +estimated using seasonal averages of sea surface temperature anomalies over +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 +The statistical models used in this function are described in references. +} +\examples{ +# Let AtlAno represents 5 different 5-year forecasts of seasonally averaged +# Atlantic sea surface temperature anomalies. +AtlAno <- array(runif(25, -1, 1), dim = c(sdate = 5, ftime = 5)) +# Let TropAno represents 5 corresponding 5-year forecasts of seasonally +# averaged tropical sea surface temperature anomalies. +TropAno <- array(runif(25, -1, 1), dim = c(sdate = 5, ftime = 5)) +# The seasonal average of hurricanes for each of the five forecasted years, +# for each forecast, would then be given by. +hr_count <- StatSeasAtlHurr(atlano = AtlAno, tropano = TropAno, hrvar = 'HR') + +} +\references{ +Villarini et al. (2010) Mon Wea Rev, 138, 2681-2705.\cr +Villarini et al. (2012) Mon Wea Rev, 140, 44-65.\cr +Villarini et al. (2012) J Clim, 25, 625-637.\cr +An example of how the function can be used in hurricane forecast studies + is given in\cr +Caron, L.-P. et al. (2014) Multi-year prediction skill of Atlantic hurricane + activity in CMIP5 decadal hindcasts. Climate Dynamics, 42, 2675-2690. + doi:10.1007/s00382-013-1773-1. +} diff --git a/tests/testthat/test-StatSeasAtlHurr.R b/tests/testthat/test-StatSeasAtlHurr.R new file mode 100644 index 0000000..82ef308 --- /dev/null +++ b/tests/testthat/test-StatSeasAtlHurr.R @@ -0,0 +1,110 @@ +context("s2dv::StatSeaAtlHurr tests") + +############################################## + # dat1 + set.seed(1) + atlano1 <- array(runif(30, -1, 1), + dim = c(dat = 2, sdate = 5, ftime = 3)) + + set.seed(2) + tropano1 <- array(runif(30, -1, 1), + dim = c(dat = 2, sdate = 5, ftime = 3)) + + # dat2 + atlano2 <- atlano1 + tropano2 <- tropano1 + atlano2[1, 1, 1] <- NA + tropano2[1, 1, 1:2] <- NA + +############################################## +test_that("1. Input checks", { + + expect_error( + StatSeasAtlHurr(c(), c()), + "Parameter 'atlano' and 'tropano' cannot be NULL." + ) + expect_error( + StatSeasAtlHurr(c('b'), c('a')), + "Parameter 'atlano' and 'tropano' must be a numeric array." + ) + expect_error( + StatSeasAtlHurr(atlano1, array(1:4, dim = c(2, 2))), + "Parameter 'atlano' and 'tropano' must have dimension names." + ) + expect_error( + StatSeasAtlHurr(array(1:10, dim = c(a = 2, c = 5)), array(1:4, dim = c(a = 2, b = 2))), + "Parameter 'atlano' and 'tropano' must have same dimension names." + ) + expect_error( + StatSeasAtlHurr(array(1:10, dim = c(a = 2, c = 5)), array(1:4, dim = c(c = 5, a = 3))), + "Parameter 'atlano' and 'tropano' must have the same length of all the dimensions." + ) + expect_error( + StatSeasAtlHurr(atlano1, tropano1, hrvar = 1), + "The parameter 'hrvar' must be either 'HR', 'TC', or 'PDI'." + ) + expect_error( + StatSeasAtlHurr(atlano1, tropano1, ncores = 1.5), + "Parameter 'ncores' must be a positive integer." + ) + + +}) + +############################################## +test_that("2. Output checks: dat1", { + +expect_equal( +names(StatSeasAtlHurr(atlano1, tropano1)), +c('mean', 'var') +) +expect_equal( +dim(StatSeasAtlHurr(atlano1, tropano1)$mean), +c(dat = 2, sdate = 5, ftime = 3) +) +expect_equal( +dim(StatSeasAtlHurr(atlano1, tropano1)$var), +c(dat = 2, sdate = 5, ftime = 3) +) +expect_equal( +StatSeasAtlHurr(atlano1, tropano1)$mean, +StatSeasAtlHurr(atlano1, tropano1)$var +) +expect_equal( +StatSeasAtlHurr(atlano1, tropano1)$mean[1, 1:2, 2], +c(3.032203, 5.119961), +tolerance = 0.0001 +) +expect_equal( +StatSeasAtlHurr(atlano1, tropano1, hrvar = 'TC')$mean, +StatSeasAtlHurr(atlano1, tropano1, hrvar = 'TC')$var +) +expect_equal( +StatSeasAtlHurr(atlano1, tropano1, hrvar = 'PDI')$mean[1, 1:2, 2], +c(0.5664659, 1.7475613), +tolerance = 0.0001 +) +expect_equal( +StatSeasAtlHurr(atlano1, tropano1, hrvar = 'PDI')$var[1, 1:2, 2], +c(0.1042551, 0.9922350), +tolerance = 0.0001 +) + +}) + +############################################## +test_that("3. Output checks: dat2", { + +expect_equal( +StatSeasAtlHurr(atlano2, tropano2)$mean[1, 1:2, 2], +c(NA, 5.119961), +tolerance = 0.0001 +) +expect_equal( +StatSeasAtlHurr(atlano2, tropano2)$mean[1, 1, ], +c(NA, NA, 10.84862), +tolerance = 0.0001 +) + + +}) -- GitLab From f6cafa13692485045173f8121685c4e8f230c472 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 15 Apr 2021 15:35:35 +0200 Subject: [PATCH 076/154] Update indices Rd file --- man/AMV.Rd | 29 ++++++++++++++--------------- man/GMST.Rd | 51 ++++++++++++++++++++++++--------------------------- man/GSAT.Rd | 30 +++++++++++++++--------------- man/SPOD.Rd | 30 +++++++++++++++--------------- man/TPI.Rd | 30 +++++++++++++++--------------- 5 files changed, 83 insertions(+), 87 deletions(-) diff --git a/man/AMV.Rd b/man/AMV.Rd index 0f81652..3cc4113 100644 --- a/man/AMV.Rd +++ b/man/AMV.Rd @@ -18,16 +18,15 @@ AMV( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,18 +79,17 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the AMV index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the AMV index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Atlantic Multidecadal Variability (AMV), also known as Atlantic @@ -100,7 +98,8 @@ surface temperatures (SST) over the North Atlantic Ocean on multi-decadal time scales. The AMV index is computed as the difference of weighted-averaged SST anomalies over the North Atlantic region (0ºN-60ºN, 280ºE-360ºE) and the weighted-averaged SST anomalies over 60ºS-60ºN, 0ºE-360ºE (Trenberth & -Dennis, 2005; Doblas-Reyes et al., 2013). +Dennis, 2005; Doblas-Reyes et al., 2013). If different members and/or datasets are provided, +the climatology (used to calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/GMST.Rd b/man/GMST.Rd index 8021943..f23e60d 100644 --- a/man/GMST.Rd +++ b/man/GMST.Rd @@ -21,28 +21,25 @@ GMST( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data_tas}{A numerical array indicating the surface air temperature data -to be used for the index computation with the dimensions: 1) latitude, -longitude, start date, forecast month, and member (in case of decadal -predictions), 2) latitude, longitude, year, month and member (in case of -historical simulations), or 3) latitude, longitude, year and month (in case -of observations or reanalyses). This data has to be provided, at least, -over the whole region needed to compute the index. The dimensions must be -identical to those of data_tos.} - -\item{data_tos}{A numerical array indicating the sea surface temperature data -to be used for the index computation with the dimensions: 1) latitude, -longitude, start date, forecast month, and member (in case of decadal -predictions), 2) latitude, longitude, year, month and member (in case of -historical simulations), or 3) latitude, longitude, year and month (in case -of observations or reanalyses). This data has to be provided, at least, -over the whole region needed to compute the index. The dimensions must be -identical to those of data_tas.} +\item{data_tas}{A numerical array with the surface air temperature data +to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be +provided, at least, over the whole region needed to compute the index. +The dimensions must be identical to thos of data_tos. +#'@param data_tos A numerical array with the sea surface temperature data +to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be +provided, at least, over the whole region needed to compute the index. +The dimensions must be identical to thos of data_tas.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -90,7 +87,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -100,23 +97,23 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the GMST anomalies with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the GMST anomalies with the same dimensions as data_tas except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Global Mean Surface Temperature (GMST) anomalies are computed as the weighted-averaged surface air temperature anomalies over land and sea surface -temperature anomalies over the ocean. +temperature anomalies over the ocean. If different members and/or datasets are provided, +the climatology (used to calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/GSAT.Rd b/man/GSAT.Rd index d7fe3cf..9f03ff2 100644 --- a/man/GSAT.Rd +++ b/man/GSAT.Rd @@ -18,16 +18,15 @@ GSAT( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,22 +79,23 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the GSAT anomalies with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the GSAT anomalies with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Global Surface Air Temperature (GSAT) anomalies are computed as the -weighted-averaged surface air temperature anomalies over the global region. +weighted-averaged surface air temperature anomalies over the global region. +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/SPOD.Rd b/man/SPOD.Rd index 0491739..4c4ed29 100644 --- a/man/SPOD.Rd +++ b/man/SPOD.Rd @@ -18,16 +18,15 @@ SPOD( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,25 +79,26 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the SPOD index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the SPOD index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The South Pacific Ocean Dipole (SPOD) index is related to the El Nino-Southern Oscillation (ENSO) and the Inderdecadal Pacific Oscillation (IPO). The SPOD index is computed as the difference of weighted-averaged SST anomalies over 20ºS-48ºS, 165ºE-190ºE (NW pole) and the weighted-averaged SST -anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). +anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/TPI.Rd b/man/TPI.Rd index 3bdc17c..5e8f716 100644 --- a/man/TPI.Rd +++ b/man/TPI.Rd @@ -18,16 +18,15 @@ TPI( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,24 +79,25 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the TPI index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the TPI index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Tripole Index (TPI) for the Interdecadal Pacific Oscillation (IPO) is computed as the difference of weighted-averaged SST anomalies over 10ºS-10ºN, 170ºE-270ºE minus the mean of the weighted-averaged SST anomalies over -25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). +25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses -- GitLab From 42f03000ea5d22180e07bd199c2122d85af16e83 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 15 Apr 2021 16:13:07 +0200 Subject: [PATCH 077/154] Update and fix indices documentation --- R/GMST.R | 2 +- man/AMV.Rd | 29 ++++++++++++++--------------- man/GMST.Rd | 52 +++++++++++++++++++++++++--------------------------- man/GSAT.Rd | 30 +++++++++++++++--------------- man/SPOD.Rd | 30 +++++++++++++++--------------- man/TPI.Rd | 30 +++++++++++++++--------------- 6 files changed, 85 insertions(+), 88 deletions(-) diff --git a/R/GMST.R b/R/GMST.R index a1d8d85..0d6c49e 100644 --- a/R/GMST.R +++ b/R/GMST.R @@ -12,7 +12,7 @@ #' (in case of historical simulations or observations). This data has to be #' provided, at least, over the whole region needed to compute the index. #' The dimensions must be identical to thos of data_tos. -#' #'@param data_tos A numerical array with the sea surface temperature data +#'@param data_tos A numerical array with the sea surface temperature data #' to be used for the index computation with, at least, the #' dimensions: 1) latitude, longitude, start date and forecast month #' (in case of decadal predictions), 2) latitude, longitude, year and month diff --git a/man/AMV.Rd b/man/AMV.Rd index 0f81652..3cc4113 100644 --- a/man/AMV.Rd +++ b/man/AMV.Rd @@ -18,16 +18,15 @@ AMV( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,18 +79,17 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the AMV index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the AMV index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Atlantic Multidecadal Variability (AMV), also known as Atlantic @@ -100,7 +98,8 @@ surface temperatures (SST) over the North Atlantic Ocean on multi-decadal time scales. The AMV index is computed as the difference of weighted-averaged SST anomalies over the North Atlantic region (0ºN-60ºN, 280ºE-360ºE) and the weighted-averaged SST anomalies over 60ºS-60ºN, 0ºE-360ºE (Trenberth & -Dennis, 2005; Doblas-Reyes et al., 2013). +Dennis, 2005; Doblas-Reyes et al., 2013). If different members and/or datasets are provided, +the climatology (used to calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/GMST.Rd b/man/GMST.Rd index 8021943..0ce858b 100644 --- a/man/GMST.Rd +++ b/man/GMST.Rd @@ -21,28 +21,26 @@ GMST( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data_tas}{A numerical array indicating the surface air temperature data -to be used for the index computation with the dimensions: 1) latitude, -longitude, start date, forecast month, and member (in case of decadal -predictions), 2) latitude, longitude, year, month and member (in case of -historical simulations), or 3) latitude, longitude, year and month (in case -of observations or reanalyses). This data has to be provided, at least, -over the whole region needed to compute the index. The dimensions must be -identical to those of data_tos.} - -\item{data_tos}{A numerical array indicating the sea surface temperature data -to be used for the index computation with the dimensions: 1) latitude, -longitude, start date, forecast month, and member (in case of decadal -predictions), 2) latitude, longitude, year, month and member (in case of -historical simulations), or 3) latitude, longitude, year and month (in case -of observations or reanalyses). This data has to be provided, at least, -over the whole region needed to compute the index. The dimensions must be -identical to those of data_tas.} +\item{data_tas}{A numerical array with the surface air temperature data +to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be +provided, at least, over the whole region needed to compute the index. +The dimensions must be identical to thos of data_tos.} + +\item{data_tos}{A numerical array with the sea surface temperature data +to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be +provided, at least, over the whole region needed to compute the index. +The dimensions must be identical to thos of data_tas.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -90,7 +88,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -100,23 +98,23 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the GMST anomalies with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the GMST anomalies with the same dimensions as data_tas except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Global Mean Surface Temperature (GMST) anomalies are computed as the weighted-averaged surface air temperature anomalies over land and sea surface -temperature anomalies over the ocean. +temperature anomalies over the ocean. If different members and/or datasets are provided, +the climatology (used to calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/GSAT.Rd b/man/GSAT.Rd index d7fe3cf..9f03ff2 100644 --- a/man/GSAT.Rd +++ b/man/GSAT.Rd @@ -18,16 +18,15 @@ GSAT( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,22 +79,23 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the GSAT anomalies with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the GSAT anomalies with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Global Surface Air Temperature (GSAT) anomalies are computed as the -weighted-averaged surface air temperature anomalies over the global region. +weighted-averaged surface air temperature anomalies over the global region. +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/SPOD.Rd b/man/SPOD.Rd index 0491739..4c4ed29 100644 --- a/man/SPOD.Rd +++ b/man/SPOD.Rd @@ -18,16 +18,15 @@ SPOD( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,25 +79,26 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the SPOD index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the SPOD index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The South Pacific Ocean Dipole (SPOD) index is related to the El Nino-Southern Oscillation (ENSO) and the Inderdecadal Pacific Oscillation (IPO). The SPOD index is computed as the difference of weighted-averaged SST anomalies over 20ºS-48ºS, 165ºE-190ºE (NW pole) and the weighted-averaged SST -anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). +anomalies over 44ºS-65ºS, 220ºE-260ºE (SE pole) (Saurral et al., 2020). +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses diff --git a/man/TPI.Rd b/man/TPI.Rd index 3bdc17c..5e8f716 100644 --- a/man/TPI.Rd +++ b/man/TPI.Rd @@ -18,16 +18,15 @@ TPI( indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member", + na.rm = TRUE, ncores = NULL ) } \arguments{ -\item{data}{A numerical array to be used for the index computation with the -dimensions: 1) latitude, longitude, start date, forecast month, and member -(in case of decadal predictions), 2) latitude, longitude, year, month and -member (in case of historical simulations), or 3) latitude, longitude, year -and month (in case of observations or reanalyses). This data has to be +\item{data}{A numerical array to be used for the index computation with, at least, the +dimensions: 1) latitude, longitude, start date and forecast month +(in case of decadal predictions), 2) latitude, longitude, year and month +(in case of historical simulations or observations). This data has to be provided, at least, over the whole region needed to compute the index.} \item{data_lats}{A numeric vector indicating the latitudes of the data.} @@ -70,7 +69,7 @@ climatology is calculated over the whole period. If the data are already anomalies, set it to FALSE. The default value is NULL.\cr In case of parameter 'type' is 'dcpp', 'indices_for_clim' must be relative to the first forecast year, and the climatology is automatically computed -over the actual common period for the different forecast years.} +over the common calendar period for the different forecast years.} \item{year_dim}{A character string indicating the name of the year dimension The default value is 'year'. Only used if parameter 'type' is 'hist' or @@ -80,24 +79,25 @@ The default value is 'year'. Only used if parameter 'type' is 'hist' or dimension. The default value is 'month'. Only used if parameter 'type' is 'hist' or 'obs'.} -\item{member_dim}{A character string indicating the name of the member -dimension. The default value is 'member'. Only used if parameter 'type' is -'dcpp' or 'hist'.} +\item{na.rm}{A logical value indicanting whether to remove NA values. The default +value is TRUE.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ -A numerical array of the TPI index with the dimensions of: - 1) sdate, forecast year, and member (in case of decadal predictions); - 2) year and member (in case of historical simulations); or - 3) year (in case of observations or reanalyses). +A numerical array with the TPI index with the same dimensions as data except + the lat_dim, lon_dim and fmonth_dim (month_dim) in case of decadal predictions + (historical simulations or observations). In case of decadal predictions, a new dimension + 'fyear' is added. } \description{ The Tripole Index (TPI) for the Interdecadal Pacific Oscillation (IPO) is computed as the difference of weighted-averaged SST anomalies over 10ºS-10ºN, 170ºE-270ºE minus the mean of the weighted-averaged SST anomalies over -25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). +25ºN-45ºN, 140ºE-215ºE and 50ºS-15ºS, 150ºE-200ºE (Henley et al., 2015). +If different members and/or datasets are provided, the climatology (used to +calculate the anomalies) is computed individually for all of them. } \examples{ ## Observations or reanalyses -- GitLab From b5452b66cdb10b1bdaffc51e1516e7bbf448f5b7 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 15 Apr 2021 16:22:16 +0200 Subject: [PATCH 078/154] Correct example --- R/Spread.R | 2 +- man/Spread.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Spread.R b/R/Spread.R index 9589fae..4b3bc6b 100644 --- a/R/Spread.R +++ b/R/Spread.R @@ -49,7 +49,7 @@ #'smooth_ano_exp <- Smoothing(ano_exp, runmeanlen = runmean_months) #'smooth_ano_exp_m_sub <- smooth_ano_exp - InsertDim(MeanDims(smooth_ano_exp, 'member', #' na.rm = TRUE), -#' posdim = 'member', +#' posdim = 3, #' lendim = dim(smooth_ano_exp)['member'], #' name = 'member') #'spread <- Spread(smooth_ano_exp_m_sub, compute_dim = c('member', 'sdate')) diff --git a/man/Spread.Rd b/man/Spread.Rd index e5f3edd..26e289e 100644 --- a/man/Spread.Rd +++ b/man/Spread.Rd @@ -69,7 +69,7 @@ runmean_months <- 12 smooth_ano_exp <- Smoothing(ano_exp, runmeanlen = runmean_months) smooth_ano_exp_m_sub <- smooth_ano_exp - InsertDim(MeanDims(smooth_ano_exp, 'member', na.rm = TRUE), - posdim = 'member', + posdim = 3, lendim = dim(smooth_ano_exp)['member'], name = 'member') spread <- Spread(smooth_ano_exp_m_sub, compute_dim = c('member', 'sdate')) -- GitLab From 17cf7d302b3aa2fafb9475ca9cd19b5258f5a712 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 15 Apr 2021 16:40:52 +0200 Subject: [PATCH 079/154] Fix document format and typo in function --- R/StatSeasAtlHurr.R | 12 ++++++------ man/StatSeasAtlHurr.Rd | 8 ++++---- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/R/StatSeasAtlHurr.R b/R/StatSeasAtlHurr.R index 358849d..9d0ec38 100644 --- a/R/StatSeasAtlHurr.R +++ b/R/StatSeasAtlHurr.R @@ -22,11 +22,11 @@ #' #'@return A list composed of two arrays with the same dimensions as 'atlano' #' and 'tropano'. -#'\item{ -#' A matrix (mean) with the seasonal average values of the desired quantity.\cr +#'\item{$mean}{ +#' The mean of the desired quantity. #'} -#'\item{ -#' A matrix (var) of the variance of that quantity.\cr +#'\item{$var}{ +#' The variance of that quantity. #'} #' #'@references @@ -109,8 +109,8 @@ StatSeasAtlHurr <- function(atlano, tropano, hrvar = "HR", ncores = NULL) { if (use_Apply) { res <- Apply(list(atlano, tropano), - target_dims = list(c(names(which.max(dim(AtlAno)))), - c(names(which.max(dim(AtlAno))))), + target_dims = list(c(names(which.max(dim(atlano)))), + c(names(which.max(dim(atlano))))), fun = .StatSeasAtlHurr, hrvar = hrvar, ncores = ncores) diff --git a/man/StatSeasAtlHurr.Rd b/man/StatSeasAtlHurr.Rd index dd7dd8f..9657322 100644 --- a/man/StatSeasAtlHurr.Rd +++ b/man/StatSeasAtlHurr.Rd @@ -23,11 +23,11 @@ computation. The default value is NULL.} \value{ A list composed of two arrays with the same dimensions as 'atlano' and 'tropano'. -\item{ - A matrix (mean) with the seasonal average values of the desired quantity.\cr +\item{$mean}{ + The mean of the desired quantity. } -\item{ - A matrix (var) of the variance of that quantity.\cr +\item{$var}{ + The variance of that quantity. } } \description{ -- GitLab From 9299abbbad2930a764a99bf0ef340a32f1b7aad5 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 15 Apr 2021 17:02:33 +0200 Subject: [PATCH 080/154] Include PlotVsLTime.R --- NAMESPACE | 1 + R/PlotVsLTime.R | 265 +++++++++++++++++++++++++++++++++++++++++++++ man/PlotVsLTime.Rd | 144 ++++++++++++++++++++++++ 3 files changed, 410 insertions(+) create mode 100644 R/PlotVsLTime.R create mode 100644 man/PlotVsLTime.Rd diff --git a/NAMESPACE b/NAMESPACE index ea090db..c9ac3a1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -39,6 +39,7 @@ export(PlotLayout) export(PlotMatrix) export(PlotSection) export(PlotStereoMap) +export(PlotVsLTime) export(RMS) export(RMSSS) export(RandomWalkTest) diff --git a/R/PlotVsLTime.R b/R/PlotVsLTime.R new file mode 100644 index 0000000..94c82e0 --- /dev/null +++ b/R/PlotVsLTime.R @@ -0,0 +1,265 @@ +#'Plot a score along the forecast time with its confidence interval +#' +#'Plot the correlation (\code{Corr()}), the root mean square error +#'(\code{RMS()}) between the forecast values and their observational +#'counterpart, the slope of their trend (\code{Trend()}), the +#'InterQuartile range, maximum-mininum, standard deviation or median absolute +#'Deviation of the ensemble members (\code{Spread()}), or the ratio between +#'the ensemble spread and the RMSE of the ensemble mean (\code{RatioSDRMS()}) +#'along the forecast time for all the input experiments on the same figure +#'with their confidence intervals. +#' +#'@param var Matrix containing any Prediction Score with dimensions:\cr +#' (nexp/nmod, 3/4 ,nltime)\cr +#' or (nexp/nmod, nobs, 3/4 ,nltime). +#'@param toptitle Main title, optional. +#'@param ytitle Title of Y-axis, optional. +#'@param monini Starting month between 1 and 12. Default = 1. +#'@param freq 1 = yearly, 12 = monthly, 4 = seasonal, ... Default = 12. +#'@param nticks Number of ticks and labels on the x-axis, optional. +#'@param limits c(lower limit, upper limit): limits of the Y-axis, optional. +#'@param listexp List of experiment names, optional. +#'@param listobs List of observation names, optional. +#'@param biglab TRUE/FALSE for presentation/paper plot. Default = FALSE. +#'@param hlines c(a,b, ..) Add horizontal black lines at Y-positions a,b, ...\cr +#' Default = NULL. +#'@param leg TRUE/FALSE if legend should be added or not to the plot. +#' Default = TRUE. +#'@param siglev TRUE/FALSE if significance level should replace confidence +#' interval.\cr +#' Default = FALSE. +#'@param sizetit Multiplicative factor to change title size, optional. +#'@param show_conf TRUE/FALSE to show/not confidence intervals for input +#' variables. +#'@param fileout Name of output file. Extensions allowed: eps/ps, jpeg, png, +#' pdf, bmp and tiff. The default value is NULL. +#'@param width File width, in the units specified in the parameter size_units +#' (inches by default). Takes 8 by default. +#'@param height File height, in the units specified in the parameter +#' size_units (inches by default). Takes 5 by default. +#'@param size_units Units of the size of the device (file or window) to plot +#' in. Inches ('in') by default. See ?Devices and the creator function of the +#' corresponding device. +#'@param res Resolution of the device (file or window) to plot in. See +#' ?Devices and the creator function of the corresponding device. +#'@param ... Arguments to be passed to the method. Only accepts the following +#' graphical parameters:\cr +#' adj ann ask bg bty cex.sub cin col.axis col.lab col.main col.sub cra crt +#' csi cxy err family fg fig font font.axis font.lab font.main font.sub +#' lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page pch plt +#' smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +#' For more information about the parameters see `par`. +#' +#'@details +#'Examples of input:\cr +#'Model and observed output from \code{Load()} then \code{Clim()} then +#'\code{Ano()} then \code{Smoothing()}:\cr +#'(nmod, nmemb, nsdate, nltime) and (nobs, nmemb, nsdate, nltime)\cr +#'then averaged over the members\cr +#'\code{Mean1Dim(var_exp/var_obs, posdim = 2)}:\cr +#'(nmod, nsdate, nltime) and (nobs, nsdate, nltime)\cr +#'then passed through\cr +#' \code{Corr(exp, obs, posloop = 1, poscor = 2)} or\cr +#' \code{RMS(exp, obs, posloop = 1, posRMS = 2)}:\cr +#' (nmod, nobs, 3, nltime)\cr +#'would plot the correlations or RMS between each exp & each obs as a function +#'of the forecast time. +#' +#'@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) +#'runmean_months <- 12 +#'smooth_ano_exp <- Smoothing(data = ano_exp, runmeanlen = runmean_months) +#'smooth_ano_obs <- Smoothing(data = ano_obs, runmeanlen = runmean_months) +#'dim_to_mean <- 'member' # mean along members +#'required_complete_row <- 'ftime' # discard startdates for which there are NA leadtimes +#'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, +#' 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 <- Reorder(corr_combine, c(2, 3, 1, 4)) +#'\donttest{ +#'PlotVsLTime(corr_combine, toptitle = "correlations", ytitle = "correlation", +#' monini = 11, limits = c(-1, 2), listexp = c('CMIP5 IC3'), +#' listobs = c('ERSST'), biglab = FALSE, hlines = c(-1, 0, 1)) +#' } +#' +#'@importFrom grDevices dev.cur dev.new dev.off +#'@importFrom stats ts +#'@export +PlotVsLTime <- function(var, toptitle = '', ytitle = '', monini = 1, freq = 12, + nticks = NULL, limits = NULL, + listexp = c('exp1', 'exp2', 'exp3'), + listobs = c('obs1', 'obs2', 'obs3'), biglab = FALSE, hlines = NULL, + leg = TRUE, siglev = FALSE, sizetit = 1, show_conf = TRUE, + fileout = NULL, + 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", "fin", "lab", "las", "lend", "lty", "lwd", "mai", "mgp", "new", "pin", "ps", "pty") + userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) + + # If there is any filenames to store the graphics, process them + # to select the right device + if (!is.null(fileout)) { + deviceInfo <- .SelectDevice(fileout = fileout, width = width, height = height, units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + # + # Get some arguments + # ~~~~~~~~~~~~~~~~~~~~ + # + if (length(dim(var)) == 3) { + var <- InsertDim(var, posdim = 2, lendim = 1) + } else if (length(dim(var)) != 4) { + stop("Parameter 'var' should have 3 or 4 dimensions: c(n. exp[, n. obs], 3/4, n. lead-times)") + } + nleadtime <- dim(var)[4] + nexp <- dim(var)[1] + nobs <- dim(var)[2] + if (is.null(limits) == TRUE) { + if (all(is.na(var > 0))) { + ll <- ul <- 0 + } else { + ll <- min(var, na.rm = TRUE) + ul <- max(var, na.rm = TRUE) + } + if (biglab) { + ul <- ul + 0.4 * (ul - ll) + } else { + ul <- ul + 0.3 * (ul - ll) + } + } else { + ll <- limits[1] + ul <- limits[2] + } + lastyear <- (monini + (nleadtime - 1) * 12 / freq - 1) %/% 12 + lastmonth <- (monini + (nleadtime - 1) * 12 / freq - 1) %% 12 + 1 + empty_ts <- ts(start = c(0000, (monini - 1) %/% (12 / freq) + 1), + end = c(lastyear, (lastmonth - 1) %/% (12 / freq) + 1), + frequency = freq) + empty <- array(dim = length(empty_ts)) + # + # Define some plot parameters + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + if (is.null(nticks)) { + if (biglab) { + nticks <- 5 + } else { + nticks <- 10 + } + } + labind <- seq(1, nleadtime, max(nleadtime %/% nticks, 1)) + months <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", + "Oct", "Nov", "Dec") + labyear <- ((labind - 1) * 12 / freq + monini - 1) %/% 12 + labmonth <- months[((labind - 1) * 12 / freq + monini -1 ) %% 12 + 1] + for (jx in 1:length(labmonth)) { + y2o3dig <- paste("0", as.character(labyear[jx]), sep = "") + labmonth[jx] <- paste(labmonth[jx], "\nYr ", substr(y2o3dig, nchar(y2o3dig) + - 1, nchar(y2o3dig)), sep = "") + } + color <- c("red1", "dodgerblue1", "green1", "orange1", "lightblue1", + "deeppink1", "mediumpurple1", "lightgoldenrod1", "olivedrab1", + "mediumorchid1") + type <- c(1, 3, 2, 4) + thickness <- array(dim = c(4, 4)) + thickness[, 1] <- c(1, 2, 1, 1.5) + thickness[, 2] <- c(8, 12, 8, 10) + thickness[, 3] <- thickness[, 1] + thickness[, 4] <- c(4, 6, 4, 5) + if (siglev == TRUE) { + lines <- c("n", "l", "n", "l") + } else { + lines <- c("l", "l", "l", "n") + } + # + # Define plot layout + # ~~~~~~~~~~~~~~~~~~~~ + # + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, width = width, height = height) + } + + # Load the user parameters + par(userArgs) + + if (biglab) { + par(mai = c(1.25, 1.4, 0.5, 1), mgp = c(4, 2.5, 0)) + par(cex = 1.3, cex.lab = 2, cex.axis = 1.8) + cexmain <- 2.2 + legsize <- 1.5 + } else { + par(mai = c(1, 1.1, 0.5, 0), mgp = c(3, 1.8, 0)) + par(cex = 1.3, cex.lab = 1.5, cex.axis = 1.1) + cexmain <- 1.5 + legsize <- 1 + } + plot(empty, ylim = c(ll, ul), xlab = "Time (months)", ylab = ytitle, + main = toptitle, cex.main = cexmain*sizetit, axes = FALSE) + axis(1, at = labind, labels = labmonth) + axis(2) + box() + if (is.null(hlines) != TRUE) { + for (jy in 1:length(hlines)) { + par(new = TRUE) + abline(h = hlines[jy]) + } + } + # + # Loop on experimental & observational data + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + legendnames <- array(dim = nobs * nexp) + legendthick <- array(dim = nobs * nexp) + legendsty <- array(dim = nobs * nexp) + legendcol <- array(dim = nobs * nexp) + ind <- 1 + if (show_conf == TRUE) { + start_line <- dim(var)[3] + end_line <- 1 + } else { + start_line <- 2 + end_line <- 2 + } + for (jt in seq(start_line, end_line, -1)) { + ind <- 1 + for (jexp in 1:nexp) { + for (jobs in 1:nobs) { + par(new = TRUE) + plot(var[jexp, jobs, jt, ], type = lines[jt], ylim = c(ll, ul), + col = color[jexp], lty = type[jobs], lwd = thickness[jobs, jt], + ylab = "", xlab = "", axes = FALSE) + legendnames[ind] <- paste(listexp[jexp], 'vs', listobs[jobs]) + legendthick[ind] <- thickness[jobs, 1] * 3 + legendsty[ind] <- type[jobs] + legendcol[ind] <- color[jexp] + ind <- ind + 1 + } + } + } + if (leg) { + if (nobs == 1) { + legendnames <- listexp[1:nexp] + } + legend(1, ul, legendnames, lty = legendsty, lwd = legendthick, + col = legendcol, cex = legsize) + } + + # If the graphic was saved to file, close the connection with the device + if(!is.null(fileout)) dev.off() +} diff --git a/man/PlotVsLTime.Rd b/man/PlotVsLTime.Rd new file mode 100644 index 0000000..05e2b42 --- /dev/null +++ b/man/PlotVsLTime.Rd @@ -0,0 +1,144 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PlotVsLTime.R +\name{PlotVsLTime} +\alias{PlotVsLTime} +\title{Plot a score along the forecast time with its confidence interval} +\usage{ +PlotVsLTime( + var, + toptitle = "", + ytitle = "", + monini = 1, + freq = 12, + nticks = NULL, + limits = NULL, + listexp = c("exp1", "exp2", "exp3"), + listobs = c("obs1", "obs2", "obs3"), + biglab = FALSE, + hlines = NULL, + leg = TRUE, + siglev = FALSE, + sizetit = 1, + show_conf = TRUE, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) +} +\arguments{ +\item{var}{Matrix containing any Prediction Score with dimensions:\cr +(nexp/nmod, 3/4 ,nltime)\cr +or (nexp/nmod, nobs, 3/4 ,nltime).} + +\item{toptitle}{Main title, optional.} + +\item{ytitle}{Title of Y-axis, optional.} + +\item{monini}{Starting month between 1 and 12. Default = 1.} + +\item{freq}{1 = yearly, 12 = monthly, 4 = seasonal, ... Default = 12.} + +\item{nticks}{Number of ticks and labels on the x-axis, optional.} + +\item{limits}{c(lower limit, upper limit): limits of the Y-axis, optional.} + +\item{listexp}{List of experiment names, optional.} + +\item{listobs}{List of observation names, optional.} + +\item{biglab}{TRUE/FALSE for presentation/paper plot. Default = FALSE.} + +\item{hlines}{c(a,b, ..) Add horizontal black lines at Y-positions a,b, ...\cr +Default = NULL.} + +\item{leg}{TRUE/FALSE if legend should be added or not to the plot. +Default = TRUE.} + +\item{siglev}{TRUE/FALSE if significance level should replace confidence +interval.\cr +Default = FALSE.} + +\item{sizetit}{Multiplicative factor to change title size, optional.} + +\item{show_conf}{TRUE/FALSE to show/not confidence intervals for input +variables.} + +\item{fileout}{Name of output file. Extensions allowed: eps/ps, jpeg, png, +pdf, bmp and tiff. The default value is NULL.} + +\item{width}{File width, in the units specified in the parameter size_units +(inches by default). Takes 8 by default.} + +\item{height}{File height, in the units specified in the parameter +size_units (inches by default). Takes 5 by default.} + +\item{size_units}{Units of the size of the device (file or window) to plot +in. Inches ('in') by default. See ?Devices and the creator function of the +corresponding device.} + +\item{res}{Resolution of the device (file or window) to plot in. See +?Devices and the creator function of the corresponding device.} + +\item{...}{Arguments to be passed to the method. Only accepts the following +graphical parameters:\cr +adj ann ask bg bty cex.sub cin col.axis col.lab col.main col.sub cra crt +csi cxy err family fg fig font font.axis font.lab font.main font.sub +lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page pch plt +smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +For more information about the parameters see `par`.} +} +\description{ +Plot the correlation (\code{Corr()}), the root mean square error +(\code{RMS()}) between the forecast values and their observational +counterpart, the slope of their trend (\code{Trend()}), the +InterQuartile range, maximum-mininum, standard deviation or median absolute +Deviation of the ensemble members (\code{Spread()}), or the ratio between +the ensemble spread and the RMSE of the ensemble mean (\code{RatioSDRMS()}) +along the forecast time for all the input experiments on the same figure +with their confidence intervals. +} +\details{ +Examples of input:\cr +Model and observed output from \code{Load()} then \code{Clim()} then +\code{Ano()} then \code{Smoothing()}:\cr +(nmod, nmemb, nsdate, nltime) and (nobs, nmemb, nsdate, nltime)\cr +then averaged over the members\cr +\code{Mean1Dim(var_exp/var_obs, posdim = 2)}:\cr +(nmod, nsdate, nltime) and (nobs, nsdate, nltime)\cr +then passed through\cr + \code{Corr(exp, obs, posloop = 1, poscor = 2)} or\cr + \code{RMS(exp, obs, posloop = 1, posRMS = 2)}:\cr + (nmod, nobs, 3, nltime)\cr +would plot the correlations or RMS between each exp & each obs as a function +of the forecast time. +} +\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) +runmean_months <- 12 +smooth_ano_exp <- Smoothing(data = ano_exp, runmeanlen = runmean_months) +smooth_ano_obs <- Smoothing(data = ano_obs, runmeanlen = runmean_months) +dim_to_mean <- 'member' # mean along members +required_complete_row <- 'ftime' # discard startdates for which there are NA leadtimes +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, + 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 <- Reorder(corr_combine, c(2, 3, 1, 4)) +\donttest{ +PlotVsLTime(corr_combine, toptitle = "correlations", ytitle = "correlation", + monini = 11, limits = c(-1, 2), listexp = c('CMIP5 IC3'), + listobs = c('ERSST'), biglab = FALSE, hlines = c(-1, 0, 1)) + } + +} -- GitLab From 654aae7b7e12074cd91a02fca897376be5812ac5 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 15 Apr 2021 17:41:22 +0200 Subject: [PATCH 081/154] Include Plot2VarsVsLTime.R --- NAMESPACE | 1 + R/Plot2VarsVsLTime.R | 256 ++++++++++++++++++++++++++++++++++++++++ man/Plot2VarsVsLTime.Rd | 136 +++++++++++++++++++++ 3 files changed, 393 insertions(+) create mode 100644 R/Plot2VarsVsLTime.R create mode 100644 man/Plot2VarsVsLTime.Rd diff --git a/NAMESPACE b/NAMESPACE index c9ac3a1..19648b8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -31,6 +31,7 @@ export(LeapYear) export(Load) export(MeanDims) export(Persistence) +export(Plot2VarsVsLTime) export(PlotACC) export(PlotAno) export(PlotClim) diff --git a/R/Plot2VarsVsLTime.R b/R/Plot2VarsVsLTime.R new file mode 100644 index 0000000..1c784dd --- /dev/null +++ b/R/Plot2VarsVsLTime.R @@ -0,0 +1,256 @@ +#'Plot two scores with confidence intervals in a common plot +#' +#'Plot two input variables that have the same dimensions in a common plot. +#'One plot for all experiments. +#'The input variables should have dimensions (nexp/nmod, nltime). +#' +#'@param var1 Matrix of dimensions (nexp/nmod, nltime). +#'@param var2 Matrix of dimensions (nexp/nmod, nltime). +#'@param toptitle Main title, optional. +#'@param ytitle Title of Y-axis, optional. +#'@param monini Starting month between 1 and 12. Default = 1. +#'@param freq 1 = yearly, 12 = monthly, 4 = seasonal, ... Default = 12. +#'@param nticks Number of ticks and labels on the x-axis, optional. +#'@param limits c(lower limit, upper limit): limits of the Y-axis, optional. +#'@param listexp List of experiment names, up to three, optional. +#'@param listvars List of names of input variables, optional. +#'@param biglab TRUE/FALSE for presentation/paper plot. Default = FALSE. +#'@param hlines c(a, b, ...) Add horizontal black lines at Y-positions a, b, +#' ... The default value is NULL. +#'@param leg TRUE/FALSE if legend should be added or not to the plot. +#' Default = TRUE. +#'@param siglev TRUE/FALSE if significance level should replace confidence +#' interval.\cr +#' Default = FALSE. +#'@param sizetit Multiplicative factor to change title size, optional. +#'@param show_conf TRUE/FALSE to show/not confidence intervals for input +#' variables. +#'@param fileout Name of output file. Extensions allowed: eps/ps, jpeg, png, +#' pdf, bmp and tiff. The default value is NULL. +#'@param width File width, in the units specified in the parameter size_units +#' (inches by default). Takes 8 by default. +#'@param height File height, in the units specified in the parameter +#' size_units (inches by default). Takes 5 by default. +#'@param size_units Units of the size of the device (file or window) to plot +#' in. Inches ('in') by default. See ?Devices and the creator function of the +#' corresponding device. +#'@param res Resolution of the device (file or window) to plot in. See +#' ?Devices and the creator function of the corresponding device. +#'@param ... Arguments to be passed to the method. Only accepts the following +#' graphical parameters:\cr +#' adj ann ask bg bty cex.sub cin col.axis col.lab col.main col.sub cra crt +#' csi cxy err family fg fig font font.axis font.lab font.main font.sub lend +#' lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page pch plt +#' smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +#' For more information about the parameters see `par`. +#' +#'@details +#'Examples of input:\cr +#'------------------\cr\cr +#'RMSE error for a number of experiments and along lead-time: (nexp, nltime) +#' +#'@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) +#'runmean_months <- 12 +#'smooth_ano_exp <- Smoothing(data = ano_exp, runmeanlen = runmean_months) +#'smooth_ano_obs <- Smoothing(data = ano_obs, runmeanlen = runmean_months) +#'dim_to_mean <- 'member' # mean along members +#'required_complete_row <- 'ftime' # discard startdates for which there are NA leadtimes +#'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, +#' limits = c(ceiling((runmean_months + 1) / 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') +#'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)) +#' \donttest{ +#'Plot2VarsVsLTime(InsertDim(rms_combine[, , , ], 1, 1), Reorder(spread$sd, c(1, 3, 2)), +#' toptitle = 'RMSE and spread', monini = 11, freq = 12, +#' listexp = c('CMIP5 IC3'), listvar = c('RMSE', 'spread')) +#' } +#' +#'@importFrom grDevices png jpeg postscript pdf svg bmp tiff postscript dev.cur dev.new dev.off +#'@importFrom stats ts +#'@export +Plot2VarsVsLTime <- function(var1, var2, toptitle = '', ytitle = '', monini = 1, + freq = 12, nticks = NULL, limits = NULL, listexp = + c('exp1', 'exp2', 'exp3'), listvars = c('var1', + 'var2'), biglab = FALSE, hlines = NULL, leg = TRUE, + siglev = FALSE, sizetit = 1, show_conf = TRUE, + fileout = NULL, + 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", "fin", "lab", "las", "lty", "lwd", "mai", "mgp", "new", "pin", "ps", "pty") + userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) + + # If there is any filenames to store the graphics, process them + # to select the right device + if (!is.null(fileout)) { + deviceInfo <- .SelectDevice(fileout = fileout, width = width, height = height, units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + # + nvars <- 2 + + if (length(dim(var1)) != length(dim(var2))) { + print("the two input variables should have the same dimensions") + stop() + } + if (length(dim(var1)) >= 4) { + print("dimensions of input variables should be 3") + stop() + } + nleadtime <- dim(var1)[3] + nexp <- dim(var1)[1] + var <- array(dim = c(nvars, nexp, 3, nleadtime)) + for (jvar in 1:nvars) { + varname <- paste("var", as.character(jvar), sep = "") + var[jvar, , , ] <- get(varname) + rm(varname) + } + + if (is.null(limits) == TRUE) { + ll <- min(var1, na.rm = TRUE) + ul <- max(var1, na.rm = TRUE) + if (biglab) { + ul <- ul + 0.4 * (ul - ll) + } else { + ul <- ul + 0.3 * (ul - ll) + } + } else { + ll <- limits[1] + ul <- limits[2] + } + lastyear <- (monini + (nleadtime - 1) * 12 / freq - 1) %/% 12 + lastmonth <- (monini + (nleadtime - 1) * 12 / freq - 1) %% 12 + 1 + empty_ts <- ts(start = c(0000, (monini - 1) %/% (12 / freq) + 1), + end = c(lastyear, (lastmonth - 1) %/% (12 / freq) + 1), + frequency = freq) + empty <- array(dim = length(empty_ts)) + # + # Define some plot parameters + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + if (is.null(nticks)) { + if (biglab) { + nticks <- 5 + } else { + nticks <- 10 + } + } + labind <- seq(1, nleadtime, max(nleadtime %/% nticks, 1)) + months <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", + "Oct", "Nov", "Dec") + labyear <- ((labind - 1) * 12 / freq + monini - 1) %/% 12 + labmonth <- months[((labind - 1) * 12 / freq + monini - 1) %% 12 + 1] + for (jx in 1:length(labmonth)) { + y2o3dig <- paste("0", as.character(labyear[jx]), sep = "") + labmonth[jx] <- paste(labmonth[jx], "\nYr ", substr(y2o3dig, nchar(y2o3dig) + - 1, nchar(y2o3dig)), sep = "") + } + color <- c("red1", "dodgerblue1", "green1", "orange1", "lightblue1", + "deeppink1", "mediumpurple1", "lightgoldenrod1", "olivedrab1", + "mediumorchid1") + type <- c(1, 3) + if (siglev == TRUE) { + lines <- c("n", "l", "n") + } + else{ + lines <- c("l", "l", "l") + } + thickness <- array(dim = c(3)) + thickness[1] <- c(1) + thickness[2] <- c(8) + thickness[3] <- thickness[1] + + # + # Define plot layout + # ~~~~~~~~~~~~~~~~~~~~ + # + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, width = width, height = height) + } + + # Load the user parameters + par(userArgs) + + if (biglab) { + par(mai = c(1.25, 1.4, 0.5, 1), mgp = c(4, 2.5, 0)) + par(cex = 1.3, cex.lab = 2, cex.axis = 1.8) + cexmain <- 2.2 + legsize <- 1.5 + } else { + par(mai = c(1, 1.1, 0.5, 0), mgp = c(3, 1.8, 0)) + par(cex = 1.3, cex.lab = 1.5, cex.axis = 1.1) + cexmain <- 1.5 + legsize <- 1 + } + plot(empty, ylim = c(ll, ul), xlab = "Time (months)", ylab = ytitle, + main = toptitle, cex.main = cexmain * sizetit, axes = FALSE) + axis(1, at = labind, labels = labmonth) + axis(2) + box() + if (is.null(hlines) != TRUE) { + for (jy in 1:length(hlines)) { + par(new = TRUE) + abline(h = hlines[jy]) + } + } + # + # Loop on experimental data + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + legendnames <- array(dim = nexp * nvars) + legendthick <- array(dim = nexp * nvars) + legendsty <- array(dim = nexp * nvars) + legendcol <- array(dim = nexp * nvars) + if (show_conf == TRUE) { + start_line <- 3 + end_line <- 1 + } else { + start_line <- 2 + end_line <- 2 + } + for (jint in seq(start_line, end_line, -1)) { + ind <- 1 + for (jexp in 1:nexp) { + for (jvar in 1:nvars) { + par(new = TRUE) + plot(var[jvar, jexp, jint, ], type = lines[jint], ylim = c(ll, ul), + col = color[jexp], lty = type[jvar], lwd = thickness[jint], + ylab = "", xlab = "", axes = FALSE) + legendnames[ind] <- paste(listexp[jexp], listvars[jvar]) + legendthick[ind] <- 2 + legendsty[ind] <- type[jvar] + legendcol[ind] <- color[jexp] + ind <- ind + 1 + } + } + } + if (leg) { + legend(1, ul, legendnames, lty = legendsty, lwd = legendthick, + col = legendcol, cex = legsize) + } + + # If the graphic was saved to file, close the connection with the device + if(!is.null(fileout)) dev.off() +} diff --git a/man/Plot2VarsVsLTime.Rd b/man/Plot2VarsVsLTime.Rd new file mode 100644 index 0000000..46b9cd5 --- /dev/null +++ b/man/Plot2VarsVsLTime.Rd @@ -0,0 +1,136 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Plot2VarsVsLTime.R +\name{Plot2VarsVsLTime} +\alias{Plot2VarsVsLTime} +\title{Plot two scores with confidence intervals in a common plot} +\usage{ +Plot2VarsVsLTime( + var1, + var2, + toptitle = "", + ytitle = "", + monini = 1, + freq = 12, + nticks = NULL, + limits = NULL, + listexp = c("exp1", "exp2", "exp3"), + listvars = c("var1", "var2"), + biglab = FALSE, + hlines = NULL, + leg = TRUE, + siglev = FALSE, + sizetit = 1, + show_conf = TRUE, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) +} +\arguments{ +\item{var1}{Matrix of dimensions (nexp/nmod, nltime).} + +\item{var2}{Matrix of dimensions (nexp/nmod, nltime).} + +\item{toptitle}{Main title, optional.} + +\item{ytitle}{Title of Y-axis, optional.} + +\item{monini}{Starting month between 1 and 12. Default = 1.} + +\item{freq}{1 = yearly, 12 = monthly, 4 = seasonal, ... Default = 12.} + +\item{nticks}{Number of ticks and labels on the x-axis, optional.} + +\item{limits}{c(lower limit, upper limit): limits of the Y-axis, optional.} + +\item{listexp}{List of experiment names, up to three, optional.} + +\item{listvars}{List of names of input variables, optional.} + +\item{biglab}{TRUE/FALSE for presentation/paper plot. Default = FALSE.} + +\item{hlines}{c(a, b, ...) Add horizontal black lines at Y-positions a, b, +... The default value is NULL.} + +\item{leg}{TRUE/FALSE if legend should be added or not to the plot. +Default = TRUE.} + +\item{siglev}{TRUE/FALSE if significance level should replace confidence +interval.\cr +Default = FALSE.} + +\item{sizetit}{Multiplicative factor to change title size, optional.} + +\item{show_conf}{TRUE/FALSE to show/not confidence intervals for input +variables.} + +\item{fileout}{Name of output file. Extensions allowed: eps/ps, jpeg, png, +pdf, bmp and tiff. The default value is NULL.} + +\item{width}{File width, in the units specified in the parameter size_units +(inches by default). Takes 8 by default.} + +\item{height}{File height, in the units specified in the parameter +size_units (inches by default). Takes 5 by default.} + +\item{size_units}{Units of the size of the device (file or window) to plot +in. Inches ('in') by default. See ?Devices and the creator function of the +corresponding device.} + +\item{res}{Resolution of the device (file or window) to plot in. See +?Devices and the creator function of the corresponding device.} + +\item{...}{Arguments to be passed to the method. Only accepts the following +graphical parameters:\cr +adj ann ask bg bty cex.sub cin col.axis col.lab col.main col.sub cra crt +csi cxy err family fg fig font font.axis font.lab font.main font.sub lend +lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page pch plt +smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +For more information about the parameters see `par`.} +} +\description{ +Plot two input variables that have the same dimensions in a common plot. +One plot for all experiments. +The input variables should have dimensions (nexp/nmod, nltime). +} +\details{ +Examples of input:\cr +------------------\cr\cr +RMSE error for a number of experiments and along lead-time: (nexp, nltime) +} +\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) +runmean_months <- 12 +smooth_ano_exp <- Smoothing(data = ano_exp, runmeanlen = runmean_months) +smooth_ano_obs <- Smoothing(data = ano_obs, runmeanlen = runmean_months) +dim_to_mean <- 'member' # mean along members +required_complete_row <- 'ftime' # discard startdates for which there are NA leadtimes +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, + limits = c(ceiling((runmean_months + 1) / 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') +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)) + \donttest{ +Plot2VarsVsLTime(InsertDim(rms_combine[, , , ], 1, 1), Reorder(spread$sd, c(1, 3, 2)), + toptitle = 'RMSE and spread', monini = 11, freq = 12, + listexp = c('CMIP5 IC3'), listvar = c('RMSE', 'spread')) + } + +} -- GitLab From ca924e329d9f5f13c9985741ce052eb5f910e9ef Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 16 Apr 2021 14:02:47 +0200 Subject: [PATCH 082/154] Transform RatioRMS and create unit test --- NAMESPACE | 1 + R/RatioRMS.R | 188 +++++++++++++++++++++++++++++++++ man/RatioRMS.Rd | 85 +++++++++++++++ tests/testthat/test-RatioRMS.R | 128 ++++++++++++++++++++++ 4 files changed, 402 insertions(+) create mode 100644 R/RatioRMS.R create mode 100644 man/RatioRMS.Rd create mode 100644 tests/testthat/test-RatioRMS.R diff --git a/NAMESPACE b/NAMESPACE index 87937e2..fd51fc8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -42,6 +42,7 @@ export(PlotStereoMap) export(RMS) export(RMSSS) export(RandomWalkTest) +export(RatioRMS) export(Regression) export(Reorder) export(SPOD) diff --git a/R/RatioRMS.R b/R/RatioRMS.R new file mode 100644 index 0000000..f93e486 --- /dev/null +++ b/R/RatioRMS.R @@ -0,0 +1,188 @@ +#'Compute the ratio between the RMSE of two experiments +#' +#'Calculate the ratio of the RMSE for two forecasts with the same observation, +#'that is, RMSE(ens, obs) / RMSE(ens.ref, obs). The p-value is provided by a +#'two-sided Fischer test. +#' +#'@param exp1 A numeric array with named dimensions of the first experimental +#' data. It must have at least 'time_dim' and have the same dimensions as +#' 'exp2' and 'obs'. +#'@param exp2 A numeric array with named dimensions of the second experimental +#' data. It must have at least 'time_dim' and have the same dimensions as +#' 'exp1' and 'obs'. +#'@param obs A numeric array with named dimensions of the observational data. +#' It must have at least 'time_dim' and have the same dimensions as 'exp1' and +#' 'exp2'. +#'@param time_dim A character string of the dimension name along which RMS is +#' computed. The default value is 'sdate'. +#'@param pval A logical value indicating whether to compute the p-value of Ho: +#' RMSE1/RMSE2 = 1 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. +#' +#'@return A list containing the numeric arrays with dimensions identical with +#' 'exp1', 'exp2', and 'obs', expect 'time_dim': +#'\item{$ratiorms}{ +#' The ratio between the RMSE (i.e., RMSE1/RMSE2). +#'} +#'\item{$p.val}{ +#' The p-value of the two-sided Fisher test with Ho: RMSE1/RMSE2 = 1. Only +#' exists if 'pval' is TRUE. +#'} +#' +#'@examples +#'\dontshow{ +#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), +#' c('observation'), startDates, +#' output = 'lonlat', +#' latmin = 27, latmax = 48, +#' lonmin = -12, lonmax = 40) +#'} +#'# Compute DJF seasonal means and anomalies. +#'initial_month <- 11 +#'mean_start_month <- 12 +#'mean_stop_month <- 2 +#'sampleData$mod <- Season(sampleData$mod, monini = initial_month, +#' moninf = mean_start_month, monsup = mean_stop_month) +#'sampleData$obs <- Season(sampleData$obs, monini = initial_month, +#' moninf = mean_start_month, monsup = mean_stop_month) +#'clim <- Clim(sampleData$mod, sampleData$obs) +#'ano_exp <- Ano(sampleData$mod, clim$clim_exp) +#'ano_obs <- Ano(sampleData$obs, clim$clim_obs) +#'# Generate two experiments with 2 and 1 members from the only experiment +#'# available in the sample data. Take only data values for a single forecast +#'# time step. +#'ano_exp_1 <- Subset(ano_exp, 'member', c(1, 2)) +#'ano_exp_2 <- Subset(ano_exp, 'member', c(3)) +#'ano_exp_1 <- Subset(ano_exp_1, c('dataset', 'ftime'), list(1, 1), drop = 'selected') +#'ano_exp_2 <- Subset(ano_exp_2, c('dataset', 'ftime'), list(1, 1), drop = 'selected') +#'ano_obs <- Subset(ano_obs, c('dataset', 'ftime'), list(1, 1), drop = 'selected') +#'# Compute ensemble mean and provide as inputs to RatioRMS. +#'rrms <- RatioRMS(MeanDims(ano_exp_1, 'member'), +#' MeanDims(ano_exp_2, 'member'), +#' MeanDims(ano_obs, 'member')) +#'# Plot the RatioRMS for the first forecast time step. +#'\donttest{ +#'PlotEquiMap(rrms$ratiorms, sampleData$lon, sampleData$lat, +#' toptitle = 'Ratio RMSE') +#'} +#' +#'@import multiApply +#'@export +RatioRMS <- function(exp1, exp2, obs, time_dim = 'sdate', pval = TRUE, ncores = NULL) { + + # Check inputs + ## exp1, exp2, obs + if (is.null(exp1) | is.null(exp2) | is.null(obs)) { + stop("Parameter 'exp1', 'exp2', and 'obs' cannot be NULL.") + } + if (!is.numeric(exp1) | !is.numeric(exp2) | !is.numeric(obs)) { + stop("Parameter 'exp1', 'exp2', and 'obs' must be a numeric array.") + } + if (is.null(dim(exp1))) { #is vector + dim(exp1) <- c(length(exp1)) + names(dim(exp1)) <- time_dim + } + if (is.null(dim(exp2))) { #is vector + dim(exp2) <- c(length(exp2)) + names(dim(exp2)) <- time_dim + } + if (is.null(dim(obs))) { #is vector + dim(obs) <- c(length(obs)) + names(dim(obs)) <- time_dim + } + if(any(is.null(names(dim(exp1))))| any(nchar(names(dim(exp1))) == 0) | + any(is.null(names(dim(exp2))))| any(nchar(names(dim(exp2))) == 0) | + any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { + stop("Parameter 'exp1', 'exp2', and 'obs' must have dimension names.") + } + if(!all(names(dim(exp1)) %in% names(dim(exp2))) | + !all(names(dim(exp2)) %in% names(dim(obs))) | + !all(names(dim(obs)) %in% names(dim(exp1)))) { + stop("Parameter 'exp1', 'exp2', and 'obs' must have same dimension names.") + } + name_1 <- sort(names(dim(exp1))) + name_2 <- sort(names(dim(exp2))) + name_3 <- sort(names(dim(obs))) + if (!all(dim(exp1)[name_1] == dim(exp2)[name_2]) | + !all(dim(exp1)[name_1] == dim(obs)[name_3])) { + stop(paste0("Parameter 'exp1', 'exp2', and 'obs' must have the same length of ", + "all the dimensions.")) + } + ## 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(exp1))) { + stop("Parameter 'time_dim' is not found in 'exp1', 'exp2', and 'obs' dimensions.") + } + ## pval + if (!is.logical(pval) | length(pval) > 1) { + stop("Parameter 'pval' must be one logical value.") + } + ## 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.") + } + } + + ############################### + # Calculate RatioRMS + if (is.null(ncores)) { + use_Apply <- FALSE + } else if (ncores == 1) { + use_Apply <- FALSE + } else { + use_Apply <- TRUE + } + + if (use_Apply) { + res <- Apply(list(exp1, exp2, obs), + target_dims = list(c(names(dim(exp1))), + c(names(dim(exp1))), + c(names(dim(exp1)))), + fun = .RatioRMS, + time_dim = time_dim, pval = pval, + ncores = ncores) + } else { + res <- .RatioRMS(exp1, exp2, obs, time_dim = time_dim, pval = pval) + } + + return(res) +} + +.RatioRMS <- function(exp1, exp2, obs, time_dim = 'sdate', pval = TRUE) { + + # exp1, exp2, obs: [all_dim] + dif1 <- exp1 - obs + dif2 <- exp2 - obs + rms1 <- MeanDims(dif1^2, time_dim, na.rm = TRUE)^0.5 + rms2 <- MeanDims(dif2^2, time_dim, na.rm = TRUE)^0.5 + rms2[which(abs(rms2) <= (max(abs(rms2), na.rm = TRUE) / 1000))] <- max(abs(rms2), na.rm = TRUE) / 1000 + ratiorms <- rms1 / rms2 + + if (pval) { + eno1 <- Eno(dif1, time_dim) + eno2 <- Eno(dif2, time_dim) + F <- (eno1 * (rms1) ** 2 / (eno1 - 1)) / (eno2 * (rms2) ** 2 / (eno2 - 1)) + F[which(F < 1)] <- 1 / F[which(F < 1)] + + if (is.null(dim(ratiorms))) { + p.val <- c() + } else { + p.val <- array(dim = dim(ratiorms)) + } + avail_ind <- which(!is.na(eno1) & !is.na(eno2) & eno1 > 2 & eno2 > 2) + p.val[avail_ind] <- (1 - pf(F,eno1[avail_ind] - 1, eno2[avail_ind] - 1)) * 2 + ratiorms[-avail_ind] <- NA + } + + if (pval) { + return(invisible(list(ratiorms = ratiorms, p.val = p.val))) + } else { + return(invisible(list(ratiorms = ratiorms))) + } +} diff --git a/man/RatioRMS.Rd b/man/RatioRMS.Rd new file mode 100644 index 0000000..bf68e8d --- /dev/null +++ b/man/RatioRMS.Rd @@ -0,0 +1,85 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RatioRMS.R +\name{RatioRMS} +\alias{RatioRMS} +\title{Compute the ratio between the RMSE of two experiments} +\usage{ +RatioRMS(exp1, exp2, obs, time_dim = "sdate", pval = TRUE, ncores = NULL) +} +\arguments{ +\item{exp1}{A numeric array with named dimensions of the first experimental +data. It must have at least 'time_dim' and have the same dimensions as +'exp2' and 'obs'.} + +\item{exp2}{A numeric array with named dimensions of the second experimental +data. It must have at least 'time_dim' and have the same dimensions as +'exp1' and 'obs'.} + +\item{obs}{A numeric array with named dimensions of the observational data. +It must have at least 'time_dim' and have the same dimensions as 'exp1' and +'exp2'.} + +\item{time_dim}{A character string of the dimension name along which RMS is +computed. The default value is 'sdate'.} + +\item{pval}{A logical value indicating whether to compute the p-value of Ho: +RMSE1/RMSE2 = 1 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.} +} +\value{ +A list containing the numeric arrays with dimensions identical with + 'exp1', 'exp2', and 'obs', expect 'time_dim': +\item{$ratiorms}{ + The ratio between the RMSE (i.e., RMSE1/RMSE2). +} +\item{$p.val}{ + The p-value of the two-sided Fisher test with Ho: RMSE1/RMSE2 = 1. Only + exists if 'pval' is TRUE. +} +} +\description{ +Calculate the ratio of the RMSE for two forecasts with the same observation, +that is, RMSE(ens, obs) / RMSE(ens.ref, obs). The p-value is provided by a +two-sided Fischer test. +} +\examples{ +\dontshow{ +startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), + c('observation'), startDates, + output = 'lonlat', + latmin = 27, latmax = 48, + lonmin = -12, lonmax = 40) +} +# Compute DJF seasonal means and anomalies. +initial_month <- 11 +mean_start_month <- 12 +mean_stop_month <- 2 +sampleData$mod <- Season(sampleData$mod, monini = initial_month, + moninf = mean_start_month, monsup = mean_stop_month) +sampleData$obs <- Season(sampleData$obs, monini = initial_month, + moninf = mean_start_month, monsup = mean_stop_month) +clim <- Clim(sampleData$mod, sampleData$obs) +ano_exp <- Ano(sampleData$mod, clim$clim_exp) +ano_obs <- Ano(sampleData$obs, clim$clim_obs) +# Generate two experiments with 2 and 1 members from the only experiment +# available in the sample data. Take only data values for a single forecast +# time step. +ano_exp_1 <- Subset(ano_exp, 'member', c(1, 2)) +ano_exp_2 <- Subset(ano_exp, 'member', c(3)) +ano_exp_1 <- Subset(ano_exp_1, c('dataset', 'ftime'), list(1, 1), drop = 'selected') +ano_exp_2 <- Subset(ano_exp_2, c('dataset', 'ftime'), list(1, 1), drop = 'selected') +ano_obs <- Subset(ano_obs, c('dataset', 'ftime'), list(1, 1), drop = 'selected') +# Compute ensemble mean and provide as inputs to RatioRMS. +rrms <- RatioRMS(MeanDims(ano_exp_1, 'member'), + MeanDims(ano_exp_2, 'member'), + MeanDims(ano_obs, 'member')) +# Plot the RatioRMS for the first forecast time step. +\donttest{ +PlotEquiMap(rrms$ratiorms, sampleData$lon, sampleData$lat, + toptitle = 'Ratio RMSE') +} + +} diff --git a/tests/testthat/test-RatioRMS.R b/tests/testthat/test-RatioRMS.R new file mode 100644 index 0000000..b70d6fb --- /dev/null +++ b/tests/testthat/test-RatioRMS.R @@ -0,0 +1,128 @@ +context("s2dv::RatioRMS tests") + +############################################## + # dat1 + set.seed(1) + exp1_1 <- array(rnorm(120), dim = c(dataset = 1, sdate = 5, ftime = 3)) + set.seed(2) + exp1_2 <- array(rnorm(120), dim = c(dataset = 1, sdate = 5, ftime = 3)) + set.seed(3) + obs1 <- array(rnorm(80), dim = c(dataset = 1, sdate = 5, ftime = 3)) + + # dat 2: vector + set.seed(4) + exp2_1 <- rnorm(10) + set.seed(5) + exp2_2 <- rnorm(10) + set.seed(6) + obs2 <- rnorm(10) + + +############################################## +test_that("1. Input checks", { + + # exp1, exp2, obs + expect_error( + RatioRMS(c(), exp1_2, c()), + "Parameter 'exp1', 'exp2', and 'obs' cannot be NULL." + ) + expect_error( + RatioRMS(c('b'), c('a'), obs1), + "Parameter 'exp1', 'exp2', and 'obs' must be a numeric array." + ) + expect_error( + RatioRMS(exp1_1, array(1:10, dim = c(2, 5)), array(1:4, dim = c(2, 2))), + "Parameter 'exp1', 'exp2', and 'obs' must have dimension names." + ) + expect_error( + RatioRMS(exp1_1, exp1_2, array(1:15, dim = c(data = 1, ftime = 3, sdates = 5))), + "Parameter 'exp1', 'exp2', and 'obs' must have same dimension names." + ) + expect_error( + RatioRMS(exp1_1, exp1_2, array(1:12, dim = c(dataset = 1, ftime = 3, sdate = 4))), + "Parameter 'exp1', 'exp2', and 'obs' must have the same length of all the dimensions." + ) + # time_dim + expect_error( + RatioRMS(exp1_1, exp1_2, obs1, time_dim = c('sdate', 'ftime')), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + RatioRMS(exp1_1, exp1_2, obs1, time_dim = 'a'), + "Parameter 'time_dim' is not found in 'exp1', 'exp2', and 'obs' dimensions." + ) + # pval + expect_error( + RatioRMS(exp1_1, exp1_2, obs1, pval = 1), + "Parameter 'pval' must be one logical value." + ) + expect_error( + RatioRMS(exp1_1, exp1_2, obs1, ncores = 1.5), + "Parameter 'ncores' must be a positive integer." + ) + + +}) + +############################################## +test_that("2. Output checks: dat1", { + +expect_equal( +names(RatioRMS(exp1_1, exp1_2, obs1)), +c('ratiorms', 'p.val') +) +expect_equal( +dim(RatioRMS(exp1_1, exp1_2, obs1)$ratiorms), +c(dataset = 1, ftime = 3) +) +expect_equal( +dim(RatioRMS(exp1_1, exp1_2, obs1)$p.val), +c(dataset = 1, ftime = 3) +) +expect_equal( +as.vector(RatioRMS(exp1_1, exp1_2, obs1)$p.val), +c(0.1811868, 0.4758232, 0.7473213), +tolerance = 0.0001 +) +expect_equal( +as.vector(RatioRMS(exp1_1, exp1_2, obs1)$ratiorms), +c(2.0944471, 0.6814573, 1.1873955), +tolerance = 0.0001 +) +expect_equal( +names(RatioRMS(exp1_1, exp1_2, obs1, pval = FALSE)), +c('ratiorms') +) +expect_equal( +as.vector(RatioRMS(exp1_1, exp1_2, obs1, pval = FALSE, time_dim = 'ftime')$ratiorms), +c(2.0832571, 0.7292987, 0.6031437, 1.1885930, 0.8542696), +tolerance = 0.0001 +) +expect_equal( +as.vector(RatioRMS(exp1_1, exp1_2, obs1, time_dim = 'ftime')$p.val), +c(0.3745346, 0.6944118, 0.5334904, 0.8289285, 0.8437813), +tolerance = 0.0001 +) + +}) + +############################################## +test_that("3. Output checks: dat2", { + +expect_equal( +names(RatioRMS(exp2_1, exp2_2, obs2)), +c('ratiorms', 'p.val') +) +expect_equal( +RatioRMS(exp2_1, exp2_2, obs2)$p.val, +0.7418331, +tolerance = 0.0001 +) +expect_equal( +RatioRMS(exp2_1, exp2_2, obs2)$ratiorms, +0.8931399, +tolerance = 0.0001 +) + +}) + -- GitLab From 448bbb0b9a6b45eefdf20193feddc25e49839e11 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 16 Apr 2021 14:14:27 +0200 Subject: [PATCH 083/154] Fix example --- R/RatioRMS.R | 10 +++++----- man/RatioRMS.Rd | 10 +++++----- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/R/RatioRMS.R b/R/RatioRMS.R index f93e486..f7e34b4 100644 --- a/R/RatioRMS.R +++ b/R/RatioRMS.R @@ -53,11 +53,11 @@ #'# Generate two experiments with 2 and 1 members from the only experiment #'# available in the sample data. Take only data values for a single forecast #'# time step. -#'ano_exp_1 <- Subset(ano_exp, 'member', c(1, 2)) -#'ano_exp_2 <- Subset(ano_exp, 'member', c(3)) -#'ano_exp_1 <- Subset(ano_exp_1, c('dataset', 'ftime'), list(1, 1), drop = 'selected') -#'ano_exp_2 <- Subset(ano_exp_2, c('dataset', 'ftime'), list(1, 1), drop = 'selected') -#'ano_obs <- Subset(ano_obs, c('dataset', 'ftime'), list(1, 1), drop = 'selected') +#'ano_exp_1 <- ClimProjDiags::Subset(ano_exp, 'member', c(1, 2)) +#'ano_exp_2 <- ClimProjDiags::Subset(ano_exp, 'member', c(3)) +#'ano_exp_1 <- ClimProjDiags::Subset(ano_exp_1, c('dataset', 'ftime'), list(1, 1), drop = 'selected') +#'ano_exp_2 <- ClimProjDiags::Subset(ano_exp_2, c('dataset', 'ftime'), list(1, 1), drop = 'selected') +#'ano_obs <- ClimProjDiags::Subset(ano_obs, c('dataset', 'ftime'), list(1, 1), drop = 'selected') #'# Compute ensemble mean and provide as inputs to RatioRMS. #'rrms <- RatioRMS(MeanDims(ano_exp_1, 'member'), #' MeanDims(ano_exp_2, 'member'), diff --git a/man/RatioRMS.Rd b/man/RatioRMS.Rd index bf68e8d..194c6b9 100644 --- a/man/RatioRMS.Rd +++ b/man/RatioRMS.Rd @@ -67,11 +67,11 @@ ano_obs <- Ano(sampleData$obs, clim$clim_obs) # Generate two experiments with 2 and 1 members from the only experiment # available in the sample data. Take only data values for a single forecast # time step. -ano_exp_1 <- Subset(ano_exp, 'member', c(1, 2)) -ano_exp_2 <- Subset(ano_exp, 'member', c(3)) -ano_exp_1 <- Subset(ano_exp_1, c('dataset', 'ftime'), list(1, 1), drop = 'selected') -ano_exp_2 <- Subset(ano_exp_2, c('dataset', 'ftime'), list(1, 1), drop = 'selected') -ano_obs <- Subset(ano_obs, c('dataset', 'ftime'), list(1, 1), drop = 'selected') +ano_exp_1 <- ClimProjDiags::Subset(ano_exp, 'member', c(1, 2)) +ano_exp_2 <- ClimProjDiags::Subset(ano_exp, 'member', c(3)) +ano_exp_1 <- ClimProjDiags::Subset(ano_exp_1, c('dataset', 'ftime'), list(1, 1), drop = 'selected') +ano_exp_2 <- ClimProjDiags::Subset(ano_exp_2, c('dataset', 'ftime'), list(1, 1), drop = 'selected') +ano_obs <- ClimProjDiags::Subset(ano_obs, c('dataset', 'ftime'), list(1, 1), drop = 'selected') # Compute ensemble mean and provide as inputs to RatioRMS. rrms <- RatioRMS(MeanDims(ano_exp_1, 'member'), MeanDims(ano_exp_2, 'member'), -- GitLab From 19ef45fa6d1784f2e80f0c02eabd080c2c17cbcd Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 16 Apr 2021 19:47:04 +0200 Subject: [PATCH 084/154] Transform RatioSDRMS --- NAMESPACE | 1 + R/RatioSDRMS.R | 201 +++++++++++++++++++++++++++++++ man/RatioSDRMS.Rd | 78 ++++++++++++ tests/testthat/test-RatioSDRMS.R | 165 +++++++++++++++++++++++++ 4 files changed, 445 insertions(+) create mode 100644 R/RatioSDRMS.R create mode 100644 man/RatioSDRMS.Rd create mode 100644 tests/testthat/test-RatioSDRMS.R diff --git a/NAMESPACE b/NAMESPACE index 87937e2..f4141b6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -42,6 +42,7 @@ export(PlotStereoMap) export(RMS) export(RMSSS) export(RandomWalkTest) +export(RatioSDRMS) export(Regression) export(Reorder) export(SPOD) diff --git a/R/RatioSDRMS.R b/R/RatioSDRMS.R new file mode 100644 index 0000000..4b22c22 --- /dev/null +++ b/R/RatioSDRMS.R @@ -0,0 +1,201 @@ +#'Compute the ratio between the ensemble spread and RMSE +#' +#'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. +#' +#'@param exp A named numeric array of experimental data with at least two +#' dimensions 'memb_dim' and 'time_dim'. +#'@param obs A named numeric array of observational data with at least two +#' 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'. +#'@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'. +#'@param time_dim A character string indicating the name of dimension along +#' which the ratio is computed. The default value is 'sdate'. +#'@param pval A logical value indicating whether to compute or not the p-value +#' of the test Ho : SD/RMSE = 1 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. +#' +#'@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 +#'\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 +#' if \code{pval = TRUE}. +#'} +#' +#'@examples +#'# Load sample data as in Load() example: +#'example(Load) +#'rsdrms <- RatioSDRMS(sampleData$mod, sampleData$obs) +#'#============Fix the code below when PlotVsLTime is included============ +#'## Reorder the data in order to plot it with PlotVsLTime +#'#rsdrms_plot <- array(dim = c(dim(rsdrms)[1:2], 4, dim(rsdrms)[4])) +#'#rsdrms_plot[, , 2, ] <- rsdrms[, , 1, ] +#'#rsdrms_plot[, , 4, ] <- rsdrms[, , 2, ] +#'#\donttest{ +#'#PlotVsLTime(rsdrms_plot, toptitle = "Ratio ensemble spread / RMSE", ytitle = "", +#'# monini = 11, limits = c(-1, 1.3), listexp = c('CMIP5 IC3'), +#'# listobs = c('ERSST'), biglab = FALSE, siglev = TRUE, +#'# fileout = 'tos_rsdrms.eps') +#'#} +#' +#'@import multiApply +#'@export +RatioSDRMS <- function(exp, obs, dat_dim = 'dataset', memb_dim = 'member', + time_dim = 'sdate', pval = TRUE, 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))) { + 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)) { + 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) { + stop("Parameter 'dat_dim' must be a character string.") + } + 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.") + } + } + ## 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)) | !memb_dim %in% names(dim(obs))) { + stop("Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension.") + } + ## 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.") + } + ## exp and obs (2) + name_exp <- sort(names(dim(exp))) + name_obs <- sort(names(dim(obs))) + 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 == memb_dim)] + name_obs <- name_obs[-which(name_obs == memb_dim)] + if(!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + stop(paste0("Parameter 'exp' and 'obs' must have same length of ", + "all the dimensions expect 'dat_dim' and 'memb_dim'.")) + } + ## pval + if (!is.logical(pval) | length(pval) > 1) { + stop("Parameter 'pval' must be one logical value.") + } + ## 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.") + } + } + + + ############################### + # Calculate RatioSDRMS + + # If dat_dim = NULL, insert dat dim + remove_dat_dim <- FALSE + if (is.null(dat_dim)) { + dat_dim <- 'dataset' + exp <- InsertDim(exp, posdim = 1, lendim = 1, name = 'dataset') + obs <- InsertDim(obs, posdim = 1, lendim = 1, name = 'dataset') + remove_dat_dim <- TRUE + } + + res <- Apply(list(exp, obs), + target_dims = list(c(dat_dim, memb_dim, time_dim), + c(dat_dim, memb_dim, time_dim)), + pval = pval, + fun = .RatioSDRMS, + ncores = ncores) + + if (remove_dat_dim) { + if (length(dim(res[[1]])) > 2) { + res <- lapply(res, Subset, c('nexp', 'nobs'), list(1, 1), drop = 'selected') + } else { + res <- lapply(res, as.numeric) + } + } + + return(res) +} + +.RatioSDRMS <- function(exp, obs, pval = TRUE) { + + # exp: [dat_exp, member, sdate] + # obs: [dat_obs, member, sdate] + nexp <- dim(exp)[1] + nobs <- dim(obs)[1] + + # ensemble mean + ens_exp <- MeanDims(exp, 2, na.rm = TRUE) # [dat, sdate] + ens_obs <- MeanDims(obs, 2, na.rm = TRUE) + + dif <- exp - InsertDim(ens_exp, 2, dim(exp)[2]) # [nexp, member, sdate] + std <- apply(dif, 1, sd, na.rm = TRUE) # [nexp] + enosd <- apply(Eno(dif, names(dim(exp))[3]), 1, sum, na.rm = TRUE) + + # Create empty arrays + ratiosdrms <- array(dim = c(nexp = as.numeric(nexp), nobs = as.numeric(nobs))) # [nexp, nobs] + p.val <- array(dim = c(nexp = as.numeric(nexp), nobs = as.numeric(nobs))) # [nexp, nobs] + + for (jexp in 1:nexp) { + for (jobs in 1:nobs) { + dif <- ens_exp[jexp, ] - ens_obs[jobs, ] + rms <- mean(dif^2, na.rm = TRUE)^0.5 + enorms <- Eno(dif) + ratiosdrms[jexp, jobs] <- std[jexp]/rms + + if (pval) { + F <- (enosd[jexp] * std[jexp]^2 / (enosd[jexp] - 1)) / (enorms * rms^2 / (enorms - 1)) + if (!is.na(F) & !is.na(enosd) & !is.na(enorms) & enosd > 2 && enorms > 2) { + p.val[jexp, jobs] <- 1 - pf(F, enosd[jexp] - 1, enorms - 1) + } else { + ratiosdrms[jexp, jobs] <- NA + } + } + } + } + + if (pval) { + return(invisible(list(ratio = ratiosdrms, p.val = p.val))) + } else { + return(invisible(list(ratio = ratiosdrms))) + } +} diff --git a/man/RatioSDRMS.Rd b/man/RatioSDRMS.Rd new file mode 100644 index 0000000..33cfa49 --- /dev/null +++ b/man/RatioSDRMS.Rd @@ -0,0 +1,78 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RatioSDRMS.R +\name{RatioSDRMS} +\alias{RatioSDRMS} +\title{Compute the ratio between the ensemble spread and RMSE} +\usage{ +RatioSDRMS( + exp, + obs, + dat_dim = "dataset", + memb_dim = "member", + time_dim = "sdate", + pval = TRUE, + ncores = NULL +) +} +\arguments{ +\item{exp}{A named numeric array of experimental data with at least two +dimensions 'memb_dim' and 'time_dim'.} + +\item{obs}{A named numeric array of observational data with at least two +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'.} + +\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 +is 'member'.} + +\item{time_dim}{A character string indicating the name of dimension along +which the ratio is computed. The default value is 'sdate'.} + +\item{pval}{A logical value indicating whether to compute or not the p-value +of the test Ho : SD/RMSE = 1 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.} +} +\value{ +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 +\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 + if \code{pval = TRUE}. +} +} +\description{ +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. +} +\examples{ +# Load sample data as in Load() example: +example(Load) +rsdrms <- RatioSDRMS(sampleData$mod, sampleData$obs) +#============Fix the code below when PlotVsLTime is included============ +## Reorder the data in order to plot it with PlotVsLTime +#rsdrms_plot <- array(dim = c(dim(rsdrms)[1:2], 4, dim(rsdrms)[4])) +#rsdrms_plot[, , 2, ] <- rsdrms[, , 1, ] +#rsdrms_plot[, , 4, ] <- rsdrms[, , 2, ] +#\donttest{ +#PlotVsLTime(rsdrms_plot, toptitle = "Ratio ensemble spread / RMSE", ytitle = "", +# monini = 11, limits = c(-1, 1.3), listexp = c('CMIP5 IC3'), +# listobs = c('ERSST'), biglab = FALSE, siglev = TRUE, +# fileout = 'tos_rsdrms.eps') +#} + +} diff --git a/tests/testthat/test-RatioSDRMS.R b/tests/testthat/test-RatioSDRMS.R new file mode 100644 index 0000000..4b93faf --- /dev/null +++ b/tests/testthat/test-RatioSDRMS.R @@ -0,0 +1,165 @@ +context("s2dv::RatioSDRMS tests") + +############################################## + # dat1 + set.seed(1) + 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)) + + # dat2 + exp2 <- exp1 + obs2 <- obs1 + exp2[1] <- NA + + # dat 3 + set.seed(3) + exp3 <- array(rnorm(10), dim = c(member = 2, sdate = 5)) + set.seed(4) + obs3 <- array(rnorm(5), dim = c(member = 1, sdate = 5)) + + +############################################## +test_that("1. Input checks", { + + expect_error( + RatioSDRMS(c(), c()), + "Parameter 'exp' and 'obs' cannot be NULL." + ) + expect_error( + RatioSDRMS(c('b'), c('a')), + "Parameter 'exp' and 'obs' must be a numeric array." + ) + expect_error( + RatioSDRMS(c(1:10), c(2:4)), + "Parameter 'exp' and 'obs' must be array with as least two dimensions memb_dim and time_dim." + ) + expect_error( + RatioSDRMS(array(1:10, dim = c(2, 5)), array(1:4, dim = c(2, 2))), + "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." + ) + expect_error( + RatioSDRMS(exp1, obs1, dat_dim = 'a'), + "Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension." + ) + expect_error( + RatioSDRMS(exp1, obs1, memb_dim = 1), + "Parameter 'memb_dim' must be a character string." + ) + expect_error( + RatioSDRMS(exp1, obs1, memb_dim = 'a'), + "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." + ) + expect_error( + RatioSDRMS(exp1, obs1, time_dim = c('sdate', 'a')), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + RatioSDRMS(exp1, obs1, time_dim = 'a'), + "Parameter 'time_dim' is not found in 'exp' or 'obs' dimension." + ) + expect_error( + RatioSDRMS(exp1, obs1, pval = 1), + "Parameter 'pval' must be one logical value." + ) + expect_error( + RatioSDRMS(exp1, obs1, ncores = 1.5), + "Parameter 'ncores' must be a positive integer." + ) + expect_error( + RatioSDRMS(exp = exp3, + obs = array(1:2, dim = c(member = 1, sdate = 2)), dat_dim = NULL), + "Parameter 'exp' and 'obs' must have same length of all the dimensions expect 'dat_dim' and 'memb_dim'." + ) + +}) + +############################################## +test_that("2. Output checks: dat1", { +expect_equal( +names(RatioSDRMS(exp1, obs1)), +c('ratio', 'p.val') +) +expect_equal( +dim(RatioSDRMS(exp1, obs1)$ratio), +c(nexp = 2, nobs = 1, ftime = 2) +) +expect_equal( +dim(RatioSDRMS(exp1, obs1)$p.val), +c(nexp = 2, nobs = 1, ftime = 2) +) +expect_equal( +as.vector(RatioSDRMS(exp1, obs1)$ratio), +c(0.7198164, 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), +tolerance = 0.0001 +) +expect_equal( +names(RatioSDRMS(exp1, obs1, pval = F)), +c('ratio') +) +expect_equal( +as.vector(RatioSDRMS(exp1, obs1)$ratio), +as.vector(RatioSDRMS(exp1, obs1, pval = F)$ratio) +) + +}) + +############################################## +test_that("3. Output checks: dat2", { +expect_equal( +dim(RatioSDRMS(exp2, obs2)$ratio), +c(nexp = 2, nobs = 1, ftime = 2) +) +expect_equal( +as.vector(RatioSDRMS(exp2, obs2)$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), +tolerance = 0.0001 +) + +}) + +############################################## +test_that("4. Output checks: dat3", { +expect_equal( +names(RatioSDRMS(exp3, obs3, dat_dim = NULL)), +c('ratio', 'p.val') +) +expect_equal( +dim(RatioSDRMS(exp3, obs3, dat_dim = NULL)$ratio), +NULL +) +expect_equal( +dim(RatioSDRMS(exp3, obs3, dat_dim = NULL)$p.val), +NULL +) +expect_equal( +as.numeric(RatioSDRMS(exp3, obs3, dat_dim = NULL)$ratio), +0.8291582, +tolerance = 0.0001 +) +expect_equal( +as.numeric(RatioSDRMS(exp3, obs3, dat_dim = NULL)$p.val), +0.7525497, +tolerance = 0.0001 +) + + +}) -- GitLab From 3c99c81fd146e2d71edc76342e2712eaa90073ea Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 19 Apr 2021 20:17:49 +0200 Subject: [PATCH 085/154] Transform Consist_Trend --- NAMESPACE | 1 + R/Consist_Trend.R | 202 ++++++++++++++++++++++++++++ man/Consist_Trend.Rd | 101 ++++++++++++++ tests/testthat/test-Consist_Trend.R | 166 +++++++++++++++++++++++ 4 files changed, 470 insertions(+) create mode 100644 R/Consist_Trend.R create mode 100644 man/Consist_Trend.Rd create mode 100644 tests/testthat/test-Consist_Trend.R diff --git a/NAMESPACE b/NAMESPACE index 87937e2..0783e78 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ export(ConfigRemoveEntry) export(ConfigShowDefinitions) export(ConfigShowSimilarEntries) export(ConfigShowTable) +export(Consist_Trend) export(Corr) export(Eno) export(GMST) diff --git a/R/Consist_Trend.R b/R/Consist_Trend.R new file mode 100644 index 0000000..6d0d8bd --- /dev/null +++ b/R/Consist_Trend.R @@ -0,0 +1,202 @@ +#'Compute trend using only model data for which observations are available +#' +#'Compute the linear trend for a time series by least square fitting together +#'with the associated error interval for both the observational and model data. +#'The 95\% confidence interval and detrended observational and model data are +#'also provided.\cr +#'The function doesn't do the ensemble mean, so if the input data have the +#'member dimension, ensemble mean needs to be computed beforehand. +#' +#'@param exp A named numeric array of experimental data, with at least two +#' dimensions 'time_dim' and 'dat_dim'. +#'@param obs A named numeric array of observational data, same dimensions as +#' parameter 'exp' except along 'dat_dim'. +#'@param dat_dim A character string indicating the name of the dataset +#' dimensions. If data at some point of 'time_dim' are not complete along +#' 'dat_dim' in both 'exp' and 'obs', this point in all 'dat_dim' will be +#' discarded. The default value is 'dataset'. +#'@param time_dim A character string indicating the name of dimension along +#' which the trend is computed. The default value is 'sdate'. +#'@param interval A positive numeric indicating the unit length between two +#' points along 'time_dim' dimension. The default value is 1. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' +#'@return +#'A list containing: +#'\item{$trend}{ +#' A numeric array of the trend coefficients of model and observational data +#' with dimensions c(stats = 2, nexp + nobs, the rest dimensions of 'exp' and +#' 'obs' except time_dim), where 'nexp' is the length of 'dat_dim' in 'exp' +#' and 'nobs' is the length of 'dat_dim' in 'obs. The 'stats' dimension +#' contains the intercept and the slope. +#'} +#'\item{$conf.lower}{ +#' A numeric array of the lower limit of 95\% confidence interval with +#' dimensions same as $trend. The 'stats' dimension contains the lower +#' confidence level of the intercept and the slope. +#'} +#'\item{$conf.upper}{ +#' A numeric array of the upper limit of 95\% confidence interval with +#' dimensions same as $trend. The 'stats' dimension contains the upper +#' confidence level of the intercept and the slope. +#'} +#'\item{$detrended_exp}{ +#' A numeric array of the detrended model data with the same dimensions as +#' 'exp'. +#'} +#'\item{$detrended_obs}{ +#' A numeric array of the detrended observational data with the same +#' dimensions as 'obs'. +#'} +#' +#'@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) +#'runmean_months <- 12 +#'smooth_ano_exp <- Smoothing(ano_exp, runmeanlen = runmean_months) +#'smooth_ano_obs <- Smoothing(ano_obs, runmeanlen = runmean_months) +#'dim_to_mean <- 'member' # average along members +#'years_between_startdates <- 5 +#'trend <- Consist_Trend(MeanDims(smooth_ano_exp, dim_to_mean, na.rm = TRUE), +#' MeanDims(smooth_ano_obs, dim_to_mean, na.rm = TRUE), +#' interval = years_between_startdates) +#'#Bind data for plotting +#'trend_bind <- abind::abind(trend$conf.lower[2, , ], trend$trend[2, , ], +#' trend$conf.upper[2, , ], trend$trend[1, , ], along = 0) +#'trend_bind <- Reorder(trend_bind, c(2, 1, 3)) +#'================uncomment PlotVsLTime when functions merge=========== +#'\donttest{ +#'#PlotVsLTime(trend_bind, toptitle = "trend", ytitle = "K/(5 years)", +#'# monini = 11, limits = c(-0.8, 0.8), listexp = c('CMIP5 IC3'), +#'# listobs = c('ERSST'), biglab = FALSE, hlines = c(0)) +#'PlotAno(InsertDim(trend$detrended_exp, 2, 1), InsertDim(trend$detrended_obs, 2, 1), +#' startDates, "Detrended tos anomalies", ytitle = 'K', +#' legends = 'ERSST', biglab = FALSE) +#'} +#' +#'@import multiApply +#'@export +Consist_Trend <- function(exp, obs, dat_dim = 'dataset', time_dim = 'sdate', interval = 1, + ncores = NULL) { + # Check inputs + ## exp and obs + 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))) { + stop(paste0("Parameter 'exp' and 'obs' must be at least two dimensions ", + "containing time_dim and dat_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)) { + 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.") + } + ## 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.character(dat_dim)) { + stop("Parameter 'dat_dim' must be a character string.") + } + 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.") + } + ## exp and obs (2) + name_exp <- sort(names(dim(exp))) + name_obs <- sort(names(dim(obs))) + for (i in 1:length(dat_dim)) { + name_exp <- name_exp[-which(name_exp == dat_dim[i])] + name_obs <- name_obs[-which(name_obs == dat_dim[i])] + } + if(!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + stop(paste0("Parameter 'exp' and 'obs' must have same length of ", + "all dimension expect 'dat_dim'.")) + } + ## interval + if (!is.numeric(interval) | interval <= 0 | length(interval) > 1) { + stop("Parameter 'interval' must be a positive number.") + } + ## 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.") + } + } + + ############################### + # Calculate Consist_Trend + + output <- Apply(list(exp, obs), + target_dims = list(c(dat_dim, time_dim), + c(dat_dim, time_dim)), + fun = .Consist_Trend, + output_dims = list(trend = c('stats', dat_dim), + conf.lower = c('stats', dat_dim), + conf.upper = c('stats', dat_dim), + detrended_exp = c(dat_dim, time_dim), + detrended_obs = c(dat_dim, time_dim)), + interval = interval, + ncores = ncores) + + return(output) +} + +.Consist_Trend <- function(exp, obs, interval = 1) { + # exp: [nexp, sdate] + # obs: [nobs, sdate] + + # Find common points + nan <- apply(exp, 2, mean, na.rm = FALSE) + apply(obs, 2, mean, na.rm = FALSE) # [sdate] + exp[, is.na(nan)] <- NA + obs[, is.na(nan)] <- NA + + # Compute trends + res_exp <- apply(exp, 1, .Trend, interval = interval, polydeg = 1) + res_obs <- apply(obs, 1, .Trend, interval = interval, polydeg = 1) + exp_trend <- lapply(res_exp, '[[', 'trend') + exp_trend <- do.call(abind::abind, c(exp_trend, along = 2)) # [stats = 2, dat] + obs_trend <- lapply(res_obs, '[[', 'trend') + obs_trend <- do.call(abind::abind, c(obs_trend, along = 2)) + # bind along 'dat' + res_trend <- abind::abind(exp_trend, obs_trend, along = 2) # [stats = 2, dat = (nexp + nobs)] + + # Compute conf.lower + exp_conf.lower <- lapply(res_exp, '[[', 'conf.lower') + exp_conf.lower <- do.call(abind::abind, c(exp_conf.lower, along = 2)) # [stats = 2, dat] + obs_conf.lower <- lapply(res_obs, '[[', 'conf.lower') + obs_conf.lower <- do.call(abind::abind, c(obs_conf.lower, along = 2)) + res_conf.lower <- abind::abind(exp_conf.lower, obs_conf.lower, along = 2) + + # Compute conf.upper + exp_conf.upper <- lapply(res_exp, '[[', 'conf.upper') + exp_conf.upper <- do.call(abind::abind, c(exp_conf.upper, along = 2)) # [stats = 2, dat] + obs_conf.upper <- lapply(res_obs, '[[', 'conf.upper') + obs_conf.upper <- do.call(abind::abind, c(obs_conf.upper, along = 2)) + res_conf.upper <- abind::abind(exp_conf.upper, obs_conf.upper, along = 2) + + # Compute detrended + exp_detrended <- lapply(res_exp, '[[', 'detrended') + exp_detrended <- do.call(abind::abind, c(exp_detrended, along = 0)) + obs_detrended <- lapply(res_obs, '[[', 'detrended') + obs_detrended <- do.call(abind::abind, c(obs_detrended, along = 0)) + + return(invisible(list(trend = res_trend, + conf.lower = res_conf.lower, conf.upper = res_conf.upper, + detrended_exp = exp_detrended, detrended_obs = obs_detrended))) +} diff --git a/man/Consist_Trend.Rd b/man/Consist_Trend.Rd new file mode 100644 index 0000000..83332d5 --- /dev/null +++ b/man/Consist_Trend.Rd @@ -0,0 +1,101 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Consist_Trend.R +\name{Consist_Trend} +\alias{Consist_Trend} +\title{Compute trend using only model data for which observations are available} +\usage{ +Consist_Trend( + exp, + obs, + dat_dim = "dataset", + time_dim = "sdate", + interval = 1, + ncores = NULL +) +} +\arguments{ +\item{exp}{A named numeric array of experimental data, with at least two +dimensions 'time_dim' and 'dat_dim'.} + +\item{obs}{A named numeric array of observational data, same dimensions as +parameter 'exp' except along 'dat_dim'.} + +\item{dat_dim}{A character string indicating the name of the dataset +dimensions. If data at some point of 'time_dim' are not complete along +'dat_dim' in both 'exp' and 'obs', this point in all 'dat_dim' will be +discarded. The default value is 'dataset'.} + +\item{time_dim}{A character string indicating the name of dimension along +which the trend is computed. The default value is 'sdate'.} + +\item{interval}{A positive numeric indicating the unit length between two +points along 'time_dim' dimension. The default value is 1.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A list containing: +\item{$trend}{ + A numeric array of the trend coefficients of model and observational data + with dimensions c(stats = 2, nexp + nobs, the rest dimensions of 'exp' and + 'obs' except time_dim), where 'nexp' is the length of 'dat_dim' in 'exp' + and 'nobs' is the length of 'dat_dim' in 'obs. The 'stats' dimension + contains the intercept and the slope. +} +\item{$conf.lower}{ + A numeric array of the lower limit of 95\% confidence interval with + dimensions same as $trend. The 'stats' dimension contains the lower + confidence level of the intercept and the slope. +} +\item{$conf.upper}{ + A numeric array of the upper limit of 95\% confidence interval with + dimensions same as $trend. The 'stats' dimension contains the upper + confidence level of the intercept and the slope. +} +\item{$detrended_exp}{ + A numeric array of the detrended model data with the same dimensions as + 'exp'. +} +\item{$detrended_obs}{ + A numeric array of the detrended observational data with the same + dimensions as 'obs'. +} +} +\description{ +Compute the linear trend for a time series by least square fitting together +with the associated error interval for both the observational and model data. +The 95\% confidence interval and detrended observational and model data are +also provided.\cr +The function doesn't do the ensemble mean, so if the input data have the +member dimension, ensemble mean needs to be computed beforehand. +} +\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) +runmean_months <- 12 +smooth_ano_exp <- Smoothing(ano_exp, runmeanlen = runmean_months) +smooth_ano_obs <- Smoothing(ano_obs, runmeanlen = runmean_months) +dim_to_mean <- 'member' # average along members +years_between_startdates <- 5 +trend <- Consist_Trend(MeanDims(smooth_ano_exp, dim_to_mean, na.rm = TRUE), + MeanDims(smooth_ano_obs, dim_to_mean, na.rm = TRUE), + interval = years_between_startdates) +#Bind data for plotting +trend_bind <- abind::abind(trend$conf.lower[2, , ], trend$trend[2, , ], + trend$conf.upper[2, , ], trend$trend[1, , ], along = 0) +trend_bind <- Reorder(trend_bind, c(2, 1, 3)) +================uncomment PlotVsLTime when functions merge=========== +\donttest{ +#PlotVsLTime(trend_bind, toptitle = "trend", ytitle = "K/(5 years)", +# monini = 11, limits = c(-0.8, 0.8), listexp = c('CMIP5 IC3'), +# listobs = c('ERSST'), biglab = FALSE, hlines = c(0)) +PlotAno(InsertDim(trend$detrended_exp, 2, 1), InsertDim(trend$detrended_obs, 2, 1), + startDates, "Detrended tos anomalies", ytitle = 'K', + legends = 'ERSST', biglab = FALSE) +} + +} diff --git a/tests/testthat/test-Consist_Trend.R b/tests/testthat/test-Consist_Trend.R new file mode 100644 index 0000000..2dd2214 --- /dev/null +++ b/tests/testthat/test-Consist_Trend.R @@ -0,0 +1,166 @@ +context("s2dv::Consist_Trend tests") + +############################################## + # dat1 + set.seed(1) + exp1 <- array(rnorm(30), dim = c(dataset = 2, sdate = 5, ftime = 3)) + set.seed(2) + obs1 <- array(rnorm(15), dim = c(dataset = 1, sdate = 5, ftime = 3)) + # dat2 + exp2 <- exp1 + set.seed(1) + exp2[1, 1, 1] <- NA + obs2 <- obs1 + obs2[1, 2, 3] <- NA + + +############################################## +test_that("1. Input checks", { + + # exp and obs (1) + expect_error( + Consist_Trend(c(), c()), + "Parameter 'exp' and 'obs' cannot be NULL." + ) + expect_error( + Consist_Trend(c('b'), c('a')), + "Parameter 'exp' and 'obs' must be a numeric array." + ) + expect_error( + Consist_Trend(c(1:10), c(2:4)), + paste0("Parameter 'exp' and 'obs' must be at least two dimensions ", + "containing time_dim and dat_dim.") + ) + expect_error( + Consist_Trend(array(1:10, dim = c(2, 5)), array(1:4, dim = c(2, 2))), + "Parameter 'exp' and 'obs' must have dimension names." + ) + expect_error( + Consist_Trend(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." + ) + # time_dim + expect_error( + Consist_Trend(exp1, obs1, time_dim = c('sdate', 'ftime')), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + Consist_Trend(exp1, obs1, time_dim = 'asd'), + "Parameter 'time_dim' is not found in 'exp' or 'obs' dimension." + ) + # dat_dim + expect_error( + Consist_Trend(exp1, obs1, dat_dim = c(1, 2)), + "Parameter 'dat_dim' must be a character string." + ) + expect_error( + Consist_Trend(exp1, obs1, dat_dim = c('member')), + "Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension." + ) + # exp and obs (2) + expect_error( + Consist_Trend(array(1:10, dim = c(dataset = 2, member = 5, sdate = 4, ftime = 3)), + array(1:4, dim = c(dataset = 2, member = 2, sdate = 5, ftime = 3))), + paste0("Parameter 'exp' and 'obs' must have same length of ", + "all dimension expect 'dat_dim'.") + ) + # interval + expect_error( + Consist_Trend(exp1, obs1, interval = 0), + "Parameter 'interval' must be a positive number." + ) + # ncores + expect_error( + Consist_Trend(exp1, obs1, ncores = 0), + "Parameter 'ncores' must be a positive integer." + ) + +}) + +############################################## +test_that("2. Output checks: dat1", { + +expect_equal( +names(Consist_Trend(exp1, obs1)), +c('trend', 'conf.lower', 'conf.upper', 'detrended_exp', 'detrended_obs') +) +expect_equal( +dim(Consist_Trend(exp1, obs1)$trend), +c(stats = 2, dataset = 3, ftime = 3) +) +expect_equal( +dim(Consist_Trend(exp1, obs1)$conf.lower), +c(stats = 2, dataset = 3, ftime = 3) +) +expect_equal( +dim(Consist_Trend(exp1, obs1)$conf.upper), +c(stats = 2, dataset = 3, ftime = 3) +) +expect_equal( +dim(Consist_Trend(exp1, obs1)$detrended_exp), +c(dataset = 2, sdate = 5, ftime = 3) +) +expect_equal( +dim(Consist_Trend(exp1, obs1)$detrended_obs), +c(dataset = 1, sdate = 5, ftime = 3) +) +expect_equal( +Consist_Trend(exp1, obs1)$trend[, 2, 1], +c(0.8287843, -0.1835020), +tolerance = 0.0001 +) +expect_equal( +Consist_Trend(exp1, obs1)$conf.lower[, 2, 2], +c(-5.449028, -0.943639), +tolerance = 0.0001 +) +expect_equal( +Consist_Trend(exp1, obs1)$conf.upper[, 2, 2], +c(3.176215, 1.656969), +tolerance = 0.0001 +) +expect_equal( +Consist_Trend(exp1, obs1)$detrended_exp[, 2, 1], +c(-0.449003, 1.133500), +tolerance = 0.0001 +) +expect_equal( +Consist_Trend(exp1, obs1)$detrended_obs[, 2, 1], +c(0.2836287), +tolerance = 0.0001 +) + +}) + +############################################## +test_that("3. Output checks: dat2", { + +expect_equal( +Consist_Trend(exp2, obs2)$trend[, 2, 1], +c(1.7520623, -0.4143214), +tolerance = 0.0001 +) +expect_equal( +Consist_Trend(exp2, obs2)$detrended_exp[1, , 1], +c(NA, -0.3160783, 0.4098429, 0.1285491, -0.2223137), +tolerance = 0.0001 +) +expect_equal( +Consist_Trend(exp2, obs2)$detrended_obs[1, , 1], +c(NA, -0.4826962, 1.2716524, -1.0952163, 0.3062600), +tolerance = 0.0001 +) +expect_equal( +mean(Consist_Trend(exp2, obs2)$detrended_obs, na.rm = TRUE)*10^18, +2.118364, +tolerance = 0.0001 +) +expect_equal( +mean(Consist_Trend(exp2, obs2)$trend, na.rm = TRUE), +0.1662461, +tolerance = 0.0001 +) + +}) + + -- GitLab From 9e526997c7c4f1e5e75cebc128686d7307a12c34 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 19 Apr 2021 20:22:28 +0200 Subject: [PATCH 086/154] Fix comment in examples --- R/Consist_Trend.R | 2 +- man/Consist_Trend.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Consist_Trend.R b/R/Consist_Trend.R index 6d0d8bd..3a31873 100644 --- a/R/Consist_Trend.R +++ b/R/Consist_Trend.R @@ -68,7 +68,7 @@ #'trend_bind <- abind::abind(trend$conf.lower[2, , ], trend$trend[2, , ], #' trend$conf.upper[2, , ], trend$trend[1, , ], along = 0) #'trend_bind <- Reorder(trend_bind, c(2, 1, 3)) -#'================uncomment PlotVsLTime when functions merge=========== +#'#================uncomment PlotVsLTime when functions merge=========== #'\donttest{ #'#PlotVsLTime(trend_bind, toptitle = "trend", ytitle = "K/(5 years)", #'# monini = 11, limits = c(-0.8, 0.8), listexp = c('CMIP5 IC3'), diff --git a/man/Consist_Trend.Rd b/man/Consist_Trend.Rd index 83332d5..955907e 100644 --- a/man/Consist_Trend.Rd +++ b/man/Consist_Trend.Rd @@ -88,7 +88,7 @@ trend <- Consist_Trend(MeanDims(smooth_ano_exp, dim_to_mean, na.rm = TRUE), trend_bind <- abind::abind(trend$conf.lower[2, , ], trend$trend[2, , ], trend$conf.upper[2, , ], trend$trend[1, , ], along = 0) trend_bind <- Reorder(trend_bind, c(2, 1, 3)) -================uncomment PlotVsLTime when functions merge=========== +#================uncomment PlotVsLTime when functions merge=========== \donttest{ #PlotVsLTime(trend_bind, toptitle = "trend", ytitle = "K/(5 years)", # monini = 11, limits = c(-0.8, 0.8), listexp = c('CMIP5 IC3'), -- GitLab From 020a7c64cadfa183fef07e52787b2cbf57874b6c Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 20 Apr 2021 20:23:03 +0200 Subject: [PATCH 087/154] Refine output dimensions --- R/BrierScore.R | 292 +++++++++++++++++++++---------- man/BrierScore.Rd | 45 +++-- tests/testthat/test-BrierScore.R | 26 +++ 3 files changed, 254 insertions(+), 109 deletions(-) diff --git a/R/BrierScore.R b/R/BrierScore.R index bf456a5..3951b97 100644 --- a/R/BrierScore.R +++ b/R/BrierScore.R @@ -1,9 +1,9 @@ -#'Compute Brier score and its decomposition and Brier skill score +#'Compute Brier score, its decomposition, and Brier skill score #' #'Compute the Brier score (BS) and the components of its standard decompostion -#'as well with the two within-bin components described in Stephenson et al., -#'(2008). It also returns the bias-corrected decomposition of the BS (Ferro and -#'Fricker, 2012). BSS has the climatology as the reference forecast. +#'with the two within-bin components described in Stephenson et al., (2008). It +#'also returns the bias-corrected decomposition of the BS (Ferro and Fricker, +#'2012). BSS has the climatology as the reference forecast. #' #'@param exp A vector or a numeric array with named dimensions of the probablistic #' prediction data. The dimension must at least have 'time_dim'. It may have @@ -11,20 +11,25 @@ #' range [0, 1]. #'@param obs A numeric array with named dimensions of the binary observations #' (0 or 1). The dimension must at least have 'time_dim' and other dimensions -#' of 'exp' except 'memb_dim'. +#' of 'exp' except 'memb_dim'. The length of 'dat_dim' can be different from +#' 'exp'. #'@param thresholds A numeric vector used to bin the forecasts. The default -#' value is \code{seq(0, 1, 0,1)}, which means that the bins are -#' \code{[0,0.1), [0.1, 0.2), ... [0.9, 1]}. +#' value is \code{seq(0, 1, 0.1)}, which means that the bins are +#' \code{[0, 0.1), [0.1, 0.2), ... [0.9, 1]}. #'@param time_dim A character string indicating the name of dimension along #' which Brier score is computed. The default value is 'sdate'. +#'@param dat_dim A character string indicating the name of dataset dimension in +#' 'exp' and 'obs'. The length of this dimension can be different between +#' 'exp' and 'obs'. The default value is NULL. #'@param memb_dim A character string of the name of the member dimension. It #' must be one dimension of 'exp'. The function will do the ensemble mean #' over this dimension. If there is no member dimension, set NULL. The default #' value is NULL. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. #' -#'@return A list that contains: -#'The numeric arrays with all 'exp' and 'obs' dimensions expect 'time_dim' and -#''memb_dim': +#'@return +#'A list that contains: #'\item{$rel}{standard reliability} #'\item{$res}{standard resolution} #'\item{$unc}{standard uncertainty} @@ -38,12 +43,26 @@ #'\item{$gres_bias_corrected}{bias - corrected gres} #'\item{$unc_bias_corrected}{bias - corrected unc} #'\item{$bss_bias_corrected}{gres_bias_corrected - rel_bias_corrected / unc_bias_corrected} -#'The numeric arrays with the same dimensions as above and one additional -#'dimension 'bin': #'\item{$nk}{number of forecast in each bin} #'\item{$fkbar}{average probability of each bin} #'\item{$okbar}{relative frequency that the observed event occurred} -#' +#'The data type and dimensions of the items depend on if the input 'exp' and +#''obs' are:\cr +#'(a) Vectors\cr +#'(b) Arrays with 'dat_dim' specified\cr +#'(c) Arrays with no 'dat_dim' specified\cr +#'Items 'rel', 'res', 'unc', 'bs', 'bs_check_res', 'bss_res', 'gres', +#''bs_check_gres', 'bss_gres', 'rel_bias_corrected', 'gres_bias_corrected', +#''unc_bias_corrected', and 'bss_bias_corrected' are (a) a number (b) an array +#'with dimensions c(nexp, nobs, all the rest dimensions in 'exp' and 'obs' +#'expect 'time_dim' and 'memb_dim') (c) an array with dimensions of +#''exp' and 'obs' except 'time_dim' and 'memb_dim'\cr +#'Items 'nk', 'fkbar', and 'okbar' are (a) a vector of length of bin number +#'determined by 'threshold' (b) an array with dimensions c(nexp, nobs, +#'no. of bins, all the rest dimensions in 'exp' and 'obs' expect 'time_dim' and +#''memb_dim') (c) an array with dimensions c(no. of bin, all the rest dimensions +#'in 'exp' and 'obs' expect 'time_dim' and 'memb_dim') +#' #'@references #'Wilks (2006) Statistical Methods in the Atmospheric Sciences.\cr #'Stephenson et al. (2008). Two extra components in the Brier score decomposition. @@ -54,7 +73,7 @@ #'@examples #'# Inputs are vectors #'exp <- runif(10) -#'obs <- round(a) +#'obs <- round(exp) #'x <- BrierScore(exp, obs) #'res <- x$bs - x$bs_check_res #'res <- x$bs - x$bs_check_gres @@ -69,7 +88,7 @@ #'@import multiApply #'@export BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate', - memb_dim = NULL, ncores = NULL) { + dat_dim = NULL, memb_dim = NULL, ncores = NULL) { # Check inputs ## exp and obs @@ -102,6 +121,10 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' 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 (any(name_exp != name_obs)) { stop(paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", "of all the dimensions expect 'exp' may have 'memb_dim'.")) @@ -121,6 +144,15 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' if (!time_dim %in% names(dim(exp))) { stop("Parameter 'time_dim' is not found in 'exp' and '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.") + } + if (!dat_dim %in% names(dim(exp))) { + stop("Parameter 'dat_dim' is not found in 'exp' and 'obs' dimension.") + } + } ## memb_dim if (!is.null(memb_dim)) { if (!is.character(memb_dim) | length(memb_dim) > 1) { @@ -146,102 +178,168 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' exp <- MeanDims(exp, memb_dim) } - res <- Apply(list(exp, obs), - target_dims = list(c(time_dim), - c(time_dim)), - fun = .BrierScore, - thresholds = thresholds, - ncores = ncores) + if (is.null(dat_dim)) { + res <- Apply(list(exp, obs), + target_dims = list(c(time_dim), + c(time_dim)), + fun = .BrierScore, + thresholds = thresholds, + ncores = ncores) + } else { + res <- Apply(list(exp, obs), + target_dims = list(c(time_dim, dat_dim), + c(time_dim, dat_dim)), + fun = .BrierScore, + thresholds = thresholds, + ncores = ncores) + } return(res) } .BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1)) { - # exp: [sdate] - # obs: [sdate] + # exp: [sdate] or [sdate, nexp] + # obs: [sdate] or [sdate, nobs] + if (length(dim(exp)) == 2) { + nexp <- as.numeric(dim(exp)[2]) + nobs <- as.numeric(dim(obs)[2]) + exp_ori <- exp + obs_ori <- obs + # Create empty arrays + arr_rel <- arr_res <- arr_unc <- arr_bs <- arr_bs_check_res <- arr_bss_res <- + arr_gres <- arr_bs_check_gres <- arr_bss_gres <- arr_rel_bias_corrected <- + arr_gres_bias_corrected <- arr_unc_bias_corrected <- arr_bss_bias_corrected <- + array(dim = c(nexp = nexp, nobs = nobs)) + arr_nk <- arr_fkbar <- arr_okbar <- + array(dim = c(nexp = nexp, nobs = nobs, bin = length(thresholds) - 1)) - n <- length(exp) - nbins <- length(thresholds) - 1 # Number of bins - bins <- as.list(paste("bin", 1:nbins, sep = "")) - for (i in 1:nbins) { - if (i == nbins) { - bins[[i]] <- list(which(exp >= thresholds[i] & exp <= thresholds[i + 1])) - } else { - bins[[i]] <- list(which(exp >= thresholds[i] & exp < thresholds[i + 1])) - } + } else { + nexp <- 1 + nobs <- 1 } - fkbar <- okbar <- nk <- array(0, dim = nbins) - for (i in 1:nbins) { - nk[i] <- length(bins[[i]][[1]]) - fkbar[i] <- sum(exp[bins[[i]][[1]]]) / nk[i] - okbar[i] <- sum(obs[bins[[i]][[1]]]) / nk[i] - } + for (n_exp in 1:nexp) { + for (n_obs in 1:nobs) { + if (exists('exp_ori')) { + exp <- exp_ori[, n_exp] + obs <- obs_ori[, n_obs] + } + n <- length(exp) + nbins <- length(thresholds) - 1 # Number of bins + bins <- as.list(paste("bin", 1:nbins, sep = "")) + for (i in 1:nbins) { + if (i == nbins) { + bins[[i]] <- list(which(exp >= thresholds[i] & exp <= thresholds[i + 1])) + } else { + bins[[i]] <- list(which(exp >= thresholds[i] & exp < thresholds[i + 1])) + } + } -#-----in old .BrierScore()--------- -# fkbar[fkbar == Inf] <- 0 -# okbar[is.nan(okbar)] <- 0 -#---------------------------------- - - obar <- sum(obs) / length(obs) - relsum <- ressum <- term1 <- term2 <- 0 - for (i in 1:nbins) { - if (nk[i] > 0) { - relsum <- relsum + nk[i] * (fkbar[i] - okbar[i])^2 - ressum <- ressum + nk[i] * (okbar[i] - obar)^2 - for (j in 1:nk[i]) { - term1 <- term1 + (exp[bins[[i]][[1]][j]] - fkbar[i])^2 - term2 <- term2 + (exp[bins[[i]][[1]][j]] - fkbar[i]) * (obs[bins[[i]][[1]][j]] - okbar[i]) + fkbar <- okbar <- nk <- array(0, dim = nbins) + for (i in 1:nbins) { + nk[i] <- length(bins[[i]][[1]]) + fkbar[i] <- sum(exp[bins[[i]][[1]]]) / nk[i] + okbar[i] <- sum(obs[bins[[i]][[1]]]) / nk[i] } + + #-----in old .BrierScore()--------- + # fkbar[fkbar == Inf] <- 0 + # okbar[is.nan(okbar)] <- 0 + #---------------------------------- + + obar <- sum(obs) / length(obs) + relsum <- ressum <- term1 <- term2 <- 0 + for (i in 1:nbins) { + if (nk[i] > 0) { + relsum <- relsum + nk[i] * (fkbar[i] - okbar[i])^2 + ressum <- ressum + nk[i] * (okbar[i] - obar)^2 + for (j in 1:nk[i]) { + term1 <- term1 + (exp[bins[[i]][[1]][j]] - fkbar[i])^2 + term2 <- term2 + (exp[bins[[i]][[1]][j]] - fkbar[i]) * (obs[bins[[i]][[1]][j]] - okbar[i]) + } + } + } + rel <- relsum / n + res <- ressum / n + unc <- obar * (1 - obar) + bs <- sum((exp - obs)^2) / n + bs_check_res <- rel - res + unc + bss_res <- (res - rel) / unc + gres <- res - term1 * (1 / n) + term2 * (2 / n) # Generalized resolution + bs_check_gres <- rel - gres + unc # BS using GRES + bss_gres <- (gres - rel) / unc # BSS using GRES + + + # Estimating the bias-corrected components of the BS + term3 <- array(0, nbins) + for (i in 1:nbins) { + term3[i] <- (nk[i] / (nk[i] - 1)) * okbar[i] * (1 - okbar[i]) + } + term_a <- sum(term3, na.rm = T) / n + term_b <- (obar * (1 - obar)) / (n - 1) + rel_bias_corrected <- rel - term_a + gres_bias_corrected <- gres - term_a + term_b + if (rel_bias_corrected < 0 || gres_bias_corrected < 0) { + rel_bias_corrected2 <- max(rel_bias_corrected, rel_bias_corrected - gres_bias_corrected, 0) + gres_bias_corrected2 <- max(gres_bias_corrected, gres_bias_corrected - rel_bias_corrected, 0) + rel_bias_corrected <- rel_bias_corrected2 + gres_bias_corrected <- gres_bias_corrected2 + } + unc_bias_corrected <- unc + term_b + bss_bias_corrected <- (gres_bias_corrected - rel_bias_corrected) / unc_bias_corrected + + #if (round(bs, 8) == round(bs_check_gres, 8) & round(bs_check_gres, 8) == round((rel_bias_corrected - gres_bias_corrected + unc_bias_corrected), 8)) { + # cat("No error found \ n") + # cat("BS = REL - GRES + UNC = REL_lessbias - GRES_lessbias + UNC_lessbias \ n") + #} + + # Add name for nk, fkbar, okbar + names(dim(nk)) <- 'bin' + names(dim(fkbar)) <- 'bin' + names(dim(okbar)) <- 'bin' + + if (exists('exp_ori')) { + arr_rel[n_exp, n_obs] <- rel + arr_res[n_exp, n_obs] <- res + arr_unc[n_exp, n_obs] <- unc + arr_bs[n_exp, n_obs] <- bs + arr_bs_check_res[n_exp, n_obs] <- bs_check_res + arr_bss_res[n_exp, n_obs] <- bss_res + arr_gres[n_exp, n_obs] <- gres + arr_bs_check_gres[n_exp, n_obs] <- bs_check_gres + arr_bss_gres[n_exp, n_obs] <- bss_gres + arr_rel_bias_corrected[n_exp, n_obs] <- rel_bias_corrected + arr_gres_bias_corrected[n_exp, n_obs] <- gres_bias_corrected + arr_unc_bias_corrected[n_exp, n_obs] <- unc_bias_corrected + arr_bss_bias_corrected[n_exp, n_obs] <- bss_bias_corrected + arr_nk[n_exp, n_obs, ] <- nk + arr_fkbar[n_exp, n_obs, ] <- fkbar + arr_okbar[n_exp, n_obs, ] <- okbar + } + } } - rel <- relsum / n - res <- ressum / n - unc <- obar * (1 - obar) - bs <- sum((exp - obs)^2) / n - bs_check_res <- rel - res + unc - bss_res <- (res - rel) / unc - gres <- res - term1 * (1 / n) + term2 * (2 / n) # Generalized resolution - bs_check_gres <- rel - gres + unc # BS using GRES - bss_gres <- (gres - rel) / unc # BSS using GRES - - - # Estimating the bias-corrected components of the BS - term3 <- array(0, nbins) - for (i in 1:nbins) { - term3[i] <- (nk[i] / (nk[i] - 1)) * okbar[i] * (1 - okbar[i]) - } - term_a <- sum(term3, na.rm = T) / n - term_b <- (obar * (1 - obar)) / (n - 1) - rel_bias_corrected <- rel - term_a - gres_bias_corrected <- gres - term_a + term_b - if (rel_bias_corrected < 0 || gres_bias_corrected < 0) { - rel_bias_corrected2 <- max(rel_bias_corrected, rel_bias_corrected - gres_bias_corrected, 0) - gres_bias_corrected2 <- max(gres_bias_corrected, gres_bias_corrected - rel_bias_corrected, 0) - rel_bias_corrected <- rel_bias_corrected2 - gres_bias_corrected <- gres_bias_corrected2 - } - unc_bias_corrected <- unc + term_b - bss_bias_corrected <- (gres_bias_corrected - rel_bias_corrected) / unc_bias_corrected - - #if (round(bs, 8) == round(bs_check_gres, 8) & round(bs_check_gres, 8) == round((rel_bias_corrected - gres_bias_corrected + unc_bias_corrected), 8)) { - # cat("No error found \ n") - # cat("BS = REL - GRES + UNC = REL_lessbias - GRES_lessbias + UNC_lessbias \ n") - #} - - # Add name for nk, fkbar, okbar - names(dim(nk)) <- 'bin' - names(dim(fkbar)) <- 'bin' - names(dim(okbar)) <- 'bin' - res_list <- list(rel = rel, res = res, unc = unc, bs = bs, bs_check_res = bs_check_res, - bss_res = bss_res, gres = gres, bs_check_gres = bs_check_gres, - bss_gres = bss_gres, rel_bias_corrected = rel_bias_corrected, - gres_bias_corrected = gres_bias_corrected, - unc_bias_corrected = unc_bias_corrected, - bss_bias_corrected = bss_bias_corrected, nk = nk, fkbar = fkbar, - okbar = okbar) #bins = list(bins), + if (exists('exp_ori')) { + res_list <- list(rel = arr_rel, res = arr_res, unc = arr_unc, bs = arr_bs, + bs_check_res = arr_bs_check_res, bss_res = arr_bss_res, + gres = arr_gres, bs_check_gres = arr_bs_check_gres, + bss_gres = arr_bss_gres, rel_bias_corrected = arr_rel_bias_corrected, + gres_bias_corrected = arr_gres_bias_corrected, + unc_bias_corrected = arr_unc_bias_corrected, + bss_bias_corrected = arr_bss_bias_corrected, nk = arr_nk, + fkbar = arr_fkbar, okbar = arr_okbar) #bins = list(bins), + } else { + + res_list <- list(rel = rel, res = res, unc = unc, bs = bs, bs_check_res = bs_check_res, + bss_res = bss_res, gres = gres, bs_check_gres = bs_check_gres, + bss_gres = bss_gres, rel_bias_corrected = rel_bias_corrected, + gres_bias_corrected = gres_bias_corrected, + unc_bias_corrected = unc_bias_corrected, + bss_bias_corrected = bss_bias_corrected, nk = nk, fkbar = fkbar, + okbar = okbar) #bins = list(bins), + } return(invisible(res_list)) } diff --git a/man/BrierScore.Rd b/man/BrierScore.Rd index 9217718..2486972 100644 --- a/man/BrierScore.Rd +++ b/man/BrierScore.Rd @@ -2,13 +2,14 @@ % Please edit documentation in R/BrierScore.R \name{BrierScore} \alias{BrierScore} -\title{Compute Brier score and its decomposition and Brier skill score} +\title{Compute Brier score, its decomposition, and Brier skill score} \usage{ BrierScore( exp, obs, thresholds = seq(0, 1, 0.1), time_dim = "sdate", + dat_dim = NULL, memb_dim = NULL, ncores = NULL ) @@ -21,24 +22,30 @@ range [0, 1].} \item{obs}{A numeric array with named dimensions of the binary observations (0 or 1). The dimension must at least have 'time_dim' and other dimensions -of 'exp' except 'memb_dim'.} +of 'exp' except 'memb_dim'. The length of 'dat_dim' can be different from +'exp'.} \item{thresholds}{A numeric vector used to bin the forecasts. The default -value is \code{seq(0, 1, 0,1)}, which means that the bins are - \code{[0,0.1), [0.1, 0.2), ... [0.9, 1]}.} +value is \code{seq(0, 1, 0.1)}, which means that the bins are + \code{[0, 0.1), [0.1, 0.2), ... [0.9, 1]}.} \item{time_dim}{A character string indicating the name of dimension along which Brier score is computed. The default value is 'sdate'.} +\item{dat_dim}{A character string indicating the name of dataset dimension in +'exp' and 'obs'. The length of this dimension can be different between +'exp' and 'obs'. The default value is NULL.} + \item{memb_dim}{A character string of the name of the member dimension. It must be one dimension of 'exp'. The function will do the ensemble mean over this dimension. If there is no member dimension, set NULL. The default value is NULL.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} } \value{ A list that contains: -The numeric arrays with all 'exp' and 'obs' dimensions expect 'time_dim' and -'memb_dim': \item{$rel}{standard reliability} \item{$res}{standard resolution} \item{$unc}{standard uncertainty} @@ -52,22 +59,36 @@ The numeric arrays with all 'exp' and 'obs' dimensions expect 'time_dim' and \item{$gres_bias_corrected}{bias - corrected gres} \item{$unc_bias_corrected}{bias - corrected unc} \item{$bss_bias_corrected}{gres_bias_corrected - rel_bias_corrected / unc_bias_corrected} -The numeric arrays with the same dimensions as above and one additional -dimension 'bin': \item{$nk}{number of forecast in each bin} \item{$fkbar}{average probability of each bin} \item{$okbar}{relative frequency that the observed event occurred} +The data type and dimensions of the items depend on if the input 'exp' and +'obs' are:\cr +(a) Vectors\cr +(b) Arrays with 'dat_dim' specified\cr +(c) Arrays with no 'dat_dim' specified\cr +Items 'rel', 'res', 'unc', 'bs', 'bs_check_res', 'bss_res', 'gres', +'bs_check_gres', 'bss_gres', 'rel_bias_corrected', 'gres_bias_corrected', +'unc_bias_corrected', and 'bss_bias_corrected' are (a) a number (b) an array +with dimensions c(nexp, nobs, all the rest dimensions in 'exp' and 'obs' +expect 'time_dim' and 'memb_dim') (c) an array with dimensions of +'exp' and 'obs' except 'time_dim' and 'memb_dim'\cr +Items 'nk', 'fkbar', and 'okbar' are (a) a vector of length of bin number +determined by 'threshold' (b) an array with dimensions c(nexp, nobs, +no. of bins, all the rest dimensions in 'exp' and 'obs' expect 'time_dim' and +'memb_dim') (c) an array with dimensions c(no. of bin, all the rest dimensions +in 'exp' and 'obs' expect 'time_dim' and 'memb_dim') } \description{ Compute the Brier score (BS) and the components of its standard decompostion -as well with the two within-bin components described in Stephenson et al., -(2008). It also returns the bias-corrected decomposition of the BS (Ferro and -Fricker, 2012). BSS has the climatology as the reference forecast. +with the two within-bin components described in Stephenson et al., (2008). It +also returns the bias-corrected decomposition of the BS (Ferro and Fricker, +2012). BSS has the climatology as the reference forecast. } \examples{ # Inputs are vectors exp <- runif(10) -obs <- round(a) +obs <- round(exp) x <- BrierScore(exp, obs) res <- x$bs - x$bs_check_res res <- x$bs - x$bs_check_gres diff --git a/tests/testthat/test-BrierScore.R b/tests/testthat/test-BrierScore.R index d4080b4..5acfa55 100644 --- a/tests/testthat/test-BrierScore.R +++ b/tests/testthat/test-BrierScore.R @@ -56,6 +56,16 @@ test_that("1. Input checks", { BrierScore(exp1, obs1, memb_dim = 'member', time_dim = 'time'), "Parameter 'time_dim' is not found in 'exp' and 'obs' dimension." ) + # dat_dim + expect_error( + BrierScore(exp1, obs1, dat_dim = 2), + "Parameter 'dat_dim' must be a character string." + ) + expect_error( + BrierScore(exp1, obs1, dat_dim = 'dat'), + "Parameter 'dat_dim' is not found in 'exp' and 'obs' dimension." + ) + # memb_dim expect_error( BrierScore(exp2, obs2, memb_dim = 2), "Parameter 'memb_dim' must be a character string." @@ -121,6 +131,22 @@ BrierScore(exp1, obs1, memb_dim = 'member')$nk[, 1, 1], c(0, 1, 0, 0, 1, 0, 2, 1, 0, 0) ) +expect_equal( +dim(BrierScore(exp1, obs1, memb_dim = 'member', dat_dim = 'dataset')$rel), +c(nexp = 1, nobs = 1, ftime = 2) +) +expect_equal( +dim(BrierScore(exp1, obs1, memb_dim = 'member', dat_dim = 'dataset')$nk), +c(nexp = 1, nobs = 1, bin = 10, ftime = 2) +) +expect_equal( +as.vector(BrierScore(exp1, obs1, memb_dim = 'member', dat_dim = 'dataset')$nk), +as.vector(BrierScore(exp1, obs1, memb_dim = 'member')$nk) +) +expect_equal( +as.vector(BrierScore(exp1, obs1, memb_dim = 'member', dat_dim = 'dataset')$bs), +as.vector(BrierScore(exp1, obs1, memb_dim = 'member')$bs) +) }) -- GitLab From eacf840345d1b22e9c581a00c2445e3782e5b546 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 20 Apr 2021 20:24:43 +0200 Subject: [PATCH 088/154] Comment examples temporary --- R/BrierScore.R | 9 +++++---- man/BrierScore.Rd | 9 +++++---- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/R/BrierScore.R b/R/BrierScore.R index 3951b97..d79f62d 100644 --- a/R/BrierScore.R +++ b/R/BrierScore.R @@ -79,11 +79,12 @@ #'res <- x$bs - x$bs_check_gres #'res <- x$rel_bias_corrected - x$gres_bias_corrected + x$unc_bias_corrected #' +#'#===============uncomment the examples below when ProbBins is included========== #'# Inputs are arrays -#'example(Load) -#'bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3), posdates = 3, posdim = 2) -#'bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3), posdates = 3, posdim = 2) -#'res <- BrierScore(bins_ano_exp, MeanDims(bins_ano_obs, 'member'), memb_dim = 'member') +#'#example(Load) +#'#bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3), posdates = 3, posdim = 2) +#'#bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3), posdates = 3, posdim = 2) +#'#res <- BrierScore(bins_ano_exp, MeanDims(bins_ano_obs, 'member'), memb_dim = 'member') #' #'@import multiApply #'@export diff --git a/man/BrierScore.Rd b/man/BrierScore.Rd index 2486972..b54d11b 100644 --- a/man/BrierScore.Rd +++ b/man/BrierScore.Rd @@ -94,11 +94,12 @@ res <- x$bs - x$bs_check_res res <- x$bs - x$bs_check_gres res <- x$rel_bias_corrected - x$gres_bias_corrected + x$unc_bias_corrected +#===============uncomment the examples below when ProbBins is included========== # Inputs are arrays -example(Load) -bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3), posdates = 3, posdim = 2) -bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3), posdates = 3, posdim = 2) -res <- BrierScore(bins_ano_exp, MeanDims(bins_ano_obs, 'member'), memb_dim = 'member') +#example(Load) +#bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3), posdates = 3, posdim = 2) +#bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3), posdates = 3, posdim = 2) +#res <- BrierScore(bins_ano_exp, MeanDims(bins_ano_obs, 'member'), memb_dim = 'member') } \references{ -- GitLab From 93d69aca3d5f3c47e4a33445531799b2c10bd972 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 21 Apr 2021 12:08:12 +0200 Subject: [PATCH 089/154] Include UltimateBrier --- R/UltimateBrier.R | 324 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 324 insertions(+) create mode 100644 R/UltimateBrier.R diff --git a/R/UltimateBrier.R b/R/UltimateBrier.R new file mode 100644 index 0000000..f969e2c --- /dev/null +++ b/R/UltimateBrier.R @@ -0,0 +1,324 @@ +#'Compute Brier scores +#' +#'Interface to compute probabilistic scores (Brier Score, Brier Skill Score) +#'from data obtained from s2dverification. +#' +#'@param exp Array of forecast anomalies, as provided by \code{Ano()}. +#' Dimensions c(n. of experimental datasets, n. of members, n. of start dates, +#' n. of forecast time steps, n. of latitudes, n. of longitudes). Dimensions +#' in other orders are also supported. See parameters \code{posdatasets}, +#' \code{posmemb} and \code{posdates}. +#'@param obs Array of observational reference anomalies, as provided by +#' \code{Ano()}. Dimensions c(n. of observational reference datasets, +#' n. of members, n. of start dates, n. of forecast time steps, +#' n. of latitudes, n. of longitudes). Dimensions in other orders are also +#' supported. See parameters \code{posdatasets}, \code{posmemb} and +#' \code{posdates}. The memb_dim of 'obs' must be 1. +#'@param posdatasets Expected position of dimension corresponding to the +#' different evaluated datasets in input data (exp and obs). +#' By default 1. +#'@param posmemb Expected position of dimension corresponding to members in +#' input data (exp and obs). By default 2. +#'@param posdates Expected position of dimension corresponding to starting +#' dates in input data (exp and obs). By default 3. +#'@param quantile Flag to stipulate whether a quantile (TRUE) or a threshold +#' (FALSE) is used to estimate the forecast and observed probabilities. +#' Takes TRUE by default. +#'@param thr Values to be used as quantiles if 'quantile' is TRUE or as +#' thresholds if 'quantile' is FALSE. Takes by default \code{c(0.05, 0.95)} +#' if 'quantile' is TRUE. +#'@param type Type of score desired. Can take the following values: +#'\itemize{ +#' \item{'BS': Simple Brier Score.} +#' \item{'FairEnsembleBS': Corrected Brier Score computed across ensemble +#' members.} +#' \item{'FairStartDatesBS': Corrected Brier Score computed across starting +#' dates.} +#' \item{'BSS': Simple Brier Skill Score.} +#' \item{'FairEnsembleBSS': Corrected Brier Skill Score computed across +#' ensemble members.} +#' \item{'FairStartDatesBSS': Corrected Brier Skill Score computed across +#' starting dates.} +#'} +#'@param decomposition Flag to determine whether the decomposition of the +#' Brier Score into its components should be provided (TRUE) or not (FALSE). +#' Takes TRUE by default. The decomposition will be computed only if 'type' +#' is 'BS' or 'FairStartDatesBS'. +#'@return +#'If 'type' is 'FairEnsembleBS', 'BSS', 'FairEnsemblesBSS' or +#''FairStartDatesBSS' or 'decomposition' is FALSE and 'type' is 'BS' or +#''FairStartDatesBS', the Brier Score or Brier Skill Score will be returned +#'respectively. +#'If 'decomposition' is TRUE and 'type' is 'BS' or 'FairStartDatesBS' the +#'returned value is a named list with the following entries: +#' \itemize{ +#' \item{'BS': Brier Score.} +#' \item{'REL': Reliability component.} +#' \item{'UNC': Uncertainty component.} +#' \item{'RES': Resolution component.} +#' } +#'The dimensions of each of these arrays will be c(n. of experimental datasets, +#'n. of observational reference datasets, n. of bins, the rest of input +#'dimensions except for the ones pointed by 'posmemb' and 'posdates'). +#'@examples +#'# See ?Load for an explanation on the first part of this example. +#' \dontrun{ +#'data_path <- system.file('sample_data', package = 's2dverification') +#'expA <- list(name = 'experiment', path = file.path(data_path, +#' 'model/$EXP_NAME$/$STORE_FREQ$_mean/$VAR_NAME$_3hourly', +#' '$VAR_NAME$_$START_DATE$.nc')) +#'obsX <- list(name = 'observation', path = file.path(data_path, +#' '$OBS_NAME$/$STORE_FREQ$_mean/$VAR_NAME$', +#' '$VAR_NAME$_$YEAR$$MONTH$.nc')) +#' +#'# Now we are ready to use Load(). +#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +#'sampleData <- Load('tos', list(expA), list(obsX), startDates, +#' leadtimemin = 1, leadtimemax = 4, output = 'lonlat', +#' latmin = 27, latmax = 48, lonmin = -12, lonmax = 40) +#' } +#' \dontshow{ +#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +#'sampleData <- s2dverification:::.LoadSampleData('tos', c('experiment'), +#' c('observation'), startDates, +#' leadtimemin = 1, +#' leadtimemax = 4, +#' output = 'lonlat', +#' latmin = 27, latmax = 48, +#' lonmin = -12, lonmax = 40) +#' } +#'sampleData$mod <- Season(sampleData$mod, 4, 11, 12, 2) +#'sampleData$obs <- Season(sampleData$obs, 4, 11, 12, 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') +#' +#'@import SpecsVerification plyr multiApply +#'@export +UltimateBrier <- function(exp, obs, posdatasets = 1, posmemb = 2, + posdates = 3, quantile = TRUE, + thr = c(5/100, 95/100), type = 'BS', + decomposition = TRUE) { + # Checking exp + if (!is.numeric(exp) || !is.array(exp)) { + stop("Parameter 'exp' must be a numeric array.") + } + if (length(dim(exp)) < 3) { + stop("'exp' must have at least the dimensions c(n. experimental data sets, n. members, n. start dates/forecast time steps/time steps).") + } + + # Checking obs + if (!is.numeric(obs) || !is.array(obs)) { + stop("Parameter 'obs' must be a numeric array.") + } + if (length(dim(obs)) < 3) { + stop("'obs' must have at least the dimensions c(n. observational data sets, n. obs. members, n. start dates/forecast time steps/time steps).") + } + + # Checking consistency in exp and obs + if (!(length(dim(exp)) == length(dim(obs)))) { + stop("'obs' and 'exp' must have the same number of dimensions.") + } + if (!identical(dim(exp)[c(1:length(dim(exp)))[-c(posdatasets, posmemb)]], + dim(obs)[c(1:length(dim(obs)))[-c(posdatasets, posmemb)]])) { + stop("'obs' and 'exp' must have dimensions of equal size except for the datasets and members dimensions.") + } + if (dim(obs)[posmemb] != 1) { + stop("Only observations with one member are supported. dim(obs)[posmemb] should be 1") + } + if (any(is.na(exp)) || any(is.na(obs))) { + stop("There can't be NA values in 'exp' and 'obs'") + } + + # Checking posdatasets + if (!is.numeric(posdatasets)) { + stop("Parameter 'posdatasets' must be an integer.") + } else { + posdatasets <- round(posdatasets) + if (posdatasets > length(dim(exp))) { + stop("Parameter 'posdatasets' exceeds the number of dimensions of the provided anomalies.") + } + } + + # Checking posmemb + if (!is.numeric(posmemb)) { + stop("Parameter 'posmemb' must be an integer.") + } else { + posmemb <- round(posmemb) + if (posmemb > length(dim(exp))) { + stop("Parameter 'posmemb' exceeds the number of dimensions of the provided anomalies.") + } + } + + # Checking posdates + if (!is.numeric(posdates)) { + stop("Parameter 'posdates' must be an integer.") + } else { + posdates <- round(posdates) + if (posdates > length(dim(exp))) { + stop("Parameter 'posdates' exceeds the number of dimensions of the provided anomalies.") + } + } + + if (posdatasets == posmemb || posdatasets == posdates || posmemb == posdates) { + stop("Parameters 'posdatasets', 'posmemb' and 'posdates' must all point to different dimensions.") + } + + # Checking quantile + if (!is.logical(quantile)) { + stop("Parameter 'quantile' must be either TRUE or FALSE.") + } + + # Checking thr + if (!is.numeric(thr)) { + stop("Parameter 'thr' must be a numerical vector.") + } + if (quantile) { + if (!all(thr <= 1 & thr >= 0)) { + stop("All quantiles specified in parameter 'thr' must fall in the range [0, 1].") + } + } + + # Checking type + if (!(type %in% c('BS', 'FairEnsembleBS', 'FairStartDatesBS', 'BSS', 'FairEnsembleBSS', 'FairStartDatesBSS'))) { + stop("'type' not supported") + } + + # Checking decomposition + if (!is.logical(decomposition)) { + stop("Parameter 'decomposition' must be either TRUE or FALSE.") + } + + + ## The functions used to compute FEBSS and FEBS have as input anomalies from Ano() + ## dims: c(datasets, members, startdates, leadtimes, latitudes, longitudes) + if (type %in% c('FairEnsembleBSS', 'FairEnsembleBS')) { + input_exp <- exp + input_obs <- obs + input_posdatasets <- posdatasets + input_posmemb <- posmemb + input_posdates <- posdates + ## The functions used to compute the other scores receive data from ProbBins() + ## dims: c(bins, startdates, members, datasets, leadtimes, latitudes, longitudes) + } else { + # Calculate probabilities of data with ProbBins and average over members + exp <- MeanDims( + ProbBins(exp, 1:dim(exp)[posdates], thr, quantile, posdates, posmemb), + memb_dim) + obs <- MeanDims( + ProbBins(obs, 1:dim(obs)[posdates], thr, quantile, posdates, posmemb), + memb_dim) + +#NOTE: The original code below insert memb_dim = 1 back + exp_probs <- array(Mean1Dim(ProbBins(exp, 1:dim(exp)[posdates], thr, quantile, posdates, posmemb), 3), + dim = c(length(thr) + 1, dim(exp)[posdates], 1, dim(exp)[-c(posmemb, posdates)])) + obs_probs <- array(Mean1Dim(ProbBins(obs, 1:dim(obs)[posdates], thr, quantile, posdates, posmemb), 3), + dim = c(length(thr) + 1, dim(obs)[posdates], 1, dim(obs)[-c(posmemb, posdates)])) + input_exp <- exp_probs + input_obs <- obs_probs + input_posdatasets <- 4 + input_posmemb <- 3 + input_posdates <- 2 + } + + ## Here we define the function 'f' for each type of score (read further for more info). + if (type == 'FairEnsembleBSS') { + size_ens_ref <- prod(dim(obs)[c(posmemb, posdates)]) + f <- function(x) { + ens_ref <- matrix(do.call("[", c(list(x = x), indices_obs)), size_ens_ref, size_ens_ref, byrow = TRUE) + sapply(c(thr, 1), function(tau) { + FairBrierSs(t(do.call("[", c(list(x = x), indices_exp))) > tau, + ens_ref > tau, + do.call("[", c(list(x = x), indices_obs)) > tau)['skillscore'] + }) + } + } else { + if (type == 'FairEnsembleBS') { + f <- function(x) sapply(c(thr, 1), function(tau) mean(FairBrier(t(do.call("[", c(list(x = x), indices_exp))) > tau, do.call("[", c(list(x = x), indices_obs)) > tau), na.rm = TRUE)) + } else { + if (type == 'BS') { + f <- function(x) as.vector(BrierScoreDecomposition(do.call("[", c(list(x = x), indices_exp)), do.call("[", c(list(x = x), indices_obs)))[1, ]) + } else if (type == 'FairStartDatesBS') { + f <- function(x) unlist(BrierScore(do.call("[", c(list(x = x), indices_obs)), do.call("[", c(list(x = x), indices_exp)))[c('rel', 'res', 'unc')], use.names = FALSE) + } else if (type == 'BSS') { + f <- function(x) BrierScore(do.call("[", c(list(x = x), indices_obs)), do.call("[", c(list(x = x), indices_exp)))$bss_res + } else if (type == 'FairStartDatesBSS') { + f <- function(x) BrierScore(do.call("[", c(list(x = x), indices_obs)), do.call("[", c(list(x = x), indices_exp)))$bss_gres + } + } + } + + ## We will calculate score for each exp, obs, bin, leadtime, latitude and longitude + ## So we create array to store results + ## If we calculate a BS we will store its rel, res and unc + if (type %in% c('BS', 'FairStartDatesBS')) { + result <- array(dim = c(dim(exp)[posdatasets], dim(obs)[posdatasets], 3, length(thr) + 1, dim(exp)[-c(posdatasets, posmemb, posdates)])) + } else { + result <- array(dim = c(dim(exp)[posdatasets], dim(obs)[posdatasets], length(thr) + 1, dim(exp)[-c(posdatasets, posmemb, posdates)])) + } + ## In order to be able to use apply, we put data of each exp and obs in a single array, + ## all merged over the members dimension. + indices_exp <- as.list(rep(TRUE, length(dim(input_exp)))) + indices_exp[[input_posmemb]] <- c(1:dim(input_exp)[input_posmemb]) + indices_exp <- indices_exp[c(input_posdatasets, input_posmemb, input_posdates)] + indices_obs <- as.list(rep(TRUE, length(dim(input_obs)))) + indices_obs[[input_posmemb]] <- c(1:dim(input_obs)[input_posmemb]) + dim(input_exp)[input_posmemb] + indices_obs <- indices_obs[c(input_posdatasets, input_posmemb, input_posdates)] + out_indices <- as.list(rep(TRUE, length(dim(result)))) + for (n_obs in 1:dim(obs)[posdatasets]) { + for (n_exp in 1:dim(exp)[posdatasets]) { + data <- abind(take(input_exp, input_posdatasets, n_exp), + take(input_obs, input_posdatasets, n_obs), + along = input_posmemb) + out_indices[c(1, 2)] <- c(n_exp, n_obs) + ## We apply function 'f' to data of each couple of exp and obs, merged in a single array. + ## This data will have dimensions + ## (1, nmembexp + nmembobs, nsdates, nltimes, nlat, nlon) + ## or + ## (nbins, nsdates, nmembexp + nmembobs, 1, nltimes, nlat, nlon) + ## depending on the input type. + ## The function 'f' is applied along all dimensions but (datasets, members and sdates) + ## so the produced output by apply is at least of dimensions + ## (nltimes, nlat, nlon) + ## or + ## (nbins, nltimes, nlat, nlon) + ## depending on the input type (FairEnsembleBS and FairEnsembleBSS + ## will have at lest the first set of dimensions, + ## other scores will have at least the second). + ## So 'f' must have as input an array of dims (1, nmembexp + nmembobs, nsdates). + ## 'indices_exp' and 'indices_obs' will pick for us the input data corresponding to + ## experiments or observations respectively. + ## In order to match with dimensions of 'result', the apply() must have as + ## output an array of dims (nbins, nltimes, nlat, nlon) + ## or (3, nbins, nltimes, nlat, nlon) if calculating BS or FairStartDatesBS. + ## All in all, after looking at apply()'s 'at least' output + ## dimensions and at apply()'s required output dimensions: + ## 'f' must have as output a vector of length nbins for FEBS and FEBSS + ## 'f' must have as output a vector of length 3 (corresponding to rel, res and unc) for BS and FSDBS + ## 'f' must have as output a single numeric element for other scores + result <- do.call("[<-", c(list(x = result), out_indices, list(value = apply(data, c(1:length(dim(data)))[-c(input_posdatasets, input_posmemb, input_posdates)], f)))) + } + } + + if (type %in% c('BSS', 'FairStartDatesBSS', 'FairEnsembleBSS')) { + result + } else { + if (decomposition && type != 'FairEnsembleBS') { + rel <- take(result, 3, 1) + dim(rel) <- dim(rel)[-3] + res <- take(result, 3, 2) + dim(res) <- dim(res)[-3] + unc <- take(result, 3, 3) + dim(unc) <- dim(unc)[-3] + bs <- rel - res + unc + list(BS = bs, REL = rel, UNC = unc, RES = res) + } else { + result <- take(result, 3, 1) - take(result, 3, 2) + take(result, 3, 3) + dim(result) <- dim(result)[-3] + result + } + } +} + -- GitLab From e3971c979214b0192004e9040ea1f02aabad780f Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 21 Apr 2021 17:57:19 +0200 Subject: [PATCH 090/154] Transform ProbBins.R --- NAMESPACE | 1 + R/ProbBins.R | 299 +++++++++++++++++++-------------- man/ProbBins.Rd | 79 +++++++++ tests/testthat/test-ProbBins.R | 159 ++++++++++++++++++ 4 files changed, 408 insertions(+), 130 deletions(-) create mode 100644 man/ProbBins.Rd create mode 100644 tests/testthat/test-ProbBins.R diff --git a/NAMESPACE b/NAMESPACE index 6da8d0c..c3f0a8f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -34,6 +34,7 @@ export(PlotLayout) export(PlotMatrix) export(PlotSection) export(PlotStereoMap) +export(ProbBins) export(RMS) export(RMSSS) export(RandomWalkTest) diff --git a/R/ProbBins.R b/R/ProbBins.R index b0bc279..0bb8876 100644 --- a/R/ProbBins.R +++ b/R/ProbBins.R @@ -1,29 +1,35 @@ -#'Computes Probabilistic Information of a Forecast Relative to a Threshold or a Quantile +#'Compute probabilistic information of a forecast relative to a threshold or a quantile #' #'Compute probabilistic bins of a set of forecast years ('fcyr') relative to #'the forecast climatology over the whole period of anomalies, optionally excluding #'the selected forecast years ('fcyr') or the forecast year for which the #'probabilistic bins are being computed (see 'compPeriod'). #' -#'@param ano Array of anomalies from Ano().\cr -#' Must be of dimension (nexp/nobs, nmemb, nsdates, nleadtime, nlat, nlon) -#'@param fcyr Indices of the forecast years of the anomalies which to compute -#' the probabilistic bins for, or 'all' to compute the bins for all the -#' years.\cr -#' E.g., c(1:5), c(1, 4), 4 or 'all'. -#'@param thr Values used as thresholds to bin the anomalies. -#'@param quantile If quantile is TRUE (default), the threshold ('thr') -#' are quantiles.\cr -#' If quantile is FALSE the thresholds ('thr') introduced are the absolute -#' thresholds of the bins. -#'@param posdates Position of the dimension in \code{ano} that corresponds to -#' the start dates (default = 3). -#'@param posdim Position of the dimension in \code{ano} which will be combined -#' with 'posdates' to compute the quantiles (default = 2, ensemble members). -#'@param compPeriod Three options: -#' "Full period"/"Without fcyr"/"Cross-validation" (The probabilities are -#' computed with the terciles based on ano/ano with all 'fcyr's -#' removed/cross-validation). The default is "Full period". +#'@param data An numeric array of anomalies with the dimensions 'time_dim' and +#' 'memb_dim' at least. It can be generated by \code{Ano()}. +#'@param thr A numeric vector within range [0, 1] used as the thresholds to bin +#' the anomalies. +#'@param fcyr A numeric vector of the indices of the forecast years (i.e., +#' time_dim) to compute the probabilistic bins for, or 'all' to compute the +#' bins for all the years. E.g., c(1:5), c(1, 4), 4, or 'all'. The default +#' value is 'all'. +#'@param time_dim A character string indicating the dimension along which to +#' compute the probabilistic bins. The default value is 'sdate'. +#'@param memb_dim A character string indicating the name of the member +#' dimension or the dimension to be merged with 'time_dim' for probabilistic +#' calculation. The default value is 'member'. +#'@param quantile A logical value indicating if the thresholds ('thr') are +#' quantiles (TRUE) or the absolute thresholds of the bins (FALSE). The +#' default value is TRUE. +#'@param compPeriod A character string referring to three computation options:\cr +#' "Full period": The probabilities are computed based on 'data';\cr +#' "Without fcyr": The probabilities are computed based on 'data' with all +#' 'fcyr' removed;\cr +#' "Cross-validation": The probabilities are computed based on leave-one-out +#' cross-validation.\cr +#' The default value is "Full period". +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. #' #'@return Array with probabilistic information and dimensions:\cr #' c(length('thr') + 1, length(fcyr), nmemb/nparam, nmod/nexp/nobs, @@ -32,51 +38,27 @@ #' of the 'thr'+1 cathegories the forecast/observation at the corresponding #' grid point, time step, member and starting date belongs to. #' -#'@keywords datagen #'@examples -#'# See examples on Load() to understand the first lines in this example -#' \dontrun{ -#'data_path <- system.file('sample_data', package = 's2dverification') -#'expA <- list(name = 'experiment', path = file.path(data_path, -#' 'model/$EXP_NAME$/$STORE_FREQ$_mean/$VAR_NAME$_3hourly', -#' '$VAR_NAME$_$START_DATE$.nc')) -#'obsX <- list(name = 'observation', path = file.path(data_path, -#' '$OBS_NAME$/$STORE_FREQ$_mean/$VAR_NAME$', -#' '$VAR_NAME$_$YEAR$$MONTH$.nc')) -#' -#'# Now we are ready to use Load(). -#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') -#'sampleData <- Load('tos', list(expA), list(obsX), startDates, -#' output = 'lonlat', latmin = 27, latmax = 48, -#' lonmin = -12, lonmax = 40) -#' } -#' \dontshow{ +#'\dontshow{ #'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') -#'sampleData <- s2dverification:::.LoadSampleData('tos', c('experiment'), -#' c('observation'), startDates, -#' output = 'lonlat', -#' latmin = 27, latmax = 48, -#' lonmin = -12, lonmax = 40) -#' } +#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), +#' c('observation'), startDates, +#' output = 'lonlat', +#' latmin = 27, latmax = 48, +#' lonmin = -12, lonmax = 40) +#'} #'clim <- Clim(sampleMap$mod, sampleMap$obs) #'ano_exp <- Ano(sampleMap$mod, clim$clim_exp) -#'PB <- ProbBins(ano_exp, fcyr = 3, thr = c(1/3, 2/3), quantile = TRUE, posdates = 3, -#' posdim = 2) +#'PB <- ProbBins(ano_exp, fcyr = 3, thr = c(1/3, 2/3), quantile = TRUE) #' +#'@import multiApply +#'@importFrom abind abind #'@export +ProbBins <- function(data, thr, fcyr = 'all', time_dim = 'sdate', memb_dim = 'member', + quantile = TRUE, compPeriod = "Full period", + ncores = NULL) { -ProbBins_new <- function(data, len = 'all', thr, quantile, sdate_dim = 'sdate', - memb_dim = 'member', - compPeriod = "Full period", ncores) { - - # Check inputs - ## dims - if (is.null(memb_dim) && compPeriod != "Cross-validation") { - dims <- sdate_dim - } else { - dims <- c(sdate_dim, memb_dim) - } - + # Check inputs ## data if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") @@ -84,85 +66,142 @@ ProbBins_new <- function(data, len = 'all', thr, quantile, sdate_dim = 'sdate', if (!is.numeric(data)) { stop("Parameter 'data' must be a numeric array.") } - if (is.null(dim(data))) { #is vector, turn into array - data <- array(data, c(dim = length(data))) - dims <- 'dim' +# if (is.null(dim(data))) { #is vector +# dim(data) <- c(length(data)) +# names(dim(data)) <- time_dim +# } + if(any(is.null(names(dim(data))))| any(nchar(names(dim(data))) == 0)) { + stop("Parameter 'data' must have dimension names.") } - ## forecast year - if (length(len) == 1) { - if (len == 'all') { - if (length(dim(data)) == 1) { - len <- array(1:length(data), length(data)) - names(dim(len)) <- names(dim(data)) - } else { - len <- array(1:dim(data)[sdate_dim], dim(data)[sdate_dim]) - } - } + ## thr + if (!is.numeric(thr) | !is.vector(thr)) { + stop("Parameter 'thr' must be a numeric vector.") + } else if (max(thr) > 1 | min(thr) < 0) { + stop("Parameter 'thr' must be within the range [0, 1].") } - if (compPeriod == "Cross-validation") { - result <- lapply(len, function(x) { - if (quantile) { - thr <- Apply(list(ClimProjDiags::Subset(data, - along = sdate_dim, indices = -x)), target_dims = c(dims), - fun = function(x) {quantile(as.vector(x), probs = thr, - na.rm = TRUE, names = FALSE, type = 8)}, - output_dims = 'bin', ncores = ncores)$output1 - } - data <- ClimProjDiags::Subset(data, along = sdate_dim, indices = x) - Apply(list(data, thr), target_dims = list(c(dims), 'bin'), - fun = .bin, ncores = ncores)$output1 - }) - dims <- c(sdate = length(len), dim(result[[1]])[-1]) - result <- unlist(result) - dim(result) <- dims - } else if (compPeriod == "Without fcyr") { - if (quantile) { - thr <- Apply(list(ClimProjDiags::Subset(data, - along = sdate_dim, indices = -len)), target_dims = c(dims), - fun = function(x) {quantile(as.vector(x), probs = thr, - na.rm = TRUE, names = FALSE, type = 8)}, - output_dims = 'bin', ncores = ncores)$output1 + ## 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' dimension.") + } + ## 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' dimension.") + } + ## fcyr + if (fcyr != 'all') { + if (!is.numeric(fcyr) | !is.vector(fcyr)) { + stop("Parameter 'fcyr' must be a numeric vector or 'all'.") + } else if (any(fcyr %% 1 != 0) | min(fcyr) < 1 | max(fcyr) > dim(data)[time_dim]) { + stop(paste0("Parameter 'fcyr' must be the indices of 'time_dim' within ", + "the range [1, ", dim(data)[time_dim], "].")) } - data <- ClimProjDiags::Subset(data, along = sdate_dim, indices = len) - result <- Apply(list(data, thr), target_dims = list(c(dims), 'bin'), - fun = .bin, ncores = ncores)$output1 - } else if (compPeriod == "Full period") { - if (quantile) { - thr <- Apply(list(data), target_dims = c(dims), - fun = function(x) {quantile(as.vector(x), probs = thr, - na.rm = TRUE, names = FALSE, type = 8)}, - output_dims = 'bin', ncores = ncores)$output1 - } - result <- Apply(list(data, thr), target_dims = list(c(dims), 'bin'), - fun = .bin, ncores = ncores)$output1 } else { - stop("Parameter 'compPeriod' must be one of 'Full period', ", - "'Without fcyr' or 'Cross-validation'.") + fcyr <- 1:dim(data)[time_dim] + } + ## quantile + if (!is.logical(quantile) | length(quantile) > 1) { + stop("Parameter 'quantile' must be one logical value.") + } + ## compPeriod + if (length(compPeriod) != 1 | any(!compPeriod %in% c('Full period', 'Without fcyr', 'Cross-validation'))) { + stop("Parameter 'compPeriod' must be either 'Full period', 'Without fcyr', or 'Cross-validation'.") } - return(result) + ## 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.") + } + } + + ############################### + # Calculate ProbBins + + res <- Apply(list(data), + target_dims = list(c(time_dim, memb_dim)), + output_dims = list(c('bin', time_dim, memb_dim)), + fun = .ProbBins, + thr = thr, fcyr = fcyr, quantile = quantile, + compPeriod = compPeriod, + ncores = ncores)$output1 + + return(res) } - -.PBF <- function(data, thr, quantile, dims = c('posdate', 'member'), - ncores) { - if (quantile) { - thr <- Apply(list(data), target_dims = c(dims), - fun = function(x) {quantile(as.vector(x), probs = thr, - na.rm = TRUE, names = FALSE, type = 8)}, - output_dims = 'bin', ncores = ncores)$output1 + +.ProbBins <- function(data, thr = thr, fcyr = 'all', quantile, compPeriod = "Full period") { + + # data: [sdate, member] + + if (compPeriod != 'Cross-validation') { + # forecast + fore <- data[fcyr, ] + sample_fore <- as.vector(fore) # vector: [fcyr + member] + # hindcast + if (compPeriod == "Full period") { + hind <- data + sample <- as.vector(hind) # vector: [sdate + member] + } else if (compPeriod == "Without fcyr") { + hind <- data[-fcyr, ] + sample <- as.vector(hind) # vector: [sdate - fcyr + member] + } + + # quantiles + if (quantile) { + qum <- quantile(sample, probs = thr, na.rm = TRUE, names = FALSE, + type = 8) # vector: [length(thr)] + } else { + qum <- thr + } + + # PBF: Probabilistic bins of a forecast + # This array contains 0s and 1s that indicate the category where the forecast is. + PBF <- array(counts(c(qum, sample_fore), nbthr = length(thr)), + dim = c(length(thr) + 1, length(fcyr), dim(data)[2])) +# names(dim(PBF)) <- c('bin', 'sdate', 'member') + + return(invisible(PBF)) + + + } else { # Cross-Validation + + result <- NULL + for (iyr in fcyr) { + if (is.null(result)) { + result <- .ProbBins(data, fcyr = iyr, thr = thr, quantile = quantile, + compPeriod = "Without fcyr") # [bin, sdate, member] + } else { + result <- abind::abind(result, .ProbBins(data, fcyr = iyr, thr = thr, + quantile = quantile, + compPeriod = "Without fcyr"), + along = 2) # along sdate + } + } + + return(result) + } - PBF <- Apply(list(data, thr), target_dims = list(c(dims), 'bin'), - fun = .bin, ncores = ncores)$output1 + } -# data <- array(1:15, c(x = 15)) -# thres <- c(5,10) -.bin <- function(data, thres) { - res <- 1 * (data <= thres[1]) - if (length(thres) > 1) { - res <- c(res, unlist(lapply(2:length(thres), function (i) { - return(1 * ((data > thres[i - 1]) & (data <= thres[i]))) - }))) + +# This function assign the values to a category which is limited by the thresholds +# It provides binary information +counts <- function (dat, nbthr) { + thr <- dat[1:nbthr] + data <- dat[nbthr + 1:(length(dat) - nbthr)] + prob <- array(NA, dim = c(nbthr + 1, length(dat) - nbthr)) + prob[1, ] <- 1*(data <= thr[1]) + if (nbthr != 1) { + for (ithr in 2:(nbthr)) { + prob[ithr, ] <- 1 * ((data > thr[ithr - 1]) & (data <= thr[ithr])) + } } - res <- c(res, 1 * (data > thres[length(thres)])) - dim(res) <- c(dim(data), bin = length(thres) + 1) - return(res) + prob[nbthr + 1, ] <- 1 * (data > thr[nbthr]) + return(prob) } + diff --git a/man/ProbBins.Rd b/man/ProbBins.Rd new file mode 100644 index 0000000..9e46690 --- /dev/null +++ b/man/ProbBins.Rd @@ -0,0 +1,79 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ProbBins.R +\name{ProbBins} +\alias{ProbBins} +\title{Compute probabilistic information of a forecast relative to a threshold or a quantile} +\usage{ +ProbBins( + data, + thr, + fcyr = "all", + time_dim = "sdate", + memb_dim = "member", + quantile = TRUE, + compPeriod = "Full period", + ncores = NULL +) +} +\arguments{ +\item{data}{An numeric array of anomalies with the dimensions 'time_dim' and +'memb_dim' at least. It can be generated by \code{Ano()}.} + +\item{thr}{A numeric vector within range [0, 1] used as the thresholds to bin +the anomalies.} + +\item{fcyr}{A numeric vector of the indices of the forecast years (i.e., +time_dim) to compute the probabilistic bins for, or 'all' to compute the +bins for all the years. E.g., c(1:5), c(1, 4), 4, or 'all'. The default +value is 'all'.} + +\item{time_dim}{A character string indicating the dimension along which to +compute the probabilistic bins. The default value is 'sdate'.} + +\item{memb_dim}{A character string indicating the name of the member +dimension or the dimension to be merged with 'time_dim' for probabilistic +calculation. The default value is 'member'.} + +\item{quantile}{A logical value indicating if the thresholds ('thr') are +quantiles (TRUE) or the absolute thresholds of the bins (FALSE). The +default value is TRUE.} + +\item{compPeriod}{A character string referring to three computation options:\cr +"Full period": The probabilities are computed based on 'data';\cr +"Without fcyr": The probabilities are computed based on 'data' with all +'fcyr' removed;\cr +"Cross-validation": The probabilities are computed based on leave-one-out +cross-validation.\cr +The default value is "Full period".} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +Array with probabilistic information and dimensions:\cr + c(length('thr') + 1, length(fcyr), nmemb/nparam, nmod/nexp/nobs, + nltime, nlat, nlon)\cr + The values along the first dimension take values 0 or 1 depending on which + of the 'thr'+1 cathegories the forecast/observation at the corresponding + grid point, time step, member and starting date belongs to. +} +\description{ +Compute probabilistic bins of a set of forecast years ('fcyr') relative to +the forecast climatology over the whole period of anomalies, optionally excluding +the selected forecast years ('fcyr') or the forecast year for which the +probabilistic bins are being computed (see 'compPeriod'). +} +\examples{ +\dontshow{ +startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), + c('observation'), startDates, + output = 'lonlat', + latmin = 27, latmax = 48, + lonmin = -12, lonmax = 40) +} +clim <- Clim(sampleMap$mod, sampleMap$obs) +ano_exp <- Ano(sampleMap$mod, clim$clim_exp) +PB <- ProbBins(ano_exp, fcyr = 3, thr = c(1/3, 2/3), quantile = TRUE) + +} diff --git a/tests/testthat/test-ProbBins.R b/tests/testthat/test-ProbBins.R new file mode 100644 index 0000000..83e4f3b --- /dev/null +++ b/tests/testthat/test-ProbBins.R @@ -0,0 +1,159 @@ +context("s2dv::ProbBins tests") + +############################################## + # dat1 + set.seed(1) + dat1 <- array(rnorm(24), dim = c(dataset = 1, member = 3, sdate = 4, ftime = 2)) +############################################## + +test_that("1. Input checks", { + + expect_error( + ProbBins(c()), + "Parameter 'data' cannot be NULL." + ) + expect_error( + ProbBins(c(NA, NA)), + "Parameter 'data' must be a numeric array." + ) + expect_error( + ProbBins(array(1:10, dim = c(2, 5))), + "Parameter 'data' must have dimension names." + ) + # thr + expect_error( + ProbBins(dat1, thr = TRUE), + "Parameter 'thr' must be a numeric vector." + ) + expect_error( + ProbBins(dat1, thr = 1:10), + "Parameter 'thr' must be within the range \\[0, 1\\]." + ) + # time_dim + expect_error( + ProbBins(dat1, thr = c(1/3, 2/3), time_dim = 'time'), + "Parameter 'time_dim' is not found in 'data' dimension." + ) + expect_error( + ProbBins(dat1, thr = c(1/3, 2/3), time_dim = 2), + "Parameter 'time_dim' must be a character string." + ) + # memb_dim + expect_error( + ProbBins(dat1, thr = c(1/3, 2/3), memb_dim = 2), + "Parameter 'memb_dim' must be a character string." + ) + expect_error( + ProbBins(dat1, thr = c(1/3, 2/3), memb_dim = 'ens'), + "Parameter 'memb_dim' is not found in 'data' dimension." + ) + # fcyr + expect_error( + ProbBins(dat1, thr = c(1/3, 2/3), fcyr = 'sdate'), + "Parameter 'fcyr' must be a numeric vector or 'all'." + ) + expect_error( + ProbBins(dat1, thr = c(1/3, 2/3), fcyr = 2:6), + "Parameter 'fcyr' must be the indices of 'time_dim' within the range \\[1, 4\\]." + ) + # quantile + expect_error( + ProbBins(dat1, thr = c(1/3, 2/3), quantile = 0.9), + "Parameter 'quantile' must be one logical value." + ) + # compPeriod + expect_error( + ProbBins(dat1, thr = c(1/3, 2/3), compPeriod = TRUE), + "Parameter 'compPeriod' must be either 'Full period', 'Without fcyr', or 'Cross-validation'." + ) + # ncores + expect_error( + ProbBins(dat1, thr = c(1/3, 2/3), ncores = 0), + "Parameter 'ncores' must be a positive integer." + ) + +}) + + +############################################## +test_that("2. Output checks: dat1", { + +expect_equal( +dim(ProbBins(dat1, thr = c(1/3, 2/3))), +c(bin = 3, sdate = 4, member = 3, dataset = 1, ftime = 2) +) +expect_equal( +dim(ProbBins(dat1, thr = c(0.25, 0.5, 0.75))), +c(bin = 4, sdate = 4, member = 3, dataset = 1, ftime = 2) +) +expect_equal( +dim(ProbBins(dat1, thr = c(0.25, 0.5, 0.75), compPeriod = 'Cross-validation')), +c(bin = 4, sdate = 4, member = 3, dataset = 1, ftime = 2) +) +expect_equal( +dim(ProbBins(dat1, thr = c(0.25, 0.5, 0.75), compPeriod = 'Without fcyr')), +c(bin = 4, sdate = 4, member = 3, dataset = 1, ftime = 2) +) +expect_equal( +length(which(ProbBins(dat1, thr = c(1/3, 2/3)) == 0)), +48 +) +expect_equal( +length(which(ProbBins(dat1, thr = c(1/3, 2/3)) == 1)), +24 +) +expect_equal( +which(ProbBins(dat1, thr = c(1/3, 2/3)) == 1), +c(1, 6, 8, 10, 14, 17, 21, 24, 25, 28, 33, 35, 37, 40, 45, 47, 49, 53, 56, 59, 63, 66, 69, 70) +) +expect_equal( +all(is.na(ProbBins(dat1, thr = c(1/3, 2/3), compPeriod = 'Without fcyr'))), +TRUE +) +expect_equal( +dim(ProbBins(dat1, thr = c(1/3, 2/3), fcyr = 2, compPeriod = 'Without fcyr')), +c(bin = 3, sdate = 1, member = 3, dataset = 1, ftime = 2) +) +expect_equal( +length(which(ProbBins(dat1, thr = c(1/3, 2/3), fcyr = 2, compPeriod = 'Without fcyr') == 0)), +12 +) +expect_equal( +length(which(ProbBins(dat1, thr = c(1/3, 2/3), fcyr = 2, compPeriod = 'Without fcyr') == 1)), +6 +) +expect_equal( +which(ProbBins(dat1, thr = c(1/3, 2/3), fcyr = 2, compPeriod = 'Without fcyr') == 1), +c(3, 5, 7, 11, 14, 18) +) +expect_equal( +length(which(ProbBins(dat1, thr = c(1/3, 2/3), fcyr = 2, compPeriod = 'Cross-validation') == 0)), +12 +) +expect_equal( +length(which(ProbBins(dat1, thr = c(1/3, 2/3), fcyr = 2, compPeriod = 'Cross-validation') == 1)), +6 +) +expect_equal( +which(ProbBins(dat1, thr = c(1/3, 2/3), fcyr = 2, compPeriod = 'Cross-validation') == 1), +c(3, 5, 7, 11, 14, 18) +) + +expect_equal( +dim(ProbBins(dat1, thr = c(1/3, 2/3), quantile = FALSE)), +c(bin = 3, sdate = 4, member = 3, dataset = 1, ftime = 2) +) +expect_equal( +length(which(ProbBins(dat1, thr = c(1/3, 2/3), quantile = FALSE) == 0)), +48 +) +expect_equal( +length(which(ProbBins(dat1, thr = c(1/3, 2/3), quantile = FALSE) == 1)), +24 +) +expect_equal( +which(ProbBins(dat1, thr = c(1/3, 2/3), quantile = FALSE) == 1), +c(1, 6, 8, 10, 13, 16, 21, 24, 25, 28, 32, 35, 37, 40, 45, 48, 49, 52, 56, 58, 63, 66, 69, 70) +) + +}) -- GitLab From c3635761c30f56ba77a5b40b258398f3a2125ef7 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 21 Apr 2021 17:57:41 +0200 Subject: [PATCH 091/154] Update documents --- DESCRIPTION | 2 +- man/AMV.Rd | 21 ++++++-- man/AnimateMap.Rd | 33 +++++++++--- man/Ano.Rd | 1 - man/Clim.Rd | 16 ++++-- man/ColorBar.Rd | 32 +++++++++--- man/Composite.Rd | 14 +++-- man/ConfigApplyMatchingEntries.Rd | 11 ++-- man/ConfigEditDefinition.Rd | 1 - man/ConfigEditEntry.Rd | 45 ++++++++++++---- man/ConfigFileOpen.Rd | 3 +- man/ConfigShowSimilarEntries.Rd | 17 ++++-- man/ConfigShowTable.Rd | 3 +- man/Corr.Rd | 17 ++++-- man/Eno.Rd | 1 - man/GMST.Rd | 24 +++++++-- man/GSAT.Rd | 21 ++++++-- man/InsertDim.Rd | 1 - man/LeapYear.Rd | 1 - man/Load.Rd | 40 ++++++++++---- man/MeanDims.Rd | 3 +- man/Persistence.Rd | 17 ++++-- man/PlotAno.Rd | 31 ++++++++--- man/PlotClim.Rd | 26 +++++++--- man/PlotEquiMap.Rd | 86 ++++++++++++++++++++++++------- man/PlotLayout.Rd | 73 ++++++++++++++++++-------- man/PlotMatrix.Rd | 29 ++++++++--- man/PlotSection.Rd | 25 +++++++-- man/PlotStereoMap.Rd | 61 +++++++++++++++++----- man/RMS.Rd | 14 +++-- man/RMSSS.Rd | 11 ++-- man/RandomWalkTest.Rd | 1 - man/Regression.Rd | 14 +++-- man/Reorder.Rd | 1 - man/SPOD.Rd | 21 ++++++-- man/Season.Rd | 13 +++-- man/Smoothing.Rd | 1 - man/TPI.Rd | 21 ++++++-- man/ToyModel.Rd | 15 ++++-- man/Trend.Rd | 13 +++-- man/clim.palette.Rd | 3 +- man/s2dv-package.Rd | 47 +++++++++++++---- man/sampleDepthData.Rd | 1 - man/sampleMap.Rd | 1 - man/sampleTimeSeries.Rd | 1 - 45 files changed, 620 insertions(+), 213 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 126179a..30fd237 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -45,4 +45,4 @@ BugReports: https://earth.bsc.es/gitlab/es/s2dv/-/issues LazyData: true SystemRequirements: cdo Encoding: UTF-8 -RoxygenNote: 5.0.0 +RoxygenNote: 7.0.1 diff --git a/man/AMV.Rd b/man/AMV.Rd index 5aa6d30..881e136 100644 --- a/man/AMV.Rd +++ b/man/AMV.Rd @@ -4,10 +4,22 @@ \alias{AMV} \title{Compute the Atlantic Multidecadal Variability (AMV) index} \usage{ -AMV(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +AMV( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -106,4 +118,3 @@ lon <- seq(0, 360, 10) index_dcpp <- AMV(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/AnimateMap.Rd b/man/AnimateMap.Rd index d2003ee..2ec930d 100644 --- a/man/AnimateMap.Rd +++ b/man/AnimateMap.Rd @@ -4,13 +4,33 @@ \alias{AnimateMap} \title{Animate Maps of Forecast/Observed Values or Scores Over Forecast Time} \usage{ -AnimateMap(var, lon, lat, toptitle = rep("", 11), sizetit = 1, units = "", - monini = 1, freq = 12, msk95lev = FALSE, brks = NULL, cols = NULL, - filled.continents = FALSE, lonmin = 0, lonmax = 360, latmin = -90, - latmax = 90, intlon = 20, intlat = 30, drawleg = TRUE, - subsampleg = 1, colNA = "white", equi = TRUE, +AnimateMap( + var, + lon, + lat, + toptitle = rep("", 11), + sizetit = 1, + units = "", + monini = 1, + freq = 12, + msk95lev = FALSE, + brks = NULL, + cols = NULL, + filled.continents = FALSE, + lonmin = 0, + lonmax = 360, + latmin = -90, + latmax = 90, + intlon = 20, + intlat = 30, + drawleg = TRUE, + subsampleg = 1, + colNA = "white", + equi = TRUE, fileout = c("output1_animvsltime.gif", "output2_animvsltime.gif", - "output3_animvsltime.gif"), ...) + "output3_animvsltime.gif"), + ... +) } \arguments{ \item{var}{Matrix of dimensions (nltime, nlat, nlon) or @@ -162,4 +182,3 @@ AnimateMap(clim$clim_exp, sampleData$lon, sampleData$lat, # More examples in s2dverification but are deleted for now } - diff --git a/man/Ano.Rd b/man/Ano.Rd index 2dd4dea..8e423af 100644 --- a/man/Ano.Rd +++ b/man/Ano.Rd @@ -41,4 +41,3 @@ PlotAno(ano_exp, ano_obs, startDates, legends = 'ERSST', biglab = FALSE, fileout = 'tos_ano.png') } } - diff --git a/man/Clim.Rd b/man/Clim.Rd index a997a7f..78559bd 100644 --- a/man/Clim.Rd +++ b/man/Clim.Rd @@ -4,9 +4,18 @@ \alias{Clim} \title{Compute Bias Corrected Climatologies} \usage{ -Clim(exp, obs, time_dim = "sdate", dat_dim = c("dataset", "member"), - method = "clim", ftime_dim = "ftime", memb = TRUE, - memb_dim = "member", na.rm = TRUE, ncores = NULL) +Clim( + exp, + obs, + time_dim = "sdate", + dat_dim = c("dataset", "member"), + method = "clim", + ftime_dim = "ftime", + memb = TRUE, + memb_dim = "member", + na.rm = TRUE, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -82,4 +91,3 @@ PlotClim(clim$clim_exp, clim$clim_obs, listobs = c('ERSST'), biglab = FALSE, fileout = 'tos_clim.eps') } } - diff --git a/man/ColorBar.Rd b/man/ColorBar.Rd index 1287b70..6d62f15 100644 --- a/man/ColorBar.Rd +++ b/man/ColorBar.Rd @@ -4,13 +4,30 @@ \alias{ColorBar} \title{Draws a Color Bar} \usage{ -ColorBar(brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, - bar_limits = NULL, var_limits = NULL, triangle_ends = NULL, - col_inf = NULL, col_sup = NULL, color_fun = clim.palette(), - plot = TRUE, draw_ticks = TRUE, draw_separators = FALSE, - triangle_ends_scale = 1, extra_labels = NULL, title = NULL, - title_scale = 1, label_scale = 1, tick_scale = 1, - extra_margin = rep(0, 4), label_digits = 4, ...) +ColorBar( + brks = NULL, + cols = NULL, + vertical = TRUE, + subsampleg = NULL, + bar_limits = NULL, + var_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + color_fun = clim.palette(), + plot = TRUE, + draw_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + extra_labels = NULL, + title = NULL, + title_scale = 1, + label_scale = 1, + tick_scale = 1, + extra_margin = rep(0, 4), + label_digits = 4, + ... +) } \arguments{ \item{brks}{Can be provided in two formats: @@ -175,4 +192,3 @@ cols <- c("dodgerblue4", "dodgerblue1", "forestgreen", "yellowgreen", "white", lims <- seq(-1, 1, 0.2) ColorBar(lims, cols) } - diff --git a/man/Composite.Rd b/man/Composite.Rd index 64d5bfc..cc21d38 100644 --- a/man/Composite.Rd +++ b/man/Composite.Rd @@ -4,8 +4,17 @@ \alias{Composite} \title{Compute composites} \usage{ -Composite(data, occ, time_dim = "time", space_dim = c("lon", "lat"), - lag = 0, eno = FALSE, K = NULL, fileout = NULL, ncores = NULL) +Composite( + data, + occ, + time_dim = "time", + space_dim = c("lon", "lat"), + lag = 0, + eno = FALSE, + K = NULL, + fileout = NULL, + ncores = NULL +) } \arguments{ \item{data}{A numeric array containing two spatial and one temporal @@ -101,4 +110,3 @@ occ <- c(1, 1, 2, 2, 3, 3) res <- Composite(data, occ, time_dim = 'case', K = 4) } - diff --git a/man/ConfigApplyMatchingEntries.Rd b/man/ConfigApplyMatchingEntries.Rd index 5f0efb1..ee4cb5a 100644 --- a/man/ConfigApplyMatchingEntries.Rd +++ b/man/ConfigApplyMatchingEntries.Rd @@ -4,8 +4,14 @@ \alias{ConfigApplyMatchingEntries} \title{Apply Matching Entries To Dataset Name And Variable Name To Find Related Info} \usage{ -ConfigApplyMatchingEntries(configuration, var, exp = NULL, obs = NULL, - show_entries = FALSE, show_result = TRUE) +ConfigApplyMatchingEntries( + configuration, + var, + exp = NULL, + obs = NULL, + show_entries = FALSE, + show_result = TRUE +) } \arguments{ \item{configuration}{Configuration object obtained from ConfigFileOpen() @@ -68,4 +74,3 @@ ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigEditDefinition.Rd b/man/ConfigEditDefinition.Rd index 8e1e968..223e95a 100644 --- a/man/ConfigEditDefinition.Rd +++ b/man/ConfigEditDefinition.Rd @@ -57,4 +57,3 @@ match_info <- ConfigApplyMatchingEntries(configuration, 'tas', [ConfigEditEntry()], [ConfigFileOpen()], [ConfigShowSimilarEntries()], [ConfigShowTable()]. } - diff --git a/man/ConfigEditEntry.Rd b/man/ConfigEditEntry.Rd index 9abf3e5..e597709 100644 --- a/man/ConfigEditEntry.Rd +++ b/man/ConfigEditEntry.Rd @@ -1,22 +1,46 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigEditEntry.R \name{ConfigEditEntry} -\alias{ConfigAddEntry} \alias{ConfigEditEntry} +\alias{ConfigAddEntry} \alias{ConfigRemoveEntry} \title{Add, Remove Or Edit Entries In The Configuration} \usage{ -ConfigEditEntry(configuration, dataset_type, position, dataset_name = NULL, - var_name = NULL, main_path = NULL, file_path = NULL, - nc_var_name = NULL, suffix = NULL, varmin = NULL, varmax = NULL) +ConfigEditEntry( + configuration, + dataset_type, + position, + dataset_name = NULL, + var_name = NULL, + main_path = NULL, + file_path = NULL, + nc_var_name = NULL, + suffix = NULL, + varmin = NULL, + varmax = NULL +) -ConfigAddEntry(configuration, dataset_type, position = "last", - dataset_name = ".*", var_name = ".*", main_path = "*", - file_path = "*", nc_var_name = "*", suffix = "*", varmin = "*", - varmax = "*") +ConfigAddEntry( + configuration, + dataset_type, + position = "last", + dataset_name = ".*", + var_name = ".*", + main_path = "*", + file_path = "*", + nc_var_name = "*", + suffix = "*", + varmin = "*", + varmax = "*" +) -ConfigRemoveEntry(configuration, dataset_type, dataset_name = NULL, - var_name = NULL, position = NULL) +ConfigRemoveEntry( + configuration, + dataset_type, + dataset_name = NULL, + var_name = NULL, + position = NULL +) } \arguments{ \item{configuration}{Configuration object obtained via ConfigFileOpen() @@ -99,4 +123,3 @@ ConfigFileSave(configuration, config_file, confirm = FALSE) ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigFileOpen.Rd b/man/ConfigFileOpen.Rd index eee183f..893900b 100644 --- a/man/ConfigFileOpen.Rd +++ b/man/ConfigFileOpen.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigFileOpen.R \name{ConfigFileOpen} -\alias{ConfigFileCreate} \alias{ConfigFileOpen} +\alias{ConfigFileCreate} \alias{ConfigFileSave} \title{Functions To Create Open And Save Configuration File} \usage{ @@ -194,4 +194,3 @@ ConfigFileSave(configuration, config_file, confirm = FALSE) ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigShowSimilarEntries.Rd b/man/ConfigShowSimilarEntries.Rd index b9f80ce..72b77e1 100644 --- a/man/ConfigShowSimilarEntries.Rd +++ b/man/ConfigShowSimilarEntries.Rd @@ -4,10 +4,18 @@ \alias{ConfigShowSimilarEntries} \title{Find Similar Entries In Tables Of Datasets} \usage{ -ConfigShowSimilarEntries(configuration, dataset_name = NULL, - var_name = NULL, main_path = NULL, file_path = NULL, - nc_var_name = NULL, suffix = NULL, varmin = NULL, varmax = NULL, - n_results = 10) +ConfigShowSimilarEntries( + configuration, + dataset_name = NULL, + var_name = NULL, + main_path = NULL, + file_path = NULL, + nc_var_name = NULL, + suffix = NULL, + varmin = NULL, + varmax = NULL, + n_results = 10 +) } \arguments{ \item{configuration}{Configuration object obtained either from @@ -79,4 +87,3 @@ ConfigShowSimilarEntries(configuration, dataset_name = "Exper", ConfigApplyMatchingEntries, ConfigEditDefinition, ConfigEditEntry, ConfigFileOpen, ConfigShowSimilarEntries, ConfigShowTable } - diff --git a/man/ConfigShowTable.Rd b/man/ConfigShowTable.Rd index 7c08053..5e4172a 100644 --- a/man/ConfigShowTable.Rd +++ b/man/ConfigShowTable.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ConfigShowTable.R \name{ConfigShowTable} -\alias{ConfigShowDefinitions} \alias{ConfigShowTable} +\alias{ConfigShowDefinitions} \title{Show Configuration Tables And Definitions} \usage{ ConfigShowTable(configuration, dataset_type, line_numbers = NULL) @@ -54,4 +54,3 @@ ConfigShowDefinitions(configuration) [ConfigEditEntry()], [ConfigFileOpen()], [ConfigShowSimilarEntries()], [ConfigShowTable()]. } - diff --git a/man/Corr.Rd b/man/Corr.Rd index bf5575e..9c20ec1 100644 --- a/man/Corr.Rd +++ b/man/Corr.Rd @@ -4,9 +4,19 @@ \alias{Corr} \title{Compute the correlation coefficient between an array of forecast and their corresponding observation} \usage{ -Corr(exp, obs, time_dim = "sdate", dat_dim = "dataset", comp_dim = NULL, - limits = NULL, method = "pearson", pval = TRUE, conf = TRUE, - conf.lev = 0.95, ncores = NULL) +Corr( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + comp_dim = NULL, + limits = NULL, + method = "pearson", + pval = TRUE, + conf = TRUE, + conf.lev = 0.95, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -86,4 +96,3 @@ corr <- Corr(clim$clim_exp, clim$clim_obs, time_dim = 'ftime', dat_dim = 'member # Renew the example when Ano and Smoothing is ready } - diff --git a/man/Eno.Rd b/man/Eno.Rd index 32468bd..03c3b4f 100644 --- a/man/Eno.Rd +++ b/man/Eno.Rd @@ -39,4 +39,3 @@ data[na] <- NA res <- Eno(data) } - diff --git a/man/GMST.Rd b/man/GMST.Rd index 208ff75..03d1092 100644 --- a/man/GMST.Rd +++ b/man/GMST.Rd @@ -4,10 +4,25 @@ \alias{GMST} \title{Compute the Global Mean Surface Temperature (GMST) anomalies} \usage{ -GMST(data_tas, data_tos, data_lats, data_lons, mask_sea_land, sea_value, type, - mask = NULL, lat_dim = "lat", lon_dim = "lon", monini = 11, - fmonth_dim = "fmonth", sdate_dim = "sdate", indices_for_clim = NULL, - year_dim = "year", month_dim = "month", member_dim = "member") +GMST( + data_tas, + data_tos, + data_lats, + data_lons, + mask_sea_land, + sea_value, + type, + mask = NULL, + lat_dim = "lat", + lon_dim = "lon", + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data_tas}{A numerical array indicating the surface air temperature data @@ -134,4 +149,3 @@ index_dcpp <- GMST(data_tas = dcpp_tas, data_tos = dcpp_tos, data_lats = lat, sea_value = sea_value) } - diff --git a/man/GSAT.Rd b/man/GSAT.Rd index 9d3fbb6..370900d 100644 --- a/man/GSAT.Rd +++ b/man/GSAT.Rd @@ -4,10 +4,22 @@ \alias{GSAT} \title{Compute the Global Surface Air Temperature (GSAT) anomalies} \usage{ -GSAT(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +GSAT( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -101,4 +113,3 @@ lon <- seq(0, 360, 10) index_dcpp <- GSAT(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/InsertDim.Rd b/man/InsertDim.Rd index 8ab628d..c0dd7d8 100644 --- a/man/InsertDim.Rd +++ b/man/InsertDim.Rd @@ -32,4 +32,3 @@ res <- InsertDim(InsertDim(a, posdim = 2, lendim = 1, name = 'e'), 4, c(f = 2)) dim(res) } - diff --git a/man/LeapYear.Rd b/man/LeapYear.Rd index d261b0a..c2960f3 100644 --- a/man/LeapYear.Rd +++ b/man/LeapYear.Rd @@ -21,4 +21,3 @@ print(LeapYear(1991)) print(LeapYear(1992)) print(LeapYear(1993)) } - diff --git a/man/Load.Rd b/man/Load.Rd index 214f984..10c03f9 100644 --- a/man/Load.Rd +++ b/man/Load.Rd @@ -4,15 +4,36 @@ \alias{Load} \title{Loads Experimental And Observational Data} \usage{ -Load(var, exp = NULL, obs = NULL, sdates, nmember = NULL, - nmemberobs = NULL, nleadtime = NULL, leadtimemin = 1, - leadtimemax = NULL, storefreq = "monthly", sampleperiod = 1, - lonmin = 0, lonmax = 360, latmin = -90, latmax = 90, - output = "areave", method = "conservative", grid = NULL, - maskmod = vector("list", 15), maskobs = vector("list", 15), - configfile = NULL, varmin = NULL, varmax = NULL, silent = FALSE, - nprocs = NULL, dimnames = NULL, remapcells = 2, - path_glob_permissive = "partial") +Load( + var, + exp = NULL, + obs = NULL, + sdates, + nmember = NULL, + nmemberobs = NULL, + nleadtime = NULL, + leadtimemin = 1, + leadtimemax = NULL, + storefreq = "monthly", + sampleperiod = 1, + lonmin = 0, + lonmax = 360, + latmin = -90, + latmax = 90, + output = "areave", + method = "conservative", + grid = NULL, + maskmod = vector("list", 15), + maskobs = vector("list", 15), + configfile = NULL, + varmin = NULL, + varmax = NULL, + silent = FALSE, + nprocs = NULL, + dimnames = NULL, + remapcells = 2, + path_glob_permissive = "partial" +) } \arguments{ \item{var}{Short name of the variable to load. It should coincide with the @@ -874,4 +895,3 @@ sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), lonmin = -12, lonmax = 40) } } - diff --git a/man/MeanDims.Rd b/man/MeanDims.Rd index f200023..9c874fc 100644 --- a/man/MeanDims.Rd +++ b/man/MeanDims.Rd @@ -4,7 +4,7 @@ \alias{MeanDims} \title{Average an array along multiple dimensions} \usage{ -MeanDims(data, dims, na.rm = TRUE, ncores = NULL) +MeanDims(data, dims, na.rm = FALSE, ncores = NULL) } \arguments{ \item{data}{An array to be averaged.} @@ -39,4 +39,3 @@ History:\cr 3.0 - 2020-01 (A. Ho, \email{an.ho@bsc.es}) - Preserve dimension names } \keyword{datagen} - diff --git a/man/Persistence.Rd b/man/Persistence.Rd index 33d4868..3582633 100644 --- a/man/Persistence.Rd +++ b/man/Persistence.Rd @@ -4,9 +4,19 @@ \alias{Persistence} \title{Compute persistence} \usage{ -Persistence(data, dates, time_dim = "time", start, end, ft_start, - ft_end = ft_start, max_ft = 10, nmemb = 1, na.action = 10, - ncores = NULL) +Persistence( + data, + dates, + time_dim = "time", + start, + end, + ft_start, + ft_end = ft_start, + max_ft = 10, + nmemb = 1, + na.action = 10, + ncores = NULL +) } \arguments{ \item{data}{A numeric array corresponding to the observational data @@ -98,4 +108,3 @@ persist <- Persistence(obs1, dates = dates, start = 1961, end = 2005, ft_start = nmemb = 40) } - diff --git a/man/PlotAno.Rd b/man/PlotAno.Rd index 18bf0c9..6591ef1 100644 --- a/man/PlotAno.Rd +++ b/man/PlotAno.Rd @@ -4,12 +4,30 @@ \alias{PlotAno} \title{Plot Anomaly time series} \usage{ -PlotAno(exp_ano, obs_ano = NULL, sdates, toptitle = rep("", 15), - ytitle = rep("", 15), limits = NULL, legends = NULL, freq = 12, - biglab = FALSE, fill = TRUE, memb = TRUE, ensmean = TRUE, - linezero = FALSE, points = FALSE, vlines = NULL, sizetit = 1, - fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, - ...) +PlotAno( + exp_ano, + obs_ano = NULL, + sdates, + toptitle = rep("", 15), + ytitle = rep("", 15), + limits = NULL, + legends = NULL, + freq = 12, + biglab = FALSE, + fill = TRUE, + memb = TRUE, + ensmean = TRUE, + linezero = FALSE, + points = FALSE, + vlines = NULL, + sizetit = 1, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{exp_ano}{A numerical array containing the experimental data:\cr @@ -100,4 +118,3 @@ PlotAno(smooth_ano_exp, smooth_ano_obs, startDates, legends = 'ERSST', biglab = FALSE) } - diff --git a/man/PlotClim.Rd b/man/PlotClim.Rd index b62ff44..9b3381e 100644 --- a/man/PlotClim.Rd +++ b/man/PlotClim.Rd @@ -4,11 +4,26 @@ \alias{PlotClim} \title{Plots Climatologies} \usage{ -PlotClim(exp_clim, obs_clim = NULL, toptitle = "", ytitle = "", - monini = 1, freq = 12, limits = NULL, listexp = c("exp1", "exp2", - "exp3"), listobs = c("obs1", "obs2", "obs3"), biglab = FALSE, - leg = TRUE, sizetit = 1, fileout = NULL, width = 8, height = 5, - size_units = "in", res = 100, ...) +PlotClim( + exp_clim, + obs_clim = NULL, + toptitle = "", + ytitle = "", + monini = 1, + freq = 12, + limits = NULL, + listexp = c("exp1", "exp2", "exp3"), + listobs = c("obs1", "obs2", "obs3"), + biglab = FALSE, + leg = TRUE, + sizetit = 1, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{exp_clim}{Matrix containing the experimental data with dimensions:\cr @@ -79,4 +94,3 @@ PlotClim(clim$clim_exp, clim$clim_obs, toptitle = paste('climatologies'), listobs = c('ERSST'), biglab = FALSE, fileout = NULL) } - diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index cf45ead..fbd7042 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -4,25 +4,72 @@ \alias{PlotEquiMap} \title{Maps A Two-Dimensional Variable On A Cylindrical Equidistant Projection} \usage{ -PlotEquiMap(var, lon, lat, varu = NULL, varv = NULL, toptitle = NULL, - sizetit = NULL, units = NULL, brks = NULL, cols = NULL, - bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, - col_sup = NULL, colNA = NULL, color_fun = clim.palette(), - square = TRUE, filled.continents = NULL, coast_color = NULL, - coast_width = 1, contours = NULL, brks2 = NULL, contour_lwd = 0.5, - contour_color = "black", contour_lty = 1, contour_label_scale = 1, - dots = NULL, dot_symbol = 4, dot_size = 1, - arr_subsamp = floor(length(lon)/30), arr_scale = 1, arr_ref_len = 15, - arr_units = "m/s", arr_scale_shaft = 1, arr_scale_shaft_angle = 1, - axelab = TRUE, labW = FALSE, intylat = 20, intxlon = 20, - axes_tick_scale = 1, axes_label_scale = 1, drawleg = TRUE, - subsampleg = NULL, bar_extra_labels = NULL, draw_bar_ticks = TRUE, - draw_separators = FALSE, triangle_ends_scale = 1, bar_label_digits = 4, - bar_label_scale = 1, units_scale = 1, bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), boxlim = NULL, boxcol = "purple2", - boxlwd = 5, margin_scale = rep(1, 4), title_scale = 1, numbfig = NULL, - fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, - ...) +PlotEquiMap( + var, + lon, + lat, + varu = NULL, + varv = NULL, + toptitle = NULL, + sizetit = NULL, + units = NULL, + brks = NULL, + cols = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + colNA = NULL, + color_fun = clim.palette(), + square = TRUE, + filled.continents = NULL, + coast_color = NULL, + coast_width = 1, + contours = NULL, + brks2 = NULL, + contour_lwd = 0.5, + contour_color = "black", + contour_lty = 1, + contour_label_scale = 1, + dots = NULL, + dot_symbol = 4, + dot_size = 1, + arr_subsamp = floor(length(lon)/30), + arr_scale = 1, + arr_ref_len = 15, + arr_units = "m/s", + arr_scale_shaft = 1, + arr_scale_shaft_angle = 1, + axelab = TRUE, + labW = FALSE, + intylat = 20, + intxlon = 20, + axes_tick_scale = 1, + axes_label_scale = 1, + drawleg = TRUE, + subsampleg = NULL, + bar_extra_labels = NULL, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_label_digits = 4, + bar_label_scale = 1, + units_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + boxlim = NULL, + boxcol = "purple2", + boxlwd = 5, + margin_scale = rep(1, 4), + title_scale = 1, + numbfig = NULL, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Array with the values at each cell of a grid on a regular @@ -278,4 +325,3 @@ 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) } - diff --git a/man/PlotLayout.Rd b/man/PlotLayout.Rd index f01fdf9..453cf2e 100644 --- a/man/PlotLayout.Rd +++ b/man/PlotLayout.Rd @@ -4,20 +4,52 @@ \alias{PlotLayout} \title{Arrange and Fill Multi-Pannel Layouts With Optional Colour Bar} \usage{ -PlotLayout(fun, plot_dims, var, ..., special_args = NULL, nrow = NULL, - ncol = NULL, toptitle = NULL, row_titles = NULL, col_titles = NULL, - bar_scale = 1, title_scale = 1, title_margin_scale = 1, - title_left_shift_scale = 1, subtitle_scale = 1, - subtitle_margin_scale = 1, brks = NULL, cols = NULL, drawleg = "S", - titles = NULL, subsampleg = NULL, bar_limits = NULL, - triangle_ends = NULL, col_inf = NULL, col_sup = NULL, - color_fun = clim.colors, draw_bar_ticks = TRUE, draw_separators = FALSE, - triangle_ends_scale = 1, bar_extra_labels = NULL, units = NULL, - units_scale = 1, bar_label_scale = 1, bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), bar_left_shift_scale = 1, - bar_label_digits = 4, extra_margin = rep(0, 4), fileout = NULL, - width = NULL, height = NULL, size_units = "in", res = 100, - close_device = TRUE) +PlotLayout( + fun, + plot_dims, + var, + ..., + special_args = NULL, + nrow = NULL, + ncol = NULL, + toptitle = NULL, + row_titles = NULL, + col_titles = NULL, + bar_scale = 1, + title_scale = 1, + title_margin_scale = 1, + title_left_shift_scale = 1, + subtitle_scale = 1, + subtitle_margin_scale = 1, + brks = NULL, + cols = NULL, + drawleg = "S", + titles = NULL, + subsampleg = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + color_fun = clim.colors, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_extra_labels = NULL, + units = NULL, + units_scale = 1, + bar_label_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + bar_left_shift_scale = 1, + bar_label_digits = 4, + extra_margin = rep(0, 4), + fileout = NULL, + width = NULL, + height = NULL, + size_units = "in", + res = 100, + close_device = TRUE +) } \arguments{ \item{fun}{Plot function (or name of the function) to be called on the @@ -48,6 +80,12 @@ applied to each of them. NAs can be passed to the list: a NA will yield a blank cell in the layout, which can be populated after (see .SwitchToFigure).} +\item{\dots}{Parameters to be sent to the plotting function 'fun'. If +multiple arrays are provided in 'var' and multiple functions are provided +in 'fun', the parameters provided through \dots will be sent to all the +plot functions, as common parameters. To specify concrete arguments for +each of the plot functions see parameter 'special_args'.} + \item{special_args}{List of sub-lists, each sub-list having specific extra arguments for each of the plot functions provided in 'fun'. If you want to fix a different value for each plot in the layout you can do so by @@ -164,12 +202,6 @@ the layout and a 'fileout' has been specified. This is useful to avoid closing the device when saving the layout into a file and willing to add extra elements or figures. Takes TRUE by default. Disregarded if no 'fileout' has been specified.} - -\item{\dots}{Parameters to be sent to the plotting function 'fun'. If -multiple arrays are provided in 'var' and multiple functions are provided -in 'fun', the parameters provided through \dots will be sent to all the -plot functions, as common parameters. To specify concrete arguments for -each of the plot functions see parameter 'special_args'.} } \value{ \item{brks}{ @@ -244,4 +276,3 @@ PlotLayout(PlotEquiMap, c('lat', 'lon'), sampleData$mod[1, , 1, 1, , ], titles = paste('Member', 1:15)) } - diff --git a/man/PlotMatrix.Rd b/man/PlotMatrix.Rd index 24f046d..5275df0 100644 --- a/man/PlotMatrix.Rd +++ b/man/PlotMatrix.Rd @@ -4,12 +4,28 @@ \alias{PlotMatrix} \title{Function to convert any numerical table to a grid of coloured squares.} \usage{ -PlotMatrix(var, brks = NULL, cols = NULL, toptitle = NULL, - title.color = "royalblue4", xtitle = NULL, ytitle = NULL, - xlabels = NULL, xvert = FALSE, ylabels = NULL, line = 3, - figure.width = 1, legend = TRUE, legend.width = 0.15, - xlab_dist = NULL, ylab_dist = NULL, fileout = NULL, size_units = "px", - res = 100, ...) +PlotMatrix( + var, + brks = NULL, + cols = NULL, + toptitle = NULL, + title.color = "royalblue4", + xtitle = NULL, + ytitle = NULL, + xlabels = NULL, + xvert = FALSE, + ylabels = NULL, + line = 3, + figure.width = 1, + legend = TRUE, + legend.width = 0.15, + xlab_dist = NULL, + ylab_dist = NULL, + fileout = NULL, + size_units = "px", + res = 100, + ... +) } \arguments{ \item{var}{A numerical matrix containing the values to be displayed in a @@ -93,4 +109,3 @@ PlotMatrix(var = matrix(rnorm(n = 120, mean = 0.3), 10, 12), xlabels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")) } - diff --git a/man/PlotSection.Rd b/man/PlotSection.Rd index 413ef63..1627339 100644 --- a/man/PlotSection.Rd +++ b/man/PlotSection.Rd @@ -4,10 +4,26 @@ \alias{PlotSection} \title{Plots A Vertical Section} \usage{ -PlotSection(var, horiz, depth, toptitle = "", sizetit = 1, units = "", - brks = NULL, cols = NULL, axelab = TRUE, intydep = 200, - intxhoriz = 20, drawleg = TRUE, fileout = NULL, width = 8, - height = 5, size_units = "in", res = 100, ...) +PlotSection( + var, + horiz, + depth, + toptitle = "", + sizetit = 1, + units = "", + brks = NULL, + cols = NULL, + axelab = TRUE, + intydep = 200, + intxhoriz = 20, + drawleg = TRUE, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Matrix to plot with (longitude/latitude, depth) dimensions.} @@ -69,4 +85,3 @@ sampleData <- s2dv::sampleDepthData PlotSection(sampleData$mod[1, 1, 1, 1, , ], sampleData$lat, sampleData$depth, toptitle = 'temperature 1995-11 member 0') } - diff --git a/man/PlotStereoMap.Rd b/man/PlotStereoMap.Rd index 4b910a9..95c2f71 100644 --- a/man/PlotStereoMap.Rd +++ b/man/PlotStereoMap.Rd @@ -4,19 +4,53 @@ \alias{PlotStereoMap} \title{Maps A Two-Dimensional Variable On A Polar Stereographic Projection} \usage{ -PlotStereoMap(var, lon, lat, latlims = c(60, 90), toptitle = NULL, - sizetit = NULL, units = NULL, brks = NULL, cols = NULL, - bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, - col_sup = NULL, colNA = NULL, color_fun = clim.palette(), - filled.continents = FALSE, coast_color = NULL, coast_width = 1, - dots = NULL, dot_symbol = 4, dot_size = 0.8, intlat = 10, - drawleg = TRUE, subsampleg = NULL, bar_extra_labels = NULL, - draw_bar_ticks = TRUE, draw_separators = FALSE, triangle_ends_scale = 1, - bar_label_digits = 4, bar_label_scale = 1, units_scale = 1, - bar_tick_scale = 1, bar_extra_margin = rep(0, 4), boxlim = NULL, - boxcol = "purple2", boxlwd = 5, margin_scale = rep(1, 4), - title_scale = 1, numbfig = NULL, fileout = NULL, width = 6, - height = 5, size_units = "in", res = 100, ...) +PlotStereoMap( + var, + lon, + lat, + latlims = c(60, 90), + toptitle = NULL, + sizetit = NULL, + units = NULL, + brks = NULL, + cols = NULL, + bar_limits = NULL, + triangle_ends = NULL, + col_inf = NULL, + col_sup = NULL, + colNA = NULL, + color_fun = clim.palette(), + filled.continents = FALSE, + coast_color = NULL, + coast_width = 1, + dots = NULL, + dot_symbol = 4, + dot_size = 0.8, + intlat = 10, + drawleg = TRUE, + subsampleg = NULL, + bar_extra_labels = NULL, + draw_bar_ticks = TRUE, + draw_separators = FALSE, + triangle_ends_scale = 1, + bar_label_digits = 4, + bar_label_scale = 1, + units_scale = 1, + bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), + boxlim = NULL, + boxcol = "purple2", + boxlwd = 5, + margin_scale = rep(1, 4), + title_scale = 1, + numbfig = NULL, + fileout = NULL, + width = 6, + height = 5, + size_units = "in", + res = 100, + ... +) } \arguments{ \item{var}{Array with the values at each cell of a grid on a regular @@ -183,4 +217,3 @@ y <- seq(from = -90, to = 90, length.out = 50) PlotStereoMap(data, x, y, latlims = c(60, 90), brks = 50, toptitle = "This is the title") } - diff --git a/man/RMS.Rd b/man/RMS.Rd index 7bd33b3..4391df4 100644 --- a/man/RMS.Rd +++ b/man/RMS.Rd @@ -4,8 +4,17 @@ \alias{RMS} \title{Compute root mean square error} \usage{ -RMS(exp, obs, time_dim = "sdate", dat_dim = "dataset", comp_dim = NULL, - limits = NULL, conf = TRUE, conf.lev = 0.95, ncores = NULL) +RMS( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + comp_dim = NULL, + limits = NULL, + conf = TRUE, + conf.lev = 0.95, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data, with at least two @@ -79,4 +88,3 @@ The confidence interval is computed by the chi2 distribution.\cr # Renew example when Ano and Smoothing are ready } - diff --git a/man/RMSSS.Rd b/man/RMSSS.Rd index 1b8274f..9ebcf65 100644 --- a/man/RMSSS.Rd +++ b/man/RMSSS.Rd @@ -4,8 +4,14 @@ \alias{RMSSS} \title{Compute root mean square error skill score} \usage{ -RMSSS(exp, obs, time_dim = "sdate", dat_dim = "dataset", pval = TRUE, - ncores = NULL) +RMSSS( + exp, + obs, + time_dim = "sdate", + dat_dim = "dataset", + pval = TRUE, + ncores = NULL +) } \arguments{ \item{exp}{A named numeric array of experimental data which contains at least @@ -66,4 +72,3 @@ obs <- array(rnorm(15), dim = c(time = 3, memb = 5, dataset = 1)) res <- RMSSS(exp, obs, time_dim = 'time') } - diff --git a/man/RandomWalkTest.Rd b/man/RandomWalkTest.Rd index 33b226f..1110648 100644 --- a/man/RandomWalkTest.Rd +++ b/man/RandomWalkTest.Rd @@ -49,4 +49,3 @@ skill_B <- abs(fcst_B - reference) RandomWalkTest(skill_A = skill_A, skill_B = skill_B, time_dim = 'sdate', ncores = 1) } - diff --git a/man/Regression.Rd b/man/Regression.Rd index 4faafc1..8e27295 100644 --- a/man/Regression.Rd +++ b/man/Regression.Rd @@ -4,8 +4,17 @@ \alias{Regression} \title{Compute the regression of an array on another along one dimension.} \usage{ -Regression(datay, datax, reg_dim = "sdate", formula = y ~ x, pval = TRUE, - conf = TRUE, conf.lev = 0.95, na.action = na.omit, ncores = NULL) +Regression( + datay, + datax, + reg_dim = "sdate", + formula = y ~ x, + pval = TRUE, + conf = TRUE, + conf.lev = 0.95, + na.action = na.omit, + ncores = NULL +) } \arguments{ \item{datay}{An numeric array as predictand including the dimension along @@ -92,4 +101,3 @@ res1 <- Regression(datay, datax, formula = y~poly(x, 2, raw = TRUE)) res2 <- Regression(datay, datax, conf.lev = 0.9) } - diff --git a/man/Reorder.Rd b/man/Reorder.Rd index 0afa07e..8748aaf 100644 --- a/man/Reorder.Rd +++ b/man/Reorder.Rd @@ -26,4 +26,3 @@ Reorder the dimension order of a multi-dimensional array dat2 <- array(c(1:10), dim = c(2, 1, 5)) print(dim(Reorder(dat2, c(2, 1, 3)))) } - diff --git a/man/SPOD.Rd b/man/SPOD.Rd index cbbbf1a..5a20a3f 100644 --- a/man/SPOD.Rd +++ b/man/SPOD.Rd @@ -4,10 +4,22 @@ \alias{SPOD} \title{Compute the South Pacific Ocean Dipole (SPOD) index} \usage{ -SPOD(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +SPOD( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -104,4 +116,3 @@ lon <- seq(0, 360, 10) index_dcpp <- SPOD(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/Season.Rd b/man/Season.Rd index cb10dee..3c1e3ff 100644 --- a/man/Season.Rd +++ b/man/Season.Rd @@ -4,8 +4,16 @@ \alias{Season} \title{Compute seasonal mean} \usage{ -Season(data, time_dim = "ftime", monini, moninf, monsup, method = mean, - na.rm = TRUE, ncores = NULL) +Season( + data, + time_dim = "ftime", + monini, + moninf, + monsup, + method = mean, + na.rm = TRUE, + ncores = NULL +) } \arguments{ \item{data}{A named numeric array with at least one dimension 'time_dim'.} @@ -53,4 +61,3 @@ dat2[na] <- NA res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2) res <- Season(data = dat2, monini = 3, moninf = 1, monsup = 2, na.rm = FALSE) } - diff --git a/man/Smoothing.Rd b/man/Smoothing.Rd index ba62ca1..8d4a558 100644 --- a/man/Smoothing.Rd +++ b/man/Smoothing.Rd @@ -43,4 +43,3 @@ PlotAno(smooth_ano_exp, smooth_ano_obs, startDates, fileout = "tos_smoothed_ano.png") } } - diff --git a/man/TPI.Rd b/man/TPI.Rd index 6968f22..fdbc2b8 100644 --- a/man/TPI.Rd +++ b/man/TPI.Rd @@ -4,10 +4,22 @@ \alias{TPI} \title{Compute the Tripole Index (TPI) for the Interdecadal Pacific Oscillation (IPO)} \usage{ -TPI(data, data_lats, data_lons, type, lat_dim = "lat", lon_dim = "lon", - mask = NULL, monini = 11, fmonth_dim = "fmonth", sdate_dim = "sdate", - indices_for_clim = NULL, year_dim = "year", month_dim = "month", - member_dim = "member") +TPI( + data, + data_lats, + data_lons, + type, + lat_dim = "lat", + lon_dim = "lon", + mask = NULL, + monini = 11, + fmonth_dim = "fmonth", + sdate_dim = "sdate", + indices_for_clim = NULL, + year_dim = "year", + month_dim = "month", + member_dim = "member" +) } \arguments{ \item{data}{A numerical array to be used for the index computation with the @@ -103,4 +115,3 @@ lon = seq(0, 360, 10) index_dcpp = TPI(data = dcpp, data_lats = lat, data_lons = lon, type = 'dcpp', monini = 1) } - diff --git a/man/ToyModel.Rd b/man/ToyModel.Rd index 379ed3b..ee7a98e 100644 --- a/man/ToyModel.Rd +++ b/man/ToyModel.Rd @@ -7,8 +7,18 @@ components of a forecast: (1) predictabiltiy (2) forecast error (3) non-stationarity and (4) ensemble generation. The forecast can be computed for real observations or observations generated artifically.} \usage{ -ToyModel(alpha = 0.1, beta = 0.4, gamma = 1, sig = 1, trend = 0, - nstartd = 30, nleadt = 4, nmemb = 10, obsini = NULL, fxerr = NULL) +ToyModel( + alpha = 0.1, + beta = 0.4, + gamma = 1, + sig = 1, + trend = 0, + nstartd = 30, + nleadt = 4, + nmemb = 10, + obsini = NULL, + fxerr = NULL +) } \arguments{ \item{alpha}{Predicabiltiy of the forecast on the observed residuals @@ -120,4 +130,3 @@ toyforecast <- ToyModel(alpha = a, beta = b, gamma = g, nmemb = nm, # } } - diff --git a/man/Trend.Rd b/man/Trend.Rd index a641041..d283ee6 100644 --- a/man/Trend.Rd +++ b/man/Trend.Rd @@ -4,8 +4,16 @@ \alias{Trend} \title{Compute the trend} \usage{ -Trend(data, time_dim = "ftime", interval = 1, polydeg = 1, conf = TRUE, - conf.lev = 0.95, pval = TRUE, ncores = NULL) +Trend( + data, + time_dim = "ftime", + interval = 1, + polydeg = 1, + conf = TRUE, + conf.lev = 0.95, + pval = TRUE, + ncores = NULL +) } \arguments{ \item{data}{An numeric array including the dimension along which the trend @@ -80,4 +88,3 @@ months_between_startdates <- 60 trend <- Trend(sampleData$obs, polydeg = 2, interval = months_between_startdates) } - diff --git a/man/clim.palette.Rd b/man/clim.palette.Rd index d912f47..5d17947 100644 --- a/man/clim.palette.Rd +++ b/man/clim.palette.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/clim.palette.R \name{clim.palette} -\alias{clim.colors} \alias{clim.palette} +\alias{clim.colors} \title{Generate Climate Color Palettes} \usage{ clim.palette(palette = "bluered") @@ -30,4 +30,3 @@ cols <- clim.colors(20) ColorBar(lims, cols) } - diff --git a/man/s2dv-package.Rd b/man/s2dv-package.Rd index cb52214..043b081 100644 --- a/man/s2dv-package.Rd +++ b/man/s2dv-package.Rd @@ -4,20 +4,45 @@ \name{s2dv-package} \alias{s2dv} \alias{s2dv-package} -\title{A Set of Common Tools for Seasonal to Decadal Verification} +\title{s2dv: A Set of Common Tools for Seasonal to Decadal Verification} \description{ -The advanced version of package 's2dverification'. It is -intended for 'seasonal to decadal' (s2d) climate forecast verification, but -it can also be used in other kinds of forecasts or general climate analysis. -This package is specially designed for the comparison between the experimental -and observational datasets. The functionality of the included functions covers -from data retrieval, data post-processing, skill scores against observation, -to visualization. Compared to 's2dverification', 's2dv' is more compatible -with the package 'startR', able to use multiple cores for computation and -handle multi-dimensional arrays with a higher flexibility. +The advanced version of package 's2dverification'. It is + intended for 'seasonal to decadal' (s2d) climate forecast verification, but + it can also be used in other kinds of forecasts or general climate analysis. + This package is specially designed for the comparison between the experimental + and observational datasets. The functionality of the included functions covers + from data retrieval, data post-processing, skill scores against observation, + to visualization. Compared to 's2dverification', 's2dv' is more compatible + with the package 'startR', able to use multiple cores for computation and + handle multi-dimensional arrays with a higher flexibility. } \references{ \url{https://earth.bsc.es/gitlab/es/s2dv/} } -\keyword{internal} +\seealso{ +Useful links: +\itemize{ + \item \url{https://earth.bsc.es/gitlab/es/s2dv/} + \item Report bugs at \url{https://earth.bsc.es/gitlab/es/s2dv/-/issues} +} + +} +\author{ +\strong{Maintainer}: An-Chi Ho \email{an.ho@bsc.es} + +Authors: +\itemize{ + \item BSC-CNS [copyright holder] + \item Nuria Perez-Zanon \email{nuria.perez@bsc.es} +} + +Other contributors: +\itemize{ + \item Roberto Bilbao \email{roberto.bilbao@bsc.es} [contributor] + \item Carlos Delgado \email{carlos.delgado@bsc.es} [contributor] + \item Andrea Manrique \email{andrea.manrique@bsc.es} [contributor] + \item Deborah Verfaillie \email{deborah.verfaillie@bsc.es} [contributor] +} +} +\keyword{internal} diff --git a/man/sampleDepthData.Rd b/man/sampleDepthData.Rd index 869af86..77e4a7a 100644 --- a/man/sampleDepthData.Rd +++ b/man/sampleDepthData.Rd @@ -28,4 +28,3 @@ variable 'tos', i.e. sea surface temperature, from the decadal climate prediction experiment run at IC3 in the context of the CMIP5 project.\cr Its name within IC3 local database is 'i00k'. } - diff --git a/man/sampleMap.Rd b/man/sampleMap.Rd index 651d185..eaf8aa5 100644 --- a/man/sampleMap.Rd +++ b/man/sampleMap.Rd @@ -43,4 +43,3 @@ sampleData <- Load('tos', list(exp), list(obs), startDates, } Check the documentation on 'Load()' in the package 's2dv' for more information. } - diff --git a/man/sampleTimeSeries.Rd b/man/sampleTimeSeries.Rd index 280277e..05a8e79 100644 --- a/man/sampleTimeSeries.Rd +++ b/man/sampleTimeSeries.Rd @@ -47,4 +47,3 @@ sampleData <- Load('tos', list(exp), list(obs), startDates, } Check the documentation on 'Load()' in the package 's2dv' for more information. } - -- GitLab From 81974a40115f4b25e8c893c6e8506c867b7607bf Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 26 Apr 2021 17:22:42 +0200 Subject: [PATCH 092/154] Use 'usr' in par() as the borders. --- R/PlotEquiMap.R | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 37847dc..5b60c30 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -695,8 +695,16 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, par(userArgs) par(mar = margins, cex.main = cex_title, cex.axis = cex_axes_labels, mgp = c(0, spaceticklab, 0), las = 0) - plot.window(xlim = range(lonb$x, finite = TRUE), ylim = range(latb$x, finite = TRUE), - xaxs = 'i', yaxs = 'i') + + #NOTE: Here creates the window for later plot. If 'usr' for par() is not specified, + # use the lat/lon as the borders. If 'usr' is specified, use the assigned values. + if (is.null(userArgs$usr)) { + plot.window(xlim = range(lonb$x, finite = TRUE), ylim = range(latb$x, finite = TRUE), + xaxs = 'i', yaxs = 'i') + } else { + plot.window(xlim = par("usr")[1:2], ylim = par("usr")[3:4], xaxs = 'i', yaxs = 'i') + } + if (axelab) { axis(2, at = ypos, labels = ylabs, cex.axis = cex_axes_labels, tcl = cex_axes_ticks, mgp = c(0, spaceticklab + 0.2, 0)) -- GitLab From 06e8881ab006ea6b3f8d796c3786ce0a4090e89d Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 28 Apr 2021 16:04:28 +0200 Subject: [PATCH 093/154] Transform UltimateBrier.R --- NAMESPACE | 2 + R/UltimateBrier.R | 502 ++++++++++++++-------------- man/UltimateBrier.Rd | 113 +++++++ tests/testthat/test-UltimateBrier.R | 236 +++++++++++++ 4 files changed, 597 insertions(+), 256 deletions(-) create mode 100644 man/UltimateBrier.Rd create mode 100644 tests/testthat/test-UltimateBrier.R diff --git a/NAMESPACE b/NAMESPACE index 0e54899..03c3f84 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -51,10 +51,12 @@ export(Smoothing) export(TPI) export(ToyModel) export(Trend) +export(UltimateBrier) export(clim.colors) export(clim.palette) import(GEOmap) import(NbClust) +import(SpecsVerification) import(bigmemory) import(geomapdata) import(graphics) diff --git a/R/UltimateBrier.R b/R/UltimateBrier.R index f969e2c..af88148 100644 --- a/R/UltimateBrier.R +++ b/R/UltimateBrier.R @@ -1,94 +1,81 @@ #'Compute Brier scores #' #'Interface to compute probabilistic scores (Brier Score, Brier Skill Score) -#'from data obtained from s2dverification. +#'from the forecast and observational data anomalies. It provides six types +#'to choose. #' -#'@param exp Array of forecast anomalies, as provided by \code{Ano()}. -#' Dimensions c(n. of experimental datasets, n. of members, n. of start dates, -#' n. of forecast time steps, n. of latitudes, n. of longitudes). Dimensions -#' in other orders are also supported. See parameters \code{posdatasets}, -#' \code{posmemb} and \code{posdates}. -#'@param obs Array of observational reference anomalies, as provided by -#' \code{Ano()}. Dimensions c(n. of observational reference datasets, -#' n. of members, n. of start dates, n. of forecast time steps, -#' n. of latitudes, n. of longitudes). Dimensions in other orders are also -#' supported. See parameters \code{posdatasets}, \code{posmemb} and -#' \code{posdates}. The memb_dim of 'obs' must be 1. -#'@param posdatasets Expected position of dimension corresponding to the -#' different evaluated datasets in input data (exp and obs). -#' By default 1. -#'@param posmemb Expected position of dimension corresponding to members in -#' input data (exp and obs). By default 2. -#'@param posdates Expected position of dimension corresponding to starting -#' dates in input data (exp and obs). By default 3. -#'@param quantile Flag to stipulate whether a quantile (TRUE) or a threshold -#' (FALSE) is used to estimate the forecast and observed probabilities. -#' Takes TRUE by default. -#'@param thr Values to be used as quantiles if 'quantile' is TRUE or as -#' thresholds if 'quantile' is FALSE. Takes by default \code{c(0.05, 0.95)} -#' if 'quantile' is TRUE. -#'@param type Type of score desired. Can take the following values: +#'@param exp A numeric array of forecast anomalies with named dimensions that +#' at least include 'dat_dim', 'memb_dim', and 'time_dim'. It can be provided +#' by \code{Ano()}. +#'@param obs A numeric array of observational reference anomalies with named +#' dimensions that at least include 'dat_dim' and 'time_dim'. If it has +#' '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'. +#'@param memb_dim A character string indicating the name of the member +#' dimension in 'exp' (and 'obs') for ensemble mean calculation. The default +#' value is 'member'. +#'@param time_dim A character string indicating the dimension along which to +#' compute the probabilistic scores. The default value is 'sdate'. +#'@param quantile A logical value to decide whether a quantile (TRUE) or a +#' threshold (FALSE) is used to estimate the forecast and observed +#' probabilities. The default value is TRUE. +#'@param thr A numeric vector to be used in probability calculation (for 'BS', +#' 'FairStartDatesBS', 'BSS', and 'FairStartDatesBSS') and binary event +#' judgement (for 'FairEnsembleBS' and 'FairEnsembleBSS'). It is as +#' quantiles if 'quantile' is TRUE or as thresholds if 'quantile' is FALSE. +#' The default value is \code{c(0.05, 0.95)} for 'quantile = TRUE'. +#'@param type A character string of the desired score type. It can be the +#' following values: #'\itemize{ -#' \item{'BS': Simple Brier Score.} +#' \item{'BS': Simple Brier Score. Use SpecsVerification::BrierDecomp inside.} #' \item{'FairEnsembleBS': Corrected Brier Score computed across ensemble -#' members.} +#' members. Use SpecsVerification::FairBrier inside.} #' \item{'FairStartDatesBS': Corrected Brier Score computed across starting -#' dates.} -#' \item{'BSS': Simple Brier Skill Score.} +#' dates. Use s2dv:::.BrierScore inside.} +#' \item{'BSS': Simple Brier Skill Score. Use s2dv:::.BrierScore inside.} #' \item{'FairEnsembleBSS': Corrected Brier Skill Score computed across -#' ensemble members.} +#' ensemble members. Use SpecsVerification::FairBrierSs inside.} #' \item{'FairStartDatesBSS': Corrected Brier Skill Score computed across -#' starting dates.} +#' starting dates. Use s2dv:::.BrierScore inside.} #'} -#'@param decomposition Flag to determine whether the decomposition of the -#' Brier Score into its components should be provided (TRUE) or not (FALSE). -#' Takes TRUE by default. The decomposition will be computed only if 'type' -#' is 'BS' or 'FairStartDatesBS'. +#' The default value is 'BS'. +#'@param decomposition A logical value to determine whether the decomposition +#' of the Brier Score should be provided (TRUE) or not (FALSE). It is only +#' used when 'type' is 'BS' or 'FairStartDatesBS'. The default value is TRUE. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' #'@return -#'If 'type' is 'FairEnsembleBS', 'BSS', 'FairEnsemblesBSS' or -#''FairStartDatesBSS' or 'decomposition' is FALSE and 'type' is 'BS' or -#''FairStartDatesBS', the Brier Score or Brier Skill Score will be returned -#'respectively. -#'If 'decomposition' is TRUE and 'type' is 'BS' or 'FairStartDatesBS' the -#'returned value is a named list with the following entries: +#'If 'type' is 'BS' or 'FairStartDatesBS' and 'decomposition' is TRUE, the +#'output is a list of 4 arrays (see details below.) In other cases, the output +#'is an array of Brier scores or Brier score skills. All the arrays have the +#'same dimensions: +#'c(nexp, nobs, no. of bins, the rest dimensions of 'exp' except 'time_dim' and +#''memb_dim'). 'nexp' and 'nobs' is the length of dataset dimension in 'exp' +#'and 'obs' respectively.\cr +#'The list of 4 inlcudes: #' \itemize{ -#' \item{'BS': Brier Score.} -#' \item{'REL': Reliability component.} -#' \item{'UNC': Uncertainty component.} -#' \item{'RES': Resolution component.} +#' \item{$bs: Brier Score} +#' \item{$rel: Reliability component} +#' \item{$res: Resolution component} +#' \item{$unc: Uncertainty component} #' } -#'The dimensions of each of these arrays will be c(n. of experimental datasets, -#'n. of observational reference datasets, n. of bins, the rest of input -#'dimensions except for the ones pointed by 'posmemb' and 'posdates'). -#'@examples -#'# See ?Load for an explanation on the first part of this example. -#' \dontrun{ -#'data_path <- system.file('sample_data', package = 's2dverification') -#'expA <- list(name = 'experiment', path = file.path(data_path, -#' 'model/$EXP_NAME$/$STORE_FREQ$_mean/$VAR_NAME$_3hourly', -#' '$VAR_NAME$_$START_DATE$.nc')) -#'obsX <- list(name = 'observation', path = file.path(data_path, -#' '$OBS_NAME$/$STORE_FREQ$_mean/$VAR_NAME$', -#' '$VAR_NAME$_$YEAR$$MONTH$.nc')) #' -#'# Now we are ready to use Load(). -#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') -#'sampleData <- Load('tos', list(expA), list(obsX), startDates, -#' leadtimemin = 1, leadtimemax = 4, output = 'lonlat', -#' latmin = 27, latmax = 48, lonmin = -12, lonmax = 40) -#' } +#'@examples #' \dontshow{ #'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') -#'sampleData <- s2dverification:::.LoadSampleData('tos', c('experiment'), -#' c('observation'), startDates, -#' leadtimemin = 1, -#' leadtimemax = 4, -#' output = 'lonlat', -#' latmin = 27, latmax = 48, -#' lonmin = -12, lonmax = 40) +#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), +#' c('observation'), startDates, +#' leadtimemin = 1, +#' leadtimemax = 4, +#' output = 'lonlat', +#' latmin = 27, latmax = 48, +#' lonmin = -12, lonmax = 40) #' } -#'sampleData$mod <- Season(sampleData$mod, 4, 11, 12, 2) -#'sampleData$obs <- Season(sampleData$obs, 4, 11, 12, 2) +#'sampleData$mod <- Season(sampleData$mod, monini = 11, moninf = 12, monsup = 2) +#'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) @@ -97,228 +84,231 @@ #' #'@import SpecsVerification plyr multiApply #'@export -UltimateBrier <- function(exp, obs, posdatasets = 1, posmemb = 2, - posdates = 3, quantile = TRUE, - thr = c(5/100, 95/100), type = 'BS', - decomposition = TRUE) { - # Checking exp - if (!is.numeric(exp) || !is.array(exp)) { - stop("Parameter 'exp' must be a numeric array.") +UltimateBrier <- function(exp, obs, dat_dim = 'dataset', memb_dim = 'member', time_dim = 'sdate', + quantile = TRUE, thr = c(5/100, 95/100), type = 'BS', + decomposition = TRUE, ncores = NULL) { + + # Check inputs + ## exp and obs (1) + if (is.null(exp) | is.null(obs)) { + stop("Parameter 'exp' and 'obs' cannot be NULL.") } - if (length(dim(exp)) < 3) { - stop("'exp' must have at least the dimensions c(n. experimental data sets, n. members, n. start dates/forecast time steps/time steps).") + if (!is.numeric(exp) | !is.numeric(obs)) { + stop("Parameter 'exp' and 'obs' must be a vector or a numeric array.") } - - # Checking obs - if (!is.numeric(obs) || !is.array(obs)) { - stop("Parameter 'obs' must be a numeric array.") + 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 (length(dim(obs)) < 3) { - stop("'obs' must have at least the dimensions c(n. observational data sets, n. obs. members, n. start dates/forecast time steps/time steps).") + ## dat_dim + if (!is.character(dat_dim) | length(dat_dim) > 1) { + stop("Parameter 'dat_dim' must be a character string.") } - - # Checking consistency in exp and obs - if (!(length(dim(exp)) == length(dim(obs)))) { - stop("'obs' and 'exp' must have the same number of dimensions.") + if (!dat_dim %in% names(dim(exp))) { + stop("Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension.") } - if (!identical(dim(exp)[c(1:length(dim(exp)))[-c(posdatasets, posmemb)]], - dim(obs)[c(1:length(dim(obs)))[-c(posdatasets, posmemb)]])) { - stop("'obs' and 'exp' must have dimensions of equal size except for the datasets and members dimensions.") + ## memb_dim + if (!is.character(memb_dim) | length(memb_dim) > 1) { + stop("Parameter 'memb_dim' must be a character string.") } - if (dim(obs)[posmemb] != 1) { - stop("Only observations with one member are supported. dim(obs)[posmemb] should be 1") + if (!memb_dim %in% names(dim(exp))) { + stop("Parameter 'memb_dim' is not found in 'exp' dimension.") } - if (any(is.na(exp)) || any(is.na(obs))) { - stop("There can't be NA values in 'exp' and 'obs'") + if (!memb_dim %in% names(dim(obs))) { + # Insert memb_dim into obs for the ease of later calculation + obs <- InsertDim(obs, posdim = 2, lendim = 1, name = memb_dim) + } else if (dim(obs)[memb_dim] != 1) { + stop("The length of parameter 'memb_dim' in 'obs' must be 1.") } - - # Checking posdatasets - if (!is.numeric(posdatasets)) { - stop("Parameter 'posdatasets' must be an integer.") - } else { - posdatasets <- round(posdatasets) - if (posdatasets > length(dim(exp))) { - stop("Parameter 'posdatasets' exceeds the number of dimensions of the provided anomalies.") - } + ## time_dim + if (!is.character(time_dim) | length(time_dim) > 1) { + stop("Parameter 'time_dim' must be a character string.") } - - # Checking posmemb - if (!is.numeric(posmemb)) { - stop("Parameter 'posmemb' must be an integer.") - } else { - posmemb <- round(posmemb) - if (posmemb > length(dim(exp))) { - stop("Parameter 'posmemb' exceeds the number of dimensions of the provided anomalies.") - } + if (!time_dim %in% names(dim(exp))) { + stop("Parameter 'time_dim' is not found in 'exp' or 'obs' dimension.") } - - # Checking posdates - if (!is.numeric(posdates)) { - stop("Parameter 'posdates' must be an integer.") - } else { - posdates <- round(posdates) - if (posdates > length(dim(exp))) { - stop("Parameter 'posdates' exceeds the number of dimensions of the provided anomalies.") - } + ## 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)] + name_obs <- name_obs[-which(name_obs == memb_dim)] + name_exp <- name_exp[-which(name_exp == dat_dim)] + name_obs <- name_obs[-which(name_obs == dat_dim)] + if (any(name_exp != name_obs)) { + stop(paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", + "of all the dimensions expect 'dat_dim' and 'memb_dim'.")) } - - if (posdatasets == posmemb || posdatasets == posdates || posmemb == posdates) { - stop("Parameters 'posdatasets', 'posmemb' and 'posdates' must all point to different dimensions.") + if (!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + stop(paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", + "of all the dimensions expect 'dat_dim' and 'memb_dim'.")) } - - # Checking quantile - if (!is.logical(quantile)) { - stop("Parameter 'quantile' must be either TRUE or FALSE.") + ## quantile + if (!is.logical(quantile) | length(quantile) > 1) { + stop("Parameter 'quantile' must be one logical value.") } - - # Checking thr - if (!is.numeric(thr)) { - stop("Parameter 'thr' must be a numerical vector.") + ## thr + if (!is.numeric(thr) | !is.vector(thr)) { + stop("Parameter 'thr' must be a numeric vector.") } if (quantile) { if (!all(thr <= 1 & thr >= 0)) { - stop("All quantiles specified in parameter 'thr' must fall in the range [0, 1].") + stop("Parameter 'thr' must be within [0, 1] when quantile is TRUE.") } } - - # Checking type - if (!(type %in% c('BS', 'FairEnsembleBS', 'FairStartDatesBS', 'BSS', 'FairEnsembleBSS', 'FairStartDatesBSS'))) { - stop("'type' not supported") + ## type + if (!(type %in% c("BS", "BSS", "FairEnsembleBS", "FairEnsembleBSS", "FairStartDatesBS", "FairStartDatesBSS"))) { + stop("Parameter 'type' must be one of 'BS', 'BSS', 'FairEnsembleBS', 'FairEnsembleBSS', 'FairStartDatesBS' or 'FairStartDatesBSS'.") } - - # Checking decomposition - if (!is.logical(decomposition)) { - stop("Parameter 'decomposition' must be either TRUE or FALSE.") + ## decomposition + if (!is.logical(decomposition) | length(decomposition) > 1) { + stop("Parameter 'decomposition' must be one logical value.") } + ## 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.") + } + } + ############################### + # Calculate UltimateBrier - ## The functions used to compute FEBSS and FEBS have as input anomalies from Ano() - ## dims: c(datasets, members, startdates, leadtimes, latitudes, longitudes) if (type %in% c('FairEnsembleBSS', 'FairEnsembleBS')) { - input_exp <- exp - input_obs <- obs - input_posdatasets <- posdatasets - input_posmemb <- posmemb - input_posdates <- posdates - ## The functions used to compute the other scores receive data from ProbBins() - ## dims: c(bins, startdates, members, datasets, leadtimes, latitudes, longitudes) + res <- Apply(list(exp, obs), + target_dims = list(c(time_dim, dat_dim, memb_dim), + c(time_dim, dat_dim, memb_dim)), + fun = .UltimateBrier, + thr = thr, type = type, + decomposition = decomposition, + ncores = ncores)$output1 + } else { - # Calculate probabilities of data with ProbBins and average over members + # Calculate probablities by ProbBins() and ensemble mean first. + # The first dim will become 'bin' and memb_dim is gone. exp <- MeanDims( - ProbBins(exp, 1:dim(exp)[posdates], thr, quantile, posdates, posmemb), + ProbBins(exp, thr = thr, time_dim = time_dim, memb_dim = memb_dim, + quantile = quantile, ncores = ncores), memb_dim) obs <- MeanDims( - ProbBins(obs, 1:dim(obs)[posdates], thr, quantile, posdates, posmemb), + ProbBins(obs, thr = thr, time_dim = time_dim, memb_dim = memb_dim, + quantile = quantile, ncores = ncores), memb_dim) -#NOTE: The original code below insert memb_dim = 1 back - exp_probs <- array(Mean1Dim(ProbBins(exp, 1:dim(exp)[posdates], thr, quantile, posdates, posmemb), 3), - dim = c(length(thr) + 1, dim(exp)[posdates], 1, dim(exp)[-c(posmemb, posdates)])) - obs_probs <- array(Mean1Dim(ProbBins(obs, 1:dim(obs)[posdates], thr, quantile, posdates, posmemb), 3), - dim = c(length(thr) + 1, dim(obs)[posdates], 1, dim(obs)[-c(posmemb, posdates)])) - input_exp <- exp_probs - input_obs <- obs_probs - input_posdatasets <- 4 - input_posmemb <- 3 - input_posdates <- 2 + res <- Apply(list(exp, obs), + target_dims = list(c(time_dim, dat_dim), + c(time_dim, dat_dim)), + fun = .UltimateBrier, + thr = thr, type = type, + decomposition = decomposition, + ncores = ncores) + + if (type %in% c('BSS', 'FairStartDatesBSS')) { + res <- res$output1 + } else if (!decomposition) { + res <- res$bs + } } - ## Here we define the function 'f' for each type of score (read further for more info). + return(res) +} + +.UltimateBrier <- function(exp, obs, thr = c(5/100, 95/100), type = 'BS', + decomposition = TRUE) { + # If exp and obs are probablistics + # exp: [sdate, nexp] + # obs: [sdate, nobs] + # If exp and obs are anomalies + # exp: [sdate, nexp, memb] + # obs: [sdate, nobs, memb] + + #NOTE: 'thr' is used in 'FairEnsembleBSS' and 'FairEnsembleBS'. But if quantile = F and + # thr is real value, does it work? if (type == 'FairEnsembleBSS') { - size_ens_ref <- prod(dim(obs)[c(posmemb, posdates)]) - f <- function(x) { - ens_ref <- matrix(do.call("[", c(list(x = x), indices_obs)), size_ens_ref, size_ens_ref, byrow = TRUE) - sapply(c(thr, 1), function(tau) { - FairBrierSs(t(do.call("[", c(list(x = x), indices_exp))) > tau, - ens_ref > tau, - do.call("[", c(list(x = x), indices_obs)) > tau)['skillscore'] - }) - } - } else { - if (type == 'FairEnsembleBS') { - f <- function(x) sapply(c(thr, 1), function(tau) mean(FairBrier(t(do.call("[", c(list(x = x), indices_exp))) > tau, do.call("[", c(list(x = x), indices_obs)) > tau), na.rm = TRUE)) - } else { - if (type == 'BS') { - f <- function(x) as.vector(BrierScoreDecomposition(do.call("[", c(list(x = x), indices_exp)), do.call("[", c(list(x = x), indices_obs)))[1, ]) - } else if (type == 'FairStartDatesBS') { - f <- function(x) unlist(BrierScore(do.call("[", c(list(x = x), indices_obs)), do.call("[", c(list(x = x), indices_exp)))[c('rel', 'res', 'unc')], use.names = FALSE) - } else if (type == 'BSS') { - f <- function(x) BrierScore(do.call("[", c(list(x = x), indices_obs)), do.call("[", c(list(x = x), indices_exp)))$bss_res - } else if (type == 'FairStartDatesBSS') { - f <- function(x) BrierScore(do.call("[", c(list(x = x), indices_obs)), do.call("[", c(list(x = x), indices_exp)))$bss_gres + size_ens_ref <- prod(dim(obs)[c(1, 3)]) + res <- array(dim = c(nexp = as.numeric(dim(exp)[2]), + nobs = as.numeric(dim(obs)[2]), + bin = length(thr) + 1)) + for (n_exp in 1:dim(exp)[2]) { + for (n_obs in 1:dim(obs)[2]) { + ens_ref <- matrix(obs[, n_obs, 1], size_ens_ref, size_ens_ref, byrow = TRUE) + for (n_thr in 1:length(c(thr, 1))) { + #NOTE: FairBreirSs is deprecated now. Should change to SkillScore (according to + # SpecsVerification's documentation) + res[n_exp, n_obs, n_thr] <- SpecsVerification::FairBrierSs(exp[, n_exp, ] > c(thr, 1)[n_thr], + ens_ref > c(thr, 1)[n_thr], + obs[, n_obs, 1] > c(thr, 1)[n_thr])['skillscore'] + } } } - } - ## We will calculate score for each exp, obs, bin, leadtime, latitude and longitude - ## So we create array to store results - ## If we calculate a BS we will store its rel, res and unc - if (type %in% c('BS', 'FairStartDatesBS')) { - result <- array(dim = c(dim(exp)[posdatasets], dim(obs)[posdatasets], 3, length(thr) + 1, dim(exp)[-c(posdatasets, posmemb, posdates)])) - } else { - result <- array(dim = c(dim(exp)[posdatasets], dim(obs)[posdatasets], length(thr) + 1, dim(exp)[-c(posdatasets, posmemb, posdates)])) - } - ## In order to be able to use apply, we put data of each exp and obs in a single array, - ## all merged over the members dimension. - indices_exp <- as.list(rep(TRUE, length(dim(input_exp)))) - indices_exp[[input_posmemb]] <- c(1:dim(input_exp)[input_posmemb]) - indices_exp <- indices_exp[c(input_posdatasets, input_posmemb, input_posdates)] - indices_obs <- as.list(rep(TRUE, length(dim(input_obs)))) - indices_obs[[input_posmemb]] <- c(1:dim(input_obs)[input_posmemb]) + dim(input_exp)[input_posmemb] - indices_obs <- indices_obs[c(input_posdatasets, input_posmemb, input_posdates)] - out_indices <- as.list(rep(TRUE, length(dim(result)))) - for (n_obs in 1:dim(obs)[posdatasets]) { - for (n_exp in 1:dim(exp)[posdatasets]) { - data <- abind(take(input_exp, input_posdatasets, n_exp), - take(input_obs, input_posdatasets, n_obs), - along = input_posmemb) - out_indices[c(1, 2)] <- c(n_exp, n_obs) - ## We apply function 'f' to data of each couple of exp and obs, merged in a single array. - ## This data will have dimensions - ## (1, nmembexp + nmembobs, nsdates, nltimes, nlat, nlon) - ## or - ## (nbins, nsdates, nmembexp + nmembobs, 1, nltimes, nlat, nlon) - ## depending on the input type. - ## The function 'f' is applied along all dimensions but (datasets, members and sdates) - ## so the produced output by apply is at least of dimensions - ## (nltimes, nlat, nlon) - ## or - ## (nbins, nltimes, nlat, nlon) - ## depending on the input type (FairEnsembleBS and FairEnsembleBSS - ## will have at lest the first set of dimensions, - ## other scores will have at least the second). - ## So 'f' must have as input an array of dims (1, nmembexp + nmembobs, nsdates). - ## 'indices_exp' and 'indices_obs' will pick for us the input data corresponding to - ## experiments or observations respectively. - ## In order to match with dimensions of 'result', the apply() must have as - ## output an array of dims (nbins, nltimes, nlat, nlon) - ## or (3, nbins, nltimes, nlat, nlon) if calculating BS or FairStartDatesBS. - ## All in all, after looking at apply()'s 'at least' output - ## dimensions and at apply()'s required output dimensions: - ## 'f' must have as output a vector of length nbins for FEBS and FEBSS - ## 'f' must have as output a vector of length 3 (corresponding to rel, res and unc) for BS and FSDBS - ## 'f' must have as output a single numeric element for other scores - result <- do.call("[<-", c(list(x = result), out_indices, list(value = apply(data, c(1:length(dim(data)))[-c(input_posdatasets, input_posmemb, input_posdates)], f)))) + } else if (type == 'FairEnsembleBS') { + #NOTE: The calculation in s2dverification::UltimateBrier is wrong. In the final stage, + # the function calculates like "take(result, 3, 1) - take(result, 3, 2) + take(result, 3, 3)", + # but the 3rd dim of result is 'bins' instead of decomposition. 'FairEnsembleBS' does + # not have decomposition. + # The calculation is fixed here. + res <- array(dim = c(nexp = as.numeric(dim(exp)[2]), + nobs = as.numeric(dim(obs)[2]), + bin = length(thr) + 1)) + for (n_exp in 1:dim(exp)[2]) { + for (n_obs in 1:dim(obs)[2]) { + for (n_thr in 1:length(c(thr, 1))) { + fb <- SpecsVerification::FairBrier(ens = exp[, n_exp, ] > c(thr, 1)[n_thr], + obs = obs[, n_obs, 1] > c(thr, 1)[n_thr]) + res[n_exp, n_obs, n_thr] <- mean(fb, na.rm = T) + } + } } - } +# tmp <- res[, , 1] - res[, , 2] + res[, , 3] +# res <- array(tmp, dim = c(nexp = as.numeric(dim(exp)[2]), nobs = as.numeric(dim(obs)[2]))) - if (type %in% c('BSS', 'FairStartDatesBSS', 'FairEnsembleBSS')) { - result - } else { - if (decomposition && type != 'FairEnsembleBS') { - rel <- take(result, 3, 1) - dim(rel) <- dim(rel)[-3] - res <- take(result, 3, 2) - dim(res) <- dim(res)[-3] - unc <- take(result, 3, 3) - dim(unc) <- dim(unc)[-3] + } else if (type == 'BS') { + comp <- array(dim = c(nexp = as.numeric(dim(exp)[2]), + nobs = as.numeric(dim(obs)[2]), + comp = 3)) + for (n_exp in 1:dim(exp)[2]) { + for (n_obs in 1:dim(obs)[2]) { + #NOTE: Parameter 'bins' is default. + comp[n_exp, n_obs, ] <- SpecsVerification::BrierDecomp(p = exp[, n_exp], + y = obs[, n_obs])[1, ] + } + } + if (decomposition) { + rel <- comp[, , 1] + dim(rel) <- c(nexp = as.numeric(dim(exp)[2]), nobs = as.numeric(dim(obs)[2])) + res <- comp[, , 2] + dim(res) <- c(nexp = as.numeric(dim(exp)[2]), nobs = as.numeric(dim(obs)[2])) + unc <- comp[, , 3] + dim(unc) <- c(nexp = as.numeric(dim(exp)[2]), nobs = as.numeric(dim(obs)[2])) bs <- rel - res + unc - list(BS = bs, REL = rel, UNC = unc, RES = res) + dim(bs) <- c(nexp = as.numeric(dim(exp)[2]), nobs = as.numeric(dim(obs)[2])) + res <- list(bs = bs, rel = rel, res = res, unc = unc) } else { - result <- take(result, 3, 1) - take(result, 3, 2) + take(result, 3, 3) - dim(result) <- dim(result)[-3] - result + bs <- comp[, , 1] - comp[, , 2] + comp[, , 3] + dim(bs) <- c(nexp = as.numeric(dim(exp)[2]), nobs = as.numeric(dim(obs)[2])) + res <- list(bs = bs) } + + } else if (type == 'FairStartDatesBS') { + #NOTE: parameter 'thresholds' is not specified. + res <- .BrierScore(exp = exp, obs = obs) + if (decomposition) { + res <- list(bs = res$bs, rel = res$rel, res = res$res, unc = res$unc) + } else { + res <- list(bs = res$bs) + } + + } else if (type == 'BSS') { + #NOTE: parameter 'thresholds' is not specified. + res <- .BrierScore(exp = exp, obs = obs)$bss_res + + } else if (type == 'FairStartDatesBSS') { + #NOTE: parameter 'thresholds' is not specified. + res <- .BrierScore(exp = exp, obs = obs)$bss_gres } + + return(res) + } diff --git a/man/UltimateBrier.Rd b/man/UltimateBrier.Rd new file mode 100644 index 0000000..2fd2063 --- /dev/null +++ b/man/UltimateBrier.Rd @@ -0,0 +1,113 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/UltimateBrier.R +\name{UltimateBrier} +\alias{UltimateBrier} +\title{Compute Brier scores} +\usage{ +UltimateBrier( + exp, + obs, + dat_dim = "dataset", + memb_dim = "member", + time_dim = "sdate", + quantile = TRUE, + thr = c(5/100, 95/100), + type = "BS", + decomposition = TRUE, + ncores = NULL +) +} +\arguments{ +\item{exp}{A numeric array of forecast anomalies with named dimensions that +at least include 'dat_dim', 'memb_dim', and 'time_dim'. It can be provided +by \code{Ano()}.} + +\item{obs}{A numeric array of observational reference anomalies with named +dimensions that at least include 'dat_dim' and 'time_dim'. If it has +'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()}.} + +\item{dat_dim}{A character string indicating the name of the dataset +dimension in 'exp' and 'obs'. The default value is 'dataset'.} + +\item{memb_dim}{A character string indicating the name of the member +dimension in 'exp' (and 'obs') for ensemble mean calculation. The default +value is 'member'.} + +\item{time_dim}{A character string indicating the dimension along which to +compute the probabilistic scores. The default value is 'sdate'.} + +\item{quantile}{A logical value to decide whether a quantile (TRUE) or a +threshold (FALSE) is used to estimate the forecast and observed +probabilities. The default value is TRUE.} + +\item{thr}{A numeric vector to be used in probability calculation (for 'BS', +'FairStartDatesBS', 'BSS', and 'FairStartDatesBSS') and binary event +judgement (for 'FairEnsembleBS' and 'FairEnsembleBSS'). It is as +quantiles if 'quantile' is TRUE or as thresholds if 'quantile' is FALSE. +The default value is \code{c(0.05, 0.95)} for 'quantile = TRUE'.} + +\item{type}{A character string of the desired score type. It can be the + following values: +\itemize{ + \item{'BS': Simple Brier Score. Use SpecsVerification::BrierDecomp inside.} + \item{'FairEnsembleBS': Corrected Brier Score computed across ensemble + members. Use SpecsVerification::FairBrier inside.} + \item{'FairStartDatesBS': Corrected Brier Score computed across starting + dates. Use s2dv:::.BrierScore inside.} + \item{'BSS': Simple Brier Skill Score. Use s2dv:::.BrierScore inside.} + \item{'FairEnsembleBSS': Corrected Brier Skill Score computed across + ensemble members. Use SpecsVerification::FairBrierSs inside.} + \item{'FairStartDatesBSS': Corrected Brier Skill Score computed across + starting dates. Use s2dv:::.BrierScore inside.} +} + The default value is 'BS'.} + +\item{decomposition}{A logical value to determine whether the decomposition +of the Brier Score should be provided (TRUE) or not (FALSE). It is only +used when 'type' is 'BS' or 'FairStartDatesBS'. The default value is TRUE.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +If 'type' is 'BS' or 'FairStartDatesBS' and 'decomposition' is TRUE, the +output is a list of 4 arrays (see details below.) In other cases, the output +is an array of Brier scores or Brier score skills. All the arrays have the +same dimensions: +c(nexp, nobs, no. of bins, the rest dimensions of 'exp' except 'time_dim' and +'memb_dim'). 'nexp' and 'nobs' is the length of dataset dimension in 'exp' +and 'obs' respectively.\cr +The list of 4 inlcudes: + \itemize{ + \item{$bs: Brier Score} + \item{$rel: Reliability component} + \item{$res: Resolution component} + \item{$unc: Uncertainty component} + } +} +\description{ +Interface to compute probabilistic scores (Brier Score, Brier Skill Score) +from the forecast and observational data anomalies. It provides six types +to choose. +} +\examples{ + \dontshow{ +startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), + c('observation'), startDates, + leadtimemin = 1, + leadtimemax = 4, + output = 'lonlat', + latmin = 27, latmax = 48, + lonmin = -12, lonmax = 40) + } +sampleData$mod <- Season(sampleData$mod, monini = 11, moninf = 12, monsup = 2) +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') + +} diff --git a/tests/testthat/test-UltimateBrier.R b/tests/testthat/test-UltimateBrier.R new file mode 100644 index 0000000..e8114f6 --- /dev/null +++ b/tests/testthat/test-UltimateBrier.R @@ -0,0 +1,236 @@ +context("s2dv::UltimateBrier tests") + +############################################## +# dat1 +set.seed(1) +exp1 <- array(rnorm(30), dim = c(dataset = 1, member = 3, sdate = 5, ftime = 2)) +set.seed(2) +obs1 <- array(round(rnorm(10)), dim = c(dataset = 1, sdate = 5, ftime = 2)) + + +############################################## +test_that("1. Input checks", { + # exp and obs + expect_error( + UltimateBrier(exp1, c()), + "Parameter 'exp' and 'obs' cannot be NULL." + ) + expect_error( + UltimateBrier(c('b'), obs1), + "Parameter 'exp' and 'obs' must be a vector or a numeric array." + ) + expect_error( + UltimateBrier(array(1:10, dim = c(2, 5)), array(1:4, dim = c(2, 2))), + "Parameter 'exp' and 'obs' must have dimension names." + ) + # dat_dim + expect_error( + UltimateBrier(exp1, obs1, dat_dim = 2), + "Parameter 'dat_dim' must be a character string." + ) + expect_error( + UltimateBrier(exp1, obs1, dat_dim = 'dat'), + "Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension." + ) + # memb_dim + expect_error( + UltimateBrier(exp1, obs1, memb_dim = 2), + "Parameter 'memb_dim' must be a character string." + ) + expect_error( + UltimateBrier(exp1, obs1, memb_dim = 'ensemble'), + "Parameter 'memb_dim' is not found in 'exp' dimension." + ) + expect_error( + UltimateBrier(exp1, array(1:10, dim = c(dataset = 1, member = 2, sdate = 5, ftime = 2))), + "The length of parameter 'memb_dim' in 'obs' must be 1." + ) + # time_dim + expect_error( + UltimateBrier(exp1, obs1, time_dim = 1), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + UltimateBrier(exp1, obs1, memb_dim = 'member', time_dim = 'time'), + "Parameter 'time_dim' is not found in 'exp' or 'obs' dimension." + ) + # exp and obs (2) + expect_error( + UltimateBrier(exp1, array(1:10, dim = c(dataset = 1, sdate = 6, ftime = 2))), + paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", + "of all the dimensions expect 'dat_dim' and 'memb_dim'.") + ) + expect_error( + UltimateBrier(exp1, array(1:10, dim = c(dataset = 1, sdate = 5, time = 2))), + paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", + "of all the dimensions expect 'dat_dim' and 'memb_dim'.") + ) + # quantile + expect_error( + UltimateBrier(exp1, obs1, quantile = c(0.05, 0.95)), + "Parameter 'quantile' must be one logical value." + ) + # thr + expect_error( + UltimateBrier(exp1, obs1, thr = TRUE), + "Parameter 'thr' must be a numeric vector." + ) + expect_error( + UltimateBrier(exp1, obs1, quantile = TRUE, thr = 1:3), + "Parameter 'thr' must be within \\[0, 1\\] when quantile is TRUE." + ) + # type + expect_error( + UltimateBrier(exp1, obs1, type = 'UltimateBrier'), + "Parameter 'type' must be one of 'BS', 'BSS', 'FairEnsembleBS', 'FairEnsembleBSS', 'FairStartDatesBS' or 'FairStartDatesBSS'." + ) + # decomposition + expect_error( + UltimateBrier(exp1, obs1, decomposition = 1), + "Parameter 'decomposition' must be one logical value." + ) + # ncores + expect_error( + UltimateBrier(exp1, obs1, ncores = 0), + "Parameter 'ncores' must be a positive integer." + ) + + +}) + +############################################## +test_that("2. Output checks: dat1", { + +# 'BS' +expect_equal( +is.list(UltimateBrier(exp1, obs1)), +TRUE +) +expect_equal( +names(UltimateBrier(exp1, obs1)), +c('bs', 'rel', 'res', 'unc') +) +expect_equal( +is.list(UltimateBrier(exp1, obs1, decomposition = FALSE)), +FALSE +) +expect_equal( +dim(UltimateBrier(exp1, obs1, decomposition = FALSE)), +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))), +c(nexp = 1, nobs = 1, bin = 4, ftime = 2) +) +expect_equal( +UltimateBrier(exp1, obs1)$bs, +UltimateBrier(exp1, obs1, decomposition = FALSE) +) +expect_equal( +as.vector(UltimateBrier(exp1, obs1)$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), +c(0.22222222, 0.31111111, 0.02222222, 0.28888889, 0.24444444, 0.02222222), +tolerance = 0.0001 +) +expect_equal( +as.vector(UltimateBrier(exp1, obs1)$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), +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')), +c(nexp = 1, nobs = 1, bin = 3, ftime = 2) +) +expect_equal( +as.vector(UltimateBrier(exp1, obs1, type = 'BSS')), +c(-0.7592593, -0.8518519, -Inf, -1.0370370, -0.5740741, -Inf), +tolerance = 0.0001 +) + +# 'FairStartDatesBS' +expect_equal( +is.list(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS')), +TRUE +) +expect_equal( +names(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS')), +c('bs', 'rel', 'res', 'unc') +) +expect_equal( +is.list(UltimateBrier(exp1, obs1, decomposition = FALSE, type = 'FairStartDatesBS')), +FALSE +) +expect_equal( +dim(UltimateBrier(exp1, obs1, decomposition = FALSE, type = 'FairStartDatesBS')), +c(nexp = 1, nobs = 1, bin = 3, ftime = 2) +) +expect_equal( +UltimateBrier(exp1, obs1, type = 'FairStartDatesBS')$bs, +UltimateBrier(exp1, obs1, decomposition = FALSE, type = 'FairStartDatesBS') +) +expect_equal( +as.vector(UltimateBrier(exp1, obs1, type = 'FairStartDatesBS')$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), +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), +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), +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')), +c(nexp = 1, nobs = 1, bin = 3, ftime = 2) +) +expect_equal( +as.vector(UltimateBrier(exp1, obs1, type = 'FairStartDatesBSS')), +c(-0.7592593, -0.8518519, -Inf, -1.0370370, -0.5740741, -Inf), +tolerance = 0.0001 +) +# 'FairEnsembleBS' +expect_equal( +dim(UltimateBrier(exp1, obs1, type = 'FairEnsembleBS')), +c(nexp = 1, nobs = 1, bin = 3, ftime = 2) +) +expect_equal( +as.vector(UltimateBrier(exp1, obs1, type = 'FairEnsembleBS')), +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')), +c(nexp = 1, nobs = 1, bin = 3, ftime = 2) +) +expect_equal( +as.vector(UltimateBrier(exp1, obs1, type = 'FairEnsembleBSS')), +c(-0.1111111, -0.6666667, -0.6666667, 0.2592593, -1.2222222, -0.6666667), +tolerance = 0.0001 +) + +}) + + -- GitLab From ab55d9ebcd5677bc4309a0533f4320011de64c22 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 28 Apr 2021 16:06:01 +0200 Subject: [PATCH 094/154] Typo fix --- R/UltimateBrier.R | 2 +- man/UltimateBrier.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/UltimateBrier.R b/R/UltimateBrier.R index af88148..c9fee49 100644 --- a/R/UltimateBrier.R +++ b/R/UltimateBrier.R @@ -50,7 +50,7 @@ #'@return #'If 'type' is 'BS' or 'FairStartDatesBS' and 'decomposition' is TRUE, the #'output is a list of 4 arrays (see details below.) In other cases, the output -#'is an array of Brier scores or Brier score skills. All the arrays have the +#'is an array of Brier scores or Brier skill scores. All the arrays have the #'same dimensions: #'c(nexp, nobs, no. of bins, the rest dimensions of 'exp' except 'time_dim' and #''memb_dim'). 'nexp' and 'nobs' is the length of dataset dimension in 'exp' diff --git a/man/UltimateBrier.Rd b/man/UltimateBrier.Rd index 2fd2063..714dc74 100644 --- a/man/UltimateBrier.Rd +++ b/man/UltimateBrier.Rd @@ -73,7 +73,7 @@ computation. The default value is NULL.} \value{ If 'type' is 'BS' or 'FairStartDatesBS' and 'decomposition' is TRUE, the output is a list of 4 arrays (see details below.) In other cases, the output -is an array of Brier scores or Brier score skills. All the arrays have the +is an array of Brier scores or Brier skill scores. All the arrays have the same dimensions: c(nexp, nobs, no. of bins, the rest dimensions of 'exp' except 'time_dim' and 'memb_dim'). 'nexp' and 'nobs' is the length of dataset dimension in 'exp' -- GitLab From 1798e7bb1cacf8f8822e0cfd5d3339f03a7592e1 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 28 Apr 2021 16:42:15 +0200 Subject: [PATCH 095/154] Allow 'obs' to have 'member' dim in BrierScore. --- R/BrierScore.R | 60 +++++++++++++++++++------------- R/UltimateBrier.R | 4 +-- man/BrierScore.Rd | 8 ++--- tests/testthat/test-BrierScore.R | 7 +++- 4 files changed, 48 insertions(+), 31 deletions(-) diff --git a/R/BrierScore.R b/R/BrierScore.R index d79f62d..b49e0b6 100644 --- a/R/BrierScore.R +++ b/R/BrierScore.R @@ -11,8 +11,8 @@ #' range [0, 1]. #'@param obs A numeric array with named dimensions of the binary observations #' (0 or 1). The dimension must at least have 'time_dim' and other dimensions -#' of 'exp' except 'memb_dim'. The length of 'dat_dim' can be different from -#' 'exp'. +#' of 'exp' except 'memb_dim' (optional). The length of 'dat_dim' can be +#' different from 'exp', and the length of 'memb_dim' must be 1 if it has. #'@param thresholds A numeric vector used to bin the forecasts. The default #' value is \code{seq(0, 1, 0.1)}, which means that the bins are #' \code{[0, 0.1), [0.1, 0.2), ... [0.9, 1]}. @@ -21,8 +21,8 @@ #'@param dat_dim A character string indicating the name of dataset dimension in #' 'exp' and 'obs'. The length of this dimension can be different between #' 'exp' and 'obs'. The default value is NULL. -#'@param memb_dim A character string of the name of the member dimension. It -#' must be one dimension of 'exp'. The function will do the ensemble mean +#'@param memb_dim A character string of the name of the member dimension in +#' 'exp' (and 'obs', optional). The function will do the ensemble mean #' over this dimension. If there is no member dimension, set NULL. The default #' value is NULL. #'@param ncores An integer indicating the number of cores to use for parallel @@ -92,7 +92,7 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' dat_dim = NULL, memb_dim = NULL, ncores = NULL) { # Check inputs - ## exp and obs + ## exp and obs (1) if (is.null(exp) | is.null(obs)) { stop("Parameter 'exp' and 'obs' cannot be NULL.") } @@ -117,23 +117,6 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' if (any(!obs %in% c(0, 1))) { stop("Parameter 'obs' must be binary events (0 or 1).") } - 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 (any(name_exp != name_obs)) { - stop(paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", - "of all the dimensions expect 'exp' may have 'memb_dim'.")) - } - if (!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { - stop(paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", - "of all the dimensions expect 'exp' may have 'memb_dim'.")) - } ## thresholds if (!is.numeric(thresholds) | !is.vector(thresholds)) { stop("Parameter 'thresholds' must be a numeric vector.") @@ -142,7 +125,7 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' 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))) { + if (!time_dim %in% names(dim(exp)) | !time_dim %in% names(dim(obs))) { stop("Parameter 'time_dim' is not found in 'exp' and 'obs' dimension.") } ## dat_dim @@ -150,7 +133,7 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' if (!is.character(dat_dim) | length(dat_dim) > 1) { stop("Parameter 'dat_dim' must be a character string.") } - if (!dat_dim %in% names(dim(exp))) { + if (!dat_dim %in% names(dim(exp)) | !dat_dim %in% names(dim(obs))) { stop("Parameter 'dat_dim' is not found in 'exp' and 'obs' dimension.") } } @@ -162,6 +145,32 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' 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 (dim(obs)[memb_dim] != 1) { + stop("The length of parameter 'memb_dim' in 'obs' must be 1.") + } + } + } + ## 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 (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 (any(name_exp != name_obs)) { + stop(paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", + "of all the dimensions expect 'dat_dim' and 'memb_dim'.")) + } + if (!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + stop(paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", + "of all the dimensions expect 'dat_dim' and 'memb_dim'.")) } ## ncores if (!is.null(ncores)) { @@ -177,6 +186,9 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' ## ensemble mean if (!is.null(memb_dim)) { exp <- MeanDims(exp, memb_dim) + if (memb_dim %in% names(dim(obs))) { + obs <- MeanDims(obs, memb_dim) + } } if (is.null(dat_dim)) { diff --git a/R/UltimateBrier.R b/R/UltimateBrier.R index c9fee49..60e8b80 100644 --- a/R/UltimateBrier.R +++ b/R/UltimateBrier.R @@ -104,7 +104,7 @@ UltimateBrier <- function(exp, obs, dat_dim = 'dataset', memb_dim = 'member', ti if (!is.character(dat_dim) | length(dat_dim) > 1) { stop("Parameter 'dat_dim' must be a character string.") } - if (!dat_dim %in% names(dim(exp))) { + 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.") } ## memb_dim @@ -124,7 +124,7 @@ UltimateBrier <- function(exp, obs, dat_dim = 'dataset', memb_dim = 'member', ti 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))) { + 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.") } ## exp and obs (2) diff --git a/man/BrierScore.Rd b/man/BrierScore.Rd index b54d11b..7466ac0 100644 --- a/man/BrierScore.Rd +++ b/man/BrierScore.Rd @@ -22,8 +22,8 @@ range [0, 1].} \item{obs}{A numeric array with named dimensions of the binary observations (0 or 1). The dimension must at least have 'time_dim' and other dimensions -of 'exp' except 'memb_dim'. The length of 'dat_dim' can be different from -'exp'.} +of 'exp' except 'memb_dim' (optional). The length of 'dat_dim' can be +different from 'exp', and the length of 'memb_dim' must be 1 if it has.} \item{thresholds}{A numeric vector used to bin the forecasts. The default value is \code{seq(0, 1, 0.1)}, which means that the bins are @@ -36,8 +36,8 @@ which Brier score is computed. The default value is 'sdate'.} 'exp' and 'obs'. The length of this dimension can be different between 'exp' and 'obs'. The default value is NULL.} -\item{memb_dim}{A character string of the name of the member dimension. It -must be one dimension of 'exp'. The function will do the ensemble mean +\item{memb_dim}{A character string of the name of the member dimension in +'exp' (and 'obs', optional). The function will do the ensemble mean over this dimension. If there is no member dimension, set NULL. The default value is NULL.} diff --git a/tests/testthat/test-BrierScore.R b/tests/testthat/test-BrierScore.R index 5acfa55..f1ff1e4 100644 --- a/tests/testthat/test-BrierScore.R +++ b/tests/testthat/test-BrierScore.R @@ -40,7 +40,7 @@ test_that("1. Input checks", { expect_error( BrierScore(exp1, obs1), paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", - "of all the dimensions expect 'exp' may have 'memb_dim'.") + "of all the dimensions expect 'dat_dim' and 'memb_dim'.") ) # thresholds expect_error( @@ -75,6 +75,11 @@ test_that("1. Input checks", { "Parameter 'memb_dim' is not found in 'exp' dimension." ) expect_error( + BrierScore(exp1, array(1, dim = c(dataset = 1, member = 3, sdate = 5, ftime = 2)), memb_dim = 'member'), + "The length of parameter 'memb_dim' in 'obs' must be 1." + ) + # ncores + expect_error( BrierScore(exp2, obs2, ncores = 0), "Parameter 'ncores' must be a positive integer." ) -- GitLab From 444451d074faca69f5971e6d90d03e11f9cdba82 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 28 Apr 2021 16:59:12 +0200 Subject: [PATCH 096/154] Add SpecsVerification in dependency --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index f8f5567..8fffd60 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,7 +36,8 @@ Imports: plyr, ncdf4, NbClust, - multiApply (>= 2.1.1) + multiApply (>= 2.1.1), + SpecsVerification (>= 0.5.0) Suggests: easyVerification, testthat -- GitLab From 24e901ca068e95527248456b5d9d96860fc2d6e6 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 28 Apr 2021 17:17:53 +0200 Subject: [PATCH 097/154] Fix 'thr' when quantile = F --- R/ProbBins.R | 14 ++++++++++---- man/ProbBins.Rd | 5 +++-- tests/testthat/test-ProbBins.R | 15 ++++++++++++++- 3 files changed, 27 insertions(+), 7 deletions(-) diff --git a/R/ProbBins.R b/R/ProbBins.R index 0bb8876..c76ad43 100644 --- a/R/ProbBins.R +++ b/R/ProbBins.R @@ -7,8 +7,9 @@ #' #'@param data An numeric array of anomalies with the dimensions 'time_dim' and #' 'memb_dim' at least. It can be generated by \code{Ano()}. -#'@param thr A numeric vector within range [0, 1] used as the thresholds to bin -#' the anomalies. +#'@param thr A numeric vector used as the quantiles (if 'quantile' is TRUE) or +#' thresholds (if 'quantile' is FALSE) to bin the anomalies. If it is quantile, +#' it must be within [0, 1]. #'@param fcyr A numeric vector of the indices of the forecast years (i.e., #' time_dim) to compute the probabilistic bins for, or 'all' to compute the #' bins for all the years. E.g., c(1:5), c(1, 4), 4, or 'all'. The default @@ -74,10 +75,15 @@ ProbBins <- function(data, thr, fcyr = 'all', time_dim = 'sdate', memb_dim = 'me stop("Parameter 'data' must have dimension names.") } ## thr + if (is.null(thr)) { + stop("Parameter 'thr' cannot be NULL.") + } if (!is.numeric(thr) | !is.vector(thr)) { stop("Parameter 'thr' must be a numeric vector.") - } else if (max(thr) > 1 | min(thr) < 0) { - stop("Parameter 'thr' must be within the range [0, 1].") + } else if (quantile) { + if (!all(thr <= 1 & thr >= 0)) { + stop("Parameter 'thr' must be within the range [0, 1] if 'quantile' is TRUE.") + } } ## time_dim if (!is.character(time_dim) | length(time_dim) > 1) { diff --git a/man/ProbBins.Rd b/man/ProbBins.Rd index 9e46690..26b88b8 100644 --- a/man/ProbBins.Rd +++ b/man/ProbBins.Rd @@ -19,8 +19,9 @@ ProbBins( \item{data}{An numeric array of anomalies with the dimensions 'time_dim' and 'memb_dim' at least. It can be generated by \code{Ano()}.} -\item{thr}{A numeric vector within range [0, 1] used as the thresholds to bin -the anomalies.} +\item{thr}{A numeric vector used as the quantiles (if 'quantile' is TRUE) or +thresholds (if 'quantile' is FALSE) to bin the anomalies. If it is quantile, +it must be within [0, 1].} \item{fcyr}{A numeric vector of the indices of the forecast years (i.e., time_dim) to compute the probabilistic bins for, or 'all' to compute the diff --git a/tests/testthat/test-ProbBins.R b/tests/testthat/test-ProbBins.R index 83e4f3b..4b3d0ec 100644 --- a/tests/testthat/test-ProbBins.R +++ b/tests/testthat/test-ProbBins.R @@ -21,13 +21,17 @@ test_that("1. Input checks", { "Parameter 'data' must have dimension names." ) # thr + expect_error( + ProbBins(dat1, thr = c()), + "Parameter 'thr' cannot be NULL." + ) expect_error( ProbBins(dat1, thr = TRUE), "Parameter 'thr' must be a numeric vector." ) expect_error( ProbBins(dat1, thr = 1:10), - "Parameter 'thr' must be within the range \\[0, 1\\]." + "Parameter 'thr' must be within the range \\[0, 1\\] if 'quantile' is TRUE." ) # time_dim expect_error( @@ -155,5 +159,14 @@ expect_equal( which(ProbBins(dat1, thr = c(1/3, 2/3), quantile = FALSE) == 1), c(1, 6, 8, 10, 13, 16, 21, 24, 25, 28, 32, 35, 37, 40, 45, 48, 49, 52, 56, 58, 63, 66, 69, 70) ) +expect_equal( +length(which(ProbBins(dat1, thr = c(1:3), quantile = FALSE) == 0)), +72 +) +expect_equal( +length(which(ProbBins(dat1, thr = c(1:3), quantile = FALSE) == 1)), +24 +) + }) -- GitLab From eb325ec1a76e5ba3230a1cf952afb817550676f9 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 28 Apr 2021 17:32:25 +0200 Subject: [PATCH 098/154] Fix documentation --- R/Ano_CrossValid.R | 2 +- man/Ano_CrossValid.Rd | 3 ++- tests/testthat/test-Ano_CrossValid.R | 2 +- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/R/Ano_CrossValid.R b/R/Ano_CrossValid.R index f625ccc..22e710a 100644 --- a/R/Ano_CrossValid.R +++ b/R/Ano_CrossValid.R @@ -25,7 +25,7 @@ #' in 'dat_dim'. The default value is 'member'. #'@param memb A logical value indicating whether to subtract the climatology #' based on the individual members (TRUE) or the ensemble mean over all -# members (FALSE) when calculating the anomalies. The default value is TRUE. +#' members (FALSE) when calculating the anomalies. The default value is TRUE. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' diff --git a/man/Ano_CrossValid.Rd b/man/Ano_CrossValid.Rd index 3fe1e60..1e91528 100644 --- a/man/Ano_CrossValid.Rd +++ b/man/Ano_CrossValid.Rd @@ -35,7 +35,8 @@ dimension. Only used when parameter 'memb' is FALSE. It must be one element in 'dat_dim'. The default value is 'member'.} \item{memb}{A logical value indicating whether to subtract the climatology -based on the individual members (TRUE) or the ensemble mean over all} +based on the individual members (TRUE) or the ensemble mean over all +members (FALSE) when calculating the anomalies. The default value is TRUE.} \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-Ano_CrossValid.R b/tests/testthat/test-Ano_CrossValid.R index 52dcf73..60bff8c 100644 --- a/tests/testthat/test-Ano_CrossValid.R +++ b/tests/testthat/test-Ano_CrossValid.R @@ -1,4 +1,4 @@ -context("s2dv::EOF tests") +context("s2dv::Ano_CrossValid tests") ############################################## # dat1 -- GitLab From 635ea2042e7b265a2301ddbfe5ce54b0ffad209c Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 29 Apr 2021 14:48:17 +0200 Subject: [PATCH 099/154] Add output 'tot_var' in EOF --- R/EOF.R | 27 ++++++++++++++++----------- man/EOF.Rd | 24 ++++++++++++++---------- tests/testthat/test-EOF.R | 14 ++++++++++++-- 3 files changed, 42 insertions(+), 23 deletions(-) diff --git a/R/EOF.R b/R/EOF.R index f37fa8f..d573739 100644 --- a/R/EOF.R +++ b/R/EOF.R @@ -25,27 +25,27 @@ #'A list containing: #'\item{EOFs}{ #' An array of EOF patterns normalized to 1 (unitless) with dimensions -#' (number of modes, rest of the dimensions of ano except 'time_dim'). +#' (number of modes, rest of the dimensions of 'ano' except 'time_dim'). #' Multiplying \code{EOFs} by \code{PCs} gives the original reconstructed #' field. #'} #'\item{PCs}{ #' An array of principal components with the units of the original field to #' the power of 2, with dimensions (time_dim, number of modes, rest of the -#' dimensions except 'space_dim'). -#' \code{PCs} contains already the percentage of explained variance so, -#' to reconstruct the original field it's only needed to multiply \code{EOFs} -#' by \code{PCs}. +#' dimensions of 'ano' except 'space_dim'). +#' 'PCs' contains already the percentage of explained variance so, +#' to reconstruct the original field it's only needed to multiply 'EOFs' +#' by 'PCs'. #'} #'\item{var}{ #' An array of the percentage (%) of variance fraction of total variance #' explained by each mode (number of modes). The dimensions are (number of -#' modes, rest of the dimension except 'time_dim' and 'space_dim'). +#' modes, rest of the dimensions of 'ano' except 'time_dim' and 'space_dim'). #'} #'\item{mask}{ -#' An array of the mask with dimensions (space_dim, rest of the dimension -#' except 'time_dim'). It is made from 'ano', 1 for the positions that 'ano' -#' has value and NA for the positions that 'ano' has NA. It is used to +#' An array of the mask with dimensions (space_dim, rest of the dimensions of +#' 'ano' except 'time_dim'). It is made from 'ano', 1 for the positions that +#' 'ano' has value and NA for the positions that 'ano' has NA. It is used to #' replace NAs with 0s for EOF calculation and mask the result with NAs again #' after the calculation. #'} @@ -54,6 +54,10 @@ #' by cosine of 'lat' and used to compute the fraction of variance explained by #' each EOFs. #'} +#'\item{tot_var}{ +#' A number or a numeric array of the total variance explained by all the modes. +#' The dimensions are same as 'ano' except 'time_dim' and 'space_dim'. +#'} #' #'@seealso ProjectField, NAO, PlotBoxWhisker #'@examples @@ -73,7 +77,7 @@ #'} #'ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) #'tmp <- MeanDims(ano$exp, c('dataset', 'member')) -#'ano <- tmp[, 1, ,] +#'ano <- tmp[1, , ,] #'names(dim(ano)) <- names(dim(tmp))[-2] #'eof <- EOF(ano, sampleData$lat, sampleData$lon) #'\dontrun{ @@ -163,6 +167,7 @@ EOF <- function(ano, lat, lon, time_dim = 'sdate', space_dim = c('lat', 'lon'), output_dims = list(EOFs = c('mode', space_dim), PCs = c(time_dim, 'mode'), var = 'mode', + tot_var = NULL, mask = space_dim), fun = .EOF, corr = corr, neofs = neofs, @@ -274,5 +279,5 @@ EOF <- function(ano, lat, lon, time_dim = 'sdate', space_dim = c('lat', 'lon'), var.eof <- as.array(var.eof) } - return(list(EOFs = EOF, PCs = PC, var = var.eof, mask = mask)) + return(invisible(list(EOFs = EOF, PCs = PC, var = var.eof, tot_var = tot.var, mask = mask))) } diff --git a/man/EOF.Rd b/man/EOF.Rd index b460cd5..a7d51a7 100644 --- a/man/EOF.Rd +++ b/man/EOF.Rd @@ -44,27 +44,27 @@ computation. The default value is NULL.} A list containing: \item{EOFs}{ An array of EOF patterns normalized to 1 (unitless) with dimensions - (number of modes, rest of the dimensions of ano except 'time_dim'). + (number of modes, rest of the dimensions of 'ano' except 'time_dim'). Multiplying \code{EOFs} by \code{PCs} gives the original reconstructed field. } \item{PCs}{ An array of principal components with the units of the original field to the power of 2, with dimensions (time_dim, number of modes, rest of the - dimensions except 'space_dim'). - \code{PCs} contains already the percentage of explained variance so, - to reconstruct the original field it's only needed to multiply \code{EOFs} - by \code{PCs}. + dimensions of 'ano' except 'space_dim'). + 'PCs' contains already the percentage of explained variance so, + to reconstruct the original field it's only needed to multiply 'EOFs' + by 'PCs'. } \item{var}{ An array of the percentage (%) of variance fraction of total variance explained by each mode (number of modes). The dimensions are (number of - modes, rest of the dimension except 'time_dim' and 'space_dim'). + modes, rest of the dimensions of 'ano' except 'time_dim' and 'space_dim'). } \item{mask}{ - An array of the mask with dimensions (space_dim, rest of the dimension - except 'time_dim'). It is made from 'ano', 1 for the positions that 'ano' - has value and NA for the positions that 'ano' has NA. It is used to + An array of the mask with dimensions (space_dim, rest of the dimensions of + 'ano' except 'time_dim'). It is made from 'ano', 1 for the positions that + 'ano' has value and NA for the positions that 'ano' has NA. It is used to replace NAs with 0s for EOF calculation and mask the result with NAs again after the calculation. } @@ -73,6 +73,10 @@ A list containing: by cosine of 'lat' and used to compute the fraction of variance explained by each EOFs. } +\item{tot_var}{ + A number or a numeric array of the total variance explained by all the modes. + The dimensions are same as 'ano' except 'time_dim' and 'space_dim'. +} } \description{ Perform an area-weighted EOF analysis using SVD based on a covariance matrix @@ -96,7 +100,7 @@ sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), } ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) tmp <- MeanDims(ano$exp, c('dataset', 'member')) -ano <- tmp[, 1, ,] +ano <- tmp[1, , ,] names(dim(ano)) <- names(dim(tmp))[-2] eof <- EOF(ano, sampleData$lat, sampleData$lon) \dontrun{ diff --git a/tests/testthat/test-EOF.R b/tests/testthat/test-EOF.R index e15a971..c8c6d30 100644 --- a/tests/testthat/test-EOF.R +++ b/tests/testthat/test-EOF.R @@ -99,7 +99,7 @@ test_that("2. dat1", { expect_equal( names(EOF(dat1, lon = lon1, lat = lat1)), - c("EOFs", "PCs", "var", "mask", "wght") + c("EOFs", "PCs", "var", "tot_var", "mask", "wght") ) expect_equal( dim(EOF(dat1, lon = lon1, lat = lat1)$EOFs), @@ -143,7 +143,7 @@ test_that("2. dat1", { ) expect_equal( EOF(dat1, lon = lon1, lat = lat1)$var[1:5], - array(c(29.247073, 25.364840, 13.247046, 11.121006, 8.662517)), + array(c(29.247073, 25.364840, 13.247046, 11.121006, 8.662517), dim = c(mode = 5)), tolerance = 0.0001 ) expect_equal( @@ -155,6 +155,11 @@ test_that("2. dat1", { c(0.9923748, 0.9850359, 0.9752213, 0.9629039, 0.9480475), tolerance = 0.0001 ) + expect_equal( + EOF(dat1, lon = lon1, lat = lat1)$tot_var, + 88.20996, + tolerance = 0.0001 + ) }) ############################################## @@ -212,6 +217,11 @@ test_that("4. dat3", { c(0.3292733, 0.1787016, -0.3801986, 0.1957160, -0.4377031), tolerance = 0.0001 ) + expect_equal( + EOF(dat3, lon = lon3, lat = lat3)$tot_var, + array(c(213.2422, 224.4203), dim = c(dat = 2)), + tolerance = 0.0001 + ) }) ############################################## -- GitLab From afc2ebde52bf1d389966f32ffe34bb4f6bc4d583 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 29 Apr 2021 17:27:17 +0200 Subject: [PATCH 100/154] Add warning when 'neofs' is changed. --- R/EOF.R | 17 ++++++++++++----- man/EOF.Rd | 4 ++-- 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/R/EOF.R b/R/EOF.R index d573739..8375eec 100644 --- a/R/EOF.R +++ b/R/EOF.R @@ -14,8 +14,8 @@ #' name of latitude of 'ano' and the second is the dimension name of longitude #' of 'ano'. The default value is c('lat', 'lon'). #'@param neofs An integer of the modes to be kept. The default value is 15. -#' If time length or the product of latitude length and longitude length is -#' less than neofs, neofs is equal to the minimum of the three values. +#' If time length or the product of the length of space_dim is smaller than +#' neofs, neofs will be changed to the minimum of the three values. #'@param corr A logical value indicating whether to base on a correlation (TRUE) #' or on a covariance matrix (FALSE). The default value is FALSE. #'@param ncores An integer indicating the number of cores to use for parallel @@ -147,6 +147,8 @@ EOF <- function(ano, lat, lon, time_dim = 'sdate', space_dim = c('lat', 'lon'), } } + ############################### + # Calculate EOF # # Replace mask of NAs with 0s for EOF analysis. # ano[!is.finite(ano)] <- 0 @@ -162,6 +164,14 @@ EOF <- function(ano, lat, lon, time_dim = 'sdate', space_dim = c('lat', 'lon'), # times ano. wght <- sqrt(wght) + # neofs is bounded + if (neofs != min(dim(ano)[time_dim], prod(dim(ano)[space_dim]), neofs)) { + neofs <- min(dim(ano)[time_dim], prod(dim(ano)[space_dim]), neofs) + .warning(paste0("Parameter 'neofs' is changed to ", neofs, ", the minimum among ", + "the length of time_dim, the production of the length of space_dim, ", + "and neofs.")) + } + res <- Apply(ano, target_dims = c(time_dim, space_dim), output_dims = list(EOFs = c('mode', space_dim), @@ -222,9 +232,6 @@ EOF <- function(ano, lat, lon, time_dim = 'sdate', space_dim = c('lat', 'lon'), pca <- La.svd(ano) } - # neofs is bounded - neofs <- min(dim.dat, neofs) - # La.svd conventions: decomposition X = U D t(V) La.svd$u # returns U La.svd$d returns diagonal values of D La.svd$v # returns t(V) !! The usual convention is PC=U and EOF=V. diff --git a/man/EOF.Rd b/man/EOF.Rd index a7d51a7..dc40658 100644 --- a/man/EOF.Rd +++ b/man/EOF.Rd @@ -31,8 +31,8 @@ name of latitude of 'ano' and the second is the dimension name of longitude of 'ano'. The default value is c('lat', 'lon').} \item{neofs}{An integer of the modes to be kept. The default value is 15. -If time length or the product of latitude length and longitude length is -less than neofs, neofs is equal to the minimum of the three values.} +If time length or the product of the length of space_dim is smaller than +neofs, neofs will be changed to the minimum of the three values.} \item{corr}{A logical value indicating whether to base on a correlation (TRUE) or on a covariance matrix (FALSE). The default value is FALSE.} -- GitLab From 2e103ed43c2dc0c8cabefe014503c644844d410d Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 30 Apr 2021 14:15:32 +0200 Subject: [PATCH 101/154] Add new function REOF. Improve EOF documentation --- NAMESPACE | 1 + R/EOF.R | 12 +- R/REOF.R | 217 +++++++++++++++++++++++++++++++++++++ man/EOF.Rd | 10 +- man/REOF.Rd | 99 +++++++++++++++++ tests/testthat/test-REOF.R | 168 ++++++++++++++++++++++++++++ 6 files changed, 496 insertions(+), 11 deletions(-) create mode 100644 R/REOF.R create mode 100644 man/REOF.Rd create mode 100644 tests/testthat/test-REOF.R diff --git a/NAMESPACE b/NAMESPACE index 3e14c43..75ded15 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -44,6 +44,7 @@ export(PlotMatrix) export(PlotSection) export(PlotStereoMap) export(ProjectField) +export(REOF) export(RMS) export(RMSSS) export(RandomWalkTest) diff --git a/R/EOF.R b/R/EOF.R index 8375eec..4221ccf 100644 --- a/R/EOF.R +++ b/R/EOF.R @@ -1,8 +1,8 @@ #'Area-weighted empirical orthogonal function analysis using SVD #' -#'Perform an area-weighted EOF analysis using SVD based on a covariance matrix -#'by default, based on the correlation matrix if \code{corr} argument is set to -#'\code{TRUE}. +#'Perform an area-weighted EOF analysis using single value decomposition (SVD) +#'based on a covariance matrix or a correlation matrix if parameter 'corr' is +#'set to TRUE. #' #'@param ano A numerical array of anomalies with named dimensions to calculate #' EOF. The dimensions must have at least 'time_dim' and 'space_dim'. @@ -13,8 +13,8 @@ #'@param space_dim A vector of two character strings. The first is the dimension #' name of latitude of 'ano' and the second is the dimension name of longitude #' of 'ano'. The default value is c('lat', 'lon'). -#'@param neofs An integer of the modes to be kept. The default value is 15. -#' If time length or the product of the length of space_dim is smaller than +#'@param neofs A positive integer of the modes to be kept. The default value is +#' 15. If time length or the product of the length of space_dim is smaller than #' neofs, neofs will be changed to the minimum of the three values. #'@param corr A logical value indicating whether to base on a correlation (TRUE) #' or on a covariance matrix (FALSE). The default value is FALSE. @@ -132,7 +132,7 @@ EOF <- function(ano, lat, lon, time_dim = 'sdate', space_dim = c('lat', 'lon'), warning("Some 'lon' is out of the range [-360, 360].") } ## neofs - if (!is.numeric(neofs) | neofs %% 1 != 0 | neofs < 0 | length(neofs) > 1) { + if (!is.numeric(neofs) | neofs %% 1 != 0 | neofs <= 0 | length(neofs) > 1) { stop("Parameter 'neofs' must be a positive integer.") } ## corr diff --git a/R/REOF.R b/R/REOF.R new file mode 100644 index 0000000..30ef6f0 --- /dev/null +++ b/R/REOF.R @@ -0,0 +1,217 @@ +#'Area-weighted empirical orthogonal function analysis with varimax rotation using SVD +#' +#'Perform an area-weighted EOF analysis with varimax rotation using single +#'value decomposition (SVD) based on a covariance matrix or a correlation matrix if +#'parameter 'corr' is set to TRUE. The internal s2dv function \code{.EOF()} is used +#'internally. +#' +#'@param ano A numerical array of anomalies with named dimensions to calculate +#' REOF. The dimensions must have at least 'time_dim' and 'space_dim'. +#'@param lat A vector of the latitudes of 'ano'. +#'@param lon A vector of the longitudes of 'ano'. +#'@param time_dim A character string indicating the name of the time dimension +#' of 'ano'. The default value is 'sdate'. +#'@param space_dim A vector of two character strings. The first is the dimension +#' name of longitude of 'ano' and the second is the dimension name of latitude +#' of 'ano'. The default value is c('lon', 'lat'). +#'@param ntrunc A positive integer of the modes to be kept. The default value +#' is 15. If time length or the product of latitude length and longitude +#' length is less than ntrunc, ntrunc is equal to the minimum of the three +#' values. +#'@param corr A logical value indicating whether to base on a correlation (TRUE) +#' or on a covariance matrix (FALSE). 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 list containing: +#'\item{REOFs}{ +#' An array of REOF patterns normalized to 1 (unitless) with dimensions +#' (number of modes, rest of the dimensions of ano except 'time_dim'). +#' Multiplying 'REOFs' by 'RPCs' gives the original reconstructed +#' field. +#'} +#'\item{RPCs}{ +#' An array of principal components with the units of the original field to +#' the power of 2, with dimensions (time_dim, number of modes, rest of the +#' dimensions except 'space_dim'). +#'} +#'\item{var}{ +#' An array of the percentage (%) of variance fraction of total variance +#' explained by each mode. The dimensions are (number of modes, rest of the +#' dimension except 'time_dim' and 'space_dim'). +#'} +#'\item{wght}{ +#' An array of the area weighting with dimensions 'space_dim'. It is calculated +#' by cosine of 'lat' and used to compute the fraction of variance explained by +#' each REOFs. +#'} +#' +#'@seealso EOF +#'@examples +#'# This example computes the REOFs along forecast horizons and plots the one +#'# that explains the greatest amount of variability. The example data has low +#'# resolution so the result may not be explanatory, but it displays how to +#'# use this function. +#'\dontshow{ +#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), +#' c('observation'), startDates, +#' leadtimemin = 1, +#' leadtimemax = 4, +#' output = 'lonlat', +#' latmin = 27, latmax = 48, +#' lonmin = -12, lonmax = 40) +#'} +#'ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) +#'ano <- MeanDims(ano$exp, c('dataset', 'member')) +#'res <- REOF(ano, lat = sampleData$lat, lon = sampleData$lon, ntrunc = 5) +#'\dontrun{ +#'PlotEquiMap(eof$EOFs[1, , , 1], sampleData$lat, sampleData$lon) +#'} +#' +#'@import multiApply +#'@export +REOF <- function(ano, lat, lon, ntrunc = 15, time_dim = 'sdate', + space_dim = c('lat', 'lon'), corr = FALSE, ncores = NULL) { + + # Check inputs + ## ano + if (is.null(ano)) { + stop("Parameter 'ano' cannot be NULL.") + } + if (!is.numeric(ano)) { + stop("Parameter 'ano' must be a numeric array.") + } + if(any(is.null(names(dim(ano))))| any(nchar(names(dim(ano))) == 0)) { + stop("Parameter 'ano' 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(ano))) { + stop("Parameter 'time_dim' is not found in 'ano' dimension.") + } + ## space_dim + if (!is.character(space_dim) | length(space_dim) != 2) { + stop("Parameter 'space_dim' must be a character vector of 2.") + } + if (any(!space_dim %in% names(dim(ano)))) { + stop("Parameter 'space_dim' is not found in 'ano' dimension.") + } + ## lat + if (!is.numeric(lat) | length(lat) != dim(ano)[space_dim[1]]) { + stop(paste0("Parameter 'lat' must be a numeric vector with the same ", + "length as the latitude dimension of 'ano'.")) + } + if (any(lat > 90 | lat < -90)) { + stop("Parameter 'lat' must contain values within the range [-90, 90].") + } + ## lon + if (!is.numeric(lon) | length(lon) != dim(ano)[space_dim[2]]) { + stop(paste0("Parameter 'lon' must be a numeric vector with the same ", + "length as the longitude dimension of 'ano'.")) + } + if (any(lon > 360 | lon < -360)) { + warning("Some 'lon' is out of the range [-360, 360].") + } + ## ntrunc + if (!is.numeric(ntrunc) | ntrunc %% 1 != 0 | ntrunc <= 0 | length(ntrunc) > 1) { + stop("Parameter 'ntrunc' must be a positive integer.") + } + ## corr + if (!is.logical(corr) | length(corr) > 1) { + stop("Parameter 'corr' must be one logical value.") + } + ## 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.") + } + } + + ############################### + # Calculate REOF + + # ntrunc is bounded + if (ntrunc != min(dim(ano)[time_dim], prod(dim(ano)[space_dim]), ntrunc)) { + ntrunc <- min(dim(ano)[time_dim], prod(dim(ano)[space_dim]), ntrunc) + .warning(paste0("Parameter 'ntrunc' is changed to ", ntrunc, ", the minimum among ", + "the length of time_dim, the production of the length of space_dim, ", + "and ntrunc.")) + } + + # Area weighting is needed to compute the fraction of variance explained by + # each mode + space_ind <- sapply(space_dim, function(a) which(names(dim(ano)) == a)) + wght <- array(cos(lat * pi/180), dim = dim(ano)[space_ind]) + + # We want the covariance matrix to be weigthed by the grid + # cell area so the anomaly field is weighted by its square + # root since the covariance matrix equals transpose(ano) + # times ano. + wght <- sqrt(wght) + + res <- Apply(ano, + target_dims = c(time_dim, space_dim), + output_dims = list(REOFs = c('mode', space_dim), + RPCs = c(time_dim, 'mode'), + var = 'mode', + wght = space_dim), + fun = .REOF, + corr = corr, ntrunc = ntrunc, wght = wght, + ncores = ncores) + + return(res) + +} + + +.REOF <- function(ano, ntrunc, corr = FALSE, wght = wght) { + # ano: [sdate, lat, lon] + + # Dimensions + nt <- dim(ano)[1] + ny <- dim(ano)[2] + nx <- dim(ano)[3] + + # Get the first ntrunc EOFs: + eofs <- .EOF(ano = ano, neofs = ntrunc, corr = corr, wght = wght) #list(EOFs = EOF, PCs = PC, var = var.eof, mask = mask) + + # Recover loadings (with norm 1), weight the EOFs by the weigths + # eofs$EOFs: [mode, lat, lon] + Loadings <- apply(eofs$EOFs, 1, '*', wght) # [lat*lon, mode] + + # Rotate the loadings: + varim <- varimax(Loadings) + + # Weight back the rotated loadings (REOFs): + if (is.list(varim)) { + varim_loadings <- varim$loadings # [lat*lon, mode] + } else { # if mode = 1, varim is an array + varim_loadings <- varim + } + REOFs <- apply(varim_loadings, 2, '/', wght) + dim(REOFs) <- c(ny, nx, ntrunc) + + # Reorder dimensions to match EOF conventions: [mode, lat, lon] + REOFs <- aperm(REOFs, c(3, 1, 2)) + + # Compute the rotated PCs (RPCs): multiply the weigthed anomalies by the loading patterns. + ano.wght <- apply(ano, 1, '*', wght) # [lat*lon, sdate] + RPCs <- t(ano.wght) %*% varim_loadings # [sdate, mode] + + ## Alternative methods suggested here: + ## https://stats.stackexchange.com/questions/59213/how-to-compute-varimax-rotated-principal-components-in-r/137003#137003 + ## gives same results as pinv is just transpose in this case, as loadings are ortonormal! + # invLoadings <- t(pracma::pinv(varim$loadings)) ## invert and traspose the rotated loadings. pinv uses a SVD again (!) + # RPCs <- ano.wght %*% invLoadings + + # Compute explained variance fraction: + var <- apply(RPCs, 2, function(x) { sum(x*x) } ) * 100 / eofs$tot_var # [mode] + dim(var) <- c(mode = length(var)) + + return(invisible(list(REOFs = REOFs, RPCs = RPCs, var = var, wght = wght))) +} diff --git a/man/EOF.Rd b/man/EOF.Rd index dc40658..ae84c55 100644 --- a/man/EOF.Rd +++ b/man/EOF.Rd @@ -30,8 +30,8 @@ of 'ano'. The default value is 'sdate'.} name of latitude of 'ano' and the second is the dimension name of longitude of 'ano'. The default value is c('lat', 'lon').} -\item{neofs}{An integer of the modes to be kept. The default value is 15. -If time length or the product of the length of space_dim is smaller than +\item{neofs}{A positive integer of the modes to be kept. The default value is +15. If time length or the product of the length of space_dim is smaller than neofs, neofs will be changed to the minimum of the three values.} \item{corr}{A logical value indicating whether to base on a correlation (TRUE) @@ -79,9 +79,9 @@ A list containing: } } \description{ -Perform an area-weighted EOF analysis using SVD based on a covariance matrix -by default, based on the correlation matrix if \code{corr} argument is set to -\code{TRUE}. +Perform an area-weighted EOF analysis using single value decomposition (SVD) +based on a covariance matrix or a correlation matrix if parameter 'corr' is +set to TRUE. } \examples{ # This example computes the EOFs along forecast horizons and plots the one diff --git a/man/REOF.Rd b/man/REOF.Rd new file mode 100644 index 0000000..a65331c --- /dev/null +++ b/man/REOF.Rd @@ -0,0 +1,99 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/REOF.R +\name{REOF} +\alias{REOF} +\title{Area-weighted empirical orthogonal function analysis with varimax rotation using SVD} +\usage{ +REOF( + ano, + lat, + lon, + ntrunc = 15, + time_dim = "sdate", + space_dim = c("lat", "lon"), + corr = FALSE, + ncores = NULL +) +} +\arguments{ +\item{ano}{A numerical array of anomalies with named dimensions to calculate +REOF. The dimensions must have at least 'time_dim' and 'space_dim'.} + +\item{lat}{A vector of the latitudes of 'ano'.} + +\item{lon}{A vector of the longitudes of 'ano'.} + +\item{ntrunc}{A positive integer of the modes to be kept. The default value +is 15. If time length or the product of latitude length and longitude +length is less than ntrunc, ntrunc is equal to the minimum of the three +values.} + +\item{time_dim}{A character string indicating the name of the time dimension +of 'ano'. The default value is 'sdate'.} + +\item{space_dim}{A vector of two character strings. The first is the dimension +name of longitude of 'ano' and the second is the dimension name of latitude +of 'ano'. The default value is c('lon', 'lat').} + +\item{corr}{A logical value indicating whether to base on a correlation (TRUE) +or on a covariance matrix (FALSE). The default value is FALSE.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A list containing: +\item{REOFs}{ + An array of REOF patterns normalized to 1 (unitless) with dimensions + (number of modes, rest of the dimensions of ano except 'time_dim'). + Multiplying 'REOFs' by 'RPCs' gives the original reconstructed + field. +} +\item{RPCs}{ + An array of principal components with the units of the original field to + the power of 2, with dimensions (time_dim, number of modes, rest of the + dimensions except 'space_dim'). +} +\item{var}{ + An array of the percentage (%) of variance fraction of total variance + explained by each mode. The dimensions are (number of modes, rest of the + dimension except 'time_dim' and 'space_dim'). +} +\item{wght}{ + An array of the area weighting with dimensions 'space_dim'. It is calculated + by cosine of 'lat' and used to compute the fraction of variance explained by + each REOFs. +} +} +\description{ +Perform an area-weighted EOF analysis with varimax rotation using single +value decomposition (SVD) based on a covariance matrix or a correlation matrix if +parameter 'corr' is set to TRUE. The internal s2dv function \code{.EOF()} is used +internally. +} +\examples{ +# This example computes the REOFs along forecast horizons and plots the one +# that explains the greatest amount of variability. The example data has low +# resolution so the result may not be explanatory, but it displays how to +# use this function. +\dontshow{ +startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') +sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), + c('observation'), startDates, + leadtimemin = 1, + leadtimemax = 4, + output = 'lonlat', + latmin = 27, latmax = 48, + lonmin = -12, lonmax = 40) +} +ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) +ano <- MeanDims(ano$exp, c('dataset', 'member')) +res <- REOF(ano, lat = sampleData$lat, lon = sampleData$lon, ntrunc = 5) +\dontrun{ +PlotEquiMap(eof$EOFs[1, , , 1], sampleData$lat, sampleData$lon) +} + +} +\seealso{ +EOF +} diff --git a/tests/testthat/test-REOF.R b/tests/testthat/test-REOF.R new file mode 100644 index 0000000..296e57a --- /dev/null +++ b/tests/testthat/test-REOF.R @@ -0,0 +1,168 @@ +context("s2dv::REOF tests") + +############################################## + # dat1 + set.seed(1) + dat1 <- array(rnorm(120), dim = c(sdate = 10, lat = 6, lon = 2)) + lat1 <- seq(10, 30, length.out = 6) + lon1 <- c(10, 12) + + # dat2 + set.seed(2) + dat2 <- array(rnorm(120), dim = c(dat = 2, lat = 6, lon = 2, sdate = 5)) + lat2 <- lat1 + lon2 <- lon1 + +############################################## +test_that("1. Input checks", { + + # ano + expect_error( + REOF(c()), + "Parameter 'ano' cannot be NULL." + ) + expect_error( + REOF(c(NA, NA)), + "Parameter 'ano' must be a numeric array." + ) + expect_error( + REOF(list(a = array(rnorm(50), dim = c(dat = 5, sdate = 10)), b = c(1:4))), + "Parameter 'ano' must be a numeric array." + ) + expect_error( + REOF(array(1:10, dim = c(2, 5))), + "Parameter 'ano' must have dimension names." + ) + # time_dim + expect_error( + REOF(dat1, time_dim = 2), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + REOF(dat1, time_dim = c('a','sdate')), + "Parameter 'time_dim' must be a character string." + ) + # space_dim + expect_error( + REOF(dat1, space_dim = 'lat'), + "Parameter 'space_dim' must be a character vector of 2." + ) + expect_error( + REOF(dat1, space_dim = c('latitude', 'longitude')), + "Parameter 'space_dim' is not found in 'ano' dimension." + ) + # lat + expect_error( + REOF(dat1, lat = 1:10), + paste0("Parameter 'lat' must be a numeric vector with the same ", + "length as the latitude dimension of 'ano'.") + ) + expect_error( + REOF(dat1, lat = seq(-100, -80, length.out = 6)), + "Parameter 'lat' must contain values within the range \\[-90, 90\\]." + ) + # lon + expect_error( + REOF(dat1, lat = lat1, lon = c('a', 'b')), + paste0("Parameter 'lon' must be a numeric vector with the same ", + "length as the longitude dimension of 'ano'.") + ) + expect_warning( + REOF(dat1, lat = lat1, lon = c(350, 370)), + "Some 'lon' is out of the range \\[-360, 360\\]." + ) + # ntrunc + expect_error( + REOF(dat1, lat = lat1, lon = lon1, ntrunc = 0), + "Parameter 'ntrunc' must be a positive integer." + ) + # corr + expect_error( + REOF(dat1, lat = lat1, lon = lon1, corr = 0.1), + "Parameter 'corr' must be one logical value." + ) + # ncores + expect_error( + REOF(dat1, lat1, lon1, ncore = 3.5), + "Parameter 'ncores' must be a positive integer." + ) + +}) + +############################################## +test_that("2. dat1", { + + expect_equal( + names(REOF(dat1, lon = lon1, lat = lat1, ntrunc = 5)), + c("REOFs", "RPCs", "var", "wght") + ) + expect_equal( + dim(REOF(dat1, lon = lon1, lat = lat1)$REOFs), + c(mode = 10, lat = 6, lon = 2) + ) + expect_equal( + dim(REOF(dat1, lon = lon1, lat = lat1, ntrunc = 9)$RPCs), + c(sdate = 10, mode = 9) + ) + expect_equal( + dim(REOF(dat1, lon = lon1, lat = lat1, ntrunc = 1)$var), + c(mode = 1) + ) + expect_equal( + dim(REOF(dat1, lon = lon1, lat = lat1, ntrunc = 1)$wght), + c(lat = 6, lon = 2) + ) + expect_equal( + REOF(dat1, lon = lon1, lat = lat1, ntrunc = 1)$REOFs[1:5], + c(-0.28881677, 0.47116712, 0.27298759, 0.32794052, 0.01873475), + tolerance = 0.0001 + ) + expect_equal( + mean(REOF(dat1, lon = lon1, lat = lat1, ntrunc = 2)$REOFs), + -0.007620167, + tolerance = 0.0001 + ) + expect_equal( + REOF(dat1, lon = lon1, lat = lat1, ntrunc = 2)$RPCs[4:8], + c(-0.58817084, -1.86745710, -0.09939452, -1.11012382, 1.89513430), + tolerance = 0.0001 + ) + expect_equal( + REOF(dat1, lon = lon1, lat = lat1, ntrunc = 2)$var[1:2], + array(c(28.04203, 26.56988), dim = c(mode = 2)), + tolerance = 0.0001 + ) + expect_equal( + REOF(dat1, lon = lon1, lat = lat1, ntrunc = 1)$wght[1,1], + REOF(dat1, lon = lon1, lat = lat1, ntrunc = 1)$wght[1,2] + ) + expect_equal( + REOF(dat1, lon = lon1, lat = lat1, ntrunc = 1)$wght[1:1], + c(0.9923748), + tolerance = 0.0001 + ) + +}) +############################################## +test_that("3. dat2", { + expect_equal( + dim(REOF(dat2, lon = lon2, lat = lat2)$REOFs), + c(mode = 5, lat = 6, lon = 2, dat = 2) + ) + expect_equal( + dim(REOF(dat2, lon = lon2, lat = lat2, ntrunc = 4)$RPCs), + c(sdate = 5, mode = 4, dat = 2) + ) + expect_equal( + REOF(dat2, lon = lon2, lat = lat2, ntrunc = 1)$REOFs[1, 3, 2, 1], + 0.09529009, + tolerance = 0.0001 + ) + expect_equal( + mean(REOF(dat2, lon = lon2, lat = lat2)$REOFs), + 0.01120786, + tolerance = 0.0001 + ) + +}) + -- GitLab From 39f3e5b231fb461c37d84f04df8ad2e1db7ae179 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 30 Apr 2021 17:23:27 +0200 Subject: [PATCH 102/154] Caclulate the correct border; add 'xlim' in map() to avoid border line of map --- R/PlotEquiMap.R | 27 ++++++++++++++++++++++----- 1 file changed, 22 insertions(+), 5 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 5b60c30..cf0442f 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -698,9 +698,16 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, #NOTE: Here creates the window for later plot. If 'usr' for par() is not specified, # use the lat/lon as the borders. If 'usr' is specified, use the assigned values. - if (is.null(userArgs$usr)) { - plot.window(xlim = range(lonb$x, finite = TRUE), ylim = range(latb$x, finite = TRUE), - xaxs = 'i', yaxs = 'i') + if (is.null(userArgs$usr)) { + #NOTE: The grids are assumed to be equally spaced + xlim_cal <- c(lonb$x[1] - (lonb$x[2] - lonb$x[1]) / 2, + lonb$x[length(lonb$x)] + (lonb$x[2] - lonb$x[1]) / 2) + ylim_cal <- c(latb$x[1] - (latb$x[2] - latb$x[1]) / 2, + latb$x[length(latb$x)] + (latb$x[2] - latb$x[1]) / 2) + plot.window(xlim = xlim_cal, ylim = ylim_cal, xaxs = 'i', yaxs = 'i') +# Below is Old code. The border grids are only half plotted. +# plot.window(xlim = range(lonb$x, finite = TRUE), ylim = range(latb$x, finite = TRUE), +# xaxs = 'i', yaxs = 'i') } else { plot.window(xlim = par("usr")[1:2], ylim = par("usr")[3:4], xaxs = 'i', yaxs = 'i') } @@ -748,8 +755,18 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # # Plotting continents # ~~~~~~~~~~~~~~~~~~~~~ - # - coast <- map(continents, interior = FALSE, wrap = TRUE, + # + # maps::map has the global map range [0, 360] or [-180, 180]. + # Set xlim so lon = 0 won't show a straight line when lon = [0, 359]. + # NOTE: It works except Antartic area. Don't know why. ylim is also set + # but it doesn't work. + if (continents == 'world') { # [-180, 180] + xlim_conti <- c(-179.99, 179.99) + } else { # [0, 360] + xlim_conti <- c(0.01, 359.99) + } + coast <- map(continents, interior = FALSE, wrap = TRUE, + xlim = xlim_conti, ylim = c(-89.99, 89.99), fill = filled.continents, add = TRUE, plot = FALSE) if (filled.continents) { old_lwd <- par('lwd') -- GitLab From 3c830c382dc6c94a6ba3eae9a793c32f1762760b Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 3 May 2021 17:49:15 +0200 Subject: [PATCH 103/154] Add contour function. --- R/PlotStereoMap.R | 91 ++++++++++++++++++++++++++++++++++++++++++++ man/PlotStereoMap.Rd | 25 ++++++++++++ 2 files changed, 116 insertions(+) diff --git a/R/PlotStereoMap.R b/R/PlotStereoMap.R index d4e8e2d..cab3b58 100644 --- a/R/PlotStereoMap.R +++ b/R/PlotStereoMap.R @@ -58,6 +58,19 @@ #' continents. Takes the value gray(0.5) by default. #'@param coast_width Line width of the coast line of the drawn projected #' continents. Takes the value 1 by default. +#'@param contours Array of same dimensions as 'var' to be added to the plot +#' and displayed with contours. Parameter 'brks2' is required to define the +#' magnitude breaks for each contour curve. +#'@param brks2 Vector of magnitude breaks where to draw contour curves for the +#' array provided in 'contours'. +#'@param contour_lwd Line width of the contour curves provided via 'contours' +#' and 'brks2'. +#'@param contour_color Line color of the contour curves provided via 'contours' +#' and 'brks2'. +#'@param contour_lty Line type of the contour curves. Takes 1 (solid) by +#' default. See help on 'lty' in par() for other accepted values. +#'@param contour_label_scale Scale factor for the superimposed labels when +#' drawing contour levels. The default value is 0.6. #'@param dots Array of same dimensions as 'var' or with dimensions #' c(n, dim(var)), where n is the number of dot/symbol layers to add to the #' plot. A value of TRUE at a grid cell will draw a dot/symbol on the @@ -144,6 +157,9 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), colNA = NULL, color_fun = clim.palette(), filled.continents = FALSE, coast_color = NULL, coast_width = 1, + contours = NULL, brks2 = NULL, contour_lwd = 0.5, + contour_color = 'black', contour_lty = 1, + contour_label_scale = 0.6, dots = NULL, dot_symbol = 4, dot_size = 0.8, intlat = 10, drawleg = TRUE, subsampleg = NULL, @@ -309,6 +325,57 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), if (!is.numeric(coast_width)) { stop("Parameter 'coast_width' must be numeric.") } + # Check contours + if (!is.null(contours)) { + if (!is.array(contours)) { + stop("Parameter 'contours' must be a numeric array.") + } + if (length(dim(contours)) > 2) { + contours <- drop(contours) + dim(contours) <- head(c(dim(contours), 1, 1), 2) + } + if (length(dim(contours)) > 2) { + stop("Parameter 'contours' must be a numeric array with two dimensions.") + } else if (length(dim(contours)) < 2) { + stop("Parameter 'contours' must be a numeric array with two dimensions.") + } + # Transpose the input matrices because the base plot functions work directly + # with dimensions c(lon, lat). + if (dim(contours)[1] == dims[2] & dim(contours)[2] == dims[1]) { + contours <- t(contours) + } else { + stop("Parameter 'contours' must have the same number of longitudes and latitudes as 'var'.") + } + } + + # Check brks2 + if (is.null(brks2)) { + if (!is.null(contours)) { + ll <- signif(min(contours, na.rm = TRUE), 2) + ul <- signif(max(contours, na.rm = TRUE), 2) + brks2 <- signif(seq(ll, ul, length.out = length(brks)), 2) + } + } + + # Check contour_lwd + if (!is.numeric(contour_lwd)) { + stop("Parameter 'contour_lwd' must be numeric.") + } + + # Check contour_color + if (!.IsColor(contour_color)) { + stop("Parameter 'contour_color' must be a valid colour identifier.") + } + + # Check contour_lty + if (!is.numeric(contour_lty) && !is.character(contour_lty)) { + stop("Parameter 'contour_lty' must be either a number or a character string.") + } + + # Check contour_label_scale + if (!is.numeric(contour_label_scale)) { + stop("Parameter 'contour_label_scale' must be numeric.") + } # Check dots, dot_symbol and dot_size if (!is.null(dots)) { @@ -482,6 +549,30 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), } } } + + # contours + if (!is.null(contours)) { + nbrks2 <- length(brks2) + for (n_brks2 in 1:nbrks2) { + cl <- grDevices::contourLines(x = lon, y = lat[which(lat >= latlims[1] & lat <= latlims[2])], + z = contours[, which(lat >= latlims[1] & lat <= latlims[2])], + levels = brks2[n_brks2]) + if (length(cl) > 0) { + for (i in seq_along(cl)) { + xy <- mapproj::mapproject(cl[[i]]$x, cl[[i]]$y) + xc <- xy$x + yc <- xy$y + nc <- length(xc) + lines(xc, yc, col = contour_color) #, lwd=lwd[n_brks2], lty=lty[n_brks2]) + + # draw label + text(xc[1], yc[1], as.character(round(brks2[n_brks2], 2)), cex = contour_label_scale) +# text(xc[labelj], yc[labelj], label, col=col[n_brks2], srt=angle*180/pi, cex=labcex[n_brks2]) + } + } + } + } + # Draw the dots if (!is.null(dots)) { numbfig <- 1 # for compatibility with PlotEquiMap code diff --git a/man/PlotStereoMap.Rd b/man/PlotStereoMap.Rd index 95c2f71..5393eec 100644 --- a/man/PlotStereoMap.Rd +++ b/man/PlotStereoMap.Rd @@ -23,6 +23,12 @@ PlotStereoMap( filled.continents = FALSE, coast_color = NULL, coast_width = 1, + contours = NULL, + brks2 = NULL, + contour_lwd = 0.5, + contour_color = "black", + contour_lty = 1, + contour_label_scale = 0.6, dots = NULL, dot_symbol = 4, dot_size = 0.8, @@ -116,6 +122,25 @@ continents. Takes the value gray(0.5) by default.} \item{coast_width}{Line width of the coast line of the drawn projected continents. Takes the value 1 by default.} +\item{contours}{Array of same dimensions as 'var' to be added to the plot +and displayed with contours. Parameter 'brks2' is required to define the +magnitude breaks for each contour curve.} + +\item{brks2}{Vector of magnitude breaks where to draw contour curves for the +array provided in 'contours'.} + +\item{contour_lwd}{Line width of the contour curves provided via 'contours' +and 'brks2'.} + +\item{contour_color}{Line color of the contour curves provided via 'contours' +and 'brks2'.} + +\item{contour_lty}{Line type of the contour curves. Takes 1 (solid) by +default. See help on 'lty' in par() for other accepted values.} + +\item{contour_label_scale}{Scale factor for the superimposed labels when +drawing contour levels. The default value is 0.6.} + \item{dots}{Array of same dimensions as 'var' or with dimensions c(n, dim(var)), where n is the number of dot/symbol layers to add to the plot. A value of TRUE at a grid cell will draw a dot/symbol on the -- GitLab From 3d1ad03a8290a241ff4a43d3c784a7d099ebd48a Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 4 May 2021 17:06:55 +0200 Subject: [PATCH 104/154] Use 'contour_label_scale' as cex for contour(). --- R/PlotEquiMap.R | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index cf0442f..eae709c 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -732,9 +732,15 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, col = c(col_inf_image, cols, col_sup_image)) } if (!is.null(contours)) { +#NOTE: 'labcex' is the absolute size of contour labels. Parameter 'contour_label_scale' +# is provided in PlotEquiMap() but it was not used. Here, 'cex_axes_labels' was used +# and it was calculated from 'axes_label_scale', the size of lat/lon axis label. +# It is changed to use contour_label_scale*par('cex'). contour(lonb$x, latb$x, contours[lonb$ix, latb$ix], levels = brks2, - method = "edge", add = TRUE, - labcex = cex_axes_labels, lwd = contour_lwd, lty = contour_lty, + method = "edge", add = TRUE, +# labcex = cex_axes_labels, + labcex = contour_label_scale * par("cex"), + lwd = contour_lwd, lty = contour_lty, col = contour_color) } -- GitLab From 12ba4c4d97c61242d28db0e1de38bd3232156991 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 4 May 2021 17:07:16 +0200 Subject: [PATCH 105/154] Refine labels of contour lines --- R/PlotStereoMap.R | 77 +++++++++++++++++++++++++++++++++++++------- man/PlotStereoMap.Rd | 15 ++++++--- 2 files changed, 76 insertions(+), 16 deletions(-) diff --git a/R/PlotStereoMap.R b/R/PlotStereoMap.R index cab3b58..e347775 100644 --- a/R/PlotStereoMap.R +++ b/R/PlotStereoMap.R @@ -61,14 +61,19 @@ #'@param contours Array of same dimensions as 'var' to be added to the plot #' and displayed with contours. Parameter 'brks2' is required to define the #' magnitude breaks for each contour curve. -#'@param brks2 Vector of magnitude breaks where to draw contour curves for the -#' array provided in 'contours'. +#'@param brks2 A numeric value or vector of magnitude breaks where to draw +#' contour curves for the array provided in 'contours'. If it is a number, it +#' represents the number of breaks (n) that defines (n - 1) intervals to +#' classify 'contours'. #'@param contour_lwd Line width of the contour curves provided via 'contours' -#' and 'brks2'. -#'@param contour_color Line color of the contour curves provided via 'contours' +#' and 'brks2'. The default value is 0.5. +#'@param contour_color Line color of the contour curves provided via 'contours' #' and 'brks2'. #'@param contour_lty Line type of the contour curves. Takes 1 (solid) by #' default. See help on 'lty' in par() for other accepted values. +#'@param contour_label_draw A logical value indicating whether to draw the +#' contour labels (TRUE) or not (FALSE) when 'contours' is used. The default +#' value is TRUE. #'@param contour_label_scale Scale factor for the superimposed labels when #' drawing contour levels. The default value is 0.6. #'@param dots Array of same dimensions as 'var' or with dimensions @@ -159,7 +164,7 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), coast_width = 1, contours = NULL, brks2 = NULL, contour_lwd = 0.5, contour_color = 'black', contour_lty = 1, - contour_label_scale = 0.6, + contour_label_draw = TRUE, contour_label_scale = 0.6, dots = NULL, dot_symbol = 4, dot_size = 0.8, intlat = 10, drawleg = TRUE, subsampleg = NULL, @@ -349,11 +354,18 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), } # Check brks2 - if (is.null(brks2)) { - if (!is.null(contours)) { + if (!is.null(contours)) { + if (is.null(brks2)) { ll <- signif(min(contours, na.rm = TRUE), 2) ul <- signif(max(contours, na.rm = TRUE), 2) - brks2 <- signif(seq(ll, ul, length.out = length(brks)), 2) + brks2 <- unique(signif(seq(ll, ul, length.out = length(brks)), 2)) + + } else if (is.numeric(brks2) & length(brks2) == 1) { + ll <- signif(min(contours, na.rm = TRUE), 2) + ul <- signif(max(contours, na.rm = TRUE), 2) + brks2 <- unique(signif(seq(ll, ul, length.out = brks2), 2)) + } else if (!is.numeric(brks2)) { + stop("Parameter 'brks2' must be a numeric value or vector.") } } @@ -372,6 +384,11 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), stop("Parameter 'contour_lty' must be either a number or a character string.") } + # Check contour_label_draw + if (!is.logical(contour_label_draw)) { + stop("Parameter 'contour_label_draw' must be a logical value.") + } + # Check contour_label_scale if (!is.numeric(contour_label_scale)) { stop("Parameter 'contour_label_scale' must be numeric.") @@ -554,7 +571,7 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), if (!is.null(contours)) { nbrks2 <- length(brks2) for (n_brks2 in 1:nbrks2) { - cl <- grDevices::contourLines(x = lon, y = lat[which(lat >= latlims[1] & lat <= latlims[2])], + cl <- grDevices::contourLines(x = lon, y = lat[which(lat >= latlims[1] & lat <= latlims[2])], z = contours[, which(lat >= latlims[1] & lat <= latlims[2])], levels = brks2[n_brks2]) if (length(cl) > 0) { @@ -563,11 +580,47 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), xc <- xy$x yc <- xy$y nc <- length(xc) - lines(xc, yc, col = contour_color) #, lwd=lwd[n_brks2], lty=lty[n_brks2]) + lines(xc, yc, col = contour_color, lwd = contour_lwd, lty = contour_lty) # draw label - text(xc[1], yc[1], as.character(round(brks2[n_brks2], 2)), cex = contour_label_scale) -# text(xc[labelj], yc[labelj], label, col=col[n_brks2], srt=angle*180/pi, cex=labcex[n_brks2]) + if (contour_label_draw) { + label_char <- as.character(signif(brks2[n_brks2], 2)) + ## Check if the label has enough space to draw first. + last_slope <- Inf + put_label <- FALSE + for (p1 in 1:nc) { + p2 <- p1 + while (p2 < nc) { + dist <- sqrt((yc[p2] - yc[p1])^2 + (xc[p2] - xc[p1])^2) + if (!is.infinite(dist) & + dist > 1.2 * strwidth(label_char, cex = contour_label_scale)) { + put_label <- TRUE + slope <- (yc[p2] - yc[p1]) / (xc[p2] - xc[p1]) + # flatter is better + if (abs(slope) < abs(last_slope)) { + last_slope <- slope + last_p1 <- p1 + last_p2 <- p2 + } + break # Found a proper space for label. Move to the next p1. + } + p2 <- p2 + 1 # If the dist is not enough, try next p2. + } + } + + ## If label can be put + if (put_label) { + # Label should be at the middle of p1 and p2 + p_label <- (last_p1 + last_p2) / 2 + # string rotation angle is calculated from the slope + srt_label <- atan(last_slope) * 57.2958 # radian to degree + + #NOTE: 'cex' in text() is the scale factor. The actual size will be + # contour_label_scale * par("cex") + text(xc[p_label], yc[p_label], label_char, + cex = contour_label_scale, col = contour_color, srt = srt_label) + } + } } } } diff --git a/man/PlotStereoMap.Rd b/man/PlotStereoMap.Rd index 5393eec..cca91b4 100644 --- a/man/PlotStereoMap.Rd +++ b/man/PlotStereoMap.Rd @@ -28,6 +28,7 @@ PlotStereoMap( contour_lwd = 0.5, contour_color = "black", contour_lty = 1, + contour_label_draw = TRUE, contour_label_scale = 0.6, dots = NULL, dot_symbol = 4, @@ -126,18 +127,24 @@ continents. Takes the value 1 by default.} and displayed with contours. Parameter 'brks2' is required to define the magnitude breaks for each contour curve.} -\item{brks2}{Vector of magnitude breaks where to draw contour curves for the -array provided in 'contours'.} +\item{brks2}{A numeric value or vector of magnitude breaks where to draw +contour curves for the array provided in 'contours'. If it is a number, it +represents the number of breaks (n) that defines (n - 1) intervals to +classify 'contours'.} \item{contour_lwd}{Line width of the contour curves provided via 'contours' -and 'brks2'.} +and 'brks2'. The default value is 0.5.} -\item{contour_color}{Line color of the contour curves provided via 'contours' +\item{contour_color}{Line color of the contour curves provided via 'contours' and 'brks2'.} \item{contour_lty}{Line type of the contour curves. Takes 1 (solid) by default. See help on 'lty' in par() for other accepted values.} +\item{contour_label_draw}{A logical value indicating whether to draw the +contour labels (TRUE) or not (FALSE) when 'contours' is used. The default +value is TRUE.} + \item{contour_label_scale}{Scale factor for the superimposed labels when drawing contour levels. The default value is 0.6.} -- GitLab From 6323576c03b8778d18f5d06f6634f2c8911d2048 Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 6 May 2021 15:25:26 +0200 Subject: [PATCH 106/154] subset lats to plot dots --- R/PlotStereoMap.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/PlotStereoMap.R b/R/PlotStereoMap.R index e347775..3eb4cd2 100644 --- a/R/PlotStereoMap.R +++ b/R/PlotStereoMap.R @@ -630,6 +630,7 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), if (!is.null(dots)) { numbfig <- 1 # for compatibility with PlotEquiMap code dots <- dots[, , which(lat >= latlims[1] & lat <= latlims[2]), drop = FALSE] + lat <- lat[which(lat >= latlims[1] & lat <= latlims[2])] data_avail <- !is.na(var[, which(lat >= latlims[1] & lat <= latlims[2]), drop = FALSE]) for (counter in 1:(dim(dots)[1])) { points <- which(dots[counter, , ] & data_avail, arr.ind = TRUE) -- GitLab From 526aa5d92d1fa3f749de51b8a4473be5a17bb014 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 6 May 2021 17:25:37 +0200 Subject: [PATCH 107/154] Revise documentation of @return --- R/ProbBins.R | 12 ++++++------ man/ProbBins.Rd | 12 ++++++------ 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/R/ProbBins.R b/R/ProbBins.R index c76ad43..327ceb3 100644 --- a/R/ProbBins.R +++ b/R/ProbBins.R @@ -32,12 +32,12 @@ #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' -#'@return Array with probabilistic information and dimensions:\cr -#' c(length('thr') + 1, length(fcyr), nmemb/nparam, nmod/nexp/nobs, -#' nltime, nlat, nlon)\cr -#' The values along the first dimension take values 0 or 1 depending on which -#' of the 'thr'+1 cathegories the forecast/observation at the corresponding -#' grid point, time step, member and starting date belongs to. +#'@return A numeric array of probabilistic information with dimensions:\cr +#' c(bin = length of 'thr' + 1, time_dim = length of 'fcyr', memb_dim, the +#' rest of dimensions of 'data')\cr +#' The values along the 'bin' dimension take values 0 or 1 depending on which +#' of the 'thr' + 1 cathegories the forecast or observation at the corresponding +#' grid point, time step, member and start date belongs to. #' #'@examples #'\dontshow{ diff --git a/man/ProbBins.Rd b/man/ProbBins.Rd index 26b88b8..cfd7aff 100644 --- a/man/ProbBins.Rd +++ b/man/ProbBins.Rd @@ -51,12 +51,12 @@ The default value is "Full period".} computation. The default value is NULL.} } \value{ -Array with probabilistic information and dimensions:\cr - c(length('thr') + 1, length(fcyr), nmemb/nparam, nmod/nexp/nobs, - nltime, nlat, nlon)\cr - The values along the first dimension take values 0 or 1 depending on which - of the 'thr'+1 cathegories the forecast/observation at the corresponding - grid point, time step, member and starting date belongs to. +A numeric array of probabilistic information with dimensions:\cr + c(bin = length of 'thr' + 1, time_dim = length of 'fcyr', memb_dim, the + rest of dimensions of 'data')\cr + The values along the 'bin' dimension take values 0 or 1 depending on which + of the 'thr' + 1 cathegories the forecast or observation at the corresponding + grid point, time step, member and start date belongs to. } \description{ Compute probabilistic bins of a set of forecast years ('fcyr') relative to -- GitLab From 3911f043bd4a31d0416996f75321cdd9ccee4924 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 6 May 2021 18:08:38 +0200 Subject: [PATCH 108/154] Syntax fix --- R/Spectrum.R | 2 +- man/Spectrum.Rd | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/R/Spectrum.R b/R/Spectrum.R index 019b421..7bf07be 100644 --- a/R/Spectrum.R +++ b/R/Spectrum.R @@ -2,7 +2,7 @@ #' #'Estimate the frequency spectrum of the data array together with its 95\% and #'99\% significance level. The output is provided as an array with dimensions -#"c(number of frequencies, 4). The column contains the frequency values, the +#'c(number of frequencies, 4). The column contains the frequency values, the #'power, the 95\% significance level and the 99\% one.\cr #'The spectrum estimation relies on a R built-in function \code{spectrum()} #'and the significance levels are estimated by a Monte-Carlo method. diff --git a/man/Spectrum.Rd b/man/Spectrum.Rd index d1ebe9e..d5e4ed5 100644 --- a/man/Spectrum.Rd +++ b/man/Spectrum.Rd @@ -27,6 +27,7 @@ A numeric array of the frequency spectrum with dimensions \description{ Estimate the frequency spectrum of the data array together with its 95\% and 99\% significance level. The output is provided as an array with dimensions +c(number of frequencies, 4). The column contains the frequency values, the power, the 95\% significance level and the 99\% one.\cr The spectrum estimation relies on a R built-in function \code{spectrum()} and the significance levels are estimated by a Monte-Carlo method. -- GitLab From fd7b4fff6a9e8afc4cb45680cbfd09b1d2ab4263 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 7 May 2021 12:33:05 +0200 Subject: [PATCH 109/154] Bugfix for dots plotting. 'lat' for mapproj() needs to be subsetted first --- R/PlotStereoMap.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/PlotStereoMap.R b/R/PlotStereoMap.R index 3eb4cd2..7410e9b 100644 --- a/R/PlotStereoMap.R +++ b/R/PlotStereoMap.R @@ -630,11 +630,10 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), if (!is.null(dots)) { numbfig <- 1 # for compatibility with PlotEquiMap code dots <- dots[, , which(lat >= latlims[1] & lat <= latlims[2]), drop = FALSE] - lat <- lat[which(lat >= latlims[1] & lat <= latlims[2])] data_avail <- !is.na(var[, which(lat >= latlims[1] & lat <= latlims[2]), drop = FALSE]) for (counter in 1:(dim(dots)[1])) { points <- which(dots[counter, , ] & data_avail, arr.ind = TRUE) - points_proj <- mapproj::mapproject(lon[points[, 1]], lat[points[, 2]]) + points_proj <- mapproj::mapproject(lon[points[, 1]], lat[which(lat >= latlims[1] & lat <= latlims[2])][points[, 2]]) points(points_proj$x, points_proj$y, pch = dot_symbol[counter], cex = dot_size[counter] * 3 / sqrt(sqrt(sum(lat >= latlims[which.min(abs(latlims))]) * length(lon))), -- GitLab From d2aee8e65f6f125fa26dbc24fc54b05e0f376d5d Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 7 May 2021 12:49:51 +0200 Subject: [PATCH 110/154] Add object 'lat_plot_ind' to simplify the codes --- R/PlotStereoMap.R | 45 +++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/R/PlotStereoMap.R b/R/PlotStereoMap.R index 7410e9b..6ccbb72 100644 --- a/R/PlotStereoMap.R +++ b/R/PlotStereoMap.R @@ -254,6 +254,9 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), last_lat <- lat[which.min(abs(lat - original_last_lat))] - dlat * sign(center_at) latlims[which.min(abs(latlims))] <- last_lat + # Subset lat by latlims + lat_plot_ind <- which(lat >= latlims[1] & lat <= latlims[2]) + # Check toptitle if (is.null(toptitle) || is.na(toptitle)) { toptitle <- '' @@ -546,24 +549,22 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), col_sup_image <- ifelse(is.null(col_sup), colNA, col_sup) # Draw the data polygons for (jx in 1:dims[1]) { - for (jy in 1:dims[2]) { - if (lat[jy] >= latlims[1] && latlims[2] >= lat[jy]) { - coord <- mapproj::mapproject(c(lon[jx] - dlon, lon[jx] + dlon, - lon[jx] + dlon, lon[jx] - dlon), - c(lat[jy] - dlat, lat[jy] - dlat, - lat[jy] + dlat, lat[jy] + dlat)) - if (is.na(var[jx, jy] > 0)) { - col <- colNA - } else if (var[jx, jy] <= brks[1]) { - col <- col_inf_image - } else if (var[jx, jy] >= tail(brks, 1)) { - col <- col_sup_image - } else { - ind <- which(brks[-1] >= var[jx, jy] & var[jx, jy] > brks[-length(brks)]) - col <- cols[ind] - } - polygon(coord, col = col, border = NA) + for (jy in 1:length(lat_plot_ind)) { + coord <- mapproj::mapproject(c(lon[jx] - dlon, lon[jx] + dlon, + lon[jx] + dlon, lon[jx] - dlon), + c(lat[lat_plot_ind][jy] - dlat, lat[lat_plot_ind][jy] - dlat, + lat[lat_plot_ind][jy] + dlat, lat[lat_plot_ind][jy] + dlat)) + if (is.na(var[jx, lat_plot_ind[jy]] > 0)) { + col <- colNA + } else if (var[jx, lat_plot_ind[jy]] <= brks[1]) { + col <- col_inf_image + } else if (var[jx, lat_plot_ind[jy]] >= tail(brks, 1)) { + col <- col_sup_image + } else { + ind <- which(brks[-1] >= var[jx, lat_plot_ind[jy]] & var[jx, lat_plot_ind[jy]] > brks[-length(brks)]) + col <- cols[ind] } + polygon(coord, col = col, border = NA) } } @@ -571,8 +572,8 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), if (!is.null(contours)) { nbrks2 <- length(brks2) for (n_brks2 in 1:nbrks2) { - cl <- grDevices::contourLines(x = lon, y = lat[which(lat >= latlims[1] & lat <= latlims[2])], - z = contours[, which(lat >= latlims[1] & lat <= latlims[2])], + cl <- grDevices::contourLines(x = lon, y = lat[lat_plot_ind], + z = contours[, lat_plot_ind], levels = brks2[n_brks2]) if (length(cl) > 0) { for (i in seq_along(cl)) { @@ -629,11 +630,11 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), # Draw the dots if (!is.null(dots)) { numbfig <- 1 # for compatibility with PlotEquiMap code - dots <- dots[, , which(lat >= latlims[1] & lat <= latlims[2]), drop = FALSE] - data_avail <- !is.na(var[, which(lat >= latlims[1] & lat <= latlims[2]), drop = FALSE]) + dots <- dots[, , lat_plot_ind, drop = FALSE] + data_avail <- !is.na(var[, lat_plot_ind, drop = FALSE]) for (counter in 1:(dim(dots)[1])) { points <- which(dots[counter, , ] & data_avail, arr.ind = TRUE) - points_proj <- mapproj::mapproject(lon[points[, 1]], lat[which(lat >= latlims[1] & lat <= latlims[2])][points[, 2]]) + points_proj <- mapproj::mapproject(lon[points[, 1]], lat[lat_plot_ind][points[, 2]]) points(points_proj$x, points_proj$y, pch = dot_symbol[counter], cex = dot_size[counter] * 3 / sqrt(sqrt(sum(lat >= latlims[which.min(abs(latlims))]) * length(lon))), -- GitLab From 8675aba74ec962e54d641f2ca8f347bebd7c0355 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 10 May 2021 21:35:19 +0200 Subject: [PATCH 111/154] Revise NAO()'s EOF calculation --- R/NAO.R | 191 +++++++++++++++-------------- R/ProjectField.R | 21 ++-- man/NAO.Rd | 42 +++---- tests/testthat/test-NAO.R | 64 +++++++--- tests/testthat/test-ProjectField.R | 10 +- 5 files changed, 173 insertions(+), 155 deletions(-) diff --git a/R/NAO.R b/R/NAO.R index a73536a..4af0308 100644 --- a/R/NAO.R +++ b/R/NAO.R @@ -3,9 +3,9 @@ #'Compute the North Atlantic Oscillation (NAO) index based on the leading EOF #'of the sea level pressure (SLP) anomalies over the north Atlantic region #'(20N-80N, 80W-40E). The PCs are obtained by projecting the forecast and -#'observed anomalies onto the observed EOF pattern (Pobs) or the forecast -#'anomalies onto the EOF pattern of the other years of the forecast (Pmod). -#'By default (ftime_avg = 2:4) NAO() computes the NAO index for 1-month +#'observed anomalies onto the observed EOF pattern or the forecast +#'anomalies onto the EOF pattern of the other years of the forecast. +#'By default (ftime_avg = 2:4), NAO() computes the NAO index for 1-month #'lead seasonal forecasts that can be plotted with PlotBoxWhisker(). It returns #'cross-validated PCs of the NAO index for forecast (exp) and observations #'(obs) based on the leading EOF pattern. @@ -17,7 +17,7 @@ #' be left to NULL. The default value is NULL. #'@param obs A named numeric array of North Atlantic SLP (20N-80N, 80W-40E) #' observed anomalies from \code{Ano()} or \code{Ano_CrossValid()} with -#' dimensions 'time_dim', 'memb_dim', 'ftime_dim', and 'space_dim' at least. +#' dimensions 'time_dim', 'ftime_dim', and 'space_dim' at least. #' If only NAO of experimental data needs to be computed, this parameter can #' be left to NULL. The default value is NULL. #'@param lat A vector of the latitudes of 'exp' and 'obs'. @@ -25,7 +25,8 @@ #'@param time_dim A character string indicating the name of the time dimension #' of 'exp' and 'obs'. The default value is 'sdate'. #'@param memb_dim A character string indicating the name of the member -#' dimension of 'exp' and 'obs'. The default value is 'member'. +#' dimension of 'exp' (and 'obs', optional). If 'obs' has memb_dim, the length +#' must be 1. The default value is 'member'. #'@param space_dim A vector of two character strings. The first is the dimension #' name of latitude of 'ano' and the second is the dimension name of longitude #' of 'ano'. The default value is c('lat', 'lon'). @@ -61,29 +62,16 @@ #' DOI: 10.1007/s00382-003-0350-4 #' #'@examples -#' \dontshow{ -#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') -#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), -#' c('observation'), startDates, -#' leadtimemin = 1, -#' leadtimemax = 4, -#' output = 'lonlat', -#' latmin = 27, latmax = 48, -#' lonmin = -12, lonmax = 40) -#'# No example data is available over NAO region, so in this example we will -#'# tweak the available data. In a real use case, one can Load() the data over -#'# the NAO region directly. -#'sampleData$lon[] <- c(40, 280, 340) -#'sampleData$lat[] <- c(20, 80) -#' } +#'# Make up synthetic data +#'set.seed(1) +#'exp <- array(rnorm(1620), dim = c(member = 2, sdate = 3, ftime = 5, lat = 6, lon = 9)) +#'set.seed(2) +#'obs <- array(rnorm(1620), dim = c(member = 1, sdate = 3, ftime = 5, lat = 6, lon = 9)) +#'lat <- seq(20, 80, length.out = 6) +#'lon <- seq(-80, 40, length.out = 9) +#'nao <- NAO(exp = exp, obs = obs, lat = lat, lon = lon) #' -#'# Now ready to compute the EOFs and project on, for example, the first -#'# variability mode. -#'ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) -#'# Note that computing the NAO over the region for which there is available -#'# example data is not the full NAO area: NAO() will raise a warning. -#'nao <- NAO(ano$exp, ano$obs, sampleData$lat, sampleData$lon) -#'# Finally plot the NAO index +#'# plot the NAO index #' \dontrun{ #'nao$exp <- Reorder(nao$exp, c(2, 1)) #'nao$obs <- Reorder(nao$obs, c(2, 1)) @@ -109,7 +97,7 @@ NAO <- function(exp = NULL, obs = NULL, lat, lon, time_dim = 'sdate', stop("Parameter 'exp' must be a numeric array.") } if (is.null(dim(exp))) { - stop(paste0("Parameter 'exp' and must have at least dimensions ", + stop(paste0("Parameter 'exp' must have at least dimensions ", "time_dim, memb_dim, space_dim, and ftime_dim.")) } if(any(is.null(names(dim(exp)))) | any(nchar(names(dim(exp))) == 0)) { @@ -121,8 +109,8 @@ NAO <- function(exp = NULL, obs = NULL, lat, lon, time_dim = 'sdate', stop("Parameter 'obs' must be a numeric array.") } if (is.null(dim(obs))) { - stop(paste0("Parameter 'obs' and must have at least dimensions ", - "time_dim, memb_dim, space_dim, and ftime_dim.")) + stop(paste0("Parameter 'obs' must have at least dimensions ", + "time_dim, space_dim, and ftime_dim.")) } if(any(is.null(names(dim(obs)))) | any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'obs' must have dimension names.") @@ -148,12 +136,19 @@ NAO <- function(exp = NULL, obs = NULL, lat, lon, time_dim = 'sdate', } if (!is.null(exp)) { if (!memb_dim %in% names(dim(exp))) { - stop("Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension.") + stop("Parameter 'memb_dim' is not found in 'exp' dimension.") } } if (!is.null(obs)) { - if (!memb_dim %in% names(dim(obs))) { - stop("Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension.") + if (memb_dim %in% names(dim(obs))) { + if (dim(obs)[memb_dim] != 1) { + stop("The length of parameter 'memb_dim' in 'obs' must be 1.") + } else { + add_member_back <- TRUE + obs <- ClimProjDiags::Subset(obs, memb_dim, 1, drop = 'selected') + } + } else { + add_member_back <- FALSE } } ## space_dim @@ -189,10 +184,17 @@ NAO <- function(exp = NULL, obs = NULL, lat, lon, time_dim = 'sdate', name_exp <- sort(names(dim(exp))) name_obs <- sort(names(dim(obs))) 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])) { - stop(paste0("Parameter 'exp' and 'obs' must have the same length of ", - "all dimensions except 'memb_dim'.")) + throw_error <- FALSE + if (length(name_exp) != length(name_obs)) { + throw_error <- TRUE + } else if (any(name_exp != name_obs)) { + throw_error <- TRUE + } else if(!all(dim(exp)[name_exp] == dim(obs)[name_obs])) { + throw_error <- TRUE + } + if (throw_error) { + stop(paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", + "of all the dimensions expect 'memb_dim'.")) } } ## ftime_avg @@ -239,8 +241,7 @@ NAO <- function(exp = NULL, obs = NULL, lat, lon, time_dim = 'sdate', } } stop_needed <- FALSE - if (tail(lat, 1) < 70 | tail(lat, 1) > 90 | - head(lat, 1) > 30 | head(lat, 1) < 10) { + if (max(lat) > 80 | min(lat) < 20) { stop_needed <- TRUE } #NOTE: different from s2dverification @@ -286,122 +287,128 @@ NAO <- function(exp = NULL, obs = NULL, lat, lon, time_dim = 'sdate', } } - #-------- Average ftime ----------- + # Average ftime if (!is.null(exp)) { exp_sub <- ClimProjDiags::Subset(exp, ftime_dim, ftime_avg, drop = FALSE) exp <- MeanDims(exp_sub, ftime_dim, na.rm = TRUE) ## Cross-validated PCs. Fabian. This should be extended to ## nmod and nlt by simple loops. Virginie } - if (!is.null(obs)) { obs_sub <- ClimProjDiags::Subset(obs, ftime_dim, ftime_avg, drop = FALSE) obs <- MeanDims(obs_sub, ftime_dim, na.rm = TRUE) } + # wght + wght <- array(sqrt(cos(lat * pi/180)), dim = c(length(lat), length(lon))) + if (!is.null(exp) & !is.null(obs)) { res <- Apply(list(exp, obs), target_dims = list(exp = c(memb_dim, time_dim, space_dim), - obs = c(memb_dim, time_dim, space_dim)), + obs = c(time_dim, space_dim)), fun = .NAO, - obsproj = obsproj, lat = lat, lon = lon, + obsproj = obsproj, wght = wght, add_member_back = add_member_back, ncores = ncores) } else if (!is.null(exp)) { res <- Apply(list(exp = exp), target_dims = list(exp = c(memb_dim, time_dim, space_dim)), fun = .NAO, - obsproj = obsproj, lat = lat, lon = lon, obs = NULL, + obsproj = obsproj, wght = wght, obs = NULL, add_member_back = FALSE, ncores = ncores) } else if (!is.null(obs)) { + if (add_member_back) { + output_dims <- list(obs = c(time_dim, memb_dim)) + } else { + output_dims <- list(obs = time_dim) + } res <- Apply(list(obs = obs), - target_dims = list(obs = c(memb_dim, time_dim, space_dim)), + target_dims = list(obs = c(time_dim, space_dim)), + output_dims = output_dims, fun = .NAO, - obsproj = obsproj, lat = lat, lon = lon, exp = NULL, + obsproj = obsproj, wght = wght, exp = NULL, add_member_back = add_member_back, ncores = ncores) } return(res) } -.NAO <- function(exp = NULL, obs = NULL, lat, lon, - obsproj = TRUE, ncores = NULL) { +.NAO <- function(exp = NULL, obs = NULL, wght, obsproj = TRUE, add_member_back = FALSE) { # exp: [memb_exp, sdate, lat, lon] - # obs: [memb_obs, sdate, lat, lon] + # obs: [sdate, lat, lon] + # wght: [lat, lon] + if (!is.null(exp)) { ntime <- dim(exp)[2] nlat <- dim(exp)[3] nlon <- dim(exp)[4] nmemb_exp <- dim(exp)[1] - nmemb_obs <- dim(obs)[1] } else { - ntime <- dim(obs)[2] - nlat <- dim(obs)[3] - nlon <- dim(obs)[4] - nmemb_obs <- dim(obs)[1] + ntime <- dim(obs)[1] + nlat <- dim(obs)[2] + nlon <- dim(obs)[3] } - if (!is.null(obs)) NAOO.ver <- array(NA, dim = c(ntime, nmemb_obs)) + if (!is.null(obs)) NAOO.ver <- array(NA, dim = ntime) if (!is.null(exp)) NAOF.ver <- array(NA, dim = c(ntime, nmemb_exp)) for (tt in 1:ntime) { #sdate if (!is.null(obs)) { - ## Observed EOF excluding one forecast start year. - obs_sub <- ClimProjDiags::Subset(obs, 2, c(1:ntime)[-tt], drop = FALSE) - obs_EOF <- EOF(obs_sub, lat = lat, lon = lon, time_dim = names(ntime), - space_dim = c(names(nlat), names(nlon)), neofs = 1) + ## Calculate observation EOF. Excluding one forecast start year. + obs_sub <- obs[c(1:ntime)[-tt], , , drop = FALSE] + obs_EOF <- .EOF(obs_sub, neofs = 1, wght = wght) # $EOFs: [mode, lat, lon] ## Correct polarity of pattern. - #NOTE: different from s2dverification - # dim(obs_EOF$EOFs): [mode, lat, lon, member] - for (imemb in 1:nmemb_obs) { - if (0 < mean(obs_EOF$EOFs[1, which.min(abs(lat - 65)), , ], na.rm = T)) { - obs_EOF$EOFs[1, , , imemb] <- obs_EOF$EOFs[1, , , imemb] * (-1) - } + # dim(obs_EOF$EOFs): [mode, lat, lon] + if (0 < mean(obs_EOF$EOFs[1, which.min(abs(lat - 65)), ], na.rm = T)) { + obs_EOF$EOFs <- obs_EOF$EOFs * (-1) +# obs_EOF$PCs <- obs_EOF$PCs * (-1) # not used } -# obs_EOF$PCs <- obs_EOF$PCs * sign # not used - ## Project observed anomalies. - PF <- ProjectField(obs, eof = obs_EOF, time_dim = names(ntime), - space_dim = c(names(nlat), names(nlon)), mode = 1) - NAOO.ver[tt, ] <- PF[tt, ] + PF <- .ProjectField(obs, eof_mode = obs_EOF$EOFs[1, , ], wght = wght) # [sdate] ## Keep PCs of excluded forecast start year. Fabian. + NAOO.ver[tt] <- PF[tt] } if (!is.null(exp)) { if (!obsproj) { - exp_sub <- ClimProjDiags::Subset(exp, 2, c(1:ntime)[-tt], drop = FALSE) - #NOTE: different from s2dverification. Here, 'member' is considered. - exp_EOF <- EOF(exp_sub, lat = lat, lon = lon, time_dim = names(ntime), - space_dim = c(names(nlat), names(nlon)), neofs = 1) + exp_sub <- exp[, c(1:ntime)[-tt], , , drop = FALSE] + # Combine 'memb' and 'sdate' to calculate EOF + dim(exp_sub) <- c(nmemb_exp * (ntime - 1), nlat, nlon) + exp_EOF <- .EOF(exp_sub, neofs = 1, wght = wght) # $EOFs: [mode, lat, lon] ## Correct polarity of pattern. - #NOTE: different from s2dverification - for (imemb in 1:nmemb_exp) { - if (0 < mean(exp_EOF$EOFs[1, which.min(abs(lat - 65)), , imemb], na.rm = T)) { - exp_EOF$EOFs[1, , , imemb] <- exp_EOF$EOFs[1, , , imemb] * (-1) - } + ##NOTE: different from s2dverification, which doesn't use mean(). +# if (0 < exp_EOF$EOFs[1, which.min(abs(lat - 65)), ]) { + if (0 < mean(exp_EOF$EOFs[1, which.min(abs(lat - 65)), ], na.rm = T)) { + exp_EOF$EOFs <- exp_EOF$EOFs * (-1) +# exp_EOF$PCs <- exp_EOF$PCs * sign # not used } -# exp_EOF$PCs <- exp_EOF$PCs * sign # not used ### Lines below could be simplified further by computing ### ProjectField() only on the year of interest... (though this is ### not vital). Lauriane - PF <- ProjectField(exp, eof = exp_EOF, time_dim = names(ntime), - space_dim = c(names(nlat), names(nlon)), mode = 1) - NAOF.ver[tt, ] <- PF[tt, ] - + for (imemb in 1:nmemb_exp) { + PF <- .ProjectField(exp[imemb, , , ], eof_mode = exp_EOF$EOFs[1, , ], wght = wght) # [sdate, memb] + NAOF.ver[tt, imemb] <- PF[tt] + } } else { - ## Project forecast anomalies on obs EOF - #NOTE: Because obs and exp have different nmemb, do ensemble mean to - # obs_EOF$EOFs first, then expand the memb dim to be the same as exp. - obs_EOF$EOFs <- apply(obs_EOF$EOFs, c(1, 2, 3), mean, na.rm = T) - obs_EOF$EOFs <- array(obs_EOF$EOFs, dim = c(dim(obs_EOF$EOFs), as.numeric(nmemb_exp))) - names(dim(obs_EOF$EOFs))[4] <- names(nmemb_obs) - PF <- ProjectField(exp, obs_EOF, mode = 1) - NAOF.ver[tt, ] <- PF[tt, ] + ## Project forecast anomalies on obs EOF + for (imemb in 1:nmemb_exp) { + PF <- .ProjectField(exp[imemb, , , ], eof_mode = obs_EOF$EOFs[1, , ], wght = wght) # [sdate] + NAOF.ver[tt, imemb] <- PF[tt] + } } } + + } # for loop sdate + + # add_member_back + if (add_member_back) { + suppressWarnings( + NAOO.ver <- InsertDim(NAOO.ver, 2, 1, name = names(dim(exp))[1]) + ) } + #NOTE: EOFs_obs is not returned because it's only the result of the last sdate # (It is returned in s2dverification.) if (!is.null(exp) & !is.null(obs)) { diff --git a/R/ProjectField.R b/R/ProjectField.R index 2e9d26f..b6e2cd1 100644 --- a/R/ProjectField.R +++ b/R/ProjectField.R @@ -140,7 +140,7 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon if (all(names(dim(eof_mode)) %in% space_dim)) { # eof_mode: [lat, lon] res <- Apply(list(ano), - target_dims = list(c(space_dim, time_dim)), + target_dims = list(c(time_dim, space_dim)), output_dims = time_dim, eof_mode = eof_mode, wght = eof$wght, @@ -169,9 +169,8 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon lendim = additional_dims[i], name = names(additional_dims)[i]) } } - res <- Apply(list(ano, eof_mode), - target_dims = list(c(space_dim, time_dim), + target_dims = list(c(time_dim, space_dim), c(space_dim)), output_dims = time_dim, wght = eof$wght, @@ -184,22 +183,22 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon .ProjectField <- function(ano, eof_mode, wght) { - # ano: [lat, lon, sdate] + # ano: [sdate, lat, lon] # eof_mode: [lat, lon] # wght: [lat, lon] - dim_time <- dim(ano)[3] + ntime <- dim(ano)[1] # Initialization of pc.ver. - pc.ver <- array(NA, dim = dim_time) #[sdate] + pc.ver <- array(NA, dim = ntime) #[sdate] - # Weigths + # Weight e.1 <- eof_mode * wght - ano <- ano * InsertDim(wght, 3, dim_time) + ano <- ano * InsertDim(wght, 1, ntime) - na <- apply(ano, 3, mean, na.rm = TRUE) # if [lat, lon] all NA, it's NA - tmp <- ano * InsertDim(e.1, 3, dim_time) # [lat, lon, sdate] - pc.ver <- apply(tmp, 3, sum, na.rm = TRUE) + na <- apply(ano, 1, mean, na.rm = TRUE) # if [lat, lon] all NA, it's NA + tmp <- ano * InsertDim(e.1, 1, ntime) # [sdate, lat, lon] + pc.ver <- apply(tmp, 1, sum, na.rm = TRUE) pc.ver[which(is.na(na))] <- NA return(pc.ver) diff --git a/man/NAO.Rd b/man/NAO.Rd index c61a5ac..64b1656 100644 --- a/man/NAO.Rd +++ b/man/NAO.Rd @@ -27,7 +27,7 @@ be left to NULL. The default value is NULL.} \item{obs}{A named numeric array of North Atlantic SLP (20N-80N, 80W-40E) observed anomalies from \code{Ano()} or \code{Ano_CrossValid()} with -dimensions 'time_dim', 'memb_dim', 'ftime_dim', and 'space_dim' at least. +dimensions 'time_dim', 'ftime_dim', and 'space_dim' at least. If only NAO of experimental data needs to be computed, this parameter can be left to NULL. The default value is NULL.} @@ -39,7 +39,8 @@ be left to NULL. The default value is NULL.} of 'exp' and 'obs'. The default value is 'sdate'.} \item{memb_dim}{A character string indicating the name of the member -dimension of 'exp' and 'obs'. The default value is 'member'.} +dimension of 'exp' (and 'obs', optional). If 'obs' has memb_dim, the length +must be 1. The default value is 'member'.} \item{space_dim}{A vector of two character strings. The first is the dimension name of latitude of 'ano' and the second is the dimension name of longitude @@ -77,37 +78,24 @@ A list which contains: Compute the North Atlantic Oscillation (NAO) index based on the leading EOF of the sea level pressure (SLP) anomalies over the north Atlantic region (20N-80N, 80W-40E). The PCs are obtained by projecting the forecast and -observed anomalies onto the observed EOF pattern (Pobs) or the forecast -anomalies onto the EOF pattern of the other years of the forecast (Pmod). -By default (ftime_avg = 2:4) NAO() computes the NAO index for 1-month +observed anomalies onto the observed EOF pattern or the forecast +anomalies onto the EOF pattern of the other years of the forecast. +By default (ftime_avg = 2:4), NAO() computes the NAO index for 1-month lead seasonal forecasts that can be plotted with PlotBoxWhisker(). It returns cross-validated PCs of the NAO index for forecast (exp) and observations (obs) based on the leading EOF pattern. } \examples{ - \dontshow{ -startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') -sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), - c('observation'), startDates, - leadtimemin = 1, - leadtimemax = 4, - output = 'lonlat', - latmin = 27, latmax = 48, - lonmin = -12, lonmax = 40) -# No example data is available over NAO region, so in this example we will -# tweak the available data. In a real use case, one can Load() the data over -# the NAO region directly. -sampleData$lon[] <- c(40, 280, 340) -sampleData$lat[] <- c(20, 80) - } +# Make up synthetic data +set.seed(1) +exp <- array(rnorm(1620), dim = c(member = 2, sdate = 3, ftime = 5, lat = 6, lon = 9)) +set.seed(2) +obs <- array(rnorm(1620), dim = c(member = 1, sdate = 3, ftime = 5, lat = 6, lon = 9)) +lat <- seq(20, 80, length.out = 6) +lon <- seq(-80, 40, length.out = 9) +nao <- NAO(exp = exp, obs = obs, lat = lat, lon = lon) -# Now ready to compute the EOFs and project on, for example, the first -# variability mode. -ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) -# Note that computing the NAO over the region for which there is available -# example data is not the full NAO area: NAO() will raise a warning. -nao <- NAO(ano$exp, ano$obs, sampleData$lat, sampleData$lon) -# Finally plot the NAO index +# plot the NAO index \dontrun{ nao$exp <- Reorder(nao$exp, c(2, 1)) nao$obs <- Reorder(nao$obs, c(2, 1)) diff --git a/tests/testthat/test-NAO.R b/tests/testthat/test-NAO.R index d0acbd5..f3c6d21 100644 --- a/tests/testthat/test-NAO.R +++ b/tests/testthat/test-NAO.R @@ -3,18 +3,18 @@ context("s2dv::NAO tests") ############################################## # dat1 set.seed(1) - exp1 <- array(rnorm(144), dim = c(member = 2, sdate = 3, ftime = 4, lat = 2, lon = 3)) + exp1 <- array(rnorm(144), dim = c(dataset = 1, member = 2, sdate = 3, ftime = 4, lat = 2, lon = 3)) set.seed(2) - obs1 <- array(rnorm(72), dim = c(member = 1, sdate = 3, ftime = 4, lat = 2, lon = 3)) + obs1 <- array(rnorm(72), dim = c(dataset = 1, member = 1, sdate = 3, ftime = 4, lat = 2, lon = 3)) lat1 <- c(20, 80) lon1 <- c(40, 280, 350) # dat2 set.seed(1) - exp2 <- array(rnorm(144), dim = c(sdate = 3, ftime = 4, member = 2, lat = 2, lon = 3)) + exp2 <- array(rnorm(216), dim = c(sdate = 3, ftime = 4, member = 2, lat = 3, lon = 3)) set.seed(2) - obs2 <- array(rnorm(144), dim = c(member = 2, sdate = 3, ftime = 4, lat = 2, lon = 3)) - lat2 <- c(20, 80) + obs2 <- array(rnorm(108), dim = c(sdate = 3, ftime = 4, lat = 3, lon = 3)) + lat2 <- c(80, 50, 20) lon2 <- c(-80, 0, 40) ############################################## @@ -31,7 +31,7 @@ test_that("1. Input checks", { ) expect_error( NAO(exp = c(1:10)), - paste0("Parameter 'exp' and must have at least dimensions ", + paste0("Parameter 'exp' must have at least dimensions ", "time_dim, memb_dim, space_dim, and ftime_dim.") ) expect_error( @@ -44,8 +44,8 @@ test_that("1. Input checks", { ) expect_error( NAO(exp = exp1, obs = c(1:10)), - paste0("Parameter 'obs' and must have at least dimensions ", - "time_dim, memb_dim, space_dim, and ftime_dim.") + paste0("Parameter 'obs' must have at least dimensions ", + "time_dim, space_dim, and ftime_dim.") ) expect_error( NAO(exp = exp1, obs = array(1:10, dim = c(2, 5))), @@ -65,9 +65,13 @@ test_that("1. Input checks", { NAO(exp1, obs1, memb_dim = 2), "Parameter 'memb_dim' must be a character string." ) + expect_error( + NAO(exp1, array(rnorm(10), dim = c(member = 10, sdate = 3, ftime = 4, lat = 2, lon = 2))), + "The length of parameter 'memb_dim' in 'obs' must be 1." + ) expect_error( NAO(exp1, obs1, memb_dim = 'a'), - "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." + "Parameter 'memb_dim' is not found in 'exp' dimension." ) # space_dim expect_error( @@ -89,9 +93,14 @@ test_that("1. Input checks", { ) # exp and obs (2) expect_error( - NAO(exp1, array(rnorm(10), dim = c(member = 10, sdate = 3, ftime = 4, lat = 2, lon = 2))), - paste0("Parameter 'exp' and 'obs' must have the same length of ", - "all dimensions except 'memb_dim'.") + NAO(exp1, array(rnorm(10), dim = c(member = 1, sdate = 3, ftime = 4, lat = 2, lon = 2))), + paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", + "of all the dimensions expect 'memb_dim'.") + ) + expect_error( + NAO(exp1, array(rnorm(10), dim = c(dataset = 1, member = 1, sdate = 3, ftime = 4, lat = 1, lon = 2))), + paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", + "of all the dimensions expect 'memb_dim'.") ) # ftime_avg expect_error( @@ -105,7 +114,7 @@ test_that("1. Input checks", { # sdate >= 2 expect_error( NAO(exp = array(rnorm(10), dim = c(member = 10, sdate = 1, ftime = 4, lat = 2, lon = 2)), - obs = array(rnorm(10), dim = c(member = 10, sdate = 1, ftime = 4, lat = 2, lon = 2))), + obs = array(rnorm(10), dim = c(member = 1, sdate = 1, ftime = 4, lat = 2, lon = 2))), "The length of time_dim must be at least 2." ) # lat and lon @@ -159,11 +168,11 @@ test_that("2. dat1", { ) expect_equal( dim(NAO(exp1, obs1, lat = lat1, lon = lon1)$exp), - c(sdate = 3, member = 2) + c(sdate = 3, member = 2, dataset = 1) ) expect_equal( dim(NAO(exp1, obs1, lat = lat1, lon = lon1)$obs), - c(sdate = 3, member = 1) + c(sdate = 3, member = 1, dataset = 1) ) expect_equal( NAO(exp1, obs1, lat = lat1, lon = lon1)$exp[1:5], @@ -177,7 +186,7 @@ test_that("2. dat1", { ) expect_equal( mean(NAO(exp1, obs1, lat = lat1, lon = lon1, obsproj = FALSE)$exp), - -0.1362706, + -0.2263239, tolerance = 0.0001 ) expect_equal( @@ -190,6 +199,15 @@ test_that("2. dat1", { c("obs") ) ) + expect_equal( + dim(NAO(obs = obs1, lat = lat1, lon = lon1, obsproj = FALSE)$obs), + c(sdate = 3, member = 1, dataset = 1) + ) + expect_equal( + as.vector(NAO(obs = obs1, lat = lat1, lon = lon1, obsproj = FALSE)$obs), + c(-0.1139683, 0.1056687, 0.1889449), + tolerance = 0.0001 + ) }) ############################################## @@ -200,23 +218,29 @@ test_that("3. dat2", { ) expect_equal( dim(NAO(exp2, obs2, lat = lat2, lon = lon2)$obs), - c(sdate = 3, member = 2) + c(sdate = 3) ) expect_equal( mean(NAO(exp2, obs2, lat = lat2, lon = lon2)$exp), - -0.01566486, + 0.006805087, tolerance = 0.00001 ) expect_equal( NAO(exp2, obs2, lat = lat2, lon = lon2)$exp[2:4], - c(0.16231137, -0.10984650, -0.01871716), + c(0.07420822, 0.09383927, -0.17372708), tolerance = 0.00001 ) expect_equal( NAO(exp2, obs2, lat = lat2, lon = lon2, ftime_avg = 1:3)$exp[2:4], - c(-0.30102528, -0.06366782, 0.01639220), + c(0.01652294, -0.63365859, -0.74297551), tolerance = 0.00001 ) + expect_equal( + as.vector(NAO(exp = exp2, lat = lat2, lon = lon2, obsproj = FALSE)$exp), + c(-0.3529993, 0.4702901, 0.2185340, 0.1525028, 0.3759627, -0.4451322), + tolerance = 0.00001 + ) + }) ############################################## diff --git a/tests/testthat/test-ProjectField.R b/tests/testthat/test-ProjectField.R index 3cf14d2..1ba0042 100644 --- a/tests/testthat/test-ProjectField.R +++ b/tests/testthat/test-ProjectField.R @@ -6,14 +6,14 @@ context("s2dv::ProjectField tests") dat1 <- array(rnorm(120), dim = c(sdate = 10, lat = 6, lon = 2)) lat1 <- seq(10, 30, length.out = 6) lon1 <- c(10, 12) - eof1 <- EOF(dat1, lat1, lon1) + eof1 <- EOF(dat1, lat1, lon1, neofs = 10) # dat2 set.seed(1) dat2 <- array(rnorm(48), dim = c(dat = 1, memb = 1, sdate = 6, ftime = 1, lat = 4, lon = 2)) lat2 <- seq(10, 30, length.out = 4) lon2 <- c(-5, 5) - eof2 <- EOF(dat2, lat2, lon2) + eof2 <- EOF(dat2, lat2, lon2, neofs = 6) # dat3 dat3 <- dat2 @@ -21,7 +21,7 @@ context("s2dv::ProjectField tests") names(dim(dat3)) <- names(dim(dat2)) lat3 <- seq(10, 30, length.out = 4) lon3 <- c(-5, 5) - eof3 <- EOF(dat3, lat3, lon3) + eof3 <- EOF(dat3, lat3, lon3, neofs = 6) # dat4 set.seed(1) @@ -30,7 +30,7 @@ context("s2dv::ProjectField tests") lon4 <- c(350, 355) set.seed(2) tmp <- array(rnorm(144), dim = c(dat = 2, sdate = 6, lat = 4, lon = 2)) - eof4 <- EOF(tmp, lat4, lon4) + eof4 <- EOF(tmp, lat4, lon4, neofs = 6) # dat5 set.seed(1) @@ -39,7 +39,7 @@ context("s2dv::ProjectField tests") lon5 <- c(0, 5, 10) set.seed(2) tmp <- array(rnorm(72), dim = c(sdate = 6, lat = 4, lon = 3)) - eof5 <- EOF(tmp, lat5, lon5) + eof5 <- EOF(tmp, lat5, lon5, neofs = 6) ############################################## test_that("1. Input checks", { -- GitLab From 255eac41c7ef9493adbadf4436655ec67eb98dbf Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 17 May 2021 12:25:52 +0200 Subject: [PATCH 112/154] Allow 'mode' to be NULL --- R/ProjectField.R | 117 ++++++++++++++++++++--------- man/ProjectField.Rd | 9 ++- tests/testthat/test-ProjectField.R | 54 ++++++++----- 3 files changed, 125 insertions(+), 55 deletions(-) diff --git a/R/ProjectField.R b/R/ProjectField.R index b6e2cd1..2643f45 100644 --- a/R/ProjectField.R +++ b/R/ProjectField.R @@ -17,7 +17,8 @@ #' name of latitude of 'ano' and the second is the dimension name of longitude #' of 'ano'. The default value is c('lat', 'lon'). #'@param mode An integer of the variability mode number in the EOF to be -#' projected on. The default value is 1. +#' projected on. The default value is NULL, which means all the modes of 'eof' +#' is calculated. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -39,8 +40,8 @@ #'ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) #'eof_exp <- EOF(ano$exp, sampleData$lat, sampleData$lon) #'eof_obs <- EOF(ano$obs, sampleData$lat, sampleData$lon) -#'mode1_exp <- ProjectField(ano$exp, eof_exp) -#'mode1_obs <- ProjectField(ano$obs, eof_obs) +#'mode1_exp <- ProjectField(ano$exp, eof_exp, mode = 1) +#'mode1_obs <- ProjectField(ano$obs, eof_obs, mode = 1) #' #'\dontrun{ #' # Plot the forecast and the observation of the first mode for the last year @@ -58,7 +59,7 @@ #'@import multiApply #'@export ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon'), - mode = 1, ncores = NULL) { + mode = NULL, ncores = NULL) { # Check inputs ## ano (1) @@ -117,12 +118,14 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon "with dimensions named as parameter 'space_dim'.")) } ## mode - if (!is.numeric(mode) | mode %% 1 != 0 | mode < 0 | length(mode) > 1) { - stop("Parameter 'mode' must be a positive integer.") - } - if (mode > dim(eof$EOFs)['mode']) { - stop(paste0("Parameter 'mode' is greater than the number of available ", - "modes in EOF.")) + if (!is.null(mode)) { + if (!is.numeric(mode) | mode %% 1 != 0 | mode < 0 | length(mode) > 1) { + stop("Parameter 'mode' must be NULL or a positive integer.") + } + if (mode > dim(eof$EOFs)['mode']) { + stop(paste0("Parameter 'mode' is greater than the number of available ", + "modes in EOF.")) + } } ## ncores if (!is.null(ncores)) { @@ -135,28 +138,46 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon #------------------------------------------------------- # Keep the chosen mode - eof_mode <- Subset(eof$EOFs, 'mode', mode, drop = 'selected') + if (!is.null(mode)) { + eof_mode <- ClimProjDiags::Subset(eof$EOFs, 'mode', mode, drop = 'selected') + } else { + eof_mode <- eof$EOFs + } - if (all(names(dim(eof_mode)) %in% space_dim)) { # eof_mode: [lat, lon] + if ('mode' %in% names(dim(eof_mode))) { + dimnames_without_mode <- names(dim(eof_mode))[-which(names(dim(eof_mode)) == 'mode')] + } else { + dimnames_without_mode <- names(dim(eof_mode)) + } - res <- Apply(list(ano), - target_dims = list(c(time_dim, space_dim)), - output_dims = time_dim, - eof_mode = eof_mode, + if (all(dimnames_without_mode %in% space_dim)) { # eof_mode: [lat, lon] or [mode, lat, lon] + if ('mode' %in% names(dim(eof_mode))) { + eof_mode_target <- c('mode', space_dim) + output_dims <- c('mode', time_dim) + } else { + eof_mode_target <- space_dim + output_dims <- time_dim + } + res <- Apply(list(ano, eof_mode), + target_dims = list(c(time_dim, space_dim), + eof_mode_target), + output_dims = output_dims, wght = eof$wght, fun = .ProjectField, ncores = ncores)$output1 } else { - if (!all(names(dim(eof_mode)) %in% names(dim(ano)))) { + + if (!all(dimnames_without_mode %in% names(dim(ano)))) { stop(paste0("The array 'EOF' in parameter 'eof' has dimension not in parameter ", "'ano'. Check if 'ano' and 'eof' are compatible.")) } - common_dim_ano <- dim(ano)[which(names(dim(ano)) %in% names(dim(eof_mode)))] - if (any(sort(common_dim_ano) != sort(dim(eof_mode)))) { - stop(paste0("Found paramter 'ano' and 'EOF' in parameter 'eof' have different ", - "common dimensions. Check if 'ano' and 'eof' are compatible.")) + common_dim_ano <- dim(ano)[which(names(dim(ano)) %in% dimnames_without_mode)] + if (any(common_dim_ano[match(dimnames_without_mode, names(common_dim_ano))] != + dim(eof_mode)[dimnames_without_mode])) { + stop(paste0("Found paramter 'ano' and 'EOF' in parameter 'eof' have common dimensions ", + "with different length. Check if 'ano' and 'eof' are compatible.")) } # Enlarge eof/ano is needed. The margin_dims of Apply() must be consistent @@ -169,10 +190,17 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon lendim = additional_dims[i], name = names(additional_dims)[i]) } } + if ('mode' %in% names(dim(eof_mode))) { + eof_mode_target <- c('mode', space_dim) + output_dims <- c('mode', time_dim) + } else { + eof_mode_target <- space_dim + output_dims <- time_dim + } res <- Apply(list(ano, eof_mode), target_dims = list(c(time_dim, space_dim), - c(space_dim)), - output_dims = time_dim, + eof_mode_target), + output_dims = output_dims, wght = eof$wght, fun = .ProjectField, ncores = ncores)$output1 @@ -184,22 +212,43 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon .ProjectField <- function(ano, eof_mode, wght) { # ano: [sdate, lat, lon] - # eof_mode: [lat, lon] + # eof_mode: [lat, lon] or [mode, lat, lon] # wght: [lat, lon] ntime <- dim(ano)[1] - # Initialization of pc.ver. - pc.ver <- array(NA, dim = ntime) #[sdate] + if (length(dim(eof_mode)) == 2) { # mode != NULL + # Initialization of pc.ver. + pc.ver <- array(NA, dim = ntime) #[sdate] - # Weight - e.1 <- eof_mode * wght - ano <- ano * InsertDim(wght, 1, ntime) - - na <- apply(ano, 1, mean, na.rm = TRUE) # if [lat, lon] all NA, it's NA - tmp <- ano * InsertDim(e.1, 1, ntime) # [sdate, lat, lon] - pc.ver <- apply(tmp, 1, sum, na.rm = TRUE) - pc.ver[which(is.na(na))] <- NA + # Weight + e.1 <- eof_mode * wght + ano <- ano * InsertDim(wght, 1, ntime) + + na <- apply(ano, 1, mean, na.rm = TRUE) # if [lat, lon] all NA, it's NA + tmp <- ano * InsertDim(e.1, 1, ntime) # [sdate, lat, lon] + pc.ver <- apply(tmp, 1, sum, na.rm = TRUE) + pc.ver[which(is.na(na))] <- NA + + } else { # mode = NULL + # Weight + e.1 <- eof_mode * InsertDim(wght, 1, dim(eof_mode)[1]) + dim(e.1) <- c(dim(eof_mode)[1], prod(dim(eof_mode)[2:3])) # [mode, lat*lon] + ano <- ano * InsertDim(wght, 1, ntime) + dim(ano) <- c(ntime, prod(dim(ano)[2:3])) # [sdate, lat*lon] + + na <- apply(ano, 1, mean, na.rm = TRUE) # if [lat, lon] all NA, it's NA + na <- aperm(array(na, dim = c(ntime, dim(e.1)[1])), c(2, 1)) + + # Matrix multiplication e.1 [mode, lat*lon] by ano [lat*lon, sdate] + # Result: [mode, sdate] + pc.ver <- e.1 %*% t(ano) + pc.ver[which(is.na(na))] <- NA + +# # Change back dimensions to feet original input +# dim(projection) <- c(moredims, mode = unname(neofs)) +# return(projection) + } return(pc.ver) } diff --git a/man/ProjectField.Rd b/man/ProjectField.Rd index 97353ff..2abeca0 100644 --- a/man/ProjectField.Rd +++ b/man/ProjectField.Rd @@ -9,7 +9,7 @@ ProjectField( eof, time_dim = "sdate", space_dim = c("lat", "lon"), - mode = 1, + mode = NULL, ncores = NULL ) } @@ -30,7 +30,8 @@ name of latitude of 'ano' and the second is the dimension name of longitude of 'ano'. The default value is c('lat', 'lon').} \item{mode}{An integer of the variability mode number in the EOF to be -projected on. The default value is 1.} +projected on. The default value is NULL, which means all the modes of 'eof' +is calculated.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} @@ -59,8 +60,8 @@ sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), ano <- Ano_CrossValid(sampleData$mod, sampleData$obs) eof_exp <- EOF(ano$exp, sampleData$lat, sampleData$lon) eof_obs <- EOF(ano$obs, sampleData$lat, sampleData$lon) -mode1_exp <- ProjectField(ano$exp, eof_exp) -mode1_obs <- ProjectField(ano$obs, eof_obs) +mode1_exp <- ProjectField(ano$exp, eof_exp, mode = 1) +mode1_obs <- ProjectField(ano$obs, eof_obs, mode = 1) \dontrun{ # Plot the forecast and the observation of the first mode for the last year diff --git a/tests/testthat/test-ProjectField.R b/tests/testthat/test-ProjectField.R index 1ba0042..b01fc6d 100644 --- a/tests/testthat/test-ProjectField.R +++ b/tests/testthat/test-ProjectField.R @@ -19,9 +19,9 @@ context("s2dv::ProjectField tests") dat3 <- dat2 dat3[1, 1, 1, 1, , ] <- NA names(dim(dat3)) <- names(dim(dat2)) - lat3 <- seq(10, 30, length.out = 4) - lon3 <- c(-5, 5) - eof3 <- EOF(dat3, lat3, lon3, neofs = 6) + lat3 <- lat2 + lon3 <- lon2 + eof3 <- eof2 # dat4 set.seed(1) @@ -121,7 +121,7 @@ test_that("1. Input checks", { # mode expect_error( ProjectField(dat1, eof1, mode = -1), - "Parameter 'mode' must be a positive integer." + "Parameter 'mode' must be NULL or a positive integer." ) expect_error( ProjectField(dat1, eof1, mode = 15), @@ -139,11 +139,15 @@ test_that("1. Input checks", { test_that("2. dat1", { expect_equal( - dim(ProjectField(dat1, eof = eof1)), + dim(ProjectField(dat1, eof = eof1, mode = 1)), c(sdate = 10) ) expect_equal( - as.vector(ProjectField(dat1, eof1))[1:5], + dim(ProjectField(dat1, eof = eof1)), + c(mode = 10, sdate = 10) + ) + expect_equal( + as.vector(ProjectField(dat1, eof1, mode = 1))[1:5], c(3.2061306, -0.1692669, 0.5420990, -2.5324441, -0.6143680), tolerance = 0.0001 ) @@ -152,16 +156,24 @@ test_that("2. dat1", { c(-0.24848299, -0.19311118, -0.16951195, -0.10000207, 0.04554693), tolerance = 0.0001 ) + expect_equal( + as.vector(ProjectField(dat1, eof1, mode = 1)), + as.vector(ProjectField(dat1, eof1)[1, ]) + ) }) ############################################## test_that("3. dat2", { expect_equal( - dim(ProjectField(dat2, eof2)), + dim(ProjectField(dat2, eof2, mode = 1)), c(sdate = 6, dat = 1, memb = 1, ftime = 1) ) expect_equal( - ProjectField(dat2, eof2)[1:6], + dim(ProjectField(dat2, eof2)), + c(mode = 6, sdate = 6, dat = 1, memb = 1, ftime = 1) + ) + expect_equal( + ProjectField(dat2, eof2, mode = 1)[1:6], c(0.00118771, -1.20872474, -0.00821559, -2.06064916, -0.19245169, 2.26026937), tolerance = 0.0001 ) @@ -170,18 +182,26 @@ test_that("3. dat2", { 0.1741076, tolerance = 0.0001 ) + expect_equal( + as.vector(ProjectField(dat2, eof2, mode = 1)), + as.vector(ProjectField(dat2, eof2)[1, , , , ]) + ) + expect_equal( + as.vector(ProjectField(dat2, eof2, mode = 5)), + as.vector(ProjectField(dat2, eof2)[5, , , , ]) + ) }) ############################################## test_that("4. dat3", { expect_equal( - dim(ProjectField(dat3, eof3)), + dim(ProjectField(dat3, eof3, mode = 1)), c(sdate = 6, dat = 1, memb = 1, ftime = 1) ) expect_equal( - ProjectField(dat3, eof3)[1:6], - c(NA, 0, 0, 0, 0, 0), + ProjectField(dat3, eof3, mode = 1)[1:6], + c(NA, -1.20872474, -0.00821559, -2.06064916, -0.19245169, 2.26026937), tolerance = 0.0001 ) @@ -189,16 +209,16 @@ test_that("4. dat3", { ############################################## test_that("5. dat4", { expect_equal( - dim(ProjectField(dat4, eof4)), + dim(ProjectField(dat4, eof4, mode = 1)), c(sdate = 6, dat = 2, memb = 2, ftime = 3) ) expect_equal( - mean(ProjectField(dat4, eof4)), + mean(ProjectField(dat4, eof4, mode = 1)), 0.078082, tolerance = 0.0001 ) expect_equal( - ProjectField(dat4, eof4)[, 1, 2, 2], + ProjectField(dat4, eof4, mode = 1)[, 1, 2, 2], c(0.28137048, -0.17616154, -0.39155370, 0.08288953, 1.18465521, 0.81850535), tolerance = 0.0001 ) @@ -207,16 +227,16 @@ test_that("5. dat4", { ############################################## test_that("6. dat5", { expect_equal( - dim(ProjectField(dat5, eof5)), + dim(ProjectField(dat5, eof5, mode = 1)), c(sdate = 6, dat = 1, memb = 2, ftime = 3) ) expect_equal( - mean(ProjectField(dat5, eof5)), + mean(ProjectField(dat5, eof5, mode = 1)), 0.0907149, tolerance = 0.0001 ) expect_equal( - ProjectField(dat5, eof5)[, 1, 2, 2], + ProjectField(dat5, eof5, mode = 1)[, 1, 2, 2], c(0.60881970, 0.93588392, 0.01982465, 0.82376024, -0.33147699, -1.35488289), tolerance = 0.0001 ) -- GitLab From 6e440536b810fd5ff0c3ba88cccb1722a317915f Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 17 May 2021 15:09:04 +0200 Subject: [PATCH 113/154] Allow REOFs to be the input of ProjectField --- R/ProjectField.R | 44 ++++++++++++++++++------------ R/REOF.R | 7 ++--- man/ProjectField.Rd | 11 ++++---- tests/testthat/test-ProjectField.R | 41 ++++++++++++++++++++++++---- tests/testthat/test-REOF.R | 4 +++ 5 files changed, 75 insertions(+), 32 deletions(-) diff --git a/R/ProjectField.R b/R/ProjectField.R index 2643f45..7432632 100644 --- a/R/ProjectField.R +++ b/R/ProjectField.R @@ -2,15 +2,16 @@ #' #'Project anomalies onto modes of variability to get the temporal evolution of #'the EOF mode selected. It returns principal components (PCs) by area-weighted -#'projection onto EOF pattern (from \code{EOF()}). The calculation removes NA -#'and returns NA if the whole spatial pattern is NA. +#'projection onto EOF pattern (from \code{EOF()} or \code{REOF()}). The +#'calculation removes NA and returns NA if the whole spatial pattern is NA. #' #'@param ano A numerical array of anomalies with named dimensions. The #' dimensions must have at least 'time_dim' and 'space_dim'. It can be #' generated by Ano(). -#'@param eof A list that contains at least 'EOFs' and 'wght', which are both -#' arrays. 'EOFs' must have dimensions 'mode' and 'space_dim' at least. -#' 'wght' has dimensions space_dim. It can be generated by EOF(). +#'@param eof A list that contains at least 'EOFs' or 'REOFs' and 'wght', which +#' are both arrays. 'EOFs' or 'REOFs' must have dimensions 'mode' and +#' 'space_dim' at least. 'wght' has dimensions space_dim. It can be generated +#' by EOF() or REOF(). #'@param time_dim A character string indicating the name of the time dimension #' of 'ano'. The default value is 'sdate'. #'@param space_dim A vector of two character strings. The first is the dimension @@ -77,13 +78,22 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon stop("Parameter 'eof' cannot be NULL.") } if (!is.list(eof)) { - stop("Parameter 'eof' must be a list generated by EOF().") + stop("Parameter 'eof' must be a list generated by EOF() or REOF().") } - if (!all(c('EOFs', 'wght') %in% names(eof))) { - stop("Parameter 'eof' must contain 'EOFs' and 'wght' generated by EOF().") + if ('EOFs' %in% names(eof)) { + EOFs <- "EOFs" + } else if ('REOFs' %in% names(eof)) { + EOFs <- "REOFs" + } else { + stop(paste0("Parameter 'eof' must be a list that contains 'EOFs' or 'REOFs'. ", + "It can be generated by EOF() or REOF().")) + } + if (!'wght' %in% names(eof)) { + stop(paste0("Parameter 'eof' must be a list that contains 'wght'. ", + "It can be generated by EOF() or REOF().")) } - if (!is.numeric(eof$EOFs) || !is.array(eof$EOFs)) { - stop("The component 'EOFs' of parameter 'eof' must be a numeric array.") + if (!is.numeric(eof[[EOFs]]) || !is.array(eof[[EOFs]])) { + stop("The component 'EOFs' or 'REOFs' of parameter 'eof' must be a numeric array.") } if (!is.numeric(eof$wght) || !is.array(eof$wght)) { stop("The component 'wght' of parameter 'eof' must be a numeric array.") @@ -108,9 +118,9 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon "parameter 'space_dim' and 'time_dim'.")) } ## eof (2) - if (!all(space_dim %in% names(dim(eof$EOFs))) | - !'mode' %in% names(dim(eof$EOFs))) { - stop(paste0("The component 'EOFs' of parameter 'eof' must be an array ", + if (!all(space_dim %in% names(dim(eof[[EOFs]]))) | + !'mode' %in% names(dim(eof[[EOFs]]))) { + stop(paste0("The component 'EOFs' or 'REOFs' of parameter 'eof' must be an array ", "with dimensions named as parameter 'space_dim' and 'mode'.")) } if (length(dim(eof$wght)) != 2 | !all(names(dim(eof$wght)) %in% space_dim)) { @@ -122,9 +132,9 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon if (!is.numeric(mode) | mode %% 1 != 0 | mode < 0 | length(mode) > 1) { stop("Parameter 'mode' must be NULL or a positive integer.") } - if (mode > dim(eof$EOFs)['mode']) { + if (mode > dim(eof[[EOFs]])['mode']) { stop(paste0("Parameter 'mode' is greater than the number of available ", - "modes in EOF.")) + "modes in 'eof'.")) } } ## ncores @@ -139,9 +149,9 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon # Keep the chosen mode if (!is.null(mode)) { - eof_mode <- ClimProjDiags::Subset(eof$EOFs, 'mode', mode, drop = 'selected') + eof_mode <- ClimProjDiags::Subset(eof[[EOFs]], 'mode', mode, drop = 'selected') } else { - eof_mode <- eof$EOFs + eof_mode <- eof[[EOFs]] } if ('mode' %in% names(dim(eof_mode))) { diff --git a/R/REOF.R b/R/REOF.R index 30ef6f0..2a32b8e 100644 --- a/R/REOF.R +++ b/R/REOF.R @@ -158,13 +158,12 @@ REOF <- function(ano, lat, lon, ntrunc = 15, time_dim = 'sdate', target_dims = c(time_dim, space_dim), output_dims = list(REOFs = c('mode', space_dim), RPCs = c(time_dim, 'mode'), - var = 'mode', - wght = space_dim), + var = 'mode'), fun = .REOF, corr = corr, ntrunc = ntrunc, wght = wght, ncores = ncores) - return(res) + return(c(res, wght = list(wght))) } @@ -213,5 +212,5 @@ REOF <- function(ano, lat, lon, ntrunc = 15, time_dim = 'sdate', var <- apply(RPCs, 2, function(x) { sum(x*x) } ) * 100 / eofs$tot_var # [mode] dim(var) <- c(mode = length(var)) - return(invisible(list(REOFs = REOFs, RPCs = RPCs, var = var, wght = wght))) + return(invisible(list(REOFs = REOFs, RPCs = RPCs, var = var))) } diff --git a/man/ProjectField.Rd b/man/ProjectField.Rd index 2abeca0..1b3833f 100644 --- a/man/ProjectField.Rd +++ b/man/ProjectField.Rd @@ -18,9 +18,10 @@ ProjectField( dimensions must have at least 'time_dim' and 'space_dim'. It can be generated by Ano().} -\item{eof}{A list that contains at least 'EOFs' and 'wght', which are both -arrays. 'EOFs' must have dimensions 'mode' and 'space_dim' at least. -'wght' has dimensions space_dim. It can be generated by EOF().} +\item{eof}{A list that contains at least 'EOFs' or 'REOFs' and 'wght', which +are both arrays. 'EOFs' or 'REOFs' must have dimensions 'mode' and +'space_dim' at least. 'wght' has dimensions space_dim. It can be generated +by EOF() or REOF().} \item{time_dim}{A character string indicating the name of the time dimension of 'ano'. The default value is 'sdate'.} @@ -43,8 +44,8 @@ A numerical array of the principal components in the verification \description{ Project anomalies onto modes of variability to get the temporal evolution of the EOF mode selected. It returns principal components (PCs) by area-weighted -projection onto EOF pattern (from \code{EOF()}). The calculation removes NA -and returns NA if the whole spatial pattern is NA. +projection onto EOF pattern (from \code{EOF()} or \code{REOF()}). The +calculation removes NA and returns NA if the whole spatial pattern is NA. } \examples{ \dontshow{ diff --git a/tests/testthat/test-ProjectField.R b/tests/testthat/test-ProjectField.R index b01fc6d..5e0fca6 100644 --- a/tests/testthat/test-ProjectField.R +++ b/tests/testthat/test-ProjectField.R @@ -7,6 +7,7 @@ context("s2dv::ProjectField tests") lat1 <- seq(10, 30, length.out = 6) lon1 <- c(10, 12) eof1 <- EOF(dat1, lat1, lon1, neofs = 10) + reof1 <- REOF(dat1, lat1, lon1, ntrunc = 3) # dat2 set.seed(1) @@ -31,6 +32,7 @@ context("s2dv::ProjectField tests") set.seed(2) tmp <- array(rnorm(144), dim = c(dat = 2, sdate = 6, lat = 4, lon = 2)) eof4 <- EOF(tmp, lat4, lon4, neofs = 6) + reof4 <- REOF(tmp, lat4, lon4, ntrunc = 6) # dat5 set.seed(1) @@ -67,17 +69,20 @@ test_that("1. Input checks", { "Parameter 'eof' cannot be NULL." ) expect_error( - ProjectField(dat1, c(1, 2, 3)), - "Parameter 'eof' must be a list generated by EOF()." + ProjectField(dat1, c(1, 2)), + "Parameter 'eof' must be a list generated by EOF() or REOF().", + fixed = TRUE ) expect_error( ProjectField(dat1, list(a = 1)), - "Parameter 'eof' must contain 'EOFs' and 'wght' generated by EOF()." + paste0("Parameter 'eof' must be a list that contains 'EOFs' or 'REOFs'. ", + "It can be generated by EOF() or REOF()."), + fixed = TRUE ) eof_fake <- list(EOFs = 'a', wght = 1:10) expect_error( ProjectField(dat1, eof_fake), - "The component 'EOFs' of parameter 'eof' must be a numeric array." + "The component 'EOFs' or 'REOFs' of parameter 'eof' must be a numeric array." ) eof_fake <- list(EOFs = array(rnorm(10), dim = c(mode = 1, lat = 2, lon = 5)), wght = c(1:10)) @@ -108,7 +113,7 @@ test_that("1. Input checks", { wght = array(rnorm(10), dim = c(lat = 2, lon = 5))) expect_error( ProjectField(dat1, eof_fake), - paste0("The component 'EOFs' of parameter 'eof' must be an array ", + paste0("The component 'EOFs' or 'REOFs' of parameter 'eof' must be an array ", "with dimensions named as parameter 'space_dim' and 'mode'.") ) eof_fake <- list(EOFs = array(rnorm(10), dim = c(mode = 1, lat = 6, lon = 2)), @@ -126,7 +131,7 @@ test_that("1. Input checks", { expect_error( ProjectField(dat1, eof1, mode = 15), paste0("Parameter 'mode' is greater than the number of available ", - "modes in EOF.") + "modes in 'eof'.") ) # ncores expect_error( @@ -160,6 +165,20 @@ test_that("2. dat1", { as.vector(ProjectField(dat1, eof1, mode = 1)), as.vector(ProjectField(dat1, eof1)[1, ]) ) + # reof + expect_equal( + dim(ProjectField(dat1, eof = reof1, mode = 1)), + c(sdate = 10) + ) + expect_equal( + dim(ProjectField(dat1, eof = reof1)), + c(mode = 3, sdate = 10) + ) + expect_equal( + as.vector(ProjectField(dat1, reof1, mode = 1))[1:5], + c(3.1567219, -0.1023512, 0.6339372, -0.7998676, -1.3727226), + tolerance = 0.0001 + ) }) ############################################## @@ -222,6 +241,16 @@ test_that("5. dat4", { c(0.28137048, -0.17616154, -0.39155370, 0.08288953, 1.18465521, 0.81850535), tolerance = 0.0001 ) + # reof + expect_equal( + dim(ProjectField(dat4, reof4)), + c(mode = 6, sdate = 6, dat = 2, memb = 2, ftime = 3) + ) + expect_equal( + ProjectField(dat4, reof4, mode = 1)[, 1, 2, 2], + c(-1.6923627, -0.4080116, 0.3044336, -0.7853220, -0.2670783, 0.6940482), + tolerance = 0.0001 + ) }) ############################################## diff --git a/tests/testthat/test-REOF.R b/tests/testthat/test-REOF.R index 296e57a..c109d38 100644 --- a/tests/testthat/test-REOF.R +++ b/tests/testthat/test-REOF.R @@ -154,6 +154,10 @@ test_that("3. dat2", { c(sdate = 5, mode = 4, dat = 2) ) expect_equal( + dim(REOF(dat2, lon = lon2, lat = lat2, ntrunc = 2)$wght), + c(lat = 6, lon = 2) + ) + expect_equal( REOF(dat2, lon = lon2, lat = lat2, ntrunc = 1)$REOFs[1, 3, 2, 1], 0.09529009, tolerance = 0.0001 -- GitLab From 544b2f10f185b1a9180563976b715323bffd90f2 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 18 May 2021 13:05:48 +0200 Subject: [PATCH 114/154] Add new function EuroAtlanticTC --- NAMESPACE | 1 + R/EuroAtlanticTC.R | 200 ++++++++++++++++++ R/REOF.R | 32 +-- man/EuroAtlanticTC.Rd | 82 ++++++++ man/REOF.Rd | 22 +- tests/testthat/test-EuroAtlanticTC.R | 304 +++++++++++++++++++++++++++ tests/testthat/test-REOF.R | 5 +- 7 files changed, 620 insertions(+), 26 deletions(-) create mode 100644 R/EuroAtlanticTC.R create mode 100644 man/EuroAtlanticTC.Rd create mode 100644 tests/testthat/test-EuroAtlanticTC.R diff --git a/NAMESPACE b/NAMESPACE index 75ded15..94af45c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,7 @@ export(ConfigShowTable) export(Corr) export(EOF) export(Eno) +export(EuroAtlanticTC) export(GMST) export(GSAT) export(Histo2Hindcast) diff --git a/R/EuroAtlanticTC.R b/R/EuroAtlanticTC.R new file mode 100644 index 0000000..1d2c143 --- /dev/null +++ b/R/EuroAtlanticTC.R @@ -0,0 +1,200 @@ +#'Teleconnection indices in European Atlantic Ocean region +#' +#'Calculate the four main teleconnection indices in European Atlantic Ocean +#'region: North Atlantic oscillation (NAO), East Atlantic Pattern (EA), East +#'Atlantic/Western Russia (EAWR), and Scandinavian pattern (SCA). The function +#'\code{REOF()} is used for the calculation, and the first four modes are +#'returned. +#' +#'@param ano A numerical array of anomalies with named dimensions to calculate +#' REOF then the four teleconnections. The dimensions must have at least +#' 'time_dim' and 'space_dim', and the data should cover the European Atlantic +#' Ocean area (20N-80N, 90W-60E). +#'@param lat A vector of the latitudes of 'ano'. It should be 20N-80N. +#'@param lon A vector of the longitudes of 'ano'. It should be 90W-60E. +#'@param time_dim A character string indicating the name of the time dimension +#' of 'ano'. The default value is 'sdate'. +#'@param space_dim A vector of two character strings. The first is the dimension +#' name of latitude of 'ano' and the second is the dimension name of longitude +#' of 'ano'. The default value is c('lat', 'lon'). +#'@param ntrunc A positive integer of the modes to be kept. The default value +#' is 30. If time length or the product of latitude length and longitude +#' length is less than ntrunc, ntrunc is equal to the minimum of the three +#' values. +#'@param corr A logical value indicating whether to base on a correlation (TRUE) +#' or on a covariance matrix (FALSE). 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 list containing: +#'\item{patterns}{ +#' An array of the first four REOF patterns normalized to 1 (unitless) with +#' dimensions (modes = 4, the rest of the dimensions of 'ano' except +#' 'time_dim'). Multiplying 'patterns' by 'indices' gives the original +#' reconstructed field. +#'} +#'\item{indices}{ +#' An array of the first four principal components with the units of the +#' original field to the power of 2, with dimensions (time_dim, modes = 4, the +#' rest of the dimensions of 'ano' except 'space_dim'). +#'} +#'\item{var}{ +#' An array of the percentage (%) of variance fraction of total variance +#' explained by each mode. The dimensions are (modes = ntrunc, the rest of the +#' dimensions of 'ano' except 'time_dim' and 'space_dim'). +#'} +#'\item{wght}{ +#' An array of the area weighting with dimensions 'space_dim'. It is calculated +#' by the square root of cosine of 'lat' and used to compute the fraction of +#' variance explained by each REOFs. +#'} +#'@examples +#' +#'@seealso REOF NAO +#'@import multiApply +#'@importFrom ClimProjDiags Subset +#'@export +EuroAtlanticTC <- function(ano, lat, lon, ntrunc = 30, time_dim = 'sdate', + space_dim = c('lat', 'lon'), corr = FALSE, + ncores = NULL) { + + # Check inputs + ## ano + if (is.null(ano)) { + stop("Parameter 'ano' cannot be NULL.") + } + if (!is.numeric(ano)) { + stop("Parameter 'ano' must be a numeric array.") + } + if(any(is.null(names(dim(ano))))| any(nchar(names(dim(ano))) == 0)) { + stop("Parameter 'ano' 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(ano))) { + stop("Parameter 'time_dim' is not found in 'ano' dimension.") + } + ## space_dim + if (!is.character(space_dim) | length(space_dim) != 2) { + stop("Parameter 'space_dim' must be a character vector of 2.") + } + if (any(!space_dim %in% names(dim(ano)))) { + stop("Parameter 'space_dim' is not found in 'ano' dimension.") + } + ## lat and lon + if (!is.numeric(lat) | length(lat) != dim(ano)[space_dim[1]]) { + stop(paste0("Parameter 'lat' must be a numeric vector with the same ", + "length as the latitude dimension of 'ano'.")) + } + if (any(lat > 90 | lat < -90)) { + stop("Parameter 'lat' must contain values within the range [-90, 90].") + } + if (!is.numeric(lon) | length(lon) != dim(ano)[space_dim[2]]) { + stop(paste0("Parameter 'lon' must be a numeric vector with the same ", + "length as the longitude dimension of 'ano'.")) + } + if (all(lon >= 0)) { + if (any(lon > 360 | lon < 0)) { + stop("Parameter 'lon' must be within the range [-180, 180] or [0, 360].") + } + } else { + if (any(lon < -180 | lon > 180)) { + stop("Parameter 'lon' must be within the range [-180, 180] or [0, 360].") + } + } + stop_needed <- FALSE + # A preset region for computing EuroAtlantic teleconnections + lat.min <- 20 + lat.max <- 80 + lon.min <- -90 # Write this as a negative number please! + lon.max <- 60 + + # Choose lats and lons inside the Euroatlantic region. + # Change lon to [-180, 180] if it isn't + lon <- ifelse(lon < 180, lon, lon - 360) + ind_lat <- which(lat >= lat.min & lat <= lat.max) + ind_lon <- which(lon >= lon.min & lon <= lon.max) + + # Subset + lat <- lat[ind_lat] + lon <- lon[ind_lon] + + # Lat should be [20, 80] (5deg tolerance) + if (max(lat) < (lat.max - 5) | min(lat) > (lat.min + 5)) { + stop_needed <- TRUE + } + # Lon should be [-90, 60] (5deg tolerance) + if (!(min(lon) < (lon.min + 5) & max(lon) > (lon.max - 5))) { + stop_needed <- TRUE + } + if (stop_needed) { + stop("The provided data does not cover the EuroAtlantic region (20N-80N, 90W-60E).") + } + ## ntrunc + if (!is.numeric(ntrunc) | ntrunc %% 1 != 0 | ntrunc <= 0 | length(ntrunc) > 1) { + stop("Parameter 'ntrunc' must be a positive integer.") + } + ## corr + if (!is.logical(corr) | length(corr) > 1) { + stop("Parameter 'corr' must be one logical value.") + } + ## 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.") + } + } + + + ############################### + # Calculate indices + + ano <- ClimProjDiags::Subset(ano, space_dim, list(ind_lat, ind_lon), drop = FALSE) + + # ntrunc is bounded + if (ntrunc != min(dim(ano)[time_dim], prod(dim(ano)[space_dim]), ntrunc)) { + ntrunc <- min(dim(ano)[time_dim], prod(dim(ano)[space_dim]), ntrunc) + .warning(paste0("Parameter 'ntrunc' is changed to ", ntrunc, ", the minimum among ", + "the length of time_dim, the production of the length of space_dim, ", + "and ntrunc.")) + } + if (ntrunc < 4) { + .warning(paste0("Parameter 'ntrunc' is ", ntrunc, " so only the first ", ntrunc, + " modes will be calculated.")) + } + + # Area weighting is needed to compute the fraction of variance explained by + # each mode + space_ind <- sapply(space_dim, function(a) which(names(dim(ano)) == a)) + wght <- array(cos(lat * pi/180), dim = dim(ano)[space_ind]) + + # We want the covariance matrix to be weigthed by the grid + # cell area so the anoaly field is weighted by its square + # root since the covariance matrix equals transpose(ano) + # times ano. + wght <- sqrt(wght) + + reofs <- Apply(ano, + target_dims = c(time_dim, space_dim), + output_dims = list(REOFs = c('mode', space_dim), + RPCs = c(time_dim, 'mode'), + var = 'mode'), + fun = .REOF, + corr = corr, ntrunc = ntrunc, wght = wght, + ncores = ncores) + + if (ntrunc >= 4) { + TCP <- ClimProjDiags::Subset(reofs$REOFs, 'mode', 1:4, drop = FALSE) + TCI <- ClimProjDiags::Subset(reofs$RPCs, 'mode', 1:4, drop = FALSE) + } else { + TCP <- reofs$REOFs + TCI <- reofs$RPCs + } + + return(list(patterns = TCP, indices = TCI, var = reofs$var, wght = wght)) +} + diff --git a/R/REOF.R b/R/REOF.R index 2a32b8e..b6c953b 100644 --- a/R/REOF.R +++ b/R/REOF.R @@ -12,8 +12,8 @@ #'@param time_dim A character string indicating the name of the time dimension #' of 'ano'. The default value is 'sdate'. #'@param space_dim A vector of two character strings. The first is the dimension -#' name of longitude of 'ano' and the second is the dimension name of latitude -#' of 'ano'. The default value is c('lon', 'lat'). +#' name of latitude of 'ano' and the second is the dimension name of longitude +#' of 'ano'. The default value is c('lat', 'lon'). #'@param ntrunc A positive integer of the modes to be kept. The default value #' is 15. If time length or the product of latitude length and longitude #' length is less than ntrunc, ntrunc is equal to the minimum of the three @@ -27,24 +27,24 @@ #'A list containing: #'\item{REOFs}{ #' An array of REOF patterns normalized to 1 (unitless) with dimensions -#' (number of modes, rest of the dimensions of ano except 'time_dim'). -#' Multiplying 'REOFs' by 'RPCs' gives the original reconstructed -#' field. +#' (number of modes, the rest of the dimensions of 'ano' except +#' 'time_dim'). Multiplying 'REOFs' by 'RPCs' gives the original +#' reconstructed field. #'} #'\item{RPCs}{ #' An array of principal components with the units of the original field to -#' the power of 2, with dimensions (time_dim, number of modes, rest of the -#' dimensions except 'space_dim'). +#' the power of 2, with dimensions (time_dim, number of modes, the rest of the +#' dimensions of 'ano' except 'space_dim'). #'} #'\item{var}{ #' An array of the percentage (%) of variance fraction of total variance -#' explained by each mode. The dimensions are (number of modes, rest of the -#' dimension except 'time_dim' and 'space_dim'). +#' explained by each mode. The dimensions are (number of modes, the rest of +#' the dimension except 'time_dim' and 'space_dim'). #'} #'\item{wght}{ #' An array of the area weighting with dimensions 'space_dim'. It is calculated -#' by cosine of 'lat' and used to compute the fraction of variance explained by -#' each REOFs. +#' by the square root of cosine of 'lat' and used to compute the fraction of +#' variance explained by each REOFs. #'} #' #'@seealso EOF @@ -113,8 +113,14 @@ REOF <- function(ano, lat, lon, ntrunc = 15, time_dim = 'sdate', stop(paste0("Parameter 'lon' must be a numeric vector with the same ", "length as the longitude dimension of 'ano'.")) } - if (any(lon > 360 | lon < -360)) { - warning("Some 'lon' is out of the range [-360, 360].") + if (all(lon >= 0)) { + if (any(lon > 360 | lon < 0)) { + stop("Parameter 'lon' must be within the range [-180, 180] or [0, 360].") + } + } else { + if (any(lon < -180 | lon > 180)) { + stop("Parameter 'lon' must be within the range [-180, 180] or [0, 360].") + } } ## ntrunc if (!is.numeric(ntrunc) | ntrunc %% 1 != 0 | ntrunc <= 0 | length(ntrunc) > 1) { diff --git a/man/EuroAtlanticTC.Rd b/man/EuroAtlanticTC.Rd new file mode 100644 index 0000000..6fa6aa3 --- /dev/null +++ b/man/EuroAtlanticTC.Rd @@ -0,0 +1,82 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/EuroAtlanticTC.R +\name{EuroAtlanticTC} +\alias{EuroAtlanticTC} +\title{Teleconnection indices in European Atlantic Ocean region} +\usage{ +EuroAtlanticTC( + ano, + lat, + lon, + ntrunc = 30, + time_dim = "sdate", + space_dim = c("lat", "lon"), + corr = FALSE, + ncores = NULL +) +} +\arguments{ +\item{ano}{A numerical array of anomalies with named dimensions to calculate +REOF then the four teleconnections. The dimensions must have at least +'time_dim' and 'space_dim', and the data should cover the European Atlantic +Ocean area (20N-80N, 90W-60E).} + +\item{lat}{A vector of the latitudes of 'ano'. It should be 20N-80N.} + +\item{lon}{A vector of the longitudes of 'ano'. It should be 90W-60E.} + +\item{ntrunc}{A positive integer of the modes to be kept. The default value +is 30. If time length or the product of latitude length and longitude +length is less than ntrunc, ntrunc is equal to the minimum of the three +values.} + +\item{time_dim}{A character string indicating the name of the time dimension +of 'ano'. The default value is 'sdate'.} + +\item{space_dim}{A vector of two character strings. The first is the dimension +name of latitude of 'ano' and the second is the dimension name of longitude +of 'ano'. The default value is c('lat', 'lon').} + +\item{corr}{A logical value indicating whether to base on a correlation (TRUE) +or on a covariance matrix (FALSE). The default value is FALSE.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +A list containing: +\item{patterns}{ + An array of the first four REOF patterns normalized to 1 (unitless) with + dimensions (modes = 4, the rest of the dimensions of 'ano' except + 'time_dim'). Multiplying 'patterns' by 'indices' gives the original + reconstructed field. +} +\item{indices}{ + An array of the first four principal components with the units of the + original field to the power of 2, with dimensions (time_dim, modes = 4, the + rest of the dimensions of 'ano' except 'space_dim'). +} +\item{var}{ + An array of the percentage (%) of variance fraction of total variance + explained by each mode. The dimensions are (modes = ntrunc, the rest of the + dimensions of 'ano' except 'time_dim' and 'space_dim'). +} +\item{wght}{ + An array of the area weighting with dimensions 'space_dim'. It is calculated + by the square root of cosine of 'lat' and used to compute the fraction of + variance explained by each REOFs. +} +} +\description{ +Calculate the four main teleconnection indices in European Atlantic Ocean +region: North Atlantic oscillation (NAO), East Atlantic Pattern (EA), East +Atlantic/Western Russia (EAWR), and Scandinavian pattern (SCA). The function +\code{REOF()} is used for the calculation, and the first four modes are +returned. +} +\examples{ + +} +\seealso{ +REOF NAO +} diff --git a/man/REOF.Rd b/man/REOF.Rd index a65331c..ca5473b 100644 --- a/man/REOF.Rd +++ b/man/REOF.Rd @@ -32,8 +32,8 @@ values.} of 'ano'. The default value is 'sdate'.} \item{space_dim}{A vector of two character strings. The first is the dimension -name of longitude of 'ano' and the second is the dimension name of latitude -of 'ano'. The default value is c('lon', 'lat').} +name of latitude of 'ano' and the second is the dimension name of longitude +of 'ano'. The default value is c('lat', 'lon').} \item{corr}{A logical value indicating whether to base on a correlation (TRUE) or on a covariance matrix (FALSE). The default value is FALSE.} @@ -45,24 +45,24 @@ computation. The default value is NULL.} A list containing: \item{REOFs}{ An array of REOF patterns normalized to 1 (unitless) with dimensions - (number of modes, rest of the dimensions of ano except 'time_dim'). - Multiplying 'REOFs' by 'RPCs' gives the original reconstructed - field. + (number of modes, the rest of the dimensions of 'ano' except + 'time_dim'). Multiplying 'REOFs' by 'RPCs' gives the original + reconstructed field. } \item{RPCs}{ An array of principal components with the units of the original field to - the power of 2, with dimensions (time_dim, number of modes, rest of the - dimensions except 'space_dim'). + the power of 2, with dimensions (time_dim, number of modes, the rest of the + dimensions of 'ano' except 'space_dim'). } \item{var}{ An array of the percentage (%) of variance fraction of total variance - explained by each mode. The dimensions are (number of modes, rest of the - dimension except 'time_dim' and 'space_dim'). + explained by each mode. The dimensions are (number of modes, the rest of + the dimension except 'time_dim' and 'space_dim'). } \item{wght}{ An array of the area weighting with dimensions 'space_dim'. It is calculated - by cosine of 'lat' and used to compute the fraction of variance explained by - each REOFs. + by the square root of cosine of 'lat' and used to compute the fraction of + variance explained by each REOFs. } } \description{ diff --git a/tests/testthat/test-EuroAtlanticTC.R b/tests/testthat/test-EuroAtlanticTC.R new file mode 100644 index 0000000..0f73524 --- /dev/null +++ b/tests/testthat/test-EuroAtlanticTC.R @@ -0,0 +1,304 @@ +context("s2dv::EuroAtlanticTC tests") + +############################################## + # dat1 + set.seed(1) + dat1 <- array(rnorm(480), dim = c(sdate = 10, lat = 6, lon = 8)) + lat1 <- seq(20, 80, length.out = 6) + lon1 <- seq(-90, 60, length.out = 8) + + # dat2 + set.seed(2) + dat2 <- array(rnorm(800), dim = c(dat = 2, lat = 8, lon = 15, sdate = 5)) + lat2 <- seq(10, 90, length.out = 8) + lon2 <- seq(-100, 70, length.out = 15) + + # dat3 + set.seed(2) + dat3 <- array(rnorm(1520), dim = c(dat = 2, lat = 8, lon = 19, sdate = 5)) + lat3 <- seq(10, 90, length.out = 8) + lon3 <- c(seq(0, 70, length.out = 8), seq(250, 350, length.out = 11)) + +############################################## +test_that("1. Input checks", { + + # ano + expect_error( + EuroAtlanticTC(c()), + "Parameter 'ano' cannot be NULL." + ) + expect_error( + EuroAtlanticTC(c(NA, NA)), + "Parameter 'ano' must be a numeric array." + ) + expect_error( + EuroAtlanticTC(list(a = array(rnorm(50), dim = c(dat = 5, sdate = 10)), b = c(1:4))), + "Parameter 'ano' must be a numeric array." + ) + expect_error( + EuroAtlanticTC(array(1:10, dim = c(2, 5))), + "Parameter 'ano' must have dimension names." + ) + # time_dim + expect_error( + EuroAtlanticTC(dat1, time_dim = 2), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + EuroAtlanticTC(dat1, time_dim = c('a','sdate')), + "Parameter 'time_dim' must be a character string." + ) + # space_dim + expect_error( + EuroAtlanticTC(dat1, space_dim = 'lat'), + "Parameter 'space_dim' must be a character vector of 2." + ) + expect_error( + EuroAtlanticTC(dat1, space_dim = c('latitude', 'longitude')), + "Parameter 'space_dim' is not found in 'ano' dimension." + ) + # lat and lon + expect_error( + EuroAtlanticTC(dat1, lat = 1:10), + paste0("Parameter 'lat' must be a numeric vector with the same ", + "length as the latitude dimension of 'ano'.") + ) + expect_error( + EuroAtlanticTC(dat1, lat = seq(-100, -80, length.out = 6)), + "Parameter 'lat' must contain values within the range \\[-90, 90\\]." + ) + expect_error( + EuroAtlanticTC(dat1, lat = lat1, lon = c('a', 'b')), + paste0("Parameter 'lon' must be a numeric vector with the same ", + "length as the longitude dimension of 'ano'.") + ) + expect_error( + EuroAtlanticTC(dat1, lat = lat1, lon = seq(300, 370, length.out = 8)), + "Parameter 'lon' must be within the range [-180, 180] or [0, 360].", + fixed = TRUE + ) + expect_error( + EuroAtlanticTC(dat1, lat = lat1, lon = seq(-190, -10, length.out = 8)), + "Parameter 'lon' must be within the range [-180, 180] or [0, 360].", + fixed = TRUE + ) + expect_error( + EuroAtlanticTC(dat1, lat = seq(30, 80, length.out = 6), lon = lon1), + "The provided data does not cover the EuroAtlantic region (20N-80N, 90W-60E).", + fixed = TRUE + ) + expect_error( + EuroAtlanticTC(dat1, lat = lat1, lon = seq(-80, 20, length.out = 8)), + "The provided data does not cover the EuroAtlantic region (20N-80N, 90W-60E).", + fixed = TRUE + ) + # ntrunc + expect_error( + EuroAtlanticTC(dat1, lat = lat1, lon = lon1, ntrunc = 0), + "Parameter 'ntrunc' must be a positive integer." + ) + # corr + expect_error( + EuroAtlanticTC(dat1, lat = lat1, lon = lon1, corr = 0.1), + "Parameter 'corr' must be one logical value." + ) + # ncores + expect_error( + EuroAtlanticTC(dat1, lat1, lon1, ncore = 3.5), + "Parameter 'ncores' must be a positive integer." + ) + +}) + +############################################## +test_that("2. dat1", { + + expect_equal( + names(EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 4)), + c("patterns", "indices", "var", "wght") + ) + expect_equal( + dim(EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 4)$patterns), + c(mode = 4, lat = 6, lon = 8) + ) + expect_equal( + dim(EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 10)$patterns), + c(mode = 4, lat = 6, lon = 8) + ) + expect_equal( + dim(EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 9)$indices), + c(sdate = 10, mode = 4) + ) + expect_equal( + dim(EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 10)$var), + c(mode = 10) + ) + expect_equal( + dim(EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 4)$wght), + c(lat = 6, lon = 8) + ) + expect_equal( + EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 4)$patterns[, 2, 3], + c(-0.019905033, -0.048926441, -0.330219176, 0.008138493), + tolerance = 0.0001 + ) + expect_equal( + EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 5)$patterns[, 2, 3], + c(0.01878324, -0.03784923, -0.22820514, -0.21184373), + tolerance = 0.0001 + ) + expect_equal( + EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 10)$indices[2, ], + c(-1.944509, -1.335159, 0.997195, -2.697545), + tolerance = 0.0001 + ) + expect_equal( + mean(EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 10)$var), + 10, + tolerance = 0.0001 + ) + expect_equal( + as.vector(EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 10)$var[1:4]), + c(17.995853, 10.768974, 9.598904, 10.234672), + tolerance = 0.0001 + ) + expect_equal( + EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 10)$wght[1,1], + EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 10)$wght[1,2] + ) + expect_equal( + EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 10)$wght[1,1], + c(0.9693774), + tolerance = 0.0001 + ) + +}) + +############################################## +test_that("3. dat2", { + + expect_equal( + names(EuroAtlanticTC(dat2, lon = lon2, lat = lat2, ntrunc = 4)), + c("patterns", "indices", "var", "wght") + ) + expect_equal( + dim(EuroAtlanticTC(dat2, lon = lon2, lat = lat2, ntrunc = 5)$patterns), + c(mode = 4, lat = 6, lon = 13, dat = 2) + ) + expect_equal( + dim(EuroAtlanticTC(dat2, lon = lon2, lat = lat2, ntrunc = 4)$patterns), + c(mode = 4, lat = 6, lon = 13, dat = 2) + ) + expect_equal( + dim(EuroAtlanticTC(dat2, lon = lon2, lat = lat2, ntrunc = 5)$indices), + c(sdate = 5, mode = 4, dat = 2) + ) + expect_equal( + dim(EuroAtlanticTC(dat2, lon = lon2, lat = lat2, ntrunc = 5)$var), + c(mode = 5, dat = 2) + ) + expect_equal( + dim(EuroAtlanticTC(dat2, lon = lon2, lat = lat2, ntrunc = 4)$wght), + c(lat = 6, lon = 13) + ) + expect_equal( + EuroAtlanticTC(dat2, lon = lon2, lat = lat2, ntrunc = 4)$patterns[, 2, 3, 2], + c(-0.17289486, -0.07021256, -0.08045222, 0.17330862), + tolerance = 0.0001 + ) + expect_equal( + EuroAtlanticTC(dat2, lon = lon2, lat = lat2, ntrunc = 5)$patterns[, 2, 3, 1], + c(0.1347727, 0.2157945, -0.1024759, 0.1633547), + tolerance = 0.0001 + ) + expect_equal( + EuroAtlanticTC(dat2, lon = lon2, lat = lat2, ntrunc = 5)$indices[2, , 1], + c(2.1975962, 2.9158790, -3.2257169, -0.4055974), + tolerance = 0.0001 + ) + expect_equal( + mean(EuroAtlanticTC(dat2, lon = lon2, lat = lat2, ntrunc = 5)$var), + 20, + tolerance = 0.0001 + ) + expect_equal( + as.vector(EuroAtlanticTC(dat2, lon = lon2, lat = lat2, ntrunc = 5)$var[1:4]), + c(23.06692, 21.98278, 20.22588, 19.51251), + tolerance = 0.0001 + ) + expect_equal( + EuroAtlanticTC(dat2, lon = lon2, lat = lat2, ntrunc = 5)$wght[1,1], + EuroAtlanticTC(dat2, lon = lon2, lat = lat2, ntrunc = 5)$wght[1,2] + ) + expect_equal( + EuroAtlanticTC(dat2, lon = lon2, lat = lat2, ntrunc = 5)$wght[1,1], + c(0.964818), + tolerance = 0.0001 + ) + +}) + +############################################## +test_that("4. dat3", { + + expect_equal( + names(EuroAtlanticTC(dat3, lon = lon3, lat = lat3, ntrunc = 4)), + c("patterns", "indices", "var", "wght") + ) + expect_equal( + dim(EuroAtlanticTC(dat3, lon = lon3, lat = lat3, ntrunc = 5)$patterns), + c(mode = 4, lat = 6, lon = 16, dat = 2) + ) + expect_equal( + dim(EuroAtlanticTC(dat3, lon = lon3, lat = lat3, ntrunc = 4)$patterns), + c(mode = 4, lat = 6, lon = 16, dat = 2) + ) + expect_equal( + dim(EuroAtlanticTC(dat3, lon = lon3, lat = lat3, ntrunc = 5)$indices), + c(sdate = 5, mode = 4, dat = 2) + ) + expect_equal( + dim(EuroAtlanticTC(dat3, lon = lon3, lat = lat3, ntrunc = 5)$var), + c(mode = 5, dat = 2) + ) + expect_equal( + dim(EuroAtlanticTC(dat3, lon = lon3, lat = lat3, ntrunc = 4)$wght), + c(lat = 6, lon = 16) + ) + expect_equal( + EuroAtlanticTC(dat3, lon = lon3, lat = lat3, ntrunc = 4)$patterns[, 2, 3, 2], + c(-0.10653582, -0.22437848, 0.10192633, 0.08331549), + tolerance = 0.0001 + ) + expect_equal( + EuroAtlanticTC(dat3, lon = lon3, lat = lat3, ntrunc = 5)$patterns[, 2, 3, 1], + c(0.25209479, -0.05872688, 0.03186457, -0.02901076), + tolerance = 0.0001 + ) + expect_equal( + EuroAtlanticTC(dat3, lon = lon3, lat = lat3, ntrunc = 5)$indices[2, , 1], + c(2.940060, 5.036896, 4.188896, 2.816158), + tolerance = 0.0001 + ) + expect_equal( + mean(EuroAtlanticTC(dat3, lon = lon3, lat = lat3, ntrunc = 5)$var), + 20, + tolerance = 0.0001 + ) + expect_equal( + as.vector(EuroAtlanticTC(dat3, lon = lon3, lat = lat3, ntrunc = 5)$var[1:4]), + c(24.38583, 22.57439, 20.19659, 17.95064), + tolerance = 0.0001 + ) + expect_equal( + EuroAtlanticTC(dat3, lon = lon3, lat = lat3, ntrunc = 5)$wght[1,1], + EuroAtlanticTC(dat3, lon = lon3, lat = lat3, ntrunc = 5)$wght[1,2] + ) + expect_equal( + EuroAtlanticTC(dat3, lon = lon3, lat = lat3, ntrunc = 5)$wght[1,1], + c(0.964818), + tolerance = 0.0001 + ) + +}) + diff --git a/tests/testthat/test-REOF.R b/tests/testthat/test-REOF.R index c109d38..9f4bb48 100644 --- a/tests/testthat/test-REOF.R +++ b/tests/testthat/test-REOF.R @@ -67,9 +67,10 @@ test_that("1. Input checks", { paste0("Parameter 'lon' must be a numeric vector with the same ", "length as the longitude dimension of 'ano'.") ) - expect_warning( + expect_error( REOF(dat1, lat = lat1, lon = c(350, 370)), - "Some 'lon' is out of the range \\[-360, 360\\]." + "Parameter 'lon' must be within the range [-180, 180] or [0, 360].", + fixed = TRUE ) # ntrunc expect_error( -- GitLab From 844efc9ae0b231435fe9410bc56365d0b2c5d85e Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 18 May 2021 13:59:01 +0200 Subject: [PATCH 115/154] Add example --- R/EuroAtlanticTC.R | 10 ++++++++-- man/EuroAtlanticTC.Rd | 10 ++++++++-- tests/testthat/test-EuroAtlanticTC.R | 6 +++++- 3 files changed, 21 insertions(+), 5 deletions(-) diff --git a/R/EuroAtlanticTC.R b/R/EuroAtlanticTC.R index 1d2c143..9a61e76 100644 --- a/R/EuroAtlanticTC.R +++ b/R/EuroAtlanticTC.R @@ -31,8 +31,8 @@ #'\item{patterns}{ #' An array of the first four REOF patterns normalized to 1 (unitless) with #' dimensions (modes = 4, the rest of the dimensions of 'ano' except -#' 'time_dim'). Multiplying 'patterns' by 'indices' gives the original -#' reconstructed field. +#' 'time_dim'). The modes represent NAO, EA, EAWR, and SCA in order. +#' Multiplying 'patterns' by 'indices' gives the original reconstructed field. #'} #'\item{indices}{ #' An array of the first four principal components with the units of the @@ -50,6 +50,12 @@ #' variance explained by each REOFs. #'} #'@examples +#'# Use synthetic data +#'set.seed(1) +#'dat <- array(rnorm(800), dim = c(dat = 2, sdate = 5, lat = 8, lon = 15) +#'lat <- seq(10, 90, length.out = 8) +#'lon <- seq(-100, 70, length.out = 15) +#'res <- EuroAtlanticTC(ano, lat = lat, lon = lon) #' #'@seealso REOF NAO #'@import multiApply diff --git a/man/EuroAtlanticTC.Rd b/man/EuroAtlanticTC.Rd index 6fa6aa3..7fe1ee4 100644 --- a/man/EuroAtlanticTC.Rd +++ b/man/EuroAtlanticTC.Rd @@ -48,8 +48,8 @@ A list containing: \item{patterns}{ An array of the first four REOF patterns normalized to 1 (unitless) with dimensions (modes = 4, the rest of the dimensions of 'ano' except - 'time_dim'). Multiplying 'patterns' by 'indices' gives the original - reconstructed field. + 'time_dim'). The modes represent NAO, EA, EAWR, and SCA in order. + Multiplying 'patterns' by 'indices' gives the original reconstructed field. } \item{indices}{ An array of the first four principal components with the units of the @@ -75,6 +75,12 @@ Atlantic/Western Russia (EAWR), and Scandinavian pattern (SCA). The function returned. } \examples{ +# Use synthetic data +set.seed(1) +dat <- array(rnorm(800), dim = c(dat = 2, sdate = 5, lat = 8, lon = 15) +lat <- seq(10, 90, length.out = 8) +lon <- seq(-100, 70, length.out = 15) +res <- EuroAtlanticTC(ano, lat = lat, lon = lon) } \seealso{ diff --git a/tests/testthat/test-EuroAtlanticTC.R b/tests/testthat/test-EuroAtlanticTC.R index 0f73524..6e3ac4b 100644 --- a/tests/testthat/test-EuroAtlanticTC.R +++ b/tests/testthat/test-EuroAtlanticTC.R @@ -171,7 +171,11 @@ test_that("2. dat1", { c(0.9693774), tolerance = 0.0001 ) - + expect_equal( + EuroAtlanticTC(dat1, lon = lon1, lat = lat1, ntrunc = 4, corr = T)$patterns[, 2, 3], + c(-0.05850999, 0.03827591, -0.04454523, -0.43713946), + tolerance = 0.0001 + ) }) ############################################## -- GitLab From b0b0b60e40c92c3ad9e998a6b61eae51c75a5a48 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 18 May 2021 14:31:43 +0200 Subject: [PATCH 116/154] Allow EuroAtlanticTC to be ProjectField's eof input --- R/EuroAtlanticTC.R | 2 +- R/ProjectField.R | 11 ++++++---- man/EuroAtlanticTC.Rd | 2 +- man/ProjectField.Rd | 5 +++-- tests/testthat/test-ProjectField.R | 34 ++++++++++++++++++++++++++++-- 5 files changed, 44 insertions(+), 10 deletions(-) diff --git a/R/EuroAtlanticTC.R b/R/EuroAtlanticTC.R index 9a61e76..b275520 100644 --- a/R/EuroAtlanticTC.R +++ b/R/EuroAtlanticTC.R @@ -52,7 +52,7 @@ #'@examples #'# Use synthetic data #'set.seed(1) -#'dat <- array(rnorm(800), dim = c(dat = 2, sdate = 5, lat = 8, lon = 15) +#'dat <- array(rnorm(800), dim = c(dat = 2, sdate = 5, lat = 8, lon = 15)) #'lat <- seq(10, 90, length.out = 8) #'lon <- seq(-100, 70, length.out = 15) #'res <- EuroAtlanticTC(ano, lat = lat, lon = lon) diff --git a/R/ProjectField.R b/R/ProjectField.R index 7432632..309f3ef 100644 --- a/R/ProjectField.R +++ b/R/ProjectField.R @@ -2,8 +2,9 @@ #' #'Project anomalies onto modes of variability to get the temporal evolution of #'the EOF mode selected. It returns principal components (PCs) by area-weighted -#'projection onto EOF pattern (from \code{EOF()} or \code{REOF()}). The -#'calculation removes NA and returns NA if the whole spatial pattern is NA. +#'projection onto EOF pattern (from \code{EOF()}) or REOF pattern (from +#'\code{REOF()} or \code{EuroAtlanticTC()}). The calculation removes NA and +#'returns NA if the whole spatial pattern is NA. #' #'@param ano A numerical array of anomalies with named dimensions. The #' dimensions must have at least 'time_dim' and 'space_dim'. It can be @@ -84,9 +85,11 @@ ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon EOFs <- "EOFs" } else if ('REOFs' %in% names(eof)) { EOFs <- "REOFs" + } else if ('patterns' %in% names(eof)) { + EOFs <- "patterns" } else { - stop(paste0("Parameter 'eof' must be a list that contains 'EOFs' or 'REOFs'. ", - "It can be generated by EOF() or REOF().")) + stop(paste0("Parameter 'eof' must be a list that contains 'EOFs', 'REOFs', ", + "or 'patterns'. It can be generated by EOF(), REOF(), or EuroAtlanticTC().")) } if (!'wght' %in% names(eof)) { stop(paste0("Parameter 'eof' must be a list that contains 'wght'. ", diff --git a/man/EuroAtlanticTC.Rd b/man/EuroAtlanticTC.Rd index 7fe1ee4..edeee54 100644 --- a/man/EuroAtlanticTC.Rd +++ b/man/EuroAtlanticTC.Rd @@ -77,7 +77,7 @@ returned. \examples{ # Use synthetic data set.seed(1) -dat <- array(rnorm(800), dim = c(dat = 2, sdate = 5, lat = 8, lon = 15) +dat <- array(rnorm(800), dim = c(dat = 2, sdate = 5, lat = 8, lon = 15)) lat <- seq(10, 90, length.out = 8) lon <- seq(-100, 70, length.out = 15) res <- EuroAtlanticTC(ano, lat = lat, lon = lon) diff --git a/man/ProjectField.Rd b/man/ProjectField.Rd index 1b3833f..358f4ee 100644 --- a/man/ProjectField.Rd +++ b/man/ProjectField.Rd @@ -44,8 +44,9 @@ A numerical array of the principal components in the verification \description{ Project anomalies onto modes of variability to get the temporal evolution of the EOF mode selected. It returns principal components (PCs) by area-weighted -projection onto EOF pattern (from \code{EOF()} or \code{REOF()}). The -calculation removes NA and returns NA if the whole spatial pattern is NA. +projection onto EOF pattern (from \code{EOF()}) or REOF pattern (from +\code{REOF()} or \code{EuroAtlanticTC()}). The calculation removes NA and +returns NA if the whole spatial pattern is NA. } \examples{ \dontshow{ diff --git a/tests/testthat/test-ProjectField.R b/tests/testthat/test-ProjectField.R index 5e0fca6..f3f05ce 100644 --- a/tests/testthat/test-ProjectField.R +++ b/tests/testthat/test-ProjectField.R @@ -43,6 +43,13 @@ context("s2dv::ProjectField tests") tmp <- array(rnorm(72), dim = c(sdate = 6, lat = 4, lon = 3)) eof5 <- EOF(tmp, lat5, lon5, neofs = 6) + # dat6 + set.seed(1) + dat6 <- array(rnorm(480), dim = c(sdate = 10, lat = 6, lon = 8)) + lat6 <- seq(20, 80, length.out = 6) + lon6 <- seq(-90, 60, length.out = 8) + reof6 <- EuroAtlanticTC(dat6, lat6, lon6, ntrunc = 10) + ############################################## test_that("1. Input checks", { @@ -75,8 +82,8 @@ test_that("1. Input checks", { ) expect_error( ProjectField(dat1, list(a = 1)), - paste0("Parameter 'eof' must be a list that contains 'EOFs' or 'REOFs'. ", - "It can be generated by EOF() or REOF()."), + paste0("Parameter 'eof' must be a list that contains 'EOFs', 'REOFs', ", + "or 'patterns'. It can be generated by EOF(), REOF(), or EuroAtlanticTC()."), fixed = TRUE ) eof_fake <- list(EOFs = 'a', wght = 1:10) @@ -271,3 +278,26 @@ test_that("6. dat5", { ) }) +############################################## +test_that("7. dat6", { + expect_equal( + dim(ProjectField(dat6, reof6, mode = 1)), + c(sdate = 10) + ) + expect_equal( + dim(ProjectField(dat6, reof6)), + c(mode = 4, sdate = 10) + ) + expect_equal( + mean(ProjectField(dat6, reof6)), + 0.3080207, + tolerance = 0.0001 + ) + expect_equal( + as.vector(ProjectField(dat6, reof6)[, 1]), + c(4.6114959, 0.8241051, 1.4160364, -0.9601872), + tolerance = 0.0001 + ) + +}) + -- GitLab From 5c6d6c0bfd455f00cd98131538452a6e5dcc7ca8 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 18 May 2021 14:43:33 +0200 Subject: [PATCH 117/154] Fix document --- NAMESPACE | 1 + R/EuroAtlanticTC.R | 2 +- R/REOF.R | 1 + man/EuroAtlanticTC.Rd | 2 +- 4 files changed, 4 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 94af45c..3b71241 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -112,4 +112,5 @@ importFrom(stats,rnorm) importFrom(stats,sd) importFrom(stats,setNames) importFrom(stats,ts) +importFrom(stats,varimax) importFrom(stats,window) diff --git a/R/EuroAtlanticTC.R b/R/EuroAtlanticTC.R index b275520..f35278c 100644 --- a/R/EuroAtlanticTC.R +++ b/R/EuroAtlanticTC.R @@ -55,7 +55,7 @@ #'dat <- array(rnorm(800), dim = c(dat = 2, sdate = 5, lat = 8, lon = 15)) #'lat <- seq(10, 90, length.out = 8) #'lon <- seq(-100, 70, length.out = 15) -#'res <- EuroAtlanticTC(ano, lat = lat, lon = lon) +#'res <- EuroAtlanticTC(dat, lat = lat, lon = lon) #' #'@seealso REOF NAO #'@import multiApply diff --git a/R/REOF.R b/R/REOF.R index b6c953b..7e6e510 100644 --- a/R/REOF.R +++ b/R/REOF.R @@ -71,6 +71,7 @@ #'} #' #'@import multiApply +#'@importFrom stats varimax #'@export REOF <- function(ano, lat, lon, ntrunc = 15, time_dim = 'sdate', space_dim = c('lat', 'lon'), corr = FALSE, ncores = NULL) { diff --git a/man/EuroAtlanticTC.Rd b/man/EuroAtlanticTC.Rd index edeee54..16c90fe 100644 --- a/man/EuroAtlanticTC.Rd +++ b/man/EuroAtlanticTC.Rd @@ -80,7 +80,7 @@ set.seed(1) dat <- array(rnorm(800), dim = c(dat = 2, sdate = 5, lat = 8, lon = 15)) lat <- seq(10, 90, length.out = 8) lon <- seq(-100, 70, length.out = 15) -res <- EuroAtlanticTC(ano, lat = lat, lon = lon) +res <- EuroAtlanticTC(dat, lat = lat, lon = lon) } \seealso{ -- GitLab From 86a2f54f69757e0b52d28ad5d174b15b6b1d1477 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 19 May 2021 11:34:48 +0200 Subject: [PATCH 118/154] Replace ArrayToNetCDF in CDORemap with easyNCDF::ArrayToNc --- DESCRIPTION | 3 ++- NAMESPACE | 1 + R/CDORemap.R | 9 +++++---- man/CDORemap.Rd | 2 +- 4 files changed, 9 insertions(+), 6 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f8f5567..9a5a771 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,7 +36,8 @@ Imports: plyr, ncdf4, NbClust, - multiApply (>= 2.1.1) + multiApply (>= 2.1.1), + easyNCDF Suggests: easyVerification, testthat diff --git a/NAMESPACE b/NAMESPACE index 87937e2..6e7d545 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -69,6 +69,7 @@ importFrom(ClimProjDiags,Subset) importFrom(ClimProjDiags,WeightedMean) importFrom(abind,abind) importFrom(abind,adrop) +importFrom(easyNCDF,ArrayToNc) importFrom(grDevices,bmp) importFrom(grDevices,col2rgb) importFrom(grDevices,colorRampPalette) diff --git a/R/CDORemap.R b/R/CDORemap.R index ae3c988..0ae0be6 100644 --- a/R/CDORemap.R +++ b/R/CDORemap.R @@ -1,4 +1,4 @@ -#'Interpolates arrays with longitude and latitude dimensions using CDO +#'Interpolate arrays with longitude and latitude dimensions using CDO #' #'This function takes as inputs a multidimensional array (optional), a vector #'or matrix of longitudes, a vector or matrix of latitudes, a destination grid @@ -202,6 +202,7 @@ #'tas2 <- CDORemap(tas, lon, lat, 'external_file.nc', 'bil') #'} #'@import ncdf4 +#'@importFrom easyNCDF ArrayToNc #'@importFrom stats lm predict setNames #'@export CDORemap <- function(data_array = NULL, lons, lats, grid, method, @@ -684,7 +685,7 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, names(dim(data_array)) <- paste0('dim', 1:length(dim(data_array))) names(dim(data_array))[c(lon_pos, lat_pos)] <- c(lon_dim, lat_dim) if (!is.null(unlimited_dim)) { - # This will make ArrayToNetCDF create this dim as unlimited. + # This will make ArrayToNc create this dim as unlimited. names(dim(data_array))[unlimited_dim] <- 'time' } if (length(dim(lons)) == 1) { @@ -725,10 +726,10 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, subset <- Subset(data_array, dims_to_iterate, as.list(slice_indices), drop = 'selected') # dims_before_crop <- dim(subset) # Make sure subset goes along with metadata - ArrayToNetCDF(setNames(list(subset, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) + easyNCDF::ArrayToNc(setNames(list(subset, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) } else { # dims_before_crop <- dim(data_array) - ArrayToNetCDF(setNames(list(data_array, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) + easyNCDF::ArrayToNc(setNames(list(data_array, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) } sellonlatbox <- '' if (crop) { diff --git a/man/CDORemap.Rd b/man/CDORemap.Rd index aabb434..c7a00a8 100644 --- a/man/CDORemap.Rd +++ b/man/CDORemap.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/CDORemap.R \name{CDORemap} \alias{CDORemap} -\title{Interpolates arrays with longitude and latitude dimensions using CDO} +\title{Interpolate arrays with longitude and latitude dimensions using CDO} \usage{ CDORemap( data_array = NULL, -- GitLab From 2e727394d592842d59496955fcee525b503986ae Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 20 May 2021 21:05:18 +0200 Subject: [PATCH 119/154] Add param 'conf.lev' in Spectrum() --- R/Filter.R | 2 +- R/Spectrum.R | 36 +++++++++++++++++++++------------- man/Filter.Rd | 2 +- man/Spectrum.Rd | 25 +++++++++++++---------- tests/testthat/test-Spectrum.R | 12 +++++++++--- 5 files changed, 48 insertions(+), 29 deletions(-) diff --git a/R/Filter.R b/R/Filter.R index 94472a2..c4e76bf 100644 --- a/R/Filter.R +++ b/R/Filter.R @@ -27,7 +27,7 @@ #' #'for (jsdate in 1:dim(spectrum)['sdate']) { #' for (jlen in 1:dim(spectrum)['ftime']) { -#' if (spectrum[jlen, 2, 1, jsdate] > spectrum[jlen, 4, 1, jsdate]) { +#' if (spectrum[jlen, 2, 1, jsdate] > spectrum[jlen, 3, 1, jsdate]) { #' ensmod[1, jsdate, ] <- Filter(ensmod[1, jsdate, ], spectrum[jlen, 1, 1, jsdate]) #' } #' } diff --git a/R/Spectrum.R b/R/Spectrum.R index 7bf07be..2cbb167 100644 --- a/R/Spectrum.R +++ b/R/Spectrum.R @@ -1,11 +1,13 @@ #'Estimate frequency spectrum #' -#'Estimate the frequency spectrum of the data array together with its 95\% and -#'99\% significance level. The output is provided as an array with dimensions -#'c(number of frequencies, 4). The column contains the frequency values, the -#'power, the 95\% significance level and the 99\% one.\cr -#'The spectrum estimation relies on a R built-in function \code{spectrum()} -#'and the significance levels are estimated by a Monte-Carlo method. +#'Estimate the frequency spectrum of the data array together with a +#'user-specified confidence level. The output is provided as an array with +#'dimensions c(number of frequencies, stats = 3, other margin dimensions of +#'data). The 'stats' dimension contains the frequencies at which the spectral +#'density is estimated, the estimates of the spectral density, and the +#'significance level.\cr +#'The spectrum estimation relies on an R built-in function \code{spectrum()} +#'and the confidence interval is estimated by the Monte-Carlo method. #' #'@param data A vector or numeric array of which the frequency spectrum is #' required. If it's a vector, it should be a time series. If it's an array, @@ -13,13 +15,15 @@ #' 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 ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' #'@return A numeric array of the frequency spectrum with dimensions -#' c( = number of frequencies, stats = 4, the rest of the +#' c( = number of frequencies, stats = 3, the rest of the #' dimensions of 'data'). The 'stats' dimension contains the frequency values, -#' the power, the 95\% significance level and the 99\% one. +#' the spectral density, and the confidence interval. #' #'@examples #'# Load sample data as in Load() example: @@ -29,7 +33,7 @@ #' #'for (jsdate in 1:dim(spectrum)['sdate']) { #' for (jlen in 1:dim(spectrum)['ftime']) { -#' if (spectrum[jlen, 2, 1, jsdate] > spectrum[jlen, 4, 1, jsdate]) { +#' if (spectrum[jlen, 2, 1, jsdate] > spectrum[jlen, 3, 1, jsdate]) { #' ensmod[1, jsdate, ] <- Filter(ensmod[1, jsdate, ], spectrum[jlen, 1, 1, jsdate]) #' } #' } @@ -41,7 +45,7 @@ #'@import multiApply #'@importFrom stats spectrum cor rnorm sd quantile #'@export -Spectrum <- function(data, time_dim = 'ftime', ncores = NULL) { +Spectrum <- function(data, time_dim = 'ftime', conf.lev = 0.95, ncores = NULL) { # Check inputs ## data @@ -65,6 +69,10 @@ Spectrum <- function(data, time_dim = 'ftime', 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.") + } ## ncores if (!is.null(ncores)) { if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | @@ -80,12 +88,13 @@ Spectrum <- function(data, time_dim = 'ftime', ncores = NULL) { target_dims = time_dim, fun = .Spectrum, output_dims = c(time_dim, 'stats'), + conf.lev = conf.lev, ncores = ncores)$output1 return(output) } -.Spectrum <- function(data) { +.Spectrum <- function(data, conf.lev = 0.95) { # data: [time] data <- data[is.na(data) == FALSE] @@ -93,7 +102,7 @@ Spectrum <- function(data, time_dim = 'ftime', ncores = NULL) { if (ndat >= 3) { tmp <- spectrum(data, plot = FALSE) - output <- array(dim = c(length(tmp$spec), 4)) + output <- array(dim = c(length(tmp$spec), 3)) output[, 1] <- tmp$freq output[, 2] <- tmp$spec ntir <- 100 @@ -110,8 +119,7 @@ Spectrum <- function(data, time_dim = 'ftime', ncores = NULL) { store[jt, ] <- toto2$spec } for (jx in 1:length(tmp$spec)) { - output[jx, 3] <- quantile(store[, jx], 0.95) - output[jx, 4] <- quantile(store[, jx], 0.99) + output[jx, 3] <- quantile(store[, jx], conf.lev) } } else { output <- NA diff --git a/man/Filter.Rd b/man/Filter.Rd index 814acf1..f98fe0a 100644 --- a/man/Filter.Rd +++ b/man/Filter.Rd @@ -39,7 +39,7 @@ spectrum <- Spectrum(ensmod) for (jsdate in 1:dim(spectrum)['sdate']) { for (jlen in 1:dim(spectrum)['ftime']) { - if (spectrum[jlen, 2, 1, jsdate] > spectrum[jlen, 4, 1, jsdate]) { + if (spectrum[jlen, 2, 1, jsdate] > spectrum[jlen, 3, 1, jsdate]) { ensmod[1, jsdate, ] <- Filter(ensmod[1, jsdate, ], spectrum[jlen, 1, 1, jsdate]) } } diff --git a/man/Spectrum.Rd b/man/Spectrum.Rd index d5e4ed5..84b39c0 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", ncores = NULL) +Spectrum(data, time_dim = "ftime", conf.lev = 0.95, ncores = NULL) } \arguments{ \item{data}{A vector or numeric array of which the frequency spectrum is @@ -15,22 +15,27 @@ 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{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } \value{ A numeric array of the frequency spectrum with dimensions - c( = number of frequencies, stats = 4, the rest of the + c( = number of frequencies, stats = 3, the rest of the dimensions of 'data'). The 'stats' dimension contains the frequency values, - the power, the 95\% significance level and the 99\% one. + the spectral density, and the confidence interval. } \description{ -Estimate the frequency spectrum of the data array together with its 95\% and -99\% significance level. The output is provided as an array with dimensions -c(number of frequencies, 4). The column contains the frequency values, the -power, the 95\% significance level and the 99\% one.\cr -The spectrum estimation relies on a R built-in function \code{spectrum()} -and the significance levels are estimated by a Monte-Carlo method. +Estimate the frequency spectrum of the data array together with a +user-specified confidence level. The output is provided as an array with +dimensions c(number of frequencies, stats = 3, other margin dimensions of +data). The 'stats' dimension contains the frequencies at which the spectral +density is estimated, the estimates of the spectral density, and the +significance level.\cr +The spectrum estimation relies on an R built-in function \code{spectrum()} +and the confidence interval is estimated by the Monte-Carlo method. } \examples{ # Load sample data as in Load() example: @@ -40,7 +45,7 @@ spectrum <- Spectrum(ensmod) for (jsdate in 1:dim(spectrum)['sdate']) { for (jlen in 1:dim(spectrum)['ftime']) { - if (spectrum[jlen, 2, 1, jsdate] > spectrum[jlen, 4, 1, jsdate]) { + if (spectrum[jlen, 2, 1, jsdate] > spectrum[jlen, 3, 1, jsdate]) { ensmod[1, jsdate, ] <- Filter(ensmod[1, jsdate, ], spectrum[jlen, 1, 1, jsdate]) } } diff --git a/tests/testthat/test-Spectrum.R b/tests/testthat/test-Spectrum.R index 0a54101..caf53d3 100644 --- a/tests/testthat/test-Spectrum.R +++ b/tests/testthat/test-Spectrum.R @@ -38,6 +38,12 @@ test_that("1. Input checks", { Spectrum(dat1, time_dim = 2), "Parameter 'time_dim' must be a character string." ) + # conf.lev + expect_error( + Spectrum(dat1, conf.lev = -1), + "Parameter 'conf.lev' must be a numeric number between 0 and 1.", + fixed = T + ) # ncores expect_error( Spectrum(dat1, ncore = 3.5), @@ -50,7 +56,7 @@ test_that("2. Output checks: dat1", { expect_equal( dim(Spectrum(dat1)), - c(ftime = 2, stats = 4, dat = 1, sdate = 2) + c(ftime = 2, stats = 3, dat = 1, sdate = 2) ) expect_equal( Spectrum(dat1)[, 1, 1, 2], @@ -70,7 +76,7 @@ test_that("3. Output checks: dat2", { expect_equal( dim(Spectrum(dat2)), - c(ftime = 5, stats = 4) + c(ftime = 5, stats = 3) ) expect_equal( Spectrum(dat2)[, 1], @@ -89,7 +95,7 @@ test_that("3. Output checks: dat2", { test_that("4. Output checks: dat3", { expect_equal( dim(Spectrum(dat3)), - c(ftime = 4, stats = 4) + c(ftime = 4, stats = 3) ) expect_equal( Spectrum(dat3)[, 1], -- GitLab From e13fcb2ea1036d7ed93551f1fb5d6939361690fe Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 21 May 2021 11:47:26 +0200 Subject: [PATCH 120/154] Add check for 'sdate' --- R/PlotAno.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/PlotAno.R b/R/PlotAno.R index 08a9ab8..9a4a971 100644 --- a/R/PlotAno.R +++ b/R/PlotAno.R @@ -110,6 +110,11 @@ PlotAno <- function(exp_ano, obs_ano = NULL, sdates, toptitle = rep('', 15), } else { nobs <- 0 } + # sdate check + if (!all(nchar(sdates) == 8)) { + stop ("The parameter 'sdates' must be formatted as YYYYMMDD.") + } + if (is.null(limits) == TRUE) { if (memb) { ll <- min(min(exp_ano, na.rm = TRUE), min(obs_ano, na.rm = TRUE), na.rm = TRUE) -- GitLab From fbc3d3b4a54f98de41af589c3321f3df96d28845 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 21 May 2021 17:26:54 +0200 Subject: [PATCH 121/154] Remove the previous development of first time step. --- R/Load.R | 101 +++---------------------------------------------------- 1 file changed, 4 insertions(+), 97 deletions(-) diff --git a/R/Load.R b/R/Load.R index 0392c74..955c894 100644 --- a/R/Load.R +++ b/R/Load.R @@ -1376,7 +1376,6 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, dims2define <- TRUE is_file_per_member_exp <- rep(nmod, FALSE) exp_work_pieces <- list() - first_time_step_list <- NULL jmod <- 1 while (jmod <= nmod) { first_dataset_file_found <- FALSE @@ -1422,21 +1421,6 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, if (is_file_per_member_exp[jmod]) { replace_values[["MEMBER_NUMBER"]] <- '*' } - if (jsdate == 1) { - work_piecetime <- list(dataset_type = dataset_type, - filename = .ConfigReplaceVariablesInString(quasi_final_path, - replace_values), - namevar = namevar, grid = grid, remap = remap, - remapcells = remapcells, - is_file_per_member = is_file_per_member_exp[jmod], - is_file_per_dataset = FALSE, - lon_limits = c(lonmin, lonmax), - lat_limits = c(latmin, latmax), dimnames = exp[[jmod]][['dimnames']], - single_dataset = single_dataset) - looking_time <- .LoadDataFile(work_piecetime, explore_dims = TRUE, - silent = silent) - first_time_step_list <- c(first_time_step_list, list(looking_time$time_dim)) - } # If the dimensions of the output matrices are still to define, we try to read # the metadata of the data file that corresponds to the current iteration if (dims2define) { @@ -1541,7 +1525,6 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, jsdate <- jsdate + 1 } replace_values[extra_vars] <- NULL - #first_dataset_file_found <- FALSE jmod <- jmod + 1 } if (dims2define && length(exp) > 0) { @@ -1582,52 +1565,6 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, } leadtimes <- seq(leadtimemin, leadtimemax, sampleperiod) } - # If there are differences in the first time stamp in exp files: - if (!is.null(exp)) { - in_date <- lapply(first_time_step_list, function(x) { - origin <- as.POSIXct( - paste(strsplit(x$time_units, " ")[[1]][c(3,4)], - collapse = " "), tz = 'UTC') - units <- strsplit(x$time_units, " ")[[1]][1] - if (units == 'hours') { - exp_first_time_step <- as.POSIXct( - x$first_time_step_in_file * - 3600, origin = origin, tz = 'UTC') - } else if (units == 'days') { - exp_first_time_step <- as.POSIXct( - x$first_time_step_in_file * - 86400, origin = origin, tz = 'UTC') - } - day <- as.numeric(format(exp_first_time_step, "%d")) - return(day) - }) - exp_first_time_step <- min(unlist(in_date)) - if (max(unlist(in_date)) > 1) { - leadtimes <- seq(exp_first_time_step, leadtimemax + max(unlist(in_date)) - 1, - sampleperiod) - } - if (leadtimemin > 1 & length(in_date) > 1) { - lags <- lapply(in_date, function(x) {x - in_date[[1]]}) - new_leadtimemin <- lapply(lags, function(x) {leadtimemin - x}) - new_leadtimemax <- lapply(lags, function(x) {leadtimemax - x}) - jmod <- 2 - npieces <- length(exp_work_pieces)/nmod - while (jmod <= nmod) { - jpiece <- 1 - while (jpiece <= npieces) { - exp_work_pieces[[npieces * (jmod - 1) + jpiece]]$leadtimes <- - seq(new_leadtimemin[[jmod]], new_leadtimemax[[jmod]], sampleperiod) - jpiece <- jpiece + 1 - } - jmod <- jmod + 1 - } - } - lag <- 1 - in_date[[1]] - leadtimes <- seq(leadtimemin - lag, leadtimemax #+ max(unlist(in_date)) + lag, - - lag, - sampleperiod) - exp_first_time_step <- leadtimemin - lag - } # Now we start iterating over observations. We try to find the output matrix # dimensions and we build anyway the work pieces corresponding to the observational # data that time-corresponds the experimental data or the time-steps until the @@ -1691,7 +1628,6 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, found_data <- .LoadDataFile(work_piece, explore_dims = TRUE, silent = silent) found_dims <- found_data$dims var_long_name <- found_data$var_long_name - first_time_step_list <- c(first_time_step_list, list(found_data$time_dim)) units <- found_data$units if (!is.null(found_dims)) { is_2d_var <- found_data$is_2d_var @@ -1789,18 +1725,8 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, ## This condition must be fulfilled to put all the month time steps ## in the dimension of length nleadtimes. Otherwise it must be cut: #(length(leadtimes) - 1)*sampleperiod + 1 - (jleadtime - 1)*sampleperiod >= days_in_month - day + 1 - - ## The first time step in exp could be different from sdate: - if (jleadtime == 1 & !is.null(exp)) { - if (is.null(first_time_step_list[[1]])) { - stop("Check 'time' variable in the experimental files ", - "since not units or first time step have been found.") - } else { - day <- leadtimes[1] - } - } - obs_file_indices <- seq(day, min(days_in_month, - (length(leadtimes) - jleadtime) * sampleperiod + day), sampleperiod) + obs_file_indices <- seq(day, min(days_in_month, (length(leadtimes) - jleadtime) * sampleperiod + day), sampleperiod) + } else { obs_file_indices <- 1 } @@ -1896,8 +1822,7 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, } if (storefreq == 'daily') { - startdate <- startdate + 86400 * sampleperiod * - max(obs_file_indices) + startdate <- startdate + 86400 * sampleperiod * length(obs_file_indices) year <- as.integer(substr(startdate, 1, 4)) month <- as.integer(substr(startdate, 6, 7)) day <- as.integer(substr(startdate, 9, 10)) @@ -2300,24 +2225,7 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, # Start is a list with as many components as start dates. # Each component is a vector of the initial POSIXct date of each # forecast time step - if (!is.null(exp)) { - if (storefreq == 'daily' & leadtimes[[1]] > 1) { - origin <- leadtimes[[1]] - 1 - leadtimemin <- 1 - } else { - origin <- 0 - } - dates[["start"]] <- do.call(c, lapply(sdates, - function(x) { - do.call(c, lapply((origin:(origin + number_ftime - 1)) * sampleperiod, - function(y) { - addTime(as.POSIXct(x, format = "%Y%m%d", tz = "UTC"), - store_period, y + leadtimemin - 1) - })) - })) - } else { - origin <- 0 - dates[["start"]] <- do.call(c, lapply(sdates, + dates[["start"]] <- do.call(c, lapply(sdates, function(x) { do.call(c, lapply((0:(number_ftime - 1)) * sampleperiod, function(y) { @@ -2325,7 +2233,6 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, store_period, y + leadtimemin - 1) })) })) - } attr(dates[["start"]], "tzone") <- "UTC" # end is similar to start, but contains the end dates of each forecast # time step -- GitLab From 0071da0b4b3a4906b8561fa6037ebf85214769bd Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 21 May 2021 17:59:37 +0200 Subject: [PATCH 122/154] Reverse Utils.R --- R/Utils.R | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/R/Utils.R b/R/Utils.R index 03439dd..6dc558a 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -600,9 +600,6 @@ nltime <- fnc$var[[namevar]][['dim']][[match(time_dimname, var_dimnames)]]$len expected_dims <- c(expected_dims, time_dimname) dim_matches <- match(expected_dims, var_dimnames) - first_time_step_in_file <- fnc$var[[namevar]][['dim']][[match(time_dimname, - var_dimnames)]]$vals[1] - time_units <- fnc$var[[namevar]][['dim']][[match(time_dimname, var_dimnames)]]$units } else { if (!is.null(old_members_dimname)) { expected_dims[which(expected_dims == 'lev')] <- old_members_dimname @@ -950,9 +947,7 @@ if (explore_dims) { list(dims = dims, is_2d_var = is_2d_var, grid = grid_name, units = units, var_long_name = var_long_name, - data_across_gw = data_across_gw, array_across_gw = array_across_gw, - time_dim = list(first_time_step_in_file = first_time_step_in_file, - time_units = time_units)) + data_across_gw = data_across_gw, array_across_gw = array_across_gw) } else { ###if (!silent && !is.null(progress_connection) && !is.null(work_piece[['progress_amount']])) { ### foobar <- writeBin(work_piece[['progress_amount']], progress_connection) -- GitLab From 89634143acbdef573fd4d85a6fa352f11b13f352 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 26 May 2021 18:04:17 +0200 Subject: [PATCH 123/154] Add '-L' option in cdo command. It prevents potential segmentation fault in the underlying hdf5 library. --- R/Utils.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/R/Utils.R b/R/Utils.R index 6dc558a..11bebc5 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -420,7 +420,9 @@ filecopy <- tempfile(pattern = "load", fileext = ".nc") file.copy(filein, filecopy) filein <- tempfile(pattern = "loadRegridded", fileext = ".nc") - system(paste0("cdo -s remap", work_piece[['remap']], ",", + # "-L" is to serialize I/O accesses. It prevents potential segmentation fault in the + # underlying hdf5 library. + system(paste0("cdo -L -s remap", work_piece[['remap']], ",", common_grid_name, " -selname,", namevar, " ", filecopy, " ", filein, " 2>/dev/null", sep = "")) @@ -752,7 +754,7 @@ ncatt_put(fnc2, ncdf_var, 'scale_factor', scale_factor) } nc_close(fnc2) - system(paste0("cdo -s -sellonlatbox,", if (lonmin > lonmax) { + system(paste0("cdo -L -s -sellonlatbox,", if (lonmin > lonmax) { "0,360," } else { paste0(lonmin, ",", lonmax, ",") @@ -794,7 +796,7 @@ fnc_mask <- nc_create(mask_file, list(ncdf_var)) ncvar_put(fnc_mask, ncdf_var, array(rep(0, 4), dim = c(2, 2))) nc_close(fnc_mask) - system(paste0("cdo -s remap", work_piece[['remap']], ",", common_grid_name, + system(paste0("cdo -L -s remap", work_piece[['remap']], ",", common_grid_name, " ", mask_file, " ", mask_file_remap, " 2>/dev/null", sep = "")) fnc_mask <- nc_open(mask_file_remap) mask_lons <- ncvar_get(fnc_mask, 'lon') -- GitLab From 59dce48f22ac23a12b8011e208061df243256f11 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 27 May 2021 14:23:11 +0200 Subject: [PATCH 124/154] Revise documentation for ntrunc --- R/REOF.R | 9 +++++---- man/REOF.Rd | 9 +++++---- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/R/REOF.R b/R/REOF.R index 7e6e510..c9c82cf 100644 --- a/R/REOF.R +++ b/R/REOF.R @@ -14,10 +14,11 @@ #'@param space_dim A vector of two character strings. The first is the dimension #' name of latitude of 'ano' and the second is the dimension name of longitude #' of 'ano'. The default value is c('lat', 'lon'). -#'@param ntrunc A positive integer of the modes to be kept. The default value -#' is 15. If time length or the product of latitude length and longitude -#' length is less than ntrunc, ntrunc is equal to the minimum of the three -#' values. +#'@param ntrunc A positive integer of the number of eofs to be kept for varimax +#' rotation. This function uses this value as 'neof' too, which is the number +#' of eofs to return by \code{.EOF()}. The default value is 15. If time length +#' or the product of latitude length and longitude length is less than +#' 'ntrunc', 'ntrunc' is equal to the minimum of the three values. #'@param corr A logical value indicating whether to base on a correlation (TRUE) #' or on a covariance matrix (FALSE). The default value is FALSE. #'@param ncores An integer indicating the number of cores to use for parallel diff --git a/man/REOF.Rd b/man/REOF.Rd index ca5473b..a5d416c 100644 --- a/man/REOF.Rd +++ b/man/REOF.Rd @@ -23,10 +23,11 @@ REOF. The dimensions must have at least 'time_dim' and 'space_dim'.} \item{lon}{A vector of the longitudes of 'ano'.} -\item{ntrunc}{A positive integer of the modes to be kept. The default value -is 15. If time length or the product of latitude length and longitude -length is less than ntrunc, ntrunc is equal to the minimum of the three -values.} +\item{ntrunc}{A positive integer of the number of eofs to be kept for varimax +rotation. This function uses this value as 'neof' too, which is the number +of eofs to return by \code{.EOF()}. The default value is 15. If time length +or the product of latitude length and longitude length is less than +'ntrunc', 'ntrunc' is equal to the minimum of the three values.} \item{time_dim}{A character string indicating the name of the time dimension of 'ano'. The default value is 'sdate'.} -- GitLab From 6a3c46b32b607fff3385d0ebe45aaf17c7f26897 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 1 Jun 2021 13:10:52 +0200 Subject: [PATCH 125/154] Adjust param 'thresholds' of BrierScore(). Check if 'exp' is 0/1 if memb_dim exists. --- R/BrierScore.R | 52 +++++++----- R/UltimateBrier.R | 12 ++- tests/testthat/test-BrierScore.R | 123 ++++++++++++++++++++++------ tests/testthat/test-UltimateBrier.R | 6 +- 4 files changed, 140 insertions(+), 53 deletions(-) diff --git a/R/BrierScore.R b/R/BrierScore.R index b49e0b6..8fc45c2 100644 --- a/R/BrierScore.R +++ b/R/BrierScore.R @@ -5,16 +5,18 @@ #'also returns the bias-corrected decomposition of the BS (Ferro and Fricker, #'2012). BSS has the climatology as the reference forecast. #' -#'@param exp A vector or a numeric array with named dimensions of the probablistic -#' prediction data. The dimension must at least have 'time_dim'. It may have -#' 'memb_dim' for performing ensemble mean. The values should be within the +#'@param exp A vector or a numeric array with named dimensions. It should be +#' the predicted probabilities which are within the range [0, 1] if memb_dim +#' doesn't exist. If it has memb_dim, the value should be 0 or 1, and the +#' predicted probabilities will be computed by ensemble mean. The dimensions +#' must at least have 'time_dim'. #' range [0, 1]. #'@param obs A numeric array with named dimensions of the binary observations #' (0 or 1). The dimension must at least have 'time_dim' and other dimensions -#' of 'exp' except 'memb_dim' (optional). The length of 'dat_dim' can be -#' different from 'exp', and the length of 'memb_dim' must be 1 if it has. +#' of 'exp' except 'memb_dim', which is optional. The length of 'dat_dim' can +#' be different from 'exp', and the length of 'memb_dim' must be 1 if it has. #'@param thresholds A numeric vector used to bin the forecasts. The default -#' value is \code{seq(0, 1, 0.1)}, which means that the bins are +#' value is \code{seq(0.1, 0.9, 0.1)}, which means that the bins are #' \code{[0, 0.1), [0.1, 0.2), ... [0.9, 1]}. #'@param time_dim A character string indicating the name of dimension along #' which Brier score is computed. The default value is 'sdate'. @@ -75,9 +77,6 @@ #'exp <- runif(10) #'obs <- round(exp) #'x <- BrierScore(exp, obs) -#'res <- x$bs - x$bs_check_res -#'res <- x$bs - x$bs_check_gres -#'res <- x$rel_bias_corrected - x$gres_bias_corrected + x$unc_bias_corrected #' #'#===============uncomment the examples below when ProbBins is included========== #'# Inputs are arrays @@ -88,7 +87,7 @@ #' #'@import multiApply #'@export -BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate', +BrierScore <- function(exp, obs, thresholds = seq(0.1, 0.9, 0.1), time_dim = 'sdate', dat_dim = NULL, memb_dim = NULL, ncores = NULL) { # Check inputs @@ -97,7 +96,7 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' stop("Parameter 'exp' and 'obs' cannot be NULL.") } if (!is.numeric(exp) | !is.numeric(obs)) { - stop("Parameter 'exp' and 'obs' must be a vector or a numeric array.") + stop("Parameter 'exp' and 'obs' must be a numeric vector or a numeric array.") } if (is.null(dim(exp))) { #is vector dim(exp) <- c(length(exp)) @@ -111,9 +110,6 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' any(is.null(names(dim(obs))))| any(nchar(names(dim(obs))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names.") } - if (max(exp) > 1 | min(exp) < 0) { - stop("Parameter 'exp' must be within [0, 1] range.") - } if (any(!obs %in% c(0, 1))) { stop("Parameter 'obs' must be binary events (0 or 1).") } @@ -121,6 +117,9 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' if (!is.numeric(thresholds) | !is.vector(thresholds)) { stop("Parameter 'thresholds' must be a numeric vector.") } + if (any(thresholds <= 0 | thresholds >= 1)) { + stop("Parameter 'thresholds' must be between 0 and 1 as the bin-breaks.") + } ## time_dim if (!is.character(time_dim) | length(time_dim) > 1) { stop("Parameter 'time_dim' must be a character string.") @@ -152,6 +151,15 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' } } ## exp and obs (2) + if (is.null(memb_dim)) { + if (max(exp) > 1 | min(exp) < 0) { + stop("Parameter 'exp' must be within [0, 1] range.") + } + } else { + if (any(!exp %in% c(0, 1))) { + stop("Parameter 'exp' must be 0 or 1 if it has memb_dim.") + } + } name_exp <- sort(names(dim(exp))) name_obs <- sort(names(dim(obs))) if (!is.null(memb_dim)) { @@ -210,7 +218,7 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' return(res) } -.BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1)) { +.BrierScore <- function(exp, obs, thresholds = seq(0.1, 0.9, 0.1)) { # exp: [sdate] or [sdate, nexp] # obs: [sdate] or [sdate, nobs] @@ -225,7 +233,7 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' arr_gres_bias_corrected <- arr_unc_bias_corrected <- arr_bss_bias_corrected <- array(dim = c(nexp = nexp, nobs = nobs)) arr_nk <- arr_fkbar <- arr_okbar <- - array(dim = c(nexp = nexp, nobs = nobs, bin = length(thresholds) - 1)) + array(dim = c(nexp = nexp, nobs = nobs, bin = length(thresholds) + 1)) } else { nexp <- 1 @@ -239,13 +247,15 @@ BrierScore <- function(exp, obs, thresholds = seq(0, 1, 0.1), time_dim = 'sdate' obs <- obs_ori[, n_obs] } n <- length(exp) - nbins <- length(thresholds) - 1 # Number of bins - bins <- as.list(paste("bin", 1:nbins, sep = "")) + nbins <- length(thresholds) + 1 # Number of bins + bins <- vector('list', nbins) #as.list(paste("bin", 1:nbins, sep = "")) for (i in 1:nbins) { - if (i == nbins) { - bins[[i]] <- list(which(exp >= thresholds[i] & exp <= thresholds[i + 1])) + if (i == 1) { + bins[[i]] <- list(which(exp >= 0 & exp < thresholds[i])) + } else if (i == nbins) { + bins[[i]] <- list(which(exp >= thresholds[i - 1] & exp <= 1)) } else { - bins[[i]] <- list(which(exp >= thresholds[i] & exp < thresholds[i + 1])) + bins[[i]] <- list(which(exp >= thresholds[i - 1] & exp < thresholds[i])) } } diff --git a/R/UltimateBrier.R b/R/UltimateBrier.R index 60e8b80..aeaddcd 100644 --- a/R/UltimateBrier.R +++ b/R/UltimateBrier.R @@ -20,7 +20,8 @@ #' compute the probabilistic scores. The default value is 'sdate'. #'@param quantile A logical value to decide whether a quantile (TRUE) or a #' threshold (FALSE) is used to estimate the forecast and observed -#' probabilities. The default value is TRUE. +#' probabilities. If 'type' is 'FairEnsembleBS' or 'FairEnsembleBSS', it must +#' be TRUE. The default value is TRUE. #'@param thr A numeric vector to be used in probability calculation (for 'BS', #' 'FairStartDatesBS', 'BSS', and 'FairStartDatesBSS') and binary event #' judgement (for 'FairEnsembleBS' and 'FairEnsembleBSS'). It is as @@ -55,7 +56,7 @@ #'c(nexp, nobs, no. of bins, the rest dimensions of 'exp' except 'time_dim' and #''memb_dim'). 'nexp' and 'nobs' is the length of dataset dimension in 'exp' #'and 'obs' respectively.\cr -#'The list of 4 inlcudes: +#'The list of 4 includes: #' \itemize{ #' \item{$bs: Brier Score} #' \item{$rel: Reliability component} @@ -151,10 +152,13 @@ UltimateBrier <- function(exp, obs, dat_dim = 'dataset', memb_dim = 'member', ti stop("Parameter 'thr' must be a numeric vector.") } if (quantile) { - if (!all(thr <= 1 & thr >= 0)) { - stop("Parameter 'thr' must be within [0, 1] when quantile is TRUE.") + if (!all(thr < 1 & thr > 0)) { + stop("Parameter 'thr' must be between 0 and 1 when quantile is TRUE.") } } + if (!quantile & (type %in% c('FairEnsembleBSS', 'FairEnsembleBS'))) { + stop("Parameter 'quantile' must be TRUE if 'type' is 'FairEnsembleBSS' or 'FairEnsembleBS'.") + } ## type if (!(type %in% c("BS", "BSS", "FairEnsembleBS", "FairEnsembleBSS", "FairStartDatesBS", "FairStartDatesBSS"))) { stop("Parameter 'type' must be one of 'BS', 'BSS', 'FairEnsembleBS', 'FairEnsembleBSS', 'FairStartDatesBS' or 'FairStartDatesBSS'.") diff --git a/tests/testthat/test-BrierScore.R b/tests/testthat/test-BrierScore.R index f1ff1e4..5668a08 100644 --- a/tests/testthat/test-BrierScore.R +++ b/tests/testthat/test-BrierScore.R @@ -3,7 +3,7 @@ context("s2dv::BrierScore tests") ############################################## # dat1 set.seed(1) -exp1 <- array(runif(30), dim = c(dataset = 1, member = 3, sdate = 5, ftime = 2)) +exp1 <- array(runif(10), dim = c(dataset = 1, sdate = 5, ftime = 2)) set.seed(2) obs1 <- array(round(runif(10)), dim = c(dataset = 1, sdate = 5, ftime = 2)) @@ -13,6 +13,13 @@ exp2 <- runif(10) set.seed(2) obs2 <- round(runif(10)) +# dat3 +set.seed(1) +exp3 <- array(sample(c(0, 1), 60, replace = T), + dim = c(dataset = 2, member = 3, sdate = 5, ftime = 2)) +set.seed(2) +obs3 <- array(sample(c(0, 1), 10, replace = T), + dim = c(dataset = 1, sdate = 5, ftime = 2)) ############################################## test_that("1. Input checks", { @@ -23,7 +30,7 @@ test_that("1. Input checks", { ) expect_error( BrierScore(c('b'), obs1), - "Parameter 'exp' and 'obs' must be a vector or a numeric array." + "Parameter 'exp' and 'obs' must be a numeric vector or a numeric array." ) expect_error( BrierScore(array(1:10, dim = c(2, 5)), array(1:4, dim = c(2, 2))), @@ -34,11 +41,15 @@ test_that("1. Input checks", { "Parameter 'exp' must be within \\[0, 1\\] range." ) expect_error( + BrierScore(exp = array(exp1, dim = dim(exp3)), obs = obs3, memb_dim = 'member'), + "Parameter 'exp' must be 0 or 1 if it has memb_dim." + ) + expect_error( BrierScore(exp1, runif(10)), "Parameter 'obs' must be binary events \\(0 or 1\\)." ) expect_error( - BrierScore(exp1, obs1), + BrierScore(exp3, obs3), paste0("Parameter 'exp' and 'obs' must have the same names and lengths ", "of all the dimensions expect 'dat_dim' and 'memb_dim'.") ) @@ -47,6 +58,10 @@ test_that("1. Input checks", { BrierScore(exp2, obs2, thresholds = TRUE), "Parameter 'thresholds' must be a numeric vector." ) + expect_error( + BrierScore(exp2, obs2, thresholds = seq(0, 1, length.out = 4)), + "Parameter 'thresholds' must be between 0 and 1 as the bin-breaks." + ) # time_dim expect_error( BrierScore(exp2, obs2, time_dim = 1), @@ -75,7 +90,7 @@ test_that("1. Input checks", { "Parameter 'memb_dim' is not found in 'exp' dimension." ) expect_error( - BrierScore(exp1, array(1, dim = c(dataset = 1, member = 3, sdate = 5, ftime = 2)), memb_dim = 'member'), + BrierScore(exp3, array(1, dim = c(dataset = 1, member = 3, sdate = 5, ftime = 2)), memb_dim = 'member'), "The length of parameter 'memb_dim' in 'obs' must be 1." ) # ncores @@ -86,74 +101,75 @@ test_that("1. Input checks", { }) + ############################################## test_that("2. Output checks: dat1", { expect_equal( -length(BrierScore(exp1, obs1, memb_dim = 'member')), +length(BrierScore(exp1, obs1)), 16 ) expect_equal( -names(BrierScore(exp1, obs1, memb_dim = 'member')), +names(BrierScore(exp1, obs1)), c('rel', 'res', 'unc', 'bs', 'bs_check_res', 'bss_res', 'gres', 'bs_check_gres', 'bss_gres', 'rel_bias_corrected', 'gres_bias_corrected', 'unc_bias_corrected', 'bss_bias_corrected', 'nk', 'fkbar', 'okbar') ) expect_equal( -dim(BrierScore(exp1, obs1, memb_dim = 'member')$rel), +dim(BrierScore(exp1, obs1)$rel), c(dataset = 1, ftime = 2) ) expect_equal( -BrierScore(exp1, obs1, memb_dim = 'member')$rel[1, ], -c(0.1013649, 0.2549810), +BrierScore(exp1, obs1)$rel[1, ], +c(0.3086934, 0.3650011), tolerance = 0.0001 ) expect_equal( -BrierScore(exp1, obs1, memb_dim = 'member')$res[1, ], -c(0.24, 0.24), +BrierScore(exp1, obs1)$res[1, ], +c(0.14, 0.14), tolerance = 0.0001 ) expect_equal( -BrierScore(exp1, obs1, memb_dim = 'member')$bs[1, ], -c(0.1016759, 0.2549810), +BrierScore(exp1, obs1)$bs[1, ], +c(0.4218661, 0.4587647), tolerance = 0.0001 ) expect_equal( -dim(BrierScore(exp1, obs1, memb_dim = 'member')$okbar), +dim(BrierScore(exp1, obs1)$okbar), c(bin = 10, dataset = 1, ftime = 2) ) expect_equal( -BrierScore(exp1, obs1, memb_dim = 'member')$okbar[, 1, 1], -c(NaN, 0, NaN, NaN, 0, NaN, 1, 1, NaN, NaN) +BrierScore(exp1, obs1)$okbar[, 1, 1], +c(NaN, NaN, 0.5,1.0, NaN, 1.0, NaN, NaN, NaN, 0.0) ) expect_equal( -BrierScore(exp1, obs1, memb_dim = 'member')$fkbar[, 1, 1], -c(NaN, 0.1481059, NaN, NaN, 0.4034953, NaN, 0.6415412, 0.7448624, NaN, NaN), +BrierScore(exp1, obs1)$fkbar[, 1, 1], +c(NaN, NaN, 0.2335953, 0.3721239, NaN, 0.5728534, NaN, NaN, NaN, 0.9082078), tolerance = 0.0001 ) expect_equal( -BrierScore(exp1, obs1, memb_dim = 'member')$nk[, 1, 1], -c(0, 1, 0, 0, 1, 0, 2, 1, 0, 0) +BrierScore(exp1, obs1)$nk[, 1, 1], +c(0, 0, 2, 1, 0, 1, 0, 0, 0, 1) ) expect_equal( -dim(BrierScore(exp1, obs1, memb_dim = 'member', dat_dim = 'dataset')$rel), +dim(BrierScore(exp1, obs1, dat_dim = 'dataset')$rel), c(nexp = 1, nobs = 1, ftime = 2) ) expect_equal( -dim(BrierScore(exp1, obs1, memb_dim = 'member', dat_dim = 'dataset')$nk), +dim(BrierScore(exp1, obs1, dat_dim = 'dataset')$nk), c(nexp = 1, nobs = 1, bin = 10, ftime = 2) ) expect_equal( -as.vector(BrierScore(exp1, obs1, memb_dim = 'member', dat_dim = 'dataset')$nk), -as.vector(BrierScore(exp1, obs1, memb_dim = 'member')$nk) +as.vector(BrierScore(exp1, obs1, dat_dim = 'dataset')$nk), +as.vector(BrierScore(exp1, obs1)$nk) ) expect_equal( -as.vector(BrierScore(exp1, obs1, memb_dim = 'member', dat_dim = 'dataset')$bs), -as.vector(BrierScore(exp1, obs1, memb_dim = 'member')$bs) +as.vector(BrierScore(exp1, obs1, dat_dim = 'dataset')$bs), +as.vector(BrierScore(exp1, obs1)$bs) ) -}) +}) ############################################## test_that("3. Output checks: dat2", { @@ -198,3 +214,56 @@ c(1, 0, 2, 1, 0, 1, 2, 0, 1, 2) ) }) +############################################## +test_that("4. Output checks: dat3", { + +expect_equal( +length(BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')), +16 +) +expect_equal( +names(BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')), +c('rel', 'res', 'unc', 'bs', 'bs_check_res', 'bss_res', 'gres', + 'bs_check_gres', 'bss_gres', 'rel_bias_corrected', 'gres_bias_corrected', + 'unc_bias_corrected', 'bss_bias_corrected', 'nk', 'fkbar', 'okbar') +) +expect_equal( +dim(BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')$rel), +c(nexp = 2, nobs = 1, ftime = 2) +) +expect_equal( +BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')$rel[, 1, 2], +c(0.3555556, 0.2222222), +tolerance = 0.0001 +) +expect_equal( +BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')$res[1, 1, ], +c(0.0000000, 0.1066667), +tolerance = 0.0001 +) +expect_equal( +BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')$bs[2, 1, ], +c(0.3555556, 0.4222222), +tolerance = 0.0001 +) +expect_equal( +dim(BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')$okbar), +c(nexp = 2, nobs = 1, bin = 10, ftime = 2) +) +expect_equal( +BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')$okbar[, 1, 1, 1], +c(NaN, 1) +) +expect_equal( +BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset', thresholds = 1:2/3)$fkbar[2, 1, , 1], +c(0.0000000, 0.3333333, 0.6666667), +tolerance = 0.0001 +) +expect_equal( +BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset', thresholds = 1:2/3)$nk[1, 1, , 1], +c(0, 5, 0) +) + +}) + + diff --git a/tests/testthat/test-UltimateBrier.R b/tests/testthat/test-UltimateBrier.R index e8114f6..654aad0 100644 --- a/tests/testthat/test-UltimateBrier.R +++ b/tests/testthat/test-UltimateBrier.R @@ -70,6 +70,10 @@ test_that("1. Input checks", { UltimateBrier(exp1, obs1, quantile = c(0.05, 0.95)), "Parameter 'quantile' must be one logical value." ) + expect_error( + UltimateBrier(exp1, obs1, quantile = FALSE, thr = 1:3, type = 'FairEnsembleBS'), + "Parameter 'quantile' must be TRUE if 'type' is 'FairEnsembleBSS' or 'FairEnsembleBS'." + ) # thr expect_error( UltimateBrier(exp1, obs1, thr = TRUE), @@ -77,7 +81,7 @@ test_that("1. Input checks", { ) expect_error( UltimateBrier(exp1, obs1, quantile = TRUE, thr = 1:3), - "Parameter 'thr' must be within \\[0, 1\\] when quantile is TRUE." + "Parameter 'thr' must be between 0 and 1 when quantile is TRUE." ) # type expect_error( -- GitLab From 8c817d84757471a5427ae4030bed4a9b1da6504f Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 1 Jun 2021 13:25:31 +0200 Subject: [PATCH 126/154] Improve documentation --- R/BrierScore.R | 6 +++--- man/BrierScore.Rd | 21 ++++++++++----------- man/UltimateBrier.Rd | 5 +++-- 3 files changed, 16 insertions(+), 16 deletions(-) diff --git a/R/BrierScore.R b/R/BrierScore.R index 8fc45c2..02b1480 100644 --- a/R/BrierScore.R +++ b/R/BrierScore.R @@ -12,9 +12,9 @@ #' must at least have 'time_dim'. #' range [0, 1]. #'@param obs A numeric array with named dimensions of the binary observations -#' (0 or 1). The dimension must at least have 'time_dim' and other dimensions -#' of 'exp' except 'memb_dim', which is optional. The length of 'dat_dim' can -#' be different from 'exp', and the length of 'memb_dim' must be 1 if it has. +#' (0 or 1). The dimension must be the same as 'exp' except memb_dim, which is +#' optional. If it has 'memb_dim', then the length must be 1. The length of +#' 'dat_dim' can be different from 'exp' if it has. #'@param thresholds A numeric vector used to bin the forecasts. The default #' value is \code{seq(0.1, 0.9, 0.1)}, which means that the bins are #' \code{[0, 0.1), [0.1, 0.2), ... [0.9, 1]}. diff --git a/man/BrierScore.Rd b/man/BrierScore.Rd index 7466ac0..2b8aefe 100644 --- a/man/BrierScore.Rd +++ b/man/BrierScore.Rd @@ -7,7 +7,7 @@ BrierScore( exp, obs, - thresholds = seq(0, 1, 0.1), + thresholds = seq(0.1, 0.9, 0.1), time_dim = "sdate", dat_dim = NULL, memb_dim = NULL, @@ -15,18 +15,20 @@ BrierScore( ) } \arguments{ -\item{exp}{A vector or a numeric array with named dimensions of the probablistic -prediction data. The dimension must at least have 'time_dim'. It may have -'memb_dim' for performing ensemble mean. The values should be within the +\item{exp}{A vector or a numeric array with named dimensions. It should be +the predicted probabilities which are within the range [0, 1] if memb_dim +doesn't exist. If it has memb_dim, the value should be 0 or 1, and the +predicted probabilities will be computed by ensemble mean. The dimensions +must at least have 'time_dim'. range [0, 1].} \item{obs}{A numeric array with named dimensions of the binary observations -(0 or 1). The dimension must at least have 'time_dim' and other dimensions -of 'exp' except 'memb_dim' (optional). The length of 'dat_dim' can be -different from 'exp', and the length of 'memb_dim' must be 1 if it has.} +(0 or 1). The dimension must be the same as 'exp' except memb_dim, which is +optional. If it has 'memb_dim', then the length must be 1. The length of +'dat_dim' can be different from 'exp' if it has.} \item{thresholds}{A numeric vector used to bin the forecasts. The default -value is \code{seq(0, 1, 0.1)}, which means that the bins are +value is \code{seq(0.1, 0.9, 0.1)}, which means that the bins are \code{[0, 0.1), [0.1, 0.2), ... [0.9, 1]}.} \item{time_dim}{A character string indicating the name of dimension along @@ -90,9 +92,6 @@ also returns the bias-corrected decomposition of the BS (Ferro and Fricker, exp <- runif(10) obs <- round(exp) x <- BrierScore(exp, obs) -res <- x$bs - x$bs_check_res -res <- x$bs - x$bs_check_gres -res <- x$rel_bias_corrected - x$gres_bias_corrected + x$unc_bias_corrected #===============uncomment the examples below when ProbBins is included========== # Inputs are arrays diff --git a/man/UltimateBrier.Rd b/man/UltimateBrier.Rd index 714dc74..2cad133 100644 --- a/man/UltimateBrier.Rd +++ b/man/UltimateBrier.Rd @@ -39,7 +39,8 @@ compute the probabilistic scores. The default value is 'sdate'.} \item{quantile}{A logical value to decide whether a quantile (TRUE) or a threshold (FALSE) is used to estimate the forecast and observed -probabilities. The default value is TRUE.} +probabilities. If 'type' is 'FairEnsembleBS' or 'FairEnsembleBSS', it must +be TRUE. The default value is TRUE.} \item{thr}{A numeric vector to be used in probability calculation (for 'BS', 'FairStartDatesBS', 'BSS', and 'FairStartDatesBSS') and binary event @@ -78,7 +79,7 @@ same dimensions: c(nexp, nobs, no. of bins, the rest dimensions of 'exp' except 'time_dim' and 'memb_dim'). 'nexp' and 'nobs' is the length of dataset dimension in 'exp' and 'obs' respectively.\cr -The list of 4 inlcudes: +The list of 4 includes: \itemize{ \item{$bs: Brier Score} \item{$rel: Reliability component} -- GitLab From abf76ad731f07878ca2c97203fae2e8bb815c9cb Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 2 Jun 2021 21:28:17 +0200 Subject: [PATCH 127/154] Add 'name' in InsertDim() to avoid warnings --- R/PlotEquiMap.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index eae709c..6ee7140 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -834,8 +834,8 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # if (!is.null(varu) && !is.null(varv)) { # Create a two dimention array of longitude and latitude - lontab <- InsertDim(lonb$x, 2, length( latb$x)) - lattab <- InsertDim(latb$x, 1, length( lonb$x)) + lontab <- InsertDim(lonb$x, 2, length(latb$x), name = 'lat') + lattab <- InsertDim(latb$x, 1, length(lonb$x), name = 'lon') varplotu <- varu[lonb$ix, latb$ix] varplotv <- varv[lonb$ix, latb$ix] -- GitLab From cf41d7f8d6836f1399755ab6348513c4b8adaabf Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 3 Jun 2021 16:39:31 +0200 Subject: [PATCH 128/154] Add arrow feature in PlotStereoMap() --- R/PlotStereoMap.R | 181 ++++++++++++++++++++++++++++++++++++++++--- man/PlotStereoMap.Rd | 41 +++++++++- 2 files changed, 210 insertions(+), 12 deletions(-) diff --git a/R/PlotStereoMap.R b/R/PlotStereoMap.R index 6ccbb72..4b4fbd2 100644 --- a/R/PlotStereoMap.R +++ b/R/PlotStereoMap.R @@ -4,8 +4,8 @@ #'a polar stereographic world projection with coloured grid cells. Only the #'region within a specified latitude interval is displayed. A colour bar #'(legend) can be plotted and adjusted. It is possible to draw superimposed -#'dots, symbols and boxes. A number of options is provided to adjust the -#'position, size and colour of the components. This plot function is +#'dots, symbols, boxes, contours, and arrows. A number of options is provided to +#'adjust the position, size and colour of the components. This plot function is #'compatible with figure layouts if colour bar is disabled. #' #'@param var Array with the values at each cell of a grid on a regular @@ -24,6 +24,10 @@ #'@param lat Numeric vector of latitude locations of the cell centers of the #' grid of 'var', in any order (same as 'var'). Expected to be from a regular #' rectangular or gaussian grid, within the range [-90, 90]. +#'@param varu Array of the zonal component of wind/current/other field with +#' the same dimensions as 'var'. +#'@param varv Array of the meridional component of wind/current/other field +#' with the same dimensions as 'var'. #'@param latlims Latitudinal limits of the figure.\cr #' Example : c(60, 90) for the North Pole\cr #' c(-90,-60) for the South Pole @@ -92,6 +96,23 @@ #' layers in 'dots'. Takes 1 by default. #'@param intlat Interval between latitude lines (circles), in degrees. #' Defaults to 10. +#'@param arr_subsamp A number as subsampling factor to select a subset of arrows +#' in 'varu' and 'varv' to be drawn. Only one out of arr_subsamp arrows will +#' be drawn. The default value is 1. +#'@param arr_scale A number as scale factor for drawn arrows from 'varu' and +#' 'varv'. The default value is 1. +#'@param arr_ref_len A number of the length of the refence arrow to be drawn as +#' legend at the bottom of the figure (in same units as 'varu' and 'varv', only +#' affects the legend for the wind or variable in these arrays). The default +#' value is 15. +#'@param arr_units Units of 'varu' and 'varv', to be drawn in the legend. +#' Takes 'm/s' by default. +#'@param arr_scale_shaft A number for the scale of the shaft of the arrows +#' (which also depend on the number of figures and the arr_scale parameter). +#' The default value is 1. +#'@param arr_scale_shaft_angle A number for the scale of the angle of the +#' shaft of the arrows (which also depend on the number of figure and the +#' arr_scale parameter). The default value is 1. #'@param drawleg Whether to plot a color bar (legend, key) or not. #' Defaults to TRUE. #'@param boxlim Limits of a box to be added to the plot, in degrees: @@ -155,7 +176,7 @@ #'@importFrom grDevices dev.cur dev.new dev.off gray #'@importFrom stats median #'@export -PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), +PlotStereoMap <- function(var, lon, lat, varu = NULL, varv = NULL, latlims = c(60, 90), toptitle = NULL, sizetit = NULL, units = NULL, brks = NULL, cols = NULL, bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, col_sup = NULL, @@ -166,7 +187,10 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), contour_color = 'black', contour_lty = 1, contour_label_draw = TRUE, contour_label_scale = 0.6, dots = NULL, dot_symbol = 4, dot_size = 0.8, - intlat = 10, + intlat = 10, + arr_subsamp = floor(length(lon) / 30), arr_scale = 1, + arr_ref_len = 15, arr_units = "m/s", + arr_scale_shaft = 1, arr_scale_shaft_angle = 1, drawleg = TRUE, subsampleg = NULL, bar_extra_labels = NULL, draw_bar_ticks = TRUE, draw_separators = FALSE, triangle_ends_scale = 1, @@ -218,17 +242,40 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), stop("Parameter 'var' must be a numeric array with two dimensions.") } dims <- dim(var) + + # Check varu and varv + if (!is.null(varu) && !is.null(varv)) { + if (!is.array(varu) || !(length(dim(varu)) == 2)) { + stop("Parameter 'varu' must be a numerical array with two dimensions.") + } + if (!is.array(varv) || !(length(dim(varv)) == 2)) { + stop("Parameter 'varv' must be a numerical array with two dimensions.") + } + } else if (!is.null(varu) || !is.null(varv)) { + stop("Only one of the components 'varu' or 'varv' has been provided. Both must be provided.") + } + + if (!is.null(varu) && !is.null(varv)) { + if (dim(varu)[1] != dims[1] || dim(varu)[2] != dims[2]) { + stop("Parameter 'varu' must have same number of longitudes and latitudes as 'var'.") + } + if (dim(varv)[1] != dims[1] || dim(varv)[2] != dims[2]) { + stop("Parameter 'varv' must have same number of longitudes and latitudes as 'var'.") + } + } + # Transpose the input matrices because the base plot functions work directly # with dimensions c(lon, lat). if (dims[1] != length(lon) || dims[2] != length(lat)) { if (dims[1] == length(lat) && dims[2] == length(lon)) { var <- t(var) + if (!is.null(varu)) varu <- t(varu) + if (!is.null(varv)) varv <- t(varv) if (!is.null(dots)) dots <- aperm(dots, c(1, 3, 2)) dims <- dim(var) } } - # Check lon if (length(lon) != dims[1]) { stop("Parameter 'lon' must have as many elements as the number of cells along longitudes in the input array 'var'.") @@ -239,6 +286,14 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), stop("Parameter 'lat' must have as many elements as the number of cells along longitudes in the input array 'var'.") } + # Prepare sorted lon/lat and other arguments + latb <- sort(lat, index.return = TRUE) + lonb <- sort(lon, index.return = TRUE) + latmin <- floor(min(lat) / 10) * 10 + latmax <- ceiling(max(lat) / 10) * 10 + lonmin <- floor(min(lon) / 10) * 10 + lonmax <- ceiling(max(lon) / 10) * 10 + # Check latlims if (!is.numeric(latlims) || length(latlims) != 2) { stop("Parameter 'latlims' must be a numeric vector with two elements.") @@ -248,14 +303,15 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), if (max(abs(latlims - center_at)) > 90 + 20) { stop("The range specified in 'latlims' is too wide. 110 degrees supported maximum.") } - dlon <- median(lon[2:dims[1]] - lon[1:(dims[1] - 1)]) / 2 - dlat <- median(lat[2:dims[2]] - lat[1:(dims[2] - 1)]) / 2 + dlon <- median(lonb$x[2:dims[1]] - lonb$x[1:(dims[1] - 1)]) / 2 + dlat <- median(latb$x[2:dims[2]] - latb$x[1:(dims[2] - 1)]) / 2 original_last_lat <- latlims[which.min(abs(latlims))] - last_lat <- lat[which.min(abs(lat - original_last_lat))] - dlat * sign(center_at) + last_lat <- latb$x[which.min(abs(latb$x - original_last_lat))] - dlat * sign(center_at) latlims[which.min(abs(latlims))] <- last_lat # Subset lat by latlims lat_plot_ind <- which(lat >= latlims[1] & lat <= latlims[2]) + latb_plot_ind <- which(latb$x >= latlims[1] & latb$x <= latlims[2]) # Check toptitle if (is.null(toptitle) || is.na(toptitle)) { @@ -425,6 +481,26 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), stop("Parameter 'intlat' must be numeric.") } + # Check arrow parameters + if (!is.numeric(arr_subsamp)) { + stop("Parameter 'arr_subsamp' must be numeric.") + } + if (!is.numeric(arr_scale)) { + stop("Parameter 'arr_scale' must be numeric.") + } + if (!is.numeric(arr_ref_len)) { + stop("Parameter 'arr_ref_len' must be numeric.") + } + if (!is.character(arr_units)) { + stop("Parameter 'arr_units' must be character.") + } + if (!is.numeric(arr_scale_shaft)) { + stop("Parameter 'arr_scale_shaft' must be numeric.") + } + if (!is.numeric(arr_scale_shaft_angle)) { + stop("Parameter 'arr_scale_shaft_angle' must be numeric.") + } + # Check legend parameters if (!is.logical(drawleg)) { stop("Parameter 'drawleg' must be logical.") @@ -484,6 +560,9 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), title_scale <- title_scale * scale margin_scale <- margin_scale * scale dot_size <- dot_size * scale + arr_scale <- arr_scale * scale + contour_label_scale <- contour_label_scale * scale + contour_lwd <- contour_lwd * scale } } @@ -514,6 +593,10 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), bar_extra_margin[1] <- bar_extra_margin[1] + margins[1] bar_extra_margin[3] <- bar_extra_margin[3] + margins[3] + if (!is.null(varu)) { + margins[1] <- margins[1] + 2.2 * units_scale + } + if (drawleg) { layout(matrix(1:2, ncol = 2, nrow = 1), widths = c(8, 2)) } @@ -572,8 +655,8 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), if (!is.null(contours)) { nbrks2 <- length(brks2) for (n_brks2 in 1:nbrks2) { - cl <- grDevices::contourLines(x = lon, y = lat[lat_plot_ind], - z = contours[, lat_plot_ind], + cl <- grDevices::contourLines(x = lonb$x, y = latb$x[latb_plot_ind], + z = contours[lonb$ix, latb$ix[latb_plot_ind]], levels = brks2[n_brks2]) if (length(cl) > 0) { for (i in seq_along(cl)) { @@ -680,6 +763,84 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), } } + # + # PlotWind + # ~~~~~~~~~~ + # + if (!is.null(varu) && !is.null(varv)) { + # Create a two dimention array of longitude and latitude + lontab <- InsertDim(lonb$x, 2, length(latb$x[latb_plot_ind]), name = 'lat') + lattab <- InsertDim(latb$x[latb_plot_ind], 1, length(lonb$x), name = 'lon') + # Select a subsample of the points to an arrow for each "subsample" grid point + # latmin has the most arrows, and latmax (polar point) has no arrow. + sublon_max <- seq(1, length(lonb$x), arr_subsamp) + sublat_max <- seq(1, length(latb$x[latb_plot_ind]), arr_subsamp) + ## calculate the length of sublon for each lat + arr_num_at_lat <- round(seq(length(sublon_max), 0, length.out = length(lat[lat_plot_ind]))) + ## If south hemisphere, revserse arr_num_at_lat (smaller lat has less arrows) + if (center_at < 0) { + arr_num_at_lat <- rev(arr_num_at_lat) + } + for (n_lat in seq_along(sublat_max)) { + sublat <- sublat_max[n_lat] + if (arr_num_at_lat[sublat] != 0) { + sublon <- round(seq(1, length(lon), length.out = arr_num_at_lat[sublat])) + # end points (start points + varu/varv) + uaux <- lontab[sublon, sublat] + varu[lonb$ix, latb$ix[latb_plot_ind]][sublon, sublat] * 0.5 * arr_scale + vaux <- lattab[sublon, sublat] + varv[lonb$ix, latb$ix[latb_plot_ind]][sublon, sublat] * 0.5 * arr_scale + + # project the start and end points on stereographic + xy0 <- mapproj::mapproject(lontab[sublon, sublat], lattab[sublon, sublat]) + xy1 <- mapproj::mapproject(uaux, vaux) + xc0 <- xy0$x + yc0 <- xy0$y + xc1 <- xy1$x + yc1 <- xy1$y + nc <- length(xc0) + + lenshaft <- 0.18 * arr_scale * arr_scale_shaft + angleshaft <- 12 * arr_scale_shaft_angle + + # Plot Wind + arrows(xc0, yc0, + xc1, yc1, + angle = angleshaft, + length = lenshaft) + } + } + + # Plot an arrow at the bottom of the plot for the legend + # Put arrow at lon = 0, lat = lowest lat (i.e., biggest circle) - (latmax - latmin)/8 + delta_arr_lengend <- (0.5 * arr_scale * arr_ref_len) + posarlon <- c(0 - delta_arr_lengend / 2, 0 + delta_arr_lengend / 2) + posarlat <- rep(min(abs(lat[lat_plot_ind])) - diff(range(lat[lat_plot_ind]))/8, 2) +#NOTE: The following lines put legend at bottom left corner. But it's hard to put it horizontal +# delta_arr_lengend <- (0.5 * arr_scale * arr_ref_len)/sqrt(2) +# posarlat[1] <- posarlat[1] - delta_arr_lengend / 2 +# posarlat[2] <- posarlat[2] + delta_arr_lengend / 2 + ## turn into stereographic + arr_lengend <- mapproj::mapproject(posarlon, posarlat) + + arrows(arr_lengend$x[1], arr_lengend$y[1], + arr_lengend$x[2], arr_lengend$y[2], + length = lenshaft, angle = angleshaft, + xpd = TRUE) + #save the parameter value + xpdsave <- par('xpd') + #desactivate xpd to be able to plot in margen + par(xpd = NA) + #plot text + mtext(paste(as.character(arr_ref_len), arr_units, sep = ""), + line = min(arr_lengend$y) + 1.8 * abs(min(arr_lengend$y)), + side = 1, + at = mean(arr_lengend$x), + cex = units_scale) + #come back to the previous xpd value + par(xpd = xpdsave) + + } + + # # Colorbar # ~~~~~~~~~~ diff --git a/man/PlotStereoMap.Rd b/man/PlotStereoMap.Rd index cca91b4..1b7f166 100644 --- a/man/PlotStereoMap.Rd +++ b/man/PlotStereoMap.Rd @@ -8,6 +8,8 @@ PlotStereoMap( var, lon, lat, + varu = NULL, + varv = NULL, latlims = c(60, 90), toptitle = NULL, sizetit = NULL, @@ -34,6 +36,12 @@ PlotStereoMap( dot_symbol = 4, dot_size = 0.8, intlat = 10, + arr_subsamp = floor(length(lon)/30), + arr_scale = 1, + arr_ref_len = 15, + arr_units = "m/s", + arr_scale_shaft = 1, + arr_scale_shaft_angle = 1, drawleg = TRUE, subsampleg = NULL, bar_extra_labels = NULL, @@ -79,6 +87,12 @@ longitude range can also be provided, e.g. \code{lon = c(0:50, 300:360)} grid of 'var', in any order (same as 'var'). Expected to be from a regular rectangular or gaussian grid, within the range [-90, 90].} +\item{varu}{Array of the zonal component of wind/current/other field with +the same dimensions as 'var'.} + +\item{varv}{Array of the meridional component of wind/current/other field +with the same dimensions as 'var'.} + \item{latlims}{Latitudinal limits of the figure.\cr Example : c(60, 90) for the North Pole\cr c(-90,-60) for the South Pole} @@ -168,6 +182,29 @@ layers in 'dots'. Takes 1 by default.} \item{intlat}{Interval between latitude lines (circles), in degrees. Defaults to 10.} +\item{arr_subsamp}{A number as subsampling factor to select a subset of arrows +in 'varu' and 'varv' to be drawn. Only one out of arr_subsamp arrows will +be drawn. The default value is 1.} + +\item{arr_scale}{A number as scale factor for drawn arrows from 'varu' and +'varv'. The default value is 1.} + +\item{arr_ref_len}{A number of the length of the refence arrow to be drawn as +legend at the bottom of the figure (in same units as 'varu' and 'varv', only +affects the legend for the wind or variable in these arrays). The default +value is 15.} + +\item{arr_units}{Units of 'varu' and 'varv', to be drawn in the legend. +Takes 'm/s' by default.} + +\item{arr_scale_shaft}{A number for the scale of the shaft of the arrows +(which also depend on the number of figures and the arr_scale parameter). +The default value is 1.} + +\item{arr_scale_shaft_angle}{A number for the scale of the angle of the +shaft of the arrows (which also depend on the number of figure and the +arr_scale parameter). The default value is 1.} + \item{drawleg}{Whether to plot a color bar (legend, key) or not. Defaults to TRUE.} @@ -238,8 +275,8 @@ Map longitude-latitude array (on a regular rectangular or gaussian grid) on a polar stereographic world projection with coloured grid cells. Only the region within a specified latitude interval is displayed. A colour bar (legend) can be plotted and adjusted. It is possible to draw superimposed -dots, symbols and boxes. A number of options is provided to adjust the -position, size and colour of the components. This plot function is +dots, symbols, boxes, contours, and arrows. A number of options is provided to +adjust the position, size and colour of the components. This plot function is compatible with figure layouts if colour bar is disabled. } \examples{ -- GitLab From 5d0412a8e6b0105d51aa20dac16b80994ffe3fc6 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 4 Jun 2021 14:29:56 +0200 Subject: [PATCH 129/154] Enable to regrid irregular curvilinear grid to regular grid --- R/CDORemap.R | 74 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 74 insertions(+) diff --git a/R/CDORemap.R b/R/CDORemap.R index 0ae0be6..fc25b52 100644 --- a/R/CDORemap.R +++ b/R/CDORemap.R @@ -724,10 +724,45 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, if (!is.null(dims_to_iterate)) { slice_indices <- which(slices_to_iterate == i, arr.ind = TRUE) subset <- Subset(data_array, dims_to_iterate, as.list(slice_indices), drop = 'selected') + # Fix issue 259, curvilinear grid, the order of the dimensions in slices and + # coordinates needs to match + if (is_irregular) { + pos_lon <- which(names(dim(subset)) == lon_dim) + pos_lat <- which(names(dim(subset)) == lat_dim) + pos_lon_dim_in_lons <- which(names(dim(lons)) == lon_dim) + pos_lat_dim_in_lons <- which(names(dim(lons)) == lat_dim) + if ((pos_lon > pos_lat && pos_lon_dim_in_lons < pos_lat_dim_in_lons) || + (pos_lon < pos_lat && pos_lon_dim_in_lons > pos_lat_dim_in_lons)) { + new_pos <- 1:length(dim(subset)) + new_pos[pos_lon] <- pos_lat + new_pos[pos_lat] <- pos_lon + subset <- .aperm2(subset, new_pos) + } + # The unlimited dimension should be placed in the last position + if ('time' %in% names(dim(subset)) && + which(names(dim(subset)) == 'time') != length(dim(subset))) { + new_pos <- 2:length(dim(subset)) + new_pos[length(dim(subset))] <- 1 + subset <- .aperm2(subset, new_pos) + } + } # dims_before_crop <- dim(subset) # Make sure subset goes along with metadata easyNCDF::ArrayToNc(setNames(list(subset, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) } else { + if (is_irregular) { + pos_lon <- which(names(dim(data_array)) == lon_dim) + pos_lat <- which(names(dim(data_array)) == lat_dim) + pos_lon_dim_in_lons <- which(names(dim(lons)) == lon_dim) + pos_lat_dim_in_lons <- which(names(dim(lons)) == lat_dim) + if ((pos_lon > pos_lat && pos_lon_dim_in_lons < pos_lat_dim_in_lons) || + (pos_lon < pos_lat && pos_lon_dim_in_lons > pos_lat_dim_in_lons)) { + new_pos <- 1:length(dim(data_array)) + new_pos[pos_lon] <- pos_lat + new_pos[pos_lat] <- pos_lon + data_array <- .aperm2(data_array, new_pos) + } + } # dims_before_crop <- dim(data_array) easyNCDF::ArrayToNc(setNames(list(data_array, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) } @@ -816,24 +851,63 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, if (return_array) { new_dims <- dim(data_array) new_dims[c(lon_dim, lat_dim)] <- c(found_lon_dim_size, found_lat_dim_size) + lon_pos <- which(names(new_dims) == lon_dim) + lat_pos <- which(names(new_dims) == lat_dim) + # Fix issue 259, expected order from CDO output is lon lat + # If is irregular, lat and lon position need to be checked: + if (is_irregular) { + if (lon_pos > lat_pos) { + new_pos <- 1:length(new_dims) + new_pos[lon_pos] <- lat_pos + new_pos[lat_pos] <- lon_pos + new_dims <- new_dims[new_pos] + } + } result_array <- array(dim = new_dims) store_indices <- as.list(rep(TRUE, length(dim(result_array)))) } } if (return_array) { store_indices[dims_to_iterate] <- as.list(slice_indices) + # If is irregular, the order of dimenesions in result_array and file may be different and need to be checked before reading the temporal file: + if (is_irregular) { + test_dims <- dim(ncvar_get(ncdf_remapped, 'var', + collapse_degen = FALSE)) + test_dims <- test_dims[which(test_dims > 1)] + pos_test_dims <- match(dim(result_array), test_dims) + if (is.unsorted(pos_test_dims, na.rm = TRUE)) { + # pos_new_dims is used later in the code. Don't overwrite + pos_new_dims <- 1:length(dim(result_array)) + pos_new_dims[which(!is.na(pos_test_dims))] <- + match(test_dims, dim(result_array)) + backup_result_array_dims <- dim(result_array) + dim(result_array) <- dim(result_array)[pos_new_dims] + } + } result_array <- do.call('[<-', c(list(x = result_array), store_indices, list(value = ncvar_get(ncdf_remapped, 'var', collapse_degen = FALSE)))) } } else { new_dims <- dim(data_array) new_dims[c(lon_dim, lat_dim)] <- c(found_lon_dim_size, found_lat_dim_size) + result_array <- ncvar_get(ncdf_remapped, 'var', collapse_degen = FALSE) dim(result_array) <- new_dims } nc_close(ncdf_remapped) file.remove(tmp_file2) } + # If is irregular, the order of dimension may need to be recovered after reading all the file: + if (is_irregular & (!is.null(dims_to_iterate))) { + if (exists('pos_new_dims')) { + pos_new_dims <- 1:length(dim(result_array)) + dims_to_change <- match(backup_result_array_dims, dim(result_array)) + pos_new_dims[which(dims_to_change != 1)] <- + dims_to_change[which(dims_to_change != 1)] + result_array <- .aperm2(result_array, pos_new_dims) + } + } + if (!is.null(permutation)) { dim_backup <- dim(result_array) result_array <- aperm(result_array, permutation_back) -- GitLab From bf4d5c34c4ba2239893d27cd95ba63a5a295ce49 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 4 Jun 2021 17:47:34 +0200 Subject: [PATCH 130/154] Make Load() to shift the grid even if only one dataset --- R/Utils.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/Utils.R b/R/Utils.R index 11bebc5..e0e1f91 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -327,11 +327,9 @@ if ((grid_lons != common_grid_lons) || (grid_lats != common_grid_lats) || (grid_type != common_grid_type) || - ((lon[1] != first_common_grid_lon) - && !work_piece[['single_dataset']])) { + (lon[1] != first_common_grid_lon)) { if (grid_lons == common_grid_lons && grid_lats == common_grid_lats && - grid_type == common_grid_type && lon[1] != first_common_grid_lon && - !work_piece[['single_dataset']]) { + grid_type == common_grid_type && lon[1] != first_common_grid_lon) { remove_shift <- TRUE } remap_needed <- TRUE -- GitLab From 3dd72e4b0753ccba716b3164e36f00521dfd5fb6 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 7 Jun 2021 11:33:46 +0200 Subject: [PATCH 131/154] Correct the documentation of output --- R/EuroAtlanticTC.R | 6 ++++-- man/EuroAtlanticTC.Rd | 6 ++++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/R/EuroAtlanticTC.R b/R/EuroAtlanticTC.R index f35278c..2860a53 100644 --- a/R/EuroAtlanticTC.R +++ b/R/EuroAtlanticTC.R @@ -31,8 +31,10 @@ #'\item{patterns}{ #' An array of the first four REOF patterns normalized to 1 (unitless) with #' dimensions (modes = 4, the rest of the dimensions of 'ano' except -#' 'time_dim'). The modes represent NAO, EA, EAWR, and SCA in order. -#' Multiplying 'patterns' by 'indices' gives the original reconstructed field. +#' 'time_dim'). The modes represent NAO, EA, EAWR, and SCA, of which the order +#' and sign changes depending on the dataset and period employed, so manual +#' reordering may be needed. Multiplying 'patterns' by 'indices' gives the +#' original reconstructed field. #'} #'\item{indices}{ #' An array of the first four principal components with the units of the diff --git a/man/EuroAtlanticTC.Rd b/man/EuroAtlanticTC.Rd index 16c90fe..7f81b24 100644 --- a/man/EuroAtlanticTC.Rd +++ b/man/EuroAtlanticTC.Rd @@ -48,8 +48,10 @@ A list containing: \item{patterns}{ An array of the first four REOF patterns normalized to 1 (unitless) with dimensions (modes = 4, the rest of the dimensions of 'ano' except - 'time_dim'). The modes represent NAO, EA, EAWR, and SCA in order. - Multiplying 'patterns' by 'indices' gives the original reconstructed field. + 'time_dim'). The modes represent NAO, EA, EAWR, and SCA, of which the order + and sign changes depending on the dataset and period employed, so manual + reordering may be needed. Multiplying 'patterns' by 'indices' gives the + original reconstructed field. } \item{indices}{ An array of the first four principal components with the units of the -- GitLab From eaf10714ebb18ae81edcb1b1a83f47e43516ce12 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 7 Jun 2021 12:14:47 +0200 Subject: [PATCH 132/154] Fix example --- R/BrierScore.R | 9 ++++----- man/BrierScore.Rd | 9 ++++----- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/R/BrierScore.R b/R/BrierScore.R index 02b1480..5978751 100644 --- a/R/BrierScore.R +++ b/R/BrierScore.R @@ -78,12 +78,11 @@ #'obs <- round(exp) #'x <- BrierScore(exp, obs) #' -#'#===============uncomment the examples below when ProbBins is included========== #'# Inputs are arrays -#'#example(Load) -#'#bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3), posdates = 3, posdim = 2) -#'#bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3), posdates = 3, posdim = 2) -#'#res <- BrierScore(bins_ano_exp, MeanDims(bins_ano_obs, 'member'), memb_dim = 'member') +#'example(Load) +#'bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3), posdates = 3, posdim = 2) +#'bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3), posdates = 3, posdim = 2) +#'res <- BrierScore(bins_ano_exp, MeanDims(bins_ano_obs, 'member'), memb_dim = 'member') #' #'@import multiApply #'@export diff --git a/man/BrierScore.Rd b/man/BrierScore.Rd index 2b8aefe..5ace589 100644 --- a/man/BrierScore.Rd +++ b/man/BrierScore.Rd @@ -93,12 +93,11 @@ exp <- runif(10) obs <- round(exp) x <- BrierScore(exp, obs) -#===============uncomment the examples below when ProbBins is included========== # Inputs are arrays -#example(Load) -#bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3), posdates = 3, posdim = 2) -#bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3), posdates = 3, posdim = 2) -#res <- BrierScore(bins_ano_exp, MeanDims(bins_ano_obs, 'member'), memb_dim = 'member') +example(Load) +bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3), posdates = 3, posdim = 2) +bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3), posdates = 3, posdim = 2) +res <- BrierScore(bins_ano_exp, MeanDims(bins_ano_obs, 'member'), memb_dim = 'member') } \references{ -- GitLab From 41a66d622e95c44f11b90aad6172072624554baf Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 7 Jun 2021 12:41:20 +0200 Subject: [PATCH 133/154] Revise example --- R/BrierScore.R | 7 +++++-- man/BrierScore.Rd | 7 +++++-- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/R/BrierScore.R b/R/BrierScore.R index 5978751..1363f61 100644 --- a/R/BrierScore.R +++ b/R/BrierScore.R @@ -80,8 +80,11 @@ #' #'# Inputs are arrays #'example(Load) -#'bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3), posdates = 3, posdim = 2) -#'bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3), posdates = 3, posdim = 2) +#'clim <- Clim(sampleData$mod, sampleData$obs) +#'ano_exp <- Ano(sampleData$mod, clim$clim_exp) +#'ano_obs <- Ano(sampleData$obs, clim$clim_obs) +#'bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3)) +#'bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3)) #'res <- BrierScore(bins_ano_exp, MeanDims(bins_ano_obs, 'member'), memb_dim = 'member') #' #'@import multiApply diff --git a/man/BrierScore.Rd b/man/BrierScore.Rd index 5ace589..9271a2a 100644 --- a/man/BrierScore.Rd +++ b/man/BrierScore.Rd @@ -95,8 +95,11 @@ x <- BrierScore(exp, obs) # Inputs are arrays example(Load) -bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3), posdates = 3, posdim = 2) -bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3), posdates = 3, posdim = 2) +clim <- Clim(sampleData$mod, sampleData$obs) +ano_exp <- Ano(sampleData$mod, clim$clim_exp) +ano_obs <- Ano(sampleData$obs, clim$clim_obs) +bins_ano_exp <- ProbBins(ano_exp, thr = c(1/3, 2/3)) +bins_ano_obs <- ProbBins(ano_obs, thr = c(1/3, 2/3)) res <- BrierScore(bins_ano_exp, MeanDims(bins_ano_obs, 'member'), memb_dim = 'member') } -- GitLab From 09fad544bdc36d90b0cd010996e478943fb10393 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 7 Jun 2021 13:07:39 +0200 Subject: [PATCH 134/154] Include PlotVsLTime.R --- NAMESPACE | 1 + R/Consist_Trend.R | 7 +- R/PlotVsLTime.R | 265 +++++++++++++++++++++++++++++++++++++++++++ man/Consist_Trend.Rd | 7 +- man/PlotVsLTime.Rd | 144 +++++++++++++++++++++++ 5 files changed, 416 insertions(+), 8 deletions(-) create mode 100644 R/PlotVsLTime.R create mode 100644 man/PlotVsLTime.Rd diff --git a/NAMESPACE b/NAMESPACE index 0783e78..9c94520 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -40,6 +40,7 @@ export(PlotLayout) export(PlotMatrix) export(PlotSection) export(PlotStereoMap) +export(PlotVsLTime) export(RMS) export(RMSSS) export(RandomWalkTest) diff --git a/R/Consist_Trend.R b/R/Consist_Trend.R index 3a31873..b02aa5f 100644 --- a/R/Consist_Trend.R +++ b/R/Consist_Trend.R @@ -68,11 +68,10 @@ #'trend_bind <- abind::abind(trend$conf.lower[2, , ], trend$trend[2, , ], #' trend$conf.upper[2, , ], trend$trend[1, , ], along = 0) #'trend_bind <- Reorder(trend_bind, c(2, 1, 3)) -#'#================uncomment PlotVsLTime when functions merge=========== #'\donttest{ -#'#PlotVsLTime(trend_bind, toptitle = "trend", ytitle = "K/(5 years)", -#'# monini = 11, limits = c(-0.8, 0.8), listexp = c('CMIP5 IC3'), -#'# listobs = c('ERSST'), biglab = FALSE, hlines = c(0)) +#'PlotVsLTime(trend_bind, toptitle = "trend", ytitle = "K/(5 years)", +#' monini = 11, limits = c(-0.8, 0.8), listexp = c('CMIP5 IC3'), +#' listobs = c('ERSST'), biglab = FALSE, hlines = c(0)) #'PlotAno(InsertDim(trend$detrended_exp, 2, 1), InsertDim(trend$detrended_obs, 2, 1), #' startDates, "Detrended tos anomalies", ytitle = 'K', #' legends = 'ERSST', biglab = FALSE) diff --git a/R/PlotVsLTime.R b/R/PlotVsLTime.R new file mode 100644 index 0000000..94c82e0 --- /dev/null +++ b/R/PlotVsLTime.R @@ -0,0 +1,265 @@ +#'Plot a score along the forecast time with its confidence interval +#' +#'Plot the correlation (\code{Corr()}), the root mean square error +#'(\code{RMS()}) between the forecast values and their observational +#'counterpart, the slope of their trend (\code{Trend()}), the +#'InterQuartile range, maximum-mininum, standard deviation or median absolute +#'Deviation of the ensemble members (\code{Spread()}), or the ratio between +#'the ensemble spread and the RMSE of the ensemble mean (\code{RatioSDRMS()}) +#'along the forecast time for all the input experiments on the same figure +#'with their confidence intervals. +#' +#'@param var Matrix containing any Prediction Score with dimensions:\cr +#' (nexp/nmod, 3/4 ,nltime)\cr +#' or (nexp/nmod, nobs, 3/4 ,nltime). +#'@param toptitle Main title, optional. +#'@param ytitle Title of Y-axis, optional. +#'@param monini Starting month between 1 and 12. Default = 1. +#'@param freq 1 = yearly, 12 = monthly, 4 = seasonal, ... Default = 12. +#'@param nticks Number of ticks and labels on the x-axis, optional. +#'@param limits c(lower limit, upper limit): limits of the Y-axis, optional. +#'@param listexp List of experiment names, optional. +#'@param listobs List of observation names, optional. +#'@param biglab TRUE/FALSE for presentation/paper plot. Default = FALSE. +#'@param hlines c(a,b, ..) Add horizontal black lines at Y-positions a,b, ...\cr +#' Default = NULL. +#'@param leg TRUE/FALSE if legend should be added or not to the plot. +#' Default = TRUE. +#'@param siglev TRUE/FALSE if significance level should replace confidence +#' interval.\cr +#' Default = FALSE. +#'@param sizetit Multiplicative factor to change title size, optional. +#'@param show_conf TRUE/FALSE to show/not confidence intervals for input +#' variables. +#'@param fileout Name of output file. Extensions allowed: eps/ps, jpeg, png, +#' pdf, bmp and tiff. The default value is NULL. +#'@param width File width, in the units specified in the parameter size_units +#' (inches by default). Takes 8 by default. +#'@param height File height, in the units specified in the parameter +#' size_units (inches by default). Takes 5 by default. +#'@param size_units Units of the size of the device (file or window) to plot +#' in. Inches ('in') by default. See ?Devices and the creator function of the +#' corresponding device. +#'@param res Resolution of the device (file or window) to plot in. See +#' ?Devices and the creator function of the corresponding device. +#'@param ... Arguments to be passed to the method. Only accepts the following +#' graphical parameters:\cr +#' adj ann ask bg bty cex.sub cin col.axis col.lab col.main col.sub cra crt +#' csi cxy err family fg fig font font.axis font.lab font.main font.sub +#' lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page pch plt +#' smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +#' For more information about the parameters see `par`. +#' +#'@details +#'Examples of input:\cr +#'Model and observed output from \code{Load()} then \code{Clim()} then +#'\code{Ano()} then \code{Smoothing()}:\cr +#'(nmod, nmemb, nsdate, nltime) and (nobs, nmemb, nsdate, nltime)\cr +#'then averaged over the members\cr +#'\code{Mean1Dim(var_exp/var_obs, posdim = 2)}:\cr +#'(nmod, nsdate, nltime) and (nobs, nsdate, nltime)\cr +#'then passed through\cr +#' \code{Corr(exp, obs, posloop = 1, poscor = 2)} or\cr +#' \code{RMS(exp, obs, posloop = 1, posRMS = 2)}:\cr +#' (nmod, nobs, 3, nltime)\cr +#'would plot the correlations or RMS between each exp & each obs as a function +#'of the forecast time. +#' +#'@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) +#'runmean_months <- 12 +#'smooth_ano_exp <- Smoothing(data = ano_exp, runmeanlen = runmean_months) +#'smooth_ano_obs <- Smoothing(data = ano_obs, runmeanlen = runmean_months) +#'dim_to_mean <- 'member' # mean along members +#'required_complete_row <- 'ftime' # discard startdates for which there are NA leadtimes +#'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, +#' 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 <- Reorder(corr_combine, c(2, 3, 1, 4)) +#'\donttest{ +#'PlotVsLTime(corr_combine, toptitle = "correlations", ytitle = "correlation", +#' monini = 11, limits = c(-1, 2), listexp = c('CMIP5 IC3'), +#' listobs = c('ERSST'), biglab = FALSE, hlines = c(-1, 0, 1)) +#' } +#' +#'@importFrom grDevices dev.cur dev.new dev.off +#'@importFrom stats ts +#'@export +PlotVsLTime <- function(var, toptitle = '', ytitle = '', monini = 1, freq = 12, + nticks = NULL, limits = NULL, + listexp = c('exp1', 'exp2', 'exp3'), + listobs = c('obs1', 'obs2', 'obs3'), biglab = FALSE, hlines = NULL, + leg = TRUE, siglev = FALSE, sizetit = 1, show_conf = TRUE, + fileout = NULL, + 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", "fin", "lab", "las", "lend", "lty", "lwd", "mai", "mgp", "new", "pin", "ps", "pty") + userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) + + # If there is any filenames to store the graphics, process them + # to select the right device + if (!is.null(fileout)) { + deviceInfo <- .SelectDevice(fileout = fileout, width = width, height = height, units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + # + # Get some arguments + # ~~~~~~~~~~~~~~~~~~~~ + # + if (length(dim(var)) == 3) { + var <- InsertDim(var, posdim = 2, lendim = 1) + } else if (length(dim(var)) != 4) { + stop("Parameter 'var' should have 3 or 4 dimensions: c(n. exp[, n. obs], 3/4, n. lead-times)") + } + nleadtime <- dim(var)[4] + nexp <- dim(var)[1] + nobs <- dim(var)[2] + if (is.null(limits) == TRUE) { + if (all(is.na(var > 0))) { + ll <- ul <- 0 + } else { + ll <- min(var, na.rm = TRUE) + ul <- max(var, na.rm = TRUE) + } + if (biglab) { + ul <- ul + 0.4 * (ul - ll) + } else { + ul <- ul + 0.3 * (ul - ll) + } + } else { + ll <- limits[1] + ul <- limits[2] + } + lastyear <- (monini + (nleadtime - 1) * 12 / freq - 1) %/% 12 + lastmonth <- (monini + (nleadtime - 1) * 12 / freq - 1) %% 12 + 1 + empty_ts <- ts(start = c(0000, (monini - 1) %/% (12 / freq) + 1), + end = c(lastyear, (lastmonth - 1) %/% (12 / freq) + 1), + frequency = freq) + empty <- array(dim = length(empty_ts)) + # + # Define some plot parameters + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + if (is.null(nticks)) { + if (biglab) { + nticks <- 5 + } else { + nticks <- 10 + } + } + labind <- seq(1, nleadtime, max(nleadtime %/% nticks, 1)) + months <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", + "Oct", "Nov", "Dec") + labyear <- ((labind - 1) * 12 / freq + monini - 1) %/% 12 + labmonth <- months[((labind - 1) * 12 / freq + monini -1 ) %% 12 + 1] + for (jx in 1:length(labmonth)) { + y2o3dig <- paste("0", as.character(labyear[jx]), sep = "") + labmonth[jx] <- paste(labmonth[jx], "\nYr ", substr(y2o3dig, nchar(y2o3dig) + - 1, nchar(y2o3dig)), sep = "") + } + color <- c("red1", "dodgerblue1", "green1", "orange1", "lightblue1", + "deeppink1", "mediumpurple1", "lightgoldenrod1", "olivedrab1", + "mediumorchid1") + type <- c(1, 3, 2, 4) + thickness <- array(dim = c(4, 4)) + thickness[, 1] <- c(1, 2, 1, 1.5) + thickness[, 2] <- c(8, 12, 8, 10) + thickness[, 3] <- thickness[, 1] + thickness[, 4] <- c(4, 6, 4, 5) + if (siglev == TRUE) { + lines <- c("n", "l", "n", "l") + } else { + lines <- c("l", "l", "l", "n") + } + # + # Define plot layout + # ~~~~~~~~~~~~~~~~~~~~ + # + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, width = width, height = height) + } + + # Load the user parameters + par(userArgs) + + if (biglab) { + par(mai = c(1.25, 1.4, 0.5, 1), mgp = c(4, 2.5, 0)) + par(cex = 1.3, cex.lab = 2, cex.axis = 1.8) + cexmain <- 2.2 + legsize <- 1.5 + } else { + par(mai = c(1, 1.1, 0.5, 0), mgp = c(3, 1.8, 0)) + par(cex = 1.3, cex.lab = 1.5, cex.axis = 1.1) + cexmain <- 1.5 + legsize <- 1 + } + plot(empty, ylim = c(ll, ul), xlab = "Time (months)", ylab = ytitle, + main = toptitle, cex.main = cexmain*sizetit, axes = FALSE) + axis(1, at = labind, labels = labmonth) + axis(2) + box() + if (is.null(hlines) != TRUE) { + for (jy in 1:length(hlines)) { + par(new = TRUE) + abline(h = hlines[jy]) + } + } + # + # Loop on experimental & observational data + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + legendnames <- array(dim = nobs * nexp) + legendthick <- array(dim = nobs * nexp) + legendsty <- array(dim = nobs * nexp) + legendcol <- array(dim = nobs * nexp) + ind <- 1 + if (show_conf == TRUE) { + start_line <- dim(var)[3] + end_line <- 1 + } else { + start_line <- 2 + end_line <- 2 + } + for (jt in seq(start_line, end_line, -1)) { + ind <- 1 + for (jexp in 1:nexp) { + for (jobs in 1:nobs) { + par(new = TRUE) + plot(var[jexp, jobs, jt, ], type = lines[jt], ylim = c(ll, ul), + col = color[jexp], lty = type[jobs], lwd = thickness[jobs, jt], + ylab = "", xlab = "", axes = FALSE) + legendnames[ind] <- paste(listexp[jexp], 'vs', listobs[jobs]) + legendthick[ind] <- thickness[jobs, 1] * 3 + legendsty[ind] <- type[jobs] + legendcol[ind] <- color[jexp] + ind <- ind + 1 + } + } + } + if (leg) { + if (nobs == 1) { + legendnames <- listexp[1:nexp] + } + legend(1, ul, legendnames, lty = legendsty, lwd = legendthick, + col = legendcol, cex = legsize) + } + + # If the graphic was saved to file, close the connection with the device + if(!is.null(fileout)) dev.off() +} diff --git a/man/Consist_Trend.Rd b/man/Consist_Trend.Rd index 955907e..2ac7d42 100644 --- a/man/Consist_Trend.Rd +++ b/man/Consist_Trend.Rd @@ -88,11 +88,10 @@ trend <- Consist_Trend(MeanDims(smooth_ano_exp, dim_to_mean, na.rm = TRUE), trend_bind <- abind::abind(trend$conf.lower[2, , ], trend$trend[2, , ], trend$conf.upper[2, , ], trend$trend[1, , ], along = 0) trend_bind <- Reorder(trend_bind, c(2, 1, 3)) -#================uncomment PlotVsLTime when functions merge=========== \donttest{ -#PlotVsLTime(trend_bind, toptitle = "trend", ytitle = "K/(5 years)", -# monini = 11, limits = c(-0.8, 0.8), listexp = c('CMIP5 IC3'), -# listobs = c('ERSST'), biglab = FALSE, hlines = c(0)) +PlotVsLTime(trend_bind, toptitle = "trend", ytitle = "K/(5 years)", + monini = 11, limits = c(-0.8, 0.8), listexp = c('CMIP5 IC3'), + listobs = c('ERSST'), biglab = FALSE, hlines = c(0)) PlotAno(InsertDim(trend$detrended_exp, 2, 1), InsertDim(trend$detrended_obs, 2, 1), startDates, "Detrended tos anomalies", ytitle = 'K', legends = 'ERSST', biglab = FALSE) diff --git a/man/PlotVsLTime.Rd b/man/PlotVsLTime.Rd new file mode 100644 index 0000000..05e2b42 --- /dev/null +++ b/man/PlotVsLTime.Rd @@ -0,0 +1,144 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PlotVsLTime.R +\name{PlotVsLTime} +\alias{PlotVsLTime} +\title{Plot a score along the forecast time with its confidence interval} +\usage{ +PlotVsLTime( + var, + toptitle = "", + ytitle = "", + monini = 1, + freq = 12, + nticks = NULL, + limits = NULL, + listexp = c("exp1", "exp2", "exp3"), + listobs = c("obs1", "obs2", "obs3"), + biglab = FALSE, + hlines = NULL, + leg = TRUE, + siglev = FALSE, + sizetit = 1, + show_conf = TRUE, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) +} +\arguments{ +\item{var}{Matrix containing any Prediction Score with dimensions:\cr +(nexp/nmod, 3/4 ,nltime)\cr +or (nexp/nmod, nobs, 3/4 ,nltime).} + +\item{toptitle}{Main title, optional.} + +\item{ytitle}{Title of Y-axis, optional.} + +\item{monini}{Starting month between 1 and 12. Default = 1.} + +\item{freq}{1 = yearly, 12 = monthly, 4 = seasonal, ... Default = 12.} + +\item{nticks}{Number of ticks and labels on the x-axis, optional.} + +\item{limits}{c(lower limit, upper limit): limits of the Y-axis, optional.} + +\item{listexp}{List of experiment names, optional.} + +\item{listobs}{List of observation names, optional.} + +\item{biglab}{TRUE/FALSE for presentation/paper plot. Default = FALSE.} + +\item{hlines}{c(a,b, ..) Add horizontal black lines at Y-positions a,b, ...\cr +Default = NULL.} + +\item{leg}{TRUE/FALSE if legend should be added or not to the plot. +Default = TRUE.} + +\item{siglev}{TRUE/FALSE if significance level should replace confidence +interval.\cr +Default = FALSE.} + +\item{sizetit}{Multiplicative factor to change title size, optional.} + +\item{show_conf}{TRUE/FALSE to show/not confidence intervals for input +variables.} + +\item{fileout}{Name of output file. Extensions allowed: eps/ps, jpeg, png, +pdf, bmp and tiff. The default value is NULL.} + +\item{width}{File width, in the units specified in the parameter size_units +(inches by default). Takes 8 by default.} + +\item{height}{File height, in the units specified in the parameter +size_units (inches by default). Takes 5 by default.} + +\item{size_units}{Units of the size of the device (file or window) to plot +in. Inches ('in') by default. See ?Devices and the creator function of the +corresponding device.} + +\item{res}{Resolution of the device (file or window) to plot in. See +?Devices and the creator function of the corresponding device.} + +\item{...}{Arguments to be passed to the method. Only accepts the following +graphical parameters:\cr +adj ann ask bg bty cex.sub cin col.axis col.lab col.main col.sub cra crt +csi cxy err family fg fig font font.axis font.lab font.main font.sub +lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page pch plt +smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +For more information about the parameters see `par`.} +} +\description{ +Plot the correlation (\code{Corr()}), the root mean square error +(\code{RMS()}) between the forecast values and their observational +counterpart, the slope of their trend (\code{Trend()}), the +InterQuartile range, maximum-mininum, standard deviation or median absolute +Deviation of the ensemble members (\code{Spread()}), or the ratio between +the ensemble spread and the RMSE of the ensemble mean (\code{RatioSDRMS()}) +along the forecast time for all the input experiments on the same figure +with their confidence intervals. +} +\details{ +Examples of input:\cr +Model and observed output from \code{Load()} then \code{Clim()} then +\code{Ano()} then \code{Smoothing()}:\cr +(nmod, nmemb, nsdate, nltime) and (nobs, nmemb, nsdate, nltime)\cr +then averaged over the members\cr +\code{Mean1Dim(var_exp/var_obs, posdim = 2)}:\cr +(nmod, nsdate, nltime) and (nobs, nsdate, nltime)\cr +then passed through\cr + \code{Corr(exp, obs, posloop = 1, poscor = 2)} or\cr + \code{RMS(exp, obs, posloop = 1, posRMS = 2)}:\cr + (nmod, nobs, 3, nltime)\cr +would plot the correlations or RMS between each exp & each obs as a function +of the forecast time. +} +\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) +runmean_months <- 12 +smooth_ano_exp <- Smoothing(data = ano_exp, runmeanlen = runmean_months) +smooth_ano_obs <- Smoothing(data = ano_obs, runmeanlen = runmean_months) +dim_to_mean <- 'member' # mean along members +required_complete_row <- 'ftime' # discard startdates for which there are NA leadtimes +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, + 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 <- Reorder(corr_combine, c(2, 3, 1, 4)) +\donttest{ +PlotVsLTime(corr_combine, toptitle = "correlations", ytitle = "correlation", + monini = 11, limits = c(-1, 2), listexp = c('CMIP5 IC3'), + listobs = c('ERSST'), biglab = FALSE, hlines = c(-1, 0, 1)) + } + +} -- GitLab From 30f52f66a639b71228a11b64856bb4bee6371d44 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 7 Jun 2021 14:13:27 +0200 Subject: [PATCH 135/154] Fix example --- R/RatioSDRMS.R | 21 ++++++++++----------- man/RatioSDRMS.Rd | 21 ++++++++++----------- 2 files changed, 20 insertions(+), 22 deletions(-) diff --git a/R/RatioSDRMS.R b/R/RatioSDRMS.R index 4b22c22..3bd28cc 100644 --- a/R/RatioSDRMS.R +++ b/R/RatioSDRMS.R @@ -40,17 +40,16 @@ #'# Load sample data as in Load() example: #'example(Load) #'rsdrms <- RatioSDRMS(sampleData$mod, sampleData$obs) -#'#============Fix the code below when PlotVsLTime is included============ -#'## Reorder the data in order to plot it with PlotVsLTime -#'#rsdrms_plot <- array(dim = c(dim(rsdrms)[1:2], 4, dim(rsdrms)[4])) -#'#rsdrms_plot[, , 2, ] <- rsdrms[, , 1, ] -#'#rsdrms_plot[, , 4, ] <- rsdrms[, , 2, ] -#'#\donttest{ -#'#PlotVsLTime(rsdrms_plot, toptitle = "Ratio ensemble spread / RMSE", ytitle = "", -#'# monini = 11, limits = c(-1, 1.3), listexp = c('CMIP5 IC3'), -#'# listobs = c('ERSST'), biglab = FALSE, siglev = TRUE, -#'# fileout = 'tos_rsdrms.eps') -#'#} +#'# Reorder the data in order to plot it with PlotVsLTime +#'rsdrms_plot <- array(dim = c(dim(rsdrms)[1:2], 4, dim(rsdrms)[4])) +#'rsdrms_plot[, , 2, ] <- rsdrms[, , 1, ] +#'rsdrms_plot[, , 4, ] <- rsdrms[, , 2, ] +#'\donttest{ +#'PlotVsLTime(rsdrms_plot, toptitle = "Ratio ensemble spread / RMSE", ytitle = "", +#' monini = 11, limits = c(-1, 1.3), listexp = c('CMIP5 IC3'), +#' listobs = c('ERSST'), biglab = FALSE, siglev = TRUE, +#' fileout = 'tos_rsdrms.eps') +#'} #' #'@import multiApply #'@export diff --git a/man/RatioSDRMS.Rd b/man/RatioSDRMS.Rd index 33cfa49..855bbf6 100644 --- a/man/RatioSDRMS.Rd +++ b/man/RatioSDRMS.Rd @@ -63,16 +63,15 @@ Fischer test. # Load sample data as in Load() example: example(Load) rsdrms <- RatioSDRMS(sampleData$mod, sampleData$obs) -#============Fix the code below when PlotVsLTime is included============ -## Reorder the data in order to plot it with PlotVsLTime -#rsdrms_plot <- array(dim = c(dim(rsdrms)[1:2], 4, dim(rsdrms)[4])) -#rsdrms_plot[, , 2, ] <- rsdrms[, , 1, ] -#rsdrms_plot[, , 4, ] <- rsdrms[, , 2, ] -#\donttest{ -#PlotVsLTime(rsdrms_plot, toptitle = "Ratio ensemble spread / RMSE", ytitle = "", -# monini = 11, limits = c(-1, 1.3), listexp = c('CMIP5 IC3'), -# listobs = c('ERSST'), biglab = FALSE, siglev = TRUE, -# fileout = 'tos_rsdrms.eps') -#} +# Reorder the data in order to plot it with PlotVsLTime +rsdrms_plot <- array(dim = c(dim(rsdrms)[1:2], 4, dim(rsdrms)[4])) +rsdrms_plot[, , 2, ] <- rsdrms[, , 1, ] +rsdrms_plot[, , 4, ] <- rsdrms[, , 2, ] +\donttest{ +PlotVsLTime(rsdrms_plot, toptitle = "Ratio ensemble spread / RMSE", ytitle = "", + monini = 11, limits = c(-1, 1.3), listexp = c('CMIP5 IC3'), + listobs = c('ERSST'), biglab = FALSE, siglev = TRUE, + fileout = 'tos_rsdrms.eps') +} } -- GitLab From 4a7cd9d28c9306521d80af9d8ec7b5d757a105e5 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 7 Jun 2021 14:41:44 +0200 Subject: [PATCH 136/154] Correct example --- R/RatioSDRMS.R | 6 +++--- man/RatioSDRMS.Rd | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/RatioSDRMS.R b/R/RatioSDRMS.R index 3bd28cc..4d833d7 100644 --- a/R/RatioSDRMS.R +++ b/R/RatioSDRMS.R @@ -41,9 +41,9 @@ #'example(Load) #'rsdrms <- RatioSDRMS(sampleData$mod, sampleData$obs) #'# Reorder the data in order to plot it with PlotVsLTime -#'rsdrms_plot <- array(dim = c(dim(rsdrms)[1:2], 4, dim(rsdrms)[4])) -#'rsdrms_plot[, , 2, ] <- rsdrms[, , 1, ] -#'rsdrms_plot[, , 4, ] <- rsdrms[, , 2, ] +#'rsdrms_plot <- array(dim = c(dim(rsdrms$ratio)[1:2], 4, dim(rsdrms$ratio)[3])) +#'rsdrms_plot[, , 2, ] <- rsdrms$ratio +#'rsdrms_plot[, , 4, ] <- rsdrms$p.val #'\donttest{ #'PlotVsLTime(rsdrms_plot, toptitle = "Ratio ensemble spread / RMSE", ytitle = "", #' monini = 11, limits = c(-1, 1.3), listexp = c('CMIP5 IC3'), diff --git a/man/RatioSDRMS.Rd b/man/RatioSDRMS.Rd index 855bbf6..7dbd682 100644 --- a/man/RatioSDRMS.Rd +++ b/man/RatioSDRMS.Rd @@ -64,9 +64,9 @@ Fischer test. example(Load) rsdrms <- RatioSDRMS(sampleData$mod, sampleData$obs) # Reorder the data in order to plot it with PlotVsLTime -rsdrms_plot <- array(dim = c(dim(rsdrms)[1:2], 4, dim(rsdrms)[4])) -rsdrms_plot[, , 2, ] <- rsdrms[, , 1, ] -rsdrms_plot[, , 4, ] <- rsdrms[, , 2, ] +rsdrms_plot <- array(dim = c(dim(rsdrms$ratio)[1:2], 4, dim(rsdrms$ratio)[3])) +rsdrms_plot[, , 2, ] <- rsdrms$ratio +rsdrms_plot[, , 4, ] <- rsdrms$p.val \donttest{ PlotVsLTime(rsdrms_plot, toptitle = "Ratio ensemble spread / RMSE", ytitle = "", monini = 11, limits = c(-1, 1.3), listexp = c('CMIP5 IC3'), -- GitLab From f8b987fb3910dc64a4c06fe9abf4009c7aa894fa Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 7 Jun 2021 17:21:45 +0200 Subject: [PATCH 137/154] Add parameter 'contour_draw_label' to decide whether to draw the contour labels or not. --- R/PlotEquiMap.R | 11 +++++++++-- man/PlotEquiMap.Rd | 4 ++++ 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 6ee7140..0e371bd 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -75,6 +75,8 @@ #' and 'brks2', or if 'square = FALSE'. #'@param contour_lty Line type of the contour curves. Takes 1 (solid) by #' default. See help on 'lty' in par() for other accepted values. +#'@param contour_draw_label A logical value indicating whether to draw the +#' contour labels or not. The default value is TRUE. #'@param contour_label_scale Scale factor for the superimposed labels when #' drawing contour levels. #'@param dots Array of same dimensions as 'var' or with dimensions @@ -216,7 +218,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, coast_color = NULL, coast_width = 1, contours = NULL, brks2 = NULL, contour_lwd = 0.5, contour_color = 'black', contour_lty = 1, - contour_label_scale = 1, + contour_draw_label = TRUE, contour_label_scale = 1, dots = NULL, dot_symbol = 4, dot_size = 1, arr_subsamp = floor(length(lon) / 30), arr_scale = 1, arr_ref_len = 15, arr_units = "m/s", @@ -460,6 +462,11 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, stop("Parameter 'contour_lty' must be either a number or a character string.") } + # Check contour_draw_label + if (!is.logical(contour_draw_label)) { + stop("Parameter 'contour_draw_label' must be logical.") + } + # Check contour_label_scale if (!is.numeric(contour_label_scale)) { stop("Parameter 'contour_label_scale' must be numeric.") @@ -741,7 +748,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # labcex = cex_axes_labels, labcex = contour_label_scale * par("cex"), lwd = contour_lwd, lty = contour_lty, - col = contour_color) + col = contour_color, drawlabels = contour_draw_label) } # diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index fbd7042..bac7632 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -30,6 +30,7 @@ PlotEquiMap( contour_lwd = 0.5, contour_color = "black", contour_lty = 1, + contour_draw_label = TRUE, contour_label_scale = 1, dots = NULL, dot_symbol = 4, @@ -158,6 +159,9 @@ and 'brks2', or if 'square = FALSE'.} \item{contour_lty}{Line type of the contour curves. Takes 1 (solid) by default. See help on 'lty' in par() for other accepted values.} +\item{contour_draw_label}{A logical value indicating whether to draw the +contour labels or not. The default value is TRUE.} + \item{contour_label_scale}{Scale factor for the superimposed labels when drawing contour levels.} -- GitLab From 9ce565fc77d019ba80410934bdf9cbed4e4f910b Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 7 Jun 2021 18:09:46 +0200 Subject: [PATCH 138/154] Add parameter 'lake_color' to specify lake color when filled.continents = T --- R/PlotEquiMap.R | 18 ++++++++++++++++-- man/PlotEquiMap.Rd | 5 +++++ 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 0e371bd..8892985 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -64,6 +64,9 @@ #' Takes the value gray(0.5) by default. #'@param coast_width Line width of the coast line of the drawn projected #' continents. Takes the value 1 by default. +#'@param lake_color Colour of the lake or other water body inside continents. +#' It is only functional when 'filled.continents = TRUE'. The default value is +#' 'white'. #'@param contours Array of same dimensions as 'var' to be added to the plot #' and displayed with contours. Parameter 'brks2' is required to define the #' magnitude breaks for each contour curve. Disregarded if 'square = FALSE'. @@ -215,7 +218,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, triangle_ends = NULL, col_inf = NULL, col_sup = NULL, colNA = NULL, color_fun = clim.palette(), square = TRUE, filled.continents = NULL, - coast_color = NULL, coast_width = 1, + coast_color = NULL, coast_width = 1, lake_color = NULL, contours = NULL, brks2 = NULL, contour_lwd = 0.5, contour_color = 'black', contour_lty = 1, contour_draw_label = TRUE, contour_label_scale = 1, @@ -426,6 +429,17 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, stop("Parameter 'coast_width' must be numeric.") } + # Check lake_color + if (is.null(lake_color)) { + if (filled.continents) { + lake_color <- 'white' + } + } else { + if (!.IsColor(coast_color)) { + stop("Parameter 'coast_color' must be a valid colour identifier.") + } + } + # Check contours if (!is.null(contours)) { if (dim(contours)[1] != dims[1] || dim(contours)[2] != dims[2]) { @@ -791,7 +805,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, LAT0 = mean(ylat), LATS = ylat, LONS = xlon) lakes <- which(coastmap$STROKES$col == "blue") coastmap$STROKES$col[which(coastmap$STROKES$col != "blue")] <- continent_color - coastmap$STROKES$col[lakes] <- "white" + coastmap$STROKES$col[lakes] <- lake_color #"white" par(new = TRUE) GEOmap::plotGEOmap(coastmap, PROJ = proj, border = coast_color, add = TRUE, lwd = coast_width) diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index bac7632..2673353 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -25,6 +25,7 @@ PlotEquiMap( filled.continents = NULL, coast_color = NULL, coast_width = 1, + lake_color = NULL, contours = NULL, brks2 = NULL, contour_lwd = 0.5, @@ -143,6 +144,10 @@ Takes the value gray(0.5) by default.} \item{coast_width}{Line width of the coast line of the drawn projected continents. Takes the value 1 by default.} +\item{lake_color}{Colour of the lake or other water body inside continents. +It is only functional when 'filled.continents = TRUE'. The default value is +'white'.} + \item{contours}{Array of same dimensions as 'var' to be added to the plot and displayed with contours. Parameter 'brks2' is required to define the magnitude breaks for each contour curve. Disregarded if 'square = FALSE'.} -- GitLab From 9bbd1ed347b44d01ca8a1c80fc160df4e6f3a735 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 8 Jun 2021 14:17:10 +0200 Subject: [PATCH 139/154] Add arguments lab_dist_x and lab_dist_y --- R/PlotEquiMap.R | 24 ++++++++++++++++++++++-- man/PlotEquiMap.Rd | 10 ++++++++++ 2 files changed, 32 insertions(+), 2 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 8892985..8f59ae2 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -116,6 +116,12 @@ #' TRUE by default. #'@param labW Whether to label the longitude axis with a 'W' instead of minus #' for negative values. Defaults to FALSE. +#'@param lab_dist_x A numeric of the distance of the longitude labels to the +#' box borders. The default value is NULL and is automatically adjusted by +#' the function. +#'@param lab_dist_y A numeric of the distance of the latitude labels to the +#' box borders. The default value is NULL and is automatically adjusted by +#' the function. #'@param intylat Interval between latitude ticks on y-axis, in degrees. #' Defaults to 20. #'@param intxlon Interval between latitude ticks on x-axis, in degrees. @@ -227,6 +233,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, arr_ref_len = 15, arr_units = "m/s", arr_scale_shaft = 1, arr_scale_shaft_angle = 1, axelab = TRUE, labW = FALSE, + lab_dist_x = NULL, lab_dist_y = NULL, intylat = 20, intxlon = 20, axes_tick_scale = 1, axes_label_scale = 1, drawleg = TRUE, subsampleg = NULL, @@ -536,6 +543,16 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, if (!is.logical(labW)) { stop("Parameter 'labW' must be logical.") } + if (!is.null(lab_dist_x)) { + if (!is.numeric(lab_dist_x)) { + stop("Parameter 'lab_dist_x' must be numeric.") + } + } + if (!is.null(lab_dist_y)) { + if (!is.numeric(lab_dist_y)) { + stop("Parameter 'lab_dist_y' must be numeric.") + } + } if (!is.numeric(intylat)) { stop("Parameter 'intylat' must be numeric.") } else { @@ -734,10 +751,13 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } if (axelab) { + lab_distance_y <- ifelse(is.null(lab_dist_y), spaceticklab + 0.2, lab_dist_y) + lab_distance_x <- ifelse(is.null(lab_dist_x), spaceticklab + cex_axes_labels / 2 - 0.3, lab_dist_x) + axis(2, at = ypos, labels = ylabs, cex.axis = cex_axes_labels, tcl = cex_axes_ticks, - mgp = c(0, spaceticklab + 0.2, 0)) + mgp = c(0, lab_distance_y, 0)) axis(1, at = xpos, labels = xlabs, cex.axis = cex_axes_labels, tcl = cex_axes_ticks, - mgp = c(0, spaceticklab + cex_axes_labels / 2 - 0.3, 0)) + mgp = c(0, lab_distance_x, 0)) } title(toptitle, cex.main = cex_title) rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = colNA) diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index 2673353..674e770 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -44,6 +44,8 @@ PlotEquiMap( arr_scale_shaft_angle = 1, axelab = TRUE, labW = FALSE, + lab_dist_x = NULL, + lab_dist_y = NULL, intylat = 20, intxlon = 20, axes_tick_scale = 1, @@ -215,6 +217,14 @@ TRUE by default.} \item{labW}{Whether to label the longitude axis with a 'W' instead of minus for negative values. Defaults to FALSE.} +\item{lab_dist_x}{A numeric of the distance of the longitude labels to the +box borders. The default value is NULL and is automatically adjusted by +the function.} + +\item{lab_dist_y}{A numeric of the distance of the latitude labels to the +box borders. The default value is NULL and is automatically adjusted by +the function.} + \item{intylat}{Interval between latitude ticks on y-axis, in degrees. Defaults to 20.} -- GitLab From 9d4099a14625332503224c0f6b32c9f961179d2e Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 8 Jun 2021 17:13:18 +0200 Subject: [PATCH 140/154] Add a sentence saying that 'lake_color' only works if lon = [0, 360]. --- R/PlotEquiMap.R | 2 +- man/PlotEquiMap.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 8f59ae2..9bc36ea 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -66,7 +66,7 @@ #' continents. Takes the value 1 by default. #'@param lake_color Colour of the lake or other water body inside continents. #' It is only functional when 'filled.continents = TRUE'. The default value is -#' 'white'. +#' 'white'. For now, it is only functional if longitude range is [0, 360]. #'@param contours Array of same dimensions as 'var' to be added to the plot #' and displayed with contours. Parameter 'brks2' is required to define the #' magnitude breaks for each contour curve. Disregarded if 'square = FALSE'. diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index 674e770..b5c3e03 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -148,7 +148,7 @@ continents. Takes the value 1 by default.} \item{lake_color}{Colour of the lake or other water body inside continents. It is only functional when 'filled.continents = TRUE'. The default value is -'white'.} +'white'. For now, it is only functional if longitude range is [0, 360].} \item{contours}{Array of same dimensions as 'var' to be added to the plot and displayed with contours. Parameter 'brks2' is required to define the -- GitLab From f7018404c6977637b3d9fc45d1678432b9fe7400 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 9 Jun 2021 16:49:28 +0200 Subject: [PATCH 141/154] Add one check to ensure the grid point has all NAs or no NA along time dim. Refine the documentation. --- R/EOF.R | 40 ++++++++++++----------- man/EOF.Rd | 4 ++- tests/testthat/test-EOF.R | 68 +++++++++++++++++++++++++++++++-------- 3 files changed, 78 insertions(+), 34 deletions(-) diff --git a/R/EOF.R b/R/EOF.R index 4221ccf..8f8d640 100644 --- a/R/EOF.R +++ b/R/EOF.R @@ -5,7 +5,9 @@ #'set to TRUE. #' #'@param ano A numerical array of anomalies with named dimensions to calculate -#' EOF. The dimensions must have at least 'time_dim' and 'space_dim'. +#' EOF. The dimensions must have at least 'time_dim' and 'space_dim'. NAs +#' could exist but it should be consistent along time_dim. That is, if one grid +#' point has NAs, all the time steps at this point should be NAs. #'@param lat A vector of the latitudes of 'ano'. #'@param lon A vector of the longitudes of 'ano'. #'@param time_dim A character string indicating the name of the time dimension @@ -196,11 +198,22 @@ EOF <- function(ano, lat, lon, time_dim = 'sdate', space_dim = c('lat', 'lon'), ny <- dim(ano)[2] nx <- dim(ano)[3] + # Check if all the time steps at one grid point are NA-consistent. + # The grid point should have all NAs or no NA along time dim. + if (any(is.na(ano))) { + ano_latlon <- array(ano, dim = c(nt, ny * nx)) # [time, lat*lon] + na_ind <- which(is.na(ano_latlon), arr.ind = T) + if (dim(na_ind)[1] != nt * length(unique(na_ind[, 2]))) { + stop("Detect certain grid points have NAs but not consistent across time ", + "dimension. If the grid point is NA, it should have NA at all time step.") + } + } + # Build the mask mask <- ano[1, , ] mask[!is.finite(mask)] <- NA mask[is.finite(mask)] <- 1 - dim(mask) <- dim(ano)[c(2, 3)] + dim(mask) <- c(ny, nx) # Replace mask of NAs with 0s for EOF analysis. ano[!is.finite(ano)] <- 0 @@ -263,23 +276,12 @@ EOF <- function(ano, lat, lon, time_dim = 'sdate', space_dim = c('lat', 'lon'), var.eof <- 100 * pca$d[1:neofs]^2/tot.var for (e in 1:neofs) { - - # Factor to normalize the EOF. - eof.patt.nn <- EOF[e, , ] * mask - eof.patt.ms <- sum(eof.patt.nn^2, na.rm = TRUE) - - # Normalize the EOF - eof.patt <- eof.patt.nn/eof.patt.ms - - # PC is multiplied by the normalization factor and the - # weights, then the reconstruction is only EOF * PC (we have - # multiplied ano by weight) - eof.pc <- PC[, e] * eof.patt.ms * W[e] - - eof.patt <- eof.patt/wght - - EOF[e, , ] <- eof.patt - PC[, e] <- eof.pc + # Set all masked grid points to NA in the EOFs + # Divide patterns by area weights so that EOF * PC gives unweigthed (original) data + EOF[e, , ] <- EOF[e, , ] * mask / wght + # PC is multiplied by the explained variance, + # so that the reconstruction is only EOF * PC + PC[, e] <- PC[, e] * W[e] } if (neofs == 1) { diff --git a/man/EOF.Rd b/man/EOF.Rd index ae84c55..3d67308 100644 --- a/man/EOF.Rd +++ b/man/EOF.Rd @@ -17,7 +17,9 @@ EOF( } \arguments{ \item{ano}{A numerical array of anomalies with named dimensions to calculate -EOF. The dimensions must have at least 'time_dim' and 'space_dim'.} +EOF. The dimensions must have at least 'time_dim' and 'space_dim'. NAs +could exist but it should be consistent along time_dim. That is, if one grid +point has NAs, all the time steps at this point should be NAs.} \item{lat}{A vector of the latitudes of 'ano'.} diff --git a/tests/testthat/test-EOF.R b/tests/testthat/test-EOF.R index c8c6d30..7966518 100644 --- a/tests/testthat/test-EOF.R +++ b/tests/testthat/test-EOF.R @@ -96,71 +96,111 @@ test_that("1. Input checks", { }) ############################################## test_that("2. dat1", { + res1 <- EOF(dat1, lon = lon1, lat = lat1, neofs = 10) expect_equal( - names(EOF(dat1, lon = lon1, lat = lat1)), + names(res1), c("EOFs", "PCs", "var", "tot_var", "mask", "wght") ) expect_equal( - dim(EOF(dat1, lon = lon1, lat = lat1)$EOFs), + dim(res1$EOFs), c(mode = 10, lat = 6, lon = 2) ) expect_equal( - dim(EOF(dat1, lon = lon1, lat = lat1)$PCs), + dim(res1$PCs), c(sdate = 10, mode = 10) ) expect_equal( - dim(EOF(dat1, lon = lon1, lat = lat1)$var), + dim(res1$var), c(mode = 10) ) expect_equal( - dim(EOF(dat1, lon = lon1, lat = lat1)$mask), + dim(res1$mask), c(lat = 6, lon = 2) ) expect_equal( - dim(EOF(dat1, lon = lon1, lat = lat1)$wght), + dim(res1$wght), c(lat = 6, lon = 2) ) expect_equal( - EOF(dat1, lon = lon1, lat = lat1)$EOFs[1:5], + res1$EOFs[1:5], c(-0.2888168, 0.2792765, 0.1028387, 0.1883640, -0.2896943), tolerance = 0.0001 ) expect_equal( - mean(EOF(dat1, lon = lon1, lat = lat1)$EOFs), + mean(res1$EOFs), 0.01792716, tolerance = 0.0001 ) expect_equal( - EOF(dat1, lon = lon1, lat = lat1)$PCs[1:5], + res1$PCs[1:5], c(3.2061306, -0.1692669, 0.5420990, -2.5324441, -0.6143680), tolerance = 0.0001 ) expect_equal( - mean(EOF(dat1, lon = lon1, lat = lat1)$PCs), + mean(res1$PCs), 0.08980279, tolerance = 0.0001 ) expect_equal( - EOF(dat1, lon = lon1, lat = lat1)$var[1:5], + res1$var[1:5], array(c(29.247073, 25.364840, 13.247046, 11.121006, 8.662517), dim = c(mode = 5)), tolerance = 0.0001 ) expect_equal( - sum(EOF(dat1, lon = lon1, lat = lat1)$mask), + sum(res1$mask), 12 ) expect_equal( - EOF(dat1, lon = lon1, lat = lat1)$wght[1:5], + res1$wght[1:5], c(0.9923748, 0.9850359, 0.9752213, 0.9629039, 0.9480475), tolerance = 0.0001 ) expect_equal( - EOF(dat1, lon = lon1, lat = lat1)$tot_var, + res1$tot_var, 88.20996, tolerance = 0.0001 ) + # rebuild the field + latlon_eof <- array(res1$EOFs, dim = c(mode = 10, latlon = 12)) + field <- res1$PCs %*% latlon_eof + latlon_dat1<- array(dat1, dim = c(sdate = 10, laton = 12)) + expect_equal( + as.vector(latlon_dat1), + as.vector(field) + ) + + dat1_1 <- dat1 + dat1_1[, 2, 1] <- NA + res1_1 <- EOF(dat1_1, lon = lon1, lat = lat1, neofs = 10) + expect_equal( + mean(res1_1$EOFs, na.rm = T), + 0.02270081, + tolerance = 0.0001 + ) + expect_equal( + mean(res1_1$PCs, na.rm = T), + 0.1092327, + tolerance = 0.0001 + ) + # rebuild the field + latlon_eof <- array(res1_1$EOFs, dim = c(mode = 10, latlon = 12)) + field <- res1_1$PCs %*% latlon_eof + latlon_dat1<- array(dat1_1, dim = c(sdate = 10, laton = 12)) + expect_equal( + as.vector(latlon_dat1), + as.vector(field) + ) + + dat1_2 <- dat1 + dat1_2[2:5, 2, 1] <- NA + expect_error( + EOF(dat1_2, lon = lon1, lat = lat1, neofs = 10), + "Detect certain grid points have NAs but not consistent across time dimension. If the grid point is NA, it should have NA at all time step." + ) + + }) ############################################## test_that("3. dat2", { -- GitLab From cc33fb19be7b05a539456b926ea355ddc8aa1c8c Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 10 Jun 2021 15:47:27 +0200 Subject: [PATCH 142/154] Add filled.oceans feature --- R/PlotEquiMap.R | 34 ++++++++++++++++++++++++++++++++-- man/PlotEquiMap.Rd | 5 +++++ 2 files changed, 37 insertions(+), 2 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 9bc36ea..8988a42 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -60,6 +60,9 @@ #'@param filled.continents Colour to fill in drawn projected continents. #' Takes the value gray(0.5) by default or, if 'square = FALSE', takes the #' value FALSE. If set to FALSE, continents are not filled in. +#'@param filled.oceans A logical value or the color name to fill in drawn +#' projected oceans. The default value is FALSE. If it is TRUE, the default +#' colour is "light blue". #'@param coast_color Colour of the coast line of the drawn projected continents. #' Takes the value gray(0.5) by default. #'@param coast_width Line width of the coast line of the drawn projected @@ -224,6 +227,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, triangle_ends = NULL, col_inf = NULL, col_sup = NULL, colNA = NULL, color_fun = clim.palette(), square = TRUE, filled.continents = NULL, + filled.oceans = FALSE, coast_color = NULL, coast_width = 1, lake_color = NULL, contours = NULL, brks2 = NULL, contour_lwd = 0.5, contour_color = 'black', contour_lty = 1, @@ -419,6 +423,16 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, continent_color <- gray(0.5) } + # Check filled.oceans + if (!.IsColor(filled.oceans) & !is.logical(filled.oceans)) { + stop("Parameter 'filled.oceans' must be logical or a colour identifier.") + } else if (!is.logical(filled.oceans)) { + ocean_color <- filled.oceans + filled.oceans <- TRUE + } else if (filled.oceans) { + ocean_color <- "light blue" + } + # Check coast_color if (is.null(coast_color)) { if (filled.continents) { @@ -442,8 +456,8 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, lake_color <- 'white' } } else { - if (!.IsColor(coast_color)) { - stop("Parameter 'coast_color' must be a valid colour identifier.") + if (!.IsColor(lake_color)) { + stop("Parameter 'lake_color' must be a valid colour identifier.") } } @@ -836,6 +850,22 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } else { lines(coast, col = coast_color, lwd = coast_width) } + + # filled.oceans + if (filled.oceans) { + old_lwd <- par('lwd') + par(lwd = coast_width) + + outline <- map(continents, fill = T, plot = FALSE) # must be fill = T + xbox <- xlim_conti + c(-2, 2) + ybox <- c(-92, 92) + outline$x <- c(outline$x, NA, c(xbox, rev(xbox), xbox[1])) + outline$y <- c(outline$y, NA, rep(ybox, each = 2), ybox[1]) + polypath(outline, col = ocean_color, rule = 'evenodd', border = NA) + + par(lwd = old_lwd) + } + box() # Draw rectangle on the map if (!is.null(boxlim)) { diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index b5c3e03..159bd57 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -23,6 +23,7 @@ PlotEquiMap( color_fun = clim.palette(), square = TRUE, filled.continents = NULL, + filled.oceans = FALSE, coast_color = NULL, coast_width = 1, lake_color = NULL, @@ -140,6 +141,10 @@ the spaces in between with colours (FALSE). In the latter case, Takes the value gray(0.5) by default or, if 'square = FALSE', takes the value FALSE. If set to FALSE, continents are not filled in.} +\item{filled.oceans}{A logical value or the color name to fill in drawn +projected oceans. The default value is FALSE. If it is TRUE, the default +colour is "light blue".} + \item{coast_color}{Colour of the coast line of the drawn projected continents. Takes the value gray(0.5) by default.} -- GitLab From abeb096201df6937b9e88933b7e7ef311a408e33 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 10 Jun 2021 20:37:50 +0200 Subject: [PATCH 143/154] Refine the code for masks --- R/PlotEquiMap.R | 75 +++++++++++++++++++++++++++++----------------- man/PlotEquiMap.Rd | 8 ++--- 2 files changed, 52 insertions(+), 31 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 8988a42..9c78873 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -6,8 +6,9 @@ #'A colour bar (legend) can be plotted and adjusted. It is possible to draw #'superimposed arrows, dots, symbols, contour lines and boxes. A number of #'options is provided to adjust the position, size and colour of the -#'components. This plot function is compatible with figure layouts if colour -#'bar is disabled. +#'components. Some parameters are provided to add and adjust the masks that +#'include continents, oceans, and lakes. This plot function is compatible with +#'figure layouts if colour bar is disabled. #' #'@param var Array with the values at each cell of a grid on a regular #' rectangular or gaussian grid. The array is expected to have two @@ -68,8 +69,7 @@ #'@param coast_width Line width of the coast line of the drawn projected #' continents. Takes the value 1 by default. #'@param lake_color Colour of the lake or other water body inside continents. -#' It is only functional when 'filled.continents = TRUE'. The default value is -#' 'white'. For now, it is only functional if longitude range is [0, 360]. +#' The default value is NULL. #'@param contours Array of same dimensions as 'var' to be added to the plot #' and displayed with contours. Parameter 'brks2' is required to define the #' magnitude breaks for each contour curve. Disregarded if 'square = FALSE'. @@ -419,7 +419,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } else if (!is.logical(filled.continents)) { continent_color <- filled.continents filled.continents <- TRUE - } else if (filled.continents) { + } else { continent_color <- gray(0.5) } @@ -451,11 +451,11 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } # Check lake_color - if (is.null(lake_color)) { - if (filled.continents) { - lake_color <- 'white' - } - } else { + if (!is.null(lake_color)) { +# if (filled.continents) { +# lake_color <- 'white' +# } +# } else { if (!.IsColor(lake_color)) { stop("Parameter 'lake_color' must be a valid colour identifier.") } @@ -826,30 +826,51 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } else { # [0, 360] xlim_conti <- c(0.01, 359.99) } - coast <- map(continents, interior = FALSE, wrap = TRUE, - xlim = xlim_conti, ylim = c(-89.99, 89.99), - fill = filled.continents, add = TRUE, plot = FALSE) - if (filled.continents) { - old_lwd <- par('lwd') - par(lwd = coast_width) - if (min(lon) >= 0) { - ylat <- latmin:latmax - xlon <- lonmin:lonmax - proj <- GEOmap::setPROJ(1, LON0 = mean(xlon), - LAT0 = mean(ylat), LATS = ylat, LONS = xlon) - lakes <- which(coastmap$STROKES$col == "blue") + old_lwd <- par('lwd') + par(lwd = coast_width) + # If [0, 360], use GEOmap; if [-180, 180], use maps + if (min(lon) >= 0) { + ylat <- latmin:latmax + xlon <- lonmin:lonmax + proj <- GEOmap::setPROJ(1, LON0 = mean(xlon), + LAT0 = mean(ylat), LATS = ylat, LONS = xlon) + lakes <- which(coastmap$STROKES$col == "blue") + par(new = TRUE) + if (filled.continents) { coastmap$STROKES$col[which(coastmap$STROKES$col != "blue")] <- continent_color - coastmap$STROKES$col[lakes] <- lake_color #"white" - par(new = TRUE) + if (is.null(lake_color)) { + coastmap$STROKES$col[lakes] <- continent_color + } else { + coastmap$STROKES$col[lakes] <- lake_color #"white" + } GEOmap::plotGEOmap(coastmap, PROJ = proj, border = coast_color, add = TRUE, lwd = coast_width) } else { - polygon(coast, col = continent_color, border = coast_color, lwd = coast_width) + coastmap$STROKES$col[which(coastmap$STROKES$col != "blue")] <- coast_color + if (is.null(lake_color)) { + coastmap$STROKES$col[lakes] <- coast_color + } else { + coastmap$STROKES$col[lakes] <- lake_color #"white" + } + GEOmap::plotGEOmap(coastmap, PROJ = proj, #MAPcol = coast_color, + add = TRUE, lwd = coast_width, MAPstyle = 2) } - par(lwd = old_lwd) + } else { - lines(coast, col = coast_color, lwd = coast_width) + # [-180, 180] + coast <- map(continents, interior = FALSE, wrap = TRUE, + xlim = xlim_conti, ylim = c(-89.99, 89.99), + fill = filled.continents, add = TRUE, plot = FALSE) + if (filled.continents) { + polygon(coast, col = continent_color, border = coast_color, lwd = coast_width) + } else { + lines(coast, col = coast_color, lwd = coast_width) + } + if (!is.null(lake_color)) { + map('lakes', add = TRUE, fill = filled.continents, col = lake_color) + } } + par(lwd = old_lwd) # filled.oceans if (filled.oceans) { diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index 159bd57..c025afd 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -152,8 +152,7 @@ Takes the value gray(0.5) by default.} continents. Takes the value 1 by default.} \item{lake_color}{Colour of the lake or other water body inside continents. -It is only functional when 'filled.continents = TRUE'. The default value is -'white'. For now, it is only functional if longitude range is [0, 360].} +The default value is NULL.} \item{contours}{Array of same dimensions as 'var' to be added to the plot and displayed with contours. Parameter 'brks2' is required to define the @@ -315,8 +314,9 @@ grid cells. Only the region for which data has been provided is displayed. A colour bar (legend) can be plotted and adjusted. It is possible to draw superimposed arrows, dots, symbols, contour lines and boxes. A number of options is provided to adjust the position, size and colour of the -components. This plot function is compatible with figure layouts if colour -bar is disabled. +components. Some parameters are provided to add and adjust the masks that +include continents, oceans, and lakes. This plot function is compatible with +figure layouts if colour bar is disabled. } \examples{ # See examples on Load() to understand the first lines in this example -- GitLab From 5a5d4762997084353396657c10bb3f13d9b6461f Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 15 Jun 2021 17:07:46 +0200 Subject: [PATCH 144/154] Add 'lat' in .NAO() --- R/NAO.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/R/NAO.R b/R/NAO.R index 4af0308..af4893a 100644 --- a/R/NAO.R +++ b/R/NAO.R @@ -307,13 +307,15 @@ NAO <- function(exp = NULL, obs = NULL, lat, lon, time_dim = 'sdate', target_dims = list(exp = c(memb_dim, time_dim, space_dim), obs = c(time_dim, space_dim)), fun = .NAO, - obsproj = obsproj, wght = wght, add_member_back = add_member_back, + lat = lat, wght = wght, + obsproj = obsproj, add_member_back = add_member_back, ncores = ncores) } else if (!is.null(exp)) { res <- Apply(list(exp = exp), target_dims = list(exp = c(memb_dim, time_dim, space_dim)), fun = .NAO, - obsproj = obsproj, wght = wght, obs = NULL, add_member_back = FALSE, + lat = lat, wght = wght, obs = NULL, + obsproj = obsproj, add_member_back = FALSE, ncores = ncores) } else if (!is.null(obs)) { if (add_member_back) { @@ -325,13 +327,14 @@ NAO <- function(exp = NULL, obs = NULL, lat, lon, time_dim = 'sdate', target_dims = list(obs = c(time_dim, space_dim)), output_dims = output_dims, fun = .NAO, - obsproj = obsproj, wght = wght, exp = NULL, add_member_back = add_member_back, + lat = lat, wght = wght, exp = NULL, + obsproj = obsproj, add_member_back = add_member_back, ncores = ncores) } return(res) } -.NAO <- function(exp = NULL, obs = NULL, wght, obsproj = TRUE, add_member_back = FALSE) { +.NAO <- function(exp = NULL, obs = NULL, lat, wght, obsproj = TRUE, add_member_back = FALSE) { # exp: [memb_exp, sdate, lat, lon] # obs: [sdate, lat, lon] # wght: [lat, lon] -- GitLab From 4bba8e3b320934ad3ab79ed2a1a06c8b8ce3e7b4 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 15 Jun 2021 17:08:08 +0200 Subject: [PATCH 145/154] Renew NEWS.md and DESCRIPTION for v1.0.0 --- DESCRIPTION | 5 +++-- NEWS.md | 19 +++++++++++++++---- man/s2dv-package.Rd | 1 + 3 files changed, 19 insertions(+), 6 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ecf2fa0..c2dbf9d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,12 +1,13 @@ Package: s2dv Title: A Set of Common Tools for Seasonal to Decadal Verification -Version: 0.1.1 +Version: 1.0.0 Authors@R: c( person("BSC-CNS", role = c("aut", "cph")), person("An-Chi", "Ho", , "an.ho@bsc.es", role = c("aut", "cre")), person("Nuria", "Perez-Zanon", , "nuria.perez@bsc.es", role = "aut"), person("Roberto", "Bilbao", , "roberto.bilbao@bsc.es", role = "ctb"), person("Carlos", "Delgado", , "carlos.delgado@bsc.es", role = "ctb"), + person("Llorenç", "Lledó", , "llorenc.lledo@bsc.es", role = "ctb"), person("Andrea", "Manrique", , "andrea.manrique@bsc.es", role = "ctb"), person("Deborah", "Verfaillie", , "deborah.verfaillie@bsc.es", role = "ctb")) Description: The advanced version of package 's2dverification'. It is @@ -21,7 +22,7 @@ Description: The advanced version of package 's2dverification'. It is Depends: maps, methods, - R (>= 3.2.0) + R (>= 3.6.0) Imports: abind, bigmemory, diff --git a/NEWS.md b/NEWS.md index b543873..c302b65 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,19 @@ -# s2dv 1.0.0 (Release date: 2021-) -- Add parameter 'memb_dim' and 'memb' in Corr(). They allow the existence of the member dimension +# s2dv 1.0.0 (Release date: 2021-06-15) +- New functions: +ACC, Ano_CrossValid, BrierScore, CDORemap, Cluster, Consistent_Trend, EOF, EuroAtlanticTC, Filter, Histo2Hindcast, +NAO, Plot2VarsVsLTime, PlotACC, PlotBoxWhisker, PlotVsLTime, ProbBins, ProjectField, RatioRMS, +RatioSDRMS, REOF, Spectrum, Spread, StatSeasAtlHurr, UltimateBrier +- Season(): Accept one-dimension input. +- Persistence(): Add parameters checks for 'start' and 'end'; correct the output 'AR.lowCI' and 'AR.highCI'. +- Corr(): Add parameter 'member' and 'memb_dim'. They allow the existence of the member dimension which can have different length between exp and obs, and users can choose to do the ensemble mean -first before correlation or calculate the correlation for individual member. -- Improve Persistence() input checks, and correct the output 'AR.lowCI' and 'AR.highCI'. +first before correlation or calculate the correlation for individual member. +- InsertDim(): Remove Apply() to improve the efficiency. +- Reorder(): Improve efficiency. +- Indices functions take the case without 'memb_dim' into consideration. The climatology calculation for the anomaly is member-dependent if member exists. +- PlotStereoMap(): Add contour and arrow feature. +- PlotAno(): Add parameter check for 'sdates'. +- PlotEquiMap(): Add new arguments 'contour_draw_label', 'lake_color', 'lab_dist_x', and 'lab_dist_y'. Fix the border error; the border grids are fully plotted now. Add ocean mask feature. # s2dv 0.1.1 (Release date: 2020-11-16) - Change the lincense to Apache License 2.0. diff --git a/man/s2dv-package.Rd b/man/s2dv-package.Rd index 043b081..5576921 100644 --- a/man/s2dv-package.Rd +++ b/man/s2dv-package.Rd @@ -40,6 +40,7 @@ Other contributors: \itemize{ \item Roberto Bilbao \email{roberto.bilbao@bsc.es} [contributor] \item Carlos Delgado \email{carlos.delgado@bsc.es} [contributor] + \item Llorenç Lledó \email{llorenc.lledo@bsc.es} [contributor] \item Andrea Manrique \email{andrea.manrique@bsc.es} [contributor] \item Deborah Verfaillie \email{deborah.verfaillie@bsc.es} [contributor] } -- GitLab From 598537f5a756823ec9a6f67ffe04931bf4f1cd9a Mon Sep 17 00:00:00 2001 From: nperez Date: Tue, 15 Jun 2021 17:48:03 +0200 Subject: [PATCH 146/154] degree_sym added to PlotEquiMap --- R/PlotEquiMap.R | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 9c78873..8d76f8c 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -125,6 +125,7 @@ #'@param lab_dist_y A numeric of the distance of the latitude labels to the #' box borders. The default value is NULL and is automatically adjusted by #' the function. +#'@param degree_sym A logical indicating whether to include degree symbol (30° N) or not (30N; default). #'@param intylat Interval between latitude ticks on y-axis, in degrees. #' Defaults to 20. #'@param intxlon Interval between latitude ticks on x-axis, in degrees. @@ -237,7 +238,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, arr_ref_len = 15, arr_units = "m/s", arr_scale_shaft = 1, arr_scale_shaft_angle = 1, axelab = TRUE, labW = FALSE, - lab_dist_x = NULL, lab_dist_y = NULL, + lab_dist_x = NULL, lab_dist_y = NULL, degree_sym = FALSE, intylat = 20, intxlon = 20, axes_tick_scale = 1, axes_label_scale = 1, drawleg = TRUE, subsampleg = NULL, @@ -708,20 +709,34 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, ypos <- seq(latmin, latmax, intylat) xpos <- seq(lonmin, lonmax, intxlon) letters <- array('', length(ypos)) - letters[ypos < 0] <- 'S' - letters[ypos > 0] <- 'N' + if (degree_sym == FALSE) { + letters[ypos < 0] <- 'S' + letters[ypos > 0] <- 'N' + } else { + letters[ypos < 0] <- '° S' + letters[ypos > 0] <- '° N' + } ylabs <- paste(as.character(abs(ypos)), letters, sep = '') letters <- array('', length(xpos)) if (labW) { xpos2 <- xpos xpos2[xpos2 > 180] <- 360 - xpos2[xpos2 > 180] } - letters[xpos < 0] <- 'W' - letters[xpos > 0] <- 'E' + if (degree_sym == FALSE) { + letters[xpos < 0] <- 'W' + letters[xpos > 0] <- 'E' + } else { + letters[xpos < 0] <- '° W' + letters[xpos > 0] <- '° E' + } if (labW) { letters[xpos == 0] <- ' ' letters[xpos == 180] <- ' ' - letters[xpos > 180] <- 'W' + if (degree_sum == FALSE) { + letters[xpos > 180] <- 'W' + } else { + letters[xpos > 180] <- '° W' + } xlabs <- paste(as.character(abs(xpos2)), letters, sep = '') } else { xlabs <- paste(as.character(abs(xpos)), letters, sep = '') -- GitLab From 31ebb83a085f6ca2664a3c3301c18d7e36eaae1e Mon Sep 17 00:00:00 2001 From: nperez Date: Wed, 16 Jun 2021 11:03:34 +0200 Subject: [PATCH 147/154] Fixed degree symbol format to be tested --- R/PlotEquiMap.R | 12 ++++++------ man/PlotEquiMap.Rd | 3 +++ 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 8d76f8c..8ddfa9c 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -713,8 +713,8 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, letters[ypos < 0] <- 'S' letters[ypos > 0] <- 'N' } else { - letters[ypos < 0] <- '° S' - letters[ypos > 0] <- '° N' + letters[ypos < 0] <- paste(intToUtf8(176), 'S') + letters[ypos > 0] <- paste(intToUtf8(176), 'N') } ylabs <- paste(as.character(abs(ypos)), letters, sep = '') letters <- array('', length(xpos)) @@ -726,16 +726,16 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, letters[xpos < 0] <- 'W' letters[xpos > 0] <- 'E' } else { - letters[xpos < 0] <- '° W' - letters[xpos > 0] <- '° E' + letters[xpos < 0] <- paste(intToUtf8(176), 'W') + letters[xpos > 0] <- paste(intToUtf8(176), 'E') } if (labW) { letters[xpos == 0] <- ' ' letters[xpos == 180] <- ' ' - if (degree_sum == FALSE) { + if (degree_sym == FALSE) { letters[xpos > 180] <- 'W' } else { - letters[xpos > 180] <- '° W' + letters[xpos > 180] <- paste(intToUtf8(176), 'W') } xlabs <- paste(as.character(abs(xpos2)), letters, sep = '') } else { diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index c025afd..b574904 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -47,6 +47,7 @@ PlotEquiMap( labW = FALSE, lab_dist_x = NULL, lab_dist_y = NULL, + degree_sym = FALSE, intylat = 20, intxlon = 20, axes_tick_scale = 1, @@ -229,6 +230,8 @@ the function.} box borders. The default value is NULL and is automatically adjusted by the function.} +\item{degree_sym}{A logical indicating whether to include degree symbol (30° N) or not (30N; default).} + \item{intylat}{Interval between latitude ticks on y-axis, in degrees. Defaults to 20.} -- GitLab From 87f01cf990b6254b7557f45413bdb9ce9a87b639 Mon Sep 17 00:00:00 2001 From: nperez Date: Wed, 16 Jun 2021 12:25:59 +0200 Subject: [PATCH 148/154] Add extra space in the right margin --- R/PlotEquiMap.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 8ddfa9c..f6a8538 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -701,6 +701,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, margin_scale[1] <- margin_scale[1] - 1 } margins <- rep(0.4, 4) * margin_scale + margins[4] <- margins[4] + 1 cex_title <- 2 * title_scale cex_axes_labels <- 1.3 * axes_label_scale cex_axes_ticks <- -0.5 * axes_tick_scale -- GitLab From 84e959c47dae6cd70a73b439c35e454b42fe620b Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 16 Jun 2021 12:46:11 +0200 Subject: [PATCH 149/154] Add PlotEquiMap's 'degree_sym' in NEWS.md --- NEWS.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index c302b65..e537e95 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# s2dv 1.0.0 (Release date: 2021-06-15) +# s2dv 1.0.0 (Release date: 2021-06-16) - New functions: ACC, Ano_CrossValid, BrierScore, CDORemap, Cluster, Consistent_Trend, EOF, EuroAtlanticTC, Filter, Histo2Hindcast, NAO, Plot2VarsVsLTime, PlotACC, PlotBoxWhisker, PlotVsLTime, ProbBins, ProjectField, RatioRMS, @@ -13,7 +13,7 @@ first before correlation or calculate the correlation for individual member. - Indices functions take the case without 'memb_dim' into consideration. The climatology calculation for the anomaly is member-dependent if member exists. - PlotStereoMap(): Add contour and arrow feature. - PlotAno(): Add parameter check for 'sdates'. -- PlotEquiMap(): Add new arguments 'contour_draw_label', 'lake_color', 'lab_dist_x', and 'lab_dist_y'. Fix the border error; the border grids are fully plotted now. Add ocean mask feature. +- PlotEquiMap(): Add new arguments 'contour_draw_label', 'lake_color', 'lab_dist_x', 'lab_dist_y', and 'degree_sym'. Fix the border error; the border grids are fully plotted now. Add ocean mask feature. # s2dv 0.1.1 (Release date: 2020-11-16) - Change the lincense to Apache License 2.0. -- GitLab From f2fe6b0a4efe3c42320cdcd69f9d1f10c4712281 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 16 Jun 2021 16:41:07 +0200 Subject: [PATCH 150/154] Lighten the example --- R/Persistence.R | 10 +++++----- man/Persistence.Rd | 10 +++++----- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/R/Persistence.R b/R/Persistence.R index 1840927..5a53857 100644 --- a/R/Persistence.R +++ b/R/Persistence.R @@ -74,18 +74,18 @@ #'# Case 1: year #'# Building an example dataset with yearly start dates from 1920 to 2009 #'set.seed(1) -#'obs1 <- rnorm(1 * 70 * 6 * 7) -#'dim(obs1) <- c(member = 1, time = 70, lat = 6, lon = 7) +#'obs1 <- rnorm(1 * 70 * 2 * 2) +#'dim(obs1) <- c(member = 1, time = 70, lat = 2, lon = 2) #'dates <- seq(1920, 1989, 1) #'res <- Persistence(obs1, dates = dates, start = 1961, end = 1980, ft_start = 1, -#' nmemb = 40) +#' nmemb = 2) #'# Case 2: day #'dates <- seq(as.Date(ISOdate(1990, 1, 1)), as.Date(ISOdate(1990, 4, 1)) ,1) #'start <- as.Date(ISOdate(1990, 2, 15)) #'end <- as.Date(ISOdate(1990, 4, 1)) #'set.seed(1) -#'data <- rnorm(1 * length(dates) * 6 * 7) -#'dim(data) <- c(member = 1, time = length(dates), lat = 6, lon = 7) +#'data <- rnorm(1 * length(dates)) +#'dim(data) <- c(member = 1, time = length(dates)) #'res <- Persistence(data, dates = dates, start = start, end = end, ft_start = 1) #' #'@import multiApply diff --git a/man/Persistence.Rd b/man/Persistence.Rd index b2bd276..9b09ac3 100644 --- a/man/Persistence.Rd +++ b/man/Persistence.Rd @@ -104,18 +104,18 @@ uncertainty (prediction interval) based on Coelho et al., 2004.\cr\cr # Case 1: year # Building an example dataset with yearly start dates from 1920 to 2009 set.seed(1) -obs1 <- rnorm(1 * 70 * 6 * 7) -dim(obs1) <- c(member = 1, time = 70, lat = 6, lon = 7) +obs1 <- rnorm(1 * 70 * 2 * 2) +dim(obs1) <- c(member = 1, time = 70, lat = 2, lon = 2) dates <- seq(1920, 1989, 1) res <- Persistence(obs1, dates = dates, start = 1961, end = 1980, ft_start = 1, - nmemb = 40) + nmemb = 2) # Case 2: day dates <- seq(as.Date(ISOdate(1990, 1, 1)), as.Date(ISOdate(1990, 4, 1)) ,1) start <- as.Date(ISOdate(1990, 2, 15)) end <- as.Date(ISOdate(1990, 4, 1)) set.seed(1) -data <- rnorm(1 * length(dates) * 6 * 7) -dim(data) <- c(member = 1, time = length(dates), lat = 6, lon = 7) +data <- rnorm(1 * length(dates)) +dim(data) <- c(member = 1, time = length(dates)) res <- Persistence(data, dates = dates, start = start, end = end, ft_start = 1) } -- GitLab From d502465c8b3f67ab35257910fbac4d332d2a153e Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 16 Jun 2021 16:49:08 +0200 Subject: [PATCH 151/154] Add 'ncores' back and add a warning saying it is deprecated --- R/InsertDim.R | 7 ++++++- man/InsertDim.Rd | 5 ++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/R/InsertDim.R b/R/InsertDim.R index 950479c..36ce2f8 100644 --- a/R/InsertDim.R +++ b/R/InsertDim.R @@ -8,6 +8,8 @@ #'@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. #' @@ -18,7 +20,7 @@ #' #'@import multiApply #'@export -InsertDim <- function(data, posdim, lendim, name = NULL) { +InsertDim <- function(data, posdim, lendim, name = NULL, ncores = NULL) { # Check inputs ## data @@ -59,6 +61,9 @@ InsertDim <- function(data, posdim, lendim, name = NULL) { stop("Parameter 'name' must be a character string.") } } + ## ncores + if (!missing("ncores")) + warning("Argument 'ncores' is deprecated.") ############################### # Calculate InsertDim diff --git a/man/InsertDim.Rd b/man/InsertDim.Rd index 7a866a3..51418f0 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) +InsertDim(data, posdim, lendim, name = NULL, ncores = NULL) } \arguments{ \item{data}{An array to which the additional dimension to be added.} @@ -15,6 +15,9 @@ InsertDim(data, posdim, lendim, name = 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. -- GitLab From 9b2e6b7eadaf80da69bb229fbbad7eab083f6870 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 17 Jun 2021 09:42:33 +0200 Subject: [PATCH 152/154] Update PDF for v1.0.0 --- s2dv-manual.pdf | Bin 274285 -> 376862 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/s2dv-manual.pdf b/s2dv-manual.pdf index 8c9d1cac06d9fffc9d59bc28e9427d11643c27f3..de5dc4cb860f84e21a44781861245233d13c7fdf 100644 GIT binary patch delta 357084 zcmagEb8uim_bnRR&cwDe!Nj(0I}=+cwrz7_+cqY4G85ZQ-hAKhzE^c$-KtyF-L<>B zPSxrDWA$2V?~84eTz_mN3Pn+I1{TKea1?Wk!>dW(;Aj!q;h1F2>?~X?iCLK0)B5K? zX@C$lIr|MRl6zz(N0{dmMN z7z-Dh&lMs!n`*jnBn{lSqA4|*Nw|nKh9d+S+42yazA(OtRDE%Ax+)H2I2~p}q*Mlq zfHG_sf^`M8I09QCb!bIBImRB7NMSNN8{k*$if<|QBldFbIoc*Q1d%j8 zEisPGl+Z6zIhvUIQq2T3iU1VVCO^ZD1}D zWx{b~L=mBG4vvF9qrjFt8mv)B4F}OEDFTNa%?u1H0s=fBm|0O!+=NSN*x!j(LeQBD zlXiWu;y7Q3IwUoCC?i`wHY)ii^+`mY^VYp>-IM zg7YmjwHhMyo;ragxwFVIU3if@#W6Xk$W>ZOAVItW3H(5^ChD?6GB)C|LeeYpv!Z6# zGJk;pYT`#KnV?pg)b+o6WjHx^ZvJ(A9?4ICIr;l;a#DrAKp`&>nOUKf1-R=ZWb3^% zly05Y;hA;kYl?fuSpunkPajrs^wQFhb56syV=MF#`4bjn6%e()=G9(f-ARR%U^Q~E zbTMETW^?X~+~Kf62?K10-bCBDRLzGPm`6q(HPh+ZQdKPOHXXS^=``AA8%Lw-ux~ z_bcx?we2UZbF0P8LkhGjd?NMCPf~&exvX5F_%jdpJ8QvhhQ5cEx#M8_j#~zLJ>z^mZx&B8%eloRb7J z6fV+l(QeqTr>nPWS^iM$ThL#4y-yQ_#5!DG+CCg|_|DB{S$^L1tSmjjYdkh~K6M`x zalJG*4x0}hoBXa4)3^I|vC{S2-Y|H^AN`tMzF^#g&&BkK%5Z;s%Fq+#f%90 zE;0u=ug4wO*REH)AB!i!5I9j0*JDxttKDuGj*$n(n~EqYtENSe!XPqPU>N&{FsJR` z7gWMex{veEwE3e49$+pH2}bCS`nK6`w+J^EnO8AyI6(=GI74HS7`ErH;Xfg zJ*+3PVI$0VrOpl_VHGhlMXZ)E<@o!{aP-%2a5Vu@6#&lukrsPo2T|ovaVz7jaNVwQ zA$z3=x2qh^%I=DGFS)!*T05ObE#oY)gxwkWix5>fRQ6gY8u&=2MdElHXxQaND|(^l zKOU;wILuYe$*56HUE_p=O^T_jzcFRY3iV9e#sAM z(nLEePGAJNbSiZ+7kL?&lyze}5o{k-cN&zY)a}ZlrY<(3Y8NH&udk#?qoVywIFVVB zjWs-Tpl~bqLcTYFN?P6W9aFdCluFjuq>4Au_(#Hy4Ip`tngYk1CyCEcokW`;i<5bh z+zG?>tK3vtyQL|)%VuJ6%(3~5vgToSvdNOr%H(@7yik!dFF)jkyy}Jo${~3=TDDa( zlr;-~YB^m+m$oWRQeqn3o4(&(NQ`8uq9%Nxow#9eTCA6Z6i!~?0hiyb8Th=wIfW9> zRz4%6F+jDp5&EZQ%4Cwu+7|RuXbDqc3ZH-EA*S-Z97G{3pisCPX;b-U6*$)V(CbgQ z;j_YrEz0VWqLJU!Y(77sP0QjBuDiIJPR%kCZvD+wVLBQgiNNbAre8{bs!Hk`dQ7AD z9O>gD&bO}#j7l^DHK#V96E}Uxoy+qZx#c1%lY|7mIeTNT92oLxp~athzwEfoICO8 zX0;wE@&{+zn_Lu>yh=re8EpDtXB8De+^Am{o6!*8&%aeho^ys-QNG<-?>v|<)yfTf z9k_FCp#D}dQg(Ql%Y^NELHWlh*H;u}-m}Hc&Me(S;b<@JTP z;iS!q1CMe^0Y$3wN5DLolA-K@DqkKqhk}M;t8xRIH$rZ+_Y@=oG$&Pd!}RIegLu}B z4+=R4B9Vp$0YUUVX*e{P-GyTbL&&p(5fIEs!jR-#V*PSvI$$V#K%GEi?9>oYl0=El zb+X2F^7^cl5v>(8Ykt(QR<-(j*$ZomTKFyx^dyFNY(H3LjroOs$QzkJTW>yWOBq;r zwZtrPSiX#uX0OU)7w;0u%*s)SQKAUulhJ%R)jt1;7oO}W>IYQXNl+eLH?Z3oj zk~M&I+^2?F#D37*@4^Csl^-i&tx5XT2Jgrhw|etQ_0Ing`@hJI0mjCi#^MV~4P5B{ zBYookA$`}9gk$tiQIp%IT29)U%_Oi$flV+tRyOt`j%ta*e}El5X(_$V8gni zu$l?C-fZ^#Zp-9t$dV4v@8{cmW7SKursFdqx;k7&2&L|@*i1$Wno^h=>Una9lQ1*mGf*!tDE?BB0>ci+T zDGYew>)S2(*}Gl=KC_fIjl}Z&MlE_y=+!-;YZtxy;J@DWXcNQhZBG9j#zyn zt}!15^8St|7j1tV>qgw;9Y!>)0U4tbhCl^-Q^NeApex!Kx&zYy|C_pYld& zd(;9uV$^~yDR!CD(5EWVv7mwwzk?E<9@9$8GLlV1%^VphhUr7nWLC(w*AliU=>p#_ zQdDcwg6&o}_r&DfXm5v_j-+tzW`XzH?F7YIG45F=|3#x0Mfhs8Q}2a~Y5gIn;<8Nb zY+>;bs8wKQwjxx9WIqH?{~cq+)C}lkEU!+CYQ*;6@nB7kNnrtJLXV-Z$5HAbq>izY zb@$|B7Nv`vJbEujFset5(b+l0^dq~57g1KJurqhl=d-l(_SbL%!5OJf+VnNWv8WyA{UuNTN6 z9}oQ}hQv?l+f%@1H3f%ZXlc;k@#>1(W~$gy=7V+M)=Q%^38RqpU#FKENGZ%qU*rqW zy7PPM9^G~c#YjVBF$j9IZtd7k0>@GDP(|dCQ2*~l`kkl!3oE7TRZ*qGpoxv(LH-9~ z0_rg}8#28*blh&9UQO;u%6T?==iA~Hovn|Z%F_AmPh$Y6t>)f3R*ynL(aYDU55BK) zP1FR9GADG5nGkR-qe*pQvD1ksAsoy(L&u6wL6n|~z#;BbX|tofw4^QJ$XJ&&FOrz7 z6fd!v+EOywzShxhQ&W^3su#6k+l;&p1_})})9(*(PY=|I6AHQ*`WD5)?2M<~P0cUCDh+(-AhY~wUcTuEs$4%;;qR|~oYzjZHwKmT z0?PAJ4*ue>5{_wLZKhKA>bdq5>-iS40f4*Q&h$Xc(}fMR~yPwIgQ! z?6`{;6I80ho2~Sm7$c4EIXq80gp$fdrwBz0m|tNxHqyHUR`wc`DQH> z{!2>CWUT;C!JlXwZo9S`#ga~UmH`Jv&X8z>@Ke)!>Zpw>5cYC#gBS-hLtB5by$z+= zr)@WJkar5mLy6mga^;%X!dzVGf=Y`k&Gte0Tf|A+Ti4gzC_E*W6oJJWfGzLQi+bgu zs+a-4txiFVADm=DMAz5pl6*BA^(zrss~yaF4)#{$TOWaizczV;7IrFu+{Rx1bE9Mb z@#Im|3EgvB>b3Y~u=q8Gx#L>!)4VOq<)%QIu5l*dM|CH#A_qQB@<_G&^}Aq({?RoZmj+W?NokC&rYZ+PT6YF>c;l3>)ym@J#IFOm^y!RO@whXpN< zGYVu$kW9Q{E2TxP^|GzUreGAsla} z&wg(I&bcRS9=j~UqLANJ8ie3w=TuOHehong_<-rNgsK3zL7n=#Np6Oyst$>Z(ioi%kc& zDt~u^5z4n{B`HUL>ruAk(b3T`TlbahjOY9Hrp_KG4XV4vyh`Y*I}5m}(5J0t$pKc|YI^T!wm?N>%y@StlwPaLnTQQo&dy7q(87 zkQKCgUcv=%2I7M%V_QO(u63JB>K3aOdESCl@nL`cGM#W$c@!V~5#oex8_Z18v^X6? z+GH-X^_I```%;}CEAdw{^WL13q7y*1^1$H)dWccp0C}%)(~wBxA0Kk`vm~R_%HNX0 zzL;=10}~JPTGG{8XeZU65^_9HK?5&_e%Dm=46S$i%^WqnZ5TpCY|b6XYXisLR?jSN7ytdLJ6 z?SgvvE9Du&s~%T!UBiK{8Qipwy+Iq+(0Z{3nD`r1xF|^6CnYoA^n;cjI9AJlFJ;^j zgjd|}@lyBgwE@-cClwJffmeUND;+qHM^=4iV;r0Z(2mVeHxKR3<2CcD?R0w3f^Lii z^zXr6DD}HW92OhEB{#al5&@4Ig|N9GYVK7e%P(*{$RqfLJ^x|Y%zVt-zb+o5ccSMp zCv`las)q4sV5>RA{AD7H6GR$szgvz^29vN*h998~D=kAM{Au|Pd+h{#znKr^|44NF z!`^F(%yIHd_mK;mvo)=3Frr#_B2D`qTjMSiTbM)3>GrphJR_lZ5e&yYveQZ&&d*Ux z6-pfNr{&f9brHsuivyCCP}z3^>2Hb({|7nF%$9@?M}_?T`~PR^v9hrI7f)#b?Hzl( zc2vI=gZ|OK1-ee=&y~zbk~4Blf=+QNxRGt<7OR+&_UYHz!wy5hBo~f+T@YuaO1H7-8$2#7FPRY;svG$?8c@~@kfvaF z==+jgIh3_7I#XW@=6NfgEEpY($cRX`#0cDHQjrnF(&DQK*dkFpoWy=F!erTTS{6ShD{;j~*|sEHY}9zxQt2jpw>A)BEL{loGr_+AhCJgBIS+;T zdK0ILzF@;-RTmeU+48!9{yS1@)fA&{a<%1@g%es$I^{_UyhE7$5*#FX3%uU3V0c;2 zfi~Q`k@jF*9@$@m<+yAV9X{uQsKW!yw8HCjMxe}<=XI<<%sPAuodY<}v;}c{Q1Qk4 zucJY*GwLnqqo{vWg^{ZPNR*LKFg8bpgb~gOC*e<`e0#_;SoUz9{4=aNogDc%$KZ)jho*#T_BhE}XuHIgzEtPa6 z*u!4(i#)$?e%?CtKKWC%=3TuRJ-l@;$pM{bO*a2N@aWX&^6(Zt>M^)9vi~-F_Tk1u z-!l{T`5ntP?qz=Z>Wv|l^MmuOrNh4YCTB*XM9*S7>v9?}Zc`p^Y}9(%d+OYF!M>aQ zsCx5k#(zDigA(#u%67eadpO@cu@c6UD00~*tN^?lih9>l5p?T&T3rVp&4WN=nN z9=gsas}G8*i8?BYZ8kjG=lmE3i+s8g)QT5 zKSA3#OJt3=tFPxWnqg~Fsfg;orm4uSts0{)-OhlHS&r8AYaCr~fB^2p0B5GEbNM#3 zdRdpV*!+9<1H%0&3npo)g)eii)=cV%h9*Syx`vX*nou-Zvw zF>Ska1*F-7wcIK@1FI$rQF&_pXQ@V zJ_F!?)>JQ)nkAM9)x7_=V04L4!~37n+Wh|p*70I7B#p3zM@0+v-#W_?7`5YQq!~B- z8Kkal3Eo*>Oxw#Px>yx59+0-pJw>XLjKe9kN1#08`e_16{@@J2GMm;DGWHDm6XeU) z2aw1`^y>f~7P6)UU7pA!JXt~bVY^%RIKuUigk7U3jWH2;IPdp3XG(_ z`6nz6b%84VghAnugY3+~CoGns(I%Grb0GzXP@$}RP{=H#*Vjl9qo{NDgt+l_IRfEu z&{yFF0Y+YNL!h&ighj%Q7Gp8x#JPkbXeh2YET(|1A^vyfp%WI-^SuQeOcGBS1{hB- znEw9R(R>(U`q7yDUGz3`i?+WoLZluY3AE1;gb~$1DT^K?KB%#^C}dtA+0AA7&a@j& zc;D|BpW)v}vY2Sdg##w&mw1fhzdMWng5?t4r6fmh{Acs7sTksxU{KfzM1}J^+MS1TQnI#qcJ=c*B!f;Wk^P~`!@{* z6v<4+@9Sv@bu0ZAD(i&Znf}M10CZOKp~ALPmRg&nN|u1eA{k zi?OVyd*LV~JrqN(!-D6r}vnGBH5D?G)tQB(c%8Mz#!P*RV?2WY9% zq0)pF|Lx@oF2>YR{|+l<;?n6zC>(=CaV0ZKfqimZCDCLWex{G(AA1?#U>6wU{s9^( zN_@s*@e*BRaF>*wgq|PHWe6OyaQM*go-IpoV=MRzHxO_S1hwj(HD+ahVdLgjj%CwDN0qI)Pzq+ec=4V+4~Kp8d%N-nZU2eHI1o-dn{cBs$(Y zOdL{CN=8p(uKb9g+0ECx0RVS&x9vzfDZGIFK1Du)l zf4N9YS~|6VMiBjW42;gB%yu;^-ze;*;u(~S85FsEtpWv84_AfH6X?c|Zm-@P#}X)r zNHlYrU~Y}4|HfID|>yO&7byuA2I74*yTcuTR*kk^35U^nWj+Y;)V5F zYgB(;h-T%v10VO?k>Y_ymz`4CLNTZ>Ug&`5OzTeKF0?|Eh%2jheX~r9khG}Qs-4d) zx9+U;)0XMW2Rf98iA=%R>=xIAW`bAyX0PwNk=6d8mIIqR-bh8!&3X%?r*hNJ8|lFz zE5eLo4!`p*U1E_#Oe)mH>2|KAUw=-Vw}`~_9Mv(A>9psUVlFqQIbivY-g0q|Y*v7z zoI2C9H#@>n+xhxch}=6-Ce^H;DBkk(cX!2+@}Xyle!mL8AWv6FODY4fdA3TZQ}#OC z4Q1;#;J)byI5u(_!)N-oBJ@#z1H}me_s_=zIcdLAeQSa>_Cf4ph6&^qM}dbFTA+e4 z<`QC_@fAmjW)hj39V$%$lde;@%sb-vuef#OOZ{i+Mq`ctf3WAUsLet9dr*)*wRa4wTJ-zCrmIK4_c)sPW&d>D@ z@#IM;NQsNjrOQ(`>(b5Vc*dB;aon?`9lWedht?vTZGW^ljwYKmFuQOl&&B*UhU}$& z+~C#b)whrrEjOVMb@^V3hlO@? z)e5ve4>jUr420+toPEo>29T4rB20_Gl$}e3U!LOVEAX&>!`U1KHW&f3`xNg`xsg&h z5mIO%lsV~z6j>iv0-x7GlOmsl>u(0R)QVT}G>be7!P66yfv_dk__9jOrm)6xq_Dh5 z*v#aK%&de2jblj5nDS^=$0g?wb7EY~S_x8OJXt2LWbs1C70GVTs6l+^ zqndeANaaj>&p6h~_Uv4kPa6fIL}1^BYPcnq@}Q85eJy^s6Ttmu!?GQtk8^T^aV6P+ zy3PbUnr@Q<>4Oq(52n&51hP9O26Z<#$#7^G%{+<+aaaFKfC@MaAM?Fyfbl%V4J*y0 zG~tZSnh7WRQ_N!LIYs%DqlXdC4nZYRf6cjyN9NLye^NTF&!gjEJ@?vl-E zu-IddHEumkOQWbBr~SuFbtU>N)`|~vO!)bx&*|on7p29~Op6Q|W-nJ_GNUzQm8U*v<3?6sQ{Jj8o}|A>0W=5bLAxT5 zZSkhzhxPuf>yD3JT)^N0?Q3Dl3T>CLxMV7&LFDqmWka(cBZo+u?P{+i)&jM>OxyrH zYH3Pczi~MAH;~AZuSHJ}_jmtQx$d!Fr-_|fQr6>QkiIv!Q0V6>o-?Jk#3JSn5&5B+ zk`vLX65xf*VfqZtyo=no`v_V*P8^Z~WW`G$5fi+p;3O2N;GlDdCO%+qw{bsWbCag^ z#KCNGyYeQSAz%B>nkX+}-N($%U5l5irJ*CWyO2TlEigN|;hCO=9w2Ez)Z_{X)1vD> zVw_Sjqbn^uB>MMR;XR746j_|7o6pqrh(!mh0%0Ftf*Aw^wl{QU5Js*mZXVEE2J^?w z?JZSCUO6MW!ag-s3QV!YSqqM-`VY3Ob97p1lpeXacL!eZZlaxgIGfoHb) z*BmLnkFZ#*Dwmlnw6@9+%(zKx$RV#?cZXQ`%J7^$9mqcw=VCoBe^&p=AODMQk_BZf z3p`;fU9v(X5Vi|E*-vW!c?7RZCTl#Aw-mu_I4NR&?_LonOr?iDzYUJpR;{0J*{0>7 z{1bU`@cUmcij0Y4#>5jHr{vwU9Nul{{%yvJnOjP2Uqt`Mfph^U1$XZANKC6JOI5}$ zYGF0IR(43pk1gqdwU}%| z*Oe((RZ&Z>1SQMtufHe9@_r))tx*PjiL1S0`+KFMgyLYT;PsIdYrh|>UziV4 zHYUV)ov%)5pM)484_b0lW^&ae+>emmzqT#;$>T`v&+Y0*@#H)0C&*B#pgc{2jvYAZ zeZ1eS^L8%y-?7P1RowpTMkI~YBmLt9eQaPDV4N)fEeV*`)Uw~?K>5cANQ$8fA-mwD zw#4ps+vNR;HU7xGqCi7cFZ~d9QCoO@e#+TX)Sj<&Jtwt%GmJWtnBk;K(@Mi?)SuR; zx0u!U%EjbyBnGo-Z{aeDJ%d!oVIFl4Y1Y*;I4^3=J2FVC&FgjKTq+S@J}u;j5*jf&{2s;#)iRKYsZPZ9JF_C=7P1i({0Hp5KX!!g#~Su^_R zax-ywb67gX-6zpv8<^gQr~@0|DO>=aUF&CCrqvp%w-J;#FvPOe{CgVfm@A#3X#g}NU=nL9us>J9$)@R zkorpP{Jqem1L?8M2Z19r-!MS|vaOIsBEw#o1Jm|SWe@4rXLzkx@9ed*R*e^rUWowv z*P9lhET&W}Y%j={2l*&(>;-8GMGHXMW~e4f4jq>C%W6T_P0&IhzD5bx@>QzTV^FRb zRhPNc;HTgY{crB4i>y}^a?=Dob?j>EkzzqzXzkj%x|Y?Wz3}hT5Y74(*s0VkWfz#i%Yq&%(>R~HYb3N`ufMV zuh-pSfHZ!{)V_Spo5UWRB!LA(2``yx|5#2HBw3{WbI%qO{jpVCRP#Vx0pDfpL_L!Z z`alMpGT-lW&^=ldBugXw+DrIr^qR2(`Ww9`qk0(#Mu-mnh!FSh!Zf=D-%vxv2S@^j z`eQi;2z~}@;}sOd6oiMrJ!1pNH%vX~U&eZ((Zty_Dxb5>pfX@0u&7iN;e96}8>23W zn>SaS2* zQZjKJh1Pp;DEC(T?BiG}nZj!-5SjriNwof|3L9>f`F?3RywtS2Y=%>xKZSOFtF~Ak^0R3WEVwA8Xk{q9ar<%+ z%~nry*XP)9HnUK@cE|&$BmQ+BM_%!6gbsYt@?XmjiM(`EG6YAo6mo3l+s;JPf3NTE zOF10lCajt0xA#H5_FCQ)-KjUlwr*R+y02;!YtzF=N5jj_<`iGgy#;5&((fGFK66D7 z@T|_G+xI{sa&j77RbRv^t7#bJ7_evX9^p`$T3=wY>iOme`0cpd9dmw}%QdPnt2w|72s zc^uv5QV_t4QQ-@NhbC;zXLjA}dtS24CLlG5!VyUAqdS!=s|42@3{r4wr{|G%UG;`1 z1cPNssQfe%%TVLU=o-7N>fGwN-Mha~0MmlC!jQhs`nU(Kxg0$Dh(zKF`^R#@HBo*j zDkqrsmi=5XZT9-c*Mp%1SpaXgmI`;Cq1xuiECgADr{pL}#%fPz?aNeg%Jd-G>8)7j zjM5dpK|cAQVqbWfkG^w;&d0c@1Kpd*A1|wHZ8RUbqwJOiwO21Xl=jwgX}*gshaPt54d1QiJ$cF(_B?9v3Z4FNq4DWHcD+rZ|&~C`7*q zqP^IH^FG1HjZ*jqsW9c0a3MHc^~rQ^;W@%h!!>5;}hm&p(k{kQ&fTDxGTDdQ2k5DHg>JiB^_YsyT=D6MbnA<-~TY z_KKHUXMr}0i`t8nn+<=)TO5wEQ;PZJCWIe; zNRli6%b<)oPy=}0Sl1t;h)K#%hz&i)KEm?PJfzEDp)zLhbSyi`iO9)6sy{7H5#q1!6L z1dNlN;EUb9RAEBnCXM&2cIXKxM zCa-ljNOZ)G)voP|3M8+UIAVBjuqI%u0lZ;4>`X`!j z)HzaVoM{7;B-PS|^1~(s;rNx3nITir^;mFVHu>lshF}>F4C_#7kYfV5B)TiAfIuLBba}B*kCfQk{CIw2Hx=;Pytm$U=~Tk zLolV%%^u2DT0gnUV<9WS9g4PqMH0NlR_5DqLDZfK!Z}3#}RDM5?4AhHSt(sRO&M9L@Bhv?pm#f--mXS>Ts*5 ztgVBOsWh;|pg&v9-GbTw!RXg4#ee&Z*8vs72ARi9P_S|*#KU1r*w$s^GLtV-?KtFQ z`At;V)+~)lEv(XWiwo(VQB&xkCLwH-(~&REKggj_|AKA@kyLFOV1uaiSAlp?_21Q8 z@{<;yY*_>A2MsJz&1SbuEi9imh`Y>n#m7@~%d8kwqTS`xIWuy%nsXDGqQPMo|66uL zWp#wG$)d8_#-za?-&7|pp`V7Q*FKI6nmmNFIT~8T_1Ie21!}gs;qutgBjSTwo_%GOE(;{v2u0Ge89r&{V7}=QREY(?g%=;PlfxC%@3P@9uP@V znS}|A3cH4TfZCsuY>9Id#7{RZlDi;WrG6_{{r)<>!ErSSY|0{@n)Z!dD1`XT9pi}s zA`S98(BpGs#KW(=NcYm{a^KPx7GKx`)*dlk!v#WXt3<(~?L7b5en~wX=F}~rpdn6(N?hXN5vP`*MJ>dq>7T|^<_Ie;&%FRTqmyg=V=6uTvrp% zW&0=t^{69kBTF+othf4RZJnvRP2%Wk^2bf;>uNP4-=^8jhQlC_LC%@7rOG30A>%5T z?o~NsqH|!p9adh;!y0^RfHAk;9Jjbax9J`oV_~7kU#=#qAvc|Cl`&$Ap1_^QIn^(D z?S`>+2zsO>&lH(Gws2bM&x&{mvM!0>?EQ?stqAbLT)F z=2`s&0b&dr=n)?sMDjN0_p!qzb>2D@)JQ|)$UO`{$o<3+yYlR0u82>sEw>fVhjJcG zRwAVFM^04M&b8%2I_Gbj-1H4%{7nQg6mtb-{!jtyi;E52Zd4v+E+R5Nx0kc3yHI~4 zyiNjPE!OsK?v9jV90fOBpNX_R%J~Uj z&`rAKe4YI74ipa)lIuDYl-D@fk5)54fI6e6DCyA|xP|z;CK`lSWn6m?3+J;lNLjJ0^>TpfJ=p1z=R3)%H}{s=e%(54kh5Z>Coy;duD=%22l$3 zEj=uhL}tX_ zCw=GN#2~NywkFKEZabX3fgxP9OV2$Y^ z<5)SR1ATcdD*PfzY8}QpW3Pa^thJ|-=qXtWrSt6Wc5;GU+JH~#+l&gnVIOne2=C?) z>l33uwlP&kj==!b@}cx%`6HC-b#Y2&V%nl#kvR|ijpH{d*q%i&P|-tXA`E=YbyRHV zO_0gW!iAtga#a2TLAQDtgY0wGV}i?R%|2AIN&d8KpTeam1X~^1Q8PgK-+QO3@$N#A z&SiVAgP185Z+m&EfeI^#%wIOhjMpVJf$Gb%BakVbg zNA!0RK8k`a&-1Q)%25DTbq~?1*nF^C?l1jsxS?4^hzRBKK(m^g8(NB1^DaX7IsK=7 z_>QKjrcskHPl*^yd!*>&6ruN74rbF{eE|?u;cpB|%-_laBfcpq>J75IMi4@ve|Tgt ziG!pN%AAP09zepTkB+!3hZ!0{>%MG-fA_Q_TQ;8wFL=pu60HOvmI$2lh{E}iLHS3B zvR@crgC8w$ljU*mD`)b#nD1VuaBq`=5(U2|%I)^*bRBY&i zp#{;P=4z{+q6C0gb@|r;>z+tlLF}+PEu0Sh)G1%1?`L*Dv`zCdlk2w&%#_~H$cD>Q}5?^#{c#zCC$`BfpYxUdIV=>V@^xp0;2&mbnG`cF#Kj~ znQzI#Q%RMvb--WatEcNo80&^kCVwDAi*D#r%u|$*|I=yQ+ut~ViVbkdXPG1lkxXm{`w`CqtRV zv`lK(@P;8u1SQeHep>dI_Ij26Q0g4StIOeu<@QFC+X;4_k8H8Wf558IU{TY0*NKG^ zfHAjsv^220$hwop32{W#-L}zsI^GK&8tpO?RVIsul6h>(}^7XH4vH4Moo|1!!xbEsUr={%Fx9aFjo626@f=LGs-|w z3NU}aF@JG%`*~7zx4;9-mp@oF^M}jB1baB<_UqRN$ui&g&=2*a1C{Tve6QhA_A?Tb4e z3Y+wtkYXJ7-2gE^DvPJL%mt{`YUCbyV}k~J`gBT zLy<3hNAk6A^OA3KZZ$7W-->xSQ*q?80@_f(IGPCXnyjr@AODFeJl?%7uTJOp7H;iS zHSu6l@BZ1ibLzEo={7eKYmqisZ;~l79Bp@$!+nsleNkc}Hm_Hz2dvPD&;^JoG z6EMrn5V-8p!z^dKI5`kIm5K!gKFl{7i_JEcMQczAMM5e5Z`lXk2zu=-PD{~?RMroid&be?NlVns$o6GE-f z57ihj&yQ5-D4EN^5z-J1B}?--Oc`2%tBD7MUI<7@?&kWDueZZ-WT)78cVwOCP`20q zRtiouqSe>Nk&R)z+k8L%+19zH@)gKNap)q88SBfQ@e`W!?S{IedF!NyzI}OMs@J@@ z$tCNNoq|ie1!D&^l_<0>c4m}&ruvNr-%vNz zg_=T!Jq1~w>4F<}^pqe=ygL zqvyQAb=loZ%H&QrTV)pUT9>kRE?Z;e-qCn6^S!+@>|&apVV(m|%7vyq;_Cwx!c-=r zL2hA&4;4ZZ1q2jD)S-bNR^HF^A?{40vDMKh@kNVvA?a*M3J1auqm1f~{W?i9TNj%O z@HlF&F|A}gaJ$_(GqA8P^0b%0F9tq&G5h}6z7FG+{>aDTTolI_8RAhP8|;|Qq6^C@ zYI)F|S2^qoAGVHM)Y-CPXdV{q=P6AGeu zfe6DEQl&e5AD>Ad_X_nH;Y#cs}(4e<_x2Lw{59{4OHEt{9>1CI8_7vn)`X!+@{BSe9W~dp4o}Qq{_gVmyp)e7>_t21>7R`3U(ffZ?#VN^i%Y zZ`ME$u~f>fT@m8%ad53i^L-awysL)e@C;S^;)5NWQ}K*a?>Cum;!3p2B56>4=-A5t z>)|eupj8=fa%}lP1xpm*srj73DC5wFKcKtDJuesAZ&d7+6Fj(gLFpDA=KJO z04t(AU+(JC8ASjZx<%WWqmY08nnmU;kJS=!{~xx_DL9jW z>(;St+qP{^?1?k6?Kie%(@5r*Rb*nZ>1xYTE5YIwuvXa%AN-?qLKmTIwui8|Bk{X|Z%0~V> zF%wkurvRYr&SycU>16YuTqm!g8{mBl^C%<737DLndx47WAKy@}%C$X%rM+v_QRGCf zrjioT;9vXOm`HXfbdHA6nZiDo5|Q$(C!CehzPSM6%?&_a=*kM?#a$b~fMnC39OVH_ zUdLkJg3r)*m^J8dR44d`>{Yw!w2UO9Adkw5C{g1~p{D8}-8jO6c%Cl$akt}C-fUvs zPDdMd0uUq3OZlp~3%3k8ahWx5tPEd1-&<)Tz4T)-)h=&la&22yN>MTOqiI6Qo)xR+ zA3w=tep=s}!70QR+^urL975XZtL`)X$nV+)*00I71ia1sTAmSD*IYKPf?0Xm3)kh| zE82!;$BsGf_?BhwfEm~ij@QtYg?K?1MmNjXC@S~W+-k!Z@EJ*BqgP0Atz%{^NMIiQ zv`xa(hWKJwckQadQw7#%Pj_S2E7uj2=}#lHJ%E)Kb-%J61W?bFSW-2)=&?}uP1;)M zL>p#}Dw-|Z7?N6pgjvFI4m|ottL^!q3`8jQ4nB?By|geiP~a6{f&0mN z2Ml|5Qpi7ry8sP71I+09i+xKuBcto>C=P%}Tq|h%Ch5Ug&Z}*m0LwK}qnHkUeK#e6EN}IbSU>`vLRz>x@VE9FFg+-I3M{j?$IWw)5?~ocs4Z`v997*4XRZ+YH+CxR!K5&qo+Qy5 z0&BH(2lY4`i7j=TEe)qk4JQ^S$^E#3gxe6N>ddvSB-Yh65ZY67-jF?#A?+Bu+LCT0 zX-zL#l)jc@oNc?QLDx|eCvNp64L6P`dN&cXnB`yS)$t~y(I;3WdqxP5s~o>#766rG=IY$x|FhDsnknaXRKbL;%}J-nnPL+$$;-;C=JouYXz;k<=4mZGsBNx^qi1 zJ~iwwQp3=gL_Wu%z_kBD+LK-~902VhFMH0ti0*?HASV!CBKDG(da!qgu@)dVb2ry6 z!ji$i;RRHQ(LA`lub@H|uqn;Fxy6RpI3k!r)nv6@BsL(bsuxHD+gZSGswdPnBCr>4 zC-H8JkBf1w9T~M-(h)ChhBM)V2`T4pJ<|!bk9zI$9v^EfQeTEj|1ik!y#w|PUEKqa zDR80vcSN)%O>9gPkp_Ajaiyk9786gY>4|8p8j}K5YN$;rc)ZQvGU9G)kImuu67=MP zUd27+K3$EcY^S=qAYg>F9@{50zlgq}`d8S3T`lR_Lvjt2>1~!Sz!*9WCDEV(CHczr z2>w&6$OUeL`6XCeyhaW^Yd_x6hAf_^JtaZTx^ma^&tN?N+rfPPo5hgA&1+U1FkTvr zuutB=A!JsrZDgVjUdPw#m^ftg-{pJQO(I)@zzwIXxKX;`yKK2$ic9T>-1_d|cS4o0 zc33-~4+EFV+q&nTt}e_Sd_6>s&e6K-!Q0{%7Qa3%@v?o~g-0SCv1x$HZ4DI4ip@Lk zTAD#pZ+y`elW#3PgI33)^=*G;;YF{>UwcwMEiOlTUrI;{eCPkBM{{?J^zhuXo2EyU#KLsOqc8`Q zn9^J2Or*%FJIg#=IE&&ZSf>&?OgpUDx~fgej$p>>nNb~orz&%_w5@jH#1wEj3&w{* z&3g0T1t+x@93H{Xlet_(v2V^6nBU*u4rHi2&gOSxO8B!DEXo#2@iP8EGlXdIW6WhX zQ#}<;d$neFQ2}-k7FH5dI;`)IQ&{y?4Q)pvD%Pi{8ln1i@FIDp!k&fFjRO_yUrfRc zonmI!A-;$8mSYZg1FqKJ$+1{C%t}K%k=r^vln6!=(yRBIz>V)UnR zhDP%b92Ba{AW-S022xuD0Q@syNyj45gMh`9CHB0zn4cM+lg`-IF@^!Ws2h0&3_LCp z(j}AQ6bCT4Fs8C?(``DzsXycdFP(lzK+!SS^~e4D2E=}|f8GdCrLX0#n!cvZ2dI>B zpo!2{@2@N3AZghAj2%%aQ7%mnXdR6M{i54Fq6}FjD}mwQ!h1MzfUUdJ4EiP0#M=3? zB98(6L;cXz9lm$)Ey?J{6p|worc2>B>@`oa-K7;iABc}6dmdw3OY1Ejhw>}_|= zJztd=u>*=CR%rRWKSQp&K$Of1;(!vI_(_J7{D(6zxmco=7%=o#Eqz+;>uwa9XOJpe zy+`mKQQM#7{KIt_z){mu(N7r=(*x>O1cCZHjCnAb%m!1QJ!`?_Ndre2O5al1wp1V( z^QbAf4A0o*qGvCcqCl3mIDU+RxqDOQ;`9V=8UDq+5SZ}Xz>B9=ziMN>2F_Hhn<%cw zNyDu5rivf-0K=idhQG0V#R{w6$Dbw6|8LYeIAX6qJSIRApnIN!g=k9XtFI@|Xcl<4 z>v`uYpp!FWb^{?x7jV!=xX@f*vI@7|j2D@*<)uvO3!G^Gk)}toe3lz8l zPN}aCz$PgMICs#%B_I&Z?nQp$VZga^0X?~lW-ziD)!?|Y$Pi0HS?^a@C@BK8E38un zJu2M%?Qv0jtOG^VTImxt=_`tNk!_g5;4>XU_82EI`=gl8*g?j`qXX2APuRx=$OFw`05a?>nxuX9XY3EU&mXOP&<@`ygvCRR=2((@P>VC%S3{<>RKKn;jNG_X zSN0Ss_1)xLpPhC0WAHtwE3>uvWtLx@8GUWT92ZcVaQ0DK+-W`ptsEd?IIlU;sNwXc zxMzBAQPWXGehtl?nv|uqCN+OJZb)E%PYw41J`p*edGyON$Etf4)CjZw!m#^x$m0%=v+wFH?n5nvScHjF#|`v>oM3tzIXmP6wGg`U@Z*u0Us{oJoG=+ z0+{YcPRP!g%Jd)UMY6`uk1ZU|cShgv5n>S7NZ~8})&6DHs>85jzgDNA%UU#l)zYZ9 znPoyN_4`Xo$@OyZsv5D%JiI_49_=ky3pY~BjuKEsQL_`2pWG^aIkJ4-caP;1$kdF% z>{Qs>qMrUV)LnV_sYajt&iBAKb1a@S)m^pSFMQmlH-3!>sm`Kuv|2FIfKg6B4oq5M_B>oT2~y#_4V{5JR@;U{JTTamBlTL zwuYXib3*NN+kOm*Lik{6#pX`Ug3^E|RQ_At5&>0qrh2Fv1IF)UDMU4+iYPxRok}XH z3429mQP5NXfOklw=(q2llPQKQY}v~a%KybuJYilI&&6=rly{SadDguPA25HR)6h$+ zB@!3pX!h%r{JA6KXYF(iTbQNM5Vz*%zgGXs{6L};=c0#3c^s39KL8VgCusB>v$C5j zvG~X>AK95TeHN&J4ecRnJU&%TFA28w#-uX7E`@>wz_OBrx|TM84Bt%~<$I8Hnlt$@cdjDPM03GPxI0*!R zAj2;e(7K*MKSL>$s)l8r&4*mLz_fc}k>WyI=&_(1)ID}Ur6drLCzM+xqMB*?Z$GJ2 zd6fAnph&1xmXL@Oq^5Sx;7Kf{B&$Da=XeY(P4GfpT3}WxG$E(Rp#}^Zah|G>GeQK- zgd+LKcE_F$@-<1T(wHTK98r_^t(yrkDnhmnU^kFw{&BK!Rb^%Ql1D&E>;Zj#$HFEd zID?XF9ksNN8tcN&b^S(nPB6oiGy?Uk9J#o}SZ{>Z)q+RT^ENi2OPpgz5*VZvP{(!2 zQ19FoC-=$WWHfxKGsc>b#39eJWSWG;8I!hD<@+zoTmq?hr{k6xN?#;2jeXOA!_(Lj z(4J&r4B%pGu1OKn1Q$ zaCzX%GoQqtMpucjseSDzc{$|NGZQ!l{1p*mpI*cc$&7V#tH}B5(oOy9nfH8r|9m}6 zCwLef_wRU8j&zCNeRxYP6C=bInX_W-B^=Tq?Z_pHQHmrrSeBNaQooy-Hc-6x0%C05 zbFus{y2zMT5b$WQ3+LO*7^ZlmWAE(lvcst`*={n$Hg%OX_MdNg2FMK`Dg`|qKx~b( z78-pElZn}?`n)Fw$ei-{oBy&4ybZJjMUI0gUYo;y&mjDJdtksKHmnFH7kYj-22IsN zHpG2GKs#3#8ym!e`A6TC;r4ByKLmzBgIrZN`2bMmwbpGRy%o*;m+rU|rt&okBLMAaCi1z zaUkuvEx)77R*NJ6EEObM(A)|W=D?Skkh~AA@QXPaUxQgiHN@k>-nfplyT)m zGE-OK8q2&!z_%THiA_-8y?u1Nshst=rP?Mp1mb-Kkh@;u@t+!!*fN0*!pW5k3`Py8 z($sg_;D7_Xl*~4DMS5#gkUWhj+j&WCn5@vR*feeMJ9lN#F~``}pN2cnd;bFl`vEB~ zEO&LK0YUlgA`(G!KQ8N?ezJHpWp#4J9_tYtQY&;FC6Dwoh3zk9mKer~ZR)6RQ|8{C zogCFLP9M1EVgJ>NGl70(=Ba7dc8&xnyMnk-=Ia7)mVg$fH)Py#!;C#QX4cQ@-*6Nx zS((2*Tm-s^xy9 zMDxWrI8|zN;q3n1CSwip7s>ztlH(!y+7cB-ZplV16)5W9sfp)@Hq`my`NklF64vUr$^S%P5rFSkn#_UcsGcVZsNJFgx`g1S$gB&C znIaPs)i=c!`^NO3o=@mgMo?mVS|du$%Zg_O3s5X|fKX{oNRnEF;S&N1?6ReE#k{IP z-D9NaO>10#0gs$Vc0|;|j1l&JuxA4ngor>*#W!YNl&xiXQB&Fq{iSlcb{SPjr6Nl) z&O%GDJ|A|R<)xiOlsw44zyYikPRntIG7}&c<c5lXUX<&9n9$9Hp|&52vdNXe>iKA^-I!)t1D7H&OuvQMYacK z;$%t~2}JC`{U;m3C!*Oi4N%#odE=ktH$_QD_vhJOhdg zhEIlH5^f|gjl8D-aavAs71%!!418Y@_L=+zY(`$FMou1bq{b|R#LVl?a8~0yJG9W( z%2ud$YobD<&jc36?e}CAacqNam2aneSL*hd8 zudSKW#sSb7XG{^JXCoHV{{(i0K>2N7bV0K>38^$|%aWr3qrE_+fVU>^zHWD{-VR~C z9Q=(?r_#yp39(_7tOUqB<3mMYkx;;y5B2m9$fMDgFM1W#l%0 zaKtQqcf$21t}hZVSLcPP0^yP=_Z^GCEGD4{Td=eydiF30diHhdgj^vo%D#I~{piNa zX@}zt-tQbhJMTYbgTVWzn-=5%Y%aNjZnzW05bifm7(`R7cg*_IFy&#+xkY#4VBR5Q zeU_3~PJG=WDrB_9310y5C8HZ*q$vV?B{6T&@{arAT?uw{NmZx!mh@kN{vxepBX7_- z{*BS|Hzs@1AZNbjVU>m^-Iea7R^a+{?rO0u0oF+Z0yaDC*POZYG;m~z1StMBuf2(DpNES(&d7x z#Zh*gtS)`J6i|f<&n>iy_;v1XN7wfs+xO-fq-~>WYHisBij#XFH{4+JPBygpao)Z? zjV1@+*OHc1g1}@NYgQIL<@YZvYpO@h?^qZ!X(Y$v>nS6~tvPpy4e`{W1CyKbkL!GT&%i7MVXC`k zI8%2AypJ|BdR9jS0PlyQ^1CUoYo6fq{6qlY6x8_eMrlwp1q?efMmXwgRtE7Se<*=W zD$U1z2TINL38U~cUZZ{_>wWVXo{<@yP$}v;GT#uF~B4 z&r}ZZ(`TW9(;3&voa=x-&w^ac=C4l7cR33aO*G2OrSK`~Wqv+&9N?pmDJ@W~qW;X| z?p`|>WsK_d!-g0&ZfvW!J7WvPuTP}o=xkkKse=e5#z^FY2t)h!O*>vMyR4cl0gRdI zRkn7%J`VzNkh~Z*VcDo65Hpg4JmdMgY)Na}m@2}+gACG(XQiCQ%{8*p)! zhs4YIaY1o9#XS)j!C2I|er5{hrzd9{Oz;QPeNJ4~;|6ax^JH$erRB=yaHMSoHmoO3 z0#a`edAPk3esV+UUsel}E-gzV@zolpI?m@yhY*?`WZxSlv4oVtvFCtRk8bB^&2-6n zb!Yy77~*~%2e7Elh!`jo!Ia8Zn~sG3jojGs>&e6%pY_7s@(FVs3B8P04~*7PuMQAg z<(u5(D1J3pd08h;47NoB)e70;CL0HZL(DCF%>u4+`h;{ysq*#HVh-A~w+fduudsU*5 zL9=+5#^67?>iAK94_UY_()3Uwq3dR)V!djUW0%HCq`aDSXM18P$s16+g{`Ez&;WU7 z?W_Fs1}UIz;Y;+T^b&qLA-gn6^V%FgrTU11?HF51h}yeHW<@}Id2zxD0Xmr88lHlg zGLn>?lfrL%5>5TONhNf49@J}JV+DvY{}SnAYn}oa0$MdBSrCc}A^W^JlD&ztuE!ET z=bXsw6Ti5YFLCeKdc!H;?v%RRiAqM52S*W;z&uP3!pGi|Jjh~L&-mzkzrUuE-uEa> z9PJF+%RtMeDI$P8uT>*hQrO19dURw(#QVVl0kyNuzSGPwT|YD)Oi3$X6o^W3nnxy{ z_=ciV0eTCW2IXwc0U~$NTeK2fn%T-c?)*>jVCi^>G&EGDVrHOwzeJMM?Rjdw0#oF? zaP~2z-`o(tx>}e5`9jg{IXffL#0)3np-2$-frWF8-Gu?Q_N1B#np%rp1=4hGr%BnC z`CuxwSL?@8i$HW)>+Sxeu>DuZp+7fdI{a69Wa#POSgrTLhcy#J{5cK|rzRRbD6yy! zq)lbeB^yUKm|-}qPSb#dYF5Rx#Z4soucmz4pCv2OpY9+`BwX&(ht<8d7KP5h`&EU4 zFWW`?6+-}8zZWGg?}*wz%~frauuBB-6DkHYdo?|}%>}DX2GBi9Lpz#9^q0q1xn~I1 z{eRuGeDOJ-%QeJBo&8Uzu|eg(0?B*{5v+PXIu z(krtFd9|~@S(s`SH$eQ7jA8=A-KJ+~tjWUFi3TNccq(Cg zRK;=3)_!$M64K2P#xva)DGv=}{O`wx>9KW_5SquBn#Twel_LqX{89FvhN_Yiqy|dx z(E~UM?RqiZr%(&4*GljY;}?(h&enVrG}V(WmQg8ZA!L2s%vpgN?VwJHEma+ z4W>+M$6q}pxMz7c z6B;ghCk@6Vb4_Ou(f{Qm`BCy-40LrR{(+kpaGFV=8?5ed5aGCE_2zGRoJFv18A5(% zMD7R)RzQkY`%9xN`e$C?>+)r=Mc>WouKijm&0w{sUv3y)juvQ>NX2BagPRG7Co6Id@j<~s>?RCeZ|Q>LC| z6!UC+WZ~x35ZCE@(pjs~gM1`hOuv0Nd=faVeRjQnS@`Fkd>XnP2`2-#_z_JyI8#3Q z%v8W)^j-{5??hw!Wo_-QO}RS-n_5HzsyrV+Xz}QN7I2qpRe2_-fF;-ghQ|h`w#U&g zfc@B)mw>~;45!97FnyD@_5V^$nE$V73WS|Ck-35z(4_e@xBKw{|I`x$a5~UB5t(H~ z$PLkY4$(;T4IE=1O~}9$3!O;$_JmFH@6VXdLi#bs^UBjm7ry(Loh=_eCDX1yu}{8j zt=YeSZv{)+UB(^|UCU$ePp1*a?CYVh3c>_#n{5A^I4JDfNp#b2D^#-igH__2B(XbE z-A3;S(AqR>k2AdjFT~$OjnbNO$C8-TMhqOJnj5Lm()yJeOoz*$4VAb`SmM92TulIh z{1Ea=b%+y8>wT%Ze7_7PavkD*SRyUQ)jQ^#66pwYhsIKI_yH#-O7MCRRtRgn)$4NG z80vvh*{k3oQ!7`ygRLR?JTr<(_Qrd_(-HLq@W$rx!L6*0YFS<8_95DN0Qv<6JTnTO zPcSVAZ`qPQ2J*5D>&>t$Wm-^apG4~|6JMp6;eS4qhk?kdlocxr2XgF#eLI>MtSPhU zu5+56c68C{X-V>xyNc3ZtRDg|LsjmLBnB2&uRc1%3ta??-dCYs;D}N+-=K_PE)kpx zfRv0-zo6R?ezG}3i~~h*N9r4F%Z!wnMNrV0hZfH{d6Ot-St++RwL+w*ISe^IcBIYD zE{-^nyjXITMEW;RwvVgi?S zrXN5KyV<%KyEl1rq@{&gvL<7SxbUvMkavFY$0>m>#U?StXm%~cpq(_vS5lBQraw+= zS68JE>ka81`FdMBkW~ngG{{9jlV9MsF^gj~$gmLANgrFdA*MAI1sJc)Z+b}wzyn)v z6t#eg*n#XKwLuNKibCazdFW-Rw3Jw|@`73vJ<8*gD6l9W8q*B|_^CNKSwJxa-xJO4 zNvXK2?%&nXsYwRj+2$dm{LQ%mFt$#4u1-_)Wu;|0dUxqFNFhZ^9r)6#}UYj);96=zx>};w~rDKfegk+Dx^& z*T~IjRB4u2QkW=)z(%yjVRog$CVyI5VF?0R!#RhRgyDvWVKtAHb*-2NAh%pLZaf)Z zmyhQk;RrSk;hxrqmo5i(uozf8*#%x5WW8zfrkWjpM67@Jm1UA0Q z7vI#dccZT0Lw#I&&{L-c@H1wnc74)*7q6c>b|i@B#QUV^*!!+ zR;UY^7q`B=ErN(u`@3xtCz6U|Z+dPSZ5>k~vdgrPS*32zN#l@}Xa_q7^~^gT7Ot^g zBVCa#Yo&RNo|N7EZr+>#LI>Nwv}JJv2ht99V(Aec54qP=XQcOozZxKu`S_)xg|^O| z^=km1?4}RQoEM&o36?L94(r#>Zj^@#!i7G>m6YNiFaHUDWZN4bw6E20koDDf=uNT3q)p*V-^c#wW(}0`@7E8&+)Qza_n9u%^5Eo-kw0N=@t-pukfew_Wa}WVG!|O zS(yg1iI`&Ov1AqmXVf{#r0CBTHm;Ph`oWHxp zxY}Wu{^E%Qg6leMb;5&GLiRekzI<4jt?+x@2A%gl-a@{ZmL*+flLy-NB%JxWeCE~F z`mC+-MT79b@eogg&|)j_rGyP=@HfDlG>d0F)U_$v=F~AfG{G^;XKc(7OJ}^+`RZ0N z9hhw{TN%fr8PU|hV3b4DEz7RdSz1&Fe9e}7P7#$#W<-0^=8g!Xkbe*B943QH8XNXaT-UOfKSZu-7cB4R^f4M@a1`aOg5Y%tIqwbj81k7|;7n28!EC?)3YXkM zGSO>vqtoA&<%Y~39s}r8DZlTsQ;Gs+A@IZDU(rm$1;|0fS8f?(QdT{1=@wEeYh^l z+8|tX!nMc6d&F0y`4!;7X3bTKdv;fAcRUL=u-KH@wb&7uPnx)>pYR3^AX|Wul@`io z@@I!In3eZS1YI@Gb2QdInRz^=^|PX`N@YS##JfigFlAR9wi)nB$`tk4NcdNx?t~!X z3kTB7e2V1MgO>Df*K)CYt|h8D2C@`If(i0$nI*;A@2S=d=P#FciFzsP+8NwfcS_S@ z06rvN045!a%qrDo_INipfZ!%((3D(eLM)`)y&&MWk;Is?&oUMW>i2B`F}=7;e>2)q z)zG2|t`MR79v-Lxq?U|n_9y{)&_>Tur4Sl8*Nk^*l}XCmje1lKF6Cs~Y#mE8enY*! zut@|h>S{M&?x;--$8TF4^7jbEI?LNHn-(~F`pCHgTaD;#=?+m9fE_PreE>X=vs=9i zuKoBmP4nr#SFuV%69}n<@Dz=_+0;QI0>473XkeLiTJ4BmiAwE=1SBZDOp^-!Y}%XY zL6~e?9e)G2xkMX@d3vrKd4EJTrjWmWUvQLINsMM~PH#?Vvzn^*Y?R_z%D=KdCC|qH zW-4$3{Z1xN*O54m0A}{7SfFFS)S_!~YT2;%Lu^(b&%LhA_R!h^SW7TBG2@aw_I3Bx3^N5%jhk(vCsk zL=4T|!}4Ice8lA`Gtb;%n(8&=XvA41Ym2PdS#yNZpz< z$)N1usBLXpi2GEOtn3ezv=pNJwSAsB2ts2xg5UZA^`FqtARHl=ip`Wc1MZ3M;NN{; z`D6Ba#*fNRd0WG#zV!~I5n@3o??(x;6M1%f$J9C*iMNeV*D(nIFs)E%9j@d>sgwIU zvm)%*fjRtqCxw*(L;=2OlFUz{CfpX&((w!6{>mMqR%sT-l$@1ybKXMTcoAwaC}S4g zWRrD02b51Q0&P|guP&W2N{QUgF)-dXk%?ONQGLl7ur?-DuKR^c+m0jjC^$hn?F%Hl zj67t4n?kS|p4zema1ugBJw$&jxZO{|QFOojcDEs+0Q3{4x)nWT?D>PArM?bB(@R~3 zzAVwld@2jKfrRb^)w9;JzQ}4(c@BGfVE@@|kcG>V@Il0AQVZ-;SEO3El)X*sa9h>E4 zE#9LGSvx6YyH9+tMdE?5l;lJowZiM4?yK_Ji(?-^C*ryWjLB)|5=vr~GIGxj7u2s- zM@S(Ui`@!NxeBOpE7=b6w_)SE1sxiTCM2e&Qr+hWlG)n}RZjK+QpOZexFBx<(+H@+ z%$Akl30|PuZ9V44=8VU(xX4y(4{#fRe(HiV70zu&!taKooG*UhC1fZ{kQE}QmX$}8 zcIy&LBo``GgK1@4W!X4Yv)v@2RFj@Il}G(!mnHehch$iQVE7IEGaTOi&qD0SIq)A) zG&~o}{{uxcv!ycn0MjJ=g#!FUfUN4ZW)Yi(fJFhl`E7vE8<24~!aGW#=0o9V`X2yY z_1t7O;Y-KY=hM-n^gcVbDGYGNvNnj)azaxd7W+H)ErD1KHH9Q#tzeMR4pWzs|E6A4 z9X6xqrGS)?z)BLzGEqwCoqvU*h-8MqkV?cY^RH}8#wf*^RD{W5(glQpsPqMhgEj!m zp>VO5?iJL^8XUihpo1dAan<^1j=>kz$xzoCG3gnE%d#aFViCnLN}W zxIC>4r^utz09~GpNltj|1uCa(fd)#;MUMdIyc0~gVj4D~Y$3o5%g8*HY4P3%(Us9KaQ-lPTlJN$2sVYSrCS(&PElj3Kq9MhE1SsmGdL!)z%4D=3#7dc& z#u#|`-ew%Q1>D{{x^!XX_gj=Xm65#)(zCLaCdC0%RL8i{|Vf!S1Xqf!u7DT9o@fz7ZvWfNyz2Y^d7L?^vY-oKsSd!p@oTVG8~jZ8Z< z8Z?%*aGLW}Y;Na0m~i=e9faoKVqL;xYE-Puq$mo)VJb`y++|c6~7AI1ZQXq}XkDdp5pvM&Z)K+vz!fHX*%(Snm#1(53-p z0&rhLURH0e;Wq}ise_Gw4I1VlPC|QMM%Mp`$gA!!O}bhV+6xb-v?ZyuiuA|iFSEJ0 zWQabC5Ti&59UBlQ=;mhpN+1)PP9duU7ffhbn>k-z+2T7J+C(I684#AYGCRV%RAe%9 zf5{NGLODh}Zj^*K>XKg}kw+fmlV1SK0G55kdkRjiDAU-EQ~vc9p}Fi_6ybhMiR!yu zWTcRC$|06o(Li<*Kl?W|)`?z&I2ERq`u^jq+lnxDF1mCT8mi+L51JFzz5qXHXOw?7 z9Gi7HI|KRdE?C*J9X+orAe@C?+qQ)o37zyYNJg`&`GY|wVddoKbE88EPlK`n4Zv+p zRPEYWc`_wa;eti<_r+BVVvm?}0!TwHN1IMUamAM8rdud(8+uc8Ly9RZ#o$HZ& z?VeVda@{xmaJ)=wwOA+Q%v`M*o)WNU{!RPj-;g3T?ql%$eKzAq-lTcSOG}h+_#kv! zL#zq@)F!$F|7A6PDq%&Kwih&i=6Kg#zVK`1a3>qTgy+dkUT0MS z`$)vq$Z1~lX3i(46&b~{gXaex_CbgXP6!-{uyx=@ zOZ3e8X>L^wp5N4Tw|P9h+ay)N^hgajyEN#4i@YjjRoAP&N~2ZVmM;Oih_*g%jtOga zhVOz{Wkdz1o#I6K0D#Ypmm4)w#L+hyuD1awl_8UJjtJw74tQ3v`XGt5t}@dH#-s`5 zp3wn^p{`343$>QD5Rdbx=7lT#{`3_>)iO84Yr!Xz3HL3Ke|?MdmJ2LnRWgT!;v_t3 z86E211vJGw0!;AFFXYBafRi3!cHwv%q*w8TT9J$S#tT{l8GwkLPlZ(oY0w06k93g6 znJ>H*_?Iazc(_}GhTLX)J4Ytd-LFdSJWE!gDr?o5yvt26trv*=-iz4Kz_ZHo?Yzk} z=d(Vx{M%+$U6ti0g47?Ul6?;_Ihqxfl+zZ?nmp1Ga!YSdeHGre&CqzW>PF(co0lfw zO5ff7+T*0(1`zk^fm6qDzkPasP_}@<@oMxEtA0_%Q;R$q!wk8^F3HP(LUS;?$*64Bjx`b z3adno))m4OWr%1zj|+#28yj+N1Bdkv06euLzE>#)pM9znQoJZUlpr!@WfYJOO^3wu zToF>3K}LQ|<(`k!Nu5;T{8zN4_0lw1p1q4@1S0?!)$5rYg)w(JLpUQ-}je5;*a zrI-=;uhVSYnUQHCPVw%{lA$(%K5X`UETambgALmjr zZ~_J+6}Nj94+*%g!OE}TUFk@AysRx50m-ZUmrYU+;Sp}uLq%A(LjH*WL5kRty$J@| zYB&FwI#t3BNsX=4CZ-d>cyc`%g!Cq`$WcUO22UVsT7P5Sa_#!*1F?aTof|ls1 z27<*pEVa68Ceh1vk}eBr=<11fnCC=n^0l6AE}?w|%D*}$npL4WdukA{(E@w#UH#M7 zGDt~`fl?F>3;dSMlo?!Sl58Ev*S&4R*VbGdOoou|3re0O<(r?h==QKyBBvLry{?md z4WFCpJRw#1-?QXb{?}6{^nHx_ir~NDRM}NO#ptrlNgf*vF2@yV!bD6he-Y*)NFSOF ztyaV`BmO?S6o&Iex>EQ(LX2x4WjpcbrCFP@a6rA$7Ug?b1Ucg5qx^6LZ z^?ckW&Vvg`*XDu;ymQWg6TBDPKD631GNyqLQopa{z6Br+t%(B&qN#%$^B+e(_{6{o z=B}8M=b3mY2@Smn5b<+4y!VPcK%I0C){?=u-3Yh4j5G3a?oNk>hc={N&RJzsy!5pm zu;1GlY4406egLU*Zl@!G5-JqUbE(?pF{VN#f3%TWSdZ>(%><0}ew|VCMb% z-aB938v!KnmUYOG>$2-dgsuaJbBm7>^+>2f?9jL@I*mgAxC=%d0yhu3F`*!U`q%WekEd||ca1w2X1!#EbVuuYGnN=e4>7M?PJ+!J!s%edo3&Pu;?pJb z(uz42gaQcuQLqr`e$>aRYD%o1zzudN;;#G@1>F~g%Zxu)oxSMbeQy&__Xx+hd1IwM zx2BCAe>2mCOQB&CE6UDtS&+K~Nd=+$fHCma%wSUi-Z48}M1OrhUaINT1`YmS{)AXrQ&B-dP{6pjIf(uz zVNO%WZh;BScc&(7a3Ta}W|}{YA8r*13fdxxGK8YVK}WVNY4EBM5R1QIkwwuZhYGbA zIyH9J_Qor~oeNXd23{3wb~9|2+LB{7M1+vli!(z9Mr_~J3j+$}y;3(E{&ev18Cv5; zHZT#HdoYvQV!Jy3LIh$sn7tH1g+^lrP;5Kt&PR9H>P2mD#%&W>a}_aUly}UEKPPx+ z%1_tC!myM2&|L)%IvCUS{GH+nu6A*X^BgaJJO5{R!2C2pHiu|&qY;T|;zTmF{!x+|U^s?L zN#vNEcnP!*eSs1$A`+WcEeM0n>bEkVH25G45os00n!qa4MetM%JI5VC9Nu?2k>N93 z+uL%dyt`a<N_$~HJl4PLzj&3zM_#2eR(;{( zPW#u%&KpN_S_|ldPzOc~H0M&v0dTInz&kgZry@3uig=)>UZ3m-2HkQ~t)wH1%lcfb zlf}uC7yXJ*C*<-xx%trYIth1MFPYEu&PZYL0soR!+Zbd&ikN6k9f#f$y+<|Hf|8CY zdN{~x%;RZEGu)ygSmroXDmf^{swe6-7lO$05K#!O{0Zw>3>`j%w+%S+(IP z_y)lS6%%oY!n^MjI9tuRGEfroLl+HY8YdN(zY(3dGPoKKX!n`)O4Ie2>)ELL6Oz^<3?*EITik*4Fasc{ z^1p;k#HHEF3^pO9sZ3>93d=k_>8MGUVkQYJGF;6esm+3KA-^#404*!}-8L$9v!nkK z17hiUtjmV94-Z5DJUD7O8(H;gB5aUWC^pi#=cX*2dnQ;@3DcO9(-AW07Fw#Rs;-M; zdHV;xY3#PicKUxMc$G=4KE?AImVG?k>9EO74^~=pSC0k9Io#qVUt<#|QOg#cKE-Gh zitf#o*FH!pRxQxn#RnHE-;$mLpmXCXgV8fJL)u?%I{EnY{Q7+=hkxpg(@BUBGvmE4 zMg-F}i>=2EC9(^dFDe36d&4~t{%`;^H;_9pGh!w@8}}%R2$m$n|93JpR)6L#YKsam z23+|l3*}rI6yzV!iUuMhGV&CrTL3i$#k7#ct1wbBAH@Os2l~X*zU|=0@nau4ukqrK{)R zWsrCa0)<6mV;3~a=;Xb(mxcG=3bo&BW2ts2zyu)3Br&IZs-t zKU}{1CPz*eAy=V$v^EJPN3BZTU@e8nMF^WJe*!%*C2UeSdGjEfVJ3^#;=v2(Qdc)G zriDRy z$9N~w%RP5Q-Qwa<6ZT5;e&@0oKNdsA-7IoK+e#{8rG^21Vv|bbZz0a2s)!|40#&sm zu2v>2+_=o2R=*Lv8O$FJFN&{%iz>mAMd4BmLxjepOaOG=1b?}4s z9z(@?9ew;w#p+E9Q!NAVvp}=9DhA+(^3(3lgbH)$KV28jQbotAJ562SLMlYJ9T(RZ zbRu(PTc5gU&6)D=y)|}JxkWfiw6aZwnzxIDy|iyx1qBn_BE4}y#r?Gm+F+UMN~v7R z-FPT+U3iDoX30f>1OS!R=REzFjARA=pH^s8P&SVLEA%PRkokv8ApO12a9j*7!%p6l zAzQLSj3mrpC1`a^(NB_vAR&fDO;Qx3j{EWRs3($>Zo)0WG=iqZh(_GuKh*L_wdl_6 z(w5WL6-#V(O>;uhsf<1H$;B0~|2>%72?c8NTZi!SK{(|>p;AC!H&jZ2R06f)rG;_7K5@dA))gHCGNrFR@0leuP*4RPq+Q6HFm ze;EX5zwj4v*#C|tU6P=<-73k$afRbeQ;Qqfl04{I*SJa@JF>oa+aHjhx#zhbtiLJM zH#Ivt9H5vPH$sl-++%LOZnm}(<9DQh5u&g1NbccT$BP?OtesH=qKxyUi6h~VOC}ci zcm&8mW`THQywhpSn6+lkCE7CcqZY18ry)?w~)TXA+GGhC%oZ?lJVppQRqWo?_MXV?knwH)5u^4 zF^J4ThA_7qS>nC5wHOIuzBoR1*-3rh_XfC=qT5-vWShTk8m#UZ^-y{(8B*>tS308{ zb{wB?@M^BY&6GY3PHPQF8W}{N*N_U#I@A-5n3)ks+FLG46xJnz^FpO}jZ}MA98Rep zKh=T;0Hsjs2dH6TLLltmSNJ+&2%had5yB_MTmq(4$rKiNXI6?l%vIw3PDxhkzuaPtpR*&c~2`z?{!1j~pg z*ahkBA6X(5?%@GMQ^&0B1lQ7+AAoAwm_Xv33(S#E`~vERc5$SBFexoGvTCl_kIWPL z!)aHeo^ng+{G=HHh_HPgN{Q& zk@>u^z41p9d{nUJOz8b>zRwnO(Eb#6XJ_RyF1~c^poy!BW}qoDlF+K=Zfugb>IJ1CwqO6ar=99Aq%}qaevJ zMcl}5EQ>_ibgd*HW>ko}?X6i&M|Ir#0$x-0X6$?dP;d5;Ln}>ZG{F1U8w&6+}4WyVr*d-tW4p!*f7EaV}FIvSrjk{ zdlm9kx8YDqdEYmEJb=f9N&f06Uo-t0ZNeO?Nw*oC_yo6@Y6BBO(R;$!VOeY|5LO{_ z?1>`Zj^##bv{b}&FS#SGD)HDSfZi9C+bY~X6Q$#;q^7YKF^UO^(g-IuuH+hva3^0Z zpN(yk^6VN~2WiXTFXw zB^3IloWA8s>lLPP4u-90Wi~)ofg+1)`j40s8^|k%ggyu3{&< zRJkl1VZ;vWRw>D^*2Yp1(UMLM?F=K?8FARV%joX~W*#0|cn-{m(Z-*^gvFgd63zSz z_;h`@d7lP+Fbj+SC0W?gfUAH}L7CVY)BXo97}EUza%FuoBD)?7$=4!Ndg8;~3 zZyU~-wHiz;qh8ycqhW3q{`73EyyYI=?nhp`Ke(Rmc*8^z*HY14OB&cWtK=q3x&(P!cfTx+ z)}|Bjf zahy=<^%d|*aO=SM!1gtF;2IG1t>-;Z9@^jHUyJB*Mg4Z`E=#CAn`6D8)8a^fY8FM& zK#0nhboH8>W(B1ft|9?}W5QN#*uL>`G|B__rY!1_Te;>U(>Z>I#04Vz)OEBYs_vr8 zSUPR^Ca@9_bW<~tFYC@Nwn)=9&qpd0a$$38U2WX69j(%C7Hfub&n;$D=% zUeLY%07=pHj^+XQOzC_vl+U#k>fGLF|FZunF`N+rjlc*(gIbYYXK$zYPV4F+B`?u1 zbW8E#qic6R*Ol<)a{_5kk-u%$ny-ls?G^_R8Ba@x3ta`pnsPcx-fNeRT1ur_@}q$m z`kKbHE&{)qt9Z0K!~GkVR#qF^XtvAVukO=Iq3A*AE?xlcV{R?ptPw8%K8BB+L3t@_ zdZr&S)5;=kq99hCdn(Q*JjD5 zyCg`&rKteG%-2D*sozIrpzG%@e1TPu9-#1c>nW2 z>d9zw?3QE7dQohfDWZ}*3kM%c`pi4vUuCDNmq-e=*m!pYr(c6otUUmFp3l+>@0S?z z)l_(g$LSd**bT<1FwV`hkSI;gc`G9P<{_gtxz__goz7dhO>E!GoBcROpC0zRZ57{f z<68Uz#(@lXOu^qla}zKWN;d&loPXwx1pDP#GqvgY-v8JBy^GMcl-_=Kr-%r)-H0Lu zyHl@IPPw@e(~NW-ER(ptC;q)m*VPjtFmHHAf9^QW>Vs$;y;w_(U>5l3B`*7e<( zJAe=Hb9El8&{gU3B7{W=>9SIl9o@>oaq;EU-ZthCZ8|J$?UjXDIDGDYTl4pte*zJ< z5c`QF_{O;V)n*Tf)|~Tz1D1f9C(4hM4wI0di8NSD(7w~j)HhK_W+1o=$(w!>_Q3pZ zgdZn_Vb@%g)qXiex`%6o}BM+OlK>K5z? z@Dz(~v@QI$1&a96HYMUeK5#an!1!h2?p{|USD}-1ZJgJ+g+4e#gR>x1+h&B~(I##5 zWs^nmdSzJZ$eKV=cavL<_^Mvb-gS|rbNAYRYnOAzA4<$dEfgI~$Ue)|O7dZpwAago zFBhhYT56%51K)mzTo`v7H1P%c=*C?0U*d-Sf6p->?5zI_eQU_XFLEONeW{ITlhr24 z;Jm4FN9^sF4oFaEu|y0=;BoRGxwp&?G5Y>eZ>P?YPd0+IQfQetsvUo7;=3^PS~kc! zY0bLO_&+VZTW4#?NxKl1j?`tl(ymTx=u@A+Qv6r`0bZVSJ(*)iZ-{lMsEXgD)n3Hbi^_KNfO{nhx@5V;TBua{HpDAXbl0zN+MU z7<6F!_wPWUE@RnvKmZ0Nqb9{V?he@M~FEAVu-b2kb zz_mx!H3~5e)eQMlOOjjgRw9vTH*LqvrD|#Bz~8AH4d~z&?T2a*Agt-O6u@17vev`H z`g~5KJt;)E>y2ZxL=ZNAH5|AMnB9eCJv`JV)P*IX{JN`|DG_Hy8{ixU%X=~D3>XU> zIC|^@B@`MMGw^5=q(YPe8I6{~;$&tA6uxc0DeVb;n*EfR3gEAGb#3`>L2;gG?W>-V z2)LmpYI-%k-HtWFtb#dmj4EGD*RiWZ1?GkTPug6VKfDCf7dm&8Dd!vG!O(z&Xod)+ zEV$g1M!WEbM5mM7#x78!IL>94sWJW^?R?LLslqdl|dq66hzQcOZAIL zh&*+PHUAm8;GNf+?#7DSPVEXAfI5Sh8eEKBK28CSW~SYw>v{aZBpIT<7X0K>h*)CU zW>xk3GQ8R5P>*L6Mh$i>GY@#OgtwimqU-(C%b)(@-5*ziU7rfsJ+#aS4qpjzsn=Pg zg-X7ZXTRw>CMO^#+bm*-hF`eQGVWkRJ*#qXch+#a9ySQGP^Y3U6bjOw4(WEeOr>&V=Bf|=)9D1#Jyq>yU z$B7279yMi}TX3eVSN(@*t2ib{+faDfj!KwYX{3>7J1f;F72I)Kd*^9Kc~z+i9=dpm zB8f?8;6VoR#d5Hs~b1yyiBqM(X8F4T>C=^zsN<+~VxC*+)dily4HQe_~y zO;cH(kjkBC#MoQluC2d*e?a{GKSbHD<-qR8R)PkE_p|`=i^AA z#_sxGvd6M{?Nkd!dQ33GE!Y{gSL(Gci}+!S9HTz|k(bw2V0|410J|5GBXtF&8=t1V zqK!|5a|%6hd?VGPLCt@B)6tpraoM>d!dIa|kI&EZ)%k`CH4^MK1z$iVMJ1#x%(vsd z(5L(Jp2=!ui{cK08`B^KVy}nxSA?BrPUzAxWR+(K#ZN0@boqC@e=vWrfCQ2uy&&F6 z)9!hg3N?S22s>5@z-X628{A&0l99rzSly_!WV62~z?wp-riFx0tPg#zw`}ydN(*n& z?{dB0REzRd!dQF(#?gEnQGOSlaOy5-m4s=igar{+OQl>;J>eCpE=b12h;jCx1;2W_ zri2)hX+flnl)Rvoq)E;U7$$X|F*^@~7!x-iT@TdGg~XZ!pj-{oFQfsU7^fG?WK{MM zd9yg1xIXYCs}&r3hNlS0cRWzG#PDexWG4P2jrV57J(8Gbu7XFLlZEB1h`0Am6=xZ4 z&DbYfSM0ZQU<;QOyP0wYqRYm!}&NcQB4G2Ty2zm||0% zaL_w0c1VB)nCp;7$U`8%v0~kknCzm#JRlE3sKmOV)pFd5xri^z@sbWAH;_0O3)x4O z`kd5-cGw(RL3Eg=2D6%^?v*ci*3=ts{!G|Nk_?<5r;5cCyy>vkAI~5&_ULVf%uwUJMteF7tI|%!jQe=k&)UR0QLy%7$u?+tx$Y2;LVQ(rxF6qmsGR+r(e2Wvpsfxm2N8x z8$~K`srucfdIJ_-$T3xppDqxo0@he=u9pe zQ%8fE=sBWj-&G`tg<{T}--#R2n^7`QZPU?!J!nrp6hU``Ha@#D*wLycFE5@0%~6dc z0EPQlA&U`u++5U3u>jsr$N&XPu}pC9$l-4j#?NVWjE7WWqPz=z3Z(U z<&zT%WP69D&(B?*jHJ{@4P8K2IRC57vXnpo=nnfKof^gxN!EaKp| zr0$lLGx5A8U9C#aM!%D!RiE^OA#24mjOPB}NAq~@I}VE&)HIsmP6CycZbjm4TVo%x-xI})zPxRMJe%n?#d!eTlMv3yzu+PIE53Y>B#o&~O0Mb1`)E1aded8E3J8kQa$c4fpu5*l325}VdaZd&7pktjt_-$=E` zNLQv3=CPSd>_)Q+JJPwIhYvxKlE6;tfR?`&WmLN&P_#eiE0AMCmFlbIVsi@v8QWVD z7=p+SN-(}KYQXWI`%!65Rws|Nb8HKR;kAc~i+L_Qr%c+M)Q+yucz&cAfC9W<=Qhe0 zb4b8L)m5Z8A}U6Qcd7z$wyqK5=(Jb6v+gEZa`wd<^LAp4(EFbTFAx?KA+1m8S;&v! zawuV9vSJUiqTP$yzweC-)JR_#$)RBgSb9f&C0VnW5L*Ew<9t&-Zps%m%hLKR)O(96Rnf?7Pr>sf{*a#FtT zfma?y`9QwfRtJ2lh0L4nK-)?a7tov^o0c2N(ub9$tIN5BSv3iYt!BI%*WHYGtee9? zWSxdtQR$lEI>n>M4T5E^V_sUNiC6N~#4t7;3e{<|j~&sB47ph!pqpjgD~S_s+=f(G zM@>#jz&6!k!x@D$x6c7}BlTdge5A(bNc9gg(xiM+G|^+zypdrdk;{*7d?MyZUn_lU zfONZ-VFK>tUy|X=$Ko&u1kzntp|vD93)DHy)0l`B_i;$Y#m9ftl3_)LVYcEBKpZ+3L=tX%g*N@h;8X@ONJ!_qnh>hbkUa)|fr;VD8*w=`&yA-g zJ&DTAiy2maef1lv`6@{^mKX`b42S_vDKcvwvA-|-Z||>0;x#o2JM=lZofu2L0i=Wo zlGo`ff;l^&QB&{BbyA>eFGwPjo4B1M{#oZlq>w%zR$i1500K;}=9-h>1~K@C%E2x) zIX#)p<{`)@gFGs9#%>B8i-c}#UvI-|GRShcR zgn-`5-m}dcQh4I1Fi%qVl~CGQo@N)3QzH3_1Gj*7K*=$v(REdcXeFg8NrsBkuuM>= zwaIYjwh;I31@XKt$vxjd;u(t@6MFSMq&y=}OJq#Bo6ubJ1x1AM83n%CM3M8;U)CLk zv4RMtFUvFyH^7m98{e;;cbi4IR<|<79OqR*)MqEvS#%_+C_m$HS-Lpb~}-2_Moxmjz-~48qf6e^5&~{LNUR-)xHW# zK}DoN&9oxFk4zh42^`I}^5~}@m47A(s;Q)orYgGGqo_= zCHZPx>@uws$Y5>TSp4i-+(i8Gv5yN$Tm>QI^BYYWv$XRn8;0mOrX9`L#JFxmv8nD( zggKQc-8D5e$I8zanu(@`)M2pw!Vp3Od_PE61Tmbc)zYbN8lqp7-Q=$$$bth}^e(;< zVD!+5zqUv;^IxGSB*Gg3*5${mKxpev(9Hlo(L=UaC+=r_bTnDEN(EAM3iYwIh9eWr z=K?*FuQd9;MPi_>bYsv28Orf!uMfEzcb7~MSz(C)htOtaeL_U#BpN@bqMb>$VBs1U4fS1AtXEfgrGxA#AKyrk5u+7S1Gj1y7X54 zi(nw;+rELPe z1<9#D2fL<|(Y{ZQ86n$grRt#vSm%BB$HfuU+)QRt+G29NlmpIVVPpep%R}#^%XcvU zter!AL4>r%D(FA?%nEK~y;2;YC;w*Ql^Iwkj9RCb8 zplmGvM~V(<_Wi42Me6>bQAO(;Kh-Xf)JhG0PAHa|E#zy`$`79^%>Pw0C0?qktbbE_ z+LJawY&S+jVdXR0x0{gdmCb>dM4D`gpLjZTIJ9(lc0n7RI>!9R%he6HB!rB1qDV|W ziK}Q%4P9@9A**AKp)Ge?_v`hMP3Q5EC5b$`KM24jHZEu;%-gjz<k zRay?`UfkcZ0fm<9u`%3)TVQr}C3CiU?PoO9Mfa(=VVuQqKPX{~ z1P-{(!;s3QpZn2x@!eRqXcLGN6EEx!I$9&f2#pns(=<@9;3B@mEeL5@T*CP{7Sc+> zpAE7f;z6j?8q|_bI@UV&1rD@~t z`(^U4Cum7pbGFE;p-DAIUnNM-#(%Sq;d&!5tCV(^9?{%J6 zsc=Kcw0o_;K_k(Na9(NJIEWxk zn{{IxgWddkKU5Fns3rs<5N^bD?mnAzWbU#RI(rPoMQShQ=*CkCmwbd@mFOxpn7`Ov zIb2#goRPBLB31G(d(gC&X&54*ZcV)Th_q0Ck@gDmav^d$~Aw>b(rx4RMkWH=i z7@elWMYVvgZdxa`zsRI3PqZY*zB9O0GR%X`YL~{P+DR)+MA2M_*7UhsgsiYh9ObxM zpm((LsBt^gg>ydV?$X6Ixd9eJmsCTA4?a)az5>3aT_T>hFUAmbBrD~Lj>5&K5VY(W z;@jiJ!l7vY`MM^QF?N9CW^3MS2ydAKybM9Fqzxx3rBy9aO0!4gSC?{Z+fkaagLtU_ z={4vcUc(VaidU>~O%5wC297|OdXiFgs|(J>3At-+9XgTSh1(qr z0jAR)Q*5l-OBPVv?7H)D?fgLHV#vYD`B}T$4Sj|hpg}^0MHW~V_9OjB|G+f)P4JdT z-@6>E{c(7eX~h3LKi5a?aWk`*sMvyK)pXOMyOD`di6_Bt`Zn|^sQIHmQGGcXI&xoo z2VT4^W@tZQivIbaDV`$7Y5JVFet*p@8$k-LX^e=S8AHHd^IZJ{iEv!&|6ihl^M3}8 zU`*`)uUFvr|4ke}G)~E#t>=9OxRXWZ>o;6^`HGzxq$EJ25<;K}siD`M{QvE-Kt-Mm8`Ww4j-F9R zS_9Pj_xMBVq^^h80IyrUcBp*U`)dmo`slS~HT* z=xmm+La?vm2pLDW>FA20=g1GF>v;e(PnM}$ZhB(w$Bw{=#3?MqutMaLK(K!MK09lF zEv~{cIUG;p6))hMlm%TOQdP+0Q8{MhZ^wHjgf6wf|J=$?XipIE+ z{>-v=JVxonr2LB66KcBG+lT}x&%DQS;C9tuS_^n3hB_*{ln96s{`BAZ9trAHXQ&l7=u(p*M8Q_FNvJLrx1dk}InYO#EGvP-v%`j%Mb4 zN(aHhZ5EATot4o_WZEh;j-36@d zQkS~Fg@)@4-lfv>SG)*-y4)2qsluJ8-XGKtDIjE2dNR%gHdfLl$KegTseov?R9Q3< zC$_D0A6-+f620Pdk`H#6`GShKYN7t(RRFYIG*mVCI9}EE;~P9C1ndOutmG@rJSh1*FSG2AGF?gmO9Zs1C+Ahm>0*j>B=Lqj_!% zf2$_;mgb_?{!SGTY|;)1yu=WL?zwx)(FObl--?IxD4j(utsPg61MwHUc~R0?ZDohR zCIX9Vh5&KZ8ix}f(&P$v+s_Xb%*nPCY$;Lz$%@R1}xI#7*jB|@WP z2%+kqr9x=65?jH$F!9(3qP_@2LGw~y&KJjQCkwFZg#sZ!weVF>u4OVN4E>p5c6syx z7{4~VCpHSZ5ZsHH$ie+BFM2*&SPC+kx?+RY?I__?TTKW z_S%>FMzWUWYgh4Tz`XSsB4P5V>jLHr(`@7;%hhyWyVSNw5#_fABKt##7)DSOTV@NF zL}!;>GO1PWCL&Wu@P&z!+BI+Gbc)hI%09*xSfGTx8Azqe z>1!k_03?PHxl5s|@QMtgUTd%+Sf>9*6Chhkfr0=Ytm1|00Bh6js>H7LN4XFr4)@cG zd>-BpnG@?*eZPM32Uoz0;h)6NAE<2E*;p_KLF=1mJBq)pv8GF(jlyzBFuiH`zhh!& z0vA?jwx2(r-r~Xz?nbD8X41~S&W{Z~iP@R{dvwu)pn@^8a&0x*y&;5O}}i-lTX2v$>>EIj4Eju2aXwf-I| zTX+tOQ+eBdJ}=k*Eb!hcH4}1O?d?39mL3-Z^ zR%-dlyae;8yQg7S0WnYqa8lb;YuoXTVgKsSl1Tc*Dmf*v7_R6yrn9G;`Q%&LxaoJQ zCP?wB060KbeS8E-T*~)` zoiHRy`;;V(eci84&Q0Gd?65-PiBU>ln_?PA7cnPhzxzfpW`0+{fh7WCEC^ff%sdjh5dEZ zJ39R=ymVjY39!VEcZ-hqX|T_zIOXeg#bXoJ&Z@5d>XWx`^nh^qS{xN3tR_;FX7Sx= z_Aw2^s5ws`!nVQ3r=OBfN7x0`hoaKR#F8rC&oIgM+k!<+&{lmpAZ|u>`3Eybp-7?D(x~vB_7|YuDwkxW~Qg9O(Ee( zQd7Ar6irJ|q(Fe+ANH|0*DW#!i^C=BHO-~vAMkV-zv|7R=(=~??G6*Z3(nIEgOYPL z(bQC}0D$|lI5n3;v)cyjyXTsqks>YftjkOdpmIyu#B0x{I9{ZHxmhPujDFJK!XSay=w=rtM8G6=4%LrlUB$-a|u0; zN>>>K*PBS&^fYt9o>2i1lE-#)FSgCk|L)#d+wG&e;Mt)*Qv%5&w`6$?j$gvI?}Y@_O!7JNIeR;C?{@j#iM{h0_t`v5rqetoqdvlPSiu*-^PW%u`WS zMrnv*@Zl7bmiDz1U>V7!&^}y%*z9JKuWdch?_7WUmmd&ve@VG8tO&DW3k4<%fvv4e zX8cgsp_A8b$?FbhHzBfVg8T?pm;yp5HbAl%PY? zbLvDwFFi}vN-lUO{wSU2vL3w9Ih2^Rb>=n-&=E+6KSTC*@Tv2tJcL(M5tp2zoAj=O z)|`w&oC+1(1>Z}oLh4f9Y5CkhCQBiSlkjUF1e+&A6Go#tfJya>3nI}Iqfk+!7yuDj z&w|hTD2H=V*Y0v6R)oevG}f2`=B^8>Pw^e=!ZTpW;!5+T5EHGQST3f=F2(u~YWVcZ zY0ywT#}ts%o(nRQqDLGVE06;BwXW_L7Zw9sM51%scN4g~Bs4&*u!hrNtEZ)bf@{^;jd48_FTr;(ItGmaj*+2*L2Zd25re8z-o(xXf-$)k-;4>t9Fxq!@I9m-&jcUkL! zhri71=bp)a7I*@|a;iaJ`Se9lO!pbi5%7i=E5fB&28}fHLf}n_ojEg@NtTu6N%(v>zZxT_%QP3Gj?%ejptso9bX7RU}uuESAoLc3i2GwPzA-w z@Pk4Jj_coD8JmzzM0V~O>u_^2wKT2+>9``|~MNyh`w z##*Z}g(#9tOU2b>{7(a_nEyDg7>^|FHOIEhWGfqeuPOoPRK&$(^PXG|9A||aDur-! zs(y%A!#foHaO7Ju&>b*~OC*7O%;e_%{H1|^QSC^Ksck|I2**PBlf69;k>p-+& zR(Zj>46n@s6sXp0L7a_fcd@+&)->uLGG@24!Jskf0uS+It@qi7iP)iP^zS}UiUR}j zmG6+@H85rXP;WOo=-6VTV37h{d&QIcs^0qiMNN)gGK}bZ9{#I1dFS)?4r7ORB#S)- zlU?Fm-dtr&O}WWwXXk~*sG*aSBF7sI>hB}!Z`jvZjkXWS=LtZUAL&Yo4P2{d$H?DD z+;tj(sXG^61R*PlOywe(4-7haUzR*gomPEW(Cv$MKq|&{@6~NNiCA9}OD_7jw>-6f zQMn5IqMq#WM}^D%ALLX~pPR67>+F=&QiBJ^>~2qyDg5!mM$4RC?QLDRAJ*kjTq(x~ zL0YISVNP#TQ9U-*X6x%}B1sfOBAdN(`8r*}lfM`UM4(@aMcJL!HynFo|<(f$lc&r*lmlKZ$77yQ%@ zgzOBz%0YqoLba|n(NB74sn;ut$+IcVIyMkORPooOOxuBe_+@Yu5F+V_pX}&gJeg}5 znLeD$Y|LCVHSen|=K(0wuox=(`a}4F`NdlGO0UCj#rSzDc7FEwdTk>2HNi^aV+d z8n%PjhyzsUl#Zn9{AT4KI$+iH%YNNkj(yN?SXnHokhW2W)dUe|Kvb$Z?;SxR!?JQF zGfN(TH95ve*(5)$$&jMg$FQ;AhX%HWJ&Z=dC^kBe2P2%0`*>-1q<57)EbLEhewvH*3uBMZc#^QFSw|& zJO|LX-A=Df1#Rh!n&pdnkI!52NTb{oF_i^gs^5$`n(v;|*G@~- zPg9dM+X}S=BA=8uoNwB7x+a}P`r+bEp#;eC-^H?0S^g80+NhUM0vmy38col6;NU!z zYR9M%who3S%}+?XN>GE!zo48gF7(kGCLN)`B8PJn=*k&X=QcBE~#~%{S9L?^4cD=vLw)7XWo1O*-gcHAx1mTmj+@KNZ0)mS^afw2%n&u#^`;*U@2 z7ksG%U!w#eV{}^?TDpHz#q}JJA0Ygl175Pf`%Mp{hD^ZrTSFiW32Of2k)pfbWGIJlCxE?v^l1Gn|0~JxG^~DEJ|QfT-kCR;lt%#c0hZ-DC^!xmpU%opI9;yeKv`5B6o7b=k_TpGDprr_ zno;Zc69$iff2$Rdga{BWQ$~D1OSgXk9>Z=+EIM8jD#x`q@Ak8(*YLH&9gg+QM&J}M z`GYS&AW9^iUH8U<8tQmy}0cpNr@mEG)66f=6U};!p zgy=osMi>gf_)MhmPt49cPRjh=nOC7AC_%7~V4T)t{)(fDp$7oGrTc%C1oRE3z!Z{^ zu`t~KQxl$~h2yzW`O>awbRT}xT=LVsc#Ot(mY2q_pAhuQD)9w0vy&6gfKoo_y(jKw>qtV(dsmkuDr z-WxySL>A&c*aL2<7Ot=V?tg#oBl&`vQiRgueJ4O4QMvX4C?^4-v(EvFt340}xTr|! zc~FeGEKoNJB=`Q8Qi`sar3leROCi}*RZJkWZ@v8xP*OEMXbslpTt=iv7W?=78)lyH~}9Y^WGas*9y{ zH-r)aGq)wbQ?@*VTfzxKu;EXJ_9h)8x_uCR94rLrE&gZ-?VC|XTV2w@#v8^2F+L|@ z6;bAIJ0IzNu;%R01Gu|k27oE1KtvnS9xZbpIy(B&w|lGrnfC__vd1<`TL$V4=v^xF zEVgz*eV+N|dyll1g%RQ#M=TqxN22#gU?X*DL5_ImbOH291?i&VD|%xU;cq0vt3O6Y zL^e9lcMuX-d073@ws80B0lIX`taFUwPiLan&Fo~ES_|{6D4Oq zu~f~-cLd;YmWH%RH+nisN0I@~cD=*sMOJtnNBHE^&p3Y5aI?6??bK>Yr}NfyuccA4 zpaCq+&CE-NoQ`}bjBq?(LnSzL_Xr02vum5xjlvy(U=6!pz|sAn+w!Ehb>v2RzqyY2 zV$%-GolJid4Z^N8mdJ6CKoy>&zr9*^GzszN(AMnD8kB?05}ix5p@o+o^PfQd$gv>Z zzRgJazD0N^S7n6kO>!VStr5jE*;6}df%}bdY(g-)l&N0|q=7Q3`t$`f2b4KG>zdu0 zEk6Q4z6Q*6Yb59(3!H$JcuN_05?qsqgR~~wh+Ckp5L8I}=AfIz(2iF0R~-Ymgi@-} zZ|J+3o{>!5c7W#}Zu$yy%KWR-#KWTO;|CrgNmKtVva~SxP*H8A1}f({ zm1AIHYk9PPaZ7gaA3T(8@pT0d11<4SDmFFfYwf~yX-^$+8%;MYl4)=p z{(%2`{eyT_hGaITL0LV)Yem|z#W$~m?IC^pY@1iv`SmQsqk<5g$rYBNuyPs=&xFGsP5KHr z(2FL*dZ&;g_s`JQxW+GgoY#|l=I!6A<}2)k8_VcCxf1>yy2Bq=v8%1sPIE#%Rc7H# zL1&=YreA^6{2pzm^V$0bv6Be z*g6O9OrU1X#qpKxuB-~XFB1OI=HeL4PHg8|CU_TN`4xmwDu z2mcXa)Eg~k16vGCjB&h_`4w=xu;#L@K_Btt8c>=F1>l&f>V|Ch-_&Wauw>{ZQBGFx zto+?lT%4+Dv}qVSjW#UD?6uu<6jMO^Wo+7I*Ac_*Cuj#JasuX8&#ce(<)CkV&NmwU!_dLX@sT_0JotbRZPUAyJ*@td*<15g%#y)i7K13sdICo>hSGbLwWWfJ??KD||=8y-x(C!?h6C?w7>`kq_;HqRB! z+B|ZHWqIMQsN!gfR-+u?Ic?vwk0i3^XfA6PoTg_xsJaEKWA5gf|KEVPpmTeU_Vzn1PXB=(!Pu)RPVMj7;j8_YR?$}M(M0j{P!JuCK{xG z;V)JD1XMfQ((QQ1X+`%5_xM==`{Aiqv%J?`qCmF2=X#R!@0uWh<4E?)>wbR(`yK+f z!?32Pz&?_zpcDGR`roH}J)-f$kdkOD5tb?wU{Vn3p$8BQ%q~CJU&}&gsb%o|Fi5{v zR74jr1N;C;Y3rUBLS-RvLCGNjOeJUoM5RDr6yQXx)K~~Qn$9vTqwq?@$>C&DcZ)hU zo)7H#f=N;(spp7*mu2Lkg5%Bs)e<^_P6m~k;MQ_j*87NZXaf5e?qM(BDR9FgE)7a7 z1fv85cX|Zx#I-EbU(U(Y;;6_@aobR11lf+;$HT*c zUlLRB5MtbRmf-W&!H3ReT#yH#r$}F>bK-Tg+)A1`!EI9jZX~KXW7#}}oCj?)F3o6k ze2~ut{$oACN3>HXrA7$eELW~FZp=3UXM}L|fCZFOrRpQRs8Ww|?(jnqT^*p6>sXXl zsurc_Ae!foKFMuS_Gq7qh;7wXj%Oz!SHy9;>(H5%l2_k{<2rnZ+J1`J&5I81K3ri5 zg$)lM_OD{VYaef^3VKhL$C`9clVcoE22oprX(eOIXV$QLGU0g*>xf@{=?RaH1#fG# zu<26RjH%7+POa^w_bDzwY@-=qxaD*`Hd)svCOFheH|hQ)rAkq>5O^J`ry8#TkDmx) z&Y__%d4`M-2*FeVWRNOHz%8CB?j|*F3_{M7+FE;bnKPkT7zBv){SHO&a0@_U)WeiQZ?Gb@(wnG?=OQ&62 zh5EkkIKV6m4Tm_u)_w1vP=m!mK#() zI%Tgo7|6!|=1Jf7Aazpz<7M;TIBa2n)Yr=bq%Ssp59#vxeMmXZ{T&|6>NE|_byP5P zJI%3WV;WsXeRGD?lr8(s9UbA1l{;EeWT(VUH`0?_WBx%j^V`HZg;`t|<$PczY;=w; znPo}o&+gdjxGFF&G~htm9q#l-`cE2&&MPWXF|2{md1>?>V5$Kf7pztD_g*q8b^MdFvrcn;Vc=|hOhU9kVFzU_5U;SVPQ)j zWCcM5Vf*o8{3j)nt0n7r_yb~j*MxFFa6x8W)&AV%&xWsa$Q_7~I@;=E*2Tdn9dY&}y`{dx z+sYUn3qD`?eRvsPt-EHg#N#2j4J1|jC@J2zA;a$hL&YNW}OE2 zk>OI#U$afC6YH{Ztg26W=ulD(ItZ#TjZT_~P7#Wx(~nwVuv8(GexBB9PSvIQix&DJ z!M|D5r)CBa{c1YyTo0faRjSuczpq=MWP{qm4DxzNv2XF}w;_<>Amjrgz||djV1J!= z875V*V$%qZ`sNCNr?vXwm_p|}YIpuPz3<#zIKSCmxq3Tzs6$;(r5L`G*&^P}lw~F;v&8CZk>aopPCd z->x8^_HLA&5&)sz(<_;-nV&>eJ1W*Nt_l%6zHwZJmeKg*$gS90UtYRaeFHji^VYr zHxdaDF=dqI471fHbHdM{9Q*uJ&*Rx$Jc1x~3gHpp(PxV-0Dr8tA2gSM+lTgIZngG-K=u2)^*M-mRNaz2Y#SH&w9+=KkA@QNfl;ZB%{5RVRss)&!70+<kRx9;PH4#qNV z6D`8PAvWQAc(|^?%4L(OAf}Oo)44K>1*~xSN!&%E|8!-snnP5#z*JWpN(O}HcwAbR zIeBZ`5QaX=ZORQYnG(zUg&!F*q2A(>arxfxx+_UTK7}wO+Jk$m3Y3$S+BbkwIv!u< z%i|JIxx8Ow2T;^5rMFjAW2_(Jd&ISdy%R)7bC{axM0`tW6;w^3LS9z%&wuazlQlY> z+A`XqLEYL(G-XW0^J3Unzz{H+CjUPtvU! zOT_C~3{hA6;z+jm?jJJ2y^0w4C+hn!9gm9_Y>s-ik1I9a>1#Sqc?>9|6F&*939IA; zo+?Ij{6{E3)XKu!WmFlBcMzXc+?-GDn&x-dUq5+<&o=g=W2LlqDX9QjhY@}Wr)v_B+MMo9n z^ntE)_cG^Iki7>oj6rl^vmhHsdwvsmHpM*;sZBn-uMhseqH5cMed8vzSGJ>D{+@40 z>$>H|+*r?M2d*j|O3eTo$jdG{b^3Tdzy_y8)2S&HwY4oa(X?`%+^Sc3_UHMmZ}vY; zt**wzC+}J64vX$^2Wc_r5O?nU=`r4Lo)}UN@MYv=ryL;p`L0>QbK|IIg^dlkEY@LN7EpGC}n_MMuy9bWI4If{%~i(byO$DT~d%EG8ZUY0gnnphOLR9 z=F1R>?Mf3kdx}wlRmXm$;_Qw+uU0StGlmnxRpCSh&2?4<%~hzha*UA$RmZM`GAhLE z1d!zhCy^Ca18Eet3_}DVKM4&q%bK>t#iV;EfO>>2^-M4kl)eP$XCBF0M%3ls)H zSBshvyYr%Fx-P>R?2yeOR#+LJX7>uL?iygSLI4J3iV_|j=v)MI$f5I!r4?q*o4Qqr zWv=)$JdmGUs5GY|6Tk^I2R@Lc3bEF~1+dI;3dB}7vT=cipl{8@fJuTHL>mLLSf=rk zHtIEl!}$s>ADTlb!kqMnJt+Z+k&~8)`jcgb*y9zFQ=s)BEJZ_y)nXf3B2=kyRui%< z9IOUbguY>&Coh(k%nOCXLJo-wQJ{w#KC?Xl&UAns=%~GIrHY1ACBJVr#}uV!4j{*T z87Q_vYw}hz;!9TxBA22;F=0xto|;KATA(3Q+Rm|;bE#$!eyj{4Ig)|~&hVMOZ0}J* zu3bwcqH*mGs-UaHG|Y{4uRa35e?!O+h%5 z%_8LjXHTC_UVo-xcrsIuzdKgg;p^#zlj+}=Jw(@SE+4^sct&H7zK*Z6RKTD3`LN>G z@#FI9hu85&*Vv-H6Gz5513JO*u8mFMrSxg(l!+ZF+!WUG_*%#otKc|Aa;(CpQ(f#ig$PpBZ|KbFf3XaC&w@2rU;mb)LbT z;)hjm3R-0;LI+K4+9Lgnv9ej|XM2S?ed*Gqn1@J8REEa!7oV zR9ytQtJi%nS120Tqr0rf_rNendYaZr12)LsXb+ZXK6!R*F8XxscTB2lTf{vs#%ehZ ze}Fu*`YqQpX1OfZx&Y=4itz9HOn;IaPWv~QHLH0f+-J;bnt!_aBgp!;gj!N2$*YhS zcwe?Bl0fh0m0Er}<&@u99Fq<^oZY&YLACb3VK@RC)koDz5NCo+WoHrB;ylaz?tc#m zvR#XJ19mS<{os8FuW$!*jD=s32h89ZCy)1ky$9EzX1NJ}7Xi8rhbsDE>x^&Y*C`s1 z+h&$4wQD3CT2W_0#w`4d1d*I8_WZ8<)WaKPuUHx`r-rsOLFvj8 ztJnY^fuDs19ETu%d^+&dQ0X#Ex3j|65i$Skr;& zK+r&0xR}xtxj?7^nz}z$QZ)bPdZZqpW=L5IcgzOw?#Av(%)?ykuKz& z3jZ#~MOC6440=r%Dcrpn`1U-#q)6?{iLcfsvz?lH8tv(sK-Sz^ovMvP;HEv;=f%TJ zGj*_R^DP`*|3xHp>W)jdTBzT#eB*uf^)&XR6~;E~ziw9p8XA}?}O@H6tH8YI2n^>cdlk7+y6~x_(T%`&SS|ysL zs2{r#i@ekU0*RVEa;#;hY`V@)+8yL(zf_XnOzhT{jsw-+%~Kh}^U^Hke#NEt-psD} zb#%dUu2nnvnKxKXp<;m9ylDwUQU9D^6&F$P@Lf?AgG(p(qwD6-j-se$8LB&p68BNs zr8nq%D*H3bn2Mi0BX6KxhswcV3(QmP?S>_Gp#YQt0!O=g{uD2h3yu37GM|)=eEz1vGdmxRI9#-fYQLO%lM@f9 z8k*kc!#$IjPGbt*KdK2LSE6)#jkua0zgYRIrr?;lb_{Lgi^J(wQjwPI-k`K0En9H> znY5_~5S7A2XP|x2IOFj%YS^A4TNw_KCfLeul~GX1Aq1&zdxx8B+M)UO z1nx?AvYt6<>PtX^+R^j{D+U5Hjo*2C889sb2CcuuLX#wl+81wiGc~NlD9}IgYt8I^ zQ%T%d$I2^u^}=_`!%3=QQLX|&N&=|>0woT&uXhVpp}_e?_q zpy9;L*x;JRhomzChe3@O-1zH}G8QdWSy)=!^wn9WK(dv)XTSDhII!tgy#!?%scCOv zPvO97kCDWI)+63hxCOEKy@Ycvw$W)fUuu6rU&S&_e5-w{W^#suaNsSfCJpo@{=9#V zDL`X|1fBVqdW7-*u!SWc8^JZq?2APq+r4Bh@-_iPzq zh}&%X-KzFkzQQR0r(z^$vJn)WMOSICDg?&D3B@?ZRi_CD9jPU%hAOE80sNSX5AU8V zRTVn5VSfO#{!ZLn`qTw)*e>DTgl@;x{88SQ?g+~F#0vr`QW2tfCvaj&7?wl}kcu=2 zmsG`%-U1ArrZ&{DOhzX!RZ91_2!#0$&``2Yo4GTzvZ@}DhS0ewWK;02UlKVrwa&8+ zWU7JBQXyw%-F~*#+b^m@^ceP5|u&EfKp^{b*yK_`A!e%(P+rtP|KzoBP36i z)5Nry)s;srq+;V%xaW<;POQK-V9v&p%y?LHUHj=ya!cDC!=7O~PNtpDp?&gUG|~dP zTQ42%bBgi^t9}+VnU{s0bl_^yYR`Xo%IW)g>Z~te#jqCO>~*~p_e!XR33==E{9<@8 zH_U&_S4&=Jc#Y*9hT4Idk`cA<9Txtu9ANf=;d3j3)E0edWh^;Im01@;z>Cw>w}h3zzfkz(-`~ zb^!wY%P-j@AKqTwhLZ~uK}bFQMUc6cYf zD@}v6^6rZbixsKB-q>_MwbMqh*f7ys5Z=cRJS+E^ZKtL?mse zrG-Sp!}aQM22-&fD)BYjEWg!Kj(rD7=Cz@9p4|-!sMNroeS7P&dn($F5BcKoo}<;P zSaZDVPQl9og-_`57FCD!yoDYjx|qCGW$5l(d?Yzs+X*jKXke?jMG>8Z-1&$_)C-3_ zWL3(dI0mGdONpq|4Rs|}1SfPZE&W0>OWMTxT%gSVqBI|^qP|0!E%Q=JQfd=g`mt=O z7@=Z$tnZKh#_d9R2Ut-j+yo(3S~vlTd21XBPs zH>(w?7QiDk(knGRrI4W1%r6+VXo(p7-%qci`o_e8RtTt&B8BmXvP0)^0Z({@HNV6D zU^tGe?*$IXberj_p+^jFKd_uCU>!tTkCHtC%2502afh|lBFyqkW3zh|1nBvl90ugZ zSWZn4BDpR@GqUO2x%$Qv19KK1;jk~kfHQ{u0?p52L~w`~DpZy#A|%kX+R?3Yx0dPT zCeLg7@X05s4*KepULtYHFIz4QvrH^5S+@8e>G*@PKAp+f-v@!Lnb@wM7LB-Y?Tk_Y zZ)0O!+t75ta3(hcxE+#_5c%|FG~#G5_(IsxP+QjMlDX3`Rm!L&I2$`cX~tRIbzvg8 zpf%ILWzEAl$~?JlJ{9tgv#zE*=-tMc85q3Le6~zOPiQefTEWP!YR}Zm9XG083R$UX z!q(VE0B=vv2i)8+#ry&D5CYDy`PeTlE-^z<8 z8$kmbUN`fzTimsLCZ>#v( zO#hQaR^$e5)Vtoq4qg659;%NpdrK~fJdu%Q7Qf8*?FdQSLbN(hj?(?YeL4w%`w6^C zwJL6)vFG3UK`vUQ*sc*3qr( zMuo}KGg<^45dJmbfG4&J)$hYHDbHSW58a!+>0eO33|jHw0^wd4Sm(lw%v<&_AJ*qs ziUR;~)>-APptU8J6Hcr8y%ctA!LM#2AD(`>t-u=rfiKr`p&wUgRQR9;XcsF?0vDnk z)lv}Pvss+*EEzn|B>4$R&-mRAtz6BnOmnV1JDzsDzP@G3>+TpQr7Xe?mf$`iO{1@O z4s}?kei;F?=!1?}YP#+{=N{kxJ0X{te?R`ifS1}d(81k^XhH;P$sj9`)d)wR6K}rr zX#UzaFMB0VY`k4Yh_BmK&UMfuy)6I9`yZliW>y15_tF3m6aKi`OSw`gD_VAlUUiRk|| zfdR~F{$B%m4dcmWU5L%#?nYR;E_xi>=caBZw9Gc`i6WZclV$yV!|5cG@m$u*k3F-XoWFi1hwuB%h-p{U}2CzCv8>kh<)d@7Q<2LKASoth|6=5 zz7-};0~0u0sp)eM(*^-61`7Tu{iB!Z#~(Rbp}`Z5%p`K3uoCDDmW>6^fIl(0lEuR{ zcU~SLv{#*XL7B}@U6{0q4KC8ya~?E6&ne7R1qHaT&l?H|E*}9846zsOGJ4wVvb1du z_aJ~^@g_+1C-9|=2@_`D?L@gsZ?ewCq*eA=Dbkk4d+jb6$W*}bgN0v(zDA#53Honx z*D);mqhu3x5;rm1u5q3zT%9XjWtp3EVN0MF+Qy>HKMi|m))ARp8hNC(8SY>0xA<|P zQCuy`XzovNt`)`mFLY9etaiOIfUM}B;d&JNv#;A=k9y)?R3Uv7QEOeO zwfgaT8D1##_vav_^@eR7b?0UhqKNL+(g4B|T7rkVuxx;0bN5PpGvY(`eCZqxj2p}(q& z%HUG@<=R!Fr_dIACV4O)6!MXH*t*Ldv2#I*SE7y3_bV!f9chqkD|>9L*k}h=prttR zW{`_BEf}yj?-6}39k3b8!G-Y_w?Ed0A8N2C{7Gc>ob7DcZL4T1DF}}dPI8E}+yt*M zQ^{LYMP4Vzh%?ENGH*^xu?zMQaR7=P?eXnfAxDW->2?wldJajtl9eYh9b1qZX7Pe< z1+B)z?@c-bs#ap#-Z4j`@;Arp3Y21FUx&N>JjkYH*qd5Xj63sg4l_>sDWf1Dh0E=g zY{h7$@_Yz;8>tDR2}92p+yLbt`+Quyd)Me%KQ}|)%CB5USCuM}3gbH5K@WT@mg3{% z)!nDdO4qN!g*DHr+obMz#^@fky?S*QFw&BnJt{>B^>n0SU^HOn|A-txnSScF9ywez-Jw zQNi~V9^ObV78q?Y^kP-jk&~#{oL^J@qK5F^3jA!Bu`3#Q=afnNl0%pLq`zo_2dE0} zj+P{XkZ$h3(|6R5qMjv?m&juH6k%1#rvyPDZ&FydURbxLOkb2Z0?yD-v+BT}+MRKJ z^-qxQCUh)23F^S)rg}YR^WE+Gd3h-wDGKAz!HD<>9ol2Py|amH0K!{Bk^bj5uD6odXV1AHw9L+oY80>- z(S|0v*1yn_gC_}g?`;?RhKE zZpf~7DqFiBvh=%`BVH-r+Ue3OwDt^_BdGoU$AfM2O1E!^BX2m6hFVO?3|Np_Mk+go zl_xuRlr4ogW|Yn_-i>k(raHW5%g`;H2hla|rvm^TCFY;_Tu9i#_B%6nc;|;X$apmT z#{VLZ9%LU?P-mDMK`%I|^vz!wR6db>J!=tGdvZa@U&H0}oUexJLg)VxaJ~;z^D5Ke z{LL5+j03|H8i2+LT>9gS4`AgI*TtKw&JZpNgo#_x#z04jff_8&6KBNXCMt05DwFS8 zufg1Z=*DC4gY7;fTkMb@x;S*6)q{=8r>zm2s8W|m%4T}hp*4?u+h+ksf%6)s4adTD z-kvxh+mx{vso(G2NdljT+N=AHVFzMaJFFbyiZH$LvW5*qpMh%)07U%Dc5v<5vrWXwy&cuHoQgEpv+U){3&J1!2hV_I{->8C$m+%|T>0{5_!cMG zvui+6XM8d*y00kG>YO(F;dba^O|!AR4&*t7t>F;q*q8{RrNoueU$JL$kO~DU#7SB^ z!KeSOOrnQQ8z6*C3@}0fk-I?{oD?a>nS>L>>LrNn5U&Q)BV!1|(}ZsVLr?Pi5q81n zAD{`6A*EeJb0Gga*9nJ}VSz07*IMc;9U(LU@*^Ej{+n_|JGTa*#>wV)&Y;H)9$dgR zdGMg6v64!47#gk`o+bD#Lf$D-IMp#CKF97vP*dG1B=}Q80h3*$?f0H5S#Z}!)@_fk zYUp+#AcI&FE(ms~;+eZa!{`zoW(;8?hZdMl77f)ER&%Y5g}naF!phCjOf>l2vb_Iz zbGR<^Ea8{;SE2g!v-RC8aXU*n&gr7&52X9tWfo~-KFPq@u0Ge%3KW%7y5tDkt&zM0 z1-DRh94XxA~ifmPiI1py&fJBEb5Sv$(HDkG|%qg0mTsc`3EAO*|0 zT@IDv^3f9z#KjTd$xyq?bBay5xWo!~PCf}MtGBxLe{2P?h$@ZqGVqL@s&Vy&f~$~# zxe(Iz%=oiJVhuLZj>;06{3eK?B=v@V2nT^+klaz=0OhCwbM}Zl6|hD22*bNz8llt! zu?PrE3w^(Ib=?_UOYY2Nc#@DWhiGxMc=|HWiaq332Jd&X`8wDF{t zhPOb)F%=$SC=1mC!*6SOG8K4;@E;N{jg3`~R!AMj8+-&^Qs0W|)_HTG3-}ov$-~ut z<(S-amGNktW>JdAq;``64d82jadsgrds4Z}COsWz7-VV63R zK43&sUUM82=nCLb{>$a*dlkIA;awAf%Qa`~p{89~S3yx~Q9B3+c_umR?UhO16Zee* zcy(B+TV~y|_}9pw*Qxc5f>oJ(W$8Vu>=y%B&~gj&9wi}tnE|URn;*iffCm@mw@4-Z zhaXH_vK@(Ouxc zoVOnde2WvIKWlGDN?;;O2Jbn)bF$kT;1I&8uFIZ2rVUp0!lFFMu``gYK2-_a*DX?fR`FKZ|6bLXh~k&|O%_)bo&r8Usa_tsh5AXcu=H_O__+ zECivL^^*}!PvBJYR=eCHtwX=j9_hybh@jJf_a4cxRr}l@pU;)j>y(? z^t{E+9K)jU6ok&%n#iW!JCC9DOq(IFKV8O{{RQjGnCxN%TDQZZn9Nz(*B}_5M4znT z>{~sd=KT`+H2omQi(}|MVAhY zo<2}?$|+)r%kd=#@Yj&Le^!z)A1Em?5AXiW@J9!GF&V=D2Yutrmobuu8#-vzhv)0& zPk*nNhq-N7lG(E{<@@6O^*$*M;If{@_37i~4i#SsVG>EBByeQK3N0r_h!29EBPx5< zL69sIbWSV6NUdo^<<(WLkEFXNPjtG8@qTi;BqO0zQ8{XraxK!Z%`_M5pN|?PnZ26c=pyDQQm z?^{;tw@s*D>?0wNNwmrps?M!<3qb_D@Hf0;PVtyN1q5PZ` z#dJztj(MIO2V(W9g}Xy85nImkD0J{O^in)e5kCGvrb;C6f*gFnmdP*~kcPIuc;iG* z@@F?*b~hihr+1Jf0HiOKE|Po}SOeI7!`!%Dyzx-lPHVl5p@phi<*W5)I}s}9d{hCN zYhwWPpsyViXGc?Iqr6%GrEz^BLidBoffU@+OGj{NZYuEn((kuMt6X{a5a5F~HpB9n z`-of6FrMofKFsIgY;W$4-r67x^JVY;#T-n&xBr8(2&}jPU_g}5F=q|xG(S7`-OO23 zniO6}Qi$nlt#*0ed3@&(S}biz+-G0BI+m3qUWv~^UhFO%s|cq~G>s))$=2QF&Q;ynnl%y`@{AaC8eA{(JHi z4p`{k)z{Ml^l|DBd%1ht6D#cDK0y}xoU|`7&)*bMs64(c56cD`P9zc?4tM|oA!07< zw?MyH%k!m_2%8emmXNnH=~UOhfC%j0zF;_zIS#X4u-A7E;z!_6jf^TM<5qQM5XX)= zTPbaXMcc<{nJ02RDlPo>=PMjPZ)n)Xz+#>Rzy3BZ5(5BdkkX~Ud!e+q)JC!HZ?&wDG;i_ z&z>|rc?|KUMeWuCp+?2lJmK>YNGN*}j6s1^9XfFBnSvwn2qYj;Gr|!i6#NY7FK?9_ zg(XJ;&Ii%>|11iq#zAEuoaWJ5p^|-!Wv>#eii$Uk4%AGBb&t2R62><(vrr%>qK*G> zcV|f~Z?>(cls?-o^LRa!Y0=n{gN=F>o6`SCWxx-d_qe!(px;3y9SW%OK@FNPkUG=? z(p;+lA;HXw9>p+Gr5P@Xg}M^a3aJg#C>22g_$wvbirFQddAW|Blk`K@)c*a2ZcN9! zP6vNBZ`}Gzr>cnOYQvx`nNnfKZ^XGqB7HIb-~jD&5_bp%_O#=Ll2p*QW&X+)#W(Lw z?y4PC;|dl9@Bb&RxWQ*dV&L>*2BJvNlsH}c>Hte}at%Zu&$KxG&?8fZf*!`)jO=$g zKuvf1hD8}gvYn5DLiL>nA+f!rit0Rx>oW8L{Uc6RkT z1I#K0=?ceS22>-D5t!_ zk$9I9m#Nct7tdjZ$s$;ZJ@#>F&MtatzYl4&-#vEr@(M78EPmHue`VD%wrd^I4Zaez z012BL#w>cuP?|Ep3&eU9z5WE)YK*qCey1Gb(LSnghRFH5qQ7vPe~5$dpsDBp96M2S zao8O@%Rdi_hD(?TG6`0#hvEkilcZ^8r@f6+hX$Wz4gUN>98tZ1H2(!f4xE}cgv5gR z*%fVvQJum&om||d7`_PCxMOktWx86n;P14j0RDJk#=2dC`;Wy`yi`GcBb%n0h9MM2 z9$493JjE4zM4fuEjRrO>Y${>~5R;`@IBcxSq&vST^w+Cb2h|=Sm9J_=b2OUa?FD#8 z%}2PHnB3Q4&Qu;h>5hNVAK9BO^lV zVZKr(5x9|dV6^2;gkMjZl94$&NDji(v|n{kxZS%f0HIrP<{H&B5cWcpXH5KN$wu^z zpm>UvxuO4^`S<>kC2tQEwW^21;O~vy*OB9p#pXwP zX$vqVC^I|vfB8#FwJsbtrI5b!`azr%Z8QfJ?Fzcyg;1BKsY}okDpYidL18af5FL6$ z7W%&|Jl4i2DC`#*FKsP6^7^$+*)`y+@AfZ0k7n>XawX=^UgP#M=y2Q2u^qM?-F&BS z^~#yG+4`*N>H*mwrU;u?D5YE1K;pPZP+8M#uQu9qHbMZ>duLIUBd+FUe#!I}y>dz~ zT?I(a(h&arU(;mgkVQIe_K$puEOM)4<+^{{N<+7#m<7(_%0qvr znYrMzxR5C`Sd&QR$?B9Tr;t3vQP6gdN=d8-JNW3#k(aXK%#kGZR$HCO&d${b1@2ng z`t3ZlbmIbgPpy)zZ(o<(*8BT%{fFEQ+wFC;Km7cGMd(l2rhgo~Ucl2=$Bzc>`id9v zW$iq1!$4Rz+nUo~cb_k%G9=Tmsd#(v5Nr9eWVJlt`S<8)@b!-1oMOfQfnJ@n2VXWWs(c9@1=0BGyS%aB_8Wievu-0m1RvFGi zR{!{`PuwablAPKEX@ZM}4w$q<_`pH-mf(7iMX=$S)>O+nobRy4vLlu^L{9D;D)~%% z)KO8z!m#%(@D@k5LwxP4lG_DwFRs^rQzeaGD0wz~G+@NTaKf6hgVF`u>m_l|?>z8E zt%U*#5dB^3?Gqh5`1eyr# zT>;y^(99%@_=9-{jk8B&OY*z#%A(XuhJ$h9oe zwZ6!~I(uVgeF&&oqf_OTc%B*P)b9pc|E473Wzn6P41T&hJ_ZWXUVCfLK#_=JWiUXh zf7KY;d`tpaeeE!LG@jnF7|F)0R-}S3#n$hb548tb36Zayxd3I`feu5NB4llpvMv3I zQSM2DWNE`o$E4Xapw1PefzmQkGY4IBi?!R!kNxHo-{fA_*_iNcBHz#9jQUw+Sx0HF zoiOD-odigfOyu0ggsWL>qS($8XEOjx6G=RTLcSl{q%Q4`x2H$!qRm)0*R<8UWgUxJ zHe*{-dM8n%q9*rP;buB?tcb=U_zd4k&KW>IL{$5U za!HdP6LiDq0`<9akErSo)t)1!f3T*TX4IRg<10o5X_f5U9dQ6@B&RQ9d4P)SuK}uU zokbK8Z6g~+n3NJ#XF8~FyGiHZ8w5Io=-?x8b8mXXiH9=j5^ad61iuD}uhIlV@sPz_ zO!81|I!wT%aX^EsOwE1p3km?4b!sJpXac4`=P~pzBxSEM@!Y2~6WNUzIjet>1)z~D zD)q9`M3$Oi0f(|Vy zW5)HWTU}iuBT}J3TB)lJ6nzVyl;(Ls5+BvSTnmS0mM>vHRrQw26L$c^u|XmYvbR(- z8-;gKTK;)-seRVNumKw42!<72Hs?a)Q=_IXqg{JRlzAg z#D|Km!(Qqj&;pD}ymjj<&LH@U&k8bju`Wuz8Wa-bP!`ijT#8evO@!**mrW=B3)0Ab5l(B8fRXCxr|ZV|_T19Y@Q#Y5m}>b{TvN#8S>2hX;-)_n z_d6lX6peJ?O27&8kOdwQS}2o2zWZ?MjYQIu?-8qCfYM6)Ct#T$f?9T~f$0}`pT z^&?%xCl$W@EV)wXxotS0Ik*#9aS+1y_>Q${r<=brKKe3zJ91`gmgNtL+Auo*4X=lr8OzPEa zX0aC~jZBFT>h~aCXT9ZROPqfp6Z!mvJ%oO1GTuX!1Fmd)#OeJM^il4z8!sOJo`9&m zycuIgPxhk{UO&(Q0Ek9>@p=Pfw3LQ@-m55mf#MDs6srodX{$4k2^Pecuoo8hYXtd+ zsX0eaxnMU@mVM}wlLOL5+#OaU{C=0ofkgxIsDuGQ>?~0Xx!Pv1oo;2qM;j8@$hk7| zz9}sXIcyCZ`oHh$U3KQQhtV9DQL#b`afhB5fuw_x$4HR@xS}(&NfEnFbLtw=u?W#$ z?}%J*2P@&X52~2Ze7#z(;K&$rs=SWoVLE7uwgz@i=|DmwgChyD#F}DN2n=LikeDcL zM2)zh==W9IIX0ZxRSqvn6XxMLW!D5}MjENO8aIwXBkSRvh`X$er+%1MV$Ef_RWb_Q zsRMYsJpN#SrV$jD`oAjWfxKm|jTjY99L?77R~mOc^bzg4w)_M7E*e(vY}wZk95@C} zJ-2xR=4E-8sFd-9z%8fjXeX_M(;iHu#WofJ&l7#D`JC>dj(bt$oGc=XZ*Kad zD530Q-~gXWKX~5^65up*bz0mOn%K*DZa>EAF5ZsSe@1Sy!#qGCS!lI>S_R7x(s1Z~M@h8o zXl4q4KO4HYPcnz$QBT77gRP0!ieaQ@gOmJc0VevXxMuLx-sx;9$sO|-RV6z*H4~^* zRraK^0|F*CB}ViU)kL`BZMK_c{ciG&*I<#jUKBinv}!CG4Fs4C#*$|+8Q*TK0~w1# znK@Vm?#qahw`|ldwAz!9@OMk6)z!aIbv60{LR}#>y*o^Fc#2WD9SyRAlG|448&}ga z%JzBD@0NlsX!oy8mzlqg?Pt|>jabhj-;YMm2Vx;o9T;Af8**1O{#0YQ)F~@M>}WNN zI^@KS&i?LTwrYOBDvKSE!~Jq<+kOTS3{7%-Mx4)bh;PMPLZW7krj-aR9^Hwe{afDjpeQS3UK8-*9xw0d_ZbAIXr+RaZ115qJn_>c|g zKIgO|3ZIP#qhpA#K$AE;w(i-I89$pr!k;tlhq7{2F>R#teY$q+IR5N+n~QS;TeI`4 zG2;VLq;u*yJ$(U~GWo2L6WBVLsEHJCX$KjosJDCX7k^Z2ZwI&aV*04d)8x=IAti*; zRhU=@Ki(F28ZLphNp!16s*jCm%9!UX|J~x?+t0f6VE<*{uRTQDy;E!ILS2&9;p?Qj?J?P1 zcaTNCp@hQ7*+pDLipT)ovdX|G-*tBF+hIQ)9YEM*+xhwbHPn3iBeF;t`xC8X1=Y~d ztt;gmM`*cP+~Q{WA5lTUW%SELo^ugFgVa_{pov5XH%N3s0}is9~0QJQx!#ucC0wBYC*Eo4>=dR!ify*ZN)A>1e52`9TzR8$5@ zZK2*dmaSjR0du2cdR_yFSg~lNP$|smLK-$XU@Wtl9pgx+fZ|cn4owHP2rr^ip>Qot0YbCEm`?*c1 zNc%2|$&)PR)IM~E3&F(?xeLl(TCo{OmD1WM#lsxO#7sjkO$`DR=}fPlmh)k{JVxAq zVYNH1Rxod5?k%WiW1c}?j9j7=9$~LlOqdW~w{xjl{NvKpAR<-|`!W2cOJ337tEJ6v z`ag?||HREh;8%T4VmNiCd$X$4tYoCsiR4{RNsu&-#EDb`sT!)}W`J&rvJxrgQb|{A zns$Nk0~p;5=R5%L@B9A_kk&7u&anAI7gsVD>J_~Gj8_sI=ykLe*|jax;Lvn~zekVx za(7Fk{|8&=*qsTqX4}|y#kTEKY}>Z&ys>Q?Rk3Z`wr#U=(|s{|jC(%rKd|xawdTCA z_V+d{?K@)JxJFGvp9H35vIDQov!Z?sR=`YBG{Y}&zawN7H((q-iAbA%RX1_&aRqYFd@0C^}HxwNC}o9zP$U}5cb zc=feiYqxdgZPW3~3QW^i6}@Ufe0X0qmv_UT61DES?WLB}z11d2nq z26!_yG5WZjiFc12Zl=fm2Z`;-qmV- zkCjqD|EGuI3Jdrrtx`w!Jvc=I76Ov?2EZE?!b;NBRgdvNzq3oRw@PgF7jZ|Vo*UZX zG>WyU$M6I1Vw`8dM6x%x=dQF@e*l|bnM;=eQ;6iGw(WYyU*x__wtqW z{I|p`v61%7$hX*THKBPK<)lulDD3s|uyC@mVJCU$Md%p1Ts?*&VRoZs{8qQyF2_RZb+rH6q%@8b#Sf*+u(~K|t8f zv1{Y$CCIUVy-&vrYdRg;xDmi54D4+}j@SVf+&_Ar{BmA~TMSq8xEDs_-XC0doOLOn ziu`cfrb%x<9vT4xt<I|#{;8NFS%?WfT}M^I;T~{xXR?3i;%`>`kA#LoCMI^5H zH0#}7{f!KTUe!6p%G1RK31A;#{7As3+Q2K!+~g^e5pUu&414m9mUelfn$oKM1xlmYd&Yy@=La*Ud+>d2qSM z1A}jT>tyqDxvTB$f0$7x}rt|S$>rPEa=zT4lztK^OOf9EL@0b;c;2U+a z_z1j``qGfgLHc8P5j&Zggl;^@80j@2#G-|1;s$jMWMCCY0mVJiV-@0u#l9XsW58|^ z9IZwn0W{AHV)z_`lU+75C0t#MMw-xvqG>+MZJ6SfM?)b;f`S z22Nf^z)$23iH%j$@(p4>YL?5wS~OmcVJF;w0lM-U>sf%c6g6W&=urFm;Q`-_^}_0 zF+fUY1J1}7iUq2?f6dx+6hq8Rg!Zc1vG=6UTwTU>WGS1BA)GojphR|qV|dx7B{k=( ztqV4TuB{*BhsQL8V(TM2rR+aE7lsV*6_Wa%Zm$8(Q3@}NV z-IS9y{_8`kLTso@J&~==Aq+o_V`ntsWG@WlUC*x8Hjg#!-iDp6wvvreFY6x~Fhffl zRLRBCL=oVJJz`s`tJcn2@NSy6XnugFyirFz!ax-hS50c0n|k|d(Zku3^%L^MTxocl z0<t||s*o_1VW9-x$k<>P|fQa6}Oe;H` zzHrqq@ok?=-ZY{Lc8d1dkSaBCv($^uLV#4RO_LHo<~{Ze0y}_8bz=`XL7 zd~F^({BwLZygRx4ntFS!{p7z96!x|{1oV)Wuwd05DlV7$(8+kGmR<17XKf6xn(oWn zA#qejZ>;b@D0TAJ`U$RVUvEu%=Xv8JIezHzalISv%j|ZHd%qys34{pm9)K+re-|r0 z_(35Cal#qoJl%K!@@z)Ucx|V=2yM~4dzE3Bx$AR{Yja76i%d7*P#dbaM0qh(@%FnVO}ICfHv*ov}zv%Z-*OF;h` z>^?pCi!Z7n`uhqKp1tNpqzB2N1|TBG(WfCaqf@KLkBW>ymJ=&*qbb^Wr~4=QIgVW4 z&f?$T07XEXcRZQpqasS6I(qmVR~jWxS3p)!c)2-}=PUCncKj~~;6*00{kCa69fd|h zYBAW)^hJn_BFg8!1@-k>AWC4{ z7b-Bf1SSPj0{SF=iotaWP4=VH0ib$%>6&to3b~^L)*{l?#nRzPZme>ToR{fR1-a49 z*022euLzY>!h<++dOPsu^)l@7GXiOwH=3LUTex{q-`(DFj^O;llw~n1>7mhgI;x5% z%4f%OW&lT_G{$ZxI(HF6+qbPGfX~ZESh30Ln~V+;XYh|@%98gM9NhQkBjAoCV|th$ zvldC_C>{Y!fr=qDG@`7F#>d=u^}O7+n)zNp2B`bQZ}z2`^Zr=!L`eRcHoi`|L^}ru zS+ACXIk))3_njf?DN_6@a`vqq6vv0kC{*k4fG)hwC04Y9sY4rII)`1%Chj$*X)Rcs z72IPQYhGEM6fZ^Dom_ZF63{myncjXo;xW9)^RW%g%kt0%)QTDEcw+5tSiH*~lmK%~ z5v^d)D1^*Z=(y%D(8de~wflfXx@q=X$?=rc0c+#=H(^nu;TQc@5d7;AC3`41DC`V# zmo>bMscw}%I3p9$k1M#HQu1DIryyi^}b5DFblx{{6`f zZ_bADKOQ>ESV$%=g)y<>_T+q=lP+Li#ivt6feeC*8!K)?&un066_X59vJ2% zvu-k7Xxfefg{74{u|Fs`;s|IFC)tcxw604CXF01r@O$mRwO}vk`U+28*31x9 z+vqx^<1Vfb& zNWe`q-3%=1oZwGpUAE5V+9xuyMwzHO9kk!AcH^j63Q;ao4|R|d#1sQ!?ZC}bpL_^) zBy|h@ftKUY4F5)jMSWQ-VUwnQL+UNpyZC{cigVWM12TS3r9gv~%NWb!HR4iV6Ju}a zw(3DB1hQjal&M6pRC&R}Y9u{S!L~4+fiRcfjftyUr;aD^oK;FqHf&QKqgmzbMHcE^&{>i`%v|F0=WxcqR1u`K*NQy{uQM0 zU%;1jkg;xg>XFsu#fN|V8=u;lp_>MbJvQch4EX3V(+j&8uyf~FDW7TLcCMbn0Z zQcDBNnqh!I4qb(86b3jk9QnpWM zXxdBTRy#n0mJ}$gngCG`q+$irS0Q=l-^@R|6FF?ey}*Lyr<^|l-T$;xstH*5{Ba5W zzt%Mb({u$}z8`vv+DYKBE!>tyls|%iXwo>=)xX+3UJ>OT_*>ElUws~) zVyd9}NknV@gq@K7tIItPQWv1LWczp3*TR{$-WGFfcq@&S(ITQ5`t&x^W#RK9XYVIm zRz~;SN6wZVMG(e9!nM5YR4G7ylbW=$B4|M7hT@sfw5d^jurA>4t8t>3qT8o_&TK%QG@4v) zm*7nA`=;w9smy4irZ6zcX>46d8>PgWy)!n0f1uLgB3bK0{hxYuUwO7VtqEl*P0cF6 z>&utI%|<=7iu?i2+QZ`~TvZI6u^PLuulg_Qtly&yh zaW$j}>f$9%&D!!H^F)P{wDNwMu^T>stK!INY6hplb=>#;-mf>f6 zPSIAR(%n1G1SCq?thKx=|M^vvd!bC##-}B|*ZJO%dM)?-b zZSElSz~pnAErZuiMOL#!rm6tb6@8Il-j%!%Dmc?)F4{rsL>ejgHfsRzXBY?!h}cCz z4cHUtut{d?GiHaCEH`M|z0XJ&q}(~!c~!inqfC`2T~~hXgJwOIt4>V=8$DRUEA~HBZFt zaBx7ZerItAlxRlIsKpXM#ZYbpPykBDWGJ;Nqqt)gCHrSI?p!LOI&Yn5kBjuk}BGB@N%{fh!H3FpaH( zxu+M94f1s_OX~pG%erATw0|2W0wW~zcD;Q1Cw1kp9+J!s2__ixgtJkfRrtXb{ws`{ z(m_nJY{OtQGAFIC0%en>XQuFcv?dLclZM##iw|9mxG(o<(sndoR+t{I?moX`TZ_CT znp%rAHzA8~>3JwX89c=V+!o4a6;Y=j?#y=OcU&)%Gcfd8x@;*&R=`Surzeo`A4IoQ z5oIDrxH9bkIl#c~QFzr2>k3GEs2xd%TUIJ|OM*_yThUwxQ*sk&;2QG0m)A#iZ}8@g zOtyo-33p)sKQcH}<>l*5Z>^$*i&Ok&1U;}DGxnAzl_E_5jw&|vE0}i2LEMTvfvv@My&kPPcA|8O5*Me0 zXJBmAT|5HEU8+@y+zV=&jBH}(k^!B`jd9unI))D5yS&W`#{8H?S?)9}4n)s)&HPE> z(ay#+r+K7H`6stb!~~0B3@4W9NT~_L^1dU@WG$}?Dm~4Ij@%3$E0hMe--!Fyg)WDk zQ=lbK1}1>aDG_ZV)@$yuo*f|`^5liQvq7Uyayjm9^_Jv7OYkyi0S7(8luN@a?LK)| zxD5h!^Z+`XCzLO~0RCn~JcjhxnLVlOtVckDWuljz(tEY^`eA)Fgr2q-Hx4Q1tW>4# z9ugKkv1uC>QruFX3K}nyE)`g@jPf5sd#pFU*>(oyn2fn-ZFe86B<`V8gp#v@_|^m6 z9izw)+wM#F?qx&iUD5W2+4CNW&&S(^yfaF<7YqZ;FII++_kQ^20-m?KLpCXUn44Qs z8Kbe1mudj%QO`j{1S&{#qsTBrNC{H2P*x!PWl-M1 zhE9_vV4(B!*r9jXKytH5iLuh5q=p8clI7hX%Xq-;~B~1^X4){_IDG z{wYr1l_U#>*oGxXgUX8pLk%==a1nZRCG0=v!D}ciFcuQsjU)mCcqt9h^wG>^3}gtp zoTp2SazDX^a8;NM=ASM$KopGrCXC5t^fC($dZZa7A=XQ*h`=rQH5VD3izcK3$_VZ! zQRtP(EkahQC?a9#Lu=)X%$i6&s4Powp`u1B_UF7bF#h9DVz`(X5RxGIX`)mpiDePi zae3q&3_Cm+>29SOKt)ivs@Iwx%v^<%RuUQnMYWdH`}8kd1i!V062%)?7%{denGH$^ z+>nQ;CYh1a?AgE#mC^EAkO5q|iT<2_7zXeV;^K#ngf9-h(K~&YyM;#5UD1vu51Bq zk?{G>IGo{hgxaW_D4Gm02E_<82BtWxm^i&J*1H31jrw9=NU&rEL<|BvCY6q#0`Bpq zNRu;ov`X(FQJLEF^`O2#oF<$cm;6jeamcXYu1o%B!10BG`XwK>o(m|X+>h`;A4}Hw zRfnrRy(=${8+|P0RMedvpFhKwRa(thycT$@l5tI`Z@Fj>mpZ;B&8>Qx|JY5e+Nei~ zXpe*d9|U*w9N`Yg;It|9_xwO&gWiDP_ z#=FLLG=@PX&tA-w+@D&)9$0sEI1h!OX^mqC04t&$Iy2Ee-eE)W>iOq|p@9#+`EPsM z39Lone5Bzok7Eykz{0nDn(w#WU6gZ_-|9wn&*w-i{np)#eb~aw05rDw*3Q~Prw zVDB@D2alfHeXS>_)zf{>w{hL)vFdTh3uRTpQSSh$awH;MF^2i97zD;^+YjaI@G>W7 zied91h=hYzS0}@ZDI+I0whZ&(`m?l8sI+hM8{()f_t98Ix2CSTD*IUTE*aH8VFAwc9jV2G!}+PaA~oM zNRfxp@UR_gX20dI9Veb-w-ffT(upQDDGR)67%QkaXmT`FvaxG zT#W|y0wax`%}&wQ76ewzVz|`8`k39J+{jRpgi{T+urZ)XMKbF=bE~gC%G?qRvNZ!o zSA5lef694*exu(v8~w5LRSbJhdOqhFs;kM?^oH&7WwisjQj*-3lid#NBBf}@fu!YE zv`_E+A1=mvurf#>WilM!_qyqH=?s$?jzOOLP$eFFwYr_7De~G^6YD~Dhsjx;gKxe0 zqgprbWYDYA=UG2*7kKZAjc@RLr##gEFpOhi`fq>?C_B^toyPq?Y0>Ef*YAV%#H&^C z_gVNA-~3g7`mG6eG`T|3VO*}-9KX*O64CKg-)pTh-&RyAMYt~#Q6(6R5z*S$v+J;_ ztp;_cuF+3g>jbOpu2};e%q~5p^4V&kvo=yqc@3qhOOI0+kMCK&FWSCiF6TixH z?2>B$$TIwX07-XZ#G`S(x=~D0qjg@(&GV3Fn^a)0x8MM3`XtU0zh~t8?-gpeFWOkk zk!o&zeA~CHtBV!kv*6;1eVxWBOcTuq&89Ld0oJ3!`}V(&Ni#N__C5V*;$DPpo)6DI zx`cavh91HU4aUd43zx!T{qh&kGoWRPlBa4w`I7N!^dB~Z+Pxb>1S&C;eQrLPn4Td2 zBfaGb#@pDHhWT9#4xQlxN*@Kq^mog_$i{m{QFflv_hUruEEy%SHl;U8q52P956-#2Ibh+B7TiMQ6#3DNcV zB-!TC@gmWat+py(epE*OK>Ub;{kCw4IwN|Z;}XljeNad6Q~LMVCR(cUMgw{V8sQs% zr6(9uQuyV7*dXTc7jTdoV>7^w(?z!d*I)$A12@bz3(Mf^kuC)KHf?q7C{(F z;f%3(R)hDDByW2vmvTj44rbP>*!nV|T6#1>V9KXWs@?=XK#uKPcb|HAjCK#!V^B%X z6EroLvSIA67`tlDgfXGN0BQ!2y`pHEQIzxag`+qk@q{9#>57vus3aO%;Q_?}bc^tP z^Gwhw6Q;z5QBbiu!f0~BoB)lN4US+#^@rmC^3Z%}NLD5gS&i9XaCk}(*>=P51>8^x zCoJqe+kr?=n+E_gPDzGo9%T3pK@QkEH{p5YrB<-_!0l9#?U)4){ zsfO6V8!(QTH&O$ND=+z)oUU|c?A`zCMLg#qkOJ!a_yqjA+f39036U6gmA*d!Uxf1( zZBN3dozavSx9Rck1DBdDXWi!8mN8WjiYyl*#SE9ckXi=4Htx$uC+!Wue!A}YO^yt4MT>e-pi z#t9KJg#l{JtdOBS(wZDma}z--AR;gw5V46Jj$ z`l8$rQ&Luu7spe~Fr6)kD(Z?B?}L{yUc4;ur?lvf<|)>N)RS?^GS->D{&A+S2qdsX_JbRt*sL%A` zW(G=})XatMT=YuF(6(g~GDA_(A{G})r@CsOM}e?8By;7V9A7$od4X%Z1X$5}vq+nn zT=u=3PIe0q^fCy;PT_U9hP1lTWX93PRfIFtn-a*=6%^!d8Y-Z5>Rx3MuaaReXfLXzSvL?5X%Z5L4GC#4KO+T?$4ANWCdA>qz9Ddw9#Zxq+f-;Dc@F zYbd-v{7ll2^y$S@rl-DOZ`XJI4y6=@^-@dK)(ZrD|6H|9CHPQcljHkcF=aU|-_5bY zW=vVbIMKQR_jT%_4QyV8Oyy4o9N2^X!x}pCE>)M88rnRGl00JaO3L~tnPm7`=*1># z@deD+q=l^boUupPi3i@I>)K$fTeR;Gt?JqQVz7t9W?WzJ_Bk*gKc@j8g_A)C}RzQK1mbONNF4ZUf8|2DVt22X|A|xvg~GbEUw&NZ-Pkd4W3?71wEmbC~Gsb zcOVdT8PTm;55X$3C?qb3_+t&94D%RB1Myt#M?*o8L20Cv)P`n1#KL`xHI z-0~3ituxSUOReGZuN0qL` zQh;g6sZAVJaL!%){Z8E1VNqM(9E7k2Uvnu6Q^hv&@Hr5JRUlddB$3 zrUb<~{mMGq?3cMpbaJ4qC{4$8^XQ=&sUq!qAv^KcA~;o~N}QHKjDRMA-j9=nZPFbI zl_qLnjWxfh*uE9ukHIZ$C0XiZdx@Fl-w#(kpFa&Wt*BQzqFa1Ls@g$RR7iPp@3_|T zQ9y~9DT*fkikNn#8PlTHch*uFIG(#?UaM9?oK~2AVmh~ZgXON%(C?aWHqr&!H9k?_ zR#r4VzAqP*f%bRnj}GKabxXT0D*>qlj>-_8T{x=+1sF3R2@U4Pdm;F17J-NV<#gkr z&GaVBNA3PXN|iZ>f(&1VlC=VbEG&i>rXP0YuveC?}V)=N5$VO?<>O&b4U! z-fw769y>ljFh49|zqcI%)<*6WkulG&phM%ld7j@ob-iCj4!jca?sMMu9OBN#;7{9~fG`J%uM(MuzGFJ$@gzu#Vff8v#RQ@P7SVG|Y34GD8^Hjl1{ zKq7WrS(rgMJhTw4lKk(VA=*?v!Mcq0*xDCrY%M;JdT`y4PG-6>|F}KKF3cr+CJt#I z@h0H;FvRq3H0Qg<4z{r|-*HD85zFFbD?-<$`dFcn#dg=#kcGnmzG9;#wpyA(MiJh}Osb3+s^KF!XQ`tOJ8>4uMztfdV@yhla zL|2*M3L}=E+jEmelXK-$f{8?UB9{}VNJD=EWEk2XaEsMViBFeYt+{u!O21kN7wg29 z;PGD~s4?o--TEE!*w}uIzrNcMw3@DY?#F!IH0-&P6wrd3Fj1-rHtMwH%q#PM6^b3T z#xJ`!zw`{F1~W&@Y6XT5ZkmTznp%?>ZlVxJ=Gv||Yj;Wt16q3ZJUx{UY;QwVVEVvV zZ0n0a8>C0+ia<-`o@;94SJKjcn1@lQ^*8#&>Lz^uVLxR}K>qn!=VJXo;M}br9R(a< zM&IzU1VQ2B(Eg*A&!yFE)uGjw)ty0?=}&ATRBhFyTXomh6N%_po%40ouV+%JVu{FN zzryqe*Yt;j{jjC|DcfYO5dC7q^GbHP-gJVYzey#N@`baSRXN@qv1y1Ec{`iKcM{Ch zLOoE%vqh$Mer=)!;4I~W0DJDl=gL-0vsQ_$>J8K0&8q?o*&W&DyjX+mn5{`XhS4up z3O?)Y2jzg?8<_j>Hw`_DXrfWcjyu{$Zvgt8o3 z_r`S^Eo#*+fk&f4VuvBKU*y+f{#>N|3_*iz%y>0?kGMV$fxQfg!9JVnfkF#oJs~}h z#G{8+=F7|ZNXMTFPmQ;~mhR6DUh9kQoH9u5AkR?KPDYyc_{(0i(N`%6K%(p#7Qdi# zqG4JN;qM5*V+;&u03ETdfZE`t`U^_nUcBkWx$KreQcqQ?L%s+$8<_BlbwP?DF*Wh7 z7~;|;fmnB`YWd2uNVYoOIx{6licpnDgK?Y0m@&r61EnkMWkgG0A82C@EGQP?`Vqqq0O5UaY$-HBHUs~s>=hWn9)+D@+D+0 zR;3~%o2Qlf3;`BEZeBLLP#gDh{O-+WV-)NlKyP~}7PY1b)lL;;VlH#K#^~wN@M`DDZr0s3#)ix%f;3)} z&e6}7fBt=t1_>J7A`JxE*F{0p(y{%lUbro7G3+6#y!6ad;w`+i+N8)4T!UW;IHN7b zpR9m8+$wY52}h9r0@~yu;a(&uW8rfGa~)CwpoX{?(rCARm*aWjDScCGdH5nx30n|g zvot3$?x75?kFFjZOyUwq79-`w<97)trVo4sOZ?@QR1|@(q=Le7rE0x};@DiRXU+~) znraR(DN5<2nqpCZ=uVkok0aM+?Y-EDj3j8_OijVT7N3c+Lv~y^dIVph3=Z}iFx2@1 zbVp}=+#R#se$*Xk-+5j7GMUH2!Vw7mVzWvby%p1)5`~)<=!um-n0&wcg=aVwBDNG& z(I!{7@o;~EhuzQ6`x+8Z1Iy?km@Z)4glx4SYsip+KKLkeXjikdvo(3ay0s#K+7&!>@RF#} zUTp~0byP5aLlL?6G?Q_G`cT5|QVH8$@jiR@Eqi?Z%4{-X2jQ{lK;0)v8S+d&8kX5X z%5J~>lcZzQ)=xYBel+|=cHP9JUM}2JYPx86|X`il?E-}<~l7t&92{MWEP1n^(qC!dYX5Joi z_TWq%bvP^j7{hEG@J z!lA{(Wu6o2iSg#V&7iJG95^GL0akiyBW&DJWbe)>(pzfkzMbjD`<-w7fg~4;Q!#o{ zWr96UYmRRF1yGn<{`fA4)%9fUv6(oa6+NJZjSRALnacG|X{iPN#p1&wH&M2>>WM}OrO$Fjx z&22A_w7is2rCz^;pDKycsJ)d@Q>*DcKjc#+D#?ClH#`lBqoZIg4Qj7hOB|KpsNL#? zOXKc3@=r7Tk0lTG>=ZL%asqOZ$y6u-0ROyi+d1r6M#A3Q2?^-s)JqyH2S~&k<|5 zK2C@A3Ai*iB*li2f(se76k&cuy_f(+-}VqPBkuA-co7Je_=OPO*!28nXqn#-pdwuv za#>1MY+2|ZC6q&7FaPyy>MHYI3W1vskk~HXhg#{jJ7m0MAy5Gh1rrTaw6bx_N#Vg7 zp06i6KEu(N_GfE>GNi~xQ8l$WWJ^GGgcAnj$% zMA0}?UHq95btfBli|CBQI5&PZ0L%vKLw;fz&=jA^Gz{d}s3W5~LIZU)10*On2kFHu z@MMgg=H`+7s};&`S2&2S6JrnFZ`;2jw+kd{=YyHGll3k^Xu6tMIM5?|- z*ew99YSr6+2XS#|wz1!rQ=dEJ7k)`KQ0lFX8K^b%x}pcIq{CB>oX5PF0LZ7e);po( zfkJ--GA`*IXY24)O$>g)RLD;CMp?tSGUt=*pfUMk25KGVnttE!g^@TS4ui8BmndgE zGGyPFZj`f1h7@aFyn|vMz^VLss#udPVPA4jTQ<-E0!lrZ(mW)vclAUyv#s=<|E6@r z8!Q#QW$Uzkq_h`UJc7H=u@h%0V*;2z9IJA*#7;H~74v)I8UnbAesF+G{-@IK`IEmT zlkfPk((6)Gzdq4#6?4mJK$ZgxOx`Ku`e_rk)3+Z{qiQ-=PnokW06FlcXyv5OKS{xb zuB+8G+6IEfez!z`t@8DRma~|B?UX+TRAltb$?99W)epTTo*43~!BNOy>DXW9kq~vW z6zBpBPg5~BJ65UnwyEiFN9rK2#b=4XYv@$*MNCdS+LvC}=K-592aFVMIT3V&LuDeZjd+MXlDley2i z-?!}s(at~g*KM|T^84rfJc=%xn0*cFuEr0|Sr+(u)*D}$_6<}Xy%LhKYh8NVDicoY zLQ8!5=+^YN5#Sm-Z{Q^Rg>ePU(l!^-yxo>sbbV=MSOVnnls>)*viI}qO`U1@E9L}c%fTkK z^rBLNsrJnc$Pww&S;2SxxZvFxj=1j@OZvugGrFos53#=#WD#MF4FWl^&UZZ*jqC8$_Ib(rFd3C$! zEK8{Qn&YTKX#eVRr*c_4)Tf-@VK^9UlI<<_LrPBu2qt6UOZf02QTS|wp&;VgprgD9 zi_5Hl_G4wr@z0f@hgACmxkOayPt;GBxT8e(zHyrI8Sm%;L+Vitt@ThigkD3kfT5Yp zmH2~W<;Su;p9)^fg6eeZ2R4momOf5@HM6dpIP8CVv|b`^P0rW6dxWEIP(od-fkq?-vk%nGm4*E% z+bok;e7s=N{X;MjselepHJ;a|v{6Oal+Hgajh89o_Z^5LlGOiB0SKP@O>WCL2@RuV z!~ZtWwv?f#kiL;dB#|E90=V+1H+;=|J`WU{9~ab|<@qvVRJ=b65 zlE3FoI$>PjCAVQm)ab7tV8cX8q0gnjkZ|%`J;Zz4ae0%oO z6>@OC0fW%hJX`SFNPHq-zex!!#Y+5Hooln`cZ9{xqXpCnuG-A7`(k!x!gpmgQ?}S1 zSJ>R`I+k+GuGsRF)+TV;1p`}_GMpgQV}U7*w|u~VzlSr0iP&Z|Fa<>|wKq&X;pB2P zNQ~{+t_4muJq>r=3O>VMZO$+h$GTr%>tHg_M11q}_k19ZQaz3Rhua2w8gL~rDi{+x z^ZymKXxeZ7SaWyui8z7PKssT_&f(U>sv78(Nae8YGa*MPO(L2@&R4@#=Kp<6-zt!5 zvbWpjiA+!Jaj>A(UDFzUb-r8ncsa@$)42Xrk1D^aj*$1~3G4U6TZx{kd<}Ki1P^s? z0G^KcU?h^*gLY78g(hykD|VtOY=x6A=9GXQ;&oU`6dK?m%HKoqPs)GW3VuKGmE^Hi zHAFzw0apLqG+P1$F0`fr6Xo@@~t@9-q>CAj<-Ps(Asn z!#>q%tXY+2%;klZt`0#(5kqZ+9*lwNIDk2JYx^>Gx0~svxUjWK=DOcDStGHZml=uO z79mTS(o~Lo0U2QqIU|}Hb@i1&YJULqux=*#G6$8GcECxS<8MP<%^%}CWbI5({UFeH z5lWDWNPu~W<39PFz~5Yx!mAF;{fznzp1<}Dkw>-*wK~bR2R5JatES4yTnA=F-Md53 zLLGcSujoUsDjn``y{EX?8ywBaj%qN4)KSk$uS*0iX>Zd)SAL=|&py3yuT4V1#d?ck-5bGmBno3oRz|(C6=$xawGWkBk4cQ=LOy8+9E3w%FzvE>#E zN!MJXN%ESs^7;6*?`_P@N*;nF&dB1U45i&$khc!+aV7Pe*9Q4iH|?v0^HrvoL8EH# zj%&l-T?NGMHDC>z-^g7g6!- z(Ja=DA_P&CkJ)>r$3REuRss+Da)7>$oE{l7_^f7Noj*v_2@ z*_yo0xwjg2D;vu?Jvy7YM0oKeCICxepA2WwifjCRoM=f9Xpef6pk-rSP19@E4VLE# zQq*NP-C6;}`O9p&NB{bL{&{z>$1JmH3?!U1IDOMVKLHK`+M?rP>Rh&bKL+?vZKoeOC)?EO6nUm@LMw~*|)xk%lGVTUzM;~|ODaK@( z!-cL--DlvBcGH|?$n;EO`Zz5Duhi29*4V%SD#tm%Btme6G{O(-VlXZzmgcuo8aZAm zE?A;UT1cC;jzjivCgoOKhVe`7()E)qv8j%(BzOE28KhsOe5TCDkWg}*PQ4FkwIXtC zJ3kx8&Dgk}0Iu&btUwC@v?p#y{68H)T>taAYnnFA0s;Zb`2$Y*Z*3UXMC^|Zr(54J zA9A8s3;9WH4!8NtZjM-XwsHYKF+ZPd9fMd=i*J9+?+2VxObfftO7BI?W@5xiD^`Vu6Yd_RY8FxuNPPws{c)+)gq>+|XW4%7TTXo&yPcf8?v+^6nt= zt>QN*yN6z%*Na3(Gl{-!Y$8jsYD!Wr=vBTn77Z1wj#D^#XoZAKma5CXWr3h}_c;n} zmctJ_=ZzdU`hcEhSGO=@4l@3>v6w4L(hNW)N}9-I*?YzSmI;@%jlgYar>L*!wpGx) zlpAl_Zuw0Q1_Ni>gpG4$rn^GSeZPWX?tST=Jh!QP>pL1Qn2!r?i(tpCvHBBt)6Q0R z7sy2=Sw9W9oCcA~o7(?%faA z^fZ+ymNwCpUm>aNvoXYs#Sq%TmrxI8N8m{JgtgmxsE5zTnUwbSY7xd?Z*l`|lNQe3 z=VC!Bz5t-3yZACl5LYqNC6n@KAU=oYH@#`MJkT`ngFcx>kVxex5tp=L)ehL(&Y;*o zIe$eCN-<>h&blZs3i}JaP<{>fNmn)#tBje}WHMdi6xfK!vaqL6Ll3O37j84wk%IN1 zWQ^wL4lvgG1w~F>>_^ao2bM_j69#^2qgYg!(gIXFkilZBd}G=Efd`e#!6&=$_NvNu z&y>_7cVh!Dwd6L`TxIfKF*f|=;Hjpphs7?hcC%d#F~!auXI(Ufso)P1pk8pGR9;=$ zy`2Od`ii*`OXOg2C`3~Yrrdxd=kGuXKd*pqQlz&-ty@tA8Y2oq zy`x3aMjD?RgyVgLF3z+&Y{sC%K+~dFi2_QIFn406OqmDC=I}Ti<^MGFlJr?k(aM^v zGuzCpJ2Bf%fDIt98J~Wmv>yDM)#ZeJ>yF62P*x-gZ*T60mg^`Q737{0@1}zJUu?Zo zV}26F7sX-4eV*CI0;q!9&j)+FWYDno7imQSt)UzxYQWwSvoKKfGvaasFhkdVX?LE zx!`|!<<9W5=b_S9;x_(SYCz2jSCM${+B!=uAzqS>e0WV79_`|c$=h1_6eFa0hA2K{ z7{Wj7;V8jL+iu-!{%CFO)we05pDRJqi- z&yTybbc$R@6TayT)_X>6o|R^Imn8#DM8^J#wq^d3^^_f02DPO7Y;gcoX4USY1a)|o z@V&>BMWLD>(7v(b{ITcIK-7RkZ$S97+QDb=9BOGFzw%#&6*7W% zQInAuRl7S3gjraCkamAc@*#nQevfsKF?YlRm7g2I@Xf{JgCF7p%Y3J&-5J_Z4%{D$ zx-@25oX*TS@N^9j<)MUWjaXXui^@ESsM@7?B%0sV-ZFiu%BI%~{-_Hhu#u5nkquxK z1*C@MR5*wxRzU(N8)Sl<-sxPtk_24h#_3M_U9x0A;6;E18-2qy9_3k)a9D2a#5~Z1 z<-yW@ou4D2qwrzHF*~AvpZs+I3ANo5A~nY13^SVNfseNPwV>P0X-?TK^{u#ksU>tA zz^CIn2l@?+HfEyrUkWqFzqO9EK^72XP?rCzxz53~`8OP1eSE|OC|fE$lc3D6=yUzrayZ>Kbk*(F2vU? z$&oTNubpySBBq010ZFgcM2>TOWVngVmzvcDku19l5fj6+l@- zPyM82p!s}9j^%o~|TWM0BhVu9Ea06%N>JWI9(AoR2pF(NcGrM#&zkQcp$?={m zacC>V=ZrmK6>~Z&jpP{mDggxsKNND%0hqoAZ|30491=G5$YJJpO^b+qB^0*AlsY}Xlp>6{=&ayFsNO!4zlrlUj@p3}j zS95tRGKzXMr64VaCV;dSFJuyTh`Vqu!Wk5nF1BHYira9$K>!`;tyEfC8<%@81Bjb2 z<2cr2h0jV;jET5iJee`(GJKMI2QEV+=(% z2>m1RH!;_9%W;+GRKt5ng zC6X$9c=_!&E{B580#p)4a-egBWCv2=dMLi@Nr0?qK;*5p!fN{)HBbWWM1~+G<+LVH zh7E~?gj5ErU^GpGnvgn2!(=(6JSs#=fy2gK$I(K+&x;8rG%pg${^4pdfX^o@#Xqp? zU90D<3-Ve0506~#tTYH$en8vk+uyj;CS8igXG+FY1mPh$?TGSlQNvZUh1@C1eE#3$ zM07ACbBs{%*FI&FfBtOt?#;_Q)e@er;i#w?(o;@;w?H2bU*`0f|D&>KC z#SvTn=-a6iYT%_XN5}iLotD|Bm#VAR*xP5M4wA1Ozgrn^V=qj={rPTd z4Nf-$^mqkLD)s$B1av(Sv%mg&5MnlY$gg=ciu+=oIks}})ng|VjjZ#3hthk!RyP%G zm`@f|hs3g)>la&XjU(JN2}j6a2ZKdQ>ncSt6WVs>Qm1qC!V@4@e*;DP^$B!O<#w3P z3?Nop!GPpr$zyHpI>$JW7_9@6HM$o;#bB{wA=%`tqs^K-1JofskdgIyz(o=xfs)rq za}}T~djunUG^}0kd-JXP>Ab;Dru_zDYlL@~R!RrPUE7}ObF@d;;?QQ4M6{K{D=B{r zWR*xs0%0;Z=Rzi&8V)adOBg~#u%5;aad*OJ{Xwi7I+~N%UmJi?^oXb|-l=VJWLS9N zqJ|Ocg;3xYqn%U*xFpjMGu$g%Jb1 zauk==4{UFrj}DjXt>^$&Kz6sJJw#Y-rR7{{gCQ3o_>bClUE|-W1j_B`F9J?0<_5uFZ zD(#;e{d58Qn4w3zW3j!H9Lu%f%eGH<%a%#7bdoo1& z?|}Kr=X|wGiCZ@C$@Ano7@5L+pYPs{p=mi9YtG)VwClQ&F5-+m0;2FrcY3|_FQM}Ax$7t%M1y`vy zTE6HaL!Yh5l}rnf8wcTQG^s(VXwQg zTMX%D0lb>JW@}(QGWh`y&S?;%$R$am>Z0Q*^oTw51~$j3PsXe=E1aPl|1+SwM!=}_ z19n8^wO0=K2+VZ#{Gb(t)!^w_ejMHYBak-QQ3B`mJZ@nJIWrL1^wO_bbiB&!FJSLE zltOSdRw`2IdfA|mV{lgk{Wa_{SQ|JbkhsvRQD|+W^~g{c6k0hAdAi~&YZG)Ih+4UB z0rr`BaFcEGGq78@fmQak9wE;L1f!CqS;KNq5Q0qNFqY6u?R ztZ~PoE4GJ6_OO*8(Pv_&`*zLYk$)LZuJx&^&M9Y`eM$8kG`{}42tn>4c82#{t|T)8llroUtq8q177F@(dQ}NVC*7^2p~2^dcmRg!^a9QHvRT6B%C-9va<;Bhv0!WbLzg;i(-EL}m^$bi zoNd7o`!4~`Zovevd|ysm5ukIxG*L{CeWoK0&K%Sr_<8k4D6k36@i#N-G`?CEa#j^a&QzhekQZL^p=t~8&FFV9G_Z6tpnsNOilZ~?+ zC(D_CR2#nb3Eg^s^Ii<6#0w{dr$Ed~&po)LeuFyUWL%JVtEe~>74Vsm)ozMFT4s=L zv{3dzjTlbN52CK=D<%Z|hTwbIaL-#TDAY#Lq`hK8UIv zrT(v;I7fO_d~KtCeO$+{=A!ArQRvnuixF8$Dfnj>C~*lIg}zLKibQ9wC$#n(xib^F z$)B|7L4r2sq?4CD0fv2|M&Ml>cSBEP)VDD5Ei*@MthhVqG%iK32gr-H2%0pXxY3mv z+h~^r`){sP`wKW-z#;p9KOGsyk>}~;itY+;{$`uSY2Wy;WxQsaQ2ga0`8!wcO}V!7 z=0m$$CMYoCC*99SDnHj6+tlQ^U@S1^*u1;+t2IW_5m+e(2cYQzWY8Gr(3|Wg5he^W z3@ugmxu7ggjZwtkt{L}kDhSukGj`LY7Bm?CRzTKf9Wwx=Ex4vLkXlH-6?VU+iMgar z9Ll%Eq!wm01MG*7*=f?HUC(nM%PB-^X=QDqTPZ}N54rETDt1FRf-8O~0trsxAw?85 z!x18(TgNlgWGMAgkrAPnKG&@D85rC2s@&3}y>xu5zZ;8v+8>Z8fnG6a?M2&cJE?C6 zIX*W=G~7Y^H>sGLeZ@eUlf|ehbf?#zzn0+}1cZ4o;=lCOT>ooR0OjCf{|^Y7tji7s zxc$R8H#iYcqv%j!i9lT^rBX~i$Jxyq+MjyXtoYAb7JT%b1rO@dBWsXAakupf3AX&rVGrCmV3Awcf=%4{K+UP(^nNl3xPGDIH8x%pLeAi=8{ZJXhnUpJXGNX$mE zp^8Og?Yt$pk#EOjeJIgj=|UiL9FNf^-1oL*prvDds`xHZq-s!W0Jcj3*=`34 zl)f$5;>4Wd#0s*yMb?H!D^qtIcto&6)HqdxJ0V?pb|v#fxfFtN2-TH)5d0imMXH6s zTrzx>WyCIA$uQ!?xx!o`inEef2p*9-%B1@rp?Eh2C11Mtz)Lf<;vuOg8>((MeLfmU znb~l;_fgr9+{G)K`BW}=z?tBQ$mYBz2)=a`EMIqd#dF+7@LtXW{I6y&o!b{?(o)=* zG(@}Q9el~UdD@dMZTS+iU5yS3-fO5@t(_*ey4bTse^T?% zg0-zZ6{spYwJ|NRShG>Yam{q_+Th zhH}cqT(A{t;CeS{Lpq~WXFq928L121JoVa4#oOZ?sBRr0T33+dxP28INm}GScbhVz z(f|Rb6ORRzgiMcLfS5Y|Q^jyt8i^e=vNABC(OP(SI{FfAmd7!66Mqy-E6ez z%Cjuj~**$R88zn~0YiEjZ z+f3P9ELjA<=yB9oC|9&(k$7uro=VdwQ-@*)oZ6;Py8d{b_z)oZ(-rtotW0wzz2SP9t!d_pGA_bG`OZn}md0;UVR!zQJYykB!{w=kO*k=Plm2N}#&7kNO*pAth;k_T}kF;UR5Zn=TYSj&F}0P&F!HsNqPE~c?{ z9aG!_^w<`Q5eyOLmEa|Rg_Vq5Tzg8rR&s8{`X8O5r5x3mC|(q$t1Lpf`uuUYJtMHzC3MX#{H25>|?7R|~z@khD_sz&yJG187>?Vj$ z;LuDZ{d27lMTC(^rU-8vpWqQbQp;TH9$mMO`9*B`lqRlr{n%{7_S7C3WyKhboc&r8 z_V%(Q#T@!jRK%LKFji(E+GNK+A8ff8-o=_=UL0n2=XJO5XX-+w^fpHVY(nbF9!%l@ zX!>75;G%2ewk-SdY4k;CGo z1%as#o8ONmDY5*T7ACbiemIVF6?LgFc?~r0UNTR~gERlVNX~-VFDn`$`W=%YT6Jb1 zW0Mmu4}N{I-Y|vg@!SPP^~DbC=SI7OUtRkR9{qHt@Zahs*MIO<5Ek~d{yAW3z_Nx+ z{6CA&Z3b!ihzL?NYM`9iA;L=*>h4N+V+dr+KHVDy| z?M`0_pbi^Fs$`?VTq9S?X4+??0tE$Yg-$+Y!pd%^VzF^@B)e&uGx#VEz^Yalioe&_ zZI+$>=+)@%>&zNJV&{a_u}%0pR@Ln_E}A3UkzH-EBx6-5-|Jm+v>TC)*`-X_DUW8x zpK_LRJVLU2jWAE((%%^;V8VQ6!%f~wWiwcf2ks4(VP)5rPGUD_)sa46#aKF4bJ>F3 z0uc{xqAK=9#QjJDH!7nBDE+iHc!&-(cmf=!&D584%w#7c%zZjL(Zy0Yas}`($;>Ew;P{L&MSA8|-nuF$c)=-MFgprQ*E;R2f-d%27cmm{An? z*m$l}Bb_3=tb|8L-fjL>s<%5WD5af?X}e{9qTGXT``sF^T5JxpGWK;|v)XcxyA-Rl z2czBTueD`mO}Vwrz@+gvNg9WZOpTH=hLGrD0^;%45Sg&yc)B8SAd$d4<>OP_`BT02 z!4^Z&QzUYe_W%SyV{s&=719JFqd$^DU_T#(xqSa0T^2LPJ##2|Sye|y#!MavF$7*3 z8cBXpF~7Kjc4^rHR_AE~agkin_H_`S@za>L_;j!~JJ1IcXpuZP5xs%Y-wi_^?Xsk{ zVJ5U%D0o@HpBU&i*Y88>muoR>AU>S%B)Cwu90m}Miw-t`VXBGe?9dx+*Fx+i_)1{Q zue-Baof>SWe9XZy;GEG~(TP;OGFci};92z2Kv5kqrRl1M6A_)}EDN%7?yXlW5mUq( zj6<~^3DweCeom|Ou2nTy?g{<8%m?BMIi*4q!_i!g<;El}84bocwGygpZREYMjYX9k zryBbDIn6V`aK)d`&RgQh6&Suhny7G7QDRtvujogWKsaoH^ZIL1WPqzQ=u6Wu(XYE+_jH~f{_x6w^dB}(CcqVNZrn-%t}m-!I-Qm~?u7y@x`@}KZe@N1 zAIGf(19IUJ&FiZ`cwfViPJf9F`*WW}K+g}MHi&UI_u=_9{&D?w8Yd__dnyQ-)>VQb z?TErPke>7Ld9juQM}47&&uV@&VEYZ=QUfYnw#b7(eNN({%H*B`lDaa8-b8MNTG}!Q zKhF99&?E7sl8!PUn*KqWa6e!LWN)#6Su2+}gl+%5?R>K3x!cCE)L`VKKE$`2i{^mb zBPEdiVp}w9uqQ52&I+lYV6AH2chbejb_L-ys~9;spFoo}84|5KDl95er=sbB!6Ge5 zb@P3B5C+G4gJygc=%=3Q*A+!|-7n?|T&7elXTLMC*9gH`%E$V_Va7FEnO}6YvNtUa za>0n`6KJvQ0V8Z~~*c`v6dLn)0V4SCh7+1TSh zls-IF&%#190f5TzLXwHiQ9(Hw+5ad18ibMSfAP&}EuBAGEy(|5Z<<7iRp4Dw<(*M4 z{oq%9f%`zyr3`jPcb4rIp%)Fv&0PF{pL1ZTl^PI`xP;~?5x9;VpQatnCBZvK_3A!u zmUk8Y^!Q<#bq+8rFmC72^B{xyqm^~i!GDs$c$7Wf80e!Ae7n4VZ+bZW+X{JDnl-ZP zbLjzm+)oQZ?dLdNRQ1^!>S*F}+QchmE*_Yq?-NCHP73)~9_L$-V8EFF4|%lxJiU)a z5xBa8yR1R(;m;K@q;fp>y!B_pMQx(Mny_6!7ag@ujcsdI+NHIV?yWq&ch2k^TRfvk z(hvFMM#J?w?*(1&<4wX}e1sc*mZSL`wh%z}Fj4jIU9UX1)B8+nmkQeAoiu)l6oi8W zhHVrB-TY!#2;~a#4gUDL#X=};MpB?kIoE7DN9T{=w<7S(A0<1*E2NvLmPMH3l+Dsm9aA+gO=_$Y0{In_~$>(0YfuTe4NA&Kbn(Dmfg*#;9e~Day z1bH)RjniNxIT?bc$chb`#5mIlFtt+N$EGwt#DSTpOILx?^4J^5={BB<{;1CN8Br-Y*?|x;yHpFU&a+u z#qf}jOU)DAWlGybL2^c&?0JP~PCMTL}^=M!&SGBk%@mq#L1!I)eW26Iy$!SXsaPKLWuloR*n0~JE29H3M!dpA`3$VmJ-6+rvTI494sZeu`#*B4l5{&9( zffbUvE2b(}*b;&Zasy8EJ*=k89Ap7rT1+N&jEAmR80Mc*hfNk(ubY#C@Q_+|e>{_n z)$hsvs@{_gAJ7{WF*C{@gQD${;Qb~r6}ZEy913oHrO?lnM35Ke1rA8R#XF$k>f~0{=iYH3=Ooe4IBH{2lEr-Z(?D>c2-QHqrPg5 z@7z(L3P)EQ%TqWF=l3|DUEJJfK+?NQwB6#Z+A1#`hi40G3MpPqw%8DDQFWjOW=O{D z;q|k)p3(yw_izBFh-`>NR+?bBAfGVNg%xF)b8Gc#)b$|it{AOHkw$k(`P-pUCGU=r zsb_8^mlFQLgzo5BNNJ|BRR(@gN`oFo!ORn2~cZs8)r zfr?5odg6dF%aJJT$~jeChp)(7i#)Vf{Ff2 zd#c%NMTCFUO^O8uGLbA5WRzb;x~3^f;mF(cc5)8Ws{>a0r_c4bvB)o&mcWhDpgoTx zz0+y)7oH?=@RIsoM(Uf zzLX0a$wz*OKWm;oYU~kTk8kF?rp+3|$*-7SYTN*yXwfb}?WYLge;639IA89O$h(4l zEF{(*?!k&DQSXkwtB}8+5aIj;y0-~%H&94oc0AoC28Wla^LWT#`n^jG4^^X2`4ucvld+sf8KCAVE^LKe!Vo>+CLx2_AD(R&kCvI#OJ2{ZU1U~ zp5{P0xQ`7Cs0-MKB4D;H+XW{L00z>G0eWcaC1@uv6N`@MjUe)z4mR~7`yP>tMCDXi z=P8QJ&^x3}XQ79g6#T>!Pr(iw*SpC?l9TE=w&wd9NVln3o-JRfufvHCfvQem$oKQ{ zeiopM@yGrD&vKkh|JgPNWny9bPu%AA|2N8w8<`oFBotD~i21C!XMu^e2;!b9lJyJI z&bKIPJzOLX{m=X7Acmb+;|@jI`@sB^t?0+B&u84P&R z5winh8Dc}HbdD$Ok2`*PO?voU^p(6aoA&Qc-<#2Cw(M)@C>OH;V@B#_E|FB|`S3pI zp-3SP7^PJcCJ{4+^nL&4lIp4oOyq;_vx;W)S3)StBW1saF~t<1yaQmvt)d|X&qCY2 z=b^OC_uA%P-QGTI5-MIBB~g#b+JY*ZqVskc?lt6)VdQ_RK)v*=yjr)RWS#=+u+vA) zJU0X0p<|cr@&q&hl_;B~V++bW`qe(1?R|^l*}8!p*9IG`=NS0K0(1EKUiB^XDFp-S z#j(T3X*>%5qFCrX=(R!E7lYjN+-Q9i3`LFoC=q6akmN({Jl=%Px`#NEefeH?=>c)T z{27Af?|dv!*YTxuQ}P8ii6!mhd2*x=Bs>`cUM=gqYyfS*ov?2am^Pk;BGR`2^BLAb zGImJiE=%wnf9*%*ugZbAlzX#>OJ8S!f;|+cGkZA48NYOpb?=97QYYtxz(sx;RF=98)=&yu2l_GOa31b_dJxZp3skdor248&7 zAoN07G}dbXS#lF4j;OJVX9~M0jH0;RJlHAmV)gf{7hu((F+@pE1iA%3j9A$X#>g+v z((PUhyA?FtuKME-0#KWq0mggFtAASPPwGBCoX$yVkHyM2iF^sc%Hckgb~yuT42olG z#()IK$PmI~b@MP&Y{xbojbruoa$39Y>xEL4;tNE8B)XagEzMwCleL06N311>TPo%S zjia{RjpYS24&LcRp1Lay#k26}VmA4uP}BF4NlM#es^V0wrj7M{#D~7>dWy4$4eohN z3yp-8huW)I?HSLnRCt)K*tW|{%2`HV0%Jrk!AOW7y)61+%elB<%hf=9(M}LXVHBK5 znc{muq$>*~B)vpn@)_DP=s?GAYnqIjkVQ6S8#CQEwf&X)Y`i;F{zWd?VRd~Y_Yj)kj3oUQUbXM zo&I`7s|%4CJuzeRgN|AkC2RGf)lPNRyi#C*DinLDYP8w~Nr|<}1JHD(TDLsGTm?GF zhP5+cM5Lc)$`qB-N7eb#z7T6|5x!ao+g}5YF7kY6P_PH4MRNuqxD9l z^(NHdi268Iqs*lqSh8S5c~JYU5O5U0oFi$+kyX9mOXTNV-$#-2QZhrl{4=o=B3cCf z@&ul%81|9jiV;NDf@Ipr7ev&61eOs54Td9>PlhFeTpD4HE^Y<2XBZDoL^^MS959~& zB#o2{luIxhFM)s`860e!6a#E{SECq-9XG*KM7ABS)(c&%U$fGK9;JxrL$s%c7_Wg> zWC@Y?*N;+yGA>3&*;D1yZ`46jhXpB_inSs{|osLfztv1 z9uTpZ=WladD25Lr$m$^r6q4D}E9jtcvMKBB8I<{Lx~^3=jT&CGKjk~fMRjzAfArb* z*QnF$JBdOb!;~p9=X$0e3Y;}2hfG{ZG_vtm_NzUbH({#)9{@WHRVvdkAx1Dh$!i;~ z3p35^ml($w01N2){wT%)@h@4TtltwN11Wt~oUglUq49~~#TzHA@SPZb&z-My#3r82 zPFnj;U5`Z`tCvbtaOqH>jj>^KK~%%Zv|`J&;Y>!eVNebzHc6Tfr?Z30PGsosC=Q>h zj&1B|#{`2w_3mG>9V`q{Ppt)fQ7n-t34gI5wa~240M*pId7_e+X(7uDRuu-dJirJx zU(U48lg$;Jv`3T`{Bs&?h@EgaQo$jm8(Yyj>K^EX>Y)BVAi_t*`E&@^;2{ZQ^-g-A zogj<3grrCQrg@Jr>P3aF8uz#Rn{Aq`xS8miGQvwu|n2`ryDKapEg&DWdOE4%MVI|iz)*@ zxDFpduPAZooO#7~Y*};FYt^FO?hFzOqX!)I08{Xut)%`ZndPW|3r+X_M#eaf72y;@ zaMI=zqMMP*suXFxt1^%t({}fP6`5+}DIIa_L>rBzpW&F9O6-MfF9>!Fo(^~TanpIh zHIepN2{Pj2qC0OC_| z{E^g*AG*_=b_O4-k>h(g_=BaJPlq?1Go7X2%*02SJ85y;l9RnVxKjQaIoVZHsgl%R z%qw^Gpq`4=Rlirf_Bf4>GNoh%<}>V_6Xj#5)?b=qMI+>WR;JhBoc z`YE#+V2^D)zWxLo-H4QYofDag01}E4pXoG`mF*$tZEnv&;F}RtbPSRQOT9TY1d@nZI+!zp=-J{ob!LqW~M%rKV1uQB08%*8aJY(#N|S z&FIRluvJzp(zVN%PJ5YiN}z?oYZ~Z(nlig;I*Sa2M`>B{eaQ(P&%_qbRHna+UAxfQ z`7}$Lv|N}7dx$<`9=~uH*OjgCA>HAem3)Nzc5Bu^uh=gi{DQ(tV{@m zZstPbXTixy9jlHD~t`!X`wHfI(6lqDe-D+Rd1` zh^D?^N}=>wd{r!7Fi;R@DmvmKN6@kut36yNVOWX?ql9E=Qn(AIGPIp}EGr?rpfOM+ zrFG32qQu~)I%(lKtacp7$$w$!;4LX|7ma1+hJk!yuv3`n+eFz%&Tuln<%zJJBqc;4 zGDEzB@FN%N(ZJ{y0Evi-Vq{{LW7KwFumsdk?yjPwzdTtv!*OxsaUC)vJ(AT9(s%ls zz)+~gQU%v`iVgWS_Y@N49i=5zj+zGRQBp3jYGYLI5g4oNyKI!KtgtO55gaTutqNAr@th}rQ0Zk8Gwt$Z>#5adja;*bv zpq`(no9(LUWXe-e($Y+Axxh{_@-u%#U$5uy4qe@pYjWk_`%T2o5WJ(qmSA0vuZ6@c z_W@rc0j+j>!b%(9v01@w8v#bdEAu%&;{KD>gEF2wZ&7cfC;j}L z^?75*`2p>{;oY4r*{#3;#xZ??YWJmY>o`k(T^JE*M zWbcgLt$5vDd8JAOr&>v3lWwBWky@Ezk1<2pna{gV0_c2w9N_e#vTV4J5iPHYMV*VJ5-V>XRM_CrC&t^&JR=z z8_iZ9YX~WZlKC=H7-g_JLjpYYiL-eK7A7u+f`Dp*Dd{|yA06;Rhlcju@zP%268c?$ zC(KYj+9OCwUyZ<**%^ujq;cU$$4Z^`0g6cYwz!q|_SD@*2Z%m$P|bD?klnz$2eTo$2^ zCH9rN(q{d3iuvOQOi%eP_zc@!WwOy6;6y*zI7J3G-YSY zdFyk3_GM{6Gg>MS4U_$^cJ=F-Z0JVU20*K|jZa;gn45$oiA+(Ug=D(94T@`xgq8F2S5dG`tvAJ`2>tTx&v> z7R*CN$#&L@iPMRMHbO)X?6=$sj&B{)2+9a>R!Q}>D*^>DzbVzL4~|62Yr%_8(657# zQhBW1_h|^1V2=z3NL#v|J>@TIQNRkQ|BQ~vnE{l#gve4hPHgRlTC<`E77x7Q+8=Go zzvaOk#uVl$6;(zYlPYN_5y$U%%X*g7-?{~(xO=UjixXaNWmL)9Vp zi^J)!4#%?J`XH5mep@~dQU)dFIAaJ8?4O&cAoDW74hKB_j0GoDNuy;jI z$*&G^*xD4v>&p3lE6D{FJOZE!*A?Lj7g=`hKUT<1ZBY^y(p;*s}LB?Q-T;k5I+PZQp;#Y~X;o|tp8r)aj z*y0rYxArUU8MacLT>r}@%=&-DU1^csz;Ga}jQ_i@GL1c%bl7s=V^EM)UWp9fBeu&< z;6Ot?TT7dPr@Mp4NJ3Wsn@khz{Qm87G1gv@Y#4hpE82~C&XVKik-87!l3J;=LVSYn^LxYgX)_Unms}E^sIi;&G*OKtONhhJs8UbsK8V}jM!hH zNsz=H05rvQ5A6E~RqSW5B>M-W2+?)i=lag{?1w1S?R}y92P3jR%aTH6Q9b|s>Qlqz zQgU?y$&-93#gw;rt(EODEj)AO`IU9NXe z)%Hc`z(PtoXvhK9`35cN+5odkxnb?qtY(T907-6}B=DzR`o&BDO; zX{z;WZttvtRCANMD3kOMvrbFwob%`37Fm^f;uxwS_u?4a4u*7ErEb3kn zAVndyVIiLcRKP?2QH$(A_nh+Rmn`!i^@e_>i}N_5{T|1E$jcn4c8l;{hq>>H3Hu^x z0`|N6nN=v31Qh}7Mj}{Rry@|9&_RWK?za4ss6;(&YWv{0k!wi?>lKDg$dII@EVLY6 z5a>1Hwb`!GZsxhUAE@<|!QnIE^uSLXV4=KZa>7`arNIe0aLIk}K1i48eqIfbrblVu zdEZ{0{zEw`qVg*l^Ih!}MUoc=UEH4_K{oG-Vr-@l*LNUP0L1qs9;1Y{DQJMZTBXcJ zTkXMU?)_O4)Zs~KhjNZ8fsMZ;`T)g&F4owicx!g9Ov;VQ;FyYX7q3cU;vx` zO1bvl1*-@Mbt_?feL}^`YH1fl9K?#3PzlBA9HSYqUMFN&i8m~Cgw?qV6-?d$`A`H3 zQt9e9oLXRQHV2D3E|KLzk*MUpUK1#QfKJ8fUyU8>!)%f*Wq73 z^Je3#&ai6oU@O-M?*B_MOpMq=G+24;NyWu$qjnib3Mp=)+Htp>aAYtGUEV--kFzAg z%8eu_J=a#SFNOF!G{O#)s6h@*XH#=f6m<~j)071R=ojvMl*5|ZK$HeLAT*1~1WCL~ z#s=H8#=<;ZU{a(cefYGYx4P7NWpotZ)~lCsh_@9C^;j2Hj$48LQ9HSTp{$j9L#@TN zn(PC7Z8`L7(~UYO1*|+=t=TX>R-&ug5(urlLmd?JH*@Jg=_+f|6W2vY%QO1OX)PU5 z+HgL7Rb=+0f17M06c$?|pwpfBNY$o71-kxpOEQ9|Z(UNd_&Ow;z|u@7dAv(s7StYn zBnl*)Rm|#9T?>vLM@e4%G)ineN5?L$2ILlc7Ry_M7dL2P;>_!gTmL}IC@pK^=S&h8u-h<)eUKZnQfQLu_9%ClF zN`#)8?}tXX_nq(y52}1ZU*p~OV_t_oDLAjRo%FM3-r*kUUFo+%Mjdj$Y~A9yw)*PM z>g$&c^2VT@_E5MMWw^)1y<{81=nl9XhB>q=BYfp!XkP;rV4_~U&-dg#z;1oKt{C^? zuOo9+o7MmmFf88^X}Exu0q`&dXn=w}CMmHs^ z{O;i~kG>9D02BfJ-oq*_zq?R_J#8pCLDE!Ag1tBnYQpBt*u*yktRRLB`9y2^YNkTN zI{XQ{krvbT<;a>I&xQ=+oI$77T9qG|KjX4}O3BV|o{V3=7PoOAba>OkQc!_f)0P^M z*RYik!+_G=<}%NTyK^;cy6*RG3PWU943w-?AIzmB0cuuQ!#mUa(MXNfrxs&vXDs1U zshpf^a0)&oL5?uoSc>Bzz+uhy<-Z`F>}WqGfB!CKde?O33G`vzm)!9JUdFGu=to1L zOy%jTlf#+MSBPG3wXs|dBY3PMfp7*Ygc16y(Dt5tx)p~Lq#X)n#70ihymdVU&u#;| z>S)rL4A`*1A9OsKL}JHQH>?dNXgPvzx*bMlu<*@(hT;{;^&;FJ!SZ<47KIiPytbzG zD$XT-J(?52xt6IeX9xijdtvv26gnyMV)e`OrS%i>lN1i0DwQ0ir#5i)IRE@&D!ZJ+ zKc<_Y3lWPqv_C!}wj?C0ARHR!jlqSYN04a)1Jt%qwCW**-?O2VIgsH+aPo3#7WC<+ zdVN9n@4%`4Y=4DcE{YuASS)N;PR+G+T&7<3@_&`{@7x;icmE_JeLwyo^o*~H>Q#8! z5R@O=-S8|(*===7iQyZb*Yls7Ht>^jp6KA8jlB1gpOTsTgz>JKwVCCo)KkOZ5QtZh z0W8^PIGj3ECcJ*>nttAmpZvuO8{b&G{N!&Z0-um9+fV!p3}lYjA;_V3lR+~Vm;F7W zL(g5{BA`gX`2+vYN{Mq}Qn}3XRRW~*2a@Ab(#Utft8RMsm{sKcp!4TnJ zgF>SDZwY$_)AWZE6H-Pf?2lrAey(=NGcoyv^lIdq`t5jstcx7cYx&ChekK4==GYbR z@a?!&H$<$a3CS4Ijd~fxoi(63*tOa+z)<4XD4xGEpsy}C5p>$=8GOW(>=RS++2?4D zjNeUZ&$htsh0=nGBEm(#`8l@t1y4FOvK2Q;%jRzK_3YR|SD=!VSO;>3==q)XY-vJ&UQ?;_ZCfvyHEG{i2Vk zU+i~8hwvk$T&0-?5r`^S>^FK$c$N?AKe9&zeC^q0^0Z1Jy?Fo!!YKpNNyjRDrPh(3 zeotlFW)AtZ%BZhXNf2FrB8jd3e!d`MX@LA8T$d(i*rJ(lsWr25LD6xSo$iaoLR_Oy z$}GCHqpKD0fT+Spz1dhoc^9wxpn~h$haT*=SJU&N{7i_8L_dt2OL!C`4^ z8E%GYt;xCFa%i%}dg}nN7X2b1o3lCqwnM=QwAFmkf)hD{)G`B)g8&2(&d7i&utKK) zea4R}veH@AOA5k;aA5t|i&lQlFMbtc6Nh0GQ<|IDnAsHKz)K7FJ+Ad-y6NYotnOyZ zKv7s=lXG|5!&mb{7Kf)_AV_g9+Ntu=KWnrq+T}OZ_pRJi^E&}ds5Y^t|I*y4O9EV* zs^o)Yb7-A)Q7~hqjq1K>Yb>Wvs|@?KL<>>v%a4(h>xuoMR~~OB-L2#h+^&rbsWI2i zQ*-p|7rad3u2hQrLfNf}JP1!TRfS^)L9)yxy(zk8_3IsLVkB{Dv7EK*>*J9cdi#S~ zlx^{=u7=LY+9D8;tEl_Ck#3%3A5yg)+P7MITwEh}`}k0=C$;lJh`uJpP6Jl&^oz*+ zu1w9@X$O+C<&?%@tBl$|3@a)fagktWfQ;x6B3Uc-(sVJ?Y-nBjCbU2DBOfFZ8k6VO z2ng-`3aD>n7?3FA&^!ege={iGzC!I)I8NI-*TP0q^hqnAMdFO?JnI)NkdF8Dh=^h4 zNevLSE#>pB;H+A3-<0PjeG^8L%up$~Vig*27_je698kI#YYJ8>TL4b#A277dkCC%_ zXg(BFq39u8VDr}QO_^cJ{?86_HY1mWqH4v=0S#MSZ>18%;3!5s&A>7xipZsHBknq$ z7x8aOyPbZ(BFf+B8zq?=Hl>=dBo&)WCt((pz>Xn;##B7ohzwgizjE!c1gu67k{5V# z|07=+tXszomLZ&|Kdl2e7tHb`!FT9OvW-S4)|@b!WtPNWp%X2Zc%FctN>Q?5)AJm6 zlu?geX?04+F)1L5L`tFfkeptKsG$C36|vDZajsMVoMS3K@eIy4JL@tS%U)E1&K?rS z?3aSKHDYNx_A4^DXrX&jmRaxejG;C)0z1MYS)3(WhZKHg2ODI4)7p>NzHf0r26m{u zlWZ-vgDGSoQ?L!FN;moQ1NFIkuduD&O0C#coQ)vyrH={9MM-H_=G0QkgY)|;u{T$pKqW)i%Bt+0}Gz?8|MP>~4gI zT4lAJ8F~_(8SBK7f-KZEGg-cOd*xQ__*daz&$N~4=U5FfZ0)NZKMA0W-7@v}yaXaKmdTI;c~9@l$4Fro zQF|jxgd#!M)7>kU*C=MQtPNHj6rHZ#xeZX@Mta0EWbk+QToB~h$nUz!_`Hb$beu7k zL>qGSG^w#KF&WY;2O5nhUkd>1n2d~CaJz10MqPCZ9>U_gCvnN-O!wE3S9;HDKg|nd z@(x*+c#OhX-b;T#N6hhBk)W&X;`Cf1E(_ojoKIN)@d9gNc?a^ny!zpumw8j}+bv)6 zjUn@qAp>b!_jkj@w(Vbiq$5qWzg*Xn?cNiN&muq*q{HJKsYiVmn%96{UD;DadopXe z8{#yOUxY)HQ!$wBK6GjQX`umJ~=T&`oiL_ZJEneyGnbQ8yIV@2VIvpZy1tbRectLsYE@uwnTT>5EUhtftIdg37(Ut&&u+xgUYBY#2vUN7Q zH$pv|twvj(0|7kR+~wKQG5+s(Q_b>^wr#0}FMQwI4nCzJIJj`mGz|5Ycaxb18StYV z4Wk?d`Qc`GbS(1y^mDqBTp^O0^}=JV*avp+h%l$l&cUz8`%0PeG31<>oi9q7Qds*e ziyy#F9T=-rc2)oy)GrxSVZu5SyJwzi1BbPt(S=7$-MjgC_r&+!t0JurT)W5*1qz22 za}CA3)N7jn@-bMuTB4g%+Nh4BrESB-CthF*vj`+wM9p&ioKy8zR^9)9#(%xkVwS3R-Y@9258`)vM_INyrw~uNBQKif(?+s?B)=!5Cw>Dp& zlSO7J8Lfu}er6y_es1eu|KGgz+uqm;hLerszo9K)=9HcpU>d;W{~AtykntbJbcRfc zRA*4JA!tponBqD;2#Q41aMc5w=;ak8ZkG?sZtfOzquM%BO1TP!;w=4X_6P`d4S#Cy z=T{M*&9AGaE()ol{72fhIr)b|1Ak&$SV}0I&u#asMWbgi?>XCgA-lc_h5RtaiUnGB zxXHhYS!@7m&%aJ$Ae0H9LD9(b_QC5&a84P7kfI7H)lc;R3t|lzm?^&)a#zsB)DkOM z29Cj5)s~C|+m#hJ~*xJ$Sa(6_bA%e3k=Rg5%lL))zXH_dd~riQRo7{}RbY zzCawPC$ig8OKJSlLM{Xj&&V(^=Op9Hh?90mLQ*#F`- zXmbIQV8&`l^UuH@aFVlyhVG%I=U=>f4*padk}2gHk&#^*sp^>KYKJhEUlT`4s}eA& z0^ozKN|;n}Bl6+~{iak=j3ah$r~-o4CXFS(`GOO;Z?>rdaZ&I0?DdQb>J81fN~I6e zc-0S&5{di9R@EALf1wfZas=i#57s#I5@rJyzt0+G8~wsZ!<^l%jTYbUUOjXR>+EX6-YBhuAk2$VxC z1ZY9k9lx?J_`qbnnRcW>iWO{KbVLf2mL_6+{`|6KNwPFuj5*fpqD|v<>SOT(^-=*b z-EI`^LdhFFDXnw~Jmbb2a=Pb$jrVlH(C0sP%}XTrz`21mw>!!f(k4mWZJA&}O3c+s z#J&vs=z&y&w{FAM;cgcNsW0O@)wr*@_;`78!cpwE!xpF+5rTyIayLM>FXpop?xE~6 zUX5XL^hCY4!7~AHjpnh?UpaofKbQl4iV+2%Ga})z-A}TWg%`N>YJ%7fw&Rz?)bb8MBifZ>Jb*);_7*qYf zc6v_98Of~!IoTb`VT?#O=1GKYtMkHWxlk{~`+%sG>5Agyj=S^MPB<0tnL9wW#T_|2 z+v9@!-*`u3j<6eE8d>>2o~O`NJ>0XN{tc_+>T-P|M4H2^e$)Gkj%^u44%xj_pb0Fx zrzM5WdT|U9a)SdoiwC{|b~@#OQ{%#toP9(JYLnB#MUAov_qdIkIz2UVb(?7924*}9 zx2%FScl1*lwYdbtCvW?gn~Q+IWleesVWxi|5-cWZx@$vuN^9BoO}UN`&C(XpZ)@o? z9zhpm!S}%qhB&RY*{196bY;Apy&Y%fh9|kPpH5@4aCDpBrTLQeFPH5fETKlN3w-eM zSh=R&+&YQ_Vv*eGXrLzLV>bP~FJp;ZCavp#t+Y4No^`8QL#Kdfdn8&bJ`bHCcbFL* zndPvFWudpJnQQ}1r=Lce*$&B)!MIx=d>pKpGgz`xdImM0d~U#BAlmPUe6M}YSd-P+ z1Ztbn|Aq-Aq+A=vK6L2l7yC%Jd)hv=>!|0+j{De z%<|t56&p)}5)3t<3R};9o%62iUmqecEof6d!&!m-X|{8UNWz2ivmItfh;QAAW+|-) zd7ISN=j6|=^N^|o{7IkIi4zau*vrEHiSynJ0C;x%y!v1cH%rSH6ynvfH}5`fGeVn= zUvU=0npk?h&^T71yB`EBfAju>LxttI`^zEa7b}i}o!<$#Pkpe#_N>eJeQJYE)*4h> zT|UTsLsC-p94?N#TK>cr`8jjy`grTOtbnyo)PWxjq>5T-@HTnxuiPYCR?V%Y%6pz2 z4sWsu@BRFzAXTxBqr+4Cvf7Tj6ZGcagEt4Nzk7Az5!-mCr;Nc`LebQ-7!lqo+Fjo7 z#1OF^u3s2@aGC)NmVg!`ld$+V4$g@$X0(=QkE=p!Q&cv2J z&OA*9DbNncwdd(hj~$gA-Q5o9fm0!9iPuruyzT+ODjDCNEQHpsgcH?7fe1;C+Zlf& z82LcX%t+Kbi*;GSX1LoFzS{=kOyf~h4d(=k=TdH2Qhfq$hh!S;{rESv+ZZhnLPGr& zj99>Ro{Wj}QG`cm7_tS%i@T@oI-2(;@PHYPlp|b88pQWDRLpw*B$CXvp;2Sle4)Bc z0JafOZ11I*Vf-$fP@-42I;*&wd>mlav)jWXlT3@{P|@xxTQI;lUo&s9zTo9HMqM-W z6pwU)ft~;+Px+7TFRx-i2W930>*~^^zUw6t%Yrr_JnW{DPJg9T+!&u%OTBjGzY#wu(xNTk!C97Ap0S@y;0J z5*^O~{W2Tg#k#OH4!_pX_$KP@vvf`V&;-6!h1eu2<3rYh!BSC{lbCuAOBntysl<_> zx@+WDqY8SIVp2L}W-PnogEHZ9DP|}2)Oq<|V&OtBf7?_%X&nFuQf7F2dSVW(pC~N= z57Wd@vJx`;x)CN{P2Qy6W5*-iIq(mX&&Ps?Dj7=5B$7JW*%{B*0yqP_UlbUuW|aR8 zh}SJhIstxUUT`#MaLEgsW8h=E68uqRoU#Qo8A`8i!4!4C?vN*dYP4fW-^E6)Mm4lG zZTidU^YzIN*=x!Z*toq_ivb9ek0cb3HC-f{7UEar7%be|T=#Eq&kk;Yk_CR_Hq zx`F?PJepZSx4+am%1_BYim@a6(VBUOh88lF-j}A~QpF{=OLEMudqVEqt{(}gTi{IQ zqB}bni)WA-RIHMFLGhwuL33N512ZO|ItWrc(ZpGvOjMjao%d7yMecM|dB7z%yLVH8 z-QyR1GeTA$>f62xK8Q8K;$z?K^Y)PKNT9u_s1|_WcT3odhJ0Z%^9{dSl~>8=FJHUi zfA2c3JDi2oDN2GY;M|O*^VV}mjDK6;$j!E6B%$s z+h=?Vt8dP_X0!&R?j3+2%}tQKMYb>&k|Pz;;wu4{QyGBP^6}GpVD?lsli-H9byfaL zYlBi=hF!yd!swqLnv&=>(L^uTC%e`*nSN$jmzvl>5F{w020l7QE`}NLcM&>XCOJTF9u@;}6 zSG&vO&!Dbn;E_GnPwvzL8P2~Cq9p@v^Xut5ki`ZmmIWF5fHo2}gC!GZ%0U(zMj{b? zAB_i2unMZYVP~{_RWT+xUg$K`++MV(SaGVvWDsFFS`=(hv9}6fG!4`oQ)r6C>mVRi zB(CJj%13b0k+Lnh0c9;g=U|27j+fW3;+!F@^|*2uy55k0w8D%ywsQN0=xqfrllrms+U-O(VV*j3mvbnfOSsc_8XzT9M z`Yy;xgU@#G;qnqV+%R9RIFG65c+aSL>5ZC6K6B2CZtK$7G}x;8S`7H^x)G_h5;WL( z_FSx~^!efiDnStLQUWI|<~O&+>a=@Bvcf@7W!)M?%xVCv#~4(ivaaE>8Z0BDeym7j z{!VLPFkoP)@yYHSI@2$>f%m>zx>2)U~T%~&gKR(pL7T$w64>xb@q7ia`( zS?g3QH2Ni)7phHh*4rv7+Cz1}7v9~yRcvzZo)J{VMnCc;*I#^T(Bi4cwaTTy;dv5@ zYIEjGQY#0zWak9z zsJC1Ae7#wir&>+nx@fQ2Rx*=8wE&Q5sAhQi4F1@;w9`2Sw9;thLS!LKk`=5x5r7`2 zgH9_rgftH+8L>{uN@b$oaD|#TfMpMYcd2JPtIPoErTtQbXG9AtQqI^x*bhHj zJ6^UYVpILFDoU!JgyYc~FTNwC+zrBva(_NYD`ij47=6ssO*+Q%Q@_zaX=gs7-SyUzs0PooCrfE1sahe z^yi=7^XFisNsnQyCW;f(hMmU?J|^4~eZXNd&+}=XhWV;AU5^uTYu&1;*^7_rP(rxz zI*GrOfPqINtdRv~;w2;z;6*hQ{}rPqU6}*C-*TB5WvN>=ogHHkKBX(^R#oz|dn*LI#?SvP>WUiI>aFy-BgDX}d z1yoF)qhI8m}FCmksa5Mry zc$7I1hCh+J42{!j@X;ZDDkT1Lk>dHVhjJnHrpO#@RA!j7SR(N_$J)(MH}}HnTqk2z z`Wx?szt~_yP!FqiDg3Jx-Bs)jRx+m16i!yPEul=J?UnV*(X4s(MD@10hgQCqPjonr z&dqO7oy%x=tzP<3B8thu8D5c+!^D+P|SA`k%*L z96!W~n@TkTcn`Rdk!&LyK}7)hiIP`vPG7{0lm2RHGw0h8P(%7{;gzjcZCW(83+}7C zO|$Qk!aM8Oq*ml#WSC5=3R)mWtt zk{nJHv_|e!wA84>KdXTdIPvF*!C-*A_at+-2b>jK|_Ysot#M z2rq3wL{!TzmOY0&9AmATnthm=R!!StNtmeszRQHN4gD-B&eD0*h#)t?hyQT~>~w>EM5GLOQX`ywlzN%OF|A ze_`43!n6!V84|xbrphFSg1BKz-9@w}s6yE6xm-cmL@-86WGJL@j$L#l3OF}2P+4RT z-rN4C%lt}VWC(NfCwE5fnV&QZkteIl(Wv!zIJ0zXCg>C{zUyWdsGcM+uB-p>lMWm zIzS=Y*=*e|jQ`#97`S)MaLpb5?o-8C zsU5y=XN_SyXtb`jQ35qsqlBk!>t|SjZtwgzZV&B*LH#G|rSiBLQc=;8Qw!9pg#T!_ zqKvVtst&aA^T0Q~)uqJaBr-*w1E7E*Dr!y69xW|7SmHHasJxzpnKpmfW6ThDZRdhe z-J1M^ogg4r)qE^h8ABxZ?$aj6ml7F<)g_VJtM9|hTgA!7-zq_#F!|kX@gAuqFni46 z3>suAtPwzM$M7b@q&|SLOCg^apxB8xI@F4-@%r*H>B8TYF^S1>vTq_;3y^c-t38h7 z;g4xg*|~j{n9!8e;+c|4Yd?W)weW#2fmh_EsBPc(7io5uuYfd|5r`H?D^ChM1Qu;$7e-py`6!y z^cOc}MT_+nM%@y>Z=t=J53qbJzZ2$qF6}etm4wUfAHwDoe{2x?O(D>z61QdPkeQS; zp+43l=Nxz<6>sw3T_isB*tDJuq0j;jWX;hPOk5PC1V#d`w_oWZcce7H>5jxc%Dn)* z^9RVEsZS8y;E~S&l~B%HoS1_h91us77L})0z9~_2p3$54tx>%74VY?d7K|u!$O?5f zep5mOu~IwjMoCv2n@@1XjW)FEAJ>?nh45o*$upTa6*Z=O_x-+emuqb2w#j~QCLN<$ zu2wn)hQPI>0ZQ=HoTX!XQKEUb&cRL+-Zb6g=uL|tVto#r+(2cYtjf;h#ruUM4Vpar z)9wS7eSi(GPG^?t0g!fX=i;tdiV)s}ssutF~0M-wW97L1&X@<0Y^TBRlT-Z@lUdiS2qeQgh?2p(Rxm2aQ|X9KT9 zt|*XdXQ)U>b~ggmkr4rTSiW7>X?mM8(M0BgbBHYS@yRmJ0K9y`lpmf83r(Fe+3BUj zjfxp?|Iz&?6$_bs?M8EMgw-BR2=N`iZG*4TP)U>Ri4`3Pg|~Ddt}^5UWF3U%!nxXu zS0cdzL?(@4v8$-5Gd2uX;%rnkf`mhHnotIz!21k7Q0fhgTq*);7|~@>opRm;Y%@u| z_ANiv+hl?h1E5-HS!WLwHyi6y@>#&HE`!?aA2-6+D)H=6+Tl^6+EM?T*#q}?{7y&U z6$|A)dLD#w_1#;#tJcB^5u64*M#=!KB)2`RFTT4o~9_<5jFPtxbFYH?h{gb@k(WXvND|$JF7>M~Ee!#ta=au;9XQn1qa;nztynP+_MIS> zrE!U}YUH;|S^G;on4OLwR|xm*`|tdm!~U(Iz!K9j^UU3JeTsUZ4(u?;X1l@D+xTdM z=hAmSjs~z1^16jg#Q9*bylQ*&ov_s zVg0N_KZ|r{Bkf!`S!zfEU2O#EN-_dGo)vk6ZNRjTRPyJ>@-ufooJ0IWLgSj=Wwno^ z|DYo>t&jWD-O;K>4SR;z)v;wFy&XaXBh-g`0)4aP4y9vbD>a6F*K!n%I$-1DVX?yf zymAvP@86^#5}hr)vv)E-<-)#TS8~R-P(KUILl7rozmP^MPQo5dFi@> z5st6xI>WUonnUNh`9fjiTmgrtOv6CQY}mqiCm9i?*1olBhW8AA?P#JyY+~u0-qWBP z)?acQrwa!4x?im2P;0rXT+w>Q8b8=4o2=3x&vWsVU@8m{-}B4bE~Wm@Y0Oh$=dpw; z6I56GX&q`Sr2r(^MyN7lQMI?Tx_6s~+MnTdn9TqINhvhpA?F;M5V?R$3^>R*cg6L` z$ol+qu6exvQ7R@iTJ#7=Q-?yU)5bUDBnYwVc^mS0N%V`2`&uu>Y^| z=-RtlVh=GugHPSjrG}NMZZ}8ei6?acR;~+l&>l*t=!r6z481g_eCI;w`5je{&i@A^ z@5~q>uA1I^Rek=rYEYFxbR6mrj;G|Z(L_I#Z|Q9MTLov*;=>G`aw{TCpktNMN2oWO zTPOY&y)YiJ?ABRi7iMO_9US(F_g#xTN04?&>Hwl#`hQ>zrC zg7nC;6n0vvu3$EiT;9^rQhC4;m6RaBG2YeY#ym%D-;m-AH%$~l*+VzF= z+m>T1=A@a{xW$wy@TQw9V8wp}0u^m&M)`*D3arrDH@Xh&y_B^%;Jtpu-!-HO3^IVc zA*dfvEP=xeCc|44?H#4f07g%QG8%Bz*UhE`5dr=>8h{%1r#$y2g zEIj%Kad}X=ky78%C{?(9WA8xBJ@F-hXghn+aZJ>qua-m5GB9`(#NhH<(^%qZ zzG$f*gy8p>IIZ@YL~L_2rz6BWWP$)u1ngtq`hMb_P<~zIY++cCJa9*f=y8fhARrhs z3rKBWqU}LfMsUG7oV8vw$VB`!6PPK4;t6%+^Z5-UZB8P6U)$-Rh=q{4L+~~*c>=_1 z{D(BmgWDe1Tzd~-C>(bo0v&xIJyY)cPNL748~+1?F<4=2GKGC`on7!Gbuj=U+3RiN z4iEgIQB5xYi{?a+I9;)UYQ>ZTN0nx+zZB_rC4ViSLOz|Vo0fonuYr|MHOpG}&?nk{ zn;T6GC4!!0ZZgy7a?-sh3dUO9o@v)X63Pg+5_Y{0sH0QE*v{P70Nqh)7M{TgXy2Lk zqcaDW2b0M6Xv;C@bJ%!$pCjuWtdqr~K}^h`M(tbqc~>3tIIpLC z{YD30k}3+zJqU<8QXXmPt}7)Ao^9mq^}}EHS)>YVRHaqL`aJv54GQTldo?-<$xi;% z_F~PPytABgp0L0nbwL13EeeGh=;>h=@tp`lq@>d|8pd;~mN?Z0nG|#X-xl0+u#5S5 z2-|rT^noiO`rN`sFhQSvTT}%w!){g*!K=XEqi^}58l4OsP7)hfL}NAKrhBGpc(1eBs@U1o;e!*YtTG&4ba7L{HSLMzaIfWasjQ&MH(a z)nc{iFK8In<1uJx8L0AgD$i0AgQ{yve;RG3;T>P;b{7P^yC2*tSZ}kxa@$fKUTB1C zVD+UEN6mw&{Eq<k{om*V&`)cke*qppGwh%2yI<&KHD2izRO{CW)%~uo`>3>v!u~~wG_9pnJnQGP6Fz^x z?R8M48wPvSs!+!gCjwg9MGH9q-LcuTo8`Q#WwZfO;ez~+{k5y*E6?TG!&^{>79J0# z-#sStV?F>TvB%!$Bx<)8otHy)C|3_WSR=05EwFBlmdQ4&CAe3s<~)I_ZRXO2pXefe zdoyNo_jRNtLB-yIlXgJo-F4VVoB%qPoU2E%Z{6>dqdu(fyJuGNl8-U~QJF-hY4%$3 z;wr26B76H$mH|7>lZ(b_$Qomyhis5UBK<9RRX5J+LV%c6^r8bD-G?f^Lh=4Tc*;#i zm-1?I@AD~Ne^5@Rl5DQCm}P=kVSxvTPXL*w)Rw4i@k)kP{c@#MAd5s|b-k z78$_=Kl4KX;rj`LdpQ#zgXk$5HFEFSo|w_f5~sni!jAD4D?n@y7h8iOx$6@&pXnbBOs z-w1;i$|-<+0{u3W$D~%2#?3zn3c)|n4$XbZ@&qfN-*{jro)iLLUde*8b1w?F>KTbO z$BUQ{N?gQIfGYnHUUJ>i#sD$#83UM__8oxzy!aD_topb%fHefXiWA&c1Z9#$Z+mboXLST+=JHRgZb%BQ$MmR@*p`^v zn+-&{Y%Q%LOr9y=cg7-6g2;MSSz~Xe3)udC7|R@*!X2hDH1uX1jLh?e`_9l?R}|0Z z0)yES;KXdS(2g$n1I8|&V=U$Fw{xXj$CWnXy*F4}voE_HreH#o+A4jNli5*#a$Uru z5AORj;2TB8;OdgY=t4-g_g_95USUP(Ce{5KXpFlZ57#QdQr+Nyo%{)H4~j%Yvqkdb zNTpMy*<6o}B~7tqmR@#W0BP6?{?PYS6v4?Q4)mz%zfQtmW`6|nuS2x4h zSA@PyN8uLkepV(G(yKf5)j$Aon|<|@E$d&nv)Yz6rAi8lkj{Dgd}rPEZz7-&BxS$G z&znFKn6w>$uc3Dp7i&s9v+C##_DGnjHBo}oz>c0ijBOK82+ z*e5q_%%69lBdrk}^MZ_)dkly4LyA@Gcx|R@-0MND5dnkc6P&X8IcjP_-W0r4nq8bB zh%awT+l;YTSMfcl**=!~0~gq&1tshN@W-tjdP5HY)kHwGy}+PVLoN!xVk#^W)Lp2R zf^XG=tm^8e$Az42IB*5>1{3IYNN}%WL6B@-9X4Vq4+|WLKW|3__G(JQC3ZbO4d`@> z@VZ4QB`k>MYI7dQK{dDfMr036B19A^GqwoemF+)gsAce&6?z`|2t55C#u*+cI!n&P zP+!1HK{@hSInD<2ljm!YerGT5jGB3}2Qp)3`;#Z{YEZ7+2TF?dZwyeXF*FWi(%9n# z3%WP}Z<=`Xh>e=FuJQHOo>A&L3Y>E(z5-?dyee6+Kx(*{K`&>lC} zWo*KJcI=2*WnY-h4)b3z< zRM*k_4f~XdU9p4xogLDk-FGx4VL8rk|47-dIMUqKK91^$WSckS7ZB%^XI<47_R4WeeHnVMyH>iUv&&H>Lr~dywi5n0xm8L0tr9%1OlI+K zyNo)xlRJQeL61etAC^hCA078&;+z7nussZg>yPtUMMK8W{h4Ri`5KXD+WyaWRx!^u zd7y29AkYdp4|DHC{gn1!5wkwjS|ebfZ_bP^v*CFU4iyTLiFSd7;6j(ss%r*C(_=AyJ0Zm$3{&X(|QNdERpvik%-Lr-X>3oxyLa2!1Y2p!-+& z;(T4?-B_`@n=0s~Z-u>?h{S1M=W;=Y8YY~o1j)JC{>N9SbpaS6?lL~s89g%P zUeIoj(f@S3$WGk=vK12nJr&TIOzV2GcE6E-iQaB{tmZnK?N#pDi)GEob3e~I(JJ6y z=+vdV7A?ZIa}c)QPPNXa5Yk-bWfSDI?KK?Z*9rXOk&f(Fp#)a9-1RpM+1wZm*w(a*LX&}{dl|L?_Evt=2DRc7|Alw{kVDp z4Q{fh1SO&pZ~FY9ISxbiSQ`m^-Eijxla0LkhfKuUgWBF;szo{?6eq zl$FX~7;JkeAu`}UT=iE6_Y-qv zatwc+HQs4#|9d(58q~1gcUQXzXO-1>9#-3V@1T;`&^o)0r_$XdRR6yHS}pBA`uF_( za%P)2X<;I;V#;MBDry->24MKR>e&?a;gW*>YK3do8d&Dzd7md>-)xlWWxmMA-n4bi zE~xD;z?#8$n=SqEZHY>zzsjTspqCrXwH)`}E(@0^ktc);C`S$Ng)1+o=N#cRm2Frq zXF#l1Azi5VNpQDf)H%R)--76^mP9$4w@?E$2vR87ux)lsC83P00I1fy?<(RDuuFXL zXFYyJ8uq{uPc>S_9M5-NO~X+azY#>|$iI0jhR8n#=)G0sy!@GGSdmHVN=vkAw`I-> ztgU|aqKZ3ONGkH%1VQ_=4l#AO*8Yhf52e}c z9CkZ-)d;#96n9<40T5h4KRu?^1%()RecVOW7g_9ik`Y92d%g-)ftJCsOwY3q(T`10 zuU%s_>+)MymFp^I0l}{DnVgp!K1hZ$W0w?_R3pSH#Vy|Ah>=$TA_e!Sy%pt5%S6O# zl=!T;4k1sMObzLK@yDtHWnxb9Y|UliGm#R?S^wb^zmjqv3!o=|EnTY>GT&QXjW<07+l=?ZT(Ibyk?;H*d8Bf;O3nL_c4372wnfzF z8nxF3bK%kq#rR&%RNtLq@+XErDp+Hs-&YYVK0i*|z3_0|6&{N;NKPBPeyJoqP|$=Ol_;|kG$<29!;II^ z4B8h+#=&8|(W0|7xrYV5;y83!4WCqqF;U$FkgPuMo&u33SHaO>|wl=amd+lKKku`Cr%RZZyet8nwbwsQ0yNzBaSs65P!v6!O1%P>4 zPAm=%h2<6p!*dgT<`ib#yG0$uCac=9n^424jRSImFH_00cJS1>zc6u*{bUMb57^9b zL~7@fF7caOHo}R+=UgCZ4zQfN!EB%f-l5U312D-H6QL2W2dG_Q98M)6v}m>exf{;3n?H<`QtXylJ8@S_4Tjfn(<(Y1# zL0_V24Il*{g_&St^|kOVO35BWa3FL@<}o+qqAw3}@al<*irNoj0B)E+%cDt2Pc>aA z0^F4Sjs0WoR@I9M!kiedmPiYrvK0! z#J`C-VcMMYXP5nC!z-y$`iRX(H>C06az?SiX0hX@&56v&_Pia#rQcr{x=&}Y)6+>Y z^RwR(tMNV|r5bJSX|RH+GxzL9Mlg0F2Z) zv54xkeri&T4SdCfa)`yE*M9DXJwtG!UhZGiREj)9IE?6HV7(Tb&KM37LTvKK2Pj|O ztAO`SonUe(pg^}OX^-I2G0854ZhDlXC3z*RhpsNL&603K3r5bO~9?=Iayq|@` z=?iT-NWyevf->G!Ua5e=?}zx{YD&6&_v|MV@)7*qp>i_464Pcy^|~bY$t3zx7RVWH z%><4rpw)Ty*U^ax-dz$Hfc!7g7FX}tS@@XgV~JYFS!~wjt+0-}y$sHbG;a7XAFD~i zM9C|xy`BxVdAp7Y;A29U1JmCuMh9wCdSU`!npTw3ZN{uel>9UU18}Yvr79B&^==t z_z7AUT3gKPg}OaIfEWw<6edkdr0s-m^7Q#PB_x3~S25sXm2GJb#Uv$6_ zE9_0n_UDN2LYx*WVhShmDM>;wG00p58}A1#IGXbEY+6N`Aw zh6TFXwd!C%0A8iiA`~i9U{creY!oZ@J;-}h7@}#5rU0=oCL$0y1_OKKRM<;67F)

MR4g)jBj?Sq(oNwmKi`a3?g&u!Y|>pGu-NkepJGDY&HGdPTc=100i?418+R z=V$F94Q?#g6|oCg@Ah4$ayYms9&k2p$d|IH7fc^yL{Fm+ z&kigst0CQ6su(-~ka*6^GXzc_Y^m1s>uNvDxnYCv+Ni*2*2k2aHrAew)&y?buk(Dg zV2O-y+hGg{zapQZZpML25t_yF@$K%1cSGhnKvBEA9um~mP%sWCAct+?Z1!Td?`2QciR`%{RBn zw{Vi;IGMjWJ-7xgH+*w^ph15bX*pbMs^)IGoKZ=jyiAI z0X~mcw~HAeiZ%#W#L)4R`uG+O+dI)yrvJb1o6cNS)~jruDjL`rKCNR` z%LlP0pj!{me0%z)i^MD4-(aaL@7-RZCfsMFBp#3@cC7I26=N{G@`p9Rd$5qDbIMB# ztqxZ@qj(?=I}^{D-6~u{HkFK?R%5zNE@ie#Zf{XVtyviZcV`TG>mm2@-Vski3HkhNwu5*i zJwEVi0Dv6M*8u@%wW@2}pINnJ5}p7KrfVXMYNYPR;Ac5+nkhuFvM*0HwzCb*9}V6) zLga#Cwsum_edZ$68_nOEfTWefroQ@Bt{L6YW%^!pk6_O5ti&S1hzPIg-sJdQtx2rN zicZEKhXFQVz%n|^>ffdR3X^}``H3lOep9^$K47v#I++}Xz|A@q+pqV5cSuaX1&mF; zK7WMt7Y_rs2dx@^JD{Qmh6R?3fBt!%J~FF?l>oc_oZ#ABr&^xJ;rD7vI?x{z%-_YZ zWUTsGmvtsAs&s3KV+QJ&ckkbVI(x@Wf9%j-Tx1e>*5bFXEq}cV%&0?t>6{ZT zF9Eg{Me381=Gbd3j~Y5yN4Dpwaze5~Gh6=sePtXq={!|FuoC_I(HX&ee2vC&m9@t-W-b7G+AIG+D_zx5~VNP7EYyo$8mId|je=q;9h_m&jh0!RlSt z*g}EP*)JNkKhCIavyVvMkO4;e5Xg1_{T9GulWqOg@Spdxn&=@dK`IK+H|T=`3{ZV3 zMKUN)#w+lMG{>6EB}ED|NNiG2IZucasnehKMa>Jj8kFTEbjMdDY^ zEGCTgGcZigK40Y%5}ke;pkHcimn>0o5Fvl|T*yq%0$zH~%kEvMC%}OMk*!DEL<<2r z`!$K)S$ZqKQk1|q34$0|z`@{1Dl`_9*pEqA9H&QWn$j6{>g=PR=Ofrtz>{HlaZhzNt)>9hqHm`LV@Q789Tds&d;!RDx-;pUa zx=G^~>?lCW2z2>EE3=GnHkzZIO2tjba|3RKN~fSu>BX#+#)#~?LOC`ja1{aU+^=A9 z8;wAMMixRCt$=qtP-TF)TY(VY!y4uk+o%EUC@L6Q=Bc9tHH-#gL^>1?BR=cjuGa}w z$UKEkv-4nSRj)0Sh*t<)JjG$&QbRH|NoB&%1&tcEGur(>w$8CR6KLDkvF)T|+qP}n zww=7OZQHhO+v%7cb!^<;`_!$vRrh>YKVhvk<{Wd5r($9JpwYIe-ZbF|VbrHUx?@37 zj`Gz?MN#>xL&U{n=JmjHudJ`ihK3}NoC$;{ zl5)mlwrEuFIB-JMM3^vyKafBlC_4fM6$wsMrK+j61g64GFO!w01}|pe9uKwr5)QID zGS{jb8cL%LoD|NCg9zsNeADExw|5FYLqKpa=Xh}e^n6LMR(Zm46vNqyVk>Z8gIJ{-tP_ccfQJ!>0#>i{I@(CVT4@UiDbKe` zyaC#W&?19x11L1qb$zV4Xs$FuVdY?%A_d0#InL8FAC{7b6$_<}p#s0eKW_T(X~R{X z(ah_xvt;-l>s_%k7B$e)P)=tIOswxeFo+JDX<3uCSkBpRwVAb>uYU6+8CO$#&8ljB zi)xohv&k+RnA*bxGs?-y%Q*bT&?vLFxx%6zpxI!o1q3@hOZe)NAIma3Ewcg@sQp~1 zN$7zFG{SZGk?B4Q%IR&ck8H{fZOA2W>>fYCly1NyREi05KUO^&EG51p2vlZ!LPn2m zx(H2T))B~4eE~^iST2XCy2&uX{Z^gH8`Afb6vGJjSUHV|1UV|(XXinJrdi0~K5pEI z{WPqL2MEuj_V!g|3(uE1eGoF&0_VZ_X?cQ&WXcRrCleqHgT743I3IW4y(Z0o-AFQL z_TnD(qaTO|xMzEdAP2;{uSmhx?SehCkS9eMYRwR%XmvKshI(NL&Y;rS$ap@tKt0rj zyBF1OUY2F76{`pFR71kFtYA2QwnGqU7~;dI0&2j8%1_@a3R8=h9%HbTBNy1o=x$es z4mLrC4U98^Z&ebDha4^MA@VHt(1F^%51s8{i~B|j1HeQE;XRC>@@B{aupCJyIpKxk zVyus>PGh49~fk1ScyDS#25uks0S(_ zp~JfaMdRlmN^G`!J6_2(HQcKxse1NX8V31-vQrurc}!c+E~;7}Xg-!o{b&30?73K; zq9ZZEC<~YxmRHGS<_wbZFnw1 z4>yP0D6g`*Rn-WeC060dn$88;b#`&d(t>+?r)EvMV*k$Y>wWTO>PtmSVBz-yViRMG z_crr02QsYAGvxMCk13}hue(hg2D>Y3e;W-pBp|QOp+4Kr0}!hm0A@oKxSYXh7mzl^ zECCCE|GLV0&qlg9_?^{f>j_Vk3QkWto4v){W(1cOPEHCQuNW0){x$eGOx1fw;Q^_m z#wvPUZ}FRaH=>d)10$5XBMRl;Zm00LHIH|40X-V2% znc<)*>P!l}9wZ<}1}9idaJ&uboftdytfJMOmJBqx61vcBq&8%%02wQQp#_KikfkL=k#=j(U@q<2#N?$ zEb-Q`0es@^rq>v{V4D4n}JGFh>_21hskRy7MlD!8)F)9y$a` zqtv4S4O%M6E+wZ)DY`%U+|cf_WkQ4zk(nfD00s>YJ;5xe!$lOb7kU?&@Vyj7`q9gH zIfN0*k+(40S=sc{Ls5H#)39D55A4ZG;p&8>GZV)rV$gv=%O!F2lLxVqZ<=N#R6R~6 zSq#J4`;KCFBYIMK<1ur<>l`qMcftGX#d>ICjuSozWYQ&!8^rZC5bRA4h^2EN6iRDh z0NNyShY=-#gKbU_kUf!{A<~^ZV=F+XZ-HCGxN+53?7to4{`J`BXX_{^&26SIZBCuZ zvEE~&Mh9XIeGVhu4nN~S;Uw+WeMCQ&FSD90O~Zd4x~RMHTPNb+8vyrGW@aKGNpWu8 zHWVJKPW45kG0RvH;Z!S@anAz(T6?F80Aaa-j<>_L-k-0V%dhnAAAisI6^GkBs4l?I z<>}4k>34efZ1{^Kfz#?Q9A<@@AFpdsnQ_5|YG%%;w0%WWN z5{*hqUoO*OmSM?Dl?y>aBO}9!VCmO~3_nJqLbo_3i#jDk$zJ$0uo6YXh|al8kZ)6E zso`>scd6t;hr!c~E1Dh-{DWXvSFGd1msTx^B^36A20ZXZ%)jglXrueFQpAp<1q;V%-{E9F2oXpu z(0+IL5d-bs3h22~LEVBL#a7OxAzpP#n@)YKrM3zNk}aX)|LYl)h(#=7$+ZM1mvD7c zE6Gv|VyV1=T&^WF76pDlbxP<6GYaHGMW^7$T3lsUHOLN~aiOh)81W3p0xFf+R#PJF zrGQ)mBR7jY3-uujWO@?oZHpsyfof(GB~s{c;i6@6ZM`D($_0s%XDqZOn*LlpsH9b) z)Df|&Rlmxdh_QOfg-Q}5_ANQlTkxo+Cjh%By8}OFHbA*fT9nj58aW9-M=N?)3=XL3 zHJ9j6c*D36VZrKC&B0Qc12`Eqf0vG)aj+>2sU8D(RR362XveS(=%LZX-{0N*3rb77 z=|ecO(2*CGKK1R1PcXi*Nv>u6{IRUHC7B7063dW!WE}s?Z~)K4AV}F^B{>cU++%PA~cHz@j5mcGx;~(8di2;ZV9-s z88M{^{Tui3&1BSsduy(5l-+$a!GWMm4qhkdSdJghKmL9E1%Hq2a5k zdbMLcL4J)wk!05n14PE-Gv^e4HpYcQ_2tCtOqUkIA~$wWzR9_5+wyEH-w$*RtD59O zhuzRanV>}stKN5B%%0)X4e1k=@5#=s?$rJE4>XoWE9OwCsiE>#oT8x}bD)5FznTyA z0Ff1+jZ~Fw{H%|Y+Vz)J5$N%rTg}Q9KSlEEeCZIY7mZ(?0=zI6Y~gGp0^xmOS-1$~ zU0+bjfmE2|J6%m-my*}XZmdiRgH5H7kg-v*(`RO?DA8-vnU+m&lQU#f-YNpwtRsFE z9=Z86xeeBHVt3G+U+LfjQQGuvDE79~R2bvW-3$i*(TwXQX`l2=!qT-BV(D{Dt@KMq zi`S|(Ybd{S1guor3GSdBFvx_gWgQ;oYOwN*PYGfSN$!b&n@1Cg&U@s{+;n^GM*=uN zzHdIj59_$z)s<;qXSsFguV5R~hG_-v{SAzkp)Z!&A2%65t}oqsLZaz=yx&<`H*1%mz0+dFh1eXHt@o;guPGr-?$%c=; zPvA}vYPxePuhuUeJ5XlP=c2^)+gy@q(R*a7S@&FLuAdG3n&}}z$ zRl-}Ye9KqZOzsxec=g)!DSG>;Zp^H)x7+I`tAZ4Iehg1_$hhrvoOz9{OWF>mSc1zg zalGBk07wh;-lW|qC?H#;Qxm#M7qqY{FpwLLrJd1v$Zf^i3wjbA@uk&+Bzv1dLS}7k z7iB)m{s)Anh7NIzSLD}ZOns(K`racLd)!VjY9xJh9R8qmw0?e@E}N3IJZ!V{P~~mJ z`mAsn^wwDv`Y!ROL2G`Soo39Rv|y6-WucWYfHnNvh*+xO$2Z^E9PSNp2k*2bq(WWa zT%{AALk8Ysls~usZa%1*GJlF{8k|8I7N$tBP1QkqF@*K+>s#5V+h6e%Ot&J-e`K&H z1!u(mzAAMc=JY%9F-SF*D1?^-FX&c@HQLTf;CgV`@%YYF{Sh5pH<)Bhd()*0%j-r; z2EcgJMzAhK5@Jd7me~a&N9&gcuwI~I{&rD$)n}lM_ZDqn$zNB?>i(M$m-m4X`TEUM z61I#$JF&53tC0xhx$1|2{EA(BA!Dr$YoAS@ffp?e7sCa~N~gP?Wo$Lq$Vy<>_M9i* zv7z5rNG=e*?W+%BMIBg?HKuY4d?_AM&mE3mWm4$29-^Sn*d;Gg8rBYz(`W0(=AL?Y zT&ntF^lIlzdd%h(=Y5$6oo3{{Fcej6^qxwm^8qJ z32b{LsKgsdFIJ^Hg?YB_(U+!s@A@ssQ$T3a*mDlO6MMG7gs%5>BVxy{CvDfyW*Rr(PTT1_ zJ7X^aruCWTFG{9urMIB-;O=b;1G~i}H`9g6>n|W8zuSE^(>Wj$kJ@Y$;2yCIEmg0+ z@YJQbxJX1h%B&G&m8`z;tKbU&0=AzMRKLnj*^ZF~k}jbZenC@`}~T zT-&!9;c%}@BuIKysp7 zN&o$!bRE{I+?PX5WFt@zQS1xJ&S3&SQNsGS1y+fD65L3^tHtv9?1xA4C)i>y5)@+< zF^9Bhcso*{N*BlW#6u1npoF@MvgRatwe>e`%_>(U%I1j{z(S6(2+=I%*2%EOM{ z)B(ZPHx$p%2A8%D0Li!pqN3+-w{`fr3`2oiql3dj7RP>BYl77dM(PIC^PXCm$6Wp) z6p@DFiC7Oro$4_V+Y&-Kdk$h@hms;JTdSo)xjL;O?p5Spy5Yj&dQY$IHMi*R4ijM8 zCcx(_EW`dMFzjY8bgWyJzBQxM#aQrDQKW^Jtvh=+O4|4T^Z4S(95HUz0& zgH*4jtogZ;YUVPYH8`&Vt)+4TALmy1mlxeR=_lUhU)h-A3W5|%JY-b}Hp5d!;Qak@ zYO5LZ73Z&9JaP>EnP^VA@x6fc>1g@dH`93g#X)V5=M%`@++31gjK$dj`^zui+p6ZG zN@O%yI86yzpLNq7TZ=wh~f>OR$|zKjC6yGb$Q=0sPEp78>O*}tP@D;sKrnQ z8(w4_&`>U)mYGR0J%TkcNjV`;dUK{BywEBFwv-#+&}t*BCCv)L#X*tFgc}Q;ke)8;KX#MrM`3~))>@k6*I9xh z^*hC1_?O`GN)C#9RS4OhFm8))+6Z144g~EBU@;vWq8`MWW~~A8q_FIq9Gp5rL>2W+ zcG)bpl@pY!lHtvr`?TbBKJJvG&^4hjE&DU!3Uwc9%1)IGo@1YhvlJ^G|Iee2N}?ha z4zAQ~2&EYlEC>?>-Oy88@7aQO?lAyOKtb<2$|xArqmIT^0CUvSP%i`q{{z;!Pt{fn z0Fl#YH9wy)OB#0VVfM3VqySPJ30sv9OTESbr1>kAJepVj%ruS;htj2W#^$36#uscd0SJ=9fIe-|f)TVNEkY0?1Ymq8WhE)gkg0`Q}hQSi5Dy zc17nhCCte;oBVYQI;C*^Ql%X8C~GaEo>qC~s~`^ln0E2Xzs=5+pVh6rFJ;04GG=cA zeFE+1lJlbrZS8#p`u*ROmn1K0{Xi3CI(;&v1RDGPD9;tnh#uFC z0EY-(yH~R1Y>8~D0Z5(DmVd_hC$L@m+QDo! z`3Wjy>#!3R(v)dFewH18ziDlf)gln@S%B@?_`wR5OP407sOY~DlyoI;;)5{iyyn!v zy&)K$q^~NARb4MjG&~Bm7n`2us2y79Nj$Bbh73Tqa>3IowIe74qr=XLm4^Ek)E8D_ z%xXG0u+dB8i%7(%7jLtw0XaushYM9^BtoQnPTxnL|C94~0K+{%lI|VE=hbQEe5=IV{838;Kxgb{@&MI zBlH9s}*DZUN^%{iIQNNfOIU)raa(RV(>@KJz~Ye zB<0T`YD_qT(S80EMe7oJe+A?!F6i<-)We+Sj;;*4hXZi+D;AYA&iBY#yd)OWodwv! z-}t-z?+rMHke2>8!O8lc{6n;K%?J=0fX2W6JUdd~hX&L+QMX`;qC;gkJ`AZ?bU}IV z=s(tGN_qgPy;L0@=+_=j*>4%jTSid;ID2@^NspoKETN%%Bi7 z!lfD)pMWVInM^(rJv_jbGS|MN5jOqxGHj6F7xHIaGBL?A0Y~qB>En(5^cz8l%0lSz$T)XcqWW>l(<{tc&Ei6nL;C^%Gc|BR8L7WBkyK^$rH-zMR$uC(Y-@MIXOh<4Xz?|DlPC@cRY!E zjC&TNErzVbU}>prVuPiXIcOS3yw}Jy^bB(t%U>JSO+hq0=^S$v0^DWdZZW$0GIci8pGV!G6oHKgO}61_yI z?Zn?e+^{m$hRv*PAe^<6hetSK?HTAZs8-M#k=o;{%UyB<+tThG8xg{O20iM` zBT=M}tp)P8=OY*xfZYJhE{Rtw#r`edWWZbr-OT+Rt=yjj=`CmU8TD~e3kvcQpTinL zVIZ!t_^H4LcrIYNQH3-FON42z8GSmRTHf6e7K%e%#5bk5XTMWooy?r1Xc*L6y*5b* z5H_BbwDlJ1H6gvUDQmSSgRsr=lKS9j2WbErLu)|g+l!+*K)KF8A8U=2!gP)MYZblP z<{2cfzwY;uh2J&9r7}|BV1M1mb|`K=2*GytCqFA#is2@S0y+KyA7WwUJ6(A1uOirS z`4T?@|I+qRpBxw0Y?s}C0ZGG_z~V299pGd8A@xkB;e(;$IBJ{d^)|R~UJZ9QH07`y z`lUx<5IA2AfJQtuMtyp!p6gu>D6TY@R?54}QjD4-RXJu24X+lbaRFGt2aDdg%Ws|T zqGjryj9z2%f1nBhjrC>HI*#J^^5|twk7;w3NbS@dTe%X#`E2VpBDPCE$5}SddYd5o z4mTCwUDK8d#fA8DoCqh(J$lo1OFb9pH8j&3^E@&gnA7lXk?=Q$o z;ST%%<<(;PPnrA=Bge}1KbT-myZ>P1zVi%>48IqE+l00J>D1w@4(qVjS|nqPM!CUS zM0Iq{7D=eK-(E<_`XbYKDX#g!oGX@h?mEx#^T4<-5zarI@7$f7-srPj%?E9Hu{0Y7kTJ$RHeREVD zF#~K}VWI5T?`l!!5|*_Tx2>CdX@1d1pbVXw;PJbXLUlkQ)_QO8WKKu)83M*iw)MNmg5AshUo;TF1R zmMNE*0&r6DGEo|7_P&flEb{k4&f#A!zP6$CM;rGufHBTcp~894(U$GYiqdp&3QlfI z;kusgbpm^V*qDn?x&_6Pj*}T>g;d-J)ozYEW|aJzG%!o(R%#>j=s@6C?bau**u@#K zu$3{GvhAG(Jyvf011xPzx5uog*}nw%7-STAJJ7`M*eHBt}|5h8Z_a*3sR4AGV9S7n>KS9Ldn-L;AtlTUM2ZV~D(b|F-=fLYoD+;CoE#77$SDlU;`Rq_klw zX)-)e$p3xF@hWom&m)}5D<~jIUJ{ix8aYThZGKTlE28%ED;q*&4rQzw z0Ox;hkj{$1Tz*+#KnyRI;LGk_fBU-`@V#P1-XJr`q|Yh87&*E1d-il{&k%G8 z;jas#^g#>~=B#kpIY=Ddj0}q@9{UjfnL*w|mL9(}dpX(;cK~aFI6iw@^=tn)037Wc zegS~FcpxR0*+1U98?oJSr51N=5Kv#l`jzCS7+5%rTb`@XFTY_dmX)xA7Od*5y&$sE zvuhxM0#40LcGeQr0DD+YE6`iHnZPv~6xvh<_oZEJ+S2J-t=k%{_>jvJG>BBM>VRU$ z460j9hGl!*2@dV9)SZD|NW@kjz_1lbCQH(X{`-MoH!_DG$H0<=g#c7=CZU#``k~SvT4(EtJU8hoGTo>cLE;}D+`Yim2-J}|LqfCC1fQ0Pl$K=1Pcfp2s2kYu=GC>s}q07j^=-+A*zj! zWyRz!EZlTaWt_eceY%t@RbA<>F+m1VbSjKGJoEXn)tJ0Nq-f5nR@%m}(HK8}^3Z8y zSp#qByZ(XnDE@G_aT{=!5r<4V-+4g zLR9A2IO<9w*^eF7=t)f}6_A41FKDB@Z~7}4Twp+8Pg?fw-lHc?u%{l$WW~JWjAXq} z#_PT#_k#GSqCi(YDp|xmCg)gb$X+g4ukx!e5cXDWuDtEaj%p7ZblV<#-iu62@=$57 z|HsOSulN1~Q2edu=yJ($+WuYsO>E@PeeuKGi=GW@lYD*uDn+?ygt4bMfnEQ{t|3DX zv>$QF3|ta^szIjus{QaAdx6n8>90(=7rL$PXi_$!hed%iJ5K-m^0xoa#VPmeH!ChV z2)=V`MCTm7>A577BRvJz;6XC}L^rjkR|gCvKZ+3cSFJ`H!uBH&JkHHwZtHdL|594@*gS}G=dV3vOuE1 zMpckCVClUl|HYs- z@iorVIEuU(YeNk$a+CsDyG+GI3)!a_vlN z5af)mnQxrkh2xXsk-r}88dU7+v`}K@v8aXHNr0P2^Q)HSeQnX;rK~8<9qXCaH?{21 zHUJT4vmexG7Ty5)U=iEzM#(Ze=3nTHDtsD)%&yr7?_0m0ztV?pbsc1na-vOC+W7Z$ z*99o%$}^9(|BjyxV6RG^hwe_DfUGJQz$bA2wJ0KMVp;Is8{vf@m}f?tyn9x^0JTZZ z0;8E{!<$kP$s`UXJBE=xKBo6q@WGA#1=z z>4}%Ex8Zs)ueEN%e3m#UnC-_%GLzlm@gyVqi{fo^K|k86DcVZ)`)A*P$fGR?P(FiN z!HFLrdtgzZtnI*sr{HX93q0)>LdBv?`(UZl)>tclZ~a-tm|XGCQIaXjvq9 zm0mB3KND~ga&xb0pZdk0e|t=2z9}8E$}wCu5~)BY?@Jwa2m%kaib!1`C0>|e>oQcF zOro%Le<|Wt!WiFbX9QDE7uu0XVM!)IE&e@HKNt>fLp&JMUPA`6^Ojlxc??JXHQSsTW+!goOffK zPC#dT&EA>lND8_f<^JYx8e?1U=J!W6K`D5IOUC6etz67#j~)3MvTqZu2PW1!4x^0B z_}h7m=U`o}j`4(mPYwstUBMwXr$d+k$M8$L?D@KH;zbnvmso97nYt?&Wx%Lm^5us< z#<=M=G{$^*P|-1$CKzqwv^gX_Af@H)6zm^Pm&B6C74fCrXYnSqB-URBV|%pDz66;O znypV}5r5d{X)!XxPcE^#GPbkUev4!~v^nC6eyFz+X`c9=U^wUZ+wdd^vmf<<0?n9| zp+d-o-Qtbh!i`)DwSK1BPm#Fn;tNosa-=#5*fu6Ylki+mLGQqL@APOPfUh$Hizvw; zN4K6g0&7B#stO{MikE#i-t_AYuO6XPQ9!>)xq~*++gEwOVsW&rj$5Gn@m~*9M9T9W z22&_R!L3HO*f`Y&!38U;9^;%kV-6gmGl7pbQjZTVZxL2-YxduRV@( zu7?$&wkON)ZK?(yHwd2rFr$2_-mI<;HrW*+teL)6zWFy^xbkDUBPOU->R3k!%`?&A z(9O$z%caPb6jdOPgWl?)N}v8&XB>05k4R+z7+kBEXd8z}>$ zNK-b{D&eL7b43{HT+SWTHQ0rdRrLDj9#jiUc=5zd<*o@SY7TN#2qkz8_hP8(KyV8g zfj41mG*=u{!EFrCP@3IzB6BFYX+aTb$6;KCWYeeS@etlF&O^as(yi6rQvqBJZL#*U z!i?DT_Dh?gRdyq}FwnuFF#1@xRrK^J3}aRs+Ui2z!}Spl+xkk>Gq}@QTD(6-eO{+x zzV#rPBB&Q$<;$yr{bDsN*L8&oI$W9;jz=z=XG0T_8 zVH~}T+fSu~GT^b@w!rjV1Z^yFygq{eX-fSNB5|}~QASBxn5$w;wWZVoA^??|kn2&F-6uh(1cSY>D~UT5MA_`JNqLf0SQ=1Q+d3GC;9@$CDGYJ| z9L_k7gtX1z8Iq(A0zU2rX-vLXsfNAaskTfdm)f=XpX{G9Re?)LL{EXh0()aJdG=Z6Ts@!z8q$K{|OBp zH)=!(JZhBm3ux?LzfsSxhd zov$-viYd%8MZG$WSHFLC>WFbOQnUfVm-EBjP-jd&|+)c#JXtAI@gLuSH8 zx9v(m(>bIn#>!m~kgVaasInb&w^DCRTGY8N8;|4r$OEbKaVN&CrIuHVuV98@)U8FU z?#vyK1IW%6_m9^an~!hM^TzkFF)tWwlx#B(bZ$sDeKn+sKI>m?Mt>kOS%4l$W@rg) zs`;pd4MsLsUQgt&?X_TdQ@N*GTjgD%Ad1lek{jqtjeD46a;VK%=Q=cw^?$vU@Oc>4 zM{Kg+^C)?81CbR&l#bgpb|^H)S(k63~ARw7FkY@bb9~1w<^?R)5+AXsLqD0=#u0B zqC{eOMuv!jFM^8-)q(q34$v5qTW+x!^%LHi<+uXvKav^An>P&MYO$EYe8;fvnLs9t zV~E}Yn9vrmM4r)1IG@1B6k|lNM-V>W&kkr`Jqo~oAPeLi$(A!5$yDyh>P(YtbPq}f z)u31pVZ1_UO2|8g%;=&iV}{T8MDb++J>p1?*g}HHL8n0BlLVw-u&-O5Nri)`vKyW- zaCtSMG3A8V?W~?4Nw;7l(whswVeoiZS^c??xm{TD!Es~s=8jw~c(JV#2Rydevkg{k zxaw8;a}1j&GC0bviHIGVd4=BFpFpeI<`1Z@9GU+Arlv_3F_NlEa)OKmT-BNZL|x9H z?$ffX2<%;M<;^&8q_+)m=Mv`SD0M;)oB95`_<=-Hb@T${^R>(%xIa;_0 zAExRsl$9crQx8j9cN{4PKr4O~JoB;Wykpd{N;qoRqS>jYY}hvyY`Ri%U;W~UY9D2< z)%)TIkM+fII#lnw&s^zcm&N#XE`cei%7j?J`EdE8$(8Icxdo?Ahq>*!{$BpEmhohZd zcYF4a1s4&cJZB%>0Gt+{CL}1FC7sWJ_Lm{3<78L_{XHtvG~0l`<7`ZtrBbLEMX+@^ z=N;$%sx(iKx%;&=KnPz#s7ht)N!iU1_vu(dRr+h9fp7di}3{1_Bfq)U%+h z5h4wFLITuBXVsvUGq-IviY?bkZ($*~23v60a@elMFY>QBBujiX^fihquUMc*KK=F@GI0{rJ~mSTMysBoxmSGEqRHMbFsdj=Sv=n`7tdBjR>R6$5#84*n+R^+{Q}4N2gS& z^7(2mT;0bz6OX5n;0FvdOg$et%-PjRk}m9fYu-%T^1>Xcai=Dnl;iT0(bth>;p#LY zFuW#tXQsWrS?`li&^y`!mtDkj?#ZIykC%@QX77tSpxU$keSD=`zbn)6Q{&s@!f|h( zmcugQJ8YD{BX9=Kj|*-SuH&;WI1Mt&Zx5&Oj9+d+rUI%{St8NO%gF7=Lv8)}ge%0y zl1~*s&wzKay6EhIuYA|}dGS}`IATl(y1yG*V#l!bwvtbniGQEi{lOcC#JV3eOeP3b z;6qIv521kP&Vx?}jVjr@49uU2fJjX+eO%F=AYOmwP8-kD*q-qu&cIo9j87hQexMcd#xrO)J5nNwRS zjRApEsMc{nzWpYxwlit&0kU?!ZpUx@s7)4JZ9xPpFoPQ&spEyMrohmZgWhZg?Lie}QsJ-YDF$P(i;_p#^^%+%T&*Y_kHxYan?;}V zgW~Z8BCxp*PV+y`j?xLYdszb+I>=l0?{B*cI7c@SbV_V^;5A`KYHm~y`KjYDQUZF{ zSma8?h~uW#NaQ#At2D;G%b4mBM&qSD-c+%Jeh#FBzR9PkkZ$1#$myN*Xh%a_Z-G!Lc+w%v2dYwQH zgK7BE@0%o}TMQ!PXekD(DTXL*qX70Qk>P_ddHQ%SqRE)G_3buRo&eeH4=r~3C+3Ng z0kuMHB@R@a;mK9&dqyM2{uSfvbLZj!PDZ0c-}@7qRurTm3PO1_?RaUncHJ?_eQrUE zwerdO;$rbxi46AKH>md0?ipth-Wf0Z=T4*fHFBkitVl1d(+|*R&h22~Kmhwh0g0a21xza==?13$7PR`r)^PeQw%IoCqs_1_Ug^sLWjR84x7UPCzpEKOKZ z!(}UE@11J^&x4nHN@$RWUVfQAbOwN9EZ|lC*(7C(>LhXR1+HIw4`9}h4%LbELHTmV z5KiS>9{k>Ps>Vl&EXF*sxAJl%P6*b$docV?o{&TEm*eYT@|@5)kRkt}j;mxGngja* zWC6>$L15K^AMjbBbG3kJ^?t5cwZRYV_YlgU>ac}hK!5SKe=%Pw^>mhRO$FrD0jUi@ zMNhaa;-fy$iQc#61SsCk%nGq2`t7GhO0~w`bg@+Py3rtFQNdK8%K=fcL_CLp2V`f- zaSi0Qe6nDcjStKh+GXccICtfgKE^YvW+=_O(kF&f$!jxZPCDEV*du5yD&-cRX z_i4kN0m0b#4FNe2`}zNrAZGTa|K(vab0p)!P^1?m1H-2WQv8RAsX1+}D}l5#uknca z=(=8AE$Equbqz9hM;v)Kv>^h8MYX}q3CLG5k-`2GClX&5(u%YkzpUm~CI8ghC9kaQ zv_u?5Koh7%P}*#W6Iz0audLa@X>tYHuL=g}JzAOI!X(?`oU1s|jdmNVM_o6hX)F_e+j<)QT-0OCP+b2%2nbZ~y#y7+Pr6Jbi2y_%nShVDTM*MVpmod(6Y6GyhYoK{W8T)NM$dUb7jbC-4CRbE+>S(h=7#R zkS_;oXweN66mtQGL0`CTh;wunV{+VqRfzpX8?WkAH!vy~7i_eNHyGS@>MZz`wFM=) zhhseHSgTc6@>=LEeiuVn9WZB@!C_&Mef@C11?&JgG28rp{vcTJsD|@md7+lP9z8=O z*tN~$`!HbS(hx?K3+$E@Q@1yoXJDwC+SJ<2bD>`7%i~VJa(QDvcr0G$L1Gbowo3~A z@rHPAW8l~C`*8D6(@(#SK07n}uzoqI`rYCEG{47V+wb)&as`| zt&k4L7wFse+v520|C7G+(ZBoc`c~Q_9}}i79O=ZN8qab2{7fQiDDU$M>=p44<~x%2 zfu#%X#DL-!(JQ|qSd`+5U@N`4AQcZ}uMIkx4^rLAO-nwgS6xU_K5#xu-LY^s5JJ6a znwP1Bwk822GPyct%KqLUojiGNtESqwF4_+GIBh7#Z;ceilnb%g>mu(eV_Fss-}uRj zsA852nyhxu1M{c?jlZO7AbK`0H}Gzkc2(^8NR#wZBJK&Up-EiQja)l_*!3Mxs;@h- zc}U_N+12&IS)Dl@*bzTDM||n%aUi#=#MPgkuT+R!~UIqcrF8o zazYs$^q`7+E~(^%;j(RVtI-hP|J+Pq~ORg%K4k}ufj+#@bj_ND1w4sW7vsfm2 z{wMP5+f5$17`xSP*rCUQWkVYxw zeOTX{zWwaJKA@leN?hy>-)+gq1FP$HEoo3+?)QI%Cu-5!Fs`i)C{zT_0|a5h+#jV7}sG{QK5it~TWvNy8 zZ~IzTmx3tvDa^3i^!#DnxeHn~NcvPh0L4cBj5i)Tw|91g+M^ols zAR#dbaf&xDjF)j(=`%GqDiH z*-PO!KOG*n_fL*9DL0P%a_&r=+cv?X-VBp$7J}a#$2dX{Puy=Q))9~MOq9pAb3+OA zd!Us|rH4QSrVV(v0qpSg<_WXtmILO_#1N~u!30=v{r;2KXqzr+J%@zuM(YN+ z(BAcK?{2T3Eze%wBLg+lnd)H2v(VnDqs--I&z~a$xMU$e65CfqlgiE|#j*$3g@LDu}_@`e9hJ?=FXXXO zJp|6S-px>8zyktF&AlCDLz_wjDwu|AeHr##YbW8NhmCrl#R-1W*)lg=qCtZUD(>WO z@Lpyan}z3p+XaUy^uF*}Qe-jABv*?~tEgthXIhBuSqQ}>-H=e)kbLArC_d%6`pKfF z==W%*>v>jQzV(g&pfDUvS%k+~H=D>32G31(6Tp=LU@EdKgwCQAdD3PAoaNY(!y_5w z%QiJk@7!Jt48!=RAfXsO;!n%g+(}FBV#=%~sJ@T&AI7HRe^15mU?SSzaVJ>zH z#@1q&8oJiejnT&<@xaNnf?B#rRVH$RU^5&5;BeiOh3hH@Wf)H)CVlQ3f(Rl_ezu>3 zLbm2aob1;7ld!#jOmGGL<{|-j7P8iL@7y7^`g?x3t(6;lK$9C=laMrKhN%F|lJrze z-tVXzCj;caq6=FNacsI20kesB>}V9ZRyXAxChVpL?e?|XeT3WA>Agq8{y7#oPUmkbG3CYvdUHt;5Q&G4Dv}SAeiIvxpyy6 zl;@dmtD6&-fY13gkg2uOO4Ba0hL-Bcf69#YaJXen|3rs35j92d9TzZx?Gw2M3QjM) z3*oYw;+10pDpo6la+u$a#Wio|zf&&(IOe6~4n1k?BGb4fjlKgnDI%*b7YJ=#jv?sIG1nV)VdT%D5G+np zfROO5oySgM6jN;AdH>lL+S7EkUrp!hy|<`#;Kep^PKKgD5|Vs@yO}Rqsww^vCGb)p zoDC6%TwSh6K!X<{ypU!I96^Q$Y=EfAKP@2kc6py>V#E)HP{l%#=e$#K)Z+BsILR5) z_Qp;j!7^(o-Zb($-Rw?PPV`reY0w)yUHATizzJgInV$YvR{D^dg=R?XtV{IrdpB~n zsFz_mJ?T&tke5Lxwob?GX7)g-Vw_f&`s*qLKjgaxXCyAHTuCSlb4unNz#C+zx=AYl z993=Jrqi9lJEmQV^hFvJ>ti?Wp!jG_m4oc~0vw7484H{t>wiL$=U|G0-e_$R60)W_ zxdLP{P;~{@M}DWtf8`%(5M$3~$f)O17e-D1apXs--oQnr96A)jn{62D6%nQ|S6a*O z

p>wld2pG`wv*%S#gmIN(Q21TS!*UoN9?9{%}Pd1Z4HaXN&?aSE>ztrH;UjArUw z)7JiD49aml1QWGz(p>KpI&F*bVN%yNbo!B*$kgNU)F_~0`yxto*=tVMZWJxP@9`G2 z8N#n3Sd7RSM`vBOn9me(I&a(28;svy=qd_ZiV^$dETlLgHXVv5)j3yKF-?j;Zuz%J z=h{^;wFNtRRvi=Dlet^>Ffy=5G_8_-jKoo4Wr*x8i}NEmk0(~p(lMOZ{H%U6QEw>q zKI#^c;|J*FV8bA_br6&soREoy>HlQ?ZmVnlhpY8lt=((OW?GK7@aJHj4szy9j472g z=3XO(DGje==z$BOc;!W&S$Ql9Zf;Q8A9(q zN3SpJMQO%d;sngn&elh-54@T|+`Nun#U`?>UR!X-*w+(+Woex{C#XNKGMxgpq9X3C zJ^9gFxNvxKuu73*W79gCuz+J-?@AC5t^3OH^5P5td|yUnZ#UQC@CD{Bd)mZJIMQ;X z{zw_??8&0MrJ^dR^LTP0?U9vi(34QKmFBQ@Of-kQG|3&9=P z#m}5umyCup4^c&A}<9_{4IRW6tD}u{i;be#R%m~B13O8Y2AXk7Bn+1#=gug z2_XX@Y_Y$Pqk_Q_EwqnC@nTeoq+O;iOeN*(q!yDt(A~2?K5Gt_-+ut92DkkEJyLb0 z4g2oMSLI-k-C*9bBRk3YMeC<7fmu1h1m)B&gANJ!RL$BLeFsV*3Y?H$Oa_M%( z&dKAC4VDqz0+4`wTW^)e#nz(CROJe%)8?j-P0)2r zl9lLtSYjPtM?;hDD-%$rZk4ekX&DyYWvU63CbOL;AC}X1FW?2Cfr?2GF>MX1`Of{f zC%!=6drEe=nT~7B*K=w=K+roV?i3-_8MPJaVLQ2;C*IKaw0k}8%s zZX~lTx_*=+*}Uv4N%tKHOr*{WM{KCmk4Oshp>ICBQrNQ;-u9=i;>_#bCbF2pyST~g z1+8f8V)T{0kTG&r+9CEKb3$xEEO4&@gtDOsSIaqH74_dYp83&Imv}Y@kB7shAsJ3Y z8~*Nv(EzKjGa*1LATA{_$nr9{is^n{IzxP<`#B|GX0ZguvHgqrQh$THF8!-&MMyx- zqiLqhY;#XUu{nnQGgu37_HMpHsP#C2T}1{NfwY3SVqko8_GRP3cVNKA;vrqFdp2If zcyfNWiD*V^fcV*f`wP2Miv=9s4!kceEglo2uovOmZ3XbCd#Hh1aM-!!5L~y_ccbKN zblk{~1L>~-TDK3G?XKBP4AGfIe$2}-B4=R4>R5e-KIL@;O6vHBmqcp9th`OMFt?-~ z+4im=h{$=MuL1Owi>Xi^2e7v|^4DLMS+(ibgp1)oHl)b*l|=N1cK`+^Acs@SCywl9 z1lIzU?f_uZsOn^-DT=F0<~n30j8#7E%G!ce=3tVo+d!ptL+!Pts(@-36&Bv22=+^C z9)umb=v$fm)|6HIB!oMil$EFg_UfK6vs!8hbk^*Wz4Rz^^x0={wSJ~`Jn)3?RFDUdGIFSRr~pH|LLQ^ z5x&^w)j;oZvKd{X^TUlBkVH_P5&_%U=@1i!1P2EFi)iB*h}5i9v_A?ikFvAoKo$9X z>Wu8_@$=v-@18rH|3K`@dKq zRFHq40;Wo;e^7@0e`Ml-*;2-LC9E(s$rPJ*K_(XqW}C5&d{-E_%ee()+s1qe)g+Y8 zTtD&qGL4uFO|$Y49tJi(<}h-a7~`2y0&Njj68 zvFWIjDOaD@%bwakM#HI5%I%gke$K9*>*XIQ$4?z(8EzBRRNB>>+=+I^`x*osfy)(S zpHble^Xz*xTi8H%Zu#Sn9wHti>G4oP=y}OR-@QRp#@yHWsfg~1KZbkN?BHkyJ3XTa zqo9aZe1;eDN|mR7RQ3Y~wfmW}UmIDS`v20D)3o5l6p-E>EyQsBPF9eCG40(43dkE| z{M&MzPHEz2bso4%SRQ*SfN9uvNGbElnZ>3C5c@Hv`8BDP5(l33T%QEpS*sbwZo#I6 zv_nv;JNsp;Iw!4V@MRb=8fKI3)g&2$DpPkT>!qGpVP<6d60*!)`s5;XsV(*EpT_w2 z(JS8D;5;Vt0h{i{5Fw79_KY;@+3k#}XfLk4``U(`xa6?=pyWX|H>kFcb4`li)&Y$a zAZY|Ay~Bvtr>m^j{P%Q&wd*JJu1y4Z^+vprYLjpOc%T!h6vmDUjkA&l>!X8#3# zi#hjhJFZx``{j&*OCDKfgH60Eu!kYhX!XXZ+oOj={E1r`>&+ND_} zhY(zKnrYted`4069c)H{O~v8~b22&^V2g}$3{h;?bSN=A7PvSH+HF7+Hjl4*f6a){ zRr$~uxzGBnr`yBRicU-RM+TZhU{AJ5$ehelxI9?yiU7G)as3C=dIsz|6ZCf>M|f8V zmWZyV%qSCftn#gDjj{)_hqY#XtwI6Rs@hB!IK_H%_J(XUYB?QrVqQ|j^39)Yfai5K zag|}+_sy+6t?QQH^0=`pO7m@`;}26^%-}EQbyUzVx;&nX~2U5oRe207VnUBscj* zP|IvKQrI#bH?fDUVqZVZm1+>oGZ2fBTN=-2J|EUVjHzJrtc{RTH@h7Q#tkKK6d%OP za%xL6m;fpl-2t-lK87d8$EoD9)vNCEr`Ddtw6PV`UJM?d8=*zs5rp0O2SXU-RjrvP z1S<6XZ9e~x!_Xh-cM!~JfJ3pE18++n(0m{Wiu=2xgFoTj4Kzt01pli|Kjbdm>)s|V zZw4Qn{=MvLLaD#K+wJZ6Jd)o2c;K8{KtLx+K;F}J;{cDEojrk>m5Kqu3;VI7km;y4 zxl`sv%PEsok#1qFfwUnAj3{elcP?I?;1YE%3zW&@eAPN*y1wxGITiXjH3n zXLmIfn<}JF1+Z!f0EnhNB~oD#SPlxs)szMe&4Gd)O<}X$%AO5cS_+mYd1um>r$X%U zyJCGC_{zGU>9~-|0M%bbYHUiVA`|E@MXK(sX<+ne{V)^#03{K_d;TyriG+fd-+Uqu zxPu$3jMV|~iyCF=SsMtz+-5I08*u{C6tl2u>P?eFfoH*z$_}*wvVf^BBWNT-UrkMM z?irZ#Rcq;Z@Oo6uqnH8OV$u@%BVFqQM3gmm5`*3E{Fgn^R^c;*MSZ)?ayN% zmgT9s?RBSc&GKftdbpbm@J_S-8qK;xSTS5xhMTo};h@6{bE3);`w;eKLU$~A^aZv` z_uD%1mTh}Z6CaQnirxo-kGIbw`)E`5jQmtJ4yB_C_6`(*r$-ZyNX8F3FToe7>tz zhEuN9Ea7nO>JoCo z_Q^%8;CvPD*i<%C&3H0XSe|-?_n@i3v)&@$!V1s=6~^&(C8}50eyZh1_F@>6hhpO_ zM{~mJ;J`W%w*4JL9$#hGi8hIs@g_6Nx zBMa!gv1zZxaZ{`M?MU<^(PA$NUc8$KLrS648<2dPnQ=1RVJ7>*iX`{RgrLZ>!e1@^ z&n|eKJY5Lp>T+DWQ8-qxZ#j)-OG}J1$F;_XM8W>XA66LsjS&VSv)RyG)bz{eIk2dN z8E|aVLdZ{hQ752u=`$=UNlQz{tzyRQ)Tfrgs-CAHX4^?*6o;t~IDL~E4%H*|n z-U$>cV^5>za&q#Z=8)&K&81u|Ps<$7t#wRN6|MMXJaWdqs*t;qO^suD6+L3WcSndS zao(xTxa_J4i?*+}G(COJ4Jkn|oqR{>fa3YiFHHi=c@{v) zLu#}R6X{9v*TzEg+#tEPKKN7f^sxR>_h9cOCcB+f63|Dnv9cM#+tes zmqNNr4S(rH_l($LJ{l3a@RDQ-QGuLPJ^p*7QJ6iSVlB0lwU69-fYdQ?>x{hNzJTz zz56_tsgG-SL$yT67*uj}ErvjwZEjnuGrLr~5`61g1OWH$q!O>+y5ULI(gLh$Jj@wp zoi+FsMqnq{;6zw%v6ge)9YflyM;$Dr3GmZN`S|~Q$#Y@k4t1jS?C{dqdQIFk33|5? zl#!%Ci_Bq4U=*B*kb{ots`g398L#4?=cQb4G*rupVCVLE5M*vjLRw)MDTGawG--tQ z*M)Rg-@ckh)L3*1v%p;(UjsH@;_3M(`@kAj2)S~d`Ddv15fk%+c3<|6%-G(TiGU`Z zC04=T8qR(PG?r7izvL+QkrTRudJqwyT3!dw>5v)%JxsiDzI|M2Yd34%ZQZysJA7kK zLNcXhT52}eoRzY*CE}{vOOFaI@|-j#>J&g3DP%$LlP2{Gq~ zNWF`MvIiWG_REC2dcbAw*z6XoEPOTTz>VcEu<}dr^z9|Pk#{j4*7EWWpx|YNi`Y5p zbiQ~xG++y8hD2$sz(tk>uAu?6LBQR>NrjKY$iQ2WP z*b>Nf=}P%GxW*8-BF#r-3MmLHp-gx@9&jCvBmwDmPjCu^0l;tAzsiU2Tz==rCKWZ9 zIxI*A6@;&RcELa>uz_0VG@|sp?~2l+IWnSeYf04W_i{i>h6a8qH$}^9_4tz{0WnLV z7?-`s4gw6nH5I-XLYHYDN@2qSR`8}NByIt~9&3|B|78boF#aDe6mROrC@>5N6HBTi zJTMJFL(~57A67J5%Lsx>16)r$&V2=bA9q5jKpJUu$xEA2kVmFvmRh0`E_d+x?&L96 zpuYb5GFsmw`p?7kFxE$*(NU})&%3Liix-|~VLFHOfC;O949M;axgxU^%5EgZzC}*# zx6^kXnSeXVZhM=G(_}scE9C+l8rDl@DsYYtx`H}I*XI1_KsB5i)a8;ykKYpT227M zv}Q$Nu^Z?v6}vTD#*bduzmob>YF8J)gD^*EQ8-8DAM(&F7I)l{9%H8%oxBb)Z8l$0 z0}$^N6e430sTH5AMKK7;07H(j?9z+hz5^4Y#wFyR%MnifvJAw9mG*qVH#tT1gX$Wx zDaR%3nbm@IGFeXLEmUS9MBz(u$x$Q&P&ChL^9%nZy}wo?LZ(13h8(OV&Hpk0y6dFf zZa)lTG$Dc|55kZJoxoKg? zQtJs=GNdeNtVIT3Yo-znL45J-;FXY!f`kHo}D=};c$P7}6b`=DBF&8T~Ay!F_ z3gEQMPgo33*pEcuCuJx1e_}xZU19j=UIaa1yVuvp$Dt@3PubhZUDiOsUliy6yw$bE zo36l3>>9A8OWF>pF_3NTCTHT0HM=AE%(WcE_%u??L*p}d7dFsu(AQOc((tq*sP4fW zGmkz%QEOgpyUGuE@zd)V98e(UQ8^NY@i=3crreMhkAJKs__{9rUJNk-mV1ogr92vl z9kf^#kmUG@875ysq#@Tud|1~Gu_J$>b`D%Sb=_kGaM?*=6LPC4>fJW@oyd796{b~pn)Z+n~PX9HJT z5O0BhrPB^R0xvk(&-z?PS2~F}^YAO?9Dd>oxpjkZ3 zDhTaRnS6-uT$k*(w7|8~NsgD*Jb)&yC?J5pIUvsK?kV_oCuQVDakF5Jag+UXa9`Wd zb>&T#o$y>UP)_u?p?cj}n`EpKVNy8G`9>R9PW(!noY0G^XowXNzpKp?_#=z;t}%@T zQW%wJaG=BIxb0UCAo)E_lM|VQ3k##eR*JS4qIR+?#fSRk%TLp!RpC=^9_d=_y4eCV zpg#mYnX0p}Bsn*Z_=3B9f~a(1(o$(l9)FLGnT$PbS=lkB{%Kl>HsP*=+!4^YaQco2 zoW_neV*&~GhW^_0_{WhNP7DBJ5_F5Qn58;-^-1JOR>&OAnWcKF2cW8JEnk2M6Q{kn3x z+a8H&h$PSctUOH=#E9?;G!@Jd1)OTFra#TZ9K3~I>g(yee;brw43jz-*AV-X< zk}VCT8&A3G1Lj;HGGOJgAeTdMsK~L`j(oZ;#oxtyM2RGgTD9+vefHaPbZsYf?olC) zihF9d?VL=y+;LkOS?L`RKyx>`gv|t;wg0vVHIzRj(MJiCU(TtKVHe;z4;SrB zDD7d)00}Wl>+VWk@p;5rFOFy|HB$)#QUmg2F6-vbK3&_&rsINv_?UOb)Q$2uW__8r zt)+qqB-89yyLF1AZEMVuu=78_J3yJw0Q{aZ=-`o$OCf0}&jHN@XY5UDO08si zj-Enb#a+{w-3+$q8eUK=HGIOn3!C2%9^g#PfXWEI2F;8USNpomE@aVwyGubdYdX#D zeJYxg7H$2N4Exd{+K*ti2-Rew3~f;b?{=|~hHVmHo*;eUDL%I!Qu9YT=eY&Qn9PAsyJ?fYGTwC&w^O; zANg+01o^dJ3Oto!qBZW71yj|3g5*I?j;d8M7iF&!s9O1wEu-`HYk;C-lG2n} zWJ3#ITXBxU5{Sf;G{qfImu+lQ$|KP=0kTwaiE%C}ww`(;choCBp z%GLQWh6t-QGjVG#Fduq`yEIpkWafD4RPwZ*<&5*o;N;1|87R}0$#G;nS)MJZo6l!! z1a2HLnOji&fk!0$=%cWqqkMn=wsjKy#Y?PO=LEWu<& zE1q9*_{|ZhxCp*ho(LgrfUm_^letK7FZwMmm)EKhZJ0+XwKNWc$;qzHVN#CNd6PK1 zEF_rKQX#VzYMTe-hfrQw+8Sd5AB_$^zU+x#xw&>Q5yByFfxAHE(w)Nz z=Ignv_lJS24r0B>l&wX_4azfNsWMI&fG+Y06VeoBzm$*^x3qf}%KbS;K*a|Ae>=cM zjhM88^F+QH8f?%l0{(W}s?5Hh>0S1Jnf0-w$r*F_F<)KatVx_I^Kt8VO0iS>_xAWc zocP>t=agTtP+5UzrL|z{r!lK%2R&S+mm9EhCLNG`eE}B!{0Vedzi>o)0SfWDXW+$V zP5v+Ihm+<1KjwL17-UTCQfFB}z(H79{)faE*4X_IiQzY^Z}?b@j5L{0Mc@{|Yx0l8 zkciB8CWvsQw1{kJpGYEKklpI_b3Yo7$1P62wtIk$ef;aO>n?sz38=$<4a#Nk%g~Lo zE3{yIDv?ZsGn*9J``F=>g0MXB{>zCw)zD8cWAB+?Yr6l<_2KHmBZqSlPvCJ5W&^LClmoR#77H>=JIKpUd_YT0cMAP?p{uueeth5DAj<}%8zOlua<)uN zM*M6qzzwwM89kjCB{zCXKRmzRyky!H63=Q^G`in*vT^vZ+?I|PZ#a;DP@M|j*LG3& zoH7K^z!EiIK;OV(-;UQH>$jtK$O7)1ll~f2ex!F}r0cb+P-J^q)2m&!Ot&QhJw7a| zMSvpfLA@0$I=Bh~9eI@IoO+tI=~X?QiVGlEfRauZA&|$-hNlJ_SGw!A2i#V*;KT@7 z*@X^18+hmC8ypk^V;vwKQR59dX_XbikiE$(|JSC+MA+W|1RBe)L@=`&qF@|+pN+~j&T=X7*rW`C|a75vih!S}tgEVIF`h@y_zg})zUg3fZ zq=AgF{Wi|`H0{)9H1NrXy#QcHZ&FWF+lqF^{0eERHiQT~A_w(P)Kyp zhb9AZdlq*cGsNgTTK{myha7bc`JcOb3_tiCU`Y1l+x+W2Oor9&2mpRl>MfUpgL5?A zLaRM^MoN@dtmSgmY8jN;D59E5)Gf3PUA*b%d$^>KgSE7|*hlYfnu%ww z+T;8$a)TqV?&${tVc1og$m*+>Q~8YTE8M*#e95|JC^FXef%_xy?v+tte+4kwc1LYCSn&1sFhkOyBaR2fK+`fgu2v3KDAW&z<$hcB#zEG;<^U(Ad1Sug-)qImy2LSYqN+VK-_bNz_|LChdAAv4&Y9{G@t$pfQdpe_+{pn z3&hCfQS;fRu^QS-3KiwEt@}26XrlS7n^bzW-}W^1Zb*1(o{5zxm6^TOC2&^!jH`pm z!cq455<}-jo8t({kCbF&D5ta8ss9imcxFVvL$l`9v=9sa&TAey3oka)vvFx|`=f+R ziDpWV1gd1`3n+>lcCfoVB_{;`exP`wp!fZ@m5;sN`R)xN21UnSsYCGb_v$$&S74m1^9( zKyKu5k+LkVS2mNz&a{_e1^t|yg286TpsfRgEEsb4188m-Moukhx$WugVL&A@X8>bS zHRCl166kW!7z`9BFc*8QoYylxpfJX$FR#T;s}2A1(4da*M^3-qtb`>)fl?90peerm zu_OkL%w3avZh6@;%W`1?$7w^+|&M}N{b z1`s8S0=TwP9(&``quoB*ltwAKz6_Rlw(Ud44=ju*^t9HyAo81M0tE@86jaFcp`w74 z*2-=84F%^BsI=#^M#L$u4#kk1>Q9z(Z*4a7+@%M{SccEMBo?u2dks~%wVbU5TX zq9TzQUue!u!s*B@SJHz)!=Q{A5Z+_;OyRqxQdREFA0r%1;+@j;uuJn)e%fZ-6IaM$ zr-q8Pps#*}|C=k@WB(O)l5(TVUHG*7&?AHiiPKIq*}1#}9A2Gg-=gtPF-fQ@J5r;; zr*d+28G?9+Pe1uho0nsq>oqbOfd!dM33sX6>CkU03O3NZwP1I#*@N7`K5T!T!!{I)vZFA2-x@Oo~@8 zuNphc>Bwk=8E98E;lzI!HO;=Fns9cq10hYojMSPL8LK8VTUs9%2nv7`%8Ua7^h8kU zo5JGBvd;G7d`>ScJTodaGePa1^EIFlDBf7gQ75sZ#8bb-DD}5wCfY1;Eu-UTuj(-V zI_czDhpR;rMi(WLU$erv7EFU)eH1F+7BQTiELZ?^Sy?Y$VDeEe5FJOLiG+pj7|as# zuw?3(L?$1zfqCEUObvj8N{U&{5}LuL!MNFMP+w>vsEo9VJFJN-3~XL!-a>Ag)x7ky z$jF1E3{;0X1T85jBv?4xdsN#By%yUGgJvRy=DO~6 zDB4f4L2ND`NxC3H817uP?mQPGKA|RYKp_m+BUE(eQlNcb5q9-hAEKxh2P~f4< zDzQYi8a$Up?*03koF=ZZ+*O08K^t)x-beS!--=b$!MDuKS{LYLVN1bP+A_#Dp4q5v z!NZ`y8alE(iwxtPw9%?xR1(2FyU1q|7w=`TX5?oh=_;1+&EjzRTzuP@ANDTIJN|n1 zaldUN-boiXc^=?gSb+o083p3{&(fB)7Lx$v>&ucZR!3yVIUZk;Y+vNOfK)_E?UaNw zc4l0jJgnkG3E|3FgJ8fuDA^=~Z6V?=K}VwzKGTzV@JixPga+XXz0b?w`Q3n1Zgk(o zf10H788A`g{-vk#S*49N?EDsQrvCtw_?@k;!1eb%Sp%?7dS~{;ha08+RU*6;;KK*u<#HS)pY{ayXJ3;i{Aaasf`8qnJpTz!PMza7YuyVaW05?;3^(T$ zm)&cJVKjj22-~^s5+_1@BX*u`nGD#BQnKHIPLx@TZ}odg+Kl&eVf_AIsW@BRV<7!L zLZ$rk?DF;YcGn@5skAGZ+fogK-AxT#QDNoV*~1w4OU!W#LrS0HwaJOLCYRSsf4viu zFqncqigl%mG>v}(0VMxih%3kYmyN6HY=NHf$pC=6ps)E8jM^PHm)|ochsPl2af*-f zwZ?Lx&%#Ubc=5(qavRgW-u#+1`9Ts2-lp6>iHADP@~5>*lgL$dxk(1L+Ijp!tj^_t z%h;xVmiS~e2XD~m8`$X8APNFM%5QH|vWmr5@=~VGmFMgHX&K-$aY++!DSb%o(W6)m zKn0Xl1gY4fBQ^z6+>cTbLRWvdY>FVGy1XzQH!_YF_tk+UiV zf;K_22C=X&Df^V?M&n&(hhh)A=H1i65@xAs`g@QHvj*@BbXPLLxkK28dpbM`fEKKVZ799h-2)wa zrB}#QFq#=I+)0F86johC&R9)WRJLax-ccsjvg@p6Y7VMS*uvRnKkrHDK1uX0ddRGD z_b?4mMmjr{LWES!g3Mv5;78nJ*9gz$!&%xE&_n?;MZ4TB8>9z5FqSn}a3(rCtySlW z+IUhg;)QAGF5BLB0M1e_e9qxBPJ(R+(JnA&?d|Txj>$n&aXrL4*1xs4gGg?rO+9WX z%;>`15>=r30hyiscK$DGhUbT?df?Mp~X5C8QF(xTq zW)n@C?l2ZDxV7xW4Ut|QnenDe0&+*@E!wfZ4t#TI9zwXkn^K=P9WgzGV*%QJ-aouK zt^hT1p|jbOx@ui!M8}Clf5brLz?m&cUf3_sq$u)vxb!A7h9f)skwi-*kKB2R?m=6F zNJ-51NY>);=1=J^uB3&f?(y8Q`^4{0s_E4NfnQ0uTdOa=lWvjTLA?-`V^;E=6~WF5 z6kv16880#Uq~dB}2i{)bP`4;yHUQB>_1uGXp)WQU3@7n}A8(v8e8t1umB9TL zzr4~{*25*5i|rl9qO(v7Gy=fsM#qGaRAK2veK~T5gwCJ=r`pW-Q#lk}n4{${Hd!S* z(ne!WBzH^3KS-+gAlOxVWt4a1A|BF1V+8UE78i8aTo0m+Hnu|$T+a4E4_4(982~er zjMAEZa^Ol(?5+KF*jn~<_AX|Yf}Y)$w!VVyg?olI*z0pd$tSp0$u4(FNQrz}mHHRT z=^QbY^xQBbhXjbxHnbFo6)Y4@J(>bF-o^!(SPu#gqaZ@k_?HCtm~P=@v)dR&udzyJ zwiu<``3z?Gu4;4u{_pk?KKUV|a)3YaC9>=t(Sw4j6pptS9RG*ZonZ2L6;erO<4^7W zR1YV#`L|2|e3jbM)6ItyIC77OFEi+xDVGG;^W_E*pp)UF#nkp(x`TMx!wGqKCNaKg zWB{5^UQBE>(ObI%+=}h2hcDiG2nob07pq`JN@S;8rQMMvFl+_yFGib%7~pO)VPW!L zyTEHdu_LFW9Oodif&Nf^W>60pev`}T6X-aCcBX({IOXlJ{O#fc^Uw4YbJ?{Ych%^)S3g(5Q zgZHslC&bg5Ok?Xp({^K7RDiEK?Y@|K*{Sh3b-h(DgisR?=hxNWR`G}P!bsl?6LC#I z+}s{fL((ej*Fhf#3HMS;>`r6a%J#P*9MQ^i;5kp)ujOoK3{@nwXGN&O&F(W&X5U03 z0TD?MQ|%J_)E~DcCT2TI9eR>S;jSB5F5ID9r8?%8+fjEMaa)A43-A!~Sm=VQR z1)0eK@_qkP1it~52@QVNcGaQCMJ;$?OlJ2gnRg~C12g0n_{7CMf>;Z>c7DHL0mb9B z9IWAYTIBXq0X+bdBH-nH|NG4&#bdU|`{|A<{H_gyu<2$rev;T+>iGG2Gu&yhmqN;P zXRy(feyQIFYNM`;8<56+!C0-i>dTqYGB(Vb)>&yYI73(Q-czxj{8J{u^sSi;-@MM; zOijI0VN+lhsci>2xl=oYj*|-K6|9%UOBTQDfO4k(w741XorEKivq}LDge@n3(sUPN zp}CM61q;^dFR`MqD*?7-7M4GL^Zf@z2C%m^_DgM}t0r2{A@q1S`a>{hEZ}`=T zHxz3LuMzyz24co4Ti0$hR{KyJcqn6{<~P`3njkQF07&p6Kf(-BaDC+XHVl;C^Ip&{ z-|JqhD(>YlAc)~h{B_|6sVAmPUF0=`4YsX0q!xI$-T)|CJ14q>$by`>tJ-D)4g?l% zn44kl(Kom!2w;>oVb&R5z=rl4$I;|m8RIp25IwE!Sh*^Bvh-RDHkq#%ak;&go$UHl zpDkhKw0wYUt{FYuQPbI*a`lhbW)Od+R|QGdDP6aM&7$PCW*(iPt^3t`?)I(1nabg+2=(=QB+Ry#}WR z?a0__`s?2L<=JW-K*=G%P&98;_hF|eGf=K>BjhY@#hm-mZhUZ!AD&(s5ye@t#wm=f zXv)){ga#D8#b_wk)I*QzXf-Wj_OvjVMkfx9@Bm>#;ukGEIxrvIbhnZ+A+4_KdUy89Adk<*w$k0>apjJ`L<2q6{Sat zdbtgGPB0n?H8CE9=@Z2dkmB|Z{?);CYI@aBBE=WN&eAp7Z~1P9{diRN$)r$&>zH_h7Y#t#c+P()W#i z|Iw?#ESPB5pscqtMf2u)liP)dSNpjsFH8zb4Pm?g;;Y|RbzGmnMF>wmT9=`1T%#p*y+UM=wQF5?R0&2ZJ6sbjgAD~xLN{~ z(U|y(dtqvmlfk3qM|TR`caT-_tiuV8#Mwk+ZzK*8HnSx_~5uYHiHv3g#hFme^H)I6j(K>67Tx1@kE$$7?wYS&t>f6M()u97TFhb6~AS3}k}| z?zRSQWC8 z@r29O2GdA+&kqL+e+0SEBR~22Ub-mCqvzCw4qeNvC=QB#*m-n?brN=9Mar)h&ejNN za+TC9xj#+S%5ld@qoyp<1`08P*+m2`C&GRtx!Pvb+n;fBy>`UZM{hfNRXr+A#nK7KnNnI%sc0oFHjdXVCw)LDN zIE!kBB^gT>#EmIOMWbb?0;Q*>LXHYuUZ)&H8!7XEd(?r4A6$)^q2p8{U&El@_%}4% zuSB2jG;-XkBh6&A=7&{ptUuXz)?Kq96(IE3hYSkuTF0hGt6n=g86Kmd^2@1g zs;BJL*6#~t$)9@~-)aCr#_|67c>$^MX2|}X5rxt5ZOE_PSAYE2hOej}rVy|BHv?65TQx~s6+F#wFN2&NXG_X4>|@w>1AU}TU&mTN z6+qblLL|I^aOXeu44cD2tG-SwC8Kd2ChEmD1POA49KnZ`;X?BV43j?ZeW8M;JgY)h z{qU%s?WWAJho+_TfYKRd23d(WosV(F)nXabu|b!ob?Etzx7tq$axr&2(4fD0MwM! zB3P*Kj@k&>y+Cn!Ph@M&mvgpJSh2NACKtPkEh!E=AbWnIjY8Fx5mavn-owdpJ9S#s z=&dVOGP7#?{-ga5@gk{+Kr&n0_>msfRs zJPrRDAt&FK!)@#xcAKUVLa5A{0Fj%r%>(};w+gp~)}kvA;^u3+w_i=}+e9l=E;UYD z+Y@wiaW{0)l&pKd{5o-DQi5thQC^2LH1!u{SH=7ctQEOmeS(_V;0BQUEP3a8k}Jwj z`oM=6ZmYuG*j`_cG`l_-@_aYJS9l?_)(@yrc)e%c16O{-h6JpCS`(_TGGnJn!sIwO z{)+-wX3HnY0DqBX`4pJ@2IYI>ZT_$0`~LuJ%xtXxA?&FE|Cb^;k^~`6f43|aBWXFPP+VLb>XXlkju@yz%Jb!J3}H%J_158oami zBN%Pe{$Yn-TyIDNhk8@Ynn95c?rg0)Z~Lp!!@~$o2vh_!RD}49KiN_qx~@aTh%mNy#I?t+(jSrZ=>- zD>~Uow^VXjJ4Ch)stkuPTgKqhwC1yL%Yj7*3FpE%vF0@OC0LK783$Q0muS^?FaZW7 zm&BN7nUOUX{9Hx$0b%4i=|yru_%mcOUyO@HA8Y#w8X{kta~y%A$nPRRlICY3EWE;Q z(->`-9PIAUB1Z+6#ZX-K%ZG!9gF$H1){c^%qHvE-PtkN{&$A@WE4I^=g%HejAdxAb zwgbX6a%&<)WHL*rPX+ zX|&WlOewnnFL&oNJ$zK~NB4(?cx&NDgfkWqyOyFCIr7eDD7qqQSVAl`b|Mz-Os?c= zmjS1#IoUa9Y^Ki+R^ia7$5RmxzWT*-o5fhghm9O>*%CuzRNfLY+v_+0-*0ln)W;^b z80&uGC;LW+GVtCgWKTVom|;AlBR6jd1&9R6J?3sm$4qvuaC4p|H}rPHA>AHX?? z(1EwBaQj6$B8r(ceSrcHqwNQUN5q%)6>&!)+|>Cs@m~{E!BqVjS^zzLF_E@&u zs;x)<_bz_9Na9uI|HsxjMOPMe>o&G+Rm>gRwry8zW5>45if!9Y1r?hW+qm_gbMMQ! zXT7Y~^{`r-V~qKY-bXXScpoHw6X}FIB@i|a+DL57d&qH|1-fq@0?lorakrCJNTC^~ z;m30)3JAT_8#{Tk@?-=$nVpHQkDsr|+zaA){@&sL78YuO5V?mUHYq{fdSd<^U*O#4YtS4Tv|dIsin5w4UNGVEJR ziQ6Qa?HlbSlxB0HyeKE|06ET#4juQ{E^b;G+00t(mhu{-0u&VBm9$@44eYr8S6dG@mXbmD-dwnD4(Kw}{!@fCrB=^Oy}SgCdw6AN5Pv zBZtMEWh`p@a)E4nv;mwSTo^?@t3CYA?~eu z0$EbZMalYQc;rW_-#=SRQ$LY+8EuCi14J4A5)8TQ$E^`?MhIzbB&kmoa=M-an*lXxe0VT!ys}`}ey}Ay+%@{5%N9 z%z)PxnV@6fceuB!E+#rLSXxZY?V3&*qw(Mkccz^1Dk?zZvuM$mME-kUNe3&!v|iI7 zP(WpOk&X&Yy6}asM(COkB>-o263(?*pt5vn{4K)Cm?Fzer=2}SITpU3$9a2g6%0+? zzoI|qc&e!yHkBKQS9xxRS(;%;w*sQK9G4|eMR>rmo&Cr~pcT#3rJJPZd%}HZlRl_7Z zH6s`{qsj;@EXd0$81Yz6IGxj&yPQI_>K733?v&k3|s z@=0|3!6y3W-x5;40s*gaD6fv>5Ss|AM4SH8kt!Kj5g7U%`vu+-L$zqHnQHLMInwk< zzZ3wi_&AGnqXaK2Z0!U(wWXxub{im_633W#_Uv5$48 zhyqVgr3V`=zLyz%1)y(r`O|qIqcNl5(ZaRTIsV9{m-_yyvDn+j@UB_#akj98N||o{ zZ{#o?JRG|aA=l0y(OFZwe(F;77ax~ej*RujY**oo68HRV$~m<^)U!@pTFJo`T`x)) zB}91ulPTe-Oe1;*gE=XN2bf+3&8)jfDklnx^>DHpCA0kN;vBQa0VG((Y)Kbz60MV7 z$H>4gmHRwLGa@`wIRM_!obm7OV_@_y{G+H93e$ZPrLTcrjS-|icrz}rk_1Fv`dB4D4d2trw%P zwj0GJcMJ>rgplZ>-q%}82W2o+dbc6BR!_F-N3x(O*&hV0RU@A>efd3`76tj;(E=~o zVqau%zFhR5pT>k{z@|uBkdfmJXteg3>1>`lt2O$?aj&JSHn{C+B3k{7ybSJd?YG|R z2!+TTs0R$9;mFf$Q%Gmtq zguVw4#1TdT4%jwox`c3mURA0PJHO3m1ahdt(Nv7ty(6HIQG$CZ@c01~!hVkCMPcIwE$n6>k4ie7ZJw_uH2xI}g5&i$TryBA z%PgUv1BQRsLRYYp1~)VUPZ<;d>g?j;=HU3#0W1_?R4*T z|I(R`96lpwuck-^(GGR&RD(IHZAxQH<;D(^E~AL7$?@*p!Hogoabp}UErt#Rt{A}dNBfeX`k)7$8=j(;RG;D~5Ar1i%>5{J`O)2YD>xBebs_E5Aj z7P9v!Ro%BsPX0GCmB-rJ-nn*<7JUB~i^Z4jIYqVC^Nol?JLH_BfHV=`<~O(rWC6RshL=KX6PE={$a*#K2UIfw*-5M)y4?YMFio1XTz~I8iH_TIFe_ zwf5t@Mw)bvk+JO`cZi2`8!91K2u}hfCARwuuS_qFyMNA?eBFGDnk(|C?nJ?;q19}2 zgMfscXcGsNAALLUJ=$lV-fyENxP90cblQU7nSOs2yo1qYLcoB4=0}-}`fCz~W}x9f znk3b#f&rf zgm%FvrM-we$&`{s%Mbd`2p)pJAE;=_pf;)X&9Kb#N{FiIsl$@w6E@qzqmM8~jg#fh z&SnOMUrx@H21m^tgl@&{&*gs2Ea{Ax+TTFE^d_C*n)&W!wdiH3%LTz>`**7gW zW3$45-i)deBx2f_SIQbxTP6E_rswTEmn8a)Hce(;As3`mwM4{YGlf?|pPagVYAvci zer*~XoOG#5#M8L~YVf0)Z;+|yu5?<}5rD{er zPS8xvnPP7h3SrZLf6k{FDRjKB&=omrJQo+)a4uKV(MhL^UOE;{)buEU^pLbotVP(@ z!JE%uwAP`{#`hf$)v3&r_|^SrpLgnJA<8?@J|~8m>hbx%zicv%1w1%2faO0(1at@% z)_=75M6Q2;THLj`4T-xgL(;=g3_wx#46hK19LFqK;EEPWGSwJPvy{wG1{o&N6OUn^ z8@sqQR~M^vUZ=O{M_&cOy~Y_OGhEuPs^^`0?$SdpFE>L z6>&Hs%D!~um!I9ad1X?v>ELR~ zPKq8&e_Tk{<_}@}$5CGRFxbi>LSys*3yJt0xYbFCXj_Gzk921wT(rg8&AE@@Qi6V@ z!C!p3^qsR;-DosD&oUCcW(`?A*iBC?P)w=wMNO+DW!NJB&2BK|;i6PtiO4mfmBJ~7 z(dD*5@E1SzvPS=OuJ;i;ro}3_C>pZwxq)>nChIu;c{c!bz$nclUja{<>oce%P{v(Kek+w2?p6qzIGYL46$kHf})VTZwjQ6c++1Fen(I zs2@^@T=BQlbfzNrhE$}JJJK8Ns>E{jU(;iE9;xw5R}`krxZ6W_n4+yfB-t+(ekQFP z>Qch;RX>+Vej)h==uy9kDhuI;uR+z%wL|k;F#`yE;W;GIT2Q$_5F@w&z&|8hL2$cF zA;|7?!Vip2NrFxgzXXcLhn`%xe_<@pT7r_o_a0n?IU@Qs4BXoxj6Phoh#d7=iIn0~ zcColKYa_>axv+|IBosHdqUspHKRfEw;k4dva{K-xK_4Ul%$a_!}>UG0i z)_~2l9i2a0H;V()?Z+Naea@sB=Cu&|$#w7Bc{d$S%HF*h9xTM*i_KH? z$VX)&3n6p{5i}gCdFrdnF6J=5X$R%TY00Tye8J;@R7-HW@ljj-I)W69aTnt^BGva@)HkSSN=>MAs~Etz29pvXfL zAe&pR-7b11zd5JXqlO^n&HbL+L^!8*Le2n-#bAH21Kp#|Y)4~*C+mPA^TOCePygiC zZp?zIDgqfhAbIrzdWBJgw-_|6TYoI1D~?N7j+GM2sCH}p+~n%(hbb7vPFoD|mL$-Y zsYsQjef1X@$^{?tfhjI@{w>rv%-`~9WTjBnT4-X`tCsb?Y&QZ*+fbjfRF9`^k-0Lu zCrSC@9KT>->+|XN+|buh(bGzD<2@IeKmyfn>jLp84Esg^oH)SMKGbE!k&gv~W6tKl z>dYX*Y>9Bb;XxW&)!EhJxb*ZD%HTC0CY&n0C?A2bo0R~uK8$+f`>5{}#c`9|I*f`a z)RbgJEFjGhixwA-Y0=v%G84RK%ZvNr?jplUfzBSY=~42!3cm;5qu76#!)CDnfoJe` z=T%-0m)NQfoNa+VYU%KH%_tfTG{8jj0uhejMbw?3oM^;U7;Z>DTsLtS=HS;VU>8L? zB^8${1I1srpv+t+_R$h)flivn8#+FF_(pnTKnV;j7*Yobr>D=3+36}V}REP@Np&>C}25W@Zoz+XZ-U3u2n+N&u7pqDFa zAN6XJ$SL{1DL6P=3*~{!-$gBF`4uB zGlL{JGIH1H%2@*5R)_jf_o#GS{@4SYmxakElm3q_BUaP=+Yw!2^Z5#Eo9s{~b|ad= zwMopDJ>sgF!00^plgsTrKj<2 z?c)R!xh~7TuBECP#6?sS1DVFdZ9+g}uw|3Y0v|^L(0cx#Y}4 z^)(ACKzn79_A$p$cr}aVjxJOGw{v}>z4WMLj^w0-lH1;~@zwG_2tc02_y5)& zq@#j^VS=%6rVq^j8^yI~>&9>Va}fMn$$lDP0UVq%;*S(bwMr+7>(FPd^)`nJ>o(WK zNi0M;cVE?AcPN*#ZP(cSLWUX{+SnVr){}Zq-WtyTc%6AK<8%-ly*1-DEH&owT2}zu z$(MBEnNR`diR~TIzo)Z9(sqcf`Z=w_h5A z7>sduaPM&#$Os;AM(?TNJx@y+&)r-2)sUOU0Jr=uTKJC(Dc)2;E!LWEE4AuXDm89a zVmWPR?Srkgt9-~I5}cLl`dd0yD_E85soo`3o7K}2sq2~97WzjcwWrf`4I8gY!tt6z zPOq9Gf1br#x`0J^B&;ILvL{pGTwVx+uPmrSy{Gn1IPblh4h;x=n={c@t~OfR%k(=- z>MMUrV4kxCd$EoSWUdP3iaCqd-r@q5>7}|&N7VVkMW_6X;G4*AkDJEm5rs%&eLy~m zgFznTwB`iA0;ryeIu}~oT70Q1h$oZ!*ck6^R4ZlN#DV%Vk^u-b3qO)(O?Rnl%>22_ zH4Fob>u+6p=r|&TF+ho$0Jmyh^LpYp^_v&x>k)F;ATqqRZKsa%#;7n7JeGy!;ycYg zS+aIdA1yZUf7^eTP!HMS{NT=|(3o?FBTQa>FUx;X1ZI!)KHrB67Es?h_vAtrOcq`g zul{G~egFr*MLvLx(m6_ql~Y_o-l=>xrFco zXSM27e0(sF)2tY^ij5bUA?fvyJYeR(QAbICz%SFhq1n(I6L{`4bqhxP1&8O69MICk z^9Q!W4c_=~=41;_@IVn#Ay!Kgn){!ql`|@scSq*IrUiygIb?Rc=-r*RxzshXtbZSYy6ue zua4Q+}3wds$8}flY zchOgB>7;VnCl0VW6?u`y>>Sz!VQ`AFel%3qss>vw}fvp$WY)bgD|hN*G(WSA~>zX2BMs1o2xLYu*0@{#}yRP;vUL-Ie={J}w(@KG__>!~=v1ZoTN z$$nDfow|QX6j1x9sfe7Tk(Bc%_s4HBjWoT~u@8+C!th?V?HB3vnfYy*;3Hf>N@swv zUjVFhFIJSG9!|Z&A8|xmj07P0u$9zl0mgiXk;x7M9o6qPE&cOWXieV%dYx5YL_ydl zscx<|?dke`6R1a2i{C1M;8IYFL{D;SF4I;izOE~nrbB$wE@6Gz$p#X5R-Ij)a&lxR7BLCu?f%UkMO5$nu+l9yOAd(U^CAb}nG^ah6v zo#U(%*mg}8;wFU>M)w0J-9Sd^eS%5o%36L3)|6QF6{|;Ujvq zHvMDIBYphQyIBbh$yaCzdPonNgf2f_b-USG8t6|0rD3)zfmh^GxG%%RP&Qgj z!yEirB3Aau&|X_xiEb0BKhl!i_H>K0-Gud}xo10lVO^(6{4_cNp23tMb0f+q#y>R7 zk=W=zludsga3NJPLPD8Hn1Q>ccrNdm%Xf!5IJ3;d0J_=B(%FH%%|!$*oqv$3wV^8Z zlt@@dQ*hAy&>JZd+Amzw8ZJ^`dDCcX7j*Ya4(0Cs1kyN}Kb$Y>muk68wFWN6= zRi}ThYh;%~$x^ZemOp=0kjvWxyXweqw)4&QcG_e{t_P3;q

>3%j{Y;FZB?xXe2s zic&PLY#l6MqyFJxf)CqR9r42zMx9*xynM0L8%K4T`n~SDet9_*e6-76dGoTY-ItR4 z;5KvEOI$zu=r(99cG;>z89Edi!hN8dJ>k%+Iy6DY?iy_Nwxmc}F;KiCJSmay#7W@d zT4-%wCe|$#mnAkY>GgK%M?kW~aU>0mz2;ycl|~PsCI$e#8gWFr9Dj;pSBm9jVoif* zNDB2|3+HG_<>1giIx>q(TD%srbAR-SHHopyYbOLLk!l8rY(zi9B>5ZO$ZrIU25#@M z_@_1t?U3xD5pF|W9d)+YG*rmw1j6NN3HYbsIE1R=nVB`MDPHng&aLf?tM_kUz9`1g zGEvaG1>5~wcT&Lq?%0bbf~|ajjzL$uecJja9nyS=7{DZ^_V9l<)M_1huMo}c`6wW_6_b36A3A7*z*etNv z4BxZNr;rsLzTmsWj(h)SK?G$D#|&WQOm>n%2V?$kEa&q7n?MzED)&nr%hL)I8)Ecb?wFcM z(ydvuy9|ETSjO2=SgERU#aEY-crrLAaJ?cgXp=Q;Sa z7Coqm!B4N@?x`|Q*mQ1*f<;e=#*h55h8hKx#DcK7yMyBAAYkifvPUAZ;?&2jGk6C~ z{)U1hmP#`+&gWCEND^Biomk8}G0#4A(z>&Gmy-YbBf}#spwO2mMBCs$9?D}#4)hSQ z%VN-p9kQ^}ozXx6aYv^;lBR;Cq=o4=c~G*K(nrS~$1lJa{sVs#*6RyZZ@?CdW#thF zdKYZhmEF4kLtr(KVL3xQIFn5NP`f4xk%+Lv6%vGB6{BBDnQDCOFCv(!C)Qga$rhfn zjpuYXu0Eo>pa}wsnGk;{G*gIUEzn%aH%?B&tc4K2T6jVNT6d|asqat;`~(UAcb_-9 zG5$i9kS-i!eP%%$F521})_oiWpCcAFUugCLui!l)8zD>(R8RBw7lXV9)A`?%UMdIF z)q%)hukyBuPHs^VmoZ3l=a5%iha5Gd%vg|5A7d$wAn=)VY$z;l0HUZd63`Ka`Jp1~ z0@waD%`r~#z>02>q4>VDAT^V^CGreit#4}lhsvcrMWyLX7PMAAb&IOpb?9R=8$!Ni zLw-$4xR~8+6v!_;OEvad!u$JBP$wwxAxwl8whQz4VpZt&Jsy<}7<(@Qc@So$>}`!I zM9Jz_R0hm4#RF68_k3$R9AMTHnWDzYd&aXas7FoQ9J@dezepiRqg9hC(fu#npy&4C zjJn9%%AYa#uh-LUH6Cq-00i*j>$=?~c)ghlY|r-4aok^qe1qQpsCgIW@)1;#x4J_x z06)Q!4mGzQNihZMp&*V_>Qi(RgrIVX9=QX>KgrimiqqCJUK4-J=>nC33kn8vWINt& z&r_G`EWYDrTYMLD>4$V&m{(A9!fGrfk^aax6hq;l_E}0YtYJiWmL-0 zJF`LoQPA)y43G)cI$%HqzY#{}FKQy%0?{#k?;CGpbt)h^je?Z)m-qYx@NdJ%?XPdk zS4$IB*a)ZaE%Cc&6Dhf9L<3YRr1k&=%2-A%)Yqks?2Ik>7=N;viH82D7+=sF1*!JI z%5kfhy~!rQ_CoplHXNp(+5_BKh>b?2Bgs`h=YW8%K z7n(>cB%;zSF{KG$z&H-+`Iw9MQvA`%@^oF(sRKIx;jw)a$j%s!yJfJ1?3vkA^;)cV zm6O%$li-OkB~r;)Azla6anMWA*PCc|cffYOG#GF@k?5mr3MNBGYb(>Ut(A`QZDjaJ z>u_fP$ebo)0lfy;szRVo-QIL=q0R|cifB;-q209vj)GoF^Z*fxGv1!f6KL3MenZa* zZfzr4?1orw44OLsW~OyqCLC;HQ^Z2!Qo5*0EKZIEO>sBFfO=`|81zJCF=cRv1yXB|FIezzbK$rw;aW7uZ;EHHc0gK}t>Ng21YGsHTopnZ%tQ z7f~OAX`^er2pbv7@+$*W`f!Z!r^Slbh#U_ilSVe=44eRA{U|k)zhS6dO4T83%r#P# zNYMJpK(tEf_M2h|#<~Sit?gHym%y2&`wG=E!w5!2kb+F12>0qY@eZCJpakmZhlL3t zbXfi557J$^Yks6kh@0^nBV&=-cO5KNt2uEff>uCLV(3Mqan?s;_2-IPOZbf%T|%+6RCCG0?g`<4W6M z07lht+K{o=pdp1qe8dS*`ftwLJGzNS7@&|}8|Lo7Fx!K;by?FUR9E+gn$SY^Xpdfuw=@_i0=}y5X<+bS(#{*HIZk^uQ_fs}Q?m*xV!M{7A zeMl^E04(39CUH0cHuz2Isw5kEPYW<>z)8fmO;^Oe1xw^7TxQUA9E}wh&cm(&O*ejp z9&H>#K>#OP9}B4JbwLV;SxU*7ARtbfLlV$w%Y0CyR;e4$n1mWVavDF!RJq$S4GH&c z3)z>pt}}#Fbra>ahz+8YJFU0zu*DYgfSV+stX^2R(}vaf2f)Zm6YL*K>XxEtH)*4j zgyOGCaimeoK0~rMV4pAdO3i`OpCZmpIna98=G^5FQu$5~i7}xw*Gmeg{D(=1+o$KD`~9~ku<3^?wyGER{o>k43pe+T7yTcxVJ&J z!+pNXH@Cl^>=Nyta-PnA)S~Xh5&8^QY6V4^R`8K5L>_1rUYib2If3A5$^aF!-=C=a z#eD)>_D0S~evif%WN^7mxq-R%otU(xKSMdg}Txm`M&V6Ja)zizuYQ93I+^C8jz&i2+YRQs~o$mB)&?%#%pV z=%vUxA1*8D6I_hKyP1COE{1^1pkZ1rNr(U2fK<-JudJqF;Tp9WK+wc}_B|B|G#xch z!d&Vl+p-WJR6v~lqfNof?@w#KnQox~gqpC7CbDd@a0n-QYK6b%85=^`jve|NF@kyR zSGmPPVFZvPSOr3n@@QjgKI8N%8rSM8FQpPeytM+jgksIqm620=6Vg&gIb%>)L_y|}}KZ{3yq7_Zn7Nqc?B->YUzhfmbl^ZIp#dZ^W#YbB+@ zf6L)vFk9`KF7$I#AZ}_boMpC(f6e?7et|H*{MB;ErvVH;&{2#xjkI=5f54!X3(Vcb zAI7ZNR~}PXA-bVz_a!c(D}Q|tg4=PiC=JTt-tOvWrrt#=gkaXk$hj~h)#_Y)=Dt9Y znO{IZGUF&t7T(KBY?%By+BlhWD%*p0s=R)efUw$GwOE>$ILHPe1u<6$jQ_2@N9=KG`4U5Nm)PN#}32$#X_dUo0Y zOxzZ-J~2kznjmVaJhJgoI5ys)gO(4Ur0DlMFk#;(GqJ8n=GKnYidywZOs-LVR*i~o zIiIRMZA|5Eczw`8XnG(w{Vki$yr4B+nb|U%&JVt723@cDiS4aYBe#cpOd{bUA-_!! zH(KShy-Brw$i5xi%>d>xz}9agWj0>3#3R8Kuw zH_ohkCHAvOj37~O+#}+0k?3A$D4XAaA|V{~hpd$HO}OKnr5Cw?8^SSnyj3#Z=Jz$f z^_%F;E6bI2PP~zi>w*m=GP6q%#mo+u%v8j=QXREunmWQ(+B&Fr2oNG;t|qW{E*+AQ zfclUt*=g#ctV(@+Zr=FtK1*soy71l^s-$*cXZ2j z6nDf+RnV*pT}Ua+b}9DVnTB<~=2GbcCS`MHo*~khY-Fg`4GkTEOmrS?(FcAxN>o9? z<{YoGSo1Vl(t~W%1Gj-64T(8d1xc!Ysp<{p_zU5@Ajgc!sejo&c}CnnWQ4<6v(3cQ zQ06vG3f#_bD+T*Wnl+4CkMN~P9P}omkAlBJTAOCC|NjG%n=Kh1jtZHZneD$gRR75} zF|z>v+iN_dCGSAMiO}<}4`G^*GE9QO;cgCefDB>_Zxu!oZls2Ta8KkCdb@t-sttDY zh?(`gScmqZm_-*PqLE=O45n>h$yEKRqy{GoTRJ)n?!t~X(UDlW+mQ{nW7%ldh{B0H6S%xdpT*q&iYM1;!VW2=>=j})vp;O`M-yXkrBl}}-!Uld~ z$QM8>SV50Mbz4bXB*ha1BRPV%Gk=j1*)vegZ`zoksCa}~@Zlj9YxP@EbtWuD)pwdC z2($zW{~DIYAu2Ua{8jFOCXa+trS~4BoKvCfe2{f5^;U=<5LMB>HN(&f&hp1< zfMlxKN&F`@W;i4i(whpUS!qQG<`1o5xD*v24{T;KyEM~H{S?F$&v`NrHBknOUQ6J5 z5cPNw6g`ZsxxBE&AugJk$gH-HItltL<{-{1`T1d1h=${-#osQCm{D?@!`cdD@oV`7 zsKI-IkqCwZesn|BsQBuosF_1mTn%~~Ts}?PQjH&ept`YCcS>}ZS;QH(ER9!t5~|C< zt+h4#@1$)gHZ^bgcSHYAhF6-bE=F%*6xZ9w#WIgBY$hUD@Bt|D!S<3G`) zq;35t>DZdC?h@}VBNBtXd1<+p!2>&w5X~l%n|uQXVDjH`N|3%iP;XCl0*3xCua4pl zR^Mkw+?P89z52gBR2{zF?gOB&fr1ynC&9ssz5O$Io!MWWZ9u;l=hw&k@S*eyboruu zB;s$+@1Y}3Z(Y)xo1hw*q4pS0Xq#(6QOF}K`4{B}&OFNpRMndv8|D|k!6oJ=-kKUr zC~OaaTXv3aGhwoe*oNQ4K$-w46-Uy68#njZD!y|T_$GFcGGR%qCq#X#a^p3S9^8dN z`uJ?2kFF3|iO237@VJ-=-1YW$b~v=$VV`s_1cBt`(iK%g(Iv z-I?-zT7D?kiJ`&VXfxj_kB<+i(TO1utq*0vH2s-Lh;q;j9p}b>v;OzsbS#R9%i;~z z;6^67OpsV2$9b{MnN`D))uJ7Cv`0BTutuhWG#*4FhfmZF7YCPiXq2_;gX_}T82{fF zbm~k$MEvRAwe!Qxn2~*?+M#rm{F*s@@H0YBUDS*!(c6alUNPp4x2FV(`_imSG8Hq5 zvu<0OSS;2G2|l{P&5p>Wy&u!ZvuhJoHS!&EWTatrqtyIt-Ts_#Fw*PDO`2;>^?kxT zyx(M~mX5rF|6SUy!|sRC{6sC9Rz&gn$I>19fYv+9T-yyFd|PpW9{$>t4mtikoZDj1 zc4O#*u2TEz1@L=|sFs%JY9?V8Bgmc!!p|bKz>iXHhsZ(~|F~#rn^*226JY9+p`p3d zwcPPczsZ4J97w-#@!je0g;>cEnwS0yAA&S}niUKNoE`9A3lh}8R886Bf1N<@yXH@4 zZ7++OQ@itd(Sbf*KF_rUkl-@6jw4_dNFcQ9V@1Fv3;b(-`^^KLRh4LQYF=d&ahm$)p2SJKCm*_( z?j#y;YpjXl#2b&UnM!f#e>tVVusy3utt@-IkQ&AToIwXFogy{A_gt!}!ef0j&}18+ zf9m`^KO}dyN&}%Ea7ie}C_|@FSX=@R#<)~mIMmUulfcQX$4j4>)P|sA(ocMPD*#NJ zA78!kv`HAXIrHAG1&xIVt%=y&rfS7fYE;OLZEH)W1kzZt~8@Sj!h&RJmISe1; zU}@tWkKzYfMJ$TY)ca-gp^?S?ZG-Q{Bnha;4lqvxh)_eN2kt1RwR@?0h%C2DZSb#x`iu2r$7vV z5<;*;HX(Yu0LXHRL55W_2>Nb7pKxpKOk>v5lH74J)fd4I{0edl zC>$y$(;`c(7D#$9N#F1 z@o`~vpu3O|HbVTJ_I7V%7{;*$K#U-I2kV?&g6UYyHV#Kgkm-RLV{~!|J5So9yy$J=` z-3INDh@& zuYq7J@kG?+!gH_%Z)t{}&9>a0BsNx65geggn?o6bJ}4>#wsLOW>t-OvS+}4axOlJ?B_2)bOfINUv*O+YvoEzB7LBo%nr)V|87N_qc|* zSO%l+DGWkS-f%wClTZRb7wv$aOb_J57W?GiY&K6I?r=@F&^rD;Ko8Ce<@4h`-lPjF zL`3JznOdvMf=)R+f>i{UOEfRX1MRyT*i9Ty+qf;*Qhv#?=ugeO3)?YQ4^!%;YB%i2#K5a3P`aaWg) zgWTr|-NIDVfJVMSOTRA>kDtfV);32nMK1SekxI$-oh2CYoK3}yefv2w7SOPPJKw?P zc|}0ZLjMl!c^cPQvM#QYWx%uf_w~ZrorScx>Eu|CStTavwWz1T2cX zN?Ek<*^7bA>txr^JJhC~*Dl8M&nfD6AuR50+vm319oL>)WLEC_V+^qUv;A~ZKZARFQi#F$C=2XLFNoFXfr?qDuN{e^0ZKFje_JP+%B zC$j?o6f+qsL+BPpR|Q|WvS-9ef6lL2?0m~^!g`hqu{O--b17U(Mqx(cuVP=0dTm6! z)M746XhP>D>ei+y_`O+5>+Ckc-M360DN%u-nq``PJ8$|yVqb_ak4ewop>noQZ!A#`H(TVWl=sP1|}k0{D4@<+2OEn4w)`(eqzka58v zIRhgIM-@|Oob6IV1BsvxsXMKBxCxVPl12jC(pLCaJC9Q#_zKjZRs9Ar#M{B4BzS-< zXRQmtsO!SNz6U#Y{uxPlf8Qe*wjF}Scb)eMk1LCua=7AJDj4?7_y$DW>p zjx<6dw_JwyYdvfE19mwBTt|P$EWrScJUSdc7|Cfsz>~pVerPbigG*(F6OqNwBJU?( z23U&EU=&ut6irRW?E^FH#3nkZ1VP2!nZPd1P}o_aaX!E1%qxAidiW$ik*g-GUGpSt zqJ5|H#jot4BEjQZe!JR*s&W64-$dSl>UqMw8xdjzos@WpmHn{2yI3BT-lqZIpr}{KGbW*z-5b&4qbOJs1_&XJ|Mp(ChRH*A+KX`qPh(%kB{9A%c4Rk^B?*BcU*6#xFKWbsuaqNBUn{toi5IFEjGM==l3fKoE^a zq79k}X4IJtG^NoeFArb+%cN0JdSWypJd_GP1g+!Iu0U~tpo4~~j*GUug> zWrJ?$fxLQ?Ab{_DjhK_n-tP;-%zdm;xJ{eNd!yfc3eU zvx_XELKr5;CtllpH0dH{TggxYi8^rz0j%UN-yk}$m7040m|9S62@&c7WOPA#bK)@O z2qBhgxt*q*mlVxe0d55eWQ6<_bTWl@$st_rs`5*&UU7LyN$P}Fi*R+VA?}O<#j>|V zJPPfBkDy`uNczSJR;u_5 z{8S~jWG(Ramrt!`#{+lAx!qla&?6>?l`oo614~|X1;D4d6pIj;rD<=y<(tG1i{3ON z{yj~D^Jig2kf7S;Aio!3eX+wrO*y*{KOZy1`G?6lG3jr$@C|d&tv#PEK@TXW?>C)J zgF3_8+2Mrn(&wL0){Dg~mSbs|%|APA0{M`-2w+mIVGdr7jKM?n8e~-{^!2aAx&32f z#WJPA!)d!-$xnEIog!IC7uz4D!P+@jM*Ej)dU^i*Ooua3RCOGNZPC$1jxcnf{&{7d zulZ|}>LoUF@8IcpHxdz={J45W@nf{3NY6IO?qo?4`^;W?Ij+p%tH=hbd@2 zVRa`eY{5v$LerTh&*QkDlcLMG-r~cnW=y1e9epBF0ofA3U1_DUh7|Y;pj5(P;KDZh zu11KT?+5pN2GX+(a+~&!hQ^AAiS&1t25X`RQeM2;h2bsZmk=Z!eFwyD#3LRnQYXJk zCRhK-%}U^uASA4lK4tAocGqm-;!CFfI}XM87&(vqUJMEGL5MG(OB4ETnWBMY#qQ@F zL0q9|=}$-?9ywPYpOX1OxDst7C*loCzE`DJdo6(%<(_svqAbAR&Xpdl79on^-VJG0 zniMzv#1>DEYirPK<8F0Is)sj5#~^<^XyI@{J*hZO!R+uai0TGHk5~bNp~Nig@OFLGlSI2>>;Wx)QX0ls zyU+hZM9VJc7&p{cZ+G6w5@|5}gb1f5sO${~befcW;IzmCul%Pdm_u-I;bwOGM?%d1 zVe1`(Ba6Gf-8h+86Wf~Dn%K5&Ta#pm6HRQ}wylY6+cqY7b3e~}PMuSAf9dMpANoVr zuDw>T_5WR$EnAsOI}CT+UpR_=;k6U2sRYwvI(pGmr?6uhAJTkN?(f{si)&lke1p+u z%Q9L=P7PwR)9~~C&gv? zKOC96+Lo7uC-(MR@1Qc!Px}9@yJ1hB83z6S#RLGA`eF}jZhWBtP=M}kqb(b7bMdXF zJ0+93_Pjx2syhDt+;4~tBH9C^c|wv$b|0^k4!;xjsd_FcFdGEEU;qvS(Oceeh?kS@ zy&GGb>x7%$5B!^(7aVVNqnC)q?Tj$&j&U2d^#<`nGaI=rZ%a;umA>5Xd*x4(%yEC} zFQ6d6QC|S_!gi!x$tV2qu5TWoOMT6~$7`+`=Qn$<4Wb0Hinu$Lz%#isXmU8`ogh1P zzuCV`O>QvS-tezgrBT&YRYmxyH7ol}1v`z&PsK@`HC2De=Gz@rO0Xrp7{@>@DIFY` z3}at#Hfu|rpZrLqkB;Mvw0nh}f=3H-sNh_lsWqq|fw&miM&sAq6@ci=9RJ4nHoxRq z%qk7sQ48i=xb$1E|C})(HfQ3m>;q9z**WR+DAie0NUxl zUqwbHpw7rQlYFiDA=)%?{nRS2Gqd<^`U98hek(xYsG|hn zchlQ0J1H13i0jF4-@FGVJ?lStu7K>jfK~1V)!P?D8Es4CTUL$P;UtJ^Q@xQ4I19~6 zT*ak2p*@hnt@?lc$2VcCLSFG6FCV#n&n8dP{GSk8NqwQ~r(~=4y)KbuQzC#~@QKo4 z<{{H8rcy^}p}d_&ct(h=Ztamr@BmQKv#jip2LC1zUyut8`3y4p#|yv|K_>rtX?O9n zNR}mD<%%CdK|*o(Mq-=4cJIH=t>EA910wYvV-+6Q9EfP~+K4Z2P)q~zP zB$8Uj`6m6i-}tLw6$2(N^AFvVEJ%Y5)inAQwhH4g@r;Q)7_c3}V`?=Xec(RD*qu-` zgu$Z&f}U>Y*#pyXvds69ddU!?2)*;LB8R(zLS@3-@|UrTKIT59u_8<@K!7uY6)Ba~ zCU0AM{UjR7SoG6D7G>>xer6_TxHgh||G~Z#9(kbN8rAZSyCILNBqfwOmy$jNT+u4u zcgB^HMo+dGHUhpo2LXSN0YIKhwdh%)ilWLgD3>*iw;wnluW`~;780wC(&7+XAcYZ5 z1aZ8yk;dnlvLuQ5p_@3{Mz3Ot3~S3|q>dKt_Q`n+TF>&V;oa_|x@KE|y{v~gH1Bwj z)awGRtv-ZIkEMg2&kX^i9a5n22g8RR?&A;_2Ty&4Ivc_S{8R}c1W1U*j0`D)kr#5& z!75Nas)~M{RjG?tcsDt@{gLH3j6CFQCmo#Y8LJLik+z`+^b)e>2@Fw$D| zvUyS0D9}X0^)?V@P0R~v<(>`;gjV+s|Z)5Oyu1 zDc!A7^IGA&uOC{ic2A0~z$c8&I50%1Y4JxLv6F`JmQX_ll=#j$h%NEVv$doU8&kAc z_;3=W^vuk*1}o{zg_CS&3{EgpTp&yJ8OA8>%%tAEmaEW#{l5+4G56>n-QGm~(C>a87xch-aLM^+e^ zjiH}|m)H@t-Z;k`s^8W&lh05{7yxNUS%}z9#G>Y8{T|M*MuBZfjmo^gO;G1Y8t-qw0pY%l|D5Z}`tILQ@sHJ}~t=rc3i0I$~3qkk9m?EZuVJ2{Egz z@nkgjsPqb>8@mNo3Nf(4^mS98&o#(8z6)Mgej}PcIF7&$;UHn}7m|*(5ePQ9H>R}N zllgq>IYl~4*HdS4fdw@2NvV58D>L8^w-@XbM9JuV)ejpNcBOk@aavyNtHHY!G|aKG zWZbDUcyiqma{qilBjcL;}3|D_mlKVck{^eGx`3-Icdub z<|lWJm`1UjxLbXbm-paUsr45A<~y_y*2>C%Z8!dBmIB7io(Kv-4Rrp8Ld}l)6?eK$ zHzjg&$+uxppo?Q)u|+`_-K+OmriaH5Yg#6i4iFi31bmLfG#4HH_CPi;Bk&MI_BqsN zKTLk!P=0zn*xj8@gm7k6V4ji5P^52=UH=nBr;Inx(O%U_(HY z?X^+c8pp2XnM$`edBb9Gk7-&F63K9n`$YC3V%MR?jIthB$97E+gmU=eJ# zd!$*?(ZG8ucc?zjnAz*=QImNa^FwK@(q}>@+6#l~N=LmF*qi1RxMyfufTnET+$r4_ zxg+w+q}}9_g;`SUZg#-`6>T{-fPO#%DbINL>WM*p^<$191cZq6=cCpJ8+Sd_NwykMr)}|g1%?pNS^GpP6 zXkarZ5{+7=0rx-TNCCdVzRad0Kbn~zQK3g~o#-yXf;v-fF43m`TBvH<5rNsjyzF8; zW;d9XzfrErzeOp8TvjEC(flK|Res4^D3U3kPir&Ed*kQflFEs17vz00GFe+9n8kIk zg8^UoC9z@WJ}l*3z{Br$l1u%d2V+35jnI^2H+HX>3}nXKvGdtFj;EcUgfE{^*eYu` zM_FmdtGy}NyC%A?(MwD7#mFi(x31u>@sT2>Mt^tUO^+J;NqXyxWZ4c4w9l>mv{Z07 ze=|Ws4&~*Y5Y)bPFUW5u;wz_JTP#GLDXF|VeJ>feY21;sv>Q*Kc1CrBXFdrz1JkSURweJyF?pI;m@iSpAI$m zTkDsl9CQ(Oqc`=4Kz@n#9py5o7E7g?I}}2RKC-_Xi=D_7KjCYfbB*8&QkQGGH3_vI zmIStm+Ql**@Wtj2XGYSx%jzQ?S;FlRJ=9e@@v3|Oul z2PB_Cwc&HS^K1tU#x&IkY2k#x9poDIex>)pBnx9M*EJZe=9__Cu8u|5bBQ2W7!IXS zZr|Id+Qx*|NSg;}^1E|I*QN+Z4j(0qxy5WKp+hNedaV-4_ z3BymetLPMGE$)u!W~k5-jK}QFz`e5#gnbR2t}8NPX5468rT)>U0pf;>J&wBOznL0L z$>!2mwM%-*=nyj%U9D?o=)iqtK}J!jr9GRQj)T272=@}p;ZX@4fLHnYtF z)k5j;GHd%0QVZRgM%UaOhQyFU)F=plx*FphzDb?3sEgBjfIqG6`eTPC@vyoaxU#rAlGr5w?^vp?UPAahL3aycJMqe zv@y6cJo>Ur_di9}KoN8bdOh>Xq4MN*aFvy9 zidNja#UFb6XEaCLe%=RhwO6Xxi#iO83)OAqWBE3SqwI^}PFjkjl_jxi2^OLo)8QTF zJt=elxduj|AZ7p-+>3YF>+dN{{i$zJUw3)Wz63Em)^C|>C>#nX(|x1YtED3TK8r<` z?~(AQ=6FMsa^GnOYg}Jal4L!|XgmyYsA?B#mdS1%Bq8rF@1KCP7C~2T%oWbVu3@=; z$mBJbI;wjz=YDxxCxX8ITQ}09>zThhxd4sF$+YR`k@DzAp;L!_7haG8dcpfiB&#C@ zq=?Kh9UIEsz_(W5Puo#Pg82#R6%2IAG!I2gWrRiB8WBB>x0(&;*;nDnMY{3?3r->X z@CrqFd)+BKct~W{4S?4T*oQ7qT!u!I{r%V(wbGRjV*$1cn4QHi2s9ITb?;Jxc0E8v zOm9RGt`+luP4iq|P_FQ5DD!)X?)*}?>gY5kR4R>PBzORJnoX`<*!m_qZ~k(kb?-&b zsptoG(~;<8U0ia~bsNNAi4f=t^R)dYAx;t&zgfu5|Ememg+PrSObc{!vnG-76#e|k z3hz5?ycALt+f1Hz7Ke`xXN%g&zoCCa;hdpx|G z!bV@5-obO%^#s&&-=|VmZ=qKU83vdsO!8O{qqhyt59i+s)X=JQ3J=QjAT&?v;yG10 zN?@wzIZ6PuidAhmIiut4a$jc$oBpNG#jg^ljU;oxw?3Q^Bo^Jux%Y}*czQdrW?tR@ ziHIwX(`vX!-e&r|;Xq7lrdwwDTNg##S}OgR9L0vr?h49i)@U2d$chw6NddB)R~bX< zjepy|38ngK*QTyFH+K5>go9HgDAONy6roS)>HsK5quJJfYlgts|G#M3|KN7iHSKpL zkbRHTHR^f&(789dYQ%Yv{s=uPR1ur7mD>byw~T1)1ukDeeEd_>A7H1DF7Of9sA})J zETgY^Fflx9-dys$x?jiECWiG{Yd)lnF!+PF)I7v5mSwDc_jRr;=^EA zr$E+KAU?Ho{Qi5~Ey*U#3c(^k(9@x>jDuYn%ZDLS$g?r+l37!i>uC|pSo7Vl?rPKz z+*+h3371N{8(y4$C{TN7{x|m8E$!62SM1y|;kn^6is(+ORym!K=!hkTHOQIRB!l^Z-bE93{S4W|IsVZks2F^z{Hl`M z;oCRp98gEK4h4dvmCs1o&)2gHloGtip{==*immRBuC&h&emr(TVr-7G3mQN*T^#}R z$9<6j>uM8C#g}3^v`r|8neG|;plBI>U)uRX63ZjVK&f9XR(Ktdy^L#O8rs;;yw4R< zG=)Z)HS@Di8JJwA$wYnMe7}51XUQVI%=!h`5lPrdDt@KiRM| zCmVQW<*Rq&I{0K~7ia$M0NNhudKK|PH>$^)2M(TLYSoL>Xeq^3^xX|q_VE@BYQmR$ zf^7StN$Y1rTet^MN`H)Ti-EIi{i-vV?BX-qrrZ90mXmU3AZOtY{yJT8iSSb33H9SP zFks$!niC#rqlBMx%^i%%H4A!biT7~C7rKpF1D%13WlFQk+A`^ChL;%{pOwx`r;QFo4culLQ z^9|ZYvF!>)$pPuX&9V##B;Q>rl*VTaiSwUEL5GgKIQf{vQ6rNl&&5gKA0P4JSFBwD2a;b7^4YpGUN zIHyv(ccBW9>QZZ?gv5^9%sNyoUZW#f?(tMX;ZGK{Vo<$Ub z1A#_V8sGY3U;XX~RluxJESegW| zhpc(XXrkJc;Qhs?7DJ-XD)~h$#}Z7td|9qAwK80GZZzI)+``J+BO>G^B|araCcE4< zv_b)rZ+5~v%CYvAw<#*)|K?TZGY#)RDc6wx+M&Mwjhb-HZgVRU z0g8xETvl}kKGng^eLSTU5EU|33Oao?$Df^g(q0#g01!IA}N~ z5sQV3=I~qKlXk->>f%Al8=;ekmDsXTp&#>M$t2G@@)rKt-2uEkLefKyjeBqD4lsRN zI*osCVNg+a-)C?S8LRRZx=lQX?E{5ga@AFjpBTnJgl2erIS%u|0}v@STe6tuUD+P^ z%-g#YA&<>*^FG&D;OX}n);W!U$}5qDdgI|k%U$|I|Js)a7mR@{<({TQt%!`GW{4Dm z>ajeOGKImU!->d(-VN4J{Mf4*i8RI8tMHf9GWS-_(LY6HIr@f46Juou8{w5Mgd*7s zSubHc(JLn9r`2Bbio!oZ8viZFo)uL%5O5#-K7Q5VoKBl@AlH!i9$E1W^fdBhibl+9 zrXe|L+N9&+Y+auH=GSCurt@%sJ7Uug3kX`3bvI()*Gz0ltYOhSfn_bP)_L!7-dwUd zyi(Xu&jb5;*HG=+vpg!Kmd6zH7lAu<`AC+qA7$}Ll4IU1BOlUm_?1)q3{96dk2#GQ zicih0K>GWP^z7xZ{Z$v&^B$WwOp@RKZ`Pi{O z9p;UT9}jth77tn5q>Nz$*SNKll?wCj1!%jl9b=a7S7?Y%E;LM-B+5m{Xs`6eYVtW* zy*%k*So1|>%BpSxs2k?3aafh_k_(}YmY5MgROQE&n+RZ0=!5z}#i2ZEpkfW~b$?!V!zI`h|bkVUsjHkU`9WuY4Jyur@Og|X5%u`lF$Mq1{ zonVd3IBUMrL(1hf$i)P@jdSh&7kY;>a{&gV8Tkh_^I@;S@$ak3I zQ_>Q&h=WaFsSDod)Mpb8;+3CZMQCCcjVj|L$nC7$1vnuay=lW^=F9Cyl2tf{xYY+! zy!VM%nJ2SgGJ=K>m()O}F+mP*zDW|SE9y4K{nlQuYm!g9Jkfdg>+eWf&a+q7Ahdh+(g`z+ikU|&n?$tMzuV&U zx*o7ibP2IYC3)p-EfY9}i==q`G3~vA%EEQGSL=g~Ri3FmpKVjvlI2~B&Yn@OIe81^ zGA*bFG7t%WN60k^5$s)QuD}jz;kue24zP}ZNCxQa>4c^aaq4pZw9|;L!}b;yPP~Vt z-m9x#4p49x+582U=6FAG3|-w1xrC1Ayui5;qwh5Cl{w{&?xFSTn$Xz68y;#{+&G38 zGLT(jISsPlPe|lv0<+*$O+E=9tQ=+&)pi^Xz?troHAkhKcsU!zy74XZ#c%+U-C-I= zB@VpUuP8{Y>@U$4`^D%q^%+g5y1P^*XT>1vwOk@KtW4|gOs7m{VFpnuC}aVH;~~$0 z-Ths)LxHodlnf5N7nkdsc@kw-8#K zlY}g&e_1qx;Z$J{7f+RTbTV>DIL&^&ZE*ord!0lOd zztVNSdpmb#DpiX6xNjB?h#jefI!`Cu?chdmLmk2DL6uxZ3r=Fx%ZsBEf!A0 zk{yvom`S2n-V8h(zMymd?R%{m5(qT7+?`|u++01@sOsl;%IQ7Eo#a#qoFtjtsQal1 z*XFV?dA;mgZCSAQwj!1OXfT2LsZ>OMKFaqixOK$9^C+?VP{fKy-A4Nt->rg3a=5pa zz)!hOJ-v5u3`a`b|57slngRbk+>Ok)C4ankZG* zItgW;OxwA+w#klR9EMm=J|4^&Ib%3G&vgqI`=9ST%xnOb;K?EXNrw3B9(vJ5 z)X_J#$ln#D7&EV(T`i;&pmk-DavHl**f$g*dsQss^{<@a#bV1hNMUTWT(Fl(5fo2s z^5vO0!MU^z`E%GA!@h4`wS%uE0@&3R#M#9?A#x>u6t@b96sWHoE0Hp5Tcr)rO4qF< z8Nc7jjeU!+Sdm_FMu9*Hi-LaoTOfhN5YwYh!TL_gcRv2-FI=s4kT-+?)~1WX=6Q4Jex$?P`%BHCb&5#f6+m{AzvEq} z75uTygNT-QgUMmMJ zN}?+^G}a<}E+39^m^MPGsID6)6MRnGSuH|U)ui$K@G6LEz{RGdy&5_q^-btHMO6tH zbs2tpM{c2YYPDTYbK~#Q1mJlkDGFM%y{!;-VrsuPZ-kwIkNrBE`_;vKONu6@mtd3w zu-pn~BJEeKrM>#a#NVaUpGNxg-^~8)9-94|9idJN?B6tmb-dVSKW#YOK0%bWai^_GRd;f#V6p<~P_QwpK>vb=p0^|J8P0hk8-$W%e*#Sw2{ zLK#0eq8|HawBYlQ5mGy6_ZJ;6lDUK|hJs~`lPnjeEBLfzK!WeZ^A;Auw94WM6}NMv z-uZ87Ff2VW7F-YV!{kDGUWJ4V)b`U=zVsuK9;Nm-EvyYh6qPAb#k*xB*E+Qb-CbZE zxT5Y5k=7TgYAb(20h)#j30Aq8x0^78`!%70tzj0GsfJ$7rR7vpt3kCB_o|+~QA5#1 zPnvRTnXKB=qa*q3iof*%PEqFprqER_WL7?ojxw4O>uIc1_0V`@6LtmRz;0Ky!BLwlPs#34kh_^u;KjU`M>Yd#!?awf<}{?Ab5O+V$2 zWaY}>&zkxjhKh0y{YgG%>!kZnyoTW4rafNyDkpEyV&R z#ILm=09)OCNSRz;VTXm{AEsV&lI`u8XZuwrgD28)Co`zF&cb2bQc)LgXK=_d?cE11 z7^`ft%opt1Z1eFq-Jbwq=KhJ@@gG1=@*& zXVkH7#TxOeTMC*SihSDfjVK#6I@aU9RPJ9`p`Yt~QRZP!uM_Ri?4S)26R~xNoG3gC zuX~d4JFX1WqeSqQ=fAAHe3rDUPVMwZ4-bky75Ycs1N6{sj)mN`sjW}_s_ZsGyg&_w z{@xz@I(f1H)uCvRg06!Yvxac(jkTxEKW)%f=V=#gr96vwa!7B^que@3HEGY0xQrlKq6V6!+uGwRK$O`^+7eQ$^C~aU(r$s%H&xJs+ zFuhtPFVp#8_?d;*mc7~S>CC32t=jkE!6X+wx`81nhGrk8#@3iX;+Lb{6KhKf7Ys6b zi@hVJA<&H*lGVTqZI}0nck+x?0IH*HJ@RibYxUL-A~XndCM}vJ=J}6P9A6UC`5V6| zyjE2-(9oz-?&{9wr#Q)i(#uJq;3t^_GIRC6`p4=ZY(Z#37y0eLk8j@7?zkb3?tRH0 z{@3`aUb+(?*3iWGi#grte*UjfA$|P{U!-6fvI#+zV}m;g=?k?5a(oMj;6$vnIRSDB zJXK-t&|3&44sbXbm6yx_fvRqvaaYdP2SDDDTl_V1AO1f1t#|g3m*L)>G08#Lw0V6V zQVq8F+c}YSMWU_osnSCErujeEC3D~D2Pgf1blUkGHaanN>a&})C#mYQEY$_)iT45O zsE<&HZoJhcH$1aVE9DWKXyFWnFd+Iu zNNFv!X|TYN_s~Wh40UKV!B0Icc=M-qCuI{AELG|%%TD2mJy)}$No9q_;`QxxvI8!& z(%b254ORAa*`FS4Hna+d{{S>q=*2TugAZt0{{5y~u81Ye|?z4Wdc1f_ct2*Nj2 zX=#EhaWxrlJv2ia!MGxtUr{7^D71R@)Qe>E_ZV!ic@wh3Pm1=(VF%jU`Yn?jhqRXH zNcg7s7fJTLh^5jtO#EjDSb$?Kn{vKM@#SEFmSC_s9_{1?1|<6ZSXrcPKa}e&=Sn`2 z`e#sc!DVYwy8Jr9#Ba>WC7Gx2c2~24R>IxxuzGS*ZEkPsb^t!(iI0si&|`6=ELP10 zcg)x@t9V=ORHaVKU?RxHZ}-wl(1GxfqkA)`=D+|Q5fGYTz1g$m1Zc|Ak+K66zXke* z6CSNtoQafw2{l-xjdC82HzvBXToHYE@wcFf&&|_<@~Ki^1kw5LZd}ec&Q07Pc2E(w zgz_9?F+8hFQ}^n9ttp<$@|xlJSd6c>_K;_DYozFoaj62zw@ps9=|Cbek|=Vx_Bihf zdhzP&JZO5FB#$d=fop1s(@K0w2dyj4t!G90$$5Y`%+s!A(+19A`SW(w178aoj$fD-Cj-rS!B4KxG2x?_@2 z-Q_KsciOO!XsQvX7XG`!#bze*`j;}%Av8}%T{1<`rw;4VmcU0ThAmF=1{7(zSa~pcyz3nh@Mm zoiAxLtwC_!3HMe{l`d=&WPN3M5`dz zKKmOBOwQ@pkd{2L%th68q_i>yRJg*`#)K!`rn?I&4i-&f9nD}f9Xon!9E&p;JcA*B zYQ~~1Ya+9-J&4~WZ~X?u!5q}(5V>V%+&ypn<)uc4_amxHZb@)jXi`YNo1q~S=PuLf zp{%Co9hZjo872eBv_PsEOxFoT1N45d-&cx2vReqt<3m|M>tNsNf^=qa`uZcQh~dk( z!{@S;W*Y{2i|>|xd>eNi)%@gEI^=#gKf31h2jTU$B4AjXC|U{->sljjWRQBC1u0&z zBl587N)iCPI!y+pMbQV{s>ogf+13%g4MawGrk%A=ZzzC^KSdc@BxqztnaOWVI?Ti{ zMv#L{W~n}mOopv|8U#}9K^E6z^^LmpyYD?RpvRT%!_5f!?09p=X2>pZ?P1-UC!D!d zKDb+tdHjH#ZBvBUw<1T1=@}x?pH1c3lH7MD;oPq9I?HDadrhLbv9<5Zlo>eB23Qq5 zB9y;H8B!Pvag$T=rXxgzj{79ZR?`RLl_y0DZNoKl-5zkw6Q_&o2|D|e8p~xo1G69} zjW2pcLISVPia0jq4?H}KRjF#%b9FSK=8Xni`|E&h)wsNt8s!D9CEfQ4u?Tso9I=q5 z(OKfb@2as4bMMup*3M+~u>#?6YjUQnk8kEk+I#t>;z}-4tXNr`;DyHs(Gu48XhVq+2@c+44 zkzJfj4Q>DP_CL2M6Vv}#c)t!R$1{~v1C<&Z|6%h0SNbUD4^+|e^|5#& z&5cX-t^_?S@^aQ#Jv^xLHKzx$cg^PhGeP&Zf5Mp@S9SpKDxJa|Pjd3h5(>bHbjiy9 zi#B5212!AG@w@cORIp+73)^csS@ln2D>2=cr0_W_?HOvpFTC>VmnUBQwxnxFndcT} z*&@r0T=v$e#w*8sWX|3c8(D#2$!{$Ns%y+8>!CS2eSEXH>JP6MCq)nag*N<%V0c;h$(9RaRZvD(fe$L^}WSGLAfd+hV38)hdu1Y zS#rnUNn}x0XcC+>f9~#g5UcYFRs>42k`OjldvNZFl9qwP zZ>*(3;P%OGVcdHfIefV<2vs~1sH@g719=wdf~xDDjo*xKGAuBumc`M&+ipZ<*0MXm z=$6}ET1t=nol|b>L?11=|0j4Og>EDvOP8IZS~#t3~)4x89el&g!zGkD<8v4_k_^w$_mE|8;4Vy@ec@n}r9KZ1s z*#;mr@W|F@lxP5XxgQmZT@KYcRiTuLQK*J|0}jWw1owMeMBT| zQ*YOvlJa=Zj(kQVafIitSi++yy#F0)O^@3W*k?q?Mh4;`TT2_kxJj zx<;UXEI2NKTRy&1-dEG<*eN4VG$C*bXFbm)w%eY&y}wpNk}Mw6+{Lx#9GkWIZQ7KG zBAZ<}J&O;;Ctmh`$d=-I+NKq1g4B2 zC`fIB?VzE3dbsxC_^oMIZRp}BKSe`Br2TYTdQDbwcOM&(5Ije3mpCjk7fQj5yCT1v zR$CQWlbNhZTjO2OaI6`Kso4bih}tuQeM{+H*x@ZH?Bliuq5D<&;R#56tQr}xnw08$ zJe_O6anH@Ie9I&iX)A^wTKR*AeCk-xRP?YHbeOm5J<><}pQ%N)EZ!{u{pSJbD!US2w~2xp`G1cKGC_H-|b%o%WrSg@_|r5 zya$Aag5NnQO$tw&S=kIB-tl%nN&#Q&9xMsrWSvefztp)~x=jUZ~Pf6sPEsZC6!1%6UHO^u23Eeq`smClGe4TLr4ypEi z5osH_Yp}P(id7*fRnoW=?olS#uYwJ*GnZw>uv$JX!bcJ>IN1XAgx)xwM7N2Z0Al6Vl%_~>)~x)YDTbw^cFXIGfCN)G9QbY@*6p!0gsbyp6*Zgx8BP4&v_e1|q z8s@++oEIbqNn#!WlsDb)Gx0N=))=VXk6&O&+yAq^~9iCOk zhJC{@nAj}pPnkdcJ12V^ej^$v>o2~|@}j)yl#yc^E10Yqg*-7UBxSIh`Q7lM(W}U; z5=|)NNtTst%I1K0@aNXP9KMq-yxKSAq@1{2NG^)QzfsT{qfLOWeV^RYH?sR2l~*y) zXu*Vk+hHbbdxx~ni5pQWBloaz{UDpj_r%Dt>V$_9bs>xMOd4JrEhNi$*aDXMZ~ox1 zGEKU8E1TpUlER;z(~6T2f3NxwmOR|R*gD;N4RBVE8hvYDbf6}sWi%Q6X*ezZ=Z9~l zs&Tl8{Y~K8;6?l=NFijF{eS6=nHc{ELJZ2506_y(;*8ks{e9Tf&rPSwsXUZBMR%dx z5QL5&A##&T6`+zNPi2y|(n!ERIJ;{ii9p|o$>74O@OrTFd?R_Q?;p?p_tKvnf|T7Q zy7D!lDKzB%wLAs3r7z~lJ*EVtitL;la=aBo_Y8IueB7RB=jJ~F0z5u1 zpCo#9PtJC@z5|+A@K258hf>XTQN#1^Ji3j8)n5mdhlr?dSJRT4@Ns$w*ueEM40lU! z3nI^}u?)NXmadIhjtU8&jCaE5 z+`GYYzC15+4M){y7ky-tNzP@Xy$lqNig&px^1oG?!>H9xIszw4kI8DZR{gBZ%>(RZE*nXrWfGAP+pi6zwo$Zx8-v!t*8U$?p=K;-Lc(su^)y zwtu|%lU|8HYNi{Z?$oSfO2zJouB#NQt#zy;F6KZiSgq(wQi7XgbIXKFm)cfS8&_x+ z;knY~bg#mNXVTzmBD~8$_KbM+0MPv>{_;Z*`b#nBU)6#=wNp(fZ-VwAzjuyvkh?0& zn@XiY^OSbB3mGX@nSYZEv+@F!!Vr479s0CcTJ9m7$LMHI2AViAB(ld#zZOp2zOMul z`^S-XibA3ccW{_N(jqE6i;neTLY2qtBKP4XZKHRrb^8OyVGgTX@`zN|1Q=W~YcJ^B z_^lD(!%a88h4Uwmw}{~kJ|j7gSC6%pCS;y{om?z%O0Wy2*?{gJb<4op``o`J`W$yW zBSqF-uw~00ztTmcroqO(&}7f`m2&1EA$ha|+tG1Qj?ObuyYOJgBEJ)_UnMK>OzH)Y z2nWarL>vbKVMKVhHNKfjvL;P$uj&b*jrtHX)ScIRq{ens?dhN2UNtT^Mlao6QSM5o z2p<PJy}nqUKAHFax@eXzRZ!=?SA8HfqIkM&G&(Bl7Mg1Z^!$}rIX>P*#6 zAxI$C_hzV4>v$rou?o8l)>pwllk_{AV(pP2O^|0#FujqXH?GC@xk}TfhYGQ)ELP(E zl{|&DW8QwAbQ`noRU*6_orUI&&g*%DgxojL|3(IxemD~3oTUJiL2ZeBy3yb?9m;fk zq5drn$bcaJ(QQrque5+0^9HLH-w4-kJBxhzMf4`6-r>9hj(a;^SSW4~%(>rtB{$z$ z(emwpV+H46vUsmmj0URrlzxa+hE|y)ohBoqWP(F@Bf@VtmAL^W+ajz1ym9qKb^%2V z(0=a(@;M{L8+X7CGMdX4uju>~B{#8phZJ4j9}Rapbops|uiA^32m%!nhLWI7(v}RW z1u3pmS+i{*S&y7ify{TIou7VqIZCr#hnHaUhVt0``}gB&m~nXFr6!dj^f%|^pKjhB z#r7J>)$Qr{r!*&cH1J%YSE%;`ioY`MVFm7DRn$3EyafPxLWbD7ed4GfKU6v za8tba(qRj+A(A-!(JX9uowh1G9}wqd>O<9}G2yq1$osS6`vT%3ktWwQ-a6M@0GiWr z&9LKf7#2IC*Hl!pg64?v{%rr&Oz+1Ytuvf_DI|b4cl?cKP*#^_^A3wZMYg2yP7fWz%k+jh?tj)fdf|@X&r~_AG(s; zK3rpiQM&RT7K0n8A^zL;LyF8h11M?|YzmM^@X1m?3)8hDCbR+!ME+5Q{dAL*uRPy7 zi1GljO?fp@@(v@h;jKI+{ya{}{eK4nis>&~~GsP+=?x#IXzIy^x(eI+c3 z!FP60^dQ(A??%dag{)uN3ZZ(R@^!_Uuzx#W%3x*Uj7UvvMby!{qB);Q8BUK;yL+S| ziHLwK#(V!=U01{{V@0$4;ppRk1cTyXsSIo7L6NZAQxl|-l&-*1;^7RpU97C>-( zS4{`epdmvlz}@C;H@>sGy+O?Vp=bp_wg~p=zha9T9~fR4DJS;)LE>h4pXgd^3FQB2 zM`(Lo#hv+;7YDOfH^^2_RJK(08DP7s@~CGY1RfA@CIq>|-vwianjrWvFgZ!XQ(AYy z3$cZ$(JO2qgn8khqCME=IdzJ*Zb<;DG6=?Q={M1vwvuIt_N~xK@Zi1g-;RJhqcDc5 zQFoPbYPQ5dr_Pwfy=f9g6kJOTwT5nSN@*Rmgn>e>@<+~-*Oh^~|!iLC(u5Jn}T~Z&&w$I3n zyD9O#d1c;i5k@yqIjr?CZFk6s(q7ixM0b1 zGfRVqe}=8FvyIC5W05vt7-?E*BQfoTS6n1lR&(S|Zfs8*O-3i;lgfj_YfXAk*AvR; zt8HYbcG#YimbmG7tTA$JnpSpZ@JEZ0dSx#c^WMm@)nR-?Y%XT7wRUk7f$;4 z+cKeO(VamcWp|jW;(ZyR)5fnlu{}gctr-;S72GfPXr5=+)eKsoC+O|+Isln|ltBsZ2@imN~`06vp-DFvg#HZjMht*Ku#2Ic? zL;=(vQilYz3zj4!nsrByqSz}O?KM|x2Q>E}p=F%T-T2{d%vT=FTJRDSxZt2K_zdo5 z9P*?05Vl2oIjUi@hWG_}7)8_LVDp2T{d&EYYQ)btF9Z@p|A(!2?9MFe)^%gswr$(C zZQFh-wr$(CU9s&{?4)Asde_?LeA#bn^B;^hdmp&_b@g#(-FCK%*Z)&`JlI%%_7dc>2KXB`4WM~uLtXIa4Ux8WSK<+~Z0H}tkE)mHW$J`T`K46NM$2gCPGf1&tyB2sDaUr=s$52<7q})qJ#72U6#T?L#_f`RT!w$EAf%(<_e|B81x%U7a#+O&Wv)|P!9^P|*)Kk%t z*O;}vb2F}oDCNZW&O+G}Db9lA?Al$X7PGXD!Gwq$phkE~jo@nNiI-(6_e|gAa`6Ir z-yE&un#mOc|A4Jp_Dti^@1x6jvh5`Y`IwDG%KlPeU;VNI6*`kRf$;}$V&+!SLhxc< zJ^1lSaF+%ifx&(k8Kt*(6P|%$ahRcjV`~AGI)Q9?@bqs~NXIxrT57`~+i+T@YQbbiYRV*G%yVi=HIPC3 z{>rq&(fKlSL7TouD|dZGKD6T9nk%(ywTgIK!O^_xMz?B21v?;+YII-A!0cJ%|M?A! zf~6RvuJ+vt#Y8Swk}HL^q1E%37RsS1&_si#3oAfC=aA$qfB*s;^G(m6vP!CbEkdE| zzah%mlS?a`3E<@@m!T5Q1qjU8g^hB6GJ5o<%n`r(XtZVXaHB|!BtfOd|}cU z9d*3zyL)2;S53U?QeZzepa8Wo-J@l1kOFT<3*do869Bds-dd#SbIfF(Rh5@~IgT&~ z#+Y%N9g`)Cf_x((3r4u%zL~a){HQt;G6J6d*^Ds>gkYQa~|KLP{Q}-cp!2B zB=q3E$6DC51gX3SEOg319|y3pC!r4}RM3_7>9>tUKI&_b9Sosgb}Zz^+Cj8o2;)2a z0WSUDlW@xT`klNP{egkEF%kfhyh4LyI=@(J0{~RV=6)v*fhrs9YK$f7e?^+<&@i4%fnUK-(cWKUZrMGgl&k7;{Tu0_ z$-8z_c>S7~0Mx&C?oh|2p5^!mDn#`iB309)xMJ63P1sK!qC>uJ7c)pOxUC2t0hDDm zk;S?g?%bCG7inCS&Ndc|j)x=22vh-iyy)!tC91>9w=u)?rM^*+Inl8wY0<%!X#QeO zb{%w=Z9iWoH+jRrn7DmpF|)7xzdygtj-KX--ZuX1RouVYS=#b!2_H%j=U)Tpn|~3A zod#6?Q}unKJtuY=7!ek4j^hU1DsUpL5qPgiqC!z%3iv2qfNJ(1sIU#YTIKst^!Fom z?>xoNIN8UYZSwiNT~$Y0etbFoob=C&9R&Z^tTTBJL{1JeR>HFsS9^PKi#SooOS z6RoaH_Sd;xz|OX7i(#iWvN^qNt=N8ZL7otSe0=u%9hj_Cs_KfzzflMYD3A~s={dLd zh__!cKwoaRr#vy)OByR=*5n9j?}Z9Bm+FaM0o1b5L!fg6(ZUb|(C0m;C7JTD9z6sE zXI-CJex_>0BUa3+Fw&7zSyl~_ZEjJ~a-#NmqwUJ#Ra`0dKo5KV(VnRRHVmd*B} z40qU&HV_xG+mT~0t9SG|=I!Q-9g8Gy1o#iDI@ z37N3pSGtg2`ra<$8Yaj|$g~SthFC6cp^%YIRwMpst7B&XOO+!jGN2kPP14Q)UoJdY z1DDc}o7xQ2v3RjUgFecUY++siR@rh^8TxE7eWIde9`jxQk&WBDcsJ~!yy}k_#Y`t| z{|iOi;s$UixnK3%O&A#6?!*j>c{@0o-9fDA$!qQ2rF0KLV^L_M?gdG+Dm3b=5Mk*gZ5rA+rmka7Eh10DbNOfi0 zx0-iv0*! z{sX8}u%!!*8*;l(&_SKiTnna9^4Sbw?=+Ajpad&=#9tIJ%W;k8uJ(I4kG`!jh8=pb zLg9s^&)|iFAu&Nao9@i^{BoDwJ1{E`Kr zY+&F0gD}3T-(@C};9*m1ncTkR)@aa#b~8kyqKW{>2H7GD&D{!%mY>DRfN05ySr>?y zGHxP0OwJ9orh6jp((7u`U^w1bxzb!15p<2Smr}wR$E%v|$sCL!zOmk{4_dltjBntcX#u!oa>yx9* zGcRv^iqS3Wr&cV)4(gy{B85N1?rSK<-ZI%wu*62@Z7!V(?j}I=Y3iBRw$>WAVKU1F zXqyXY(AsJ&h89hYsf?vnV+QxAP%80B9QrpNGEvPy5(an)z`x+awD9Fnv;qCUl+M_a zj4A(if#8n|mn~9e<0tDdHW8P7wi=(mcI)c1CQ>u|t1^`%W%UpQ={|kj?7Wdg7i255 zP&EnQ2@~_!aRgxB|1Z2FG;LSF059H9HZg5y*AiL zb-2Tci|`e|9WbW7*4yIDEdb!)zcn27#rVFYuK%90>}`(S>Wi6i=Wbi~nH7X~XHPph zIvR9Sdww&S>N!*q4|b@6(!3Z{{zqSXwbU8@%^hrif8__wSQytNP>oa(&DW z&XBno2#YD~DO_Hbrl=J%CSZcx!H8ju?1pJc$FO8ik;eZoEZ*7KO#lGDAeM#ow!U-O zLe<;eHH?SR*bnr3&x5SJ1E8S%37V=W_&uyiRXSsCV7DKMJ-fFzX5q|LVvD!RQ*>XU zTycIqY*Z$Qy}IVlJY8e06O;Z6XFKS-n~mhuJMZh1O{Mi3O~4L@N$VRCUpapI|7`|f z%*-sT|KmOa;rjo;EcT9DTqxhWh6j$cpp7+}{b*WvU2Dfq;Vtd!C6IU?i26E3_8cgc zsb?cM_5H+_6G0Lp4shzigaZ z^$B)j0Ad4ZYi7_&zlh(UjCC7PCx~$u9`#-@I^og#OD7`$M*$ z-=273g`CE|3q4w;DuK}vkLq0uHLJC%!0nG|=xYGP98|r+$IhJhM8UifB&6H7%@Ob| zbR5Zm66oQX&bl|k(@T7hG+rkS%nj+3L$^+)QVRG|a~z7|PBg=5MW{2lyS*d>#7 zRXhN*WT0J=;}$i~EeGCu6zaw;)#A549)RlF!2C*d6JEW%MJe;7%s0+2PMn87vMHb* z279=u4dX+1Je##65Iqh;yC3E`V7uj0=PO=$Ubl6Q49dZ+)!6DYxI*(ZJhfVvc<9S7 zg3zNH$4-dr7$Oga1~UvA_Gt~J^ENLG-L7%*Yo#xUXVaX0|yyl1I_h}b*J>)tlCZVPFm`ge!f#N7X%{oYq4sB ziTnc)h4O>A?O&viA8T9u6Um3|L=h|$th*#2%wCR02cxP=HU@#wch3oy9j?1B|Hzj5 zXqexXrdzgS;?ch~5h$~PPieID)IukSei3rYGCQ&A`I4lj#lE| z`M<(x)fqZymor4Ptk`Y(Ts*ef_+Tqc*ht236=T?`-&u6HuNLjwa1QVg5}%6xLk-iz zJ12MzIJ7deHHQa@hLArFbZ^^sk?aGAX!Vfi3i&7xwvW_VYvsTrhcjPFhpgInIyEQT zQtPdMSJgPl`x-E_u!F%y=;c41=wd#5@6|%D{qR}V7y;Q6$zV-q-i%}KJzwIZ`@xm*D15nlO& z%6hr@2c3I+qgi$Aj0+WtvtT6^_9uPnZH^m{dYS#E|JxZ}Snfh;R}Gp`6U#hDqy3C+qe`E90Nw z%YS`ueP}Fw!q6b?nAf5NoI>1uem7$hBmEs8KBh<+3h!X7GjxVF=z$ZIc|0NJLj;R zz`OkUO;%&ng8XiUC{Z|OwZCb!TH=2~iV?MTW zs3XIGSXf?XbgL*ipwD>$sc~3oCPK%yh%Jc9S0{O`ymt`7iJDG>$=<#IO4Zk89Z5R# zvfeh)$0F`p=WA0~tpUFUCu=Y$3dW<4inE$3lp{VfOs^>!Ck+bY$|TL}4-Uso7JJs5 zJLhr-YrGz7L~|0ccxtCDl%3jio`O8>mdbFRc)>yn%v*LAfNIm=!7g}pmz|yC8IBP9 zT?RB41;6Dip_vg4e7Uda*pun1Zl#6ZgbR&!5O0Mk|L!*}Xxvnm`3Dmn8J@yaaXWCE z%1y+(*M|-NCV$Gpz%A25w_^Nt?&+g>5HZ2brx|jmY?MV2*O$XCtmlh?fFa4{pS)D{ zL0?9ZXRfbjz_Np2#kPL)CWwe4@rlYIl^aM~Xo&{7L&=8|;dsEq>)O6fBi<650N~|^ zneG!ytzhz3J|DTu`CO96;vTGWU)_kO3O^;&!_k{d!a%kPb#LhLOU%0V#oW?}bAdd? zz1@u@$HL1G6W$jRmG?OTk6AM7HA8^p4|bPF3kU(go-~JaUu=IPw|L(fZQi^!%*nIQ z7)tCqG+29nWJq<}$JTFOF6?%p@1^E@`ekL=FZLnT#zonK;c|hqAvP$KP@LZ`@|CV- z5B#*9*bk*8z1{H}u}}eQ>i_M%%*?F+A+Vx?GP5(K56%Nq14_02cjW!Wkho;f#XcOKV?@K4pfV?)UwLKT?a4wAUy)Y%R79=h4?8@A3Mw(L7-EUu;@+{#zkj;~V$qoJY_9}O_?pdH~RgCpCbsJfT%KtbEl=oWQ2 zJmNlPl27_BAVz`-KSRXB2K-7kr=1K9)l@{q*E^cg1{%WdNYDX8;pdcg^<;M#c9f6q z|LM{NleZX>nHVhw+v+3+&nrc@kyVdhH8AWrtLx+!} zJ`FIPM+c|DfqL7HGsVBgOx8Z;I*Jb}Wvfng$SSWfW*fFY$Vin8h)IhIDROeTxIn^$ zJZvH&^??U(DcBlMJJuHd9gw}?1&@|OQob9=o1Q`-sfdoePpI-+rtuJ~y=|AX6iY4I zK<^MSioaBS^wYXFWkA2yzi+HW{bnkt*#)2;(X^3E<=HDBcp(yD(SEUW+^aM7oBm($ z_m3^UGRne@^%OTFubh5(*nkzcbJ%1*uk*+mfIAVSC02{raxJ(%PLR>7@dU*(Ir9=& zx%?|J`%lp}4hhSezXaJ&-yE5uX5;`Cryu#~aAzmHzDoJ(VvRxu+i8t)6R=PRgdHFl z6Ip@41ACW-E7VuyqIhEZc#f0pB&XD>Y;A7%u{*0KWI2Tujkiz;J1n1*59xB(#Hj7DBg|KIiC}+_^AJ6mbS}DCaqzCFTK_wm~zHCT+pn+ zx;Aq_Z0&kv@9}j$Y%kSggrTtaq zLh#BoSNpMG7(AMK!Oz3q3QHvxX#1vAKbrSqri(m+FFa>3Qb(P9Ft6d;gUiQ=r|E(c zqGUSsCSpW+!zF7)PJ3{SF`be@oSI=!aH04*;(9$dUN#W|{yrA-UI=LAEFuNrk2b0F z1c5ovquFvJiV3^*)!@KBzGm8=w-8gh{DB;(tc>=_;&HqYJu0YP^XySD)2O_DK_4!! zg(AqtiZZ+fGZV}Joq+s>tS=ZrOx-9uARdA)DFMswxcStfK0*37k+l+>S=!J6#g2gB zkE{=~(l3O+V0YhvwwnM*xKJF=9!190_!{KSb%AFH2=+uCIAyeR3DPW4Wnvcvwhn97 z#6>-G*qFO_47#}voA#6WSt=>*Ji#O`c0uVr#d~Y3>Nue297^~#99?{PKWic-aYCfu zp=s6pzBcE~)Di<|u>e$O?LgD~b}#@m z-Rc?C_4!K${&gE^g8jU>3QDfd1(GoMI~ATpLsdSTgA6P`$q7paa>hXnFmDb9mbJ|2rUVtGl2I+nL? z73^VmH!yGZE=hUJ38#D+FWNs3Y*4IA2I_Xp%7J8T=>c++dkik$dZCH^rW{W97}uL)Pq=*0Yk&BIR5o-`c!j*!-BH z5#Xr)T9h->E5=QZr*}%t=%#-OnWupZoVsFw$!&n2Zusai-t1xNmGp6}4V^r=>tr9vN=`LeS5mr++0fS^@rL z%AVtyr+TDj8_HMlvD2$VsQ60+Pr|Wb4KMf3*-`!w6gwq|n48OpJ{*6)3gv+#14Bt| zL7^U4rc|4buslGmDOcQdfdsMiVaYcp*coib1i^F82tAU%1Cbtg8`(i)#a4|EQix)5 zK}!sJXQO+pm2ZI5ddKACq>zB|Apr<5hY5ZVg{t~!suZKiNM?#f;^SK^Iw+(d*3%uJ zBwbh?qG({Vx!vxP@EM1>y<14PUi8|5LQPsvNU+$_*Gx$rNh%t=(!`k?Mh`3FB1zNf z*d4_TaY2@nR~&{He5(|g6ruCdo?WZfwp4tW3QMcro#trX(GK0MWFdDcVF2%V1{&E1 z_w;h!!n$K1TWYdvtpv>JaW;SpyiBXn0-?qqIFOb=9rFO8!Zt6xvUx3d^sF2-n2JCV zQ}fnDuF_px2xX;bWh%(~s1>2x##h_~rrObXnp95ksb8Q_5^@&vSU^8G(PtRVfQ_qDW_15Ejkaz=VIJar!Mnal+6xR zL8NqQ!|ymzqM@sWWJO+Kg+8$l;?5WdM{sHSIe@_)4qVmzv~Bzb z8!;CJnd9oBGSJ!VEoN}ptvIvAw!J*_5(XTd3j<^^3IY6;*0`=lRbRFeYH|F(Pvr|s zKO%ob)HKF1;zN0IO>zMh$}!+*%m}PPIg!X-d4JjZDIw~_;7STcfC`eadeX#x@l}M7 zMDly{V2rkIXhxhckO6S}r>nbcvN~Ut^Af@D2>RqP*E{ofg7aa6cy~ZGT@Zc5Cul)& z-ZSgPqP*3I5YZ)l&+nK!!$3Ms$uK2H0XruTuL{C&09 z%R+VZ$e4sr=so}x{ZUdrL@yC^AWBH6{vsyu=5uf~v&7ISDS#oV&1e7SKV2*DbA>!c z4TaA-%#xsGVpt-VjA_ElnP;w;0F^USVtfInG%MfyVPg4Uf%}u(UQ>P!T3y-jsr$ zLxP5@rcnQbIKa5ETafY@gC9BKmL3xT{PfXmV_l0G!(!0^n>so zM0meFn?oRnFpU%AdJpWOV?=%J_p@ist~7wF?6rGkr9VW`)BV4lXxP~PSESC)&Ga8* z77bu3X-VSlre5iKR0SQSxZQ2SnAi>`3Iv3L8z?m^b-WFQA5VJhYHx{uCyBgXi)m6k z>-_xY-17y>)E4TfeKdLH@IIChw=!A6z^sNNj5g#5G7(vF2-<&6t2P#~jF#kb>0Aaj#iri6$3Mud}Be-+;61ekbc!?Czh*0NLG{A0x%q4vlAjwChKrxb+OmQPk zOA940Z?j=QC8xboO6Rh&*jCq-rD5Jn@C)}HkS5RI_(*bl^OV}07NIg1X>yCAngG}; z!fqEgKI~8yY5J+!teJe#H_$|lRm@V<&&O(m)pfLCRvP_FVKbbz5~g0y0mAw8W9MDS zt)dU=`&nxex1(?`lKRn=2!5ldO3ds8M2i7Q{~q!p^!MuTj5Lr=YZZ|9%BHZruqf_y zS{SkQBVIlDYU~Aqd?<=tCW$DG3+3;G)zJ770=2Y_rorm`(z|JMPz7a`V%qKQ$$Va`~+&fcV#k} zbNm)5c3VCS<(&wJh}gKh=|%urmSd}209vk@$Q>w4X(WP5-^ukb%UdOCR0BXVO!oFs zv{HhGAnU!0)@F{k&Jq&K7Ow53mIvCubjJ~h`-E8{K8$pn5InB>YFaciI3b++ zh>!VOp|`xPcI~8@0TR!@DYl~%G{%H^e(X9|1(zr(Ej&;6!6}UCtjmg^naOJ@_JiYw zs3WyDW<>vk4uS6QFQUy*n+pD~lZH!|a8c1?>XH4^nKTsG^$I?ST$e<`em=`i0SO)lr{HwX zY4Xw)0!w@^xUSQIPBUXmw9RcOVbSA zmlp_?15PA<-Z(9Of?!<#pWhPZ{of&Pb+c4z=^y5X8&X)Wz}1u!zwS9XA`AF4y!wkw zf-;x^-@YtQeA`*hN=HtFVnxMve>oQ{Woi9DY)J!n1EpPawFv;);YxWB1O!H47y${Y zOEE+w+<|~XHb5jiKqbZY8aHq>R*G1`o11O7z0ZJHR!Crgq8tEH*qj_2f?QT;zcuLB zRO)U}OT5OrTfXdZ2jrTmk@5U`TC6rDTre1;I!&$yCD)DxfinGpEnBk!VVlE;mh%r+ zg$~JXZ*}ZO_Xe1Pg~P~w366GQlH=lPRybA8xI2UA;3`^Xw_mS8T8~pF+o|nI~qy=gFtk)N=!YaN`WC);uW|f@b8sygCTd(Pi-Q}u~7Bwz4qA(C!x(r=mccoOA{*R!4x>I(03Pwo`n=^>7B2Mw1i@SUiChuUKjD# zCCoKW#}B)=mCFHjQWakxRq7R_qBff4(#f=|Yoz>i7@J<6cdVpI0Ji=yK0z+SqvB!i zn|wKYAa2$RhoT!-4kpo-*Ry4-cQmi7UypWU?mS#C;aAV^o)~3gFE(z5U0?slwtp&9Zt_^Eb`@=znW5?Em+@ij66q z$^So>W|~`Z|2UEUFPc!&zhs1J61sGRKN_q(V9|uLC=}iswCSuO+cuPvNGF{!#D98O zd#uRobFRu1agv5R@myw=MmD%c-t3=ExP3j4#T8C0r4zWOT1BDnhpC(wLtdS+xTc0W z-S(QQDyI5-z@0NcTb@)7AKD)4()tCvp_T>#H%zjhY*Pbmo08H|GOQ-sfgUXLdAfhS z6Anvu-M&*(c_+6PW>pO%^0;8vbHr%g!PkF(rkHJFRNFY_Asv46t?e~e^?kQiZasr0 z7rjcEEYdhKYLDloxZkT)!&6+U!`h$~1IN3{eA02OdiVC77wa)mEmR|WBQBCYgV&Aw!WnWebYzZX>E@=kim z;qEJ8Xrw;DQO22Ays0FzgTED~%a?uc7Q*L?n8qdZLs9jp1ces z6H^gv_#G3%vH%o9?RQPabCevKwMQA}fd-q}(Tz8kXKx8$j>GvrLviOT)P|(=<|*1k zv<9e&cjGoE1esPh5}7YH7~wR)Z1+Y!rEio&l-W8O@iSSG0$AtBLItIXAX~4~dJ0DI zPGCNLg?*GyF(;zQA%RhM8V_3$nLDGhl^`^At5!s-B<4*Pr$I(n&u@9(oG=m~J>pGB zp+XgczZSN1(^Ng6ZpVz?*_`8^fDi zgf-Q?^5|hrM-+yIie>iQR1JPP)z@<0Iq?#S@Edmo7c7m`QETLS12q~)nW3`fo$ob@Y zqAatM-^1mh`;)O320bVL>YDXF(swxH%ujX61QV`(G;bDLL=sNLvI30CW1C{P+HTVp zA++ZL_0N;nqYn>|)INF*mG>gBoG)+ptFqfaysrYsVUud#@?nIfuZPP4`Q3_(m#+-o zXG(r6yt+FLuk0m=chQGI5aKSh;|Du<%;S#LrcYW0{~I_#3b@hJLJr=5NUeq~2?R&& zqm%%h-|Vj6xCXzCWRC!QC~Qpuna&n2XdV9H4&2%~!&oC2{wf+PS7J1c2WB%IP3 ze3W**+kC@C90`)t{4a%?iJdta4~7DPn}hrRXN)kjqzjY(Cr+=WZ>z_N5*B@zbJJ&ZRI8|Zc8KG zML`o*|173)_gBoIco3C#yr10Jalu4dtVle`26{Nj`l&5zdI|!foMr+4hz(kp8*m2=%P={lKN_@pVXTMPz5!PN`5|Qs&U{feKdI;QNB9ymhb%ZT#3tPiTHhpAT7~9J9-iRNviNKt%$9ER08owTH44%hP6Zx)B%l#d*%Xg1 zLJSRVY+Pm5DB`I_z{VYdvx(dhWG2iohNcc9Yy5X142TJvD@N11#khw8G+bE+cSx*Y zbz5h2$Ixdtf#>&P4anr|ZlWJrciZ`ec&or%g=PKjhW zv|6jsiiO&A8$nhw9A^-}S#&*P1qI`MbpkVlxJC*Kq*B8_Cdkby*t2G-YdMz7NWe-m zF9Y%#sz?W77zrs5iC z;{S3#w`1|~_-AzH=J15)p_O=ej$^BN=kK4jYQ^r$Ej$AI{wsl>zxU-+j^{lk8Aaw} zVqGdX-^Rg>bxcrqe$jwO3of7R*>jI0F4?WUfFIIM%RyJ$q(b4Y*Y`hD;gW+9?YeBb zaRB@ytg}s@u{IV&yHM9aF5fd%qznax#b-3+@vpkAN{Q98m+&q6`y1du`8{JOoSWe0 zko&gVItIb7u5Rhmgwt#5&AvVVZt0ggf`yqUCC-UnDNb9+E@JW1%V#7%#q_qA7N3|p z{;=mxU#T@$CbcOrQGb3>f%w8u;)f@51pt_cJ|UF5G|_UTkP+DiEi_oZQAMp~1*36= zqMc3^cBwf9jytw%adE*Yxg>CIB*si!QwP^JVZ__(^Q&2=E`LhrxlLv^eZm{@Yv1N_ z8trT@V?GoYFFwn0HTH!$uqfi7ph5_>8$6-?&ALSr?5u^PaC#ng_Y@!7Y$f+>A>eWT znEd6(_2EJK1XaA1k*=yPocLH)WPUtvZ#|}KMs^3L$dW$_SrJY{xIdXO^3tK z<@XB@>*Jc(n=1B@>@=|G{Y7_Dp;vp}%sjzsKztzQ`NP8sXsJmMvF@CbzxwHUhY^on zS-k-TJynwL{zp(jQueYY5|o?QJRk};a|Lb#C9DiVXKW*DS}a?e0$ z5|FOmCRz8U$RbNc2A>}gvy#G+|5E&zIsSK-3d+UC{l845Q7nDef4BKN{Xyqu5>{hF zo=!w}Y=|0{E$1cI%Zb_HWXXe2x^hSrzwA!;JYPHz14Hze()py?J=?plu3vH+Zs?4^ zT$;4*jrakZv&Wnm7yXc|reo&4rn(`YY?>BYIedOokOVpZ_f7$fkg`He~v z>kcVs>jMCQ_zcP*K_dwwbo|B4Q(1Xl*V7IuJcAW!?Na`C(DRc()X=)O!%;U1Qe(_+ zc^z}R<@>Ng^)~5f9@^-v^9#`Bn)RD31jSv&^2K(-WVb2b z3FybhmWDPJtdOMdyR!do_1wJR(P7p~_hXdRL z_(7fNSdaA5kdS;d_!BrW!6Kv8y4h&mjWkw5$oqU9<`p@ZmMm0pB9d?tQo$~!QC~qI z*^?hBFg%kLWR37N-o606I_a) zLQG$A!`oXD_`)X-T1l@QNIU{x$@v$F7;qHepGhW4*4h8p40F{Bm&85l4%TSzsYwdy z{xA=CUG1XQ0xcKaCVTB733o%n>L?}gHrc<+U7E~3DsN&31g!V*mN3UW54_F7kV|m= zWU(l@!}nP}C9;=4rac=c*8CYBkV{TbaEUlc{!ly_yuuSb4#{0_AQZ464S<}5ij^pU za^`-1%4y%g8BeLc5+!iG^}N(y8i&Q*CbXFRVi6wPI&H@2Z=L{9Ky4*h2F*o8r&1AwPjs{&l^;;OR|}2cf^+(O`sK$9&_V)!s$`5Gnnk zfNc>%2=4C6{Ds7XxZ8g!O)+^Jruh;YDh?78{m-0L=~VjzxKUJktNw-2ZA_6H)7BC1 zrYZLUZzEje)OB*NN5*Lz3xt-Y1hyb*i0S>LBC7DDY zZ-wVpl^A2^oCfs^Bj;YnZ*0f;@cb3u7*6fnt7@8%dn0{O-LtGQ%Z|FE?x#QC*V4sV zck`Bj?JOIh0_lu`;M0d8L>}tT0je!uJ7b=$sp`wA^5#*(wcFjykb6S_WnYDoyJxrm z(`P^G5%svc<>S0wft5)YD^Mq|DBRr=df<*N>a06WMtBbSNn)(NygFx#Ol-y^Y!|2) zfir6HmiX_0sfcX+1h|ezp0Vl0Ykzs!)Nkb71NI4NPaWHZs@ zFDa`$;9@J&8NEV;R9IT(TdYSYcRK>Hr6|1pfuuu>Y{`l~Z?HYk1Xe;J0vCMiJpUU! zOui~pJk3fDuM}nkhOB*M|D%09$at0)Y`wE|V0@;k)(A=w7%U=yG46ncVzB7i%q=q0 z1C`OH6b>P~y#s-H&U|~ayWS{tf6%W>PIZlKWVyM2Sc;)Idn=uJWl<&?w-vdkhS?)Yl40a9LhUB1R6MlTAF`C{{Il@~Pj#1Q650+7-(F@kySod6ypU?L~PQ4g|iCT73XCx0wJ?~u6AQO(hOBzCc29bbu92*?-Yxq`nVLs0}>4 z0uAwnv>KC_23<<%dOlQqevzQ7htX{lvhq?~4xt%jBAxB!dNv|GeR;E%~qbv;xe2SI9-wgsTPHLYr zS&Vk>x12ehAx4o}yw3hh;y2|8`7eqzl|~tE^C4Ci6Tl^kv&;mKA8XmVIq_oMKu_2w za|W1x9VP`t5tvfex9E?%P+!G0as(5x@|+^tj+@wr6E3MsySuYa!hU|--h_44pDwLQ zOCYeiAM^qDJam1ndgIgMTK7Z(x0gi_7w^e_yKbK!x>4!Yvr+Qzg7w5z>*Bv>C~>VE zoby)vM}TVYHb<|2tF>3_gOUa0>6MD!qc(PmJ5>A42z?0Kkkxxu z5F99`;86ERj)QK}Ij^^Vq`x_ae?qhVq&xK(25`H0mo58=HLo>}M(x`?AvsMlQvIbs z!!Vq0mm@HKhDc(N)CS%Xp{enR7em@PSU?*1JQI*7y@CK^om-lEmIjrQ%6Dozs#<+Y z3E_zS9mEw!Gp>zROY#tH-7iaWH!&lx7+R)aJ(j@WRi$?&($&d&@8rT2Dz<=QR1a_*<*6vkP@W#-U!@LlX z54%F!f#Fl{Lomy!O|D+=msg!ae2;1Z5_?i7c-y2KMmPv`6rf$mPZTFO&`E`#Eq6XI zw{J?Q*j-UTt(4jHwkR`zlQQVZ+wX9C0ND3oe&r+Dx7kk=%~mLsk1u@G#|%cy2Vo2q z6*^inyWn4`3FV|1i62Kh+s;P(=HAe_)F!f;1KD?FqaeUn1)%U)270IpTt|cju#kID zarLA*nbbi=UPQ@-;V?63>hU`pJZEIJhthV|)>-i#)2&>-hY|-K@Ssx2_~9%P0-#m# z<7UrHQbVETa8cpy#{P8u-sccM&(Zg3Mwz7{ySGOAdnf{|29F&nGY&Q>Do2&e0XGjw zqpnuz4eCNs2>XaxF<90$SyJ^r3sXX@9;uV_#gorr7i6t!dbk@p2$h3#h|}~u%XZ2u zGPdKv#gTY7aFV?Y&wUTNsD(ha17ttO`LA<4i-LlCY-7acT0xPAY5Ky6;X`nFdfDT! z$`mj+zqR69Q=g4INl?rPlh2c_+9#V<*HfH7IpvlE@4dn%{lC1`B_`O zQmI%u`O9~b;Pr8Qcd2r@N0v_8r%d=v`S!4(+$E%pVc{l$UX?d1L&n`$Kz$HXKXO8$ ze)K|1jB-D82}0x86dGEiL)WOg9ks{UV0*`qmwSqRIbh@9>*ITemo(3PtF>rPbv z4Z@o=1@^yHH?IGQh=MV*b8@67o&nPU4F8q5fAq_8C=bvRpjg|DdqVj3@SW9NpR=1V zwyh}*G>0NG2)wO^RF98m$*2_5a)U;+4qp;#Wwd|%%Y|o&%S6ui$K&|7$qjL&_!3%D zL7W*)(gSY?rdSE*<4)uK_>-vxO-U$6Kh~eiD-)jU3JBw4h)5t&3G1|rnw|iF;D=Xi z7bSrs@N@BOQKUZmy(wNvtK((kUCv*JYM7m;G(wfT!OO1fU&M2%1|nh0FBeWPH|K{F zsgaKS0laxo=iK65>arGt!92PN39Ih!!Rs#KYO&&He)U3-{PM0i`ei)iH^fW01~ri< zH1-)Qh+Y#(YXzYcw9#S5n!2rk-tK=`_A@~*F65z9W2w9{aIUlP0uGGGV&ht6cf{Gv zV2h#f+=!9C$q{g=o-=?*#0<^9U+akYa$$!*5L5_+z--V-^PS6V8+O0-XQQ&+u6$?t zA=DNk2w*LT{Xi`#>MkLFQ!mlf3QJaJz5H4B5+{*{RX-PYd~DL%`V|HNAmqu!-h}Mt zf4C2{NR|ZOdf~Hd40NTRZVX9LD88KTfKkj-xn$H!{$owA&^_Mf$FRwwu(wR3n*?#W+^9YN2RWR|9D(UmA%^L zijQ7~X=d2@QzLhtee1OgxUm8a-NHvj^w^$TbZ9_lw5k`WbAU%rx1 zm+Dz~>x#JG9Y_~NMYC;2_mR3eGgj;>kmzWOFQ(5MoU~D0i5J56@f&MhP%VU{Frk<* zrVkqZ(}ZWCt9oDiaU2)G!bH6$h4+dJt;!z4yFC@TA^!fqKhAjn_Yp*mM%%2JdY zp>Rl;q1uwn#T`-otAZ>pG&$Y&7cFJsC3-|J9mJb)@!k9XVe1{DGz*ut+q7+GR=U!* zZQHi(FKyelZQHi0(zaQDp0iKm-Z6G}HCH2IybwOB1wqL-LXy+hB2cnlX_TTSqrv z$$vUX?Z^wGF0T-+U0?|4rH{p3?ES78Zj09x!hf`KZ3k==km2M#M_C(0SqqG$te0iQ zJ(C4$6WJb+Zc#9cm#MUgsw`CNG9B(BwfJ#3sf%Z=C( zheY6xEdpu_>B=rp@S!1LSS=gL+*T;{OyJRZmJ39HVv}In5y{j_Dr%%|d((G-!LU06 z2p_4_Yt-a1Fa>^y=LK`tdW%^PQ>G;~9-nF%o$bVxS9rzr#agpUp!H=_L9syAmv^GK zrmo)0BqFKNOg$`b~S8)_4HF0*U-c2~MMJBTDG*J%&u%Y-fZoo8|C^uvzCYwgfn(AqzK z1OraL)xm4YPj-W}>D!L(n=cx$gN5$LJr=o7Wm29{9!T#w{(V5UKwes!E5qBx z^Tf2@T~Om1?KAhBeQdP=vIowRAgI%(zyLUpdyUWt+K}sCZ_!`MxH(ehn`SgcFGgY` zv!rI)TQZFfw!+`h${>{ku&vL={TR~)#sw~-*^hBuv{BXLUgtvf6+ByJot}8h5voXb z{q!6a>^Oi3-o<~%;CEedX?a38T|St9p=$8Lfi@ZGALDZ#HlCh*`nF|uO)q$QF2v6C zyL&qM+S*`CSA6Ypsy6=aR?(;*$-N{yvg@+7p>e9K#_RyaBMaQ z9`NHv#PsZYeOzNef(hY~N+RwkRjo-3rXxTJPbXhpAEqXD-z4nXJ8`F73;nShaJedQ zW9&}pvekwbO1RbWHh1Sp@MO{(}v$kP$1Vj@})FwCaV=^+$b;E8= z=cIT5jaeAeu2xDdGk(ccypfH^@R_cMCv<^WCB3L!RRYNdZwrGN;>gZeB0-NIyf+WE zJdw`LSWF4L`bmrJ7D}z@ z9r^!UYKCFdc6wEm^zXS1s#VZ84eYlMzp?QFkmj}m4DiDD)%%+CG+XYdP5;Twr^fuzZFTpwpR9n(<>BHXf|ZG4aw^yMNf#7~M`Z+!7$p-U^}a!bwxY z@lD2S`(gaa;5QK@638@aSBf=)GOU_~!1nZS!DV+4*>b$#%KKTSBpzuGMe!gIds_Jb zqI8zVUi$|o)b9MZ1;2Wp@CPd_bR4pYEeL#Ck0fU%;u>n#$935W<7KfGm|-1TN>G21 zuG*T2!8(oGL($*~STZfwA_kUlnvc8vC#iBlZ4TxwD&Kj?_p^*5zEM}zeNQ4fF4}E#`;zoE`4q_=Y!7k+CH^cBljTd=poI0vyo(t6_CGI z3F+(CQr>6XJs`V$2UKH7!wu@U|+IFQBdVFrXGX6V{lD$)tn{t zr1#3vU!KCFUp}AG|6(#S^Y>F63AO4nj7&?wgK(?^VP$a4sICo~83F^Al;sEH3x>pmDW5w8GCB|r*lnzI>!eSz5YSYjdbtKP+LHS zcPoX~Sww2~o}72de?`mCJh&hoWRYOAS4|$z(f5pt{Clda{Py14NGO&=125t$t-2BZ z`_V9zXh0yvlu{Q#LMR1rTDktc?O2!-jR>xeNQ%Z!z`^>?F~Bjx8AObPxg&PaZEU0t8ax~9fL5Cw4lo_!aA)KmokZ}S`G;y^mKH^ zSm9iN-~G&yA&%pn*eiIcsLqO!jqnH+HA-n~#*5`C$=uBx_uD!^&CsYW&f|P-4c(kW zi?@oiL6i4)V0@0HePFOCgAOmnfjIQbg4~W?;6PWb$i%-LxC%(Ze zr6WcjGW*s{AGxiHjc32qp1du^Md|1DzyuOhNe~~8IU^Nk*wyOy z0fcIy*#`xkmW}f?zcUC)64iRLW_{UdpPlNPDU9-U_NTjp$s7fu0GYF&@m->|IDx6E z8^xX(X%{Evm0;ZzVL=EEGKRxC%TBt|CHIv)`~rX%4x@+Rwy}|(qIudEZOs$uY!N%H zwX=xZu8+Lr&N2>h%U;);>g=BKr=+H*lKWZ_Ml{Av!r}lXx(&pLkS+ds9euH zFWphC;K-d$?%1)R2o)Rdx&|0@O%?0IyZroq;yjQnZ<*j#a{=4Mp#4zmCP*UfrK98&g9s+@?ds)ff);W{x8wVRz$RJ>~CH{g<@#4 z)wzkk=-n~fCC2h;);14-)TwcBrSUYNk$I{2RBS7K6OetVWhV7UM6q)oKrb~KiunDR@{(`^MRbf{h_*&V zxhSB&q~L3vxM-k+e>5@s6Zc3BGYvRAFuFRCM1SqnBolghd&z(%%4wF>S@!(PqveSVkL*w|{B!aTCeqs*A{1P8x$j1|HoKfuY5|s{% z1ra(aM;`mME`-nt+b}=0bWg}!yziuuYc_#A0WO*+)sL~k9ic(4L1na#cms!z%4++W z0ur?Qe=M>e{klvG`?7n90VIdrUQi(xNS8t~;G~AmCx@QyEfR6f@t3d!zeowY)UgD& zvWT>@1gjlc6te^mE&hev|F?MilopEL6=dLaf*7h&_o zLR0@rM!SZ3UIB#}%i&JBBA4ch2uEj-1dBERQ-^a(X<12S{t?E^|H~?CZ3G$*M@_x+7DU)@`1v7xAU5I6gT`%6rjWw!(co(2$`-IU<%axK>F+<4`%mc zL7Juf?GU2NLC&H9C$IBhWNgmj-?f1z_2XeKFPk7*@}ifME^hH}UQ4Is^awf~J4Xr% z4X`MTj|Q$yfQnKF-MXqohk&llw5iZa^JqeDOGl+nW3bGMF8@C1i=WdVZY9hMOQ6Jp z-(=}$cp&*U$_%-r^Hl{209&XKQh^YPa-Fl75_#H+n|ejJ zXa2&F2c)p_{>OaRpHitmNxw&$M~smncNuNSIojrG@L zdLFjTmv51y-+8}e=pA=T3>8_ZHsW#K3BZQ;&2SuEu2`9u?y}U|9=Hsi){^sfGOX7^ zufGVGEr1o8ufRdYTioZztB4H?FM^y+i`I7^-2fJjMf3PQK0QQ6eu?Q@YuoAes-3BM zeouUOaqMCMTf7H*mU;y(HFe`u(6*R^hTnL~aQBad)ZFmU|E2FR{jWUcCu7aVnF0*< z8_@DUT}SM)SKsh*gh_$As7)n5%(g+hS%Od^TQ9RP{U?&3pm}hPO!4)eC>%@Unc|Yt zO5wLZUp ztaEC++x=9qZLptT3RB+!76k!JjV1}GE66itLUzZ&+Xm~~ySuCim>7vrFG5(cZ zcX}YIPek~);hBd$in!1ws_5NU8&ABsZAPv2+|7rm6m&-NSYH0nUX;{MdSmdHk>dF| zM*Qw!O-Jp;!dqBZTHOtWBz3;(O!(^IxePx;~&zB{te;FElWPmfF{}Ab~e&eMad|=7U|!^Vf96-_6c(Q%PyfwR_M2 zud#9|LQ~D3O^7GmCMaQwcncX)b$(^(JUVJiW^X_HO+Qv->ga;fUVHO4-g0u`&+L5< zud9^olt{hTVYjAxTroJITbard5Rpnvf7N3-VY0GnC$=!+oO(^cn~C1~jKUtFF?O5o z$rW4O?^$K7g*!9Y#(PWcZ@J*6y%PPBmjBL43_(*^`wfZg+VYRy1n(q-(+EQEG}}eF zd1Nxqi$cIgF(7Ebsm@9$-{F;YkpxKZ+oPxAvDT1D_K$e!H|T+4j+WLHfQ8T}>}9f( zWAY`q+!Z!-3BBE!)W_kZFysCNzZ-2rz_8-RB}Va=0PP|u8pBDWa`UeY1I^!P7(8y0 zE;Xz1E1xnPC&CGY;gzQwzY81VM2i_wea;#}Wl&XXHfzl?2>2CpaW<~b(dmZij#mZM zaM7d2We>(PVL^GMW&P`X0rYOIR$*Kzx)FlsqD7cPi`~GzdczcbTgV^>>G?{k-btSR zId@9iytl^{t6OyDyP0#FaDX2-rAPmMgXWfV1pnKRqs(FTG0u#~sL>;d; z@V8Li#Zun#?@NZI%%n_@#5j-?$ysfC)1{v}aa#HN4V_ zBtjF~ht*&-nygm3O5VW?YbjTa?X>1oDGKcf~W7;yY-MJrj@D$RM~qy(pd&I=+a&SIc1 zHK@MQ%(VL{r3)ew0NK0ZU?ia)7Zk#v-04y|9<#_O`0^%7fY{L{@o#W=wy?FbjGo+@ zh;+gDy~V&=hbK$jUlVg~}cuMaW(WOmCW zNc)BF0Ghn*cm4CSiUY9pZ=e8F5j)Mw#P!2>kMs9$BDA}{87&T*cI5{VjKs`P<`Md; zX$k`6hvAe_KoU?=P4Kh(%W{uk4ct}&AaGe(p^9Ek6-^1OO!2zp>tN>iMj>Z+z^uWg9p#00uluLo^P4|0J}sdr+?{l|eSD zlZ=yuly;w|2X>4$!pGSe)v&q?BYhP!q+r#UGkhsT7ga0kA^q3N?b$d@G=ow?1A%%% zC^|%cErhQc`$~o!84?1bBKJ+#n{_Y-VaWts3dPy_AQc_X&Ee@nVMCmS*cp{Op^5c(%~;BJRM{S}bsoAl&(cullEV-OD zVgHNrfJ~&((`bNwyJ+gh8)YNs1y(C?3r!}YJ@V|!4HX1M>_&p7`x zyJO(|j}A>u^M7{UelI`ID4>=A4RlvcDmTK$ERz6`ouZ2?X&f4?h*)TeV(P`2(!O3{ zr_&TP?Fj<;?&H_vztbWEzDVHwGkzL#yE+tA`EXM_vq4YfM2cwSmIT%Jl+%eE8fybH z+3_xpU4AdeT(aK96P0ieG~j}%r=Ur?GhD(PfG7n%s5x&u>AA*e_2WfGy)V%%-Jxaw zhh-S7!hE1(o)!n#c=Ql3ByG()j47VT;|p4KyRmEs_i~f2E$dKuuc$S`TEC7_?oA2D zn^xS7hDfR_Iqi+RIwcP##jcs!1TPvn7&95*c4?FlQ#FMAGujn`&DsK;=#3k0F<=rD zz=GN}`1R3fjlRX$8NPkHA6!q*Wq1ec3fhA5^5S?Hv<<#;eEbCTyWTDApA>-!xsj+BC-ulC3C!utFadRUf{eZ)MKjrl>GP0)?2=2t`0+iCY{T zT*VULi~7m;ab+^lNQPmhRyQ1|e4h-4U9G7or#jb+bvt6H8SmGlOIp>jr!|WGt<+TE zIThU4w~i;f!9YF2eANj)aeV6wkl)Np1;_f3pLWk7+JFN zs%vj9NHOzJ?KnFA=qyy6nHflXr8D6l|8ZmqOGiyDnj7nH1k8JxdzPmtbTDNbC)-;c zuuv+WMEYs@=_E7C(0M-t?0c6J{GUNAA;Sbk3hwu>qZ$^=MN#BCLDO1fKKNg~5;_zQ zSx5blh3VJIBQI*^l4BCu0&I}H_Vvv-czh=Gzvz`svx6rr>cK$A>;GwmWf0nIaeHQo z9AD&qyp`g+%)#`%|6N3-_Am%a1Jh^AY#T~@6~Ub=H4DQxscD7M_pnYieEapqI5PE; z_PaJB?H~Uc<3VhTHw)ar%IWCy%RtPN6hJR?5DetttUtjVl-+I8(HxWBQHba0vPjM^ zv3kCt57_e2Mf<}mrn}9ns?Bk7lCBE z%S;q4OlxUXQt={Y&HnkCa|mnRQ)O|Sl|TjwJ8|su^kO66bKp`qd~1AmYViQDMdhwf zB-1&nxW&N&=!=FWlltRKPpemFAzya#ZhEp-E>7r8xs*~o_scvHLZcIr7^wiXAg#VF zT0UA(NTA|)GocmqD0|6WBVk$nnnQ=ykfrz29qg4qx~M^U5@@HZZv9Wzb#7bBn*om- z;@cz%j^E9{JXm)>>fu&Rl2{A!%m=ydw7a$lo9|N%@!E4RN9?w&&aYG!;+FwjXgL(h zX-_KRnK^Is)qf;&e_XqH2W@~md2(j+q~gIjAxZ9U-6vD^E7uh^RQ|YcIRsggStS#{ z#GF@Z)8lhm*c?Y3GAA6egXRqR1w)5bxIdZ$=jgiXJn`$h@LZKNUOU<|Pwc71cHUc6 z*G-tCb^*Chy=~D;!Rf9V0qbEvbTP3Lh2L$U<~_L z7^0@d9Ql{4ysX&Kx&CdSHdNuPTcw9Ra%P(V6j{Etm=EcnH%t8tfHj+5h*AJy z>S5J;tLkpAx}~G)DXzhlQLSRJeyRV(gIe%`3v{T-Ocbva+q!A0sN_!!+lV~$%vVD! zZB><6>^yf>-`ST#+yq0^6*=f`A1)?W=8tmTTy)j9S+-&G$;K~ZA7|kf%JzlZ@AsIY zl-E($e@=5Q18N88&kC9<$F<1>_J4(Bn)8y!nm55395?X6Ve~9MP{$_lXx%@*&tz%Z z!X)1;g&g!`S=8?8>d$n>W%||d$v1EuI+jwMxJ4{lb4DPIEOx5a|tT~sCUd(Rbys}Qt9 zIKQU|TpWt9C^;g-;53<}ge9oGrm9$5km7lx-U)JSJQHNMzwqWUbH^cI^aMOaIm={_ z=y>4R3b#TeCj&mDmUJv(^9rxEahN1g)|5eCR1PZ_gMKL77^jQ1j){dh!2|*g*d-el z^Sg~Zx$FSo0B1(&-}MXGhftlkQwxx`y;KODJA$Lszk+zzFCsR@v7+l@pdre{YQXpM zQj?6&X)@rYk>84J954W+yS~GO(D`tm3FPj|6~PlAB_uOn9eo%}&9!VAJbLHjN|FBMX|PATI&_dKCEQc&5c*r{O+Xb}b7 z`{*_t%*>jRfo~@f^89QGo5S|Nb~4&=;4>1IbyUNE9bz%Dg!`R?jh}u(2J=ro`3w>9p+^orp(7 zrOa%+I;Xf{7#e#f9*`;`Z5Eh79n2@6mbWSD$}gcZ6>+^$?$lba(QLAlh8LBQq?2fn zQSfm7ZSi|QyY0D6!D8BXQW3FnH0cgoAPd_I?jt1PN$xz+-Eg39!R=-#XWry@qp$(Q zCA7once7Z2%lfw}BN3jzUY=~w!Y-Yp95yx0RplmYwQe-O_X+wu%|?N|yq||Lu*CT{ zS!6{S_XOoYV>^2XoRnGomEaAmE&b&sa37e&A*Z`T({!zl zGzvi@+O^cVbWE{`6!Ph)p?)p3Rqm}9)RUq6Gz$76i(#D7jx;c2%0(G_zn)4qF*KW?!V^2oQteLr0$Z(ew;icI$u&Dvb|w7lYL#{mRmQJJJrO%uZdHccG^VK!u z?<=*$@j}b^(|!{`X}pZ9^=D$@9Uw08hB6R1m@kkt{h^0bd{~la{7P#d6BHZ-MAs71 ze-&b=NDv4J563}1MA>^=`8%vY7d@y^N($UhQm#YDCZt@U1m??{SK&{};a3dmup1)~ z(Fxsju%{E0zyiW=F!lTJDN1o-wn^l9REXR>lk$_T-jowfPPqz}yL%c2NkBKt+oC%@ zzQh!4BOU)uRPGPQ)V&9F?7646y?EydHO>^-6HK!6IrAEbhN$N^gN2Od0>nHktn?D+?uozX zAF-`x*#wgk879fQ8EtA-<#KI6Ta=v*o9tlOM^?m0aJo^nVgm(A%glFtWB5-GBTDc9 z`Tqp~`%{+g)n(OQxW0NT);+y3GwrTE$hC}Inc&}bBHp8a?uba^!Vyq8}M5;eaaW22U_^!HwjNUiQ*%TcFdYO|Lq{0SXVT1rd3G6T-yaHa4)_qOxRz)SPBONs6O`1H zXaxKe=9GjgfP})dtb>@Y$oaB63j|khOcGJG{=jHTXSSwX8y5`%B;@tE+*i0f3AfF- zZJRw+aa#x~!-v?L>99b9BCtAvVv;7FpZus@2_e^BsD|Txc8*km5NoBU#0jX#(1=*y zFMm4LRDo)XroaM_LEWHqEP^U1l7~aA3y#@o0qgp|0PdX4qomd<4-!ZFPpksvnHd+p zB6mFKqfF1}Y}sS*6l7hNN2i73(V-VkI*msl{roNx(uQIEQ%ST;nozPyqx@J+xaJ8X z16Ivy4$7#2VLXu0!foO|WlPdftJX^A{OCzfMh5~mE%TCaN@9HV{Cl_%rsjblvf~B0 z5nG+b0Qdb;H4DSZh1ztUvtI5VgaoEjpbj?LsO|J#EOuYr1%u5MGa6P3SDz^(L$b$b zju)JZG5J`vFD!f57O^np1tzi{`%d`kj28+z!YK%Lc$n{UsFqa%xYyQg*TTf&dTwQ! zutLJeaHf|{X18l-$%6ewqCWPa9#5?s22XisfNz=HVQDP~aAzUDbCFA6*M0L>W9pc) z{~^AaxZ6sd@afv`m3eK=pXwiXo`&0ZHY+18Z^{+mU&W7amcQ^%U^@Bb3`?AOl7yF- zuk&9I?{OI&1ARl6;*8O7ZLUz$j{>M6`?lBb<2=R8^`wyXVF@2^kMAGs1xZ)+|Fj2W z=l{QFo{2dD84ZMk`9D~RpXQMCBgXh?4zKapTg(kYN~_dMc&!_84Z}d zw}7~ciyw?1t({sGI6Q<|=VG62kw zj80H!3ax0!UpruzYG@)Qkjhs|N#>S{pZNvo^qJEp+XMiI!Alp1>|n$#6DO)=$@pDp z1}~0GW~O7NN0avapnlF-kR(D81R1{c25{6^=Ja?Gh7Grs(|5bl{#Xb)?1kVdDB1CT z3!(dPa_VV?D2vRA-!EDMhUPgh3uuX{{!9?bgu`Hzq(7g=Hqj#x@`e87(cMANy6<8x z*;EM+SOe6ijq#X&jZNZ>{=FVseHF!Umq=yT@K*76{sI;mmO93dylM!~*^mz;=GkJ_zf}G|~R0YHA;}Gd}O` zCgY-CbKqNghOQJy22;(ij(WcjC&ZD9nxu8=-O&B_yfQO06Ti2VNgJ=)^)+zHItb?D zdPZkb!+zRzR={u_%0Pn#nLC%YI*k-HFze+MN~;Nba%i5R^dwusRjNW!sxpgK$yy>a zo(z}_B(ZHSm=#A3N7?_Alvn@@n)t>=hfCSG;4e8>uhI2#=<|7XLqwCOssM(RU8(It zbpH65$QxB5036GLRZ}XdtT@F`AUBd^YMO36#r)wZ&k@#07q$RT|K8%oWg-@Mxs5pT zh|LO8^d%%y$G-gMfq=L4XbZc(yUR;Pw-fM;bT@z4X8NrN1zs>WZ(xoX2`#a*iFclO zy2cDOgGmteZU1t`!u_vus=D%t6Pi%iyZZ0+XyEJWZXy1uj^kyb+NH5zy_3vyWqyfl zL|x&}tCF~U7Zk+VMDa9m7>Ubf#@|vl7|^8YkvpT;=l!;LFxjhKMFGo%ntbl`OA>JU zfqf`NZCozH-=LwLTNN7=ZkfP73NE6(R?qEHIc!W8YY7omHd=x%1;~-Ob2+`uh+)Lj zYsVRhA2K;lR6g34e>}(GZYf9&apBfU%pc7zU)BmT_%idI6wsoNnLge{0(SQ417L2{ig_)xyfI)iPuemvh<`6}hcb@Y{07smE--s$!v_fS$Ji{sM&5HwQMF98hW zm!(|IlaG#4nraLmxzE7us3j~1X|AGiPHznh7iuJCe%mv-Pwx8JP9;0?U$&RC4c_R^ zxCyWAp|FGje*9y&keu{@gDF55f-$Osx_nl>qq8ju1%l#V7mQDz%5(8OagKnREi;!E zJYRgtb=hds4`<1@2#PO*>?<)szKA;AN;3ZoZ|n0&g%(!!Bs)cphJtbOO4vZ}zm^T+#|(=rUT zj@+1?cs<-7$;YyawQ0~w)dIJ_EDTwlpA7#eo2zM38?`4I4;wI*^?MoAtp4FG!rF4c zFc4XZ^sw*~aB-ioq>&OqyWcfxLRwEu`6)4SXsW{MjROzB^-IQ^;kB)__Io)4o5rOU z-nj8FFGQufL(Bhh;Jj{9XLE2$r)1_VixzW#YQlJ?#s8`gXwZA{>%Tp_SpE;##LW1= z8;cUPAHfJ4()YFguY3p^&<3GMuZE~A;ZV|{(B>VSHmrFJV3LIf22Ce2F3snQAI!Pw zL_@3v8AW9tJXK@sS6P}|r z0JhqOfp+H^PacSNq%<{0V`ef{vU&bQmcYSlU;!5y1|2>|>cS^3 zW_H7B;vQQNJXu4*D1z_Dp^-js;j21g`s+J8p)=XU=|TCTx%mLHc(M|v7bK-)I;)(fT&U)=&Ep$`Xa_z613r3C%!ZAtTI0DRV`?aUq zVTe~Y_9CwGGofg&r)TpR%dBv6wmtYtp~ zqo##?Tw!UYt=G{xv$5e(Be?G4^Uw@@?^jl0@V@Y1h_K!fl7v0MVYORF?xND_3g}48 zH?x%cXZdJ`>pvf&=vt^=GLDjEej}an8dn4rev|D}E6#VWeFKsQk2RuUVi>Hr9vkNO z#}H3Wyg_D=hIDWFP}c)dBtR7lNyvR1HB@P4Tl`=eeCL-yO z0pm&S?;S3T3Xfiv^(x0%|tE~+i%oC0>p{GZU&*}f+i594dV-3>G%JOFee!B8MLf4X$G z#Hy)u9ml$_Ofs}qk~moOkSi?Q=sZyZ$8Ca7+2kCQsg6ti*9w}3#>ZROztTJ+Z^U;A zeZyA=V}sZ%!!6N-iR3w7-8R(fHOX_#0GQGyk6--?p4FHwU1s1Gx2B;I(#HB#@ck0! zx<&N}a|IaBOtbgZv;gMES0U>01F4K^h{ZlvQ$%&y9_(B3k4C6r5?)T%94t0^>RV)< z&Tk9Y$W{jm-59i*yA z<&`Wkk>$>k0}IHOjc;Ja0r-`UI1F_;@UjB`&NlmCPZh1YqZ)$4m=*S8pb&7;*D31k z{*@I=`uy#vhCql;gkE>C3usmEtZ-J%jjQ{9Ke)ac$*Q`0g9t5hee($$y7?xU^@zV6 znU~@r0CaoEC%S_i*O&V6-6V{*O+~#-bxlPbtz2=GH}VFg38X>ovv8@L$BN=jCz*Iy zh4%itne_Uj*u~xpgxXy34~Q#ejP1WvQpTUW#t%^mk&~7E|3g$_Omh?g`Tc`bnzF-V zN9w*&zlCi#;eQ1JBSaBy0}4G5Mj3(}(gXvB`yFr6|MsDx7@5BkOBAaPduq@TrflM_ zuI@askSh$s*#++WeFIF=u@c{M-|<(_a+zq+vYE(Lz*}L0#c5v1A;DmUZIjG{tW|^3 zh=nH^hF_!WcrXBk>Mw(pMFn8NqTsFnc^=i6it`a!B_!=IFyw}K0EtFYC*LR*OYPKO z>I4Q(K1N#Qbx|zr(T(60=jjETeha&WVems%OR0&t2+G~I} z-FCmYQE(3=aH?=KjPVt8HQBq+G4b`|UqKc}-C~l^Lt5j&6GmYAoe6+Ay`Yql1O77R zn3PB2;#qSO)TqsAODm&bAWI9pM?jrj2At)*Nl5Czx$$(68NM+%hBD@D4RMSbEDSSN z6AL*lHhm3BD&uj7EyN^j#$4b&C@^d<%o8zouN4mJ->OEAzn~aZppAiSxXd^a)wkdP zN`_FNc5HzIN#>U6;(1yX$v|3}3_NN4*Vrx^<@>_*` zC9&XYtgu00+UV>hZ30xh)HrC17zAM4!v5P^%^yz@zac2vc8U-e9OA}_`x`}Rnh-o zoN}C^zZyRtZsz!P{SXOJA-aP+F8ybmY`#!GeR~Iq`=_8R;sP4QgiHhIY>E?bPw+NV zN-QV@wXGR9Y_>}|Q!SfYaXPAI3mUk`HglEcb1j|^n*kJ=zMMV&ft7ev<)yALm0>WI zo*{t*fq8#|Q|GmmE=zJDa-0uu4)Jhs{b*|IY>O-`3#PALnO;~;ud61v(=xFeTG%31 zb%+Z!|2WF0?2m2Kgs^hT~NbP$i{Ih!MVK!EIgpOilmZ<{-V;w`}P zkY@dY`9q4K_oac^t&c?muX9~0TnGL0Qf7^o1y)tG=aegAF3eo!W#Zi{Ab#KKE8)kR z``H@$*;+_~xzNr&ntU%gujVXM*ktipeE-f9whBlrs*o)l@SEntjgW{v|7vmd)P*{M%`tlw zkoQM5b$(a-v1I6xc(Yj4?}!UrOFPoe69xXgsQ7u4OaDs&tx`Nn$To!X=l^1kplsr> z?P(PzS%|W)jeWh5W~v+OesXdU@FD<4^fp?wFK<7xHTbm9TK7M;30^%FX$oN7B6rQ# zR_zk>zvKheqP`5b{{de|-2OK)0uw9a|K7W#G2Z;xN?U#i4+sC5*p~;4_iOzU<*hE{ z_2`m}DwLd$=@Mwr1dARS9z5SmG2#Ax$=OqAEFKRN-HI~fphpNJ3`1+uqcQv9^6bmh z(eutl=T!U)v3kC-AI&)kTg_k)ORr;%uAO%!WwxbKV>Z~9B(qb+q_}c9b^bDCjqK(l ziU!~?L=!Z*8u1JkLp380%Fr0|q62d-bTFLRK?*r+PI)q8L&RzVkl$w)PYRxaK4{Wd zzl8_67yB3x)8taAUYq8iy&XMXe|;TX-5*gU&kFVXHwgAf$YZlO+4*0M}P-BR^s5BOVtX6y6QADTm zPoPIX$D-k!l!c8fG8HC1q^)$}*HlFxMe&Skz-11Pc-4eGm8P12c-G5Uw^vI!7g;^x z!-c^U1yCvpZ6N|t8yz0AE2h!Wks4R+V8cKhiTHv`3JRWP&h^_IKTSW`<~&&71Wh8A z>9&NdjsbN@t(3Z%G9L8y$Q$ttQgV{6BPKAndS~mTM)*j{X6u+yU8nwpjOIkQNO{%_ zznG!UE!Fb1o9mMz%ZGcSiJ|l-vD@NUD%l&!zi_-NWt@yFeR45)2b_HSO-DOSlO}{zJ%ChhuHQ6=RN0=89;6Nvlq!4#N zYKaUHee%J1D(<6|+HfQ~0Pw}LSVr6##{8URkbl>@JVbaKSvYR#O?+zy&PR-?hhU(E zeT6~Iu-X_;L$Sx8T-G;qZUv0NejAA>_m3xNfIvA>_{ZxY3#&Kp^79;P0MJl{C@pv# z&WOOmD1upz|3M3-Z$Pr85=V9+LF;(`T@H{S3Z0}AS%)UJFM9lS4`5S3B<6j&36fv{ zLH_=s^-4#jMSX26NA^5;M`7goi zU^C)7=cGfcr>k^gVoKhU<5cKZ1NB?3^t~WtWz=>3dOqLTWI1dWXvecqsH~K5hsxQ# zu=!Ld;c~!IJOHPf0j#UQX)e7Em0E+4glD&=kJ?Lx4wfDCZ!{bK-Avre*Jny*>3EV3 zP5jqql2o;FxD`AEH@$z=2ZiV}7E(6FmF4q2SdEn&A52mh;yPcNaU>{IK;bW6^D&WU zo(J|gwB(KMa12Hua~yI@7wN^%)03BT-DI=?`2u$o&P~XBms7UAc)64~ zm@Yno@(12ql^E;qvH3Hs-*o5L%P=~Edk>(A;vZ06L`#yPKPuRd-tRxlN?@im2az9+ z{*2m|-B0E7om0os08I@@Cl{4W#kdk~mF%SK+#q(0!mu@DK*5Ktiu$!6w^(-*FT9aR zBWVz}hH6 z27W)hTr#WIWJ;E6vdG>@M@?E0BQoiC{%$~o9+x4qYBDJ#p7L~v@=WKhL_FaFI1T}B zpMPzvT2&UqN7lwCd!WrOcS~v3IwkQcR0cAf!y-wzF%BOE#sqWDD3(%7p)971f7I5* zDm|&L`VFege0(_0RW51!KH?t&hEIA}KANK-HH@1BRHW+G%xg})FCR}>*ke8$#KUTJ zmAqPFFP-oysOmfUng7#r$E~ThXugG8svRAX{ z9T^vq()8wZ@!lG*a??v%7R9j*?FEI>G~q8QAl?tL7(k&;8WsK@TkjO6NwjS3mTlX% zjV{}^ZM(j*ZQHhO8(psIvTgL~wfFwd)w;{)$-K>o8FR!K@7eNz)cAf)9zv95mB0u zDgDx$k(XP)uATwC1Ho8H1g{o|4&K21hd3_Bs}vTPp8dP#-wo9dK!P+AX?5=c=F2}* z;NGm+^o8%&{m!u9tR-c#;EwK2{5YY&F8$tL+DzYI|Gm`tw?}|&Ga1b%C_JUtsDYl& zb5}Key&llSf>=#z#Y(GU6Qss=4--bHKrmiQ9%d3Lk1RowJ9X*sQSehIXC&j-X39xh z@c6_V2#)Erv&-^6wskQ-jp1Gq!LY-CK9ZoeE2Czo%2qB zr9KZIqphde;yNIk*`vYUa8R;iR7}0iXLE9R%Nu5*UU01mnBY$FpCAD zez(~4K>QT)lGzoDX^ez5vV*BR3mNGJ1Y$_z-@l|N8B?ek)lz}mCF;ytYWNowTiI@8 ztc-so4v+v(uXQ*I+Qrakb+3xJ$$oV3^bzn9i5*?YR$>_AT zJZbhrRSjU3RS_9D4kq>zX9^bPS8=rUtNV=&$Xq>ff4;_Xh1i`Rvf^o&rqAIM<$C`I zkz;p!K*;FJf4A)m z<-ZKPEF5e^OhgXG)-dT4tRQe8Y%KqiSMX1obJ!9`>bulH5&}*R7^T}gDuirrjm8jP z7<-_Gk7Dmkf>JDzW+;B!^DwtaC$So(58YTYNgwkW6j7IG)XsK1mt2`(P!PCC9Tgyhjjedo;8!L2a6od`G311&8 zbyE%)fa0FQ7k9d&gcK zP|Md4qqUpR+L+&EgrfCs^nA|R45JBlxI-jUo2<;QNeq-20z5-|Y4rS=Q2m%#5g1!J zXkw4&tqw=ofH}it8=`k^ntp3uX+ia8{KWCNid2e4l0ei zU>_T_%_$~9T)bx8yRhPHz<;@{rnz*FmgY$|p2E`o|5#REN~NpEKX#)@3P|%m3ComF@VX*0 z!OXo|qF!Fe;SL=_8C1uhbvdlukfdIZJ_7o8n8M<^%wYcX!P&J_`m%QdeXFRMK3C?` z-t@Q8SSL(RS7npE8Hei9f63dD&+mGF^X#t4;-rU|m3$pO{O(oOV-zYGx@T`chx>Pw zj`H9SiM`Ty+Y{`N11x@}$WU~qkNhIf>QJ%F~$oS#C*O(j*~qk%%Q^3-fz zq_VnuoVs5k#;V)q9*@1&ybQ1H9WgUpVT)s6rV2QkdhI#xRNV&3&$X3F-DhIFESf1? zExgrygr_5dVpHivIL!FxHe#09fSk#>Di=7y!K6if;rb^^uB(wr91xJxNM#g$(hAP_xoXi9Vl{{mZWcBYEHNo>^Xw-nvVJHM<&MX5g z@EaM@Q_J8q$rCkXiaQX&S@U?@M2#j4g1B{v344PO5F$c~5N>GMu+S$`BgKu!xwTFe z8JI&#RQuy-_Od=)3Y+niTZtq>%YbWzlVL*p@Sr($@X?Nh<8`OJU+Hb2dhd(qk9$S* zK=XmsKmMww%9FEW^?wXQ}k6 zY-bst{637C7tPq|lC;p*3Fs)@)1K$!-09&d_~We@Bs2) zZ%k>t;lEY!|0FbmGPC~QV#TP2+<#{H|Llgrmv9phbg6nfgct2Q^yh z1c-K`^h*7F&pA>_IA4vNL!60~gdHV3o;aCL1gi}M?@{*aD+uU`YbiF6q*^)l!hxOA zMJ*G_aLbTj>oNvqD@tzOBR)rKog#Ln|#Mq0T+jT6y4d1veww_t}(_Nb!bdSSh)VmHjq7E0-Q+!(9sWuM6r(D@g<0c<#UWH zGfHN)(B*-;AMf~hQiOO~MIsWUL-zs+jix;b<#;pIAX71DouIc&Sz=mKNqmGNt3~VK zl6u_ZMckrufdV0`4r-ibY{zfEhYODz3+=nHhaG3aZ#|iQh9-{yTsXFr;}$LEz*D^pA#m@87|%1f?2$iG=CLc@50(MoP@}WB?_I{5)u*OuSR# zFVTo#FaFNX<3SLJ!Cx5YUXHhAYeI0y0@0*r8iT8VqxoW`wPQo5mS8wYrqV_z;|LV5 zy#5^hL*EwVCKAlU6j?1{?7cSn6V92`oAjjYY05FmOg$2x!5=nrYP@Us7nRyXf(mxy z%!ZEn)Bbb&-89@Shreys`w^qPt$tG>!~^^Hp7QwW(Dg&E$|v8Om8k;!*L}vscLn`a zd1HP6W)|ZI$n+(FH)^C2>smNf+;GtPOwMkZ^YK34@2}2&=z1+rgpof7*02@7(_v%M z>0R3a^0)>LRaR@S_b1^RE1eI3D(bB$Ck zp|~xj*Ontb-Za7sYLz)dfmNH&BvaiX0J` zWDb(Pr{Vnj0lPt92rlkW6_)n8W(!lOm7v&JlJ?S8-`P*&4Ai|ZgyYhCtw_j(x9~kNu!sWw`ZUskz&+i?R%;goV z?i=@>XwW?*NH z)H=!8o=Q%g>YC`~=8STLe9(s6D2y<`NHB7L1az5^>{nqr{RkR^L}IL9uS?I_-zzB z>1|MGneJd`2hy&aU$5PViA|=oT1&v63rRc#x1-&Axx+cJ!#M^Rf(CSXy^$o8kF3a0 zr^eTgV_!@t@+29A;ejrV&H`PhI$9O>8jOMlUoTg388L6evTsspfo!vrfMBFdj2S8* zd*(kcblsR_k|i?r{m0L3N#92&dbGc%bI=%~CAYG92o%0EEXXdyODVBj_S)W~+$ZY<6Et^e!+4VcY-QTE@GKh9&n&NW_)qI@IN?^d9p`sS=0a3*^u(E04L zTYWyRnLPcdvE`^3a>UxGsyRNM8oL3f&)3YTxd-D6YusXQoynHwKvgH;8z>-kh=<$c z{p`nbMJs%5x>j#mR$ww}RtTUBe21FF$xJOCyM-R^Sz8Wv%K8G^%Wf-OtEWz3bVj~I_m;CU-O1NUlXo*X?E6KiB6dGMMxz$r zx{EK}QYxGlbuiFw+^nQ%w0@g8uoct(v~A@4j-b;wpzEXKf-*)REZ{&O%?A%uS&5F% z&uk77SvU^Yy6|1C0konz-B2n)eNJ&3e7R9_q2x6)=LL_F{E?ptWenjOdt`1XOO6iA zFWm1q{lP3ACdD4?l_duG+H>PksUlOcoq%`!cIbym^ zyMd_(Ew#YW%zsp1ah{hbG#?S~JB@;=kH86%Lk5}7=k9QB3vg5hv|a||t{5bwh?HgW zR_#dcpG6$oRMx@6(svWYft+|#b$^X$22e-Wh;8kk!pJg}2^m8)`UFEvP7ykzSkrOT z=~}9Q+z1=nGjj$LIZo$UZq5z(({%WqS zZ&4ViIs}5`02q>E&?=(T=$qO1674SJv`~;aDxdBomEV-vQV?Y7=30jHEl(B6j^kWT z8F&+0j5%=$>Wwj<^RvgO1LcaSs_AS0^TQ3WH|5GZi(Rf?Hg!-Cn7Jw99HINwDt;w( zPpJxT%=gByNrl;Y)njwK7+&qY`HEv(qBPoo9nW6e0mM74Tq)4GOA!_bvUm!yD7i7b z>IXPm5`>{jOZaO1U*}vxYFvfW^Uuz_3!aD;ht-y{3kkB;uXw!z~o&XLha%ZdSfUzV!$;HzoM^-?*9OgGGNu!`Kq! z0HZKvABI}e< zJNoM)b!mc%JH17|FeiU+N1SKL7i^>9zpP)^4UwS@^(Kk3zTWY}qjr${j0g?3n3Ex7 zoy(i3U$+e+EQmnEL!zdDn?2WYQs|y)PMMY>7oBWZn(orV4g#HWz$+jEZ?Z{&NDDXg z0m9oGsmy6EriKm)+Ow=P*dK--(jnHB@&Q~6G0D@c8-E7LQnC#4L~8kHCY8?u*S*p) zVRW$ktz)kC+d=)(W~=Ccn65dGRi?&!p#&eRTIo1G6S_yyt6Rb_7!XB&Nqf88=f}_# zdtFg|ImfPM-qJj3L!f&&e^8acyLOv{@*U59@CG2Z_ z_F-{M;I>@c7l{+_4FCljU(q`x8A1Z?&vsbQZbU@9GJl-2ldv0yC(%;q;{fjb35Qqpm_1$w9~g;_=X$b^U8 zoSSfKvY5b_*zk))7JsB3?DjBM#H z-a`ZC{@*QzRCOJPOAa{ye^HcO{3XAxr60)W2009MoDq0j?b=Izi|C+b)wXQMU6$7c#!2SkPm^}z|z;p^MX1ycG@~)_0KQXGH*s{MX96h);hY^lrb2e zEQ(x-Cr!s<@%x%{4;o;1+#Q&u zJs3aDEiDl}hIv0LqUG7QaCr?~oiiu^!4waGM||?n2ZOA2kN4442@SCwKZ8}tzctos z%d=1Nuh;8@)X$Mb5}*B_Yf(JVFH|>`|4EBBAVm<$95-yYZ0h5eGr6(&O=nC3I(KGWr<4L=wR+|it zDTKqK$%!UV9Q>t5n*APOel2E#7M`PS&a`e8ujkd%n0xQ}dmVs*0(a8LZeUDbr1;bt zA&k(ve=kq3Xk!z&)rS#*w+7N$hG7W!5e3>w>QDlARgw>{qcB?^&%9l3l3#gTwhtsos;iCAEH1u!mAOj)BG|@WlXxvqDhDgcMHDgH!mwG`FU9`tDvHua& z7<2lSV0OFklm~om8Vxgpu^!V!-yXBcFWjmBUT3OarKA?dZnW5;e}EGwNc#=AgX;5* zq<`TQSBdpyY6bgk+(?#FbD@lZ^LJnjFAzfxXwZICltjttlCzjbg6K&SrD6l$o}mB~k2NR{2qM06xMp_}|sP1@;1f)#c58q!HzT z2-&?xx83ph7Qjf5r{Lbj^ig9XJjujd^BhTQqPi_oxyjk$cD&|3Z*!~~(C_0(1TT;z zLBxksgc@B(3)xi{m(wS+@xvXUubZFWo#<9d%Rk_JBU%Tv$=^pI6uF?Mh{%LE~VmJXwHUl-{pDzq3$d|3V-rx!pI3=lA+R zwCP~^_VX9EPRHxN0ZLi8(}C$gP{CMO{t-%<{eY<+7OBj%KV)daDNyL*Iw*G#n(I};sTb3$de$3&lM~-YcjB($yhhuxbk0*@d zoCbaoMRNWVsHwJbr*iwB;Y`vTR(}ZpDB8u1o)GRL?g3ucclzV@{GW+sb6bt_@Rs-> zjn|k{`@vqgDpY~0D0zn0Rw3clfkQ>C48486y z{DM2F>~aWRWi=JI?mp;L^Ru}f(4F4|V-;a=e55yQrPEMP)FZns;Sj!0UX7-kqE zdJR0it?Sx->OY$*vF}x1(%XS({!zV)X^Oi61WrN%57g3%Lj-~#BioRJ#PKE=?V$QQ z>)n1SVET6of(Y)Pilh4A;ZLtaK*dZ^Jyn&2<6c*8z4ku((3{LqA zy{sv^$(^J~{wAf-J`G%z1St^NF&I*SP9E}+Sim43BJ1Cbj%9s3Q^FBQ!B~m%4-lNo zH7|^)@w`#gpA{8_ykV3V$#In~-SoJJnzyKtZZ7Lis(6tBmLR<@-1>h=@BpNxKPG4Vu!*T@~>tbC$ zCP-@0i!d9gAFvt{s&WvBX&R|Er;H6#SXg^QJdI)bVC%{%h}%o4m*=5Ib`8o*m{?t* z(L?y@GObOuGZjTkx(S721>;M&kPK=dEEwM9$B>dxrRj&055+a*cjBNNtk}=prsv#{ zXa=1Fn>xGYT?*HdneWbh?<#YM~IS)Y3UK&1BiO(`X7WeW&IU^dC}hxuPBq zwROWDIbxZoo|_UI{a2#PQW9|tc#{#~NUP;Z7M201O7Ktozr?cu}aQa)(uG&wZLGa;vr>gMk0z7@6iYHCFZN4>q()yJgs zh~rVuq(tZ6k(iQzfR0=x{N`hB8|3>o*Fqmf#$6Gn-ta^bBuQeD`&i53GmJ*ESBvq_ zIz%Fxk?Uu#V_6&ngUGk@5|sN~X|R1M=CiG)VL}=d0~(a{qaGq7bAyDR7Ou#q{eFEi zs>dG3*q;2=#eRA>HNwfFY|SCWGH+mi@20CfcQXLL zo;KptlfdMJ>!HaKx-(JANpOsb1@flB? zU}U3HdVeJVl)%!E(LTHE>yYf>dL#F>*a^8Q1i$>4_J zuoH4oF|##Cufd^vn}Vid#XbaGJ1DbP*;pk;V?}gacW69%U7f}ygndn>lcA&oe|1Nn zO^QiV2u}tiYX^$-gv@l|gZR31=+c9dq}kSxfju2!<)X)SUTtRxtfGRcJp`Y0r6zN{OI_TZzlXhUpWlM9M z>Z-3jFrnQFNYcr3eEYZ#)(gxMydCWVf*oJh=_(@AG3EBKQL@vKN1AP*{j6 znqhyuOs&#fuEN1Cog-rm*9hg+5KTp9`gW=$6Dm%DELhy1hqd1U1(YSDmKn9d^_SBK z023zt-H}78F35fg*grO0{$m?pk7W|FLFhjBhA_C*l zi8OfwL-j$MM0D!FscW>pDb7*A^WyyrK5yqf=VxG&Wa~EsTr*Fmjv%k%W?wYF?bc^V zXy8{fM8KnPF}M3LM9P;>`n?ObgcXaKnXdL9u9rolKTnGi?)Le3PV)J>nyoSqeRqPG zVde26+BY*#4$(q5QL6SD`M88Hf2l6!H+=ccnZ0e52(q*@8DMQFwsS}p z|7DD0W%|E#XExUVOA6Z2*!#~Vr2ne{aSLKpvW%W&7BMj1E|f==jjn zaOzRX`>n@#vFT!3bDL(M9U}Dk;l1nE+dXfRRy#(sf8KXX4nN>pO#Kg8A+Gjx>nOGh zpI}Q-0(ao4_VkRmg9~R4K= zXLv5zzo0G#7{Is$YNqFg>kzyHRW`g|8EaH;M;l!76Zf4^{WWtt$69Zd8s%lP$) z<&`=)&nZEq|NZiU9yTRP8Dkb`fk+LvGr*&5f(JMD){xBz0ru?q+K@W70C^&YM3C*& z#^8ZM6f2Zw@X%JB&4(VU@2P(SGn*SJW7W+VQ6aXlsUkg+sLnm?vER6~uCdyO)9}ynHo98XI>9 zSU=KmdQ=%qUm0_MvK=;%nco*8eM;>+($ZVp3bN1!6Kggfk~g~5rzH~8N3>-9lM9uxQYKy122W>k2B60;DySe0>tz|ICY7IqPA1*J?Caz;u%bG*gag| zy&rbRdZ7+?%Yk^{`Uf`!VVLx$9w@Jdc=pbP@^?27oWY~ zK#ktlj2EVwr$~I zFa`DmMfw!P#PHygtq7A4<)=X5Ji-{O0MbK{d@46B&uUWA>kA=7dM_aWznQ&(W57qu z3X_@YHG-zKO(VP+Eg?f*KqwK0ci(ME2=aP5Jh?wn5nd16BbPnPGgv2wmRj|^BJPtbOhQM_m8!M)5M@)dCzk36y1LfqQW!g0|IO+ zd+kSSzaA{+L)bb@X2(V=*w_nW$(;J<%Q8%I%9XUdg^vI%+?6QuCS8nsdImWW2DSa$ z%hX4?2eGZ+wihMpRy&f-X#JgiJtclw!iFvL@i$Xm!Qe0>U@1rU66ckA2R;*s`NJk* zVve519z+z56UXl0d!g-6-yI^tfXNmWu;4wvYKEAV-uZika`PzVNeI{Rrl|hztW8&{ zRm<%&1SoCDshsj!6o#c}=#kipU$5>ew=jC{_dnrw#A4OmUa1(}vY2}oq*?qf2o9Jg zXqY%@;E4E~QgKor>=8xIu|lF=Dy@)i4x~7Vf84~r!Mwoj?Bw!=V8UCM0bIsAOOggE z1wQ?g%du+<+5k~f0U?heLMOJnQ|(Cr@6no+9q@O#!Krwe1lyv_$R5+p?p*#?f5^0`KLY9cba-Mjq_ z>*t3szJZxqIZ)Y8rG4@ixBcy>H$v{?bT#au7Zdqv3*$xKLv6upBzH0nu*Y;i5V^{R z-+wFQ%>Sb$fibhOa{TY`dabeZpF$3pH!yMqCIM}%x{WvTnaDDoNQ2Y+^HNF=w^3vV zjB+07oc!}oOj2s9oX|ep~JEsxlUo6lNjv4Kbs7O7|3vAWZXyDSia2Rtr1_2k@(oz@$*#t}=AwQw@v;5LGGMP6=N zVWCV>dp`<~Pi+94uXxnk=y6f5j7F`9t#WqbK*zm3j9xRC-j`Knw-*qK4JGpRn&#(= z7NS9-9ca}tVRJ$t=rmDfP-xW^4V!{w$VHOpO*mULrAU5Pfj@Pr%ZYFDte9FzdJuQO zZ-)k+K&i{c4cJ4P=Wj+Vw8wB0c|+(3Xg!8jWcosA;1vPLQ$Rab(NB<}-KD}@Hf{cp z);_9BEoK?ng@`0kdWsj?=+Qq%SzDuO3J?eKfMad(2$ou5mYMp79ygX% zY6?Ude%xCHj0DYWLP?6JMw}@>>A}iI_)JU&`lSKH)GB(UsLeAhMUbAX3DRD8iEoIU zJvNnh(6y`H*mLYSan;a?e9&0!R+A){RY)n^5d=xnguL>P1AALD0o-w*mscP1i3pEn zc5_ir?0%>y<>PPq-yLjE*b;!E)AWkB`I8Vu6<#>yAaC6-6~SI=Jz{czLvt6kH2wp} zAuZtLYx=Nbil8b;kpD^UMNxGtDoEb4gPLnfA4%^-A>McWm$I3gJoEhd3$<&o?_gg( z@<-UQ*ckQQhHex})+8~O!g(DgqE;)l&-y~4k{u;*c!VD37FJem--17m0?Bw|9k{Ke zpVV=7UnBn#rn?;8K@IPBy!_cfz6^?Zfj{7e2AWYbH_sa$zNL`2q%B~I!lGZ+(iaq^ zg+%cb=(GdnH<`O+s^ZKsaXB_7>q`Ukcb=2e0(}wJ7{Jnf!lw5aefq5irAJFJ27z6`ybFo?P%ad%+e`Ygohgogub8iBV%4qnol+>i%WFgK0~aY@K0CM* zJsip}4@~2PO!Gt4~_iXS)JT zV*hsZoPIW)7JuInB2ph-aX%a>X+zE~vy@KW)wr++W4=O}3mV>~#x3Z}Ht5c@{;adCO(SOKIyk2z3Z z6iq;Q|86)Qz24brv0!3UH{;-ZVmyyz39!+_$bskbc)?=`w0r(@ee6wo1jjP8Yv{76 z@K#9ry|-O-I^-c+fAd{9*SoK?;dgWNmNu-!KY>uL{y^H=$J0th+^6I|`NeC#cH>uR zk6%XUHa}HCID2u)Dt)q7qrvMp?`jQTtys5y%?7qOWt6V{_fChcTB7s$>~wAP>CE7l zJVefat>pg~6wJZ#ztYO6=Kt@z2LmSoO_f$=Oyh9117oYq}NG^ViVX-L-Zpm!x04m7z;Pu%nA&5W!Fa_09p z5lqH)5&Sl-xqe?GHE0x!bQw{km-3PJ^!Y9x2R;i7HJ2L(JN}3DO~V#`yj(6K`8q~a z+u(?RI+B`rh|5r1iES(oeLD}k-+bf!4<_94ij(rpjvkt{`teRg+H#jE3wg0KG~R zRhz@h)A1EbU;6JzxQs^pM#M*^2K+&R0cm?SDN2QvEb`eDawIkvf{pf%x|k&-v-!HrEJGORh!kubL~bE#rUke4Lz* z^ic+}lxSVJI?6aGGaS2Y+d0j#0HDC*T^-5s%q09eSnrm~Kl{>ndW9gLYQUJP@&#TpX^Q68U zzZ38NYYT`j-xo`ue4s1p)igNJJOK=E>*nE_w|}`ff`}06OY!%=+pE zPc>@+$hk5Oo?}&T$Qg4wBy;7fd{K6J#*>aY{z(mTbKDYoQTl#t4H1y=SV}lzuiQ8K zO{BFz>HOq$H7dVWT@_AnKc~<8&9lw%q)&#cI_cwf+g6S35u)5@q*TdYs(XZ`X_Am0 zTG?Ix;4{4ttUaw*z9aesK>DSr!Xa9#G|5KQCFCPDm;?1-cT(9(XuxgYY(u#x`Y2>i z6zfQ}XnyjBunIH&gN6ySA?FaF@w5+40_0iPn2pozt2USOo~8TT-ekB ztVT$e>N0J-2p0x_h)KN&))@N`lOi&|^aJOy>wlrW+gG#f=&=+gwZ1X_YaQOkU~c^{JAEMRenNb%US6_8qeYiNFH z`kgx9V@y>b<&jBMK;P)_O|FwGdcghiaWq>omn|&5gz71JZ64?O!PD_7XpxA^)%P%{ zS{zu#HdU%as**JkI3I2l%9)C*sDAp1lVT`>FMA_xXH;Lpdxg*{JexaGpjaY$%dE88 z6%1PpHU>=yMbMu~?jRaBmHY zUeIhSIYhHLP^jUQr1M5u_y(8*h(doye&yRVpK&S7zP&!`Y!TDx9u6vBE9Ut@7chp^ zd+eh{CA@X&bpT6js%+LR)yuHwqNSeEbEsl9%oVW^tEbNeWzQNFHJb!cJJi@lVVj=` z)$uT25ID3OppNDFw+Jl3<-=;Ut4s*8$4C%(a(yUi3lieOkVV(=r#zPI+AQMoevrVa zSRcDPL>F?@0Cex@k&%VAgYlthH?6o)BQXUb_(KDWL1sYzWS_=L{EsB?)UP>CrrYiu_bEpofG$&FU{C{?(s&Q()MnrC0)D~# z=8CmusS3z+ z=6a9EqOo9;*-n2R1^{N-exdY&WUIcXbY4q@zf4Qh8bK z=ozTe_rsKF%&oUa5R^{tQaVDW6vzqJJ!$lE{zXQy5@A{KL&Q4R*-C8|yi{<12^zn# zVoEPO_M*nRG=A+q>(O^#_eV|)d*cm@?n0OyWpVyB62<%cu^^_#*PsJ9gkExui_|$d zyh;Za^DyIy{6ZaEZ)do)9JN2nbp$ovi7UioAdFm!@uVHj@ZG!3{_r%CXin{PfaTO# zGUAYKzo>WXZ$Gvlc4d9|2b}~~d&YqiFL$Zg*uAG;-9Dxcp2L=f!HUyyvp`+H0vJo( zfAIgbBX@ar_Pl+PfY1XnG4Y+aXdfG9NF8?ceZOXUa5x4Nm@1`j^_$!Dam0)gDVQ93 zvZFl^NhkvOvxE3MNEJvKrvuZ>DZD;WClnUjToJ~M)Wk8a9T4!reidt@SnxPY9hg*L zBnqN9MbC$yg=mXr&P%{CB$?3;9(0W)bLEy0+sE-M*&wOu{1F9wa8dU|f!NRwTtz>E zFqMD<5nB$jmr=&$gjJRh3VCLIVA)q;?^Au_Gq0drX~z4KXDbm{%3wAeyP6@3QMF34 z62gy?KTyiE%d_2lFkmep8g?g<>L#i}v9QbC*-CpHD7yw*YQSSI zMtv()%Sfn@;TVYhL?Lb(5)Gn{*ec*}knZ*TgWTb)2{r;=QJify?%>6E9EfJDl9WhT z)U$L$YCRlw_ZF`7U}P)&eU^_apZpRJ00-!$)#)8xiH%fKTBl+F-o*$Bu|Nz_!tLI1_+! ziFmMlW2Kbuf)ECgWbuKqR*6KdJAV+M-S{YSO+wIm!nR06o%0rW^ojeIBxQgg0UOXlO22>zuJwT*pbV*mYN zG(hk)Nf>Nk;;Ph15AUtwGXxX{i#L0d#>-&*%ifqy*fZp{2ix-9-C@2iMpS+p7zUP5gN&I(4;#W}wDYyTf~6R6 z*Rz=4MaIMdp@flU_(lCU{|fW1;KI5N4r%3SNIDiB;unX+QR7@-YUs?BrQ29s!l)IO zc5dP-ldjfSB5%kob90XRZSu8msm~U>--c;woPAOz1~BwE1XQHzwB(u`d`$4qeRP{0 zBG{2%JBIa96E3_xgjdpM{}}{9o5l$Mj8iy9BEb|r^B>wSa}i@#3l79zE+HT=BJc|C zJqqfdy9r94d*LC9BM?@Qo2ZTvEXY@))<8--6}2`147=B1Y%q_^7?vz@ZN6~iyf|N< z_SA!ztPs-8eiEJ{{TmrkYBTXfie>hWuNYwhX>JJIH~tHh)+A!&|5_u0nUURp9{*!~ z{Eu;Ffb~DU@t?-B089<|e}i0}fsrAEF=$(nh7QddB6gNL?q-QhOp(Zcv=!bFvZ>@V zw)g++cejzz)~dj5Q4-w7jUNvC6dob0fqLAX9Hoy=Zd@7)NamQH%tJ)44!G!1LRkdA z|KlkS5YjabmM3C%95P1l&FhC7iLhq`Pw_#BXj?JI0d|zQU$z$yyIBso>$sd|#ofVB z?T1I$B7E&kF6I-Z(ySZp>2Er?^0}q1w(K0xlCi6s?pNZ2l*Y#W*}5=gBb8CAbr&mc zxRBB7#oElcXK$Qo~?B>MJ>2 zgdN2DDx#*ZJQMa{CbhsV6hN9)lc7`+LXNOlaF}L;OZL35F7p>1o-uTZ5^u_j<)qoB>00R=p-0(%qjhM*>dFDAYSVM~z&>=&mK?TEak~gFq{L0>zLdLhkJG z6Fp{X(#d0WsAJsB-N;TGWR@jxvB*PzFNJ8233k^p+A%e;(O1h(v_?)ep=O@pD7`{) z0u)jOKxYKKPyr~icoO9ayh*LbsZ)J?r0(!B=EwJoKArSwcsm)RDI3l2l3N+(viDu| z1;s$cnGdY_$^_5<=*jBmTp~`ClYu61a}woa_sf01-w<64jFBn{0}%hn6{CfJa@B14 zIS`=bw#4a2h&MfA0J8bEw6W*`B7GAK9e zaQ1NYn(2g4f|gh0b$_c)iQOdj9X!GPF-EqTl#sLWVqUNnU?_lo8E(VOK0<3*QL_dj z7v$FyZ3cpFy>dK7{q03xt)tjgYjz&?3^xe+hJmr1ZJn3ilHK2 z_O&6P3hdnoPJKcMYCl3k=_&U5O}d|DaZ(EY0N0gQBlj4@%@;wltJ85IXXP>@kfKcI z#-08Tg0SKZ*Np}~jKe_;57;rJlS72yU4}Rcbp)Q1>nu|O}PO5dHGeCD~^DeA8 zOBmk*H^MkkneR^yu7~#;>(ZN-bn&I9pZ0W}`odC_oSK8pv-S|<8sOHZ^2Wbzubkq* zZcDkO{uZ>g$As}}m4+woc~kk=~`^Gs`lcU(oRc>FN40Gd{4aZ-u&;+WVp{q_au*JH=)aCR?u|a%VO? z=H*X0>YyMAa>Xi9Dqy%c++uGs=*7N%K+#_Wn_Dzq7edz|X+3gS`w)+-v;(fV$?;fb;BgkH3@Eq~{*W4H~~_shs-cb6r6 zDBeeE=auK=SFVQU|HsxlMOW5t?b@-eif!ArZQD*NPG)SQVjC4!Y*cL9wvC;4t@Z7H ze}7vCbF|r>gLyCx=IEpMeqDEvnvKI*(~PJ)-hM&$#t3D+c|NLGc7Ne-00_y4t;fyH z$Hl=*d(_U#wYk$zU#GX%*WI`syWVtO96!$P?_1-jVPE;4kaf(30fT*Nc=qn)^mgjw z#N=vf4ZH%Wo2!9DM34(CN0RqxXB(=~y^b3&I%E0n>Ey?U+tuEt`~GUj>H0dM1MQ^c z$MzAjc4-_AGy5@v7LzD$|7=bKBEUiEf8(8B6K+E0DFy(`h%aS7?<9@ooqE7tM&WUK zTk&1(I&1ql&wf;i5VnHEcUxWiH0{+*`Pp9|gCWawH)vVU)Pa4@2lU;h?f<*GPjG)d z^vtpAxuF|+?CHabOp!{yt{4R|uhFY&FtA`Y2vzHAD!muo(6W7WwjElD*YU0qZo z$PwkZxp?eGB&3vZO%FGb;v8+{%JDK()xGrg6 zJPKq>3u7|%<@VJ0=I6`W$`B!zP!R27A}y!{_5f&X9u`X%pqI%-S#XG`Ku_Sn5++l$ zX0>di{6d~?J+1B~?$3HXA#yg_7TKk|lqR%VYD~!85ciGcN#8x1NdTwrWC!i&@t+F2 z*v^)9f_4AfW%zcpgvn7Sq7}4Rci-W_(*3IooxW@iaG(`48|D+YiC!dOC?5tn6lUb$ z=icHJPao=Oz?+FGV~F+|_8f+*zhs6P7|`RJ?t_S*V09L8P@a25NEaYMwhdX=#o&2g*LORB7A zyA{%A_iUswy*Zpvwc63V+%wx2()<&nT(1F80FeNWsd%oohfR9ad=*VTgdR@%IDtJ1 zD`(%VP*$5YrW@*)uYQVIl~g+?#K1Rv@;sy6_CsB$nkv{%>qf@9)zu* z_ne+yh30xnWc2qv(4G3^9RIVIa!7$Qr2s{a(27bPFcdV9k-ImOrp?}!TI_>aB+$$@ zE=oA5;A2VB34J&whBndeyrwShGK1#4)9^w9@HLj(#4wZp9(<4n@U@!Nc_D7Bc46R68ARf6Hyh+3t=2YVJw1=TvyAVxJiuhkfAvb zD4Xa73FnKCte|nd7Nrh^D<9a}_SjY+ab(RSE`^|!q<$@&i*#nwN>4dAO#-DH4)kpA zW6Kg4cJ2f=sP55!i8bo|t6S(2tY^SrMUv5kp+@D+Y=dk$4Yqxbaq4j~>*XoUnR7hl zVu`bggsH!xr=Ww!E^I@UA!4f%!}jL{Ktoih9d=IPgUdX65wEl>!L7;>9U8AR+D~MP zpB}G7n-RD!E>fWF&8I0Agw7HXs}fEHUUgi9vWXRKj2NoLo(i+%N>7c*wdZrm;s`JH zl$WK%+pUR=G}?AeQc*yR+?7y&786v$Ij4bLcYXSx{BTd^I7)1~h73*CL379mFh&>j zR9h5oRBPWv#SGeb$WT+PbgLk5ExX0LuPVY(m^5_B+ltwhUC*FY}J z766s=XYYQ)Jw0+?kxh0bjn>_Olq8sIca7x6kH>)Pebr#^Y|S>9I_O z+>!)4m-ptsFQm@kijAK5U?Zh_#{oDm>!MMmcLVgJW&lWEmoVS=t@>q|89o7sVhRQ` zzLZg#bk@Ez+xy$8%sVSfgfGL7hMtLV+cELunL?^gm;)Bk^J0W0S} zQcxr=cDDaV3i?0O`w2}s8&VFW&Z(MdhUqd@vJ^0L#F1ScL#N01foDT@5hz->+RoaS zC(oLT2`^^6Dz_Zkg@*8otb9q1&~&e7WYNw&MObYAYKm> zy@$``OIs8Pd1j+2NZ$yDXyf^%F#>harlaD@r&|32)d^wZq*diiJqe(|{wW<|#96zE zhk+}dAt%jUBp!soqG#18H4Gh~6H3g~wt}WynrJ>8?=}1@jT+l71o@}*aCKX+FbVOT z3+0qL1zDO>31FW@NfL85>fLmTb+tE4gZiX)0gO9A!?I`wp`0QV#`szS20QD_H)9)E zssNnV8e@DqnJ|Du5=C{+v{9HiZeQnnA92@==}0kPKHb4`w!$t6cp=h*2@Dp&fXHY( z-At}_;ntK!gcuoSZgnIy5MD;MIubmIHwIl&mW8U37Vs0adqK6@D67v1`7QJ>9Ud0!*kmPzV1#>C<_ZC@5xn>>|)0NNRz46IZ*4I z#^-woXi;Q-K0+VQth>t%^S7PL$GNHYFh{H=g3a8pi=mCBFvrGTnvB=yCj*|2mQRy! z$tP4pduEvTBioO}sEJ2ocfi}h<=o|`Q%KsNA7J(4^XLJw*`VJHMujlJZb{boOrzG_ z7m}>!Xk@`5bTe$s$|%F<{a|V9TUI(_e~As>wdM2j{&EWFO`Hv;pD>XSK`dA>PElfA zOtiGjL_fY7xNvD4+I6XZ)Z&G3@{`o1I*X{339k%0>FYv<<#vPn-6$bp17FY}`oS<^ z1MoUtSgCPK^ZoN#aK7Xh?@LR$w*o-;{FR@fQ>8B-NPmfpb4sZVgWZBqP$wnU+tgk? zlJl^De^gVlaz`|gqds?D?|*o-otkNjpeLl;AIlNSE1LF&II} zPViH-FTOEIg=D7; zIisvI(ChRP`EwQKl;x;(QA0z~z&Yp4N(y`;-zhdO@toAM0mD-WPo#2j7-tVhhtg4l zJFj)=f%Od~!xwpie@O)Y&L(zoh=0n8n|JC4q=PxPBLVTq1@YaO-(n^%(@6jx8xXTy zXkU3?X&iJ+%OySKP&K5Az+vJyr>TtkdfcxMVcKin0r~mFsX;orUha#bm-x5HtK;nK z>~6*4_T>BeYrkP)zky8m`p#;aGsSI2$W@B1WD#OU-Le0aJ$!QG8h{pEu;ae+7teF{ zEbXvgFE00TQC(5L_Ut0SK)?71F#Y}~r6LPLZZ`v=0KH9yK+Hm_&H`XUp^rO_@NE$N zsbs08h&I)`mKc(XY)>`!%`z@cr4#$|_x%9m6mNKDM z5!7tK+4=WEDmR8NZ51t6;`-cN&DA<(LdERwN&3jH<$f$@PTa{D62M){4ab+y!^6#j z##Ntd62Yw~S>~Q6>hmX2bfR3wa~P*;rb+8dFRXCm+sX5U##O;^2KM0y(S(bkXj1G} z=MX@u#%BjU8r9};Q+BHoEurIBt{K+n>c($jVwz{{=&QEXVJzM5QOHe_`A`KzglTJo zUp)i&Ru)TX>->>gQ6F^8ZK1r(Q`1%NW_)}4_ABV{%ezMA9}LHh`GELO1=Yj9FdPr- zn&vk}IJGs#-EwUD8er8f4Y=rvpEHPnaM;@j1+4&-M-M0@7Xq*_-dL@5e2<5(<%>en z>p+4J&gBacbZ<6W=5-nP=swEZ($@8{vb z_mZOVjxh;FffjABB5jd=g`eew8c0`7^^=&|qAL^MRk()K7h>n7-)8Skq|!TR8IN2i ziQ}P^sS%i7WR8NrdLYyvl=tqRbl81UYUMJ#$?Ken<1t~5d%VzqKTv|~{ylTWzaJ9U z@zR$`aMaGdV;0HMNqbDIuBQOMO2Ivm4Oyr9#|3cRSEGW?gPylbZ}wGlg-kxUr-W~o z8$5a>_~7@sXpz_F71`oglwtzzd5gvxPbjA%RY)JHu4lgrR505=zwk{wx=z$6z9aT{ z^dhS{;Y}?V&%<)eA zW4gBUU+B*4+&|Yb2mirvYQ)l+UA{3K13q^Xcd^o_lCoTHy35W*EWy|*q=F?qp?J=3 z3}^0N7*6yzhC@}Ip(HB}Ple?hG?PrjNGF&U`GMP)OmxgbKEJDv*b)1nv=yTN5S1EW zV;FYf)c|G#F!+s;GSH;0iV|Zjgu(^)-p~(}uuw0FogH)2q~FJB+=( zR%We3kYTCdYYL{=P;=;>mMq*zl*r$^+Mv{)fZ4`Pu`NA`<+X7jJ#dLsSlDrCUPs`ClAP zx+yH`KOD})KOD{(#y5wv2;WyXr$O^?4rdO2tl)ofIH&*NaJ>1h{fk1rgiD&2!YUF* z5s~)?EZ3i6e_xU6MpmG9y?V{*F|G6Dj|T%pVUH5&cIqw5x#um3rB3Y&6UPr?S#&R1 z4~!)#!sCwFB5pV5eWPyJLui??- zVNm9uI&Bu7&=8TLmU{1kt-)XQw)4BFjGjMT`8ab?KmL=!+>p`JdhlvZ5x7qw>@*EU2CqbrVM)A9xiy-p41a(>HKYeDrx(-bDS!D#B8xR0AQZq}1NfWO*9r0!|y({8r)Du$66QdIp2$d*l z7qT772H~&$PfO3O2Vl{VmQMbfEUCRS8f1Z=)W};EqCjquLR-mrpPC8J$_dM)XW-Bz zcY*gCyQHImUtS4$<9B^*uMIX?Sw?O#434FAl{es?okPv{uaOj!+25a%NC3s8g#$Ed zN&sOBqTqXEt>kTo1g^jp^2xtB94_(ya5!fF=5QMR#o@?)b2ulTEX$imDj%ivz)MGU z8P&uvRo@&=3nC9@QV9v_UO|towMtM#q#bO&5_#~~36Xt+kY`l>@3kQd@vMp1>rE|N z^{nF?5r8-{rnuty4>|7;$HEgiu%!V!s!3$tLWc`7pce0bxHfoFG`5Sr3p#-Qx4e5` zFRBx|jHv>n&<)J#o$r()i7^0303UhxJQm3G0(;ZspdtDK^Z+THF{qMu=M*%(@%_s_ zReUoO@ypA5`^IT~fQeslc`()YWQB!%!Ltvr1#o;Ii6QqtUY(nELKWn(4?IwIxE_=% ziyiH_Sa&w-eUO)8N>L{{pSJ3_&(5gOE=q(@zT~D?U++2%M@^nluMa_PTK^x0eVZilaFNq5jXD2-I|grxNVK*h*t-XN?tDIbDDibXI)I8 zaldWhr7t~tcFvv<-N3CsTVPEZ`tQvp8qEqJNnH@1KR%<7KcD$RyA&J@^8Vp){Qkq? z9AcBjk}-v92J@y#p`kFpd(124CrAxU9nYbH;{E^@bSbydW5GG|MlAstmd(eFaT!0T zxO@UL#A(V=bAjcToou!1#yDB-WM;qF&3u?k80;uN(X7vdfJVBu%Hp7vKPMzGPHHq; zRh;-5m8O7JZ_r(sMd@GbW&jOT$-lCXr%5iQc5Q{YHMmskUCs)AHsM<`#+G5R7wqrh z$rj?Pa6hIgpEQ-a;ozAJtK(#s4^P@BkxW`A-BF(olZ=%s)u+W=)aYRrZN`nXE?o{q zDN#mhxH;sm5gb;c{XCIf%yGuzYo)|#ZBkDr>v~GHJ-WDAaDb;k+W60?=zmR$*uK}n zK^Xs2?ks5h-+0pzBQnF{c&|!9gf;Uya;QZ9j!x2EVVW6sU@d3T6`ZfP$?F|-Gp=@e z>^v^aqR{@G@u4^t6Jt6$;}7mPPk!$k?r%-z*taJ05H<>B7u?8}jOnJJr}?n>VJ3%1 z$h5hNK6~n}nL!_N#84#uuYRJLp?n!&mQb)5ONqkYjd$9uvF(h4GC8xl`|wQeFSp52 zIWjJ}I!xxCB4?I1y<7(;eDUw2DLfAHfltS!I=9rPj&dFEdVicz5px$U(UgAqL^g2l&8=vbFcjJm=HpM66{&Y zrN$vXL2TZ0rn8ri@K9HtgnbDfzbqw}mC1f|eLe@o%^tajUVTlo3D{A0w~&b0=20l_ zJ!@92D=bsmo1kG80sZX(Fkj>57038@_bL!fwCP!Z@WCipg8(m-dtJPrHz0FDcBPj{47x52t$VQ5Xe4C^~+8l!$eR z)j4>Vuw!-QTkUwsApO>ua>dv?!-Q9ZnDi^Mf9-72A~cGQP6iyEtZ-akxkWI!Fk@SI zP#q&gmZ~t|Z(G3uj*nlG??9OYvabk?Z@-dYJ_6+*8vUpux?m9EH1UEYK_z`2*7~R0 zLeu9u+w|2n+Wi)*3f~Pt6_+{myM3enQhwzu5~HdohG#6!bJs`7 zQs}E4k0e`sPJyI2Nlekmjggh@4|p9;KQL7?zh14FeF;4unhyF3yO9tULhj|ApHr)W zc3widM&v&%;Zmf@8I6mTd+rYh65##9_#2Ou5%J1y&J!2@PIv49P}i~}&BHbi)hMLM zr$R;s)nIkRx;qwH@J^Pe05)uk2kz*@Nii^z9!{n96 zk&SS@?efl=Yg^rqZX1FtW^Z}mT%&kHz;;j##7)mxgi((wQ1j%dYWa+;hc@(MHLe6W zk>d_5RM4>mIC4eCqX*C`BQCGm#wfQx&W*lz|%y{v%nXfi;` z9frWKRzUtv(U;nb_tl*JmM=-Fcs`eI@(CngzwN8S0c`5#&filvvHYn+kn?7AyZ?@2 z%BSD{ok@21G12ZWypS!dni@BB`CRdnvMzP4(c@sN?aW~dP)C_x*!{ELG-E&!*GCVx z+WKK&Tlcu?VQ;{eFn6191a1tHF<^n4Dlx1`^85{*L0#f+=!tBPnl+^_Xg2H39$*5n>Z z8pNKg>fN}WA_+_UFJRPz!v7|4U}66^%m~8%@4&K)|1T!mGBRa`O(fC_Vj|xvkyvcH zAf`E$70NWCDP%N}W~6-uu!V&{B~y_-AQc57CQlmHzr!oQ-_qdJa@T)8;{15s8l4qP zmj8o$tdWG%Viqx*a-TLnr(ryMsXG4ied2Z~Y|0nVLmd?VvJNVgaZ+*~skd4VppeVQ zHqCWvh_W-{Bd9Wv#IgZ~We_Hg7&*1()8!hmxQ`CF04!iz` zml7L84Z%fE$-7PDq4rWnrGZ0<_U-=Ry~(S_{T!9=O==XnjmAg(^{5HQRbz zo{nij++58ajt&U#hj1+^l;jc_K>7~k^3a;^$NKlWq(pGQASbQ1b!zvd@8u@12`V7E z(-OBH3HdGr;7Uxha3L0Zk23vHt0I>$V|dKPu(OYlh1m{DbI9def` z-e{+!LCR9;{w4yMIgg&n;6v4zDerM*l09fN0*;VG>I;BfaZy^lF^&HTV8k@XgOkvL z+%s7WK;}O4mmJJQPqv+2VIZ$}H5RHwwfS!17NaDF>T~V<0r1vURE1vaZBxOy$Q~2~ z#nBV?5jGpjN}hz)HiI3Lx8C-rtVbhm^9Lj2 z_?;#$7NPGnTg51YjJ2a^9FQ^;hh4^f&at~#GZ`@%bvzO%wkiswXPpZA0vog5L{N_% z5zxf~n_^G#SsSg*{YCa@goT+XPC%dCTsF3(PFCa(`vCv55PNHFK=ix(&$c#0D4p;9 zFPR!g+*apYpicW?+ zMLE}DUA;!_zY)#kKT?<}&KMIxr0Jz!htJP$`89B)LmkSH$aPK(fWQ zio99v)vZlt2;6=Px+{2?yQm(WDVzNW8g->9By@(#+4e%3znurH(b-mZq6QwD<-=ZhNE zMeTShtJdSo@_b%^5k*h^+xkW5f# z66tFf<=|1?hl01s6d^(2wj7XTuR7HWdA71hOJ7hWhJaHEZpAuDmF=DcBEN=u2#I_r zytV4W>p`wQ=Kt5oas~6?eoD<#q2MWx=h#Equdjo!9`*rNsK&##hJ|B_AMNF-Kjg=d z?DGg!2j}^d0pNPKdnk$$|2yi7PhaqhR)1K~55}-Z%{Cmx)g@`ZSR-B+uW>p`0?^Ys|*H2MonGa7j??fi660#K4U6CmCuJKXdv~0aJZXz>yPmx2la=D(5#O zM=Ja(`i7JzVG@9i!9>5UR|aB{b&dyWJ@n_30wV~?-!E=`{3Qua&GFXgKe}!02a9tNP zlmca=i`fI0(`{mLwr%NT_}W^mwb@fBSg#3pe1RCSb0Yq?>Yd}?QAeO0O#cxFHEPOz z&$|CnC0jZpvzaixW0a@k?+#oRC7lo@dP{NRWdzdxK`Tc|#`}7^H2y)lGcCVg^aFVL z@6c{1BrT>4sU-Q?#lRCUM|9!{@y$9X9QoPAev*q`lXGtK zZb3pp`bX>M#e-T4CLBz|fSxG;OSZiI%_us1l2;$xiy~;#WzH9$c6!*R>|I^6KZlyg z*a6dtJN+&FY>1@J@6j0XDC@Z^^DngPK%#dfLzv6Oy{)%zp{=*@qul0aW5U}C?+x$K z4{H4YCXE7LHtsq7bB8YcK=qmEIRE9pOC)Gj#DkFU-s6?(zxuFiKRtW_T>Kx^b=(+G zitpHx0u&-8IED`rM3w{ykJ2^t>U&OhqDohYjfuajDz9LxsZYfzE3dAW2>6ey@0dWC zWYr6c8C1a}Y2>(0IVQ%Rvex$WReyV_8&Ao=g57B@^{doMuG7Mg6M3*?LTc@+)>@Om z+6K#Svc7<>oYAE>)gBQ8H0ZSMDmIUbMbV}`8P@O=lCJ)SR^%ZlQ3}?m>jZ8Be88Zif}~@mXXdS2OJ|4BkJ^$rq`(vm*kpJkfDQbrg)kPx)G& zrW5eEJCk_4Pk&mX_C5-rvaBE5Bt!-=7U6;qW}n`=YrqOQt< zZb1`4lDnb;bve%fcsR6JB03kRCaral=-Vk3Atq6FTUn6TvfwahV@A?)*66!EmHeB0 zX^u}M36Je>QpS&k!*U(_M^Rkiz8u=5O=)uS+)~q0hiL5`BT*Rjt@ag72@7-!W{nBp z!^?lzHjIR+$&!BgUX9{T2Cg%XXS|f*Duzy!KKmD%mJ$925GEN%ad`OArsHy3A0&Jz zuef6kGW+7oiT?#@kXb6#yJgRaZ-mP@uAc@Yz{7WB%rGoaHJk4;yhb4I;W{5H=uc`YnCy3(#47zc5L<)g%6CYrR`~c@~ zGYr%e0bB+L$otFWsg+6p#G`fI;ywY}V{^C+bGj-A?A|BGpJC)+3eAx!|Lz|?tB^?$ z|MUEqV;h$60zaHWD8oZuYYW7ljNONZ`PxbqWnGBq=U~A1?*O;3?hltA8K^unTqwbtm1#@ zgEUfeos5HFN}V{h%<<(IomZqM2y*zcsd^=>(DVmXtZmw+{X$sw>stp%*sEieb*oAS zs=4AH88=MKHVqQN`#gWfr@-aVb0{pR3w-W3wAskds_wsh@W9}Jxy}#+EsIYQ$JGlo zMaWeFc7BJMO$~x#L8PL`h_%{I1kb_3=T&1nYS?Z5Da`5sO{c_0Hm5>3@5FSoc=+CO)fs2Y|# zOR+JMmIY}=kI&0$>?byG7?AG(M22&xx&R%{)6=)*b>^02dsbhCeDh|X9}Cp@XE*m5 zkaI>6=k~${b^aAdo_p96!k;0N;Xw8T2}<+PD{3B{w%4J4Zh$A6|C#o3O$YQeY%v83 zxGNqxU2IMVZ`@j| z#SrQ}q@qtCNLNhU+GW%NJSKMU7OPz?y7Pwtrds?Y zlS#(jttda!@>Ah&hB!Hu?;VRQ4>+e+RRR!1z`aDj6tR+wz7lG`fTgPEzo?{%6&UK& zpsytQ2|VBcQVi3im@sH{tM5#2>!cE7)lww%K zotf`%-yr~Nwid1XmNhsE$Ie6Eix2^%+#>@(T9~vC__pa=!H_q z5}uY&5(IgMrVKoIu|W3jz7L za!|}WT4@UC-g)B{_OnGv8XZ1=u4`9i(F3$-RQ!}yjxK~DtX$>={xP%SYsLB+qA9In z_P|(nSxp&Rx~gOB^3MIWs9J{YwjiKtjn${2k=2wi;%utI_>B$Q6*rI#h}0n|km`f| z3{NYL3IqVrVl*At%+IAzsmZQUZI2O^tf4yvBaDV2oo&=MJD!5J#_#8gV`AM|So&Pl zHNVA^K79@nqZ!T4Km#Cz)UShsQf&nEF91AK%V=y#Eo(F><@Tr z`yOKA9o(cqSvqwilm_cUTD^00khn`W*6ST{$iD#m$I+%$PgV2%*g@4y_dnqd(>8G4 zqv`YNhCoxAENx}^dR6mNu5LdM=8{k38je$Hk0no(W^E#b?IW}r^*!}|rYH*|!?8~f zsxJ%17tzw|Cd%Ird#gNt@0W{+qNZcKX;HI`qA(O>c~1-UC!!9Xq~peZq48#j|4p{N zVmbyy6SzvB@`R|Aw%}MR`IT@;md^e}JbE>8s0BemvTwVHplK@!+@`^SO5zmKiV)XLJ`U^T^erk`p7= z2ss+N`a<0CshX)R2>zteLn&2A3rUOl<)_8#l!KVU zA9u%To(iksrz!7?19JYT(>xdZ5h@Sx16qPUxZ#H;s|-<{?Lw|tgVDD1#(oLwF^9F) zZp^QF1PpB)7Z3T)%gppvPgCIWuMb=8I-g_I=l)$=s?e$oVp!rj?Fv%qp{e&1a9N&8 z|FSU0MXOplt+&b#fxUh>Vwy=WldarH#Ie*%Xt8RXPkc5ACmrdsWlO%v9=8Q7f?~Pj z)H_UIYB%sYBWAqeUC!XYbg%1BufS!$qT5fJ+a4crDc-c<8|$Av(vo^PMhF=6oa62) zoyH=&d#(}r4GoF(^a9+2G3*-)kJ~A~U24OXU+vmyFv^8~-q0u>TY$y@D|WW&T?sPD&*Yo(3e9tt78Fl4AEWW%p?1oQ6_j zF8TN3MgMubJUlBYu?PJS-vm!R1YCUFu2ns8mL+- zYup^dl+<4#9Gn>o08u^A_(wo%vjxa}Eg#Mx|)MvEi`-h=`BbI>`!;`wGg9eUKoz}G{S7)ja0x^4Ijm_d z_drG%6rtqh6z|wtx#UqRI}{oeR3J7;g3y(6p4`ArLTzaWr4vM>4yz8_D(jYf{;wr! zw}xY)u^6@-V#0E{&ApxE%7aFcYS))?X+2S1@<-%cTX!i8?3gJiq%Mb`sW8;8#HHRi zhyM1Y33KElz)2F3A{nG4ROWDvC_TH;Ce0jVRuXhC0|k`<7&`=RLzB5FCq_6Tsff7A zx!cT~^1;~~V;7AY)K7D3=_*Wz^H~*yQVY7;Y+Q!Htg|&nggeFvIn#K=(eg24O0079 zM!_Io?i@Rgk=cg%&_T(hs(mcYtdNA9Vr?vzA%@aTfYjo#s5#eqm+5<2L?l+G33G@p zY(JVOs3+N~r&?s!dgu5|y}Pi}yvp$Ky>ujOP>-*;hnd&*wf!~X<%0qb#Ax?A)u~KR z1Qmx28|Z@wPgS-F|KX&M?sH8VblGvTytCm6t@+S?*rhsk*o*^pFx^eI@blp&^KVUO z1j2+50LF<;umi`SVN`MTgul485c1V{GD)xR?N;R)^U*KLgPQqf$uDM^;ges6dL=?F z@FXb+(HO}<)*2lH!}|u%=S1_28#wK)yhWK7M!x`h#oX+A?IA!Qt8l%h&zBlwXJA$t zZ7puftS750%ZzmE=RA~ko9?vqQ(1&6X9tVB03td0TgktkE&3C>RgaVeTYs*9ZA2m1 zbUC9ykT&<(Tj)PE^n*(QQ$Aq!2|{&)a2Y^Ub{#hm5f25`I0u)d@*VX?z#4{@0GYtW z8`!+pNj`%C;Pxi8&03?N3{ADcl1cadaB@yqb8&viPjQ%K`t=+?Pv|toIOZ>0GF+J7 z0D4MlRv#z3CFci2?$UqXrE32TSz!6$pqjB^`lHfu&D*8PDF8F}U3*i3bzFgF5mum=g5h2Jc(BPP zjvi6?tN2R$ZT3kPq&x9gt5K&kZ(y;w6cB9i{)UuckY0ra#edJleYMGNL`UMyBQG6k zo?~>IML;fk97!YpLUVG&IJMl{1%?vhKLIaW!KzW~kZQ_Rz4tBN7!QJqJW)fw0BE7D ze5WX_dkAZL?_vq0WnwK0d79{o zw0MSyhHFoOo7b#;T?5N~O-O)pGX|ItNK*ao2~+9DSeE{fwR2C%In(nK&}en83l^4? z-4wpCQ=B<|S&6zZLn7ijVSi=`0MsLcw^`6w@?{hzx<{J+(rtnB~Ko|vkqV^VDqCK4AH(}hFR&Nc4T^Mqg-Ny{|wf5Pa^7L`=&>r=C zuS0&(Dy7i3%hyH~mb@Hr*88UtxO+ULejYckJCcohKK*SEu!!wHe`VR5;es#7=j>#I zf;;9^q?o8er`W{v_wV_(R`{&)^{y{|vX;ys_U~Xcl9Xsj*KIB! zv5;G?z+BIg@zea0#iL@ys7Ft(`3#uFX%y>9yqZw*)uYDgWWNIpk-`zi#OXv7#K7h( z%9NQ9n&Lp6Kjfl9u9DGVH76^|tuPCia^={kJluSL0q`6Hs#NrRw7>WR4kN$EHboJ? zYXnjE2vQv_vPh**;jmt@LZj13?Vfi3+JD{N?s9i{AU`rNtz4t_E427y!u;t6|E0>i zdQ$*F{mBWRgCMK#b2nlCwYPB4u5q-qLwgQ*-!WV6=KuQO?pWEOp?`So?#|weYX0Ki zy67IN2ORxax=LrqzS_C~a037@JEt2jZz9wuxgQtrM+TdI?l0b)CfL$+c9D)%^g4D9 zwVP`+{*1%zf+qO{eOgnRdV}3xd%4rkgDsSQ**X1Mp0Cep94@or3USTb9iaKIYgZD- zO0L^=8U(1Hn)n^8UJGHqFC(wAC)NBrByqCMS(>df*pm5g5L_3(`S;GA$kUTcRR7SmG9IlHmMXniSSnzpQTK zyKSoimM(y%V-iI5PTJ6m+q4@O_ox%vX?F{*PJfF<(_GW!91&N0Tbk63`8jZ8_#cU*<{3;E zYxuuw`aTs>YZyQaJ`lT!I-0P*hCOtNLA^3!vRx`Pv*@aum1up|QqVk5YF*-u}DTy3SwkMS$Jvia zFv)dga>1G>DUl`MQ9<7w`bYRQxjbYCGn!WUV9T@MX|P5WsNleSQ%m(CDkvpnZ04EZ zYS-~XM2{vqC-=+aG6V!Q6<=~9UI!5RaOPTcfRTv*yXm^kns%0G*(mh;>~`3;SU-bO zm0>Y6vawkoKR>5-L!a+ppf+%Q$Zkg?yNakjB`8{+p{k**M-!MyUN||UfzV?WDv_-E zAVk&ndLFnLc(GzK{3T(~4iU~omC_HG{PR*eO(Fo4A_R5_OnN-+XpztA=(HuoT&W=z zfZlK&T|yviED((R#WR{IGKK6hF;4|b=2~G4EA~m&OL6`jOx*z@Ofa)h5-V2NnzHPd zx$yEUwLN8CA4_mPCYquv?NkwTFc8PzP^8EfTS@{0jJ`z*XtCb$bwvSk=qN@Rxhaxh zVm@aXaac)o$|m(^5KH>6Km-0HEF4`EDRI!#ShYqlie$N~?+YYdAa{_AU8HHuw-(JTzz|FH# zxGAC5_eocmGt{U?>B`V35rTdaMbW4RbNdb`6a*@BJLmzrY9j02N*AM`QWZznaJ*2p zF$Mb~tT#KTXC|6+4Fyslj%XPshp=OqWfN09Bd2bW295n7EBHv5Fq#@|FPkX&q9klk zf5p9ULeD{Dfgg#6Qy~UFj4~4-V)_pwCmcLutFH4_i-y(lXzSGIM+R|{Zpy4zs$}S? z7`clp^yM;IvjvK=WgxP&8xLzQRCY>DN3Clb#eUiLIw@Fct?H|1QlU@!l-u_!Y{gF4 zQe7+!qe+e!o?88ureLV3wT<_DT`R}Xu%NKVp)=i|ME2X`B8#0fdC-ZXTx z)J9nwKWo(s#*Ej-fViurC2_xW4KII7!il+k#Gi>*16M=-{1&<#!Ej;iLV}Po$s9A` z^NidcY#(^>gF$R0(>qSUh^n2D|0eCI?|iT-9XKC-$Y}I@1kwRm24Oe74=|{?V%K0~ z1;0%&+3711TdiNz!FEDXI_24>xdpCMxdyHtGWYQjoFvj+fiRpI+bASb0LQH~RJjqJ9>O z(z^OvILB$-OH8YJk(`R_1hi(X-sBVue+l9Idx@?wc#UlyRO@)M=5(a4tV3!MmG~yZ z(BR;F7^Bs5D8*lHc#zJ&@4@f$Lt2&Ja_lqkT*7H5P{W*^mYb=4t~$HP3E|YTD+;O{ z#NP5Xj0yxZcE4yy4Y?Fl^wvouzkr(t|F-{^Vvd!aJ;_NL6_k^S@ZZMLlmtDQenzy= zt2dg-12FGjS6RB;>xW=sx?n~gN|wn&KT*y?zBU(4YlX^_bxDIcrtT8^x8X6XqCyxB zX{>tlS^E3|;FFlrWU{b&jbPa6CV$^t#RnIbM3r5 zBdJ4>#kC)1UQHj-`4y;u&#H)d$wAzc)bw>a((q0~Jc1?gbLsq*XjqnNg`PwgS8WS# zoyIjqU%keO3HNAFw&8pxYh`%s-w6T5$JUP0ntQ9I6DVm&;1j)akXdkG^dd?pM228JnBW2Zj9p)ny(DMRy)81Zu-@L@umKy>0AWf*3Qv7t ze-7L|IL5$yBYb^E%I&3LAii3h^C?SV(kviU3(i-DFs4!DJ@`j|;93YUTo93hI-(p& z%5hNt-w2G0v%tsg{qcZ+pPwL5K%ceC*M2q%F~&#<6LI~)@&1Gin^|GC(ad`E#d6!7H9AU3;NP7WjwYxm zjSB@7Ah-(z4b3D7*cQ0M^xpxzKF4X&6_LOYK4`Qr`@XiD)d=8jzmOp5_XxP0d^6Y;N-5O|pY7~6AOPuCF4LAr)8Tfw)er9e`R#*F;<0sYH7ej3kd-tEg8RN#E3pV^gGG&MiGa?d1AruwAxCP0(7~aCW|q@;EH%!# zIKP||-wS~N19SbLl}%f+J?dZHA3CdyX^3#b%mPt?!@=zxP*dMT&msyR-&LH@Mj*54080`@|Uh;>_FFn z$V!uKv1HRcir=g4)+K(~;*O;m$=Hm7StC};DxlKM-N>vkz#d@1obuZUZ$o{NP8<_EXl7>MZ?i_WrL&`C4RMFX6$^ZbX3hgAW) zSqK)F3*p2tUNLd^{c+=(CbrgOlo(OIkz+8$oE^kX>y5_hm*`JBgo8an$@;y4a%eRsGg(ThUP zuKH>D5K=8ybB8B8G7g)F?5<+wJr&fUd8=-bpKCYdhZORVSm^tEIDg!&hSxQcGcpYo zSW$~9S@XRt3L0XQ$|Y>6@bb}k<)q~IUK_IxUW8MgGbx<&>6}jzdwasJC?0Fdu`fvh z%8S1@8P8wbHrPjcO$;=Hht=Ej&bk_W%kiK1#y3bk=GJi*W=pB7$`7|*tq2C84=bQzs=2*mefy*L|}HYf4;{vQBfK%c+e zN3-$!DgHi9I6%UkE0n`-Sa}iRatJS)}TvGn{q|s(Us$?gU)MVg^#!!)2q!5m?V-v|5 zLP2|hu4vne<55d2RsDAj_x;me=8rUOb0sv^t8nKwli25S2{mm;fnBCR*7Tgy?J>HZ|3 zTRu|^H;1;kyE{A?0@_hz=cnJz^=`8mWvitfmh5J=CQjoX|KLhn%|zT*zoN4a(xJjN zat1wTRnK=gD5)L~p;>SAui4oOLJIu7XOjh@sgUmrs zMV>nq7``{9G}AXspXB-nte%`027*ODtCu10(z}i%eekQ82%k-1QZ&t#%6h6-Wa@v} z7R(kWev+xQ4c`niL)AZi@70#SlcLa5pLSa&Ew@f?|2vY zyVt#pRMO{)@pBDTokDN)qnvTL<;T^A6iQ`s(}W$F@iSqpx8}R9LG%Z+HV)6;NXO%M^bnc?5B| z2I;f!DMo%zX^xH@H~pg~Y^hY8KOD=h75Qgntth9DY|RFKe>pIpj}~#{Ryp!rT&cAi zd_MhL(FVdQnOcWrlz6}$#_;8ucJ#$vSADr#yFV)xXH5YqWgid%9}Q4yj}~uzam9U` z#YZkd^Z?IlfsJ72?0fUr+{S;jHL5+-_8mtvSKQ~LLmMhdM0(;{GrE;4Jp7e#(#nc0 zZ#J9B=e}St*%9t?)z|rn`enM1PGj~$nZ%9s3r|}d;}{YpvBNBJWjU(%MPA7FSthGQ z)me#k;~ne~lV{~LHo^p>fZZH_k-W&}uacMlyfg^1Kl zXG-zpEB$D%9=lQkqs=$8yReHd}(f#zUq9-JJgw=c4uy*7|LDM`?;G*u(gTwwFr(dQ$K+7AR#bnzMCm- z?!zrow~>gN`xlITMLOh?<1dfr;~^tQjpL}B^SD*9IXarfZ`*&gKO7%5<@08q5I)G~ zfA=0@>6_j^+Fo3cbB%hMC}Jeq*i#09V0)O-97lb#i@_NA#cLK5D-n8!=e z9oT*+Tz$$yw~d*Lz`M|dWk=2%s5ESP>3v;i*ANdRE!iRaN?4F@(+Db5x|Q@YE{#86 zy_RRK)okWqDORJb3Lz1y?Z{+)({ItEz;0LWhX%Vpcg26*kw^<&KnYJbeQ$bQ;0qnX>_m&eNt4@%!S zsSGnDA0_Y2y==?ACgpd%{j*85%3_dkALe0Oa(`yz^->fI-|l0nxB-vx8LdZ!D3==3 zUF}mEAD6;5Az}f7(Q|$WQ0?rC1JYit9E7UQp5cFeJkgM|CIdkv>bT>ulUsJevU7<5 zCb$C?K)B&vzUj+udgo7-NYAr$(Ri9(-XgGAZ1} zDLI9Lv~A=@&jtfA2->oW(Q7 zq8?F!}d_^qrV~tJFKsSi)5AsJ(v;O>uXxQRk~HJE>dD^xE^#pN5VhC6G6s zQBC1FN`>*&Fzr}KpLDIu4|Zfr^NlX*usGt5#?$snrEq~$Tx9rJ{At^PQN+9x3rZsB&CuI%==l%|42OIHkOH@lTt&5j>(>`SQ?wb3QH$dNpT>M<2v&bk7uP;$sb>N*?%JKXsr7Yf9tqA$mdLhmd&}1|<;ijT%SKb=r> zZu2adw38``b{qP{UoC%ycDT6rk$1>E!*Ujt5C^T<^13r4Cim3OmBZDQ!{+XG4K4mY z#IdFDdktl~3ch)U;^D~A57E5S$L_ZghBZ%84Zmc?;5#gr(F(gCU28mg!fcZIpi6yH z65sCUj1pB!H*%ZC@Gaq0k(+jcKbN13>`Zq)L5SPosuf(~%{YHu!*=e|18zRL%Lf+0 zCfAUM7+I#7IM+jAB874hHwNDPk#Wc4)|%b)<&~my-#a|3HTIkf{uNA=rEDFBthvHK zF7%R5>#^gyawUJ&jK`xrwWU2P%;bWTzBY5b;Zu(9953W|bM0=h;pmp&}(_C`#4DZ zy}5s`?)0Ll!n?%ya@|9lZ_?%rGB>HbZYM=hW?p}{SdqCNu6#R%IHuHsCQ-;>SxZKt zfX(DtG(hM^Gn#G(@6^<0?Ri*=+@wY9&l{I1Vht~2gFS+EG4j50HIaO)Ar2~dT@P)^ zIx+oBN*;BE2=1oy{*v^Iqifd3XLAKZ%sL^s+hK(Usaz5m3|PE;P&D|FurYZp#YXBRgWss+lg6W|{6f6z9Z4hJ%@ z4^LN4%58@npf?wH!+cQpY?j|uu)XoV5ZC`G6!<7V7_&VRBu2GgWVSL=Ue8}eRoq-v z{qllEBDUTX9h&`owtT>M{qt~NDxpb1oQi+gg@%XIiYY-KrPv#e#Hhz{TmiL-joqTT<8ljA8n(IwAUhZ@LLThq*o@iq8{)n(r;pH|OJDs{6T8n{0gK)VkOaB2&rR>Rs;D7q|-66mioH1 zLJuZwE{VX{RDTRIK<*-<;$~I+sZxJmLO#UR{JU#$QF$lsh(!%|*o&_$C3LwIv^}z> zr7zy;y_eKML0#UX-;s+_M#+h|^42#B(vagzT1HivO; zt$D&x3^xW2DD&IjCD0Z_8NC=DS>i?#SZ195yzPy0r#artV#`wNGsu%rS3rN!kN3G4 zP)MyDR&5IlBpEvlLa4e&2YnZ5Co+|pSn@{N}G!hOY`b?afl`3iHd28Xt$Y8$VyQtmjf;n~ENIP7;5 zUv9Qyi(;ahDzDlKT`D3= zdIQ)?8@?QWO`0Vs7#y;qoz{tUF2GH&q^7OsokNL9xY92DOufSyM5uq6VvQqE=tY0%c^Trt*%AQT_4?bF1^uuUwnc-0>@2YanjjX(EL7iB01jJJ$mlu+OuJ~ zvb7K1dY|*^!H5d!7>;v&u_c4GaPMBbi5N9tESvVCXw1Y2yY1)6Z%z+>N&)K})dqNE z+}Y)R4m(2L3FWwIpm%>~R7SQ#R%40vza4DbQx6lBx~F9Nw=9)uiQiJm(7sf`6ZWpn zbGu1c`C-`jEyr`iAFPuqI>$vv$t`p~ncl>ox=L6g)LRyFu5*z+WDj3cOO+pu3}}+E z$EWBg_4>hietV(D#A+8ZOJK7X3d4H(dEWQ6 zyZOQd%AQ*B)PaBfm42kn9HPeO6Suhc;i|aB3l++4Rc%&%LWWmSjyXI|irzMkC1zP8 zJyu&m54Yn$>fbh5Z7GyQy{d=@SM+ndrfQg*M6P*}lK6f9Y|^s$eFQlF@utI_)0}Ho zIexz5DKi}SFi?Nhd)FDU$511s9ebYs2u1%Sx$C~>^4qjg`@Sks!1X|9z+D+Lkp=&nWH}_ROF& zZqKj70kmxL??rzA8{%*Ec09G6d7ehkJCh~o->je5TC0CQ`(1?6sH~@f!sqqIHqq^9 z!+xS;Z)K;6&cCc+rx$7TB*|2RrHGyL_s!R$OYa|Y zGZNjbYb}30$^5kL5N-H^@p!-17(rd&(tip_Vqo+m^kTrFTnt`$$SFjl?PslbvoJP% z{bKcuPHl@&U=?O2GDRh)dkaOwds8sv9%Rt$(=+KQM$>tb$rkw`Q1rXksq7TphURTg z!t^gsCX?^->HGa?6N0oHxj@n?Ex9h1KFrOH()G%k8TCD2rdiIk=ii(+S3u!IWr8c8GdFSN#|HL3Qgu3ZKjsRd-vWrH&<1 zvC}H!w>rl0W(;Ab8;7HS7u>NxG|Kr%tJZ&|_Eq+^s3Vq7vzys=H7WsaJ1;udh=DJT*oq1i5B?4gyHP%G-&@l)eNW7$9ZOV=ZmqCoi zhv2ZEYu|w!cj<(USiu@Z!)IOeKgStMi;oIrZe(+Ga%Ev{3T19&Z(?c+F*G+hm!a7L z6_+}V0uBQ>IX0I-Is+61F*!FfIFm8jCzp$j0ttWH9dpIDJGO0hv|`)o*y-4II<{?F z9ox2V|Gw|+z0cV9+<(s9f4pP7v#RD(Pt{X%uCZQnVnr2tArm_zptzl_Gd(i{(|3Tp zg^iJmlboHcEWI+&%mwh*$PPzNF5(C@bhfaw6*Y7Qeg|j(O#q@mV*m>afSH?{8;%?x zVrPHv;b>uI?hK$(Q`VrSrKS5X%ReCiBai>^{N3qfVP*@U`1|4tw6?Ri0opqMh4{bT zr~(86oXvp%QwwV#Ktw@NOG;h>KqVos29N;S0v!#l0g5h0))vM9Sqo#JtrL(MU~1SV~U~Fe=V)0LDP7Hssgq#3|04IB(vBiJiZ9sQpp#48CI)FXU(Z<5b>F+zh!Ui91+Wm`=y`$aV2%EpYzhH`XPR>roju!ULfWKK4MaBQk z)7jk6`JdcQ7JuCUJJY|BCU(Xy|CIDE-(Q%&US~rKTPJ`s(B1i;Tt+~EiG`EBwV{8< z-`sz}>>VxsMZ?9(!q)7+7|;P6fo6t|Ce}bFr@t_NvH$7Lf7J>2->NsXx3~8A*KWIi zMg1oS3uh;wwJ8G}Gt1wc#?F6pn_1YxG5#|sQnsdc0A{9t+f7{T|HJ1Bbo^I?sQ#H5 z>c1omP3&x~Jpd*^Q#eL>JLkVC0aSngcPcad&x!m$Ao2f*!2cui{{IvAziafr9peAL z=lQ=wi@R7`%NyGK9e{sdFo3@|j2%E0@XsA%ZRq&_3OBT|u=e;rZ20ei8o+;({Qtm_ zayIOFD?bN^QYPKdoM{5gP;9q}5|J6(Y zJu?&2fAguDTNqo}{?mH)f4hLTCjXuMUy=Srol!)UO_P^h$|B6!ltG%)^dipuXMx?PmpD5Mw)XCR?g6bs7_xGGx$)jeM!A)VgAo5yKcYKux;*ggZJuShK8x{ zpRFE?r}iKF(liGnJ($*%-O0eqJbWKg>fU_R4T^S7+JgW_{Sw5qGmU>Jud4;wEeLH6 zCiR1z2_3$mKRr?o zj1CVCcHcnu?&HyB|AHmwF~sssIwekY_Aqd~uQ&dLe0Ak?+u>0PM5zF0I7@7a@)>a^ zy3!gHYV?8-8VU>G%x{0P#3oOhRr1Roa4u8H!DJaN%KJ&QB;H6p)z`puGYR-{^#I!d zOU_Qc-CXa8uD4|bNtX%JY{tj2eh|a&Ub^od$+lPuRk{G8UoRJ6XpyR>LFE9w1jS^J9PMghXxQmUnk{EcF6o zrA+KI{yMGf108IL0?^x=-Qg#vF1!fx;wlM9VNXxBVtXxt+mt(5H(km%leE0#i8YPUg zwXExw!u4>SUq^pl;*g?Q5=75?HG&CmqBgnlg~Vhq*TsTR_hrJmkbyA%>eb;m%L;A` z!OnpAnSNjKh}ynr3iAbDUjJDK?;B91=jqpRoSxOZm}{9!iOKMg$$^?U&MI2$aPMGv5*)cswd|+{S;y`U+HzNJ1$AE%_{PKZU{p z-)&>1aS7b}-ek*4ekCD2`vc#a6*-iqkl!*Arb<@$=26=ukd9h<3Hvaxw0gPV?JxvZ(T@|fJ=|~ztcf=pJOO0Oe!+JxP?S20zi~Czk&;fEfi;hDqQ)W~o>=r= z?C&hS^0!CUnK%+aAsq4ck4iEOl;zq2HjwmIn<#T(a|^jVyU7XT0K?Bs1{g9a=Yx3zi598#P7SR?N#mK9RxNFh7g^17_rnGb7l75_bS!k#Kc-NqkjZ0H|QQ zRH!|1R4u< zp7GT65n!SBn((sbl(R+TOG6Nh0z6!{vRGOXQU*+%Qgy$4Rm!$ZKAqUe&Z2(}-V~Az zdg4HmxU=rL?j>H39424sWkmAOh?0i1^RgL$@+tV3!gbW`Pezyih^BsN=AD1ukwU|) zi|%U7@1yPCQu{9g-KdoB0yE^12y{PtN2Y9t+TU8!Sr=P>XNkiWTwEvHNc$-&w>mDa za8!a3W4N0Yz%pjM%OIA|*n58yrg*DB>IJ)JP_8{Dh8$Kod(K8`3b6i!yinkLshTO! z@o&J#l-yiCV!0KdxItP~JZe2mdumGKsujEsStt@|YKe7Db z;B)c_H4q{E?ey?)b5)ZwCo2Qd;jnp+Ju^=7eXfy^{O6Z7#8q%$1~ zb>S9YgHaOEAwefw9KI>4z25bvs|VA*2ymV`lbEf+nB?gU(>|JZcMMz=u5l(6(yQ*P zk2@>JtfY_&KRyt@z+=h(0;N}N7K~P_3`y#smCQa#!r`0~5-c;A87-B)VAogtp`))2 zZD8K7b>-CAnbvhGg-n0ES|*?G5Ou_C^K5YsL@`84PMY17qWlgFFH;#xe>Ehs>{6s7 za{~c7x2AsvJEy5+`1HncAPM|kPB(ZpRw^5}1i^r)GnF}S8zJ5-jce?3e>@5)v!qUAQvk|v!?zj62(x6D1d7ppy$Ehz&ti}&iYW~D#uO}F1ae5mIcV^7DQCVjN#35+kKE}Mk#3JsM zG@c}Q8cXO@>-hvFS#gD4_OCO2`Z9y0TL>>6zwn5Y4R&R&_*t`O#_+1{OF#Y>zQ(7@)t}&si`enNV`ohe-?%t}zrU$59dPoN{nIcNA*vC-mX_ASOmjJ2KnqPaB!9l# zBOkIq{4{@e$Bkn`k9g!Qsynd^bEd3?0ESLj_}VEEkZRI4x(}o=6nYPYvVHy<3Yk_6L7(D{(h=aiL#)m}p!VjiX4qVCa6o z9AXYCgZNaJ&7_7*-*N7Jz8F&Bd^mKcCKr1_*o@qG9~!h07tw#F5k7YdBSoJz!oSj}aL55L)gAnNM+^DvyP^kbbx+xGa@&-T2= zF{)hesKh}JdEMuXCXVEzIEw;re9(LN7vmViCy zPyN%wAj8EFJ{?giYY3Bm1Guxq34va<`LBPi=YawA2}(yEZk5Y4)f`g_O9HHkEO#Y9 zwm9{Cd;lUU49mnw;5}T}_ubZch3V(iDX*#CNAH`lmryXgjY`w`J&y512<=LO#h_aZ zR~0e(m8|BChZ;0dg=7DCyz;bY{@tFo<;-ammq{A)7Ld4tdp^-8BdO>!iTYI-DDHpM zQP(4ac=Rq9$R~FYk@OOvM3mCAcJa)H(3Pv37N<^fd2IEBXi=~0#>15(lzjNqv3JC9 zl)|81mTA}^Qzb-%0cXBJfrL2&SVQGm@MiEzt}kYpqkIlm=Y2jX`}Hud)Z~a9k%i}w zA*&}l3v zN`U5q@)0wqTre)|NYC<(Pcm6-wf}1f3$uBQCBY_jtQrz+K~{#Ebpt>jzTRm=y#hvS z8T(}~>CDRsd2+9k$xZxtdS&+QkQFTeqCFgj(y&Id-P4vJ96jXbMUsts4VHhazcL-` zKHt2qpboYYwqBFvGm~}f3;MKqYBHlDS=h1yZGzg}=!U!mDb5NMH19>(O6f#OAvbvG zgwqV;9Uw`Jw50N+uxdkNBFv%lZumP989S)}hR*zf3QEmxbzfapW@Y#2BQr-aS6d%} z;c~75gu|rD71vJWJP$=nX%>HSNlm4DmQw>_qm$AoV-EM(vUzVQWE#JHB%Q$Tv`V>y z;6fMI0B`PdMXsN$iiCg{S0J9)@alxNYbm+JFJJ2E-Bnwjs9()WvRmb1D$xq|TcN#@ zHZ2c>^uptT#x%qJ@}S|;6#wAixp~%=7RH~JZPa>EvL#7BnTrVvby$B2YynfiDLZlM zRL>Lhh79*7B0mbLR^6sG#|FGU0+~ZrU{|X| zll1yXX}(O~ebp>(H{D}|I5L<_Jj}?Bf({gXvgho1&gOaDdEevND&z#oJ@kx+$ z{3{*lmdLFA$XHf#<((Ckxv=4ht#%Ni%?$B&d?>mpNJgW)4mjLjzK8jB?px(E8%uhX zDN+4Q)oecU_D+Aq&D0EYa>SRNWAW}FvGfcjQ*5AKNc|wgNex!(gCHmb=_2qhH+9bS zm>w%Pd8vNt{t082@}v-IK$VYzvkCVgl#<=dqlj;5W$ZA$Mg9v{=a!8pNg_hgMv;RO zLd=v9UOTr!^voTi+j1`+GohrGZbpA9*nTd(K=({;cus#~Ft7k5Nh7L=K5yVQ(1j9B zEC3;z)^x`&3r~%LG(5lS#iflDB_+|2Z^e>z;7?R%$$ehPYHI)LVXG< zMJ?Dyt)zc$S?PVmdxiIspMD;pg`HDu#VWB)tvnGw6NqUYJ)(l`U8Qh5y14Lz=VT%_8 z{jqNr8){^3UacZd?kVkQq5qDYFKW~8mq@>K(!^E-g>3kA*}Qu zL4m?N5NP*#BHng7`(_7JEgX5g(t_*pm2Q&ZfP0B5BZWwn2*Z&$KdVZ7<*=5MBv#FB z+gzLjtWE-=RwjeT5fuXDLUs}iZ7of`#iDKgFEV%fEqDtz0+`z z{C8ocaQ)*r<#Jzl>HBkWzZmg~C(dfVhWJchN^v9ePIaC=^@Mvv_e%J>cKU4c=klVk|NE~PFGxBpQ?~;%b zd4QisObQfH9D}1&HOgot@)q|wpq8uyG(1a1-PyodDG73I;JHE)+z4p(L_N_^Dj*Re zhe_sauR6hRCg$IA9B#w@$G7ug(3*c1{IRWOu|kgQXSmS8#LHXMaN+bG$=T(OK5J5q zQ7h}2+U-zTW5w!GjOv`J=OzkJ1shxjTGYEtZREYzO?tEwB(yvK<4r=C>ILHyzcO{^ zly&~zytq#O1IkFguuWH}fQD}2R7uFcqYoZ%QSYH5#)$j_oD+&*X6x4ss9k>=J5y|s ziBCn{29_e?B3(CZbmZ(?`E5=>xf;1(d#3!NHx#h+~niu&znx~b!8 zY1AKx`VrrhkxM%3hEez0+hBi!sYnCfuvK@NJ=+aeZv&vs2pnxv%zR9n0*7@$NSg`7 z>=e1(qqaU{ReI1gzhzkY*Biutqt6T#uu}~C^DD6RI}uGdy20Iir%0Y|^XULHr~b0m z?Q!wCeruB!7miy!8{^(Nb8V*smC!tZzqb1TTp>)To+^sWw%~QUR!V>1b~5}PcuRhz zy54q@Zx22z!aKmTd+y%EgViq<;CBy(Nwn%WU{yb!^u^Ts@Euz0P#&5ys%IuHh6nckoXnqo5h@(r-Jd@oN@j^X+%nrJG1j{sQ zW$Kp$Fi=L#M7rMD5#yP`+R!EY1PZ;Wm1a&ojq2sq)TCTyePVy$&?rx$Kx;Lr!{WC) zpV?xGaq2lKMUyZ*%_V=ycBUL8kZ(C%zto-ES%+;VNzHMjgxng`vsKMP5FglYgb-$qPOQB7)q#mQ887Bm;>5+y7fegqFF*o7U7H+Uw4zBuw%%e%u@{>byQdJSY!o9w`dmx0k3+C3;V=n+ta0f~X-M4<7QuW1YlN^u^DFHU3a${r$V;CpZ|x zJ&LlM%Qn*Ab~7=L`F_fM#_OG3RlndQIp7l?ITC-^a%5ne8pMJDpkXq)#nz(apA26Xev_WHJxW zAmM)(ta@!tMk++=b(?mu0oRb-?LLosxMuF|vw9wzuN24k{nwr#C`QrG?_+GNh|D1zhK86g)T6c)pp&aspxJ*e zLGTq=?u54>T8qIC<824x(ln9dG5T$DI`e+uI@sQ0g?a95Mn>o|6cr2E&eKq_;xfKc zDg*;6+$zkYEgQ=AC6sCiR+~b}*u{Nxf2z%Q3x63aW*AEg&YfSP3?x=kt8GN$vQO9L zjMb4ieawFCNg6SlSrf{jLsVNYQSX0YfmZ2FP(Ar)t!=-ejDe$rd(DgDSfD$lT6kEA zPr+3U(yV@8g|IoW){? zv(Zi@rf$@xJmTDvVQ0#*+dYtlYJmCNHS!ZE1~hxa?#w34G#D=TM zZSHuFqmX1rC5#pG*?>CZXAW;A5uK;vd zeVRc3v|suaL&{PQS7$<{E=O)Agg>#j&Qj&y_spxsaWTJLwW2Oj;y|zChZ~bn?wgh6 z)K;(f;tYI~v^)Dn+ebFL7iE8owgnF#eW@2SPkMpA)U-+2gxMf^UMW0#N6>0tA`-1N|&y%)2jWT3mc*b^>FnvwyISQ{vF(xLfB{PK>Ni1IaN7R!I9(OoZaoeo#n z&`NtXk1Ymlgzyyg{=k@@i+q{o&4?&MAS*aRGrW- z_#6|ed?)oEEnVw>wD(;-(klyA=zppbsVp$M9M_|0>nSxA9Kc(vf@g(rpfX1#fjPZG}?bU^I$Ee5@%oB?Y?X* z@_lQ1dbxY(M^x`<=Mki(pOwg3pVJ!N&d?>|Z!T48xnf3*=bjnU@p*^B+%JqF^nUYF^CZ6r0r~`{in%`M(wFqNtfpkzf&q z>u3q(iXuH1?>B!owYf7)Qj_5~+keQ8L(XdpY{~IV%c`Trm9w`=ON7F0xm)KE3p+#zD-pxxFo=hJoD4JNXzXufdV1tc*lPNGwu>K*2 z;&@_xeL#CmFlovR>fvF)xam;@*utZ6W727MSfhA92)%!OZr;I7!aS@HxQ<|^-3%l0f=!$Q z<}<17e%Q5N-bG(3=60A+vQD6Bv+WU)a@UE?FqXl)H3IRw|B zd{3eJSn|kb9r`w>X7~zo`MDgP^-n?L~T+yk>l301n1~>Ki9vp`4s)l&6 z5T69_O%mf_onBlon+^EfM)l6|4OW|*68Q&rq-GhejGwBnY@u=R8FVf-aD>C`HqJ@L zCp3TC9-CuX(Y~)|guA1EF3@}mM{(}3mccFCZSS5C%S!G_{{F>;O`<|3Fik}o|1Hx9 zUv>oj5ettWj;%uO;1tsVHE8h+O@Ur&^ILxtZy^d}HnF+H&*@Hilj`l)DG0^{Ra*jk zQ39%oVUieiS&L)j5rp0yx63&jm!H1OK(6TLi;c#-5|jkn^A3{|y{j+b2Io3p+R$L4B3etVzRrVKy7?)reVy9-BaHyH>hMfUjr9C(l1ClzY5X}QU9&RP2i4@vJrd`|MGYCk zo0V9&48D04r|wNvoJ9{f+}r@>zyW`5L1Tp5zMYBQ;d5(I%gmLqK2fT}kJW+`SBOWT z#E;(w8|Il942H^3311fVaKG22Vhw)rBN!+{gP~2MPOPWImfe3T$$dLT_5CiRe9Kb9PBt5-yNx=--a0Wv;ZE+%EA$ig?Fg8m*5=6&S&*VBfgKhJ`gL~# z6&4P9-QT;fk|`BvI0pEiEc+h;m0R#Su(39Cd9Q4m^L|lt$4ZH=f!ivBpTu-WuKQzI zB4ZRd*Ue|N*QRqJD(ipohTlH3@!j!xyG*o^Y1w(X>3p1_C`L4d6<8VE(Zc(JIv;1l zvCJ0EPmr|y$8&P-t-a(NN%QqRf0OD5rL7c>NMPfF3nTIn6NeUTcG9yMH<+J>bA-t% zKfav4H#D(NWQA!G*pTIQYnqKnP>P+e5UQb!w~;wLgk&^8c5#1Iq$H%?+Rd6H)Q9Jl zwu?l?`pTi`InqPl-nmU(WPi~3QK0?|MdaaXW=3bJs=Q+fOEiP}^-?ZE4Nv{ERZrV6 zjGW+1BpJK`12cl??L?o*D@cixTSxS2>Q!rYEmnbqmS3|80LF)HKk>y|5OyqxEw?Ji zUl>$cu^5L8 z$pV>7)t_TI8cIw1nttc^R@p$DYrNaTLTDgG6Wvyz)>^9aOM)5re%+GpCz|#Gd38(S zIqOKqHf}-nF)Nelj(iAttG+~?Vk92Q8WBW_ITSsSwmyHUSd46+;yTpSKzV?`T&a;JYiWpC`r8nV&h(lJPrBXMskCys;An_=*l9_24c{0R5ITU#V%?D`4LZJm89u6{vn~dW2ig)B=L)vtQcqzi{tmE<9bvIaZ6iQ=E{;K@p zWXtT!qPYu*_#-%hwd{-bu)c#Uy3uD2{&GCVW+O=H8C;wkH?kD)8dNg_2O*CSy69ZVv2qSc^m3W0ubx;gv5j-MBOr$)|FR1VCMgCyVFTQvmwTd^d@fbskLg3eto3dVaBnT!%osfvD`sXwRD@W=o8vOp0$zG0Z=2J2 zx^py=T;TaB*&0<{8ZL|vdIY|{hdqA=#p&`Wq9E(JM7&p|=fguOWpk7R3GMInQeitn zXuKS{=zHThl)!I&Ystu1*+8u5dqJ@c1X=W4gc~t*7}?^mNS4w()_=@p_rhhkDAsWw zrzACag-@6HZ;l)|I;YY1dI(7D_x2Jla$UdOZ*4JDa|F`XsfKdt4rB+-SK@zF__o5w zJ+WM$ctX}MzEg>M^^i4oQM=MZT*6<`!%U+F29(jtgh~DEJ8^9Nfst+}S{>$m71QqY zr1^{5%=`{itr{gHnsG3m(CMp{X=C*pVm^EkN7x>@*Tqe!GtqCRta@!WtNVeL7Pm)N zG%PW37H4U|c_-p{)ABV_xaI|P zuZFrW6aGy{4*cCh^346Eusfnuj>7|2GN4RxDGw*lHlV77vh4)|G8a&@`}o^7#-eCn zI-Ss?;r&GJTE$UP>*PtQsoVa4%gX|^4^OcC&HGS|sz7||?sIe9c4PwGX1kO0I&9eY z6MS4!+Kw0o?HXbqUc%c@tWqi|R@~kCb*(q`!hBUY*v$ItQ8tGn+SslM=Qiy0zGe9^ zPo9)9&&1BJbs5@z{JRf$DKdDgDD5Z+QW=qe)$gNPlyB45T~V&21ps1$D7!17X1c=;ZOMe960m#dq>weIB4)1TyBPm5R@iJ} zB5zeeezwc-^nU-`reMM!`XzO!gYeU5{V^At)jguh#Y2!^Izo=lT$&(n+^BrvoI6A8NEH7-6>lpHBII#0pu?{-ve1wL_Cc zzmLu2N=g<@_gB_gb}=;04@?6Vw+kUY_~&z=HD7Z=<(bbp5ga~CfCPS=O}PQHk8SZ~ zsg;QW=ki(%M$nOvDLUfhi&iCm(w%8tEYFFd9E)z3oWvIn+tE3h9uyEeKM`y2K}jor zP7Q4rH0De%P5dN($vY^1m8x*76#f1^`4NCKWiW|CJ&+YaFf_-jbdIHT_iC+)*`9d* z9VGo_(~mLc_N&vLn_x@xlFt)_tS4AOkVr@Hi_2k=r zxaOTKLo%D@stL6u8Ak(L!x9lj>(oPqVftb;nmH#o40LhfTx8oDwPw1u8u~f|WR3_r zCAr58sa|J)@hpU*XE4+(Q?E#}b(yubQ&@?PresU7Ky)9nwN+Bj*lHJzZEM~pu{eod z`Ig&75eEiaz%^rk30a12Kv!T7V=`UI`#8tBTj?ANl%cE2Ri*0M zjVW7p1mOGv+1I6Nd7?|GM^|MO>;3IW&EwjX_`^4Udq`wB4*cHZnq>~C$&WXkIUL}b z#Pqqfu-kceENRdAnr=4qbaS#}9VM_HICr~5KP_M|ywZ1EXi~GsZdmwg%=lqex!d}R zE_oqLaHd~m(tSqP^W!S=G1|}+Ky&se{MF{Bp{S$cLUXB_Z7@>8v3~GlM-x@qp4S^? z*lg#2T8+?_;ZK1w`}-srkI-H!9i@?-K>bR2F*M*3%a>cLYcI+J7ZuG3^PbnM%#QZd z5}M%btIQfgyF6&@P9QdcY`p&~^%l4FW(Y?~qm;HN7mva=RW0ov<>s!+zP>yn!d6}) zB~`lIr+$)@YRsWqu9*sFa#(#@)YOHf`D6Tl9nN795UukV#`uDKlzy)HqiE1Tm^R9H ziS)PaFIL@5^T?*frt!(7hKZ1uu4k4w(_oJ`18ik{_Bdv8iTi2oxp(mE^K(YCLvUq( z;SQH4kbMhXdgU@>W;>U6D?kM96eFoBx6OaQyCWkVNa(nqnyr#T%c?GTrf`ZV6BgCz z!!&$-~{xl?R8Qw;i1%wtO=LM8hCKnGhT4C@MgILtKJx z!0d_WK3jb5FzNeUl{MPywc4C-{-C?~8no1)oZ1fhj;IFi8(ATa(!b~!tlsjVPUb^r zr6?42t!>)|vi=(`(1*?Q1ZV!WS=3j?=!M(fvtx&XTFO@JLMtD)e~MsX7Yb_+>0E)j z6Y24-n8)Fil2O$M?D}!0Ov!_Pb{gdfqSB=Y`M2R*}re zVb8(hpJEEOtc#y<&A>ncWidqQvzmm2P?LB5a2t^T|_Tqdf0utclE&Y-{2? zC%eQXK@9_@41f=APUktw&+=9R)d~M(O*9O(RHmCo+-{6r|E_dY+{-h6OVOv;B!@`_ z9ViY)+YAm;2kc~yCuWM&5l02|{`M_1MdnV{Bl&r^HvY};7T#ehFJ8#Os6 zz9|Q*5zKPpJ&%Sl21gSyKwv^+T$>tCl$6*Oi?r5QsVw`%KA>TpkzwuY_Ny3b@#NF? z`Z{fbQVT)9wf>piB?wpz$!N!AuG!FeFur|&+FRo@%SWj_$Snnb+hjYa!qGGKvF(?q zKRy?gc*;-y$|akLQ5*ve@{PknEK942y1YrP{p9+NTwem&bvqNKb&6=hqTnx=Axn|p z9*8Ramhxo2(*?4o?G#sSp5>ai@7;gQYzp>9QB3j)UvX@J9*kM$kXy(-`Y^8!gsuJ( z^)Qw}FYm1lO5sj_dFWuhe?W?dD&1Krn@3;VR7AK9rds_HKyFN$LI z$)j@|=$i}A1X}zv;JuK*H0jQ)^sexSu$LAt>7Ot~>3XDOIFTG?-H&*`VAby)X6KJ+ zB%7XDt#4Xsw|?ie&E4@&Yf1`#uUvA~T_ugBI@CRwVcRO8?X@+668oavQV$pJe))FH_Y=OHrBNh-q0d zi;26DlpOJYyifKF>OYp9hD1BIvQ4`Y$EopwoTuik znhK*0g}~Q-lyQ}o?G$g!d6MFZcRh3lp!Lb-h5acApy7msqEJ)4Po;+}o9vj}lU&2% z@bKEg0Ph6me6s_jEK;`#p|t8MfL5Y`$E$5ZC>)mr7d+a%ssi-wmPCy+LCH9x#{ezk${<^PTshNXS1FAP{Q8Z?903M6BrQ(*FCB3Y*yTvdd6uEg zenvVB+<1)yYpvNgzhrO!LPR`l+mPXe7w^7$1T;%&>DI4zG|-_q!r`Sv>oSdwm62u~ z?rr40-Am)#38?|=xnH}TNDsBo9X9&X&z>U7iPGP{tfAP z;Qbs9E$~ZAuiA00@6!gn{|$UeIUYR7dN$tZF%f%Ez07e%nNM!|bMc_T;1MYhI630&*TFw0^KfMy@ge8NVI zR{5q*j04w4`?vfj4Kv&2IAjr7@Z7|v;`Lw?q*E>_o&I^cS|vU1=6qm{kiYC(x1nT{_$s4`YW1f-OQi;7a`IF zaN=Se1qr;kFce!|8&s2pmtOEDZ-7&=lBl!y!jdt6r<_+OTn*1)`w8?GjeT}4V28sP zNvPn^mkN;)RjXOOCf#f1RB7!2^@f@YINf@g9k(X4=ev1KE}kO^RbgkZH}89Y*mK$D z?3hOwME@2kLD69E=72`Imwm@=~P&q0o`+SsM+;HP%Ym+*E>Cu$$E*6wD*p^N#wx zw3?j@+gm;A2%O3omC}Fk7VS%Jcw(wcB17Uqx1&8RA#vAwnQ)nugQAkP5?DW~+R8^g z9Qu#olSPd28!8*<8>0-83DU70F~8GrwM>d2-3f_Efe0?r(D;Nd*|eN@uqIPscd;UWdXmx=zo(m{-BbGIh6y4Q93aMy>%G@)LsLWH+s^Z6LP{w~ zx9#|Rdj{!;%L9IqH*lu8$+l_M>I&YJD*#ucyXbBv^e17c{E&xtY*eE+n|yqTB0U>{D)kzYo-LPp6s1MLeQc)?zs1W9X>l%WxI+$_DD}@jd(l}1Y%4o2vo3t=wLYE<_<7&HZs^Zuy#!C+Z>steo|E< z%+S=+=M>Djc^?ed58k?C^n44VLhMQ->u9i=ifDGqV}WK5d{B2pA|T4jP5LAlTdCV0 z)DJJGk2(Q=X;?;l{}CQgylQxK^3Wwh64?t-9cf6N5zR)MkBLD6In!^pAmGvV(%Qq< z^!zcV0bqiNCGR%0*GW{KWiO?OZk*E{i@5yjdRuv%XqpI6c^ME1d$X77Zudggjo7_@ z+;+;}sS3j3TwJk#&M0JZ#KMO zXnpd3lSmAWNb1qv(kL6l&*cX09rdxrPJfhH;#Sd*5eJp(gvb!49fOG=hOeTPV1EXQ zUJsQgud0Tic<7%V`0&gL`cLJT^{ReD_aL1lh_9DtNqA6rt+?J0#so{Lq<@;4+Ta5-Fs zeurb^pg8|wEA%;sX{?fn#As}*UpZ;MrzLx8h(D=sJnSdZGz;;I4}fJ)wAG$0(3z-@ zWH+-uK)~n6jLZS_fxN58u^HOgumoMavenQrBSe2(t&?8n+Fm@cS@VFVs?l;py*LGb zpR%I(1i5WLh4yaP3~UvvA;~|%tMvb)Q_eNFLo(jeQDqZVr|s|R9#z8zGAcb_vXtpL zUL6u~VR&m%X4u;c5!UQu)&Om=KC0u54F8lOdTIeU)JGuc?y`$%oN&2{u@R^0%)s67 z&rlk1Z&7b~d9s0R1qm<{nWeSm!h0=$TGN>HSBvQ*Vx7y)s50w_&DmH(&(In4ig4jW zAkkM3@HLb6G9O1n5~!GlccRK}_U8>B*@gT9bL4r9&(}ar z!dw_`$-YosKA7mI8oI+6^6jbPXn$bEA(?%fm**$fyMjQ(QSw*Tl!f!|Aueb_B=A`5 zX^`ITv`Eb99OwC2XW3oIB(t!8l!#?RHP*0`2*pk~*m&k$REY+oquh9fsLb^#uonZ6 z*w2KsoYW}y31krr6$)#$`M&&vn?CTYib-mAuJ*u<9EXVblqAr2G+2=f2XjXA`3f~X ziq4*!dSj#tVzyi8&Guo&>e00kGVQylEq!)FgK!q&g?C66m|>?;vY4uW>8j4>sIIbA zBOFfGc7ov3rDc20H=R03Br{sW_`Q7GEAb&${Afikw5OG2R+bf{yrYGDQ09qQk0Xfo zo;JmzB=IB}j^2DS4Dji(j57T;t5}|`dnAV3M(2#~?}e$l2)gmV47C~9^`lm95ZE7v z0{JU0;{u7e!@|g(imE1m2YWg=l|DF&VUTRV^9U`cEH#WY+aOXxNRmJigF)|wg#}#} zM0HDq!UTejQlQZviiePwE~fZMb=M_p(-23M%5k2>j=}FR+R#Ukey-SpE>DfT;8m7b z7OQ>5rNLMPA{s6NdR6X%+gRmfd*%rD%TQT3AOd*4DJUTDK??AH6sGp5CxC?6>h|M$ z4bw8%*}R(ZySPGXJ}k|&tJIF@T+yzI4RW9N7-NKYhYYw+*91AR7E=<)MkBf>A58xk zGfn_wb?zHH0GGY!V-2aLm=xgV$y2roWdf`pUmRT=VBDkQ@?g%sh7WsmGD2}!9-xwb zC{7Xvb2&fMpkBd$G9%gDz@Sn^uw*#Pm(o$7p~)}6@izkpq@k!*!)&yV;tb+4KO8p~Nk zk*Bgo2^SH6AaZ@|HSNsuhN*uT20QIyA9W2k_KcM*XM-dU;o;CdAy4SSsAfgGgR0@z zz!8r0&|!IYAH6viW+9%3X`V58G|5j`hGx-{fBT$?u;bL}J5c|FyoV>__SnA8PXGS| z2MqZ0-EPKz(@N*jp+y)Bl+Q54k|9K&H#5n1PAU7o090y}L#m*DZ|!E11d!x#9fVE7 zCt$3-KN1{`C>_5=h(1=ylrK!_>O+axI*xMv!(Ztp8)w$|Fjdf}Hh`)RXb@2#HSLre zXUA{J1U)tu?qQ^l3mv6{d@*j0km8*GjpC_vN~;flkpHpzQ6#eK;@3Z>toXD7H+0w$ zs4Ic3ui>s-$(){O*sI(k8)%oPcPhT`WMWk|C>JbYoXb;1;6ZPg4Fepg{dnTeSU=Y~ z1zy-+W)T*)jDS-wF|)E-<@b23axLFzc}19^8Cfmq=J(QRAKYwA&KKTXUi}5~czNW& zv>fGsgwcTD(rYwXq3Gl0nBeQ0p_)IGxLLZ+{D2OP#DVdpPG-{*=f|C~^}}w#FL*<| zxoqZiXzdpGWww%1AzG(ht*9b`wz7a{&2|87TneABW))&P(LR|TtmlrrCeymuB(fD4 z$hLv>brzjFhUvP7s!j>5bk@-T^rc^m5u;RpggHJMIRk36Rq>q}VP*>crBl*wcQw`V zU=nVSWdT;D5F_|9JmVo)w+)$cF`kdf4X zihEUF#3Cpas6h3hV)YxKI4Bi^Q5SGU=iTBqPh*m}j+@y*3TmO*VmHbT7vA7{NydSnP!JE9ltT^v|E&q!`Jlr>>0hu@%O>+Q z(FN{K4ZGuE0rT1yUIm{YR&m+FfR+0Gk9+UDUnyh(kwFADy$qpHT0+#i{bM12d-RWK zdbJ=_Nb}3<-{CC1S9UAN%~eM}S=jCAMcoF$Rw%k&?{coe97y#*ZOo|La_sxko@$tq zgaj5o(`0SHO1_>jK{L(UNBZfl;y@q7DM@b+(UCO(fK4_@Iv3V;AqCK-w8$chcccId zd302iZPLIz9OISWnXak%*vFNB?G&7qB#g@`UR(LhcnyEQAwD%;6e-6q1e`2-3Ql>y zK{_HB1tPm1FUM!4%0FU&USgvv zN)gLLbnVbob$|bd2xWsqfV~#koY`ej>Ep}xa+a&09t+5_5FNIgthC+#lmQAxV_6NdgM1#Rc6d52&J_pGjW1pq7& zf1!DK*4MBD@)PjayVe|kZ(^=}Q7gX$V_W;0s(KIfG3v}lG3~b;i%UjP zFY0?v3O?}WI!1@n5tNyrVvH42Gawf&#wS>CWyzM}xgDVA2g??=0O6Jd*o-adln9r` zvd*VFf?!ROuJXJ(_J6N5r+zaqnp=22`0Mo6_j!LhB0xZ}!|UIF%t6S^wKZy-*o-C? zyf&MrCMOtv!aS2N1SPq+HOw7+IAOsu%u^sN8?ZS!#$%Y8%~{AgVi30`ok{MB28lLD zV$$XOw6U%}cB*HPC)?Jg7_BvhKd3QP5GCQu@id19g*i6{(!Pf%-RNUToQi54SpLa1 z5;gS|i)ZK!9FG=%;w&PxPtnCEmEa8`j#x=W_9IP-fMSE*V`S~3zLav=xgJJNqBQ8k z8!E(ew63Kjl|qQq6+pb|_P`@1lL@(AFpavrpNE9AaRcszM?y%;rycii)V_PjndCK} zN~ua0$LV#Nn2&4ymiX0E)&rqDL+gtQ!UfhpQzNr}pxmDe1Z}@Qp<_mXOaQxuKc%g%QW0g#hQP($h(*O&Pecxm#eNpCg%1)?RSOQK zwRg(o?Vp@~Yb3W)05kx}VJhTEDH7l0QZ`=bVN$e-jt1MyXB*C1tcE6d=pCHkOk6e% zuDpHF#~r@fphD*`L_+Hhxe|K;t=HcW;kovYg?OGK0M1$q-mOq7NghY6;j3U~F3hX; z9os-W#43i+T;$l zp05NpHgO7V?{H^x!c3La=Xs~P*C3dTLkk^^@0Oi&A5+k;RZu0ku6-%snCQJaiSx)X-O@Nu&sLnL z90X*&MzC0cG);A%V(3teO4gaCBV4t`TFtA=DkM2JotxA4o({ zTu|?6N+Dvvh2-|Jb3>$#23ZK~e{YP<&PUwOr&_SaZ$^6lYBe}f&2DzmUr8rV3vU~L zX1`P5e!ei@lu7bk;8+`VG-POmsi)zG+UBBJnr(nhrfvlu3czyH+xPkFV@+8x;SI)_ zp&48r%sA=o3qd`oCdk3Ecf@z&TNl(-lgr+yMx^k(U^oPpCD(MMZMR=cS}_X08R3x7 zZ+kl!_2)Comss7UOiMlPU+BQaYbb_)4OoZ>JlR0|St-sp??XiiXuFdB?#eu?3Xrzr z!LoQwN+4N;fXokVoVBGVH~MRsr`*|1@fATm3Z-S+WjlOXbg$A;<+a#SL4Lz=H?}#$ z6R@*Og~(~S4(e4~4ev`2Qk2!D@aD*Z01Ft8^v`A3j+HrvI{jn(`>+5PAvgSge53Nq z%TX}CHh!6dUxgynR4 zzhjk+2A~ikOax}rSBE&{mEfV&{iAq@@3KH_y60hnpgQHOE;v1x;WL6f@AY=h^Q;I(_(DnZ~d;ML1HZ40?4Y94u z|2;FCQUnPLkp4hw?Q|Lev4EY6F_>LUT*L_Y^8dlQ+}BkzJ5q+`9;o>xK5Vx`%Emg1 zyz0ytkj4^XZNSoYHe^Bkqf3pqi6UrbX$R~G4|juX`YNlduP`4hrsX%WiNJEGEwF|T zn#$}8`BHGW{p#sPg_O^K30si8Pzw5HkPS$fIkc+0B6*w=KVMEc?Ql}@EKk~~54)dj-i-He9ALE3EH1HY`Pso7mb^#k@PHj_vbGUYTPQ0fsa0biY z0Se>HC}QFMI{)U^jEPHN6-T#7V~?jl60ToQmpYnC55qW)ik>fFQrHy0S~#d5o^5)bNg{VyT2Xs5S_H3T19&b98cL zVQmU!Ze(v_Y6>wlIJcnL0!+9Rn9Y*4*0A*-_EfTGp0RnpOsA zY!3L8v%->+3ON7`oXl-)gbkd4TmUtoF+dn-1YlwUFmiHof5MUiglz5H9n4M5oB$Lm zifWY9)HMH+{AB_#bpNO3)6>!1)CNHI`QQSyvbD1Y+BkiN_#Zne0f7J~Ga$gk+zJQ~ zl9ShvkQD<^h{>t|#DF$H2LmgBytAQ|xe-9x+z4pn2&4p<*g62L{&4^p+1ePJ|5chJ z-DfNTM}Psq7|{-BWd7*}bTb0l{iUJ-*a01^%^e*-pO>-+11Au?t)r8pk%PIN6W}we zys+q(=?4Qte=h_y00*F{frGIX(9!WT%xCPsy7R9(0sp0X13Nn__rJYu|F-&14CYRb zKr0hESVpGLoJLNcxlPS&VCnyw6$u*?TL2@&Kjg;FcK_7503H5r5XE0JL-`59z}VKt z${k<~G=Zg;wRQST3846&u}t^BNAmvy#s4b=|F6*dfB#4BzjO3oF7f~Geg5~*qRv)U zvIf?l1MrU>1NdAr1~!1tJp+&i{IzJDt^Y3<18Z|D_y3pEzgw#T|AAJ}*2?(bbrMbn zpDhuvG5w^4fsWxHLUTt^b2p%|yt$K+8NkHA>a$;e%T;WQfeu#YHo#9_|86OOmXU$s z-*n1mf96J(Hh&So`VSS*#`xdie^T`~czP*04G~E>>i=fB{%t7#IRsA1?slKp{-YEb zTjT#c{1rw}(AEv$Nz2H_0ib1OVf?&%pMW^o7`*?Rlz#_e{MT8=z{$bf4WRW|Hv{9} z)&IxuUniY^3nOA^p3BMASks3r)Ojd$Bz%>1Ea%3 zgWWd}z5BS-*)cGr+ypGD)fdI+23be-FjN3eGjhb9G|&Us?tR7V$wEV$+GrAf8oX zdmf{joW6vN9zMX%ursjI*Fs1#SJt*tgqilBhMj=W5`HO_a$|`d_26YKTzM#WXpPdrHh@s}n12v8 z7RKR@qN`Aq(9_qRvsX#_4f*`g8@Nu#kq_k*o8@@=(*z!-&!&5VZ*{@u_+{$>MCV;I z`aZ77D>Jrc%Y-6ILhTjTJHyf8s zv`RRSW9?+NFDyn?Ubyo?e?)8gkcJIkU8!9;)pGkVXVBZ-km9me`hOV2QtIO;Uz9St z##`X>ey6H+cwEEz#^2g4sI*3Z;+Sn$;@d^^TZq$LkNE*a3EFQPCI!^iW+O8|L%jTl z7W13db3OP{!rRAQA6B<6##W)RcO0$$-4u_GY6=7RM~az~;`foA-&dB|h{Iof5Hcgm1dZG4B5P&Fpnu8_ zKoe-?m7raLMs;AXe_^0M1dqG#@@lzTq_J>jW$KVA*yr+6Hlq2>tDE2SJmBUf+^Sna z_kK-3=*tuy9okOe(fxpZ{Lr3aY~vejp?AlecP#x@Jk5k9%%3x=L@Ho^R1d zyF$DV$nu{F<6_(=kbaIfpz3mCu}PR=ystu99QhWN0L&igR!Sz`Esc>FWj#S)9eX8S zPLj_z-I|D6#K*TvJ(Z+7J@~n4?})b=tr7O5Y1}a&Rn>)-lxV z&wrYZAEGT?e=x4}(O18P%Fsl|%FHzTqTDpT*?$X7+I={JV>zX2!EEmFWIMszDp$ig z85PDS=Bvz+P#HR^O7Z=%#W3ok|BK30#&mtgJ2Vug6PwwWXA(Ne6BE$F{-Dxt9tnc*erFg2(pZ-3ZT(c=m)AHI^|4U=s5}jB= z2-}I9&1qcdV7z!{>L$o;yYR}KfT-m9n=t&Fmd8XRnsX(yIzz35C?Wzi!>?qjsYuEE zf8}HR5n5rHd->bR=I!3+?&%^OpPr<%V+)?nGc#CiH8pY*Rp1CLF^;`6K)y0+RVfrK zj;LW-BZ04x(j^R;pcE(2dFvM1!FzzhNK7uzuj5VQsTbK^{*7psk-ZhYsASMcwAYDN za=0Q9w~d|9?ed0)Qa+_(Nr}potkc=ue<(nHm;42haQ~8Mxe!VhZs|MfpBmJfb`0#Ov~kC&`gVq@n3g_nRL#eQFpt-#E^@2*-vx zWI}@JEWV7*vYr*94zAZz4|;TH`!o(Af16!+W3I3z${m8L*@)z{(AL53EWNx@e<5`z zMOjR{HzVc?Ljo7i@{x;ee)^s4h_r@q3ll*J+PA_Y?7Cd6V8BfLtr1!^b{!iMg*TCa z)_j$*XL+$8&ufBli`8&Nb8 z9CCHW)@EjYJC#y>yHwpk6dY*C{8waOvOMwUTCbx~=FU{v7F2#6>hIzx!VF^*VClKk zW^9!%Jr#vE8;a5mEE>ev+i0YCJamo7H(N{COOMp&ivbu&IyxYYk`-?5K5ZP>BihWI zTXKRqeog3t`?S2}m{~cQfBaV*=kpsGEXA<+kH>r9q$CNdQWDPG=SijOmjsnDO6jGF zyX9ZzSe1-@lN?{CfNHTWc;W2*yv{?es~Bs1^sUPdmMKXaZ+RYl2k4y*s=X|peB8W8 zSFIFUf9$mzjmt4WxRGymd^|=@SXL9R=(*GTtiuP=yZm5yon9S#e|0&MNoYA09ap0~ zK<4dbOdV`p>6Xp+=%0s=Dd~!Vf@F|$%uf6A^L^7mgv(X%INx&U{Y;VTZr{TJVER}h;fGHJP&q$wR@Dg?S1 zf5Y`5D@oKjgQ2M2CELP>1gMD5MTL+WnFn47`PV}WUDuUM?M0;)R5%1h&bimDKFc7m zx*||yxgiKFXd~XUhoA=C@T|cZY3S+BC?Z=>ggNG6oS)J0f7GMz)Wy_t1gvMIhBW}%^X9FD}XlPxR-l0+V9faRx^|_Z3PoO2Z8)~|C3hnSeZF{ zxW&tA{5VOGu!t=H9u;S>e1D{m+T1>kGCH*aMLQp?Huqur6fJDfM|ish%#cihgEgt z52>fn61c+mrSqsc`dmm@{~VM;?&%qKdmi7Sv);8=s620_;tc6*&3Xp9`%LRnd?4OLbO1t7JtA zdrelV8S51JU3e8mU6`vBZ7{P=vTW)6l88$_Rb%xg2-^th32aaqVaVzR!0XMRBZDLt z`w9;`egIfCBQd_0Drf6{CG4th`vKoVV{{3Ef7=Mc1riV9j)QHy(0Pbllrl2YI<&HW zg=|kKv$J7tN>0ECPM1q-G}u>CHEx5JsXdGf(Cy5b3|g?uv=pq?MhkwwkULno;1o!+ ze^*o+Xw)wn#jw!WZI#!Tp7xM{Hy0Z9^MPHV$;^1yO56Df=%NYMDjbUZwBxS^e(P@o zjNy88sEI|%AcQpbnqH*COR~Aq=H|EdPPisG;wh)b^f^PdgGcie=)+vvu#U^e7I5>l@;~|x|Lmd{J|H#{_9oLZ1sgm zul!>YMprm@clCq}8+-i439N7`=Oj@-fJc(mNm;DFAxJ!`&Wc4`D^0=KQ`*8Sf2&VU z!UN7dmNAGN(a&c{fZ%DY8VJ{eke@R|ID4%T^Z5ct^E=-j3Tz=UDTCyzIf+p=$Dn*X zy1)N55e~ZExbPkG%wUQ!VAysTqRvD4gb4op3dzLlkF;;crs&P;;So3Pl3~MOnmg5! z&4ugRXwcQTh-x+I8(wOk5Su3%fA*LKDNkSnsnPCWPBjH_SqxwkkA!x+?N&#FY8|xO zdY0nEFV|2VE+>y*gsaNuI;lppv=MTRdPOY6Q2C-DdZVuWk!82b_ydbrl^RrNUQ^qF zj9@q8gOuA|S-QX!#q%L0-zJhVa6BL_)XF;wtCMP00U`&77?B^*m!mDIe=5x%$wBmX zgWdI+-(dP_wYQX#ba+>4eMyG!;Zkw%27}S@?9h#tHNjP3hMh%^L)Il;2G%;8z}Uxt zul570z~#fXG{bH--ta`Ok3tbmEQKR59$=$#XfwUfK}QFw!<%CnmK=fegKW_+^*QUH zqS-WKjP0F}oDQ>{Roqcqe|!|$$t{tBbdo@;cGBd>lzr%y!N@*jiN)**R3d`-(53Zj zutM#JPGr#{4Ju1(e!Ey_UZut#ndx}kOLAjOva{~3_o;dm_%s0jk zS3g>vS?{9=$}aNWr8U0kA4eoR__`tey1UO23+h5>fBf9$V=m$q7U}TuHIon z6p(^-R+nUU{$S0%aDlom$@r}tFWXPB*uxpslrS(e^n!&r!2qVk7Fz>-E2-N%@xt! zk%*fz6{IXy%+r`rcY|fQOGvRwHhQ=QDkTtANlA$yAK%?#N&nL@9h~YS#J~+IuZ|?b z96c5XUL{xLjmz?BWCVK6i=Wjcy^5z7;a^~$3613rTE?!q+mI;_W}UFt<X$fPOax3-$S!^TkSaEaO?Ap)F!&heAwHy*c3G45!^~CkNwC+$GHM6pLUv`#W zf9_oAyXa>u{t4sEk!L5xjgn&Le2C%}mdLo~ex>A0TMH3Pi+0*v7LV2NV2gZ8&!S2> z0M_oh_Y#bTTP9SNZyaW)$Lf`Rypxz)2RY&_#u#EPHu812h-BdVahG(0Qm5Zf4w-W^oelf@(d!AG1ntsA0-t#an14O+UM5` zs1zMSXQXwSO^OIOs68~^#|3XiN1ly_ZN-E6(S*6C8^Jk!O@#eLy%xwUVT|yq@b?)s zon-|{&)`ay?RY94$M0NM(R0*0Lk0)Euh4&VN4-^lK7Y|6{$TGmKMPJ z;kA4ZV{O+&FgCWxh((+Ev^rV|S|uag3MbOZ!;(Rh^2C^=PCwL_?lVC;g1!oSs-WW{ z(Z11AgoE~$j#5n^exPuQZKT&?f2O#%)2MtUEhHY-clsTD4SkR!a>-AmpBx5mNyvYV zYNFZ_Y_g8}sp#vmb}p;oymBJ~6hbX#=Q&laN8+A>cXnVFx}6uzxwfcAR?=AyFHXq- z#R&os?QG<5EmZbMfih`%RX`P=SIW{fQ#-d}*EMuz6Qydhb4n?hmb;^8f2Tv|NJao% ze@S3%>P6edpLXM;7)I$3>qFTn6oUb(CNzI@Gd$R_gZJOdq3lFqF*@ozEQl!I2z~ZTSV$DgReJ1!~vMl(X}Qd z#>6?obJ=5+wf_gy=BnGre?aZwZ5NvNQdAqBpW@Br!#qBRK3JC!Y|qWP(NwYyUIxsW z!H|kra(}0OxyrP#^Mc5s?OplSUF1e-mgJr6|rvE93D; zzRg^ipyA2QZ!-rd_ux<%FkqfIw7&f^%1sRbEL=lNL6}89Y0Xt9=S#p5zO%7u=G1AA zXt~}~iR9|{u!4@hC>(8?ooCcl!sUMdQ76qUT#A#KgxULRt;f1G0lWqZ|*x^|nV%J%XF zIs=8{*U?rGLb=Ld#<)MOTkXQ6LFTDR&?>*u?Lb8V{Y?6KkX+20Qh+v>z@e;SnB&Dz zE^%jG?~pEk8fQue$3Rr1FEKygwJb~t*zYO@ILs|euFTS}P>HPL;mHOrhcbIXGq+tk zZL-}KOzX>&e~}<()E;jg4`?yiC}OvR<{jaC39&D6F^s#NfUw;3fZ9>B>B9 zr@>-7(SOCn2sk#kGfi7gzmNJlIPaPop;v?AL@bm%E2~VnMz^iFRibHj!s>3wJTe^m zU257=hx4oEssg2|f0k`8ATkrzy9$)HN8vackv1xge_9QDJ69fyrbaYdF}qRX}kdBo2yzu!d&uf?=gyJU@^ zy5B(8-_=oWk+AA+hbQ}2{6yqiHb-?hAoeC@!>47GWPf~l^4DozCuk6(!h2St3u%Rf zoD8DAe}`PJl-5(x9kp?R4-m<#%8?HxurT(E%k}EUozXH2$$pOV*eCE`m4JZXi8lIk zaWiqyrQcBf)M4^26LK|@azSHLW6xk3J=dGA5Xk#VVa=8UZXBc4E?ez?1iNGCHH@@B z@9OF?ckilTxi01yXzqsWEBjyt-G8-%tBtYgRG& zeu#56)G2B=Z7}-`b*&5e!vhLP>wdl#Bx_mJA;Pt4xZ>~ggH_XkvhjRs!yJ}s-_j95 z#YbVcZwxkA8-Zw%uhLIdTH6=j6Nf#l-lC=F27iuf<7ir9s~k18m$PaWpas5yBVs*n zJk(}QrQrLjdb*)C`oIYGpjWg(32hULFGKENZc2@l;QKJ_e*;^?24yHgzwq0|^Vl6s zR=ES?U`B1-0+nde>*(QSK0~#~_ubn`& z84Sbc(LH2ZJ!UT6JeZ<2@E_!WT+k>r_UJBQWl1`7=*}kc^StoR;QU$EFQTbmRWU{t z=5rgM2!er3w&cakvt*M-Z7#%S z9rQljBD*twR|8K|>MKhuq)5KCF)SyM4nFxk+ns*){w7<+1J(9YcWv? z_*&2fq~kl}Wk;YiF8Kzf13w%5?sB8+ z-*H*Ad~ZZY_bJBPVuOOdTUKGN70rZd~1t&y!&lh&dqvDrDBdWu`T? zV;XpJ%XfKqvn zBe_(8MV3zG!V1vyzV3bn5qhVlZ;Bj}>%4uP*?hYpdFOeYRo&TL>V=XSj65C(u4~|5#m`vJU$W5%!WcIahR+2}(!V-~jyC`pu zy^uYnnhYc{S)*rWQ-7neR~59R!o_V#)7+KmUJ7Lpd2UHjrsSkkIBF;!Dq>efx1IhK zY_DFG{>*hOpUd?#7tM6;!ZQRY)-a%%DZ_|U@(rEEd$tan~bb$9voBPq94Eo1A_vvdE&q8trWe%_Isvcwlkm-$83OYnBM^Fvyc!@nt z5gYOX3XS{+`G2ZotNZhW_hMLI%~Z#7k2yVpD-9<&zn>92fNYEYyNebxWQE7-HyhE0 z$rwrl z_hWkNLpe{)S7cwx?kap*BoWw}GFv?#U`49o*+`NHkGi^x@(!&uLKf;_O8;N}5z( z)EGU*T{fOZRR><RW$`w!={+AAjAPwz6)$W>h%Kfg+J}*8FMjaAH?n zwp>Lon07(W>0!iIJZzNJbo)a-&Z?>IE{C z`K`*=I z4mw8>e|g((L5_IT-55v1Zz%AC`%J{Poud9Vtz6kZroNvW1OK?nffY@kkadd3rRtbX zFITxrAO*BEW&O!SSxRnCbX}snE2R}53&>{MSuRt4o7-yjC640~5-U_B(ZCj=)+?6M z&VLc+%-+b(2;)%g=zA1R;gTZ^PDU(E*Ti`#GAvJSq`4q3PQmNTpmsR?gsb?Nxd5ee!X&gAUv@D$uGJs*Jb@$RwKP>9V!2KiMo{KurY0TFVmU5`<^ z$(SdAqBV(OPc6eB@o} zR~nE7LEu>e-@6RPRK~pUt}bAtAG19w~(gb}Z;_xgm&?Rf|Mh)5eqcNWmF|CFxj03bp9{ zwxAH87xkla53ZAKi+^bLX1ly&+nQf-YqHVhHlgS{-k~-@Mt$2c7;g0Jqra9+Z9>tn z^=ps<|^h%~9hT0H3oqSw=!yp~(}5*%I`6JLkMjr`oIn{x{X z;~;)t1bbYd^ls3Q)x%@7C>m~wse!FE@Kxu;s8WTMubOk_r?an#P*AloXn$P7zLbDaB5 z$Acq*@hi(xkvcf*xpSwAJ{*()iuQT$H+czpX>A6;ReUynhFRuveWN9hlPt(xg-S=R zN&&IuRvJY@Wk!+9o_t=66erMv%@?n9d0!(iWl;H#V1H9i2iyjILd7Pe_D15e0cyp6qfHJH^oRlD(oU&QP<(YUH(5Vsxf& z$LJ+pJ%7Uin|`be3%xExj`QoCG!{QYlV{%3Ei&Rou8pSD{x5MOpt^WxxC&xV6_MY5 zPdxkY{B>_h2Ic6pDs#hr%w7iTwek@4m_HbFr=p$A*c{39zAqm5lI-AMV4G5{GJE~0 z(NGe#rgHV{*3EhKg=Zs5N(lKJ--%Ox2COyX?SJPi0Ar2b~+GVQBxMN8j32bK6{VgrQG=I`17r?&pwQ3+K{Ctov`3I*{$9e zaXElP2yeHH5fwaI(}bAWwrzDkORhz`UDXP=8f6SL?L8AJjJwP$agy2ZrEAWRU%+eH zaDOOIwh-C~(%DX5c4BhD<|NNzMSh1F9}7`F{P9< zIt1y2K$Bv}R>IPdE}>cpjBvgYyZj=+t$P{M*nqS`ygv7w9^3E!DZkjA)|{A>$Ku?S z$R8t;?i%z6wYa9A@j3??f&bX}4&w6)(|<(G(*{SO*H`H6v4ZdS@RzjfrIoS zOhoAkyN(k2<^_WY2V#pSr4812dcny4*vrJ0$1Px*B1?KaS+LMFGlRn<)hJ1>qJM6; znb)0jy9Mgy#0EjDhvfB2^u^74tZ5f_UI)RNIA0QF zQ0QutB0OvEx9VRRR@D-}@UVPo{O1tF(&76Rl5E9)ax4d-cR@KOEPL@L+xmo6uG_=& zw>P&Ki+tRN@+rO!p~nl|J=G4LZ-1p=S7`-?)isR&DC_FxKI8<^5@FjG3$nhhjkbrP zXhh&tF+CS`tA6)0<$Vo*;yU+^HY6gN-WhHmtD4?dhbp0c>4omyLKf%PiH~6BE&W zP&p^c?3rmKn@ZTKQZgOrA(}L=P=3F)l8ZZrF+RgjBT6i7L=r=ivDhG)b4{<9{ zNzGD*6qccnMg9oQ_b}9I{-nuxn+fSZMaIwOOVm|dIT8YFp?^)1_o5f(6uf|N-Snc1 zXN)l1i6!YY zrSV?DHhrNRkxDO2&gIjc^P*M&v`MUg-X1>QHz~qy=H}(9UM!rNNrSM! zVlDGs7(gxywts#rRzgvNv9l@jeZJxZ|2gNfTp7fJnsu|L|IMG_5236y2bWTW0=TAi zZWYd$^RCu54>$W)5o$^iHCbgVbkc1?-2-3uskde@>Qx^sg~G&DDNwgzfF{@^AMyzl zrdN^3G!)HIo^bSF@RiG40`k$4ML~)unz_roOh)G*^0=Ag3u>&;jcuCB?rln_revi? z5`^OvI;wk_Cg=qZ^A*A4QuZ=?WcLK(ajtfe?Xe(4OtEK9?8nmy(#OLR9@L85c7_P) zt1(sf)7hV@@)VVRm6^s8i|`S&Idt!k91#MPs()PEU$AZ2(cR%S4bBXhlf#vIyBuR?V7 zGL#f9gGQQIEs31Y*Ml$x!s{Y|8iOvc6>m7w$kiot-{YPKb@FxrMY3^>S%HRQG~K_8>Q%VA6>yE8Ob4#vlUeyKllB1b>Iw;N(+;uChrFJ=)1MT8ORKD!ME9F~Kzh zNl&M@Sm77C72pxOv+uP@QBl9vW~tO2R>ler%<@MS)gyMAy30q-$j48c3t)2A5K1lXurdp?9QjGkGB1QG$dkBKN z)Q?iTr_iZQOLuxCZK{6NK_u=UJkv39VQg%!L*g>mqfy?IY-3Yj-0|^FUbVM;5kX_V zZh;o^_8=Uof_ryp#kN+H49Mj*!+$)Kk>cUM7p;PZY;*=I;D{qqRafoFoo*SbPcQAqmeKeTW1o8zU4%e2B zUicYGPbUZ8fXW?s)byUlIfc~V-v0qCNRv_uWo~41baG{3Z3<;>WN%_>3NbV|H4nW4On?#&_Ad0y3`{%# z1uHufS7#LmI|T=BIeHbKg)88%oE?FJLKFlvcCm7>7c+JN@&Gh}W&kmuDS&^41;EVB z&5b|-5Or|$1X)>Fx&WxuRWzw-Y3cq`@{b9?#PdHie?6V8EbIZ4e_z~ywhoSVKzo_TLA9se`?l)jy>oTC z8DIf2ws-m40~ZH?mA$F0tJyyZ{FR$K{3{_xki%aKyT7`>U`h_oF3zSPD@PZ=->6Dr z693NA#nRa2pV-b;f7Jj7^S_p64yLaEl=Ls%UzopI7h@}XXMhXP!{vXUSSCP#nU%An zt+D6d*nhzsL011t!`0c!-r_$qpaXz_7RDemTcES^Uzoqx|8(a+>jeBS)f+oH+Is%W z+u>hU|1$?G7iXZYIRgSS%iox$E`MWNSlJ^m{xd7m_T~-%W~P73&0HP-L+1tr{i{J# z|I7^a-z1F99PDj90cL+da|A{O2baGg0aX8YEHnJ~k^J94@qY`!|1I?XzmfZ2Ir?8N z@&D_6{;$vyuC}%c#&&-P;NLq2@OQ}=+XMdY8Gsz%pG9M94Eq217~5Iddj6lh{;Rbn z@ZahFAHbwtjQ_Sp*xuqVHB1al{}x&~OIUdT&6KQMOf3QC#-)R2~t(NLoO-z?aF87lo9 z1Q#_=$G^G#k80!{%>L)$9~co42M>TZJu?RvfS!em`S1Pvn-Dh(oA3W7;kg#0OQm6$JWA^1l|q z->U!P{I9tO0zH7H2y4p@ro1868QGaG_1JkMQ)0RUeaw&}p^jxuYQ=>CwGO@h84 z8RLDmB)0>l!@;C+v^S-!Vo>@HLpbw;6$E$nL>)lpRv3Um{^TDO=>9`|+VAo36uidReyL|9DK4Hyp!+7%59n7nPUq^MIc=J? zXvymCUig1+%dW)a4{^Kb%$b+0L>8aI;0H`X%O>%%?!Uvs5aU>ilLY99Cq!q}WDFX* zmZi^EIo2;41$Z)SvRAp|tPp=SM=wiekQK9Uf1qhl2}untW$T0`nn`IeaiL}^YimUF z&vLRg;0aQQ3w((dst*{iOxY7Ei8c7);!6a_-vfVEqn0t)kbAB~Kf-SXNgvDn%RTDe ziH}K0NZUG$<~-&R_En{VElzNs4-X=3s~JnAa@x9jVPp*&RxqO_t{bh+UH10@1?wwr zIGWU!T{AIHjC3BwozGpWL0hkGcTa{mdl2%XpwaB{K(lP=9-L>>h_+PEC0MyEyg-~n zz8`;Es?PbJFH0tM!_Ccfy3r?kyH)r(og!)3y-^(dDZGT)fX6E~tbIy1LG^;P3FI)3 zD4Q>fal`drWyZlD3>ht$Y)@rswcr~8ygziJadgcap9`YI?I7Y!R`>kn-lsQVMc*Ja z{2@}R+&A+(9HS{I91q}q+}yH%CgkVUV3L0wbQAsj6XM#};++bPtvz3&=h&3#xH;(5>7egJ0p1=jNeiv;8QSqde&Vl%vp$;g$8F?X8hC zBdgLH_Lpibk;@gUVYfrI3k)ka4E1Pm)TGE5VTHxE z7bEO>8^2*8&~Hr(FL0q;Y>dkExwq6`AZ{;E1C0+puAu+@R4!ES4!`|K>{s~hensAD zn9h{6msK2&&t)anyyaJ*)ytF3p6b9^1xr>l}{Sk#$0Id}`NH#`3by~cmPx=WsC zw-8Q)Q{(qJvtlxDY@Ycx%4I=9j7M4%(9PlEtwyuX)w9#G+a_oDtr>FyW@!%^%tnff zI1uj%@~|VAP2QYqmF06ZE!06L{V%NOZ}au45D(rxorT8^zd!QZbAo@OVacjC2X-Z) z2>r~(q-}Vx5ETm`MjkyTDA|8jAfNIC_?XYNCVlu2P(&ZAMcn51{v0D3?uHJ{utU-p zcMUq75o(k44u72}r#!!r?A{<8fsNQ6aq7>UkDaC~j*?JK<106a6oZvhA_x?Xs+U&iG(Ubdl7~YSy3xe%2Qs=Qg{-4_0Qv-T1BozVB3G)ga6tV=?HD) zN#PpAIoHjbRGntkP_TKEcO9k}Qjy&2b8AkB&mH(SeE4Uuqz!Q;dxm}F{T)GP0t`l! zx33=nE0DG&bK(F&YV`hrmbV1dwdmJ zmw>fb<+L&qIM%13_nCj~ypjnZ+TXstu>+ccOkRwFw)Dhaxsw;W2~h{I&otV2xkO^z zeAn7AnTD_N_ZN%_Ud-gE?j9IdF%C`HV;#4>M>;>IIlZM!`N3i9brvLPmVq>Qi%8rx zGgjx@JT(o&@9U*$ui1P8re#Cx;QzuDX zg-UMOYw?Rl?$rEmC18L=THzlNIjf2M+j+cD;5oZ1t4Y5n|AD>eNVe`}F|519EFy}=ID?+jr@zJRwF#NHQwm^1 zlG_X$zvdflCohm+3N-YpMI?2Z1=uPih7~rt&3!EKFp;#Bh%;>iHUce|6mTV{j$aAK zo|3$@2`w^)3tP}a2ajc2t37BQuOo{AvZkKYVc27jeq4VE2m{Q<2pyh6$gj7K<5-@< zSPL+;DOs_J-Fh*22sg(<7?Cyhf#4med@T>i!~C1KO*F40L6N67E&Jc~bZAg4$U?Q) z*vUO6(MkhgEDg|~J8IRO>2MIGrLQx%JJ=hZD#UJcuk3rV#qfRJQGl!nBK5ucajXX7o zYONz0CY@s95sdB0#nV|E;LQu!va!_ROp-@Wh|7PG5xE6Al({~Vew*q%C}5%0mi-?^|xXdAJ z{vwIhn(%FPuIt^LG(T+PlqBP5gu*HpvA1G-*AAdAD<7mK3BD!-tH%WhtI~T3-me1~Yu_zz(1%BS z=qb45e5X2^dg=I7cD;ZTFIX4_80sLjShci zT&jg9&x9l3^bzpWQ3Q^Q?BHU<&QztfTTPfJ+orQBrOfVYP4Z{vi>QFWNN1DnY@p?A ztDG!mhO_6?*F0MvY~vk$-ywVWv?Hycj3(-OGHAP>d9qh+NkfN%`KinN_u2Lo&m zN%+BcJS-1C(=0mwwIby2@vnqB3CQEKKL>Fy*ff#av^o!pMAkTp;4wFTV!@ME-U_?) zVFcSZfXGV&`&TB8KagR*b?aOQg$;kF6q?xi&bndFf$N*91IvODnRRTefnk59GG|(B z^k=x7{`%}AYc+~I!O*vDGa$Wht^S2M>kOgJt9GeeFF8F${AB*9qIPU3E74j) zOK~mANgk;ojg`}K>53pacO?PcJcztwaLZt#5{ABkAxW%nZ-(@c-Oqm@o2fmSC@k8w zAC%}I)y`-wT;XHwvI$S@C35*9LGc~)ki|_7{Pl?D{Coxj^@6MVRpsVGoG$AxB+Q`v zXxFrcKgpFhXt(YGFzafz1sf4RH!@^SfiZ;4HIEmII7qmj1fls`^J@MZ0Z^W$J7*f7 zL}=N3go6=%cc5a)uc?2c&Q<19B8YTj2uTC4;Dm`o!kvu|@;}Zb7;x-iup94^i1CW} zr|Ad`rn&}whY<&IQQjaARYA2Myke_bLhN_FI%{IurG^EL%C_I|K{SkT-Q@TlShW!z z8Xpg!B<#%aMw{OIS;Eq3+WMp&M(YC@dE<`bp80tJRoP4|)WUy0i-LaG3mb&kR|i`; z3hpr%uSF)!hl;u2(#Qk3n8H+$sfR7G$LuwmckwqSH7Q_^XWNjmUoV(o%mtCG^^->A ztApJXvyZ=(>y9{4O$ir8aKZeDGEynZs)72*p8aB0*mjY}@;w1q&n5IHV;&wU?yumO z!0)MUhgT$)5JP_z=-Xg0430ao!LGvQh3;^yek1Mq%uvOY1%v2LXV0)>%UtvJK+G$c zWFY>)&X{9C*@4hcs2-HFUh#&J4Bcry5q z3nW$e#B^xHzbSMgn*;Q8>=mz2Qf}SvEV*=qrJVR(Tj4vESIV>5L7r>uI_bw7OTCN8 z4S|IG!G3>yA~oki*S92bk-X0icvzJiUe*##8#Un*#6_TnXTV>;(r$3Ixjc?r&&k+H{ZlPb?vo4J%;3L$@#gtiUqHQuGD^c|6sN$^Zl||W$Kn3@gN>2sNZj48dlDjo#RF3z%#jKS2 zM&5r6QVfYaGs6u~xUz{46??8ZdU_NaA}wu2Yd(`=c$sr#eilcm(NqQ#2!VMddm$qI+IxIv?9WJhDK%TWx@A&h7=Tbl^H-VvZUJA5-W{byTJ@k^9x3nYyUQnQOMT43o3UO0aH-2Xn9fd_M4qxxB;q_rCf? zcDV>dYS9jJ6LPZHMpDh9a9)m{tSEo=T{PhR$>P{KJISSHWw4B5M2A1)iZ?GGcdcws zSQdG)lbBo6V%pWCXHX|XeAb}sQ=?=m0TMYL_?_faNN)&6>WV{NV>LRgCx(XmXlA~f z$9a@M(RSV(6w{JzLsRQuQr)WR4k6;qX};?6$Hc1kkL()6o3K(`o5=TeG0%TYs^)d~ zK(CnjLE9H)rG&{xK~A1JOfynS*qy$$TutOxFRe!@C23Zckf z%^Q-EI>ZB1yO_k}vJeJ(7{UY*Y*O}80&>kl7AhX`70DcH0cEAXZt5<&!*540BT#s3 z1~AF1R$%R`O3(0XQ8EpGhrWMsQSlj-73}Qvsg|=dDK|vVF;nmSY6cy1Yt3U=)LhQ2 z1m*77dw6bMa&Y4jqVctRTGdPFn|0Wz8a=sGgrOKpMf-vpR11FAH28@Vjq87kv;e|5_I(4 zQxfEmIt*ya*)fz%c1atwUqO;}!deMvUUXTR7E*}~Y;MR`m;tgi?Mt=7G8m{4_MfpT zA@w4uVH@VC??gU~4}!QbUu;Bo>Q{SX*A)IJL;nWUB5ti|VcVM9(M@+26xEkc=Qpbe z<-|PVe}~i0N;GRb>$88WdG@%9e>kw|Hp8e4+gsr$L36EwV)*$9fAzYg^VqTir3;2 zh*{gqdr{JhR(+A=1DE%6BMp`M)fp$R=wEnT59*<8J>>zUxqg4O;QnM_szU?!rVz+5 zh@mR8%MwgD&3!Dc+xgWZ>E8T3>HL20q~lw?(s?vwT8~s-F_{v7uzsCpY`XF4be2Yh zgbawHFm~M5*M?-s+|icEH6(sh^bWN$G_2(Nd5$TIg8xc`n03mpjU~0nYfHB8pM|sA zt`>cBudLPSgN=Vbk8V3Be!BJT@Rq;#s4>gjN`tE0Q+gU%9&;MT3hVdQ$mGa%$tVbX zX_}oPq}Fl1{ji2!#iJOsz?A9Z137Qoa)vx7f88}ZTIimCk&3kk&Q|f6-1Ljm$6#AQ zHzazy%_dxh{JVIx5goSPiIZRCI`mAt(t>IX+m}ZSMnr$ThXjYr0jJiZj$atdGCm+q zD)tMR%pcrkwUa}H5NJ4C8Vl%@V>rF{+pKgsV5b)9$6q7Rd~gps00W%nx6%z&_va1H zg1KBb?j%$bOUiO`Fdv6my+Xuiw;XXhx{4le=&Z((N)<7D z1D}p*d%k}j`;T}~EkejSRK^J9OVOTRHe`R!!kJl-)&DI1R!j4I;2CcL$zj^tf^>$d zC37gN@h$RlT`Vl81ubKCHF^>MOFw7bJ<6dp@8pQ&zT{m?tK&`S1Y89pyiV0DRp+VV zVNRiNpTgR^L}|db_2S%*hbuD~9vZf_X2OqQncaV~bc%IT^<$hB#E;eu{7Vuo}8Qj~z`h(?v`;gMW>m}7-^q6$daJT2f_8`v61<_s@8Cpuf#;A6)7G<*Vv{k%Fx?8iF-`$ zs34Xvy9KM!_xtSsW`fz(2<*-8x;o(cgOYz4-zm_Ani15}ce!~|GS)3#O4+Le%frt_ zhb+C}ew@pj=-9h#;#Y^+VCQ?xPJ4f~srrzs{!r>ph;i9O!rgzcaw{MoQQ+L;;vN5% z$M@_?EkuND8Nlc@<5t@17&folMmtPPlYmk^!%q#wy5kH|C(DU7)QsCvi~XW2jQ)T7 zJ-RyE667cyNQWcM^AbP`2_)F26>%ieVeBrV|Jv|n0leZS$u&CDhBsX4y#h|vxp*-h zRkt~@T6#BXZ3hD6N}*Q#Th&Zp?#tolV`_4xOLdWDG@JyE)3(F>k8M#J&;wI2OGm7g z>gVbhdb2}fQVlg86U#kr^zUW9Qh$HO&%6b5R|1*P5ZG+8EvpBv^EtJwk#-SNTKupM z)m=vEw$dFeH9dinFxbXJ}m)<^*)yMMYRi^<;t>vTSHC0Bw93u;APlShF-l=F)sa_|mj)eVP0NbqgMAFPV_B)ykaxGq9idO4JYMG&-Pt5$#hq+uMv6>N8p{ z_nSNaRU067G4k(3_{BIsCZHxZF(at*V3TzJt89mF_Ey;-;T>uC(o?|iL}j=gS6$-c z^?I_QlQyiI2WPP}e=-C_%I1IDhyn9jb4x4^M-3sIw4e*z8}q;{C!WneepgQB3%Zm~ z7jD(AoQ)M!9PDl5M?YYHpLDQZzCkF6lZ>h_%1Q&}%BsOHpq1bhMQ0E_>5?gTDlWfX zM<+^toW6C$C8D^ZYJ@yUQF_c_U*9|bZo(KTgNE-rnwcC`O>rDG)k1$R?k07S-(LEi zRVivGC*($D)A686U0w$rsTKw?h6@q{(z&4`(2-^uYa~KWFoY}V773dUAhOHmU8lCF zzX$I>e z*2Wvo%=AVSG~p8n3t@lEVy^3p1)rvie(qe4Sh->nQ4OdjsBd!is;V%KHqf(6Q#OVt zGkQ77c*Oh^cKDrN2qXW2nN2i{GdtGoVpbP7tnF|Mi^Xi=zDO2WCtk9T`PGXE>K0v< z6g?7dPz8kLUXcO!+chc1u6_evtilB2h0k)d4Z{4g5NBk;$Xb8a)j+OsLmG+t^DCCl zenWcOK@k(@b#?ah6jFz<&{2%Uw}Nj=M##-li?p|=(wctbvs+Vf7L8VZ4W}#l?E>>D zee$kk>Aw~(J{eO8R4q1pD(Oqxw=e3lPJL{>k#F6XhE4|h{oOj%C&@(+Bb^ZANN8q$ zLbwM)zWD@Mo6CPOa~u80Dey57+*(T%|5*g&@8m7q8N0I27VE-<-ViQ{qLTSMkjUCrG!Xc;6;C#J3lz%B^vj z*|hZV5e!Dng1-L-8G$+iSpFJILQ_d$)JfERCHh4U04+8#cjq%2~N;n_P)=Wnu2=97G z1pE|p$hLnaX`xWCpKk3puPcO)`&nzOE4YI{E{&G`*YUXWV}^?{cU5K~@~eVjc;jsS z1gVSS(i#%Hcekf#lAD8SUV1A!fqZ2I*{k%>J|6J*s2;T=NW{KGVlgff{;^Jz%!nNe zJP+XV-`Q9M3xXMEcESq5%9b*JXctFt1_QV%@zQ^a3fj1U?*(t=viBc&r23({`Y|j7 z>5D5Kt?boQnGs9aFBQz7SdXj+{Jr85j|~(J%y!r3a;QDGJYsiqC(NnK%-t^~f&Rbc zwpKX|E<=j_UHwrEZ_O^Ioeg3l=IWg_4lVL4Bx;r*1Wc4%lEO#~JFPYIJeBpU4n`Fm zJVbwVNYJ;clR(y^kE@mvV#zx~Z)T&%Pj0HM&G8JSI5xW&oFmm^kuY`1zZmyNE0|OH z>M!pIxL3U%5^AU#rm`B*`Co#)+%VyN&L0A(y%&4Z?W9e6@#>4drE$dhs&`JagrSFe zC$saRWZDoPmyIJI&uWu*DJ@DDj@4PVWh{R++!z>(rU@9ebc?c#<4h#>sF{LYo`M&n zs@!xh?tEp2BoaA3E=6dtXM!EKtu=fu`W7gU34;nDfJwi#`KjxryP(6QW z#BDa>0|}w@X0Tu;<8f+B&?Z@wT9RO8WVAZ}jv@0z#&p0m>d#y$!aX@!AUY>YOo}%+ ztHflXi#A;<@6U?K@wD+;H(e(uAETkC5|*2kVRG>RvBfc@W@KP*Vzz&k%QnaZYQs4# zSplSIY-2$?m$W%-O&b23`_RzEfDV7HSG!F7tPJA}`&wVqa9DAxvNIHyyOhd9uApj;`9F%-GslF74?<>CcX+SXjF{{0xvKCn={cH03(o^wjfKRqz zIbJJ?s-QJ4*U8sT?p;@VEdQ1|4XV-%!bZwf3PU^;{5ep&z#nZxz((FZD>{D*U2Eg| z7tEB>^aoNf>9i+mdXA-5P7eoqM#;b=<$7?ahrCmZgevjJBp)AvWGjCqwcGX>m~kqP zdJytl{}0~xmlbvov{e-fVd5#Tn#IYSCu$2<0T_)}DFwIV%qG8RxW~JDz z_j*9Jss>hia$cJSG5;h6@%Dcah9lD5F>Do_mwZb+31@&|32oT)Tf)m7rv0`DXuE@b zc&*25ipQV!Yp0BnRrcO4Hu(t#h|#OtDYa~BC|T2D*`+3-v2OLrpZ2zm?ZEtp4<1WV z5*chda&}d*-uG+VRKeHFe$=5CdX?I38wf{`K!SvQ@CO?c40?@Vn8AMsEUi4FzG`)8 zjN0}{c9+hwTMq-G5F*jWd$rjOGmUNoA6Hn2-b6n4&m@L9oK+al^IvUc_s>wxS)pw| zb?+ICn|&AW62res60TF(-#Ud6_%dSJxaU|}+xDksyJ9h>5E3jkr-mvWWju`!(ptqD zxCljL8;LSuknT-pfOCJ@>0)TTSt%iR`4W(4uO2Tl#EMR*`VBSVvzlzvBL_lZVK&g^ z+HmT)HPMjX_ld_Q1HX^;swTZ79t|J8F;9FqV(M_Te<#B_31>fVB8;J~Yi_x+a4HbI?HYfY41F%3T*N_@ zSVk~M(Ff%a-q+11r#9K+3*Mj+jxAf0KD;UWX-luX| zpTOKw^T%pr^PzwEnhh>X`+I||8~t=8$-9pPc#mZN<(ujRBFb71sj7Q!!9dn>Ns6%2z)(3o7SONz}O_)W?G?*>^p>NnWJQ?fB zdlZu{wuLzA(_1al$|H((M(R;&z~Mx2f*@+NN_~)E@Iqp8q2gp9?ck_XU~Ox%d_%td zm9~_viM4;s@{nov^EXj6^FyFf{WGdltCKPvWESE6#hw*>?bF>$GeJb(kY+hEcG4>+ zrsE&Biq0PXKsoghaD4l2uVq^#Y;`SMFK!~E4WEqppz1Yo%m}o?ausEyxp538EU$Fc zg1sBM0O{x$$&?ryGK=PRJu{n{+;25MSfEt4`%`}`l0E|Fj04s`)cvAGroaPvUAu3T zi^V?*bl2LeWB6TRhXqdJ6-a-zs;Nhczd$xhBY@1IJAy}6{Df`d*V!I8wCYRX^xt0x zJmeGTZOHAdz~K?Ug&l>&`o_%4H}BZ&&5I_0h4M*ns!($LYB@$P+;IA)f z11AOKmXuoxmNBwSF`Crxm%WqE&9Jp-eZAwvF488bA{tIwRK(D>9ocLOs5s(=2~p6j z_wpz@rTjwoLab~w+-Q^IsnVH$Vd@@#$Gv~z&4pZ!pUs*HURH>|rZ>3aUarvPsyvn*w_`SE`i z1(w9SXG9?U1CEXu_>Z*C^p$uU$0}x2JslKry z`{4)brdcxvExfvD9xmEwENu0wJwAS+J+KHQA>3+61arwpZdAo1OFENQT1*`4lg`QI zrXw1{~WuBtJr@#(+Y-0MrnzP5ysEwOhYRML-{w+zxPXE~=;BgY? zzc^Y+gk6^hLy^W~om!)}-p|s?&863O<8RkDiNKS7k>9ncTRG}3vzl*f=%d%0 zSD#RCX6TZB`14-g!=;vWBnW?M*KvSsi8`?F8i*bQmRNI%Wwq&!77~*h1`nBA6+j8C zbV#?QlP5AHu34ZArJ1#wkJsAKlx{D?(=Z-@H zJX~W>o1f}a_fJ^w~nlt_{8Dd z3h&jjd+WWD&)51eSKhnJ@mZW>oBIo;uWMO1vE{1!5AY{$KsnDjS$VqEWDTJ5zL7Lk7>*p%Qi(1ZZoQ=~x zZ0-YsWUf2FifR-$g6nlK+F7^7FUV-rT*vLW-TC?batIOf+I%PJy`oNe7G*I_GG1AN z`lwJ(aa(y37bYHuU(F}d)>USkVBvHU+gKhU8J=paEr*9sv-44ZLKcF5xrwI`8*^Yo zPIU4B4#i>;tpw8KCjQy_rLm-Gzx=o+l4;!CYp(jOR!aJpcVK8wz(x^onUmsz{?414 zIbU)Ea-QTyQg{KQdoAV{#jV<4iD|nhNlPpy4)2q_=t=HOvWXhva!4v;KH_IPoj`^+ zVV0U#?&fFbcJZoPb0lYfFohZ_@~|fI*KK2APQ9ODoN43VXoYxM!#eE+zH^!WJ}`WB zW8xS!B$PdF{>d~}+Wg3Z#n6B3N4RK5$JN&_0 z(}3Ke6jp@^4)@S{_ti1tgJ*Lf>*;3{n^h8Y{Gct_lrQV`Hj}A;ZGEL-<`%ysbt6V2 zQ4%2=RU+Pv@>61ieDKXqs%Ba@<|^ATyNR2&*PO$IlNG}jm`Eb;`ekg{${4sEO82KK zi7&$d+KKS0|8rbwP#PuUgcJ+%cBd3v!K96Xbd--?;`Zv)2)4m>>AfXztop|xsam!? zgzDXcJat}+B~f30LNA7#ES}AXCQaX$om$pUM717~u(BZd-nqAz*%6d1d&-G($u>3z z`ia8Cv=PXgekObl&^$9ck+N2jb!IBo546{0s%E5f4oG!>Tl94O+M|+NG-)va^;%)` zE|m^>`O~$}aP#Kt(r3y8hlDWaqbyRtR}-e`TVxoUv3%o^7rtyF*+j zsfvkOxp{gNH<0U=`~B0y(D#dklU*QWO5%o?71paEYRf0yA%4i*kF*+^CY3n;#Y1dbTCJLk>-9F`K_b~72?E5Wl3%o zPL+XYwv+qSbvhGO-vVh&ifDx*nw@84)JsfksT=`aR1F?7Mzd|EP4Il(abG z<}B_b@gI!6w=Q_)zOVV&g6-niBsQYof@v9cZwvc>?wTJU%72A#UR_f{Q$ZXfPSTln zrE9bOf#TVSnHb{0)Li3wmpME89#M(%NVGzO-c$geB~kO9H!BGd|89-!Jv{;jb1yT)q2oUP~4)U~;0IVOZ#CV@PKkcXpUl z5XA+5lZjpZ#3pu?z!ViX|Fs8Y%g#}u_v^j5trLepjUvA{`F>i|6`j*9dG$BB1TaP6 zf|v0VmX=XqR#9edOu=FbA@Q}yW?QhNqBDD11JFRVO62^oQBII%(dh;;|8;?M=rd$1 zHf+V8@*-@?K+r-}oY?i+7+QTCAc~mnTnDFrw+Oeb9pKRm)P?HZ?27-IjH=IdER*d9 znO;!sQ6giO{Y|v4B3RfK0d|2ms8Zq5hsfpVr-Ck@1aDu{obGH6V_d1s;PBH7{ak$E zp?jB7q1Nfu(CNB}!*~B!Dm0KMa8wsIgoNAyiA1u2-%$?CVmqOQKhbnMoPu4w?!|F` zdgj3XwMNu6wf5uWHbP+z*tNZ)$z7Pc{u9^Hpl`64;#tV!)ZeX&Ij>qT7%~F3e>TIa zs@gOg)*+Qlzs*9kc2h&UUY+ok95oBL1oqudl-z0->c@V>L%0U9C9Vile59OoJ`>hk zTC5P&!p-rBX@;Qwz)>g1rdZnblJUTQTdW;)VICo6;QS!tj})#(dE6h|vQ#1Q3^54q z$8XB>@E|ge+eW$5FhhVzcpOBhReO(5ZF7De;*s9s)viXrlyr5G7Eq}HVKX&ONA?aC z<{*Q(-zc_-#+YwD&nm;UcM5|H86is`&i#f<3LhC_i&BoS+C&w-=DgDj}%FTZ#Lz_)F7=+xw~mK;mK29ag>_DV5j z+j&n9wafIFUMgWYH*+}KG#D~}JvC~+%^b_njD{bfXU0N-J$_h*Xdwi|cn@mqPCYy% zL}5hoazAy8YHMpkiyFXyK^0tkQx$Ac&m(!u|2{IyM>5~QO?K?vYn|`4@a{jyYWU3S z!yWw%3|+GU!Uj^&q_TvSU^gim_n`#!lNvnRBN5hA7xDzG+tc?tqUm+83KHALikFgywFQ*rrWBMUcu zzzpd)VLMdlaAQDeBo*&}RZyfhBDcH-W;(;KIy}%dfvn2pkuZ1%{`!@nVY|V?k?c*S zVNXw!AxV!5L7WV89n+*9Atmaf_sq~Snn*a|Kz9_~3UPv6bCLTs16kLL{Wlj%ws4Ms zZMT(;-X#o~k)4DV9&HkjAMqclZ-H!iDEwb2fA%o0FuxSR0!_$&@{3)^NazpzQ?pO= zBS3Aw-3VSkM(uarqiyA?m%I{>*|A6%Pn=A!6a^)YU)Wdh3u-g^P`t=!jIrI{nG;cb zt!|b(o$x{i*BD!p`gS|$LUxJxadZNru|L5nx>Bi(?0(rO?%$Dr;E1(^{{~}^N3g51 z$Jc}}7uHsg`n+R*L)(08w8}+>#>5cBvip!dRGgUzM4wGD{DG|zB1?ayN`{BgXscS! zOuFY6&B@XB!}_w!j63xMK2ZWhbbyW&jOMjc#hs6oPd3NKyP*k8rFSyNqU~$WEQqip z`>8|)T?tPgz#vD3V4D+3x0`~M_kDll%b%LDHr01j^uir~PIj&^F!!yPm!1{p+X0I| zP6I1W&x!4&9!&$G7a>-gR#VxsUG_^#9tP4S&K^5F8};qqHY?f1+REA?R0f$22C{Y? zGE?COVIR_liDDc7_`ijxs+QX`Np~X>?SUaw`b*AtLL6M_DU!DgY#4R^jzuj{U)VMr z6dle;H_9A;#UarsD>xwWVM>h8%a4A-%L{}_n9v<{2T0m(`gFmT9WJZ~A z%M%`~)Cebk%Uq^873lh=?O0*!`OS5+%eTO4wPN~ztOElIqje$Z*;mcvmOsYbF@LPp zJi(-h!bx86WKbyI3ko%j?-Gh*J8@IZaZcFSYicOM+X4p0#8dPb z#|3?6{Ys!>p!~M=TTC@iGVZW3BY)*J-r|sW!jX;Gk?1E2K&OV4=>$0h$u61*^dlJC zZjrRt;4=-wTEPJ12;z1UojTX=&&Ak(ma{zKmne=5aPsu9DexZ`*qtd?1GW9> zW-WmQu!W8xJb_O_tNMq=u=`imn9Rhyxza8p(s54BXbht>S~mHdsJuv4MB}NJYt_cB)fj8PnU=nP z!MA#jFX+ODqAF&p1mUs&D(Xy*RhGBTyV9tnHEmgY>=zHhSA)xM@QijEKUa^Hl}FhS zHvR^N&&k5nEBTZZ@Er%vZk{_8@JGlznlc)*l>U16UVO+{>Oz3#neP-nx-H&wv16hG z-ZVjD(7Pbj^-cIF(X~MK3H+RZ?UOfu4pFu5*P6S`O%p>2=rNjWfq|EWz@FV8K~%_h zgjgv>r$zwdtnj3ZKVl)Y(=GgyL01J%Dzp@}QX!VG(4^8tf(nu;tgFs$$00HxWat{v z3Z5Fr@$^`nFY_d$J2%}t2lbx!Rejd#8A*Lci$6;Y?&x;U{gc^z(oiKjy%2pxj}1fi`Zmj#12#9iZA* zm+#FtkLMQnhHu#>yh`z{or%wI-9U+1Oi>wi@lgqMcRPEo)!S;qB>-i*X;W8&JKI_} zotm689@JVCvZy9RM7g(r8Ft$ryIw%(Kw4&5uT4)BW539W8J>Zcz5EpwPw;WsgI7#F zItbE*lquFCV&-v49J8S0r7A7zz~DC{a>y#>nxSn>aQ`1yI!ox8WOC-;h0R4iQk8N) zcIrTM{(?{`d<*=}SJiBzPy8*(>2J30ae!gD+kd1tf8r4=Vh zF%AB)d1YI>dg7ns!WCOb-s}^uwDQv`h8HE<1)N z;TrGR58_Ypnzw_0#G;rZahy80+EogYz;O2Z3j;<8xC?x}fwIEG64qHQQ0shT9XGOd z&t&XtjeyscUV6Xsd`T?kuj-#iHvAw&F>1f3oEfg(>tWvk!|ly)7G)&(c0crfHnk%c z<&I$_Yxwfua}$qe~pzmBvZ zgln-Ro?Je=LnRT+7W6rxfJcXi{mw1`J*=NLSrcmXc3)8Fur(_N1Z^b+{g{ziOKMgj ziEZYcnTacZunz+shCpd@goN7R=FIvjOrnAgw2%Az{o*q=W{c?^n|AB`n&Esev~KbN zYj#bTD8v~z=?k8&zaCFt)*VjL+I;bR6>odUZJZo`} z2B#7sjjICMI%d8$pE;I#*?e8wZB)3pGr5}dYaAbcDT+3rCT_2^O+zokHukv^Ve|t) zzC)y!*tesAhh{4;c%{g7-q=mzu%Kyj=elqf=hB6wYN%}#8>X4rKK9GS+rtctR(@3= zFNM}monfQ8AZDsq`Sz4^-k!qQaG+aTRng~7>S(k|Ns4#ulJbKo%WRg9wzouMzrtv;4i&ZCO<19O)`B`@JUgh?WiX0x#gYWlR3B#VpPu)q!p(%tY zsj58doF#Kr7pEZ+p1=!)l@jwa;aTmf6PR$E*OB@Nb@=J;m z@L^8SmuTFk6pd+M;hh|ZIyMpWb2c8D{nKNAg09mGIRL4G3cHEzdlmm$W4b|;<9p@p zmHD|mJrl7s&1K~X`!P=UP3Y`*E?jd~nH~S@GkbZNo)Dp_KL(|?PB1Qdfy>F#q&Oq4 zX4sCj?bsK!TUjlnGupb!)LS3EFLd&^j6L3ff;DjBD)dV8!7wQ4H)`~l7^x}6fG+oc z5C`bMNc@sFIkiz?e|R}OG~Cc35;k)TJ8?8`QDvMOqiqXEInV|-n;enB*hh)KNi-~L zg!^RCCx45ihtSPCexZw&lV7qi>lu^d06}#&$ym%v3wpkE(R@`& zsk?VAdKc53X-ATTiZG!=_3%M|*(f3?-Y3y{PrqXPgj%m;S=bhT8>i~oQVQvVaNkPe zN_D~l5^^!X*-}8GnWS0BR28g%7^R39oXwy4_OjMff(X%8$+tR85cj4@NW#0wR76yN zwl>Fj0lV};TJWJ)q#1IT%Efcdmo?s0(9J;4C(_|d$JGRE3d#>Oc~KjGN)i_YBYpdG z-s;L6ij;yvvm~4qM$FeiPHqLOU4S08^JV0#Ssi(6>8;DLrU^v*!Y2pO#0H8bep z14EgDOX&RgXfWwciY(-FoG>k_d5ZOHq{7*R_M%8GmewFgOMQ$3WelpbMw?+Sc91~n zv7f>cvL+tRYkYD=ZehlM&)p`ePWXjir3_rtp8ag_6g<*!V1#DY_B8Z~i0mhW@ie)F zXna^1f3hFGru&T{a2nG~0O|$>w%OE#v2S?S_YXvJ>Yc8|vd|(Y#&Q|k(|~+UYzn8| z3z%|QqNnb5f<5+{?4Q@3 z@87dQ_BcKs-EgY36Nea&WtC6$Bw_7@IL-uciu@G(X@XM%;C0N{(vO-qsri3Sb8_Xj8V#j<9B3pVcS*=iMg2p4Y0OF=cN{Ye!+e(PCMgk^N9YmN zq~u4C4xX$k4DbHsrSxYqlDovY!I2HKih?o)uh^IPMhNUmtogy~R! zSPn-TLR49Q+@&S6zD?uqg(I{t5t?JF{Vt55z}1^HDnV|q#NH}))c-E-NYZs{4q&73 z)c>O)4^i57S%GpQ%tk)*q)^zZK@cZr&6dd`mV;cnfEa5hSOQ5c@K}VCe(LW!4Hl*E z>25JXcf;~J(R;xf!`QRqut2R$9!3PWA?|lnIJGE$hSnLGA>M-B7|i8Y+V+;kj8{6S zyKUePk?_97!7x4|#mTw1OE46q6j2;5Yk}ozU$Z{C`EhY&?~+5JG7+elf7$C^mZeaL zSbq7t;1@*L-%nih{P?g!%gZ|Rhx*)xgwcJr2v@TT8~uq<_uF-~~_{qxGrjk~y)jkZ)Qm+Y}Tnkl|SgkszOe*p@A z6!q(WTRsF5V$uxeL@F__%vs}0=)PE1M#BPcN%jN)vUu&+p?VnI)6o25dd9@$)z4AP zXz`TDL=DWp4V|TO?8ZTW_c>KiP~WRj8|FHsiNm6hIsm(EWZ^R`)L#XYl3qOpwFtD5 z#D%O)th(fk_rm2@3@2d}OjkrOh3VaYG9}=8xaq1zbgM$46VL{y-fbME0|huzH238> z@EK9GNS>pc8AUUal`&uKtgO<4ZN#nJ4XkU8oNC-kwfC4%gXK$MTx(=lCQLt4@@e1p zp*%irv5B#Ns$^V$;>AuH5!q}7+l%upWKwwAhZ6B&zbdz9hmtja`w21N zFaup#bo-p3D&Ev&LfI^3m&dG&06FI1v|Yi|8xTb{Y*gg&JCEj-?=e9_K;mwQ0ZZ%Y zOfxb+#28`|ZXyH#xbYjv-Plm4=t2o^W9G=+`Dj(0Ra@j<$q%vr z#t(IkLet)p_96ELLmiui%t*Q_`?Pa|Zi|6s?$WGMn5Yr(l#v|eT}ixuTPy#VA5Wlf zE()OL)|?Q7wcS}OtS8)=EKy<&4Cs~v#pmM9j)JyzyaaaZfM*S9my)4wisC0;gX=7- zE{CLBnT1=_SlBgv+au$Y=yaR$bVT{zOXTD8YR+EVX{k7v>t^=Llh7pGo%tv^(NM^( ze~^&NX?g(z^m0)Zgpgc+VVqb;$o5A>l_qQEuYFN@eK&?mix@IoU~AKc%uax^R*%@K zB6+_O%*CpBH%9+JR4G#mU>K^u@y&7M+vB{|L0B!Q!5@wHPXYFs0HWPbE3r{uq79 zY#s+wxT5G$QN2!2?&qE&ux5p0O4ql$!y0&wb_-4(6i~Je|D^ za_R)SRcSH~TC8Q?zG(!c_`@RoQ$8-z`I+7p4M^Bj6dLe4$`&A*Om5lL{n#OsjQ)+U z$f%i}7+sDm1i+Ag*Q1AvWh~}EtU<)bdJm>m)9vGN2ML%(&dk~?Kv8T6Tmox}dP&Th zb<4~*8^r@L3xw>fV30PWym1sU#2K0MNzpx=N2;A?Q{nrxSf>d+{~mwoL>{|dR{P;g zGss(xKD{i99!5sj&NC)v7w2-B?LhdwdYhOzEKKA3wV%>|2p;Sp3t>MDVJsQ)#4b_q zmUvDYd+&*2?ntG+U_IM~mt!v&>I)tpZeu;-a(U2oPo!kB5f7>1$+S@diE--&`IlSd zpT?Lgm*c1=QqWE>W{(vWLr96Mn+9hleGJ{eT;f4;IN5oHM3cJTVW%HS&F-HTr7?m7 zVnwG-Q!`|LcsIRv1cFi;h=fawtolH&zpGc|V4_Tla9P;CL)4|)^qWycm4IL*%QM|D z(Z1b}l9#DZOf}2C&2_2MvmcmGV9JekhmYhQ{t%QuWc#O9tPa-N-sp>#9D1zq3DQ4y zdL(O;{y77TrkYQUujHBa6G36-JQ3QR&BDlE5^(2#U-LCTSHyM%+FSHf5<|SD*;rt8 z3xm0y=|t+KriDMYzKiN9O*+v{ zD18HgE{t(a(6l{=Vx?b!humQOx)`~TVno!UY>J12&fn?86# z+c5cptjF-@BKD(srhtU@u9Z*IRNho#B)(IN>!mZhZ^xt3PKLm&xck~avwO7o%RTQ}KL2Fiq)V1Z4Jw`>#WoJme*-W~&X z<7FoA;o;b6)-k%5OhVQ=Q{nZIM=eB`wpHG%d_WYO22Ms$xLJlgVI6dY4(`T@tIZ8V z(pN2(GiEJk;6v{%N?e}Fl`<)B;o5SGJ8xl63_LZrqIK2Mw)>W1+|V1FU3=i?oaoel z3JT&Fq9W!#XE;ECr@VK&{P)qzhh2%Jl=CfkXG_b1(V!9Hi@kecl0Pmo>I1pfXE^<| z!c>ooO|KgLr9lB}i*t+9Y6C=OvmP#w<4U~sO8@>k7468;O5lsJ@Lj~6ne@@hU=fBF z7dnSDR%1B$5(Plj@eEkcrHtn~LBd6U(6QXiG;h)xjZAQpmsCJtc)*y{?lJqUSb2N| zPln8L+*J$y+U{kAw$&c02fxY`=rv3N7Y^sPq40HOOw`6i@5d7IY}dueC}|Ih!IUYA zVoOcX<@w(JLEp7C=Juu$RZQPVxPV!-fIfZ7H4v5O&_U+Ka}|bfDhc;4)MEmF_zQtc z;p5v5^flp%Ld1R0`W`dhL9&jR75{mc>wei=wI}_>Vbt5%*f*8tP(8bb$sgK!88B-} znKrHIzzXveZ8Y$?A3TdkFZ_3Y4mf*E8{Cu>Op)oFws`U&pQLrERKyA2xz?8oJdNIP zeS^q;(%doxG1%^~Z#dz4X__y8X3Ar}br((lyHMW`8Vkcn6V_r7&?O}d7r-inOxg6- zVq^0mp@#C{iWvcfql8}4l$T;?In+<8zyP}1%kR%Mi0C%TwdD=L_%5XFyGYOoD+hD?YEF-T>fKJpQ55KHY?6$M05b zCy+F6Y+$&x6PZQ4|e%13xl(~Fp) z&tu7yLhMK~C?}|7tna#Z?O__L?zk2{8^vBFK6pbv9_4H*N)r6t>4vJN)Q`*~pFoo) z%Pg**w&d;q_w;gqvhrhR-|{=y3zu;-@;+bL!nJ%;&1q=xN_$2 z;f<$oBUnSqBa>)0QSKPG_LK^E^38aI%2g_iK110hVw^dnMUP z;V#m!+xOb1GxH8kXtYk~15t)7@5%D;q^d8K?QsTf(T$FeSMTVqZ zyCwS+-jA8sfEx2IU!ofc@u{=<0tih4;HUoowVh``((|i5^mnFzmLIyB8vm%E`JQUm ziHJApCI^Clm|t}PB#_MrP9kf?qHyM$^;XaN*^SY|t3B~^oh9JEf8c}&FS1(HUarq$ zb7d-N8`#sSO(^*S&qy0nVR6^c;y1};k(h#pa!_q{@Y4~zd1La7UPNnzaRBMC96Aah z2Vw2{F>EjK==~+=Vv0A0az@7Qza{Tv1TKdUl76ax8^{aA+~T*I&z6zLPkNziO+;BJ zpQdN~&W%g&TL4Z~!4PNFtH;3RB=((rq|Jxzw&C{EJz*u&go_ zVfovC%1IEe({tfQqLDlgGj5=Yr;^w~tF*JxaKd%DPt7DMuQBH>Y^)rPK5Jg0ge6(g zh!<_C$_b17AX*s89b9<8Y+uUbKjxWXpeM?tINN)ls3q`Ufqohb$;%!hc+sqE0c}jM z7%bEKy3IOb4Mq(`ND44Z^J8_rq2}-ustV6%sOru1{W^6C;0t!FA>O-1f}UPI zhRMi=?TL0Y(~T^|`yP`u?r4YlQRIM4%fXlq(9R}}U&7Crlu2^gHd6Se;=9Ma5u2ZX z`BC0XWmA@d3#Dig&-!ueCDH2oS0W&YgZgL8_nniRsog}_j`F=1q(HM@&y`CY1_Z;5 zxy^|Y%7W#;jm@CT9t$8cVEso>zuk-jw!FC1f!!&LaIU@nb(BDhQ}tZpbIrld%y2*B zMkv{;<-U+bg}McQ++$`5sV^PISK`ipcH|0Vgbbex2O0{7x_sI<>{2N;f6ON0Oa=fQ zaT&80Y7Tb$KiMmJ>v~mQ3);Ls6IkC;t}yYrr6*)j4;7WQJ$Jbb?#kQ;;54M=2hSW~ z*gj@&b_rI1`0HOe#5+3#jYG^=0%f_CDReDd!Ae&FRDgjxAv5$SpBz{suG!*$#lty& z?LSQ1wB%3gV=B_HL9g7f*iOkpcI$(!IC z8-tPYrIE(kEmb%~lLD=+Xq3kTeJ3OSQ>=!?mtID@acSP!l`)4Auv53Sh3 z1w@4o1>Eyq#QZduKrZ&8S{WyQNK(SwFoQsyH_PiC=SPnDjx~f2?WS3F0lhKIF*>vCY^OD74UP)U;+T4J7}2}B;IHp zF_^{@lX=j9HT}L-i^|@$Kjk+{9`R05#)CZI&u+5P4y9ZsP7@8c5fB3c$X(5(7966| z`|=J&>!sL<2PHe9Y$J|;CgM)mGy2db%Zj&>(v$J*i6ECcM!PR?_2 z-}Ud(PFdJ?Sq)hBF2iwG+tbaiu&kE+Kkn#^`V^*erEE3*24&sHFX%U1GYHghT8uzy z4Y*vZ)c^Q*emxqxE0VSiJfFq20Koa^Mw&1go(5B+aV!A0m`%oiZE~tmf=!bKXm(pt zAE>6-=zdd_SQfXTMkq`Hb;*M9l|n-ihW=$6UD)X|M+ET^h>=8dV)}P}fa5IxGPV?| zZ(wfc8Ur&4A3~B$R*NNj$x~p?FySQ!Z#+uYsO{{Hgww)5zV9Ttj;*RiwJw`s8U`n4 z4RH2nqq8Ts|HEs4j^JOI^JtS$|A)cs5Kh1-7|V)V8MhdR%1UN{fSm&u*L5KuACr?# z&QB7wW;KRYUoaNML*6i|2t;XTGD^z=xtQ~#oWkG#A?Q`)?D;hHaA^x3{Ouz4%2`e2B_6B?Edpg*TBzLhO{P!rbkE#{E1N$*fSj2#xE&YgO5I?%kG!`ULoe zGG5-hG6^rAO{eRlKESKo{F;SA&8`IhP4QeZ1UCAAd)N{%yKe8hDo@WxJeSa~>p)}O zdfW|4zsbSMMS!-zPjM~TgiwUK!89}jXxDqne{(~1z*Mb7xM?z!c6g@v#Xdt{h8f~k zS=J?fQ+~Gnqo%m8O*vmoN`%KM!vWr)L}R~o{r{B62)HAHVCrZ(ef%&IrZ*X|Ffms^ zn}~LQwMjZ_8a*{NEVD1lB=Xjx?|h(yEw5X0%VIvPYoW9($8?X#4lck-1 zP7FRM^f?7it`JB>&mMD0S8o96!!vDV)DsPhkUgk>-N`3CGFh_ZS6REhFrIRF?Nt7P_Mp1`AsnsDqM)E<2`7y2-BIHqfn9RoeE`cWOH$x3X*bk z05buZS@{4;*7l}uu4<0nK41Ayk^i#y29 z(a9d<0REu(KXz0HfdF7D5WvFP4g?TaR?(GJk_OO8D`^6xK@K1n6FY#4o2i|(89>3> z4CLSnq6b(wx&Z9{eE^s_I+$DkQ<^LDe+QSSE5HQc>I5>g{%`|%nt`1DffxZ!AQyXU zSJ#j40Bcu(rHhFJ_@f74M}W11nVp;YKM8!;Egb)qkduq!#|`@r?1N0j(G~1!=3?yx z27E+Sk&ya#o?t5z@ISF#tv_IZqs7Nfb4N3`e@gln_CfQ3f=#R)TmfK^C-|ROf2JUS zxwWg4or%{+><=<07wdne;pS@XVEJDeFalgamL@Ldb|6>R51J3|f4cKubprl}>P?)S z?7aTv?f9=-|Cxg|*cD`F!HfiC`-o`<{)la9?SRDc&#cHgSU3WJtpB!~yE**_<_>cC zSA*#OnHlVC1{(m6x{}X}#pUC@vC+>gO z=zn;`|F`e?zf()O+1V+X*nbSbzjqAaW678}06z8%KmqX2qOmh^`Ja4D?5*v*{&!yg z{kAsf-|7Bu$YjALA8iqJu>6pQiIFRaF7AK3sCp|8f4;D*%B!L1sv+OO9szp*HDR8Q?nnyx~a+{r+Ac z^l+Hd_XdsP!oV8Go`CeoZQe@bx7sk~#%aDkZC;C~PVf72pASZRfAQ>Sd(uFc1tfk{ z^nHbxn=~EV3qVNabD_ zi1X>u3C-W^+mCqMPK-tfth%DpGn(Y%r$^esv611So*US{ePV{(ctmP`6MX;FQ;HO@ zm$A!zgV`V0-|pP5e^rawE!s7h$(kPC#IH+kc7|F-QXEfx#)ORk)o~>}Lo&ONxOSjEh;f=FKK5UF$l1`^8=G^*&sYNFu zGq{kY7oKP?qs7XDk)f)q6)iZ!%~4MzOf4yd7A;a2I98Feev(`iYa*vw*H(>;(%%*)KIbV!y9`&8?UFw&X9{sNFbV<%&)Olg!nWO$j z`O+N(uZCe=f0^zJh%$LZp*W>{e~whWvv;%w)7qiNMn?VUV}tEV;_P;@w5*;euH6)V z(k#H^6$jofjk~aBLE1QKxM!3t+I-wl9hTe})HLo_X$`8n#=H z3fZa?jvxhU?HGP}UxuD)X>+PdouL4kA0-Mo64jjc81_NoWkzA1^{!eNkM5o!PB_4a zLKSvVe+U&oGw;0)h6MVZ=tZ&ib2TM4Y!tgSq`4Y_QE2Y2st6pEdA`z`KTK=w#bc5( zQ-1Y}#Qr6R1G}q{gQqnf$4-o>*KPc|rBI&@1ESEmYOx6h>))M)z5+=Hp=wxS$T20u z+!KW`gFE8Z1Bt_k+uicKm2kZUr8atTwE4{5fAlYM20YAo6-*8T{Jf4Q=D<%IIssdV z^DCAoS6j0EA)6BK>~-?Rr&AX}4M+1&y*XNX=2%s%Z*f80krd_71S;BDP}6@*4B~t# zO}_iPKJYN>)Zjsgmu$U#mqsgPNZ6)9uXrf;cG0Ly{7m3IOhEoHvtQG@isuj*3S z1Sxk1cF^)#Z%uPKg!u(YyCoU9Z-BS#xDh+VM7#qxcF4T^89BynES#+mxh&Tap)xSV zt>4t?OrSbgy@(h?6UxAq#9d7D_o%Jk;=t%YeQ6YOpBX&_Y1weFixRcj@4Pcle-{RP zvES}V*!dvLlim(HbwQ1AdUl~b;%JUcW4t#AhTlvSDBQ=wV%F&IvF!Y-apMfhiUSz< ziR_%RgwCuGQpR~A27`(>K@u5N5YPb-Gb&K`We+A925S=$=J;F)9 zp)p~4RDi8-(}kmi-fsV3WU{V+aViTfZJ`_B5UY%2eM}iQsnn_KoG|Q+s@Wk1|86^H z@pv30P~avlU0BTX$~bdejP-xhmopG~(&15&P|gaLf}@Wd;|#S+@W&CjnU&Z`K3ac< zoT>ydS)EwbbX_3Ze+Um?uRXnhjn8LLIy$w!XZVnei^9i#QA2=V%%%O(<0w zxfM7@oDj`Ipo$1;eM);#Vlw(}jAJOWcE=QDB7f#%-=CDTf0S8#_eLIwM6$6LKUPW& zeHTNM{t2-+sdx@*ovf*Kzl(MMF>zdkfbL$J{^_~w_Nd%IjQ0uAv`Z&{Wyb;et5!Nh z-=#Wl_$~SKf0wtfIgC~l1`k|vnan*pF>HAa%j_7vn4yWw8hCgS`=$SSNg;glx8s_G zcMB05vg*4NrX(Fy!m%^Q5tLjQr=+jl{Wujn4ok`&5kmSg4E#aFnvYMV^G~WjHk11- z712{NuCOcPUpy|lT50l@9vua8X-*SJ6@MMr z_Vt{G(oEgMG`l)Z6Ompfam*=SL2Ska?_fQq8%q(Qu{K;xfYLAxa|0<!jP@NHUlI*K~i;vRIU@HW8+*Olz{VD%7O`SQBAX5 zOKc1|&9JWy86Jfg5W;I|)P$hQ=B4s1HP6D5ea=rW*bvJ zRcjy?(taqop9M{gT2KVB$w8fpK;arYIfteXeFk3=Ufp^{(ueO%ZaRXb$!$GtDGcU?C=oW#OSe>)IcoO?SRRSKT-#5-h18&WQ?*Y@PGf3Tzt>5GXa*wq8nd|*2b0A!Gug-3e^fOh zsS|q7TnIS%>17_!xu6*Y12^scSAH8Zrt+_J_3?e^8@ubzD7R~zY(+4&iA^!XO!@4X z+VoDGWq)dK&xX=VusplL-*M>W#hT;=vAE^WLdFm8xBt-EnV)fbJe?0OH#+R`wReMD z&Q^OY%Y8_w3=)21J7kB^Mj`fCe>8|U-|dj$XGH6}D3>$U3~4d(-=o7r&x)3Pw~USF z&xoaaX1lt!_Gf>z^=4t5(|l(!50X z`|5tIo2PMYN5b!|3#A|`z3L=nFY3YDc!=dTt)0Qma^ixp6S*fFXeli9ep(a(ND{?ujEuP*AYx-mPTJFEfZ+#F3>J{YoNjmH}95F^z0X_!%)$9 zi=8s}B|t^^eUYpK=(SxZe{V?qyz35kZb=KdQw~+@p5VD+Vb~D2SF=XuQtY-I&#=k| z9O=#RxC7}3ae*r+h3LYhq^N0&PTSs?*v%%B_?KN$w^y|;*gAZm5Wzq~P--WOKkZ0%4=%q9sOX9JYkuztaL6v}#-GG1IBD$fn(sIFY9Qb*%9@>5vH-sAEYuG|Mez`Os& zqzBCEnvL1IY?1mP^NVFItMxS{aTbbq99A|B+3g;f3}pqev(`DL4x%>JZ24`DF{Dup%n!gEWHSr++4b$pZz&CF zc*Y<-i>NL*oYdc1Wrt*qV9w8=UN^_k77V$bXLv1-VO-o*;@8NE6RMw(<)*l5(p%Li znWo+P;FN$we|~7n-Cxbg4PCac_b~eEOc~2!vq2|t%}^(oX-@6$+l|YchFE%D+YzkK z7#%25-kNszZ?O=Zf%5js+5tF}Zb?LuxBOe`qCC}o>=pvdpb9er%-z$s$;G|xs? zI>`j_hb`QlSG1QdE&MK58*&o0`75ocAgkF{9+Ggse+uv5Act!6OOJ1`ox5(psm+m@ z7sQ*W9B4#p9c`pft&UR5XSa$2?m_pV8%~kU`=7Zfpx>jIu9~@VD5qv!%peRFopJ{F z#_O;mKX-3`V*lm)q6cw&ef1WoPAfN#Yi7q}Tt^ip;roR@z2B(?UP5x31>nXlMtj54cKK`y4EHbK|6Q$GX)}lm^b0N3NKc=o!+^;((pHH;JWMw%mF@L}imHuM6FS&yQ=h%AkJR4n; z4|Oyd)}%|Pj~ady&JpUT{LMds(m!)UC;tzZYkLYVR@F((T@Sj!lU>O+9yb>r<=7rv zF7rhbXq=EdO@E#)p(rU-kHcM*Bqm z9w$D_@;ja35wDvg$>fw@ug5EH1!-0rJ12cJUw>Zu<-}EF;drdrOSz7HJs*%+89rt( zOrOHM#IWoBa{5KF7{!!Slzq72x)8tFshFI(j)?WPCdPGz-S}AcJdA_{b)7!r*5M+D zZNSw;nAtN%>kL`z`|B~d<|@6=jlL0w%eeB@88Vve{!gw|o$jlHh>ioUpZ@e7+Q1*R zmw$r=FKqO>EmT*yX^QJyS~G^N1HqxLZSo4< zMNion5U8b3c7AXFf=k#FMG27`mtfo^`nc<4lc5X?h?EeZG>x-((RDg3Y0TyyKd`M& zwgF+FH~HWk7_}wE`MapzGV9mbm{X*BucNYMqRvabE-71E;)@AW#uy<&_BiG1-+v_U z`45pSmx{H(6;?jV3C6oRB6b@@#4mF$*~{VC)b`jG!E;x$X+q*^Ii?FApYR-%o7y$yFEPRh!(Kov@@Z4P# zBSrVrT79|#Rmbvk0_jSU73UoKDTDBt_ZICJ6ua2io7)5BAeRCs)JCZa?OOo*_AjQc+qN;%cI}i76S{@7wTgxo*MQ(P6r? zN2@Nr{X+!7U{SAt>w+Id)55Rxq-jbxR(eyhV1nJ>xbKkP6GsfB!f7t$%yQA0(2TC- z`LEM{fXkJqv6x<{AO?_UKfdsk%_Ve&O@dS;n8J?!c2&F)2CYdL;sw+dBmEaHfi`W>Pahh8&t0M5|^uHS<32tF?;~;uS1|A+XcW54L zaPnMUEY12bmyr_13<-_urEgjSM%GC7`M#M zeRg0>JoyK2uWhE{Nhs(L*iRiBp+G>}1+*B=J#2V|DSV^R5L`s4T%T4OQb zww&L4m2G3 zPFiJNpT(2!5UFHs9ZB=AfN}nSarg;54o%oJd^KxPYCK117wk`8vxsL2qP8cy&1852=dYvA zGc>|i1j*U_zaVO@e1<#BXQkNZi>BDEJ7TaBXQ??Bbb#^@U`{s-l}5n^hkJ7~G-l0y zbQRR8mSgMT>)f)eM8F>B)hHTy%a(ZMgF^`}CU zWEkG=bT;%~oeaO6-Nwbh!_5Yf3~YPI5J*_poLK8xCkV_e;3{zZ6fn3zd+y)hI1q)e zY8FL{uZ|oVX!s3E_3p0|R4@I>EvA1S#=D65ZKxIG0l=}dyre0z2}U!6pac3k{^4V4 zKz|#f(-6g3cd}K$O(Uaaf>3dY3zN322lMz7bLa(8WzwwQ8-CA8$+jDozVX83`aNV| zCNok!gv4(5O_dlxS(AqK!t6~`M>s;ilK6Qxrq8GcEv8vk`qiD@ZAZb;No=2XRaI5M zD>(ZmRr!1`2!KrM-q%P~An09GaT30-+JEfJMigMkT6aZP=6;fBm>x$6vjd%pIBh&t zhb^LjJe=~oB?HVgL#DE00vlHnTNwh|=nLT#@Olx0n}#gubpta({x(Nf5>ieu&)fHl zYG^Z>c)gpYb{_!dowAGq;KNl4eH&7kfNh4=Z>a#EGraB%ul8m60sxS&vdk{fY2FNe8|@9B%V8G*k;#e=Q_%&XC4c8jA(J6~Cp3}p(tq~?zqvG(kZe?X^T?k(<)BEe!Bm~-^KLIjHrk~)sLUmb+ zHD%AK*2BJiO7g+onn-lgQ5e_(%c$>6dV9CPg>4bQryexo(5> zpX(^ciEUm949r_>P(!+5|C--@+Dz<@r`5Ak^Y>bGsjmt`f5ld}4S(d41*WpU4V0Ql zJaavtW79`$88F_#>qJiP?)MqztbkFH!UVI6oEwBfCiH8KQwt0JE$9?){L@HEMo?{vhRiguvRN!}+=_Pv3BC+_K$GU^3D6Z{T z>F=e`d58-OPmWZqc7M=Oyii+=rf%X_?p;^2(UJ3bh{~2I#+g5~Y$zxDbEaos_%Fa& zW|$${&kRGVa0_zmt%2FSD`s%Wg1_sxcce!`wFROyBCV+PkpVB&52V5XoJ7N+X_4gJ zn=OJ>6FY!)cD(Mh2VLpVUty#zvc|3CG17IB#yxm&3x7pL!j;QXp;T0vfti+% zrLw~sYf5IGU2qBMCoZfOWMfjMov%M~_c-Ya$X7qvA&TXl-b{jS(cNoGZ($C3NH za)qvZxn+mpCV%^CBHBZ~F$aU2vdwFQeDv$gW#Cdc$Pk}!5I*8LL`|Djq0sFIWm4zw z!xG&eMNqAf6Qx&v7;#bX#Be>1JB|I^k_f4b%B9wF#lvj)i*P&GF(&OrSqSPY6x$TE zw9)bcbJVJvHect&m7)q35VvRb5b_u=At&ARwNauGZ+{{}4RYf1-LC9ne%Dr{i~R6| zuIE73a6t$WOzarnZyr{j5_xGDZIVmT<(gv+m~dGo+@875! zyZ5YK?~@5iDsdia$N;7_*9vlb0NuA4&fMACXysEDSQa$1GY6Ay1nyb4!mVf9(QP;8 z4jBKUH!8TM)9*0Ig!j;Y8-KL;wWo!1p+MWsEeU2-4EObRWl9W0^E&nr> z4cSgal_3LtpszH$0|4Fa0W0S!27S!l;dNMT;<)^4(tNfj6Iw(0nGWG*ZM^MnMM&Zh zL3K>LlUv8d53N0^Tsmk<3{gVJgo%ad&>Q|ZR`yHI#adFAiWUcFex)xld4~F#ID6ndeRH|r48bI*G}(wY2jXd z;t$`d37_2&oN7Fd&(0q=2#Y!M>oG3f_vy3XvC}HIlcU-Go6n8td{qIXf0z5eW;lFS z;wB&@g;(tn$ z@~=*ZAo?;sbv+`je0`-sL058a^mo4q%jMv1{lSYaxlt|1L=;VS;z%L5T;yifH5msSoL7*?nHI~f21)N?>f>)mhi6uq$au=% zzP<}wI(Kt^9%ptE4&y63xD^xH2v_0jr-DbQDR)RsrOfse3?K=OokPZ$$#&u zKvv#88xS1DP9VzFv{Qt;+)-$s49c)*&{n&#x)4nxl0Q(_XTqltr0DVCgt$pxBet0)K}0StH8w z?z#_f89T`iaLwXhwN1+onMs4|B=OaPjr*A1=?$%y zt!A$9ohc;<=d!%j$3TNV4StaKcfpQry0N`^g=auNe&?YjMN=Z$_WaT4qaQyD|iLZoJzj?WmtKY*MZ73a2~ zNc3gs{>s6DDLf{KA@d!HRK+&nV|Mk<8GjU@j0o<;*OaG+ z=O`1o*D97)2vnI;c*XeSzE>A@GOki!%Vu-**$d8!#DnS^`;yw>f#nu<%4A{{Qu~4N z*E%2MU^{HtpMU428jH}~LRL_bAJ3uL-&&ZTNrbYwgdBx55TlBb>2c&|ql>QVV)Prc zg#P1aJmY_opg@5nyc(EP{DSK(AY|w!6<0M0h>tWhJYSM@zepS+uKQ&NJO?nam z%h$MV{K}UG>@1wqnoaL4Z2E4L;Zn+s6Bx!ZCXZrja6;Z?Byqhvl8e;H=~{$>C#LAK z!K$a5EYwKv{uOJQ^8w0TMq6PfS-g5Ja_Bl=>%fZ=YzR=5&3|cz<@0C7+cY!1A*{^b zON$)Dka0-}j0RUo`}?E&2EqBNz=o$7w`k`kiZLO=Xm7GOK}g7-NFLMtus{65>h@}) z8ZRLwc{w~1$~Txcav8R+f&IXyeIs7)2epvr>=`813qB5q;B2k~IrbPTehVsvw=bmA zp?HSdwrYoq?te~=2~nyT4<;IW*;$F1>S(ScVS;$eju5?D)YPedBZ-%*KX5X#Z@B`Z zBk#1v1wQ|(n;talRFqdk`-NNkmalFRsCo!{Vnyv5Bb&C75p&q`9&|L=eA&6l}o5`^BJZdg=STdkvBN*ECkgXMa}-btY&mxd=X5Ka}I4s3Xya zTy&Ae99)L_hab-a8O{pm`nUs5PCz)0ndDV? z=l8Z`a_y%It{I<-q5q3^I^3`L-p&f1o4G)sP@j~()L{>&Fj`6MHqMVGeP;Ng>yu4A z`yKJMnSWZ?jOE00v$lp3urqmfAiy8Tbk(*fD^;F0l}fN9rJpv_H$iq z)6AHGf_p4KpKo?MxOLssMb>(qW1g&>W+`0@P8xdvY(@pA5?sBPCFDL8m3Zftp$9b zl1n>QAjgrR0h_!|Zv-%NqB{!5X8YFs%n`h+UE0M<{)nnd4Fz)>_i6EY|BFBH5PUYN z1mPYlnfn5yZy6fDqfXt)c_I)idAme@z0^$W{emcDpk_NFfUtj5j9%}6di`h?*R?gf zk$;|wngid<8jCM%sV*7%eC#H+W|YU?S9UflXj1iad26BTWsXrEzp06kLhu=VL3!Bj zi{RK`qBMm*45DEO%ry7>G6F*S84G4wJ$o>_SC`%cVGzRsnQKQ3ZIHiQD_U4e&l?QK z{Ak2i0<5Qz+=$>$%9gwYp8>bALxNv;}KHzz_U|?tC|r!s9_@N(#)mFUm9wB7Vg4C{N7QZS3RA zAN={y#?nl9jdmv&TorPOB7+>)WF2EJxv?+?`5~ zYtSB^)EO}TWxGOl4JeJrWd#31+GKNyECo6i}ca5Y?WP)TvIaIkBc@3M~2h@LxJK5{6>(EOW^zYqYc z3Oh=hNuQ0|kcOWS?hj?_NCZ-g=vn` zPk>^mjTAXm*#ANo(oI@hoE}Wn z>HxbMPkmzeV^DWjEP`9zo~DD|*7lvQbe` zOvQt{UdnQutuSDo*v*D{MSo8et$>hz>b3jn-t?5u+CxDI^flyMSH6=)prMI5PG=cl zNka9hb7WsAXW`Lb7J5-4F*WGdJ^FB^fEp$)RaYfgLOuIl!e5~w1e>`J^k#JJ0k?68 z1e`t6gc%7V%xk@F33`y`&Sloqmgb|Y9izhBDzUoZ9Js*jMAwaAM1Rx^f2V#zxO~=n zrGqayYzG*Sj6_YAb)~_~LoL4$2wPBx6tsxfI7>AIfWypHmToxhWiM~VgA$Yb&XO_} zw4__TPmAwxyWJ>BID+Wg7EDJb&CxO;oeT;l`J&uWN#8_!zoN5&fpXJFR42FpWDLggn!PSoC)aCx)c2whIO6l zey5z%Y1LHa11KGIVSPo@-**XlD}i`0BidX)a}39$JhilrT4DB7(%e_65kFn_%kc(0 zo^(^#HEm5TB)DRMg@2WYc-vtAIkRLG`XgG2?%Cgj>&Q5Z1oSZaB^N>L$@WH6ms3?* z@*HrmH+GnRy?;`OTm-$R_H-orXOS_EEXyC6hL&+(mE*e?Ql08_{jn_p9P8rM7{tbi zcgj!<)5i(z|*Ev^)ZU9OD-+CC+EE{Ln8rhf6=GhB zq~Z+^F$sc<48!XA*U4gwYLb!A`ADiOQ;C5iw$#*W?|VI?OHb@V%>sC1tC#Qw4V@Xh8?Lp5xL~1GFD}FA-bLW^#WXqgJ$n3GWCF+}; z^}j(_w~f+g*V6j_joE1xsN3*_N0m|89%Ef%5Rc%9aRWW}OjA$^t;>?^!V&(2LURzh zUXwB4s??(0BX*f4b5yRi;3;UdQ(s;DH`3FUxqtGHxA?xj2lEiKU*jrc=LXv=*(zTo zpe3Gr<3$dR!SNR=-O?!|#e@BkdzSPy~0n+dms<@siL7$1iidxU7TivWf6&u2zT z-kFFZOU)@A)6QgN-N5cQZ;ki1B6@@iFl%Ip@J~#PJ`1DQBT;UK) zgp;!qjMTlm=e!BOf~!%Lw^MvEZxPx@AgjKK#1&a2YA*7d&wVTJ5c=Ts)SV)!omc#M ztU6fj%MY0V<3YXhnw5ExwGEe`Jk1jyw|{PKT!S4?#pXeqjRookG-9V;QYJ)XM87iI zsG0?mqY2f`f3nWN@xv+qNK>R_w%#z%R`0|@nisl0Xki=2E9MW8@s?{VDz+jlOGl!E z+sdsyo?BvATy!fcPSLJui-cl|vPJCwer)3&E7d;08z4FYaq(l&4|$M`xyVU7Dt}@r zj9FmpyxI~Jc;7CZSuUuuX7@sbYTkao8G?yQ-N<%ZaHi)nfSU^a+!}&(&62@N$-e^Bi1VFD>0(AzZKRz5ooGJIWH+)uglJ2MFY>Em*?)xZ`w(I0PK%Pl9-0rUXg(A@n~(~&iN_TP#AQ=Y z3FfdT-O(^_(RzsL*hVA@OYl02bJm_AsU>iD(hQ)#JXS=-=_zkL_cN7NT_r60)%FCV zGMGWze#F{AAwRAZVRS(B`89kfb#VEfleS=@)=S!KpuO&9=bLA#W9%D)y?;bd1?3V9 zre;AS8-iu^C3tqz`|uh2uUIOW?W_b{tA3LE+S31yR4u0BORPc=ta{~W3H12yo3_FC zpXBe$WzI8=kS0GtUYhnWD&$as@1!g5XE_T#b|55lJ)QFVitdw;sy6tiy>+l!b6XVm z7tm)t+;1g|KYxsw-)Gfx_kYjz{2`U)zvGO!E{+*?*j1Bh`o*9T6ZWhNx)y(^*v{_f zJ^?KYi7kuR8p-^83vf4yBqo{CV4a^Y%n%BhbmH4%FqrSL?HbddD7d7vH$o5z>m;ti zxfMB5gsJ3}J&Kj+@XN2j!@~8cQ&X=%CwViJ|kzoGVek8rj2t@wTj`EE24X9 zG{9nBRjE)(EjiES0Oj&v@pn)WLq0sJCGl~j<*G=%=sE86@h3cgpweB8aU`A=+aJg+ zJh973+|oS_h!WdHDSwE*p*>h1m^&NmX|qcOM#skUf_dV(MLd~Srg2wIetE%Uryj1A zsH;>UL%JENrQDDz8c{nSbA7r#z0XIEIsM?`uiwQy0)_;Cg$>HhdV@wVi0qNmEJy<^ zpHR}K2K5!+D#1yd(eEs7b8MCE*2y!5`N6hsUQptF!M{DlynoqB`c#O{%3jH7EFN^_ z4IFB%=hDq1aR;aKwGoBbtx_)va6p%M3J;>6Bp9h$_gqw4R?&ZvG39#o)2zmhy@wp< zE5c?opYSn}Z+nsDv)K(u77WkA5hBoak9tB*i$&tHOcU-4vcE?MrlxNz85fNXBa;cv zV$1xsCXs_cv45f~$B0Pj46(h1J`tRsUcONiy@?Y@kp^gfd7etk1Yqn zdwrycBI*T-^(-}0IccOmB(v$?bdNHHDl)0|!A%8=GhS^i7D-omMG_L^J5O!T@ML@I zwNq-Jz`Pc<{1Uv_@mq`5Ng?~%(QQegBwLZ*5g^MJL4P8yS6hO-os$h!8@4a(g0(h$ z7BxDw9*Q&L$Rq#TjUvZ(isq_WkGR;ocL?LJAO7&8Fc>tmW4kto8JYmGo&W7v=dBwV zmWzx(QV6x2OLR047wZIHH8cFA4aj5J_OzSf&c z8QShMC4X3;kF&-^`M9=)A}|YS**Wm-G=wlme#ft!q#4CXV?G8vC3NEnxTc%G+Q8%Z zGZk4@b(@xxU?B7f!Xu)s>M^);c^I1c3l%|{fM`>0?O%3ko)ZCvVA$4P6BfxXHJkWm zMR98Dqd(&tTLML&(>u6psXYEz@O254Ostk_vVRCwKhb6s$xJtLb~i|M6RKO&{XmVy zDH$wY5T0UD`1Ugbp)=iQ0H#9b?~;md$aVQQx!xj|CR-IdzD*D9GQ#7;SsESHBfv9) z^DtSMrTdgQy9Gez_$8`v*Ot=q{r#jE41W^PA8{f;6=}jSo~jlk7K3p6el3cA7bTtG zwJ`CSug>6_)S8QdfDBpz_(&#W!Q}1vLO!^L5AmeZ8WF6V2i)WbPWap|wQ{PTR0t&^ zW7o^N_i-G58pl@)wC*}}urf&>duJ_7+>83vp?pRcOL!t8`)I9@>9%c-hp`hUNr z$3#_K>FKUiY0<+h5dRRIh8_YA4|s%`sSEKzugY>qgoxv}X)Ed40%|PZozO+3C5N5% z0bk@w!^xu$8`zWPy-yBan`W86JQ=Q2#WQ*XSq`V!o=5=gnD! zVf1e#?hchj3H7UakBe?Yn3qoS;s{0CC?*X2GLqjfw1HM=ee&MUxqA00yOb$s~2!X+;#tLS=8Vn?Fh%@b=ylN@3Rp@_$=Tc&?DK z7A8$n`FIx*y(+zG@DhLSeX0kML;K{C_!6mhffrglx&vBS?-E#IfMn%nCdKJK|m>8EEd;{X%>GcSCbfUa55!x2(J0*%2yd0sIC|EX7@f$gOWrX_TkSd`1BqyG4hL>qgMQ%aI z2SH|O2B(B;@kLRh*oEA5e59t!)1+p*8dC7M`l+mOMt@f4Vj1s{3CEV^ zGEmO;Xms7b&4jAq%>{lCa^q+=kH_llm*&_E8q+0^ka3b+!EhJykFDolJ?S}fkfhtu zjN>p)qBD~+Z^W^romnV~N%l`m)fq&4@;m5EL}frCwMRG+BV<%`EdURphua9}M|ZZg z;D7%(vDZ9!)t3AY(|^h@er}d}Upt*}jrxf$c6)4f=TX&a;KZ>3v!r8%tZ&w33bHY$ zf+)S_RlpKbL1cNjaa+yBrxvBAzGyq2UG2Jj$ z^BU%tO*jqe^nOEZjMHHA@ps_y-3;rl+eE7FaOMuOF1XR=!drT!N0iN_)h|R&lo^{Y z7OfDv2k{}1PKhEU{TZDqET9kOm%|*-wpb9FDj_jSQE~nak3l>$FZOy>FtV~#+w}hd z1HrRl3T19&b98cLVQmU!Ze(v_Y6>wlIhUZ>0u~W8HwrIIWo~D5Xfhx%G&MLjmq0oL z6a_IgG&D7rkrx3df46gZrC+lq9Cd6vJGO1xwzFd!9ox2Tr;~K-bZm5No895$_r7!H z%yqtR{+T&{?0r3}?p1eHt-Dq|*F#RMq)IPr=3oMpaIkl!XJ%mH0Vr76nYg*AIM^vT zaLduF04?04U5#x4Ul=j;cT) zz||56Ft@S=0z?&+w51g!0aTI->HtZgJ<$292qiZYTPst5oRuli-UUbvFn4eU*#3I~ zFmj7(1KU0$p6bXui1rIi3Hk6Y#%PZ|vx3>-8^hhkxz*UpZL0 zx&Up>8DN=NzG9lXe#N%1vWI2-r(dM)%^d*DO#iliJ*8x%e(=*gxNf?_s z*xPymf6Rd9u#5^0u3sSmRR4D>GyM07{NEt)e~ZBXE%N@qiThtQ`rj_`|LcAJuhbH5 zwzdk!c3%zf?>Phb8Z^fCfUj8tkOTZPY;2940sjmfE7SjvtFfJxt=Ip_`M>Vg1pYhg z|H=7Z;eUq^wzv3Fh@P39f&JfRD;EhXPoSBSf0e7LCBWR+_UrKeWmmU113KGU*#o~s z{@3|_IWaN)7fj94%GAdGA2rzj4FT=V{%Z|iy8WvHMon#bc}Y>)|HHKX*Jh=!u5eZJ zas&eYXCzH|2ebdR_=ieF#K9BbL(j~?4WMV?Wcs>{U)PbFh0XW>C+xq7nE!JvZ|v%9 zf8`0#Wny4rVg`Ku|Htn?SNi{jM%>=i!R((tQgt=9H~VV6|7G|GHg$7${!;v3)8MP} z|5*R)5&(goKvUS?%MPZzA=Vk$nXV03`6H8Jx&wX8;3J`q<;`j(MFDjVz5W>yJKWVq zZ}p)JEz>+7KfRXD9N!OQXbyk%VcJsmf2IMi3h{kOsr!piHYqweX%B-K4ayNR&oyIw zt{3IDA#^yHG!Azsl~oMN-XIC4J6WBfub-&{NZpG9(8-=05&cZlo8mFLkXt}d8;Z}) zDUwf~pD2gMMn{HwZ@={);L+yA!;teDWBH|?5vRC%896^Rn|^$Iap!b{^FZ)Hf6IJ# zBMr1C$#4*D^q&9A57G|n{a z?gsf_fcFuJ2|smHXowCA01fu^w*n`IlX#2S^#Izcv^ z>XV3@a_fmdE_za7?uzT=Na1X6e=JdblWc!;sl7O5;>l|gWYO3*rpJj?*?0L-wJB&; z6x$GTRPV(6ms66b3uh6PI#qK)$bV-fvBooKk+%D(F3Eg=q7>21C*{ zpx;Mt8K2vjTkDF%OzwM+MYp=KEA!SkW_-KS)QVbF3__+~Wn={O0Nk;({uM!!1X zq<$`fkt|q);+FhEk1qAc)NRAYVB3b(_L(C18^0{}F2Dm*gx7%GYwBl$D6McF!l$Xb z;RI@ezMG4{4-OZVS62~1e{z+++VR=Vs6x*(a4$`nMu?pakIBbj&?yWOajK&`4{}7i z^y5UL`=Or_G)k>JdfIMOY^cAk58C&^afLwwKfvquq!iUl-UERf7i^L0ZM;fxXjYKJ!bP_qRx~Si)DR+9hlw5vAkSqG9j9>{%fZf9;`NZA*h_uP4zD z3|x7##NMJsZfJ&>=K{U15N@7IMgo|6LaSRV0C2l0d32>yoy@AIRu7SHWarCtt` zo)gS>EyL7+=%!_`BWGRsbRg*zRLoAO5C(D_UeGMx%d+Kjenb@r*TjOT{(_SnC&%e_ z7gnHyj570ZFnX`rf7KDF$pr;-I?KE;tp4NW!R|6EU%G#lqNA^`T{!5JnDXs+b+A9n zRy8%5f!k?Fmu`Q$NAZ39hh?n`+lUbQ+cBD%;8wsii0lk8IVSZbOunQTF8x#?r%0YOR*d_%zE?`1`9`teF5Are^gG{FQ%uz)^Uh%T`5R^2I zC9q{g^@zE}e+df*=ufq58ynEIN(T&KG-nQoX4?D+9ekhMES{BP9BnF8o{*-YN+k;l zpn_E-N;Xg@$EJic#Wse?yL;sHSc(CY_}oUK|$0ZDM6g zzXZ1DRQ$rypj0qVeUlLJsV7dJ*}Ix0)YFl=~&F}j2#l2PN z?c4l2*195Z26?$Kp;=_cTkSDKAq4CxwX?+&8duysebU&#(M#ZA#rPZ0oHcvqf{xsd zt_w=1^HxurIugmW+J65z@;36-#DT~4jG3mte=SWebLbQc2bu{lhc`p9se-mwjeC;f z2Z35W`d;r!qwf@h$u;bB&!X8`_OKpw2k0Bfgm>+ETOLSsC*kCaHnmraF}PE7Mnb4mTp}+ zf7)Cnyi$vgWi%R>7>{35{&}KR1m@v0^O~bh5!DB0kB~RYAa9D(yPuooZ!cxzuZ~4) z8LW8Ng@=O|*#kmyL03NZnRb5c8g4H8trC0NrI|K-SWC4Zmxvww>R6f%)A1k1PDa9r z>e)8F#;jXvlfruuRn_J;Qqw(N$$e5tf28@W(+399o`#0XYr;)B))604fZ>3y<@ zI1?_XvJ4~xOY#i(YK_H@KR-NTDC0hd3>i(hdXDj^^D>ljc~DEzH{+l{${N;lP1HOv?q)2}sATcz$&At7wHm(lKUxe=Jj` z6+3RtfMj)qOGjgodB6bP*h818x1~*e`6t@ux?R;=2|J8W zv*I?f&F2otR8&I!WaKg0vGTLlf98xR?6;&|jVSzR359NQrOT4IM6onP``nNv`ysOpQgFYy3dCc#)4@-ft~TLAj<2Ehj>Z5#zjyF+e!q9 zeUOF+!+Ka0!6MroyK*ckST=V2urqY1mFSB^Lw#(boZrsm9)*_IW>`TVe`L%u$jo~# zH6P*v#J50)0A-5g)ZdxNi6KjbF_7Pu#PEDRM{xt+l{m7w5E*~dqM2>*)SuRcS5lWl z+-^^P^Bg25N$Y%mJyzdm+PXHtjp|+id(r72e%CKPeFKY@%LBGlXK~qgx@#@qwOJKG zx*$<=9kLBMc^+F%Rn|r^IZj>G zJnoGBK^(cY>8SP*kJUlLMMJm-`CY?sfpY+$cXCe_at`BF@pBy8+gJuyk_Al53moE~ z8?a+$k)cI5S6ZRk362@~f*A(~QVECzoe8>x@f?dhtQb&Y<5HFOe^Prp?0GVCI7819 zk_Q7k6os6&!p@bNvzOTS-nacE&Qgz`5kE{flFb@_PYU-^G*kPy9rKIXxRIkJ##w*z zXw*eWd5UTF4okL;f39RKP=(KW9zVx#Mm%b7&JNK~B=UDq^L7{IpKVE31mU=?fp4vk zg!uO^2r>C@t5~(je^+T?)rGdo@!%jYR7a^rLa^mX5KXeAZc^j%Y|qPRQp*;;Iy#D=FlBf*D!#-x;dL$K9Qz&_;HuZ_KLDX{twxHr zEjV=T>XT;BEq7wEATcUurN#=mki_Z`d+W9eMVe|D8$hU%M5(cSkQM5q=} zLI2v5?l)N(DIz#v>0Aj!;l7$IQs0g~Evk78%Q@v+no&PI-RJcg8Y)x^eS<|nkEVad zCNX>?3?{H`=XbAVH#C{`ER>OMq%O5!lIM)v1f<7H^|V8X-i9L7rkeNFrCKoyS>OSD z>7Ly#wdPSTe?m%7nik>*K% zHE3GHwq=I~mxmA;#?R5`!L*Tu!g=+AclK6M9_RC)e?R4}I_9jx@MgQe8w806kb~rw zD^$Q{-|*#r+hn!<*72Rdrnedu{#ogxVwhi9rbz ziB6-yH!YFO*$Iwk!Kgx$DLmB>JKtc$_??n(=Z!9?v|{N4PN*1dkw7RR@||7~O*f|L zDj>ZCf4P*KFhaXnk4_v;o7z*6a9eHKqBMD)8!8dp2y!{f8FSFT$d?qpKB`Ps2NOjZ1Fu`E9@GO(vr~L@a@k(^O zqP@Ki7_!GQmvy^lgTqpuIGzD3A2wqBQ2|5-e-mxO2d?lD#7a6g$>no;g$yYL_GyNx z%h(nme#CWw4<8GEHiPKJs2b~kt8fS4_Vp~`95iYPN$478{^asm0%#mDs?9lYQsvGG z0(ed)qM%q-h)m7n#bd8{+p5tQffI;|Cd6U~7-wobQ8%H5LozfV>Jk<+^?ypR<|Xc8 zf36bL3&%uY{ZS+}4i&3jyqTg?kKUmhVi%s-ZJ7x|7H6IMCG=8vbmyL0!E5+vXoRjs zEL`)u9}PJgFtRp$o&wJhCyB=ETU>Ux^^?n&HsiGCP-t4+e`>x+Y=hX*SVhWDpy7NxI4m*X&h)WQA=KM0Wk^LBGR zg!mi#bBR8LNnzfDf4h?z7^Q|nf``Aq3Le=7AQfvb1cO%B+9HoXlUeG=v4~ihf1h;s z!%{5b2@QvlXMUEP!KjxR2d({v%}o%PGn$U=(`!F?YGou${l;RrY-nC1^26ym9z0UK zxWB=0eE{S3Gd^J;7&JeBvhU}etsosZ$|Y0h9KP{VI-AN_BzLq!!r(O9Z%OcS9?ow= zO7;G-0l}(*oz{y`excz!!(|;6f5@7oKU^*}DeGZ>k(DU^616yAHFvK^Pw2RV=Fk1? zd#!DO-DRr01EHOYLhkqJjqfpPeU`?X^x9J;#KI_y{v+~S&>q^o0_(Ke-d8l5}5ZZ8P-W%N)G_D!jqMztr~sJdFze1tN)Z*gd4;| zAIYokXosK_@x@%AwFlcKRdKac%_u{+l{2(h!cq7v?Pb!Gww~_=^7<8I>Ms|P8&Tl% z=glZMZ#WcRfF9IKvdKM5B2uz`9UI=o&33A;LJYVU;At}0fBOg2JA`QvvicsX zE`oI5(@HJJfYF4BuksRhYOTOljm&2*`WCr@*S2hhusUmx8ZY-Zrg0E*0gS92DYFxx zj@wD#!Y~FM#vXKjlaq~~+)3>EbSk%-B5rp@dz`K{KR`O?r{$u)ak&;8gL9FJ@}n({ zy?-6)1_?-55O4I`e=t9L#>BygzD@Fi<;HbOTZU*r@-FB#T#(#cVPcNh_g}Y%ZYq#8~%1e)K@WOWr_Zr~4pWF;8P^>4( zG>d$G83Fv%gvAt4XfRuFEgN;NJW!9qVR<~KlRie_WA~1GqJ&g~j0?U&Y#?E8952P~ zFWbB&e&+k_f62sKFtF1R0JWWSEYQpp#^QEhZnqP@Up!O^7gIawJ{p>!RzLyea6;rd z&sp|@Yk(B=SinqwZMNRuH6lX$o{R>l`Je=G4NRJuZ^=3vxlmm7i-Hd%mRUmZAtYn0 zy{r}6j`W!DY)bPdZZoOS+9*j5P``oWeR_s^XcqP`e;(c4lo+AedVxiK{vyKy;j9&g z`dB)5qv?rMmy3T@zbhh!BOJm%j#ia+`K6&wYN2APg0$~!7>wrw8btaTE z;{BzbIK%1C06s;21H_C4JlwEkw*GqKS1q60jgsm8U^g4*F#D}s0Al=b7El7iQ+c&x zv8OPV@CtFp0PfIjz{K&KuQq-)fxr!V_j_O|e@>QW2d^_cX7VfplfCV^Srbs-Q&>z; z*e<7CU~t4{MP%I~Ph;Fta#LLJBnGXP>nBP*8)1@|J@>(~XCYNqSMCARVSKlBXMzbc z+_8W6EKaxdRvS7xE^gpImg~0I*I+o2Ul#14gXw*+Fm0WkFwY~T1bTuzTvzRhL^e_ds%@o- zm>ifadj4#u?hNClw>dWF-)KE~b~=8sWD46YWm>E!3m-g2_{|gFL0>VnR zr4U$@Ox7u?%7|-c%%tk81xLdOuD0Q5e}SIWxlZ*)E{0GI{w8t`T|%U#w`_4NsyqF5 z%hqj5p721yXO!8x(CZLQOUhPaWc7?p;*uq!E|hr-HubD3nK*7+zbH;!L`z7Br+98w z4Ws0>@A10z7Hun6v*?|8!+A|*)6Z+*JB;VQ4(OUvnBU)?%VMh`A*=*xcn7qGe+;`K zhp7q2tSF>mz}#BfwQA!GH9!g;)Lv?;`^RpQ>XuF4SN~a-$Tcia6zUqepXam^kV0}s zNP)+oYnfP)^c_H<*L#23QkEZvK|f|Ct^n!6>y~XFB@inj(V>rH;e9dsDPE0XwL9jh z#A?+SY9>$6_EMbp$jemUOSD983pS#l3a z38k&jXJ?QE@}oGy*j$iHYI z(|5GFvsO8Rz1A#~nc+*vAoPZ5pJ*iNTFj_Jz>yM(r^(`UXY4+6D<~w4`e5&P{7(4c zHJ`AMYd`!Bl{-9eVrg62e_wW*OD?S_>AO}bU&eI`IiU#Yz7Dl*YzalA!qP7$0k)<)L#+xN*xs{L0u|YyN9DM|o_eHT54# z0x5tHeL$N2sn{?ugZ|jwe7@BCBf6A50ov;x*GcX@Tr7@lt@uyBig8}qgtNQTlZ%hF zh8T+`sBH9AC5{^0bPUTr@t#+O_O*xS!H}3Ty0vF4zhHBO8>ZoxZha(@3C3W_a(a`8 zqL8j+U;kIB=$hNmQq0)+{pHv3&fBMKQ+kj<>=~kD0oEGOse9w9D6ZEzGRR$ZL1=b5 zFH|oxeX39s#^q=ER_ULBaoKE8S3(xIO!+l!V6%)L5sh9H^vFMEBhwrLf&z@U6Frv~ zLJy<}!IqV@VN^eC!zP>+k-=8&EPXCPMG9@c6~Z1uWdO9BcLD{~?~L)KjSs)-jYWN9 z=k5eY!-Y#AZph%7la~fbg;AE&HZAT$RWr7}06RkmP8uN6r+S;A!UtUv=&(l<3imW69RU%W}j6Vb6LhPkTzzh|+Gv9O*P zl|cl+put2`F3y_=D^!qMNsVvK#{nYzQ6UGK4U1%kH$Uz!oJ@MPtJ9KUR{>i(B=gId ziK;^F))Dk4mELiZvi^i5|AN4|p+;4rXB5Q>f2_CdBo_&PCSTbLl=t<5^IEj88yixJ$Hk!GpWx>} z%qCVC%tjMPII&OizZ3+wtwFssO|XP~E^61XOEp(jkiKQffU0ms0!Kuo9hO{{tMO2V znhmB$Mv>w@^4uL_@CNhd6W`~Xh%~xL#l;;U;E&>8QK#k07h-68Rtec7@2 zg^I47w`ZALl?~~XsUoO}{mxZHpf(FCsoz0Pli(!>SYS)_922Cyj2#i5MC)wXbDFn| zQ)P87ScZp+Q>o(;7jaN78DoYhaCx}@g@Zc(@Xo3X6$}YC1B$`5g#ToF+8_dm5tiZT zd^C_^UzV(7RD|r1u<`RG@vXBa^q&;daKfzGC3}Cq(IfeMqN_Y7JJ1x=8adUNY z$R(K(>1TZ3Fr=7yuB``tSs4lh;fl)j<#)yk{UH%f70{PH=cA7=ko@|RqsgR^_^+j` zy4_sBSJ%Ob>_7M5)BIgBsBH05<}OYc=GEd4sxzqKn1t#sPo9&20F|yjO?1Chqg04N z(8GYhNMt`v0jjSm_xM7Eu8EcprfbmHV+^B}N>*}TaLIeoi;uu*$)q1py?OftDb~x| zu;&QHDDe04foJUvWXIpD6ji>D^^wYAmYA?45ApAndhtbAL(}47OxNG_7e(u@YU+-JGPKapq0G21(SieeBWqth zaRZfv8K>o<&CPOQ-tdx8K)z2Q1cWJkd+w;-TcjC6aZpW&Xa!VYTC>a_r~xh(-6T#} ze8U??JkT3;n0}#AfKbHn1&~0TJV8k$VyxmifN9bKF9A(uE+K+4$#h-{>v@02Hb=H` zIytllb!oR&Dux4{D;L62Mb+g5T-xhbdUh$H{}d3-H{G^?=!wFI+hEr&#%LXmi3BD7 zBNDV-`E`eBiW3aT$E>g=fY$ZafBmx<)kCzr_Z+gL;&GHu%$mxwL+ugj` zJJgZ1Z3B%x&O)qfvWleKXVX2utEyx4>wTOCFFP1XD6&{!6O`CYh}y}vs5`@7*dj6Cm(@O(wbRS{Gc%A5lq7z1G2eBEBSwFV`-V*s;{Oc8!cay>s4eok}F`KvJ z#7|W)dra-z2ib7+UJh>^J3Zapu7a%75w-W+?E7Zoi>(ww&!q@;9y}%QR9bIz;xdSa zf*TjVMq*Tej*`U88s}51>fs0JE9bcMV=BX4E2DT%SS(Y(GtTnRnrf6G)zdSEzX$_? zs|CDjj&ZXSg_wHp_$h7}TTiW5^+uNy4;H_|gjtJ8OQ5)M8&zOqYn)m{ND(GRV@1Z^ZR%)#Xf5wbg^quDCHqU z?*@|fq;}as(--fcyR}`E7@rE(UXMscuPPn|M(!gz-tCYrn*N!^+$CskPRTenMd4+L z7_K*8{6*9Yhr)~;>eY6Bb59y8T)X#4dT)I8zOd{<*4I+h3?yBFb*o)id#$ic`)goo z1`JFP|{FB%K?iO(3fMo}$j4FT#TVh|I0@B( zCS+|oi$%t{%z|9WkHSuuDtXXI>2ew1nD(>lzAD@hhA=IiUT=5gvvaV9$)Vjxm9z(& z;<@`O&&=PDi4t%S!rIqb4CQ923-fncv$%*)jT+haDH6sLm^GIF9wVkEy}Hq%>+L%% zZf+w*jNyh{4JkjknBFe1K=%!f_~|E*Kx7loa&L`>A=IMy#+H>1=h`|ZxV&@ux0lVc=Kb8D6w z1Lb?-ur-I|TjSj3OrF^#h#AoY3VU4Wl}!olz=6D_mSn&=*SyHeU+{=B*z`I+soIYN zg`7P@X7`q`lj~f|;VnzJT z5)ybb2&7&W(Y$7iL0^R|UHOHGDr~5`95T!bkH@0H!TNFx|Iq}s{=rD)_ab`%!yV*S zy&_KQ4&Hb;T9SS8btIiMQ~M<{r_FEo7fkPP3~b>_djC8|urt6@>0XCiF!CND`~!{* z@@>4s)nQ6;B^xHH^*}TKHztZnI=+mRyN5WJ@79&<=G7Jx?zE!7MY57>_&F75lH;Qj z6$^Y!CHPtnKZFtk9hYmIrdFP{KN9ar#TB?dnToH0Til*i91oVM^iH(3WO!OcK01rb zD3TI-q|TstJ0Cy>55~29l+9j2_)&nEl$5G>YCxrYdnh5LY`x`Dml3SC?dXzI&gR)Z zPL9{o4)`g=vrK|v=3nC<_dpb72<7~f@{R^rXAsIkv0~H~F>|%WOju%pWhdG584tVAuv)8d?kj#x{I5PLJh5Q|c9Oe#}kI;5mV=M?wH*xZFy z%_7F$v|iwHQ6I*a)k%asZ8|lM>g|C?2Me6st1VyPQi{FYtB&f0$ul|Cd2{?5T9~e%~tYEW-G1T`bV?Gj_yh`O^HEsx6#CcIB|yb;~oA z!pZz)rFomc^eyev+Uht<03Pm;qpDpj@;W6WtQOw_aOS9 z{x-M*4(41{h3b_u47k@5;j^0|8sgIlt=UkiKe6~zvST*QXHDr7yYY|}7$(Rss*{fE zGR*&y!1{IM1Uklbsu0K8tqGwU+sPV>&JD!rXrS6;_6(*9hka^Fylvxl3^Ht?)`r>P z-Xy&i_1vRHkKE03W5p|jEOnA~bsvIQM29I$pb49uBhYBQ7&2u*fuPCjgLk%$mD=g5 z*mvaD9LB?6!(hb>xNiwJ=S37EXX4EwZf9JsfQv;RchIx>@DjL2V7$Y&h#|5;Hv+2B ztDWKrR8miHgX8zDC`i3!cM(@ zy40DeR(0-8#5afv{oP<+@`91%%6b|N@Z@t5t)&OYIx*PTS<-Y#`>?%{Eu{Nh& z(s$bk1G&>wAuF)2S~9l@w4!eZ?1xl?b`VZP*SSzOkmJXQ7;~vE*s&uGE`R}%Zwle| zMfrWs$d(D_a#g)u#@HvZ3VZt_8IrRG@RM~+x|$wrR>l=qD?aQ`hm8BI8yE+AI=s&b zc4N|#BZ8=Gt--OCy`79hcqI@N3%9mf3=-Sdq*=8cgbs@soZ4hyRz~&HvTI<-_w#(V z=>-aJi7PiqS!>S?)B+7ZOMsWRAky!rB>1+3zNn-OuuAIpoM+?+d>rR~wr4eKkyyY*EQnakStF6=x_#kT43o=y{If*hGHutc~_TMZGh z8z`|I`t$OIXYkP|YK*grZ1Dpb`^E1UyGBf3hFquP+Nlg3FQVQE-T!_)pNiwf5ZFR$2_$~jMNAdnNY9E>s={hXX6Zo=qys?kI3-ijU&P=4SEdu zh}XETHz6k8TQwJb#2b1GNtX^3%$WD~7~`fs!`pQT`iU-Xur%SO%|*_PfM5pIMnpy{ zB5M-5hjTQ}Iy{NITU2@S>?yz!ZTKl!dYZHmo zATjsZchh$)(7R)j0gl#TVrm@B&Q($%1v@=^^9z(*a!e40x0rg+DHkiH3nTm? z^l*^P$ly2g9x9M}3$w0%n>h)tI*D=m;c5oG)r?GGvSoMIY_s{q*wg6EDgUv^ldpJV zouG9;ru@f7JzmcG1R{Hc`EN3pp2R3DKYmeDYd8nbvN-Z3AA{&$N}hM$)0BgFGM>s(|MOdco^&nMFa4zGAQYLy#=%9 zkI*Uc;vV2$TAMWHYT2;-soFYYa~9j@?=~7Dzb?mZ=_(L|7i-k2u7ck663?yZeuf{X z138!J979^YfrHlLH8Z!R>|x5?r6clZI^bQIi) zmE&iWgD{uSE-#UHcO=n0b!cC|rO!eiE8*80S1f>)Bo^hf7|EW#d60ZqElA26gP7%@ zSIE5*LEn9)({_&QJ))0JHWS0DR3tpt+QGYsRX*1x)o9SpgNX|Dhra&Me;DHc<3BxT zj(6#`^uY$Lwz-^7zTnjr5@5n!a#k3Gg`N|znwb4H*{r-;b~KTd(8waBI|gN|IH7aq zbTomJ3SXYSza+bd~$Uq=+{Q{QbPjIkv-@O!(YKSfQb+ zs6?q}`G8fS<7n1oe0|;q@9sa9_q+EB z;WYF`Y#JJGo4Szxmsf@*#@s6|_TFD7GciKAF5VADgVzsoOw{ zJkbRUaxgUjzPApdNNF{HPQ*@;X5d1b%!Tinlk4{j^W5z7O1S_t<*X8k9^~BeV5A|d zpVALLEpZRiJKsRL9erL7*RpaTQir3A@~EWJShIfUi#6r~PoNDM?*@(x?`^H(VP#{V zA|P>l45jJu($)D|l2b5$MB(hs*4jJ!3`76o#$fzV*L9`?>Ou{7YQFZ(PiI?+4@1gw zJN@+K7acu1x;%o3{9TlNh4(B8MqqQB>#n-Hj<&=y{W4QRXTDE@VyM@3oFC9NV~#vAiloVTJ0B_E`3 z4x)OETdu z^FL_#kdN@@&tZJr)b$GwFk?5bz=ZJj?h`}ok%gR@7SF-;RgAN}x_2=dJO(nq*8#Z3 z_nwO(VPmtJ`1@sBSRUCbc;`;7h4NkZi(FmU`_93XPd;{f29|kXJzKj3?>b12K*Z~s zzc0oY5nt(L%`q6O`0dT+{N*nd5F$!VI3L!o+2}&qA3f@?1*4^9`U|->*5PggWZ|1o zKb&f@#StzQ9WzMLwv84sobu|Eq}RAC2_XRN(eno!`K?BQC!{mDk1|h)(bR%j+e=q} zm4P`0XYD^r{gzdMlR2Au49;FReeDrJzkcG!P^#i>t4S`)mljJ2N2RHH)M>-DOrve% zR>b1$7UbpWrgEm9nx3AK^{40%$Pl_d@EK3naM7~`L?yIjhuQR0J4`s?H^dde2{$};kN80gy7ufimY?!#S zbh&WzS-$A62#R;QCF93|+oi|cB;}%r$#TJHrajw!HkJ8kV5h>v@zr0nJ(m14(z6=- z^-RV51fLa7hB&Dqts~%Do-)%RTdq{XHk{_LmzjvG*2*q;W`|^r{egEQ=kbqvO&)4Q z1||q}n1{OtKJq@)+uzLEvdwUDeXd9_Bg9d+PE&p(>_U=Rp?i%G0SR!;OY5+=mrc0k z1C(Z!RjxF1b6;hUOsy45Cm-dLTL#f>0~M!#P1H3zThAPZNjG|k|4n777Eu#J(2D*^ z{p>3vbG$=67bYM2@hM(~*4DK>JTl`kopX}uU;CpCC|vA%euFzsz~j==-RNmQt^^sQMIp7xk@EuEp4rc_)uyqUI-8vwPeUu`i&VGSJ+fJn6 zp6<~CTL1wsI6shi|IrH2VlamBLy)uZ#d1y2???7U&^iyr<25dZW75YJ&fa;Z-67;4 zxo&s&>^w8uF!4q)f;?VhsOsVG&mZ_44N$u5l#H%JUN7Grdy~!ym+@fY6Ebo)(N;ogg3mAl zJEEibh`5e15<5X#r%vY>=Cv&+7$+k6?r6vkUGr}|Xiw_QW1D$z>Z5Nh9;{MU6N+;q z#fES=e-it+B(ZNI$}y)LdS~6^kTM_YaEg7UMm3^@Wa4FEg}R3HDA*6dJx7)yT$3$V zgXU{i;KrP0>HaQ&vlT~H7kloyBN~JP9wuL%roI%@3{F3gUbo6A*0dw#vRW;#YxsPI z%wg?vaQ+T+PcSb+;#P(}EQvZ!W67Q@lWQS|{IQj)vRcWjF}vMygTnL0U`v(h+SF-o z9Dnc!68N%;qTpSSZ_v-h7Tt*%_*?KpS(s1gJWshdt3|saIsAOldz2P886_eK=xwNd zvk;J;%J+Di-_B}5%xKG8f7d`wM+GS!tM@Cpm}^%AoBAF^#3bpvVuX^tro2mDaZ1-F9)I%>2=PuS;S@4#<9$cAzL>4$j` zfMP*!%+q27L;BKTumDuzCe6=j;P#iIgxXr3Qh_vsLF<%mn#-`QX|evs+CdgRKW`53 zPuWi@@q9ugV)_aSLVqOiBjUe|sbhtTyMpHu8^Y`J$`xUKdrKLlM}A44GUoce0bimg zbYa4$$|gNw$&;SF&Xq*~h?{NmQtW(G3m&JWL<;9GNGPx&zae+?064YCTvI=@Gy1Om zyQ3cn8@%}xPrO>dXg%1Xfb-)w(_oden7~TWk1hdJbc|m_3rrBES|;8VtH%iL>4`2& z=44Cx{q6%@l)oTd^~&jxY`uHV_f)O!RZBB_N6R@LHSTatU%_ZGXbIB0>;80Plc;h^ zy3yy>j*!u-90n=<%y^Q{cte~Vfg{9f>Fcq-5jSy>P1zu$TcIQM1unsW5_{d}sWGj0 zm1EdRI`HJ*d|Npl2-h@l`=LH<34zH!h*_o7^tv}bU;DiBu*h^e>Z_DhR2V%?oVgp) z-KtNaP~!bP*CNIcznwoRny-|#7_FJQ?JNk1c?vW9 zU-T9X*P6TMZQ$9JOj0N3%jz!)ZqfyY6uENr7MUMsH2xPG(C;>>N42R9E|!m$L`KlV zIC`NMjnu;?*hU2f9ijuuEQx`P5f-g&rS)>|8n~k(F%-=VgoKcb5i8pk2nahGT8@ta zM$;?Eo@#DJD$HQv*`4xootH$ihQaXOGkLqr%-j=7kigA>UiD|088!5arKO;94%5|Q zxlPg(EW>PwByt1AUz(|p4u8eK?3(81B zd)Z*hUO_ zG&jF#a7}zazjhkhfc4Vi<~;9wX+a?Gudd>!0EYo(Gw!HSJDG?pGx^Y@3+zm-!98u4^l`0M!X7(!x6Ui@2`g#zW*${5Yf%dhJ*`8p> zJqjE1h(|1j`5&PjZbTX%CJ3PycWz7fc|GxnCoo<;>@c>oPh-wq667%NH$ zSSa>`M@x{I>#sK_c9|0;>cA3++o?3}kg_Zdy4O}BZrf}kidYU<*^|dfL!)G!90cZ z{xGvX_;W6JzLUs?!_=4%d?s`_^gPCZFt46sgCn?$a_!-xC)h9l#YNkClmoxgX}m{7aym2`Z>Q z`0WH}Q?LG!;fsKJz;T~Sp9ZMQf?P&9#8UaWIaJ%f^DmJZ15LU?JOF9TJ+sF1plHnX z!IzDu@$!*1#Ke^`YJTGh)xJbn2qR!p@3oyNKIXFK()|MTIDy&5Fyny?0oDDq^Q#LU zIt@~B2L%Y4;*y8vB+e}BugtNygCAj^jAWcN6KA*oT2SZg84{ryJCM_EuH&JB@89`{ zUGbAUp))`kpf+E>Pbl~q#}OeTdqXS~957Zw`93d%cbL#O%>EtgCY;0Ejt<3rZ$IJD z<{?cwZy);N+7@ositfZxarFW#8w2yaK~d#>lB=^fv# z|I3#kZ_xj2(iz4%n5_q3-qjdeL6(2nV}cjI<+!*83Ln$L zUvefcncxolm>m5ij;y{wl{x8&B)9RTPU69(CL^*c$AW<|!#gt6Y+O21IEeRVeRm+Cb@$@cEmYZ``Bz^_BO>nXDlH@q3>Tj5OIDI8IJ<1&cA&NKsrl;Y1T%8g#kHv>KFf0rvj zh)k;F_gqMY{YC^{2MlacBTsr5au>ur^o0fk&3^=?kLMKqP-7)sAvstH_4#pd=m&;e&ExN9*hInsL^=xo!_nSpSQ=Mf z+t85ckKPBFT;}Q>C8ueiI(^vV{I(0{KZQ6GBwG99=wkBg?atq)qxW~dnY|HDrzT=r zpx`}s_cal;65`#V>D(z!;Km7m_$^;$Jg=mafc`|Clg^< zNhi^(9;5y~9xfk8cjZ{c{iHhyzvA*6RG^2PNfJ?f@UkLe~_?#7#i>DHO0kMTHsW+7|o21)Sq2~mg)wk$-G{irs> zjQ^fL%V4qV-bO@dUa8u&0YA_$AE?>%!`Y7`E|!~|9g7T}H+K=j06o7yX7~&)c3yko z__~|=?4b_FV15~WX8>z(y}Ka)+~^7JOZK}Ai1oOx>;3*&vU7Hlkqgcu$G>fHudAaXQ zz20xmo6^UtwVKAGGlc~DltkOOE%12~-Y5`~*b*!dEO(D&yKC^x{G-jfMN-2Y50jFI zNGv)2Vy8&N?O`q2*2Lz30f{E*&nl*s8kR(V{`y;$WvjVys;zGevib`1mYsZP={U0j zx|1k_?X>UG7g`0e)hXG>;b@-p9w)DA;=dW#wM*usR4|4aeC~d9zi%a|ub|8GWy7au z^lRjhG~op~2`R%n_jfd2h)M1c703euqmrB8PUJk);Bq7MI9s-n60k3S*|V7{EnG78 zY_-WT`HQL;JNEY!*p1<2%;{~s(I4lfq&le6!+y7SCeQdUCd->Zpz?*Lbyvq;yA3kb zkz7d(a8TuNN7t{y|dJSu5zp+I0log ztwx97>;=9CcyUbC0dTX}dx1C@TO-Drt*FB^T0OD>l#BK@duaxBVRGR z$+m(Pdh%>A929;36^KQu%@fA8?Y-ZRCrz2s=w|zr;7N_;ClT1f>hN53G$4%3qDjL# zzJEsBiCz@kBUvX#4%Pqx3ayU(Pu#6#5ix}kxIxNh@jm^+OBGRc4EaiYE2FZ@wQ`r~Yn-qV@Ij<Y{V{~! z>Kxf+R{Vu`Dn8BKT@gg}YO1#?>o>^X1X5c!ig-FRA=rfV*@@YT_hP>!EZ{B5Q6+pk z-0i5)dP(U$|AQ0@A>`dq{!dToN?2jd=A3t?_Ps&a0kAa_;wD>Xzq4rLBk0p-;B8lO zmD_b>ibNFxE#ko063zh*&Jv@yL21*Bk*I|H7Hz`ln~F&KgFCq7n7%(Z3Q04li&G`y zgfzEUm7yqHx6HpIItiWf*I^p5{en9=Q;|I@sXybrFa-_%2352lx`X!95IIt80+N=g zxw@%3DlqFsDDxgDu`uDa( zq}+ghBlk{RK5SW-970bp;fyMS@L*ZklmN}3bF#NXhJpGqLmd6}@X^!}VRCN6y3(kJ z%5fuPzV9B7L(VbbjEh-1-~nGaZzAFmpQ|>>hyV8B=*0gq)4Hm09V%O+qlQ+60Bc>T zAGn2BC0>Pn$7qerdM$@R%R{CLB0P9iL`xMob_0`+Cun;|!$XnGSCJISSeUq#%yU^P zA4#R*FL{kBoY{6iag`?z4~>xA_Hh#SZUH$F#<;01-_bpjXbqF32}S!0Q59W*ycWua zMJ7tai&i!yuQqpj%l7BofyO~s&f1$=8c-ZJGrxNR;?-WkuDa}QFg@jfrwPq9JinX# zuBW5mU?G)MqgFK4UOlsI6DyNROYYAfI7%iGreIB=Fd@LtE0bglx z|L6*R1xFdn#{)JQhhIpR$4+Kl;Zy@YfqHsP8VV*}uKcjc+XJ2k+SNZKQwExE(Sc?5 zVi^u7Wd;=TKjD%QOu7}cF&IKp}39thbRtH2l0K~xn^N;}* zfW2+N9VDO#0bmHy*9EeN01yY_0lGm0euDMk0`52go)Cab$N&z&o;{!*7C_k<+R(|o z0tuKDTI$~=aDzGY+E5zM1?+k4h?rFAWmrL**$mC1}tC^ zA;217ya`~&0F>bY76Ex4vd)`~UiylPBF- z9FztatGgM8$A#*bUw1YtAK>oU3lIV9x`14*VNdgF(?1kUxtZFt7wgE(Yyf-R*HnL| zj@@jBueoR>^1D}QOEebyovD}qJ~zE;mU~*9->qfST->c{iZbVPF$Ae;vjl90~yfHQLI4xTaE%$>nN zs^}#Rc+8KQo>JFCG~F9aQP5Mm$pES90|C5hk|m4~2v6c_Q7~lG@HBiAh)Oi6?jlNm zEYX;wOUa!=)h;`)nnsv*kI$kF&RirRy`$Y!d$1RJF+wqf&UYsul@Aki#X)`r1FDc^ zS@FzG`ojV$@S_>t#bu%}a-=#(OruNOTGu3xENNRyiuCDPn{mD1BMeC{4S+?<-I9n{ z<%#|y80INk8zHEe%=V^{7&)vRAz1o)2A*Xh%PW}P0-Qle!<=SJDG9_`Y ztm$v&rQZ6AlI*!ut|nfrR6t6$U*mt+Gj;Oh@5dFnnJ5YQa~97KmbCR2}(E;aHa`ZLI zTwJ@+#OwAkk0ZNs$aQCOKE@;h?)3%{5A1QoXmcn<54!{c$;Ls_^}ytRO{(xjyI$$m zQ}b}hbv0Xqo0=kEL+i)Il4g2Wl~vWRJl>Y2<2YJeo9cYUYqyT4psK4F*XGq&Zz1}TdpPLu$ zJ4AJn?+5Cy%Sxkv_cMELwv=CIK;0EqDF-Rclf%^c<>1M)B!taVN{Nnen2Y*IQRp7U;Z4+ z1y%T=p)hdcY9uJamL&an{QV{Tn0xp$sgII%{P4uY?`pR;zjiWOPAm{5YtVNqaGW*= ze#mN7@}r&3)tlwCDO+jNlIgW;aDULdtD~HvQHPZpsK&f&c*XVQ@7}igiVjn%2Mf;< zQ;=S_v;BnRw2f3+?qVrS8=Ebd+wucuq(WTQb-jGBVK@1QQ))9do08E@ zYu8saM@{(P4uu_}WSo_mkhL7e!P6CCo=5mJN=V+%qy(hWXgWgR?w|WVfB!xoI)8^Y ze(E=703Xh+Kaa0JJYSt3-=L;AzxHvJq`%`yRvtUgSzPylO00vRlHEPK_(spYj)YvJ z(>I9;IKW8xEOdE=Y&ICqS)0i{*{?5)&EBn7TV$dd$I4xSXMm-Bc1#-8FC5GW?oEJc zJp+98vk~BIur$fV@l}gSCx-ZmU53rH(z#n5y3zeq8Cs_QLrAp-oc(6IulQx|(&w$n4{shY7C0 z;aAU9-5Bc2bJwlRUJ1BlnM*@m%MaIc@l$d{nGgs7F*yc7**%tj!Yr_xY;Q_u0Jtg41)m z+eM6uF4s1XZMXz>hoi@(4}C(3RlV62u;+R;9{eGI`a@U$$}9Z){k`k*;YUSab}&wC zcD)SC)KrA;?rj6Y=P2LCZYG#z7Hib&`|IZRys!2x5)q=K0~ZqZ#dWtg_HC&M59P@m zy(?A8KgW9={4hB&zj%g zkLgPBI1hg@4oE#!t5)>U7;KlQ{@Kx1BXd!F0d!(=A@G z-}vm8>jg}gq0xYvkFLT=n^b)@4*0G;e+iD--CXH?Df>ctu|tS#vxketL+{C97-tTL z6}h~Z?$Y18xBfm2{WQY)Jp|J4KxSgN;oh;=TduDc!r&ao%L(C~Fb7$w;w-e&Kc?8_ zC<^foiofTmG1Ic!=+se*Ln<=v8I>9}Seh?HxicCcm!?1N{a^1Uy+2Rw<2?$LtbJkr z!k2SY#2T%^t4s7S9BRzp|6-Wv9E>e0}J#qo4rtcD*%!dzp+Nc&1J28(d% z+v+^j5PEcx)$*5GzK5A&4mx3)2#%O1FGe42hL28|V}iC(;i{h$g{=~5}o zl^ATNIVFQbv?P=oC_=7c89|Sg+Ki@lE-JFX1{maE%K_20m=1#J?%-p{=qv8xlpP=$ z$U*VnBiY8;hcaBqZLkl~_HE1-!)6H<&mevfO(B8R4{7%aL_)eqxg^E9E4h)+0l}`z z+=dtC@8=_<8Yb&TLC2l@A@LT&G_9T$$V8_y>e7|<@1m4|VXnv`85n^q#8Xiby4}=p zu)k=(NMUun1TpUG%hY{2f|(8225~|#V{}kd^{|sY`!Z4`M#4zZ{^%V|L0pAI>tw*N zr{%+2G9QRVVaEBCWC#b}lCfezN2R+_NQWSBcICs=cjeV=^d+3d6$|I-&91VSdOCS0 zatS_&i!JB^XWu1fK9)u}%5t4u>+kNR)z!&gJ(;n|-+W8JVV6W3BoZq{?hp$Yn@!#? z=PM8t_R|_2WB|n$X$@VV%S?f%UFOfpXx)xrP^_={)duR%td>VGq%)1LqJ_=r>jQFY%uWv%4SEwfRvDnwW3kkMil`EZv=h}j70Txf4C#095Mf=u&)4$ zD(c(crMo+p5=mj{C8S$A1j(gCdJ$aeE+8o#vcS@fNGJ^=s|zSCB_JTuWs-u(hraK8 zGyj=y=0A7topXNYInVE$nRD+v=iC$DYxc=62!F$HI*y-*^pwxp0QoG--FQS8g=J@e zb$Z$2OIXWLGYtryb#jLawQHT3ug)7WnXR+|*!vKF=>dQSxSmh=ZK?YM%Sg;+JdYg8a#)j}ow#l6U0hLKxHMaFBu6Lc@e0j02C@9L?&+N@2cq(?8YsqsUQiJ{C^>NejEhl zcrvot>|`8la@T*AwY`E6!Q65((EsfKOUlW}=Sf6@1%WCXWB;WN+L!z0->n&IwSwOA zkP?9LdTL}1S8vqt5@YY;f!p2Y$tI&NevW;eU+c41_Y@<#%`1Nhxf)gaDsE}W6K`Ru z&c>QbS7{~fUHh!8tW0Kq`nAdaw1)nyLTW~3Y2LBmSxr?&LFLnhf}#Ypp}Nt%_rg4P z21TF6+aUn;I~sm<6|?G)cU${vX2PDS+*$4sZA08LPJP8Ot+49!;@FhL{GLZyyybiR z3`uAtuaFzOud!^WIqFu9vQHnxTY4t)QGwzg1?SoU5*8tYO5{1(-raFjF2TzuF*v7m z;fz(r(G4o#Iv3EPI4UrX_izlEZX(J?U7$##Y-IT<9^ly}@bdiRBl(Z}uYFQ6u4v+Xw*ryE5or+} zo2Hhww-m$LJrp2`XP2R%o71q@HAXk5`C5>Yw?j|rx}v?-UTFnaxA~H8^(MWtFFE>z z`y}aJQ8Y#1PF2@$(7fmx_Fc?}3~^IR@OlB#A&6#r5g-N`98!713qmIkQeH%Q69Ut5 zPpV>f)teOrMG7e&Wz794JX1tBa?qh0gDtKDtzw)8hon1j8zh}c^|2%f*Lv~^44T#_ zhxSW%LEzoAi{NVZFR!m3#+1X0^Ej18<8%KtE_gS6D850ca~R62&w>aINg+3&9wZ!g z4|+-Rw=&}RXbwI3R4JWFVB+qi3Q@kmrIZ@k!ixp+g@J>-(8(aw`$+mIQM4$3kl9%A zyGHkIc;N#3LeB#05$ZC4wS<^<-NH&uq&RbbLXh&Gebn^8dp_Nos0&%rGg zp)Ac{o_Ez1d_oHc3=OD5&12Ii&LKABb?!B7G#PnRgzu0n&mrXRZ>6|T({4|VjW4ln zTSUOO863KtG3Ljaz~fA-5bh`H)cCU8$$<`uPn|K$HWk+o1)Txdc3~~ccCHf(GC_Y! zDdoBQ5xZSEg3u_{1WZSNUR?obW)oKT~%tTz5$21kuXZ$pWMX zit59^dpo?H4e6WR@zkz_Vjc?}XUC!fI2an(wt)!n)4*}&=Ic_ayUYAMpGR2_t5D3N zOx7{N-3^2Cj+x#V>h8xgFfN1mz^HgCK7Swhj!o1~`)|~vjgMS(K`S*l9_fu%dJ@4V zF9Dj2ST80iS8?}OqS}XHT5Z0+z^w8f6-6LU`7bHu`9-F|FQmv!iuFwS9?W$LsVv$= z0X`F&a)VM|e)^?kPmV9MOtjwamMHep>X8sj!FFbk=^wTI-ud{mf_+n+A*2Gc5%N{L z3rbOe$^Ho1)SQC;9NsGUa{re^`{odI{2n{yI>vkjIxdpnhOx5gal##XG>E5YoOA3rI*3lbsxn^VVgJ(_2JPKP81q7Fax)Fq%t&I<47@j1IT_^ z?zuMI9t9HvC-<;=8gq2MKEFgp3Bj7uS+u?t&6W;i{Brk(91O94>I7r$6u3Ru$wncFGkR4eV z5g1dJbBm|~GaaXA@HyCt&YZ16YIxU+S;Xeoq)-Dg7G8(fAx<=ppPMeUXHdV>{3jPe z^1~v-s6**)%TyuHT(e(PnzbWodpd#jiGCK>V~4tPY?jqI5RG@k((JQ!r@lA)$lYVf z_5GgylY1bM)CrIg2g+s<_mEbwW{92|FZV>I_<91P*+Yt2U;5K5ymoPL#>d<}4kdhx z`k?P5CSKX=q@`K9gZQddF$6zfrH#xU3;*d@9EVnxCZ&ehp|?>wQE2UUZqI-++p*1)IGnPXVnS8ck3y*cXEY6Z;@5mq!LZ7b=;e| z5S}0Veq9Eq_3NP@*=_Fa-lAu7*d30Iu{zgdI=A2DeFTJAb(54WTZ*f6Hw{OMES06_ zM*WEMw(3?WUC4dT$Ix>!&G@FN3rD=seKNxQS$M9)hBL-m??ScqzDgCjr2TGZ;b+9t@v_)l$O`uuyB8nHA(MF1VSU~8jy@OZ7acD=6#C5K7IatM zuF&{1_-6nH$m8!@{wlXuqQWpy4p%3i2S%(^di%nGiytX`$9e^F-ExC1nM!EQSEfou zzqJ&?E-tuAAbsHxp%s1 zS-#p%u^P(dunMtT&>M%`dxCIyWpp*LZhW1z+~)@PFVMQ_gU^vK6l;?>8PYo+ z;s*G{#vOiecY>5hF9tNkJ(M2y58yXK0v@c?>zHmfB=p_LJvy3wy=+0<6E;8lrg7Z< z*kljb>UnY;$YU8&1$hjE_mh>9xdxk&iR<~f`~S7e{x_=0 zZL1_DD-V;El9HE&Noq+*t4Yde%1f(5HRaT`q3RlHa$3sV|9{A}%l{mF!!0E*m4}@K z3jzH3kv^RFkb~PrT^}5~TGnwbE{*^$kYmU(&}XP+eLwvnW`4ZGWqTxqLm-U?Pfh6A zqGb(9yPF!{4LGgl-q(6=Ebk*S^O=|S&-A0~8!~okV>YQna3Hp486eX~WF)v4)J6Dj zov5zu+uvRm=Wok-wJmj^d z#@IsWd|Udd8fA+JF715-;RBo>{eE>9HG|zBT19TH}zdRvMudVG?C!`w_fWP|BjuItN*R)Qi7zB}9>0Jco;@Gw{873?wF<~5e{k#6t9~8a za*4|+=Ze&Ah?~D@Xg?`--4u=vmkjJ!4-6dxcHlI5-)PspaAGa2&UTKY*(nIzlf>n+ zB(gxp7E9+P+mx6<$`(WC4$tx^I~|JY9Hf}Uc#_DIVK+01~JC{EB_bq(Qf0EyV!?#U^vYZBSsqy1^D zWj{*gyF4W9BIuyq>)^f-T``x<=MgfhLqh%BX~y{Reo90vK=TjQerW0h9+8IF=N^0-S$2bpXEMUP<)@G2o{T0Tm_rkK*l9SEol`SAjG$Xp1x;)PK2)o1smDJ0_{L?a&|!|~DES2CFp4bw5GXTw zr;}-CwuhRbKgxuftsmSUF0vw1gZ(hUwIN@!VNMUgM!C44+spXfrHEC$RsA;~QC>nW zZ131q$zeqCpigg~U=2}EqGVwGTvKt(YLDePsUHyPsET;v-!5IotQgmK&<96Xs7`3* zg)d>sUJA^R8=;h;c;{oR#P%(k%j*@A#2GjwIP&KMaPizuF*wC@$niXAq5m zvjKJ>sjY?xeIW!Kf+1G6CisBWLil;oo~%h)gY){`0vPS^L$Q6;_8PGIa-qlWi0g@MUS)l1}!ZE}{VtxXt-qNCCum^%?P zlL@C39IBVQGU>+!Lh)~o{yL~txQS(e5u=sJ$l-Gs;FnI-Xf!eaVh8GzziJ06RplpNBWN>X^JE`s2bdgPkPO$WcWde5iGUkj^zl#!GN_L8>T$bMc z=xFhcsgt@Li{Fe7i5VINHVEmuB&B-Aka*0ivE0=4sxqpVpkw?QYK1YP?qkYZX{IvQ zPExPTDEtX(xmFWVZ4v!{fQl3lIEXl5?3Z3emV^e16>pTrlXlsCTzsQj_5KkR>U;E) zX4_n@+_zUJ*p1nAK2xF~d1035LgOv8b-w{S@GGf^Mc6Y7-UJ4fu>`sPU(M zez159Dpda;A3Peq*zk2|_>DAJndG}#Kyl9umm@(U^O-xbJCHkCDDsW%m7g z>0iwEB#)D5z>2;qyLVx?sXmFCE+S(!mcTMw;l(@q4fq{P!U z?iL+^A<@{}Vs6YOM6Rba+b5q3q8!#Wf=2;Aty5U(|ii~M}SHIwR`O=K# zgj7o7AEaX}=2IQ>XZlCR0ea5|x*s8x7G%TEOLBO}TC`ptWhmVo02A3EY!zpf2!h zSP7GS8|6cdf$o0ONy;!at+NR(Gx7V4Q+fff5324bA4jWA`k!!>m>b;xCKaJT7(d$Q z@GQ*zB&5bSR{nW0MGZy1lTw8jw-v$-57q~goXVl z?eE(qIhDp_oO zm*qFpAvSB`j(*<&;w60cRi63h!-a;Qu3LTdlWs*(r?!7SG%7qb%Ix{$V+T&QsbfMSWrbS&Z5BCN%Xd%gLAV_k6Uhw2n^vhS#oE0|#)SYs7 zgpQ*r@kvs%@uM+b1A3=|+Ucctayc` zHnQdZm9{Jrr&B8v>v^6Ot63y%ywd46$Luf3t5y?9bTnbSHUv^zE2*=O`FNKY>O^B$ zc{kF;&^?#@Rdxiz5u*6Hfa3fEO~&I;pqwFBwh`<@`wVX*ZEiI3;**eDk?mv~cSP{V zrBJb2d@0RPu(@`t)7MXZ)l?}APSHDkUB=zMr*#<@ zEGRQ9@H5njF&u8mL|RFlzy`b#j-8b^W#XJ~eHa=q>*P9+IvwCY2F&yXWn;n+uQCJ& z8!L2oOXtai?;^YOIejq6KJerNy<`jgWX{sDCGiQNDw6p>%onNy!dI7p4>$;yQO^v1 zz;*})`h^0fmi&9`Ho#DljZ`n?)aYcnzP8Zq8mu6Ud~huCmiZ7X6de4D@oB`j(oxi706xA{qGCFPYz8rb6sp3O&NDN)?zt_LbM$hDPVCK%2I_s(hk-`^TF*@deEpxms*<`qIbl z*S?R>DhjA&%SkpumYSKjAr%1&GRD&8x!!gnnNx5CjhQ+?W~!ojNn`scC-k+()&rF$ zS6@dV%D7st_MmO0S2U4t%8>%fPnASz)>514n?>&0U%* zjU!6tv7R#^G7|s#JXa3hAi>Pz&vX)b`MZct=O5ry1!S^3y8YfFwM zlRO%;kkIUHSm_Oo)D^0ys^`$%ykX9nww+bxHs`YfeCoY}tUs4vbge(G>r7~6opRSL zlz_iTZpHc^Q&x_#to^f;MQJTe1J%k(=1#tK8)=Ay@w&h~m^&@2xbL;Qu8=#Llj(b$aRU_% zIi}g~Cgn6fQ7k{VJXF4H$fA{hL&3WK*Agi;=zW*bohlC6+l+u@6F4CSsGP9HY_;IQGwG8ZS9Yv%Xp7pYA2hj*NWrh&ert#xpT3yv#JN zTlR;3D+Ej=37ty_D<>fDw*%hR05q!|=+iITIj^ya6a6P2QQoazwqEvq_z1Qb*<2m0 zvDr6wKCVl@U|@{&Zc=Wuy1KDLEJ|^yrfT@f!{$^7b74_*IgN^C0w@BOR!hM2tD8ZCG_q9DxoE}tF*p3?=G7sC&IdMMY_3K?Be7SAFG;Nx&EL);YviQ9}^amn8>!?Zt zjFJ&%nCvx-g+LBWV75zWTrbe5o=*Xjy;n-MT?rEykpE{&MgV3-UV9+w?Mel2+<$EK zeAY$&ftfaPqIV4WK)Uz5dQ!D_a=hb*B&dA5nX={~naIx?dhjsShU_ zjgf~^kH-?O#%cwC?FjC`SsPGyo?MNZY_?qOTVYi2=R8Z_{dcT@*UicIZ}9I30V3Eb ZDEMKJn>(45oTRL*JQ+W~ma#V3{{XaxZm0kN delta 256170 zcmZs?Q*&@(fz!&1yH4z0p6bEPm7f}w-4a;40%g3|z#G<6d)IM97(YHoF} zaLC{$r?NN}y2$N##yAdK-)BuNXoaBIvBStY9DRLa{{=;_^oA$e(~ zog2BPYFI*ICrXbX7$2H2l}CNVakQtk-6f92XO~MzmS@M3G6ryFjVC?3D;9N^w!FU- zZ(p6u7}%RLcb3ZL*|)H_$cQas&^%>TKHbpEOPdpY^E(6e-DS8x{OVFr$9j*ow4gE% zB&dJM7xzI88;WKs3n1F!khmYM_cA%f@t#kNB6)AA#5paG!c~J2c^FQ%uA>)2N_u{@2_e?onc=t|7xyE7&j3;^eH%|UmC8k7YT9ErKwDXh()lVy3G5LOd zv6v>PTOkKrk%7^g0|7^Ub$kkJH033=vPVG=!XI>lSYfkgdAMy%B2e%Sm_02XJPb_i zHBcgEq8=CP})AB(F&^SWJxI}jWPle3Y{c>!=%pak|sH-Pz5+`nbRI| z^hZgNmZBHyz9(-stCt_8ZX%(rd|0UKG>0}b@)U{G(sJGmNou5riNOZ56H5tzlU3GNxyJ{+foPN(tq}rE^Mg-&+~P|u zI7@+%(W^2sF?-(B&e%8`xV(N|YOZ6bQv)Su?~|sEDt;xV#4srrWG!Micz(gm%)T2c z^~IMyFVYtq%6nEtlm@JzYuu)ge2lSGJZa}rj*I3&&h?znNdBqum~=PL81XHOK2xa6 zPXKJWIf`q8z0<^4ymCt4phzDqNQZV@hHYS+L~7<$Dc$+xb`=uD%crJKml$C`!BTV| z%QJhWmX}A9jWvU$5xwT9EM_E z_p?SUMquBZ&rPd<&hTDsvLQssMNgX@Q*M9!I!z}ik2jpXJF| zT=(bF+m*m+i7go}mi3}+;KkS+8j>@u%l;t~_6-~(G|&!cKE?D(ft>&uw_{+u;88=; zmz0ZziHQFKH-aHoM_^fD8}H9}MKT_BKp%&f@pQZO{v-rV)>O9#6RPXnrjhLJ-MJS0 ztHWmkLxp4iWGDbE37r~+Cf_)2zzrxB52;6kstfPqT_LxA39{pwQFFF{^U9Da?580J zHlN1*ZwL}Czi7V$*_|+CiQM3&<@^%IrULoRv1d_wd;YF?Zhzo<3r^bI=Do~J?`mI- z;IyEt6Be1N$Ti*ksZ^1S|JRjx(lSnFZb2SoX-F;&aEpc^48jti|>TZEE;#=4| zWAViY-pTPbVCLCtUS@#JN|jGbWO&zlbVM`BS(SsSN?*ys;X6>XtcYXj4eFIbYs2DEv4NIENnzk+^u1poeM)*#XtF6(;$pbJO+KD87EH>^MMZw)Ov6WE0gIszB|_=@@# zp;cS#v8whII36CVHKGmz_`%yFA`N0?Sp0w!L-2CKn*A|#c5yN@vV-}b(cah^mL)+s z2pyc6>A%y226&|>?_3~(+;ySpfDXO-W+*T^)e*0sQE#muAVb?U<{uU=4~Y$SF#f({ z0VQo?aWEK&rBbG55Tr(EdDgWe|Kfs&z6nL$s?#;4Y0pshYo6;U2>Oi?RD!w~1_?rv zxqy6hV)r0DNbqQ2F*Q)83*7eM>)tY`3W!B1Mz1=!t9?hkWFN-RcQv0+F-4}xxasft)CkS{YzPLQKKB^tgwG}9z6fQ^F8OF4un!k@Icv6*hN`mB?V)Prw! z0c0Q-trV~T-0wR9(;GfWT{HmjOr^5rw1;ilq=%>A0<$5+aZY1*g zt2qmNmhCi8Hqo{diP+XuZ7!#p*0OVuL9b3gSGy{&uX8}YF;0aVJk_d-+mOw#{sd=@ zzwIi1vJ~MhAuSoIdDR~2j58U2Ke;~00%vm)fvPsF%?{j9dowk_9(oeV{yIll8uW#R zhTeZIziojXHN$5pFa#Af1NdIQf7<`fz6@`9k`ScFfgIDn>l?kFqq$gFP!c~q`^gc+ zbcw-iRdeT_e1i(ImTSIqF^z&eX%?k#+7lWXG#35oCcKtR62 zBI~bt#VrwXwe;CFDv?#!<;9Qi!?C)ZczMWpsqK2UpN;eM43-b~TuL?~C&AN+LU{A` zVG;=4y>kRZ!KgEJ^3Dd48T62-R?AVa5VRo?=EA)Hyajvn4sjFs^RPrzj(O-|_J0}i z{~{uV1P6=?iHQl8QO@j-g^MLIGaCnIN}V4lEl}5fMs6&^q^)-y)Dh9+H7oW+B4D4+Jbf&cLXMKoOoD}w zHG?SzG*l@HuCLWdPt*iQ(U_9!zzSE0v6g`ijn<5`k7$`m2F*CJ&P*jBnYAocE{|Dm z4@gC?DnvW&LI*~XikWIv?5_s10Chnl+grGo5+YGg-X!j zPR7!FPd{Er3!AwD1r0J$$d%E zL0%*id)7SBjl#;$tY{Q{ay&ivcSKAXPws34$6)<(A!tJ}{isTUYFIE;0F;)(DbaXu zLeRJzg}4HjGI1BErrMwWT=Gp~k4z4ZupBa@O*cFdo47PPRqS&_Il7^k``g9`MBt=V z3rUk~K6tC2f1hBY^q}Jj7?i$do}Fk4jt#YjwVq78# z`d>|Bn$>ptv4j_ttrhC(JyRF{J2NG-7xGK!9SBfE=-rwAI#>m+Ze^Q8^zTHPCUDx=`q(Y&nSdT1kAmZD>p}?H#Ry}2!Rcg*A>8e zWBtnecS8n1H89dHd#8F+HeP|>OgEMmps4oYy^?XF+V$p}JmrNPO{KJUh8TQjv}m^0 z+Rneh{*lWS^|O0FMb&b#haA02{?56j#E}_Cvd2^B+ARNW?fA0pmwqEXj``=r)&C$S)iP3 z2_<8Bsd_!qT#2x`V|v1@>6_ocC#%Ce?5xeLe|~GJ+DbyyVVp?P0V{RpF)VzIJ(3~fImC~ON|+6}&V{Le>jz4$et7gB+fT0w^@{@@GnIL(K4< zItV{DU!277bcg$fGZeU|?rOV>PSfd#k+@Lbbtm+PJo+Zd1nJB{`ysei`cDx4(RGj@ zinzCN@pPKMLe6rd5**Jrs9`*NIq$aPoSIP%+UV#)vd<7d1*V@?TWY@91u2sy10`$r z4uCGIWXz9U1tLY{s-%c#WMK9^O0aJxU7s|x>BpeZ#wS;;n?Ub(G$OpbL7N3^oPFh) z@zAAnbJ&T4zi`EqGIs>KaBS!W9G$)3sT`s-_?*#xYV^d0a%CPLk5r>wy_usKDbbt(FQp))BJNFmp9Fr7{fqif5jOgO8#X`3r%lTl%e=uAE2?#z6++oY}- z8W5rXc72H5nzArB95U|MPPS@W-C}H1xu9djQZHK;PiAoY7(yD$sOd5IZv41!V63N2 zPp@#&Pol9EOJKXUwI$bZwpH_6v3#oH^D` zsOyxPa!H*`&8E6Ju*Y`$+CsIoG_7TX(CjcaEr*|FwK+!v@v_t23uw_Z5u?omY+l^b z$`3VBEirSPbSqtz^#YOh{w1+;Y9&MZbs0?wv~*u@SvlzQ_8$aHoLWDb*UjT`Nx>V2 zYME}(_Jc{9(AC><2SQFq*8ZJBUwDo25^ULGp^q=o!2UiGK8g%1KkTZ}Ur5bGrmh1s zZ3ZEPnWX9lrl2`zQBFJCv~s&S;4NNUx7khIt{yydy+WErEQMLbn;DMiu1yI(zsOdh zs-j6!1@dRx#`5ZLV^O@{8jU;)b9+UW4b`&&^fA zP(o9`eoVIpKsj`9T)^ix`F5wR(kVa?-Q_k2l2i5A5(5{PG1YaTqS+`?E67glGq*#jL z{B9G#N)X5m-rwUFhm4(v&Ku3s3-7ejNwnWkTkxk_`X-;&g<@ke-m*gc2@c2wm%UY1 z%QbB&v{@vSHqs!Dh1y1`QY0`!QYBm654k_K-X1vi!*yP$_FP(}T{!Tg%Ct#_FJ!MB zMA01_QK2UZNeq+kt?rV9pII52Lf#m!`n&_c8=YM;5wMxl>e%5QzVx5#j+*ZHs~G(Y z9nO7g`c5xH#L$!yX8vD?!Z;sJsBz+@;aC0@?d$KcFZw@qe<Bjk3WJ@!G*xkDNd5zyhxzm@^V#(M>s*2+I3!344SJv-s<~pyvS2c@y5ycr({0SX)BfqKF0-qP~f}41t z%SP%zp*Rjn>BcZf%ncqV>JodnB)b7AQN>FJZDSCA(wa^yYPOh$772$_F&k0eB#`R_ zpEp5E$L8gbO-tH+bGhN@Y0ZCmL5BbNHL3MhCdFpd7OSPC&>`z)AaDPJ&rtos-_Ja} zR|{%IKu!$dnRqS!n&r5FFQ*&`33$mV6lXg4sliS4ubKCYmw6Fesq$=oXJxkgDoP?|4IVFB4yf=y%ow3dbU{1mpN-ez-BC{z?5Cyx1s_@uCgwLPQYN@ zh_e3_nNG&j?(Mwu>@H*OaA^a`>3t)(D*S>`yL|iuf^*0>NH?VFhhV6fVhYSkgtgK` zdW=Wgh21W%m}QFl$uy-RClDs`9oNNW0$qn}-;lg(QOcHNq-TMveM+ZyIHBP2m^x$& z9S2!9MI7Q_+|0P{pKk$}t$^n)?~#8LCM0wHZRLaN5A*Yy@r{+kBZWuioxIbjYJ^-z z$Xc&;;9bRX37pY4Oxqg&D4?=64^ogb-Kidm%tz>Xio=5Ei?dR!O#Pgbs!|KK{|w>R zSx6~)b8z3#5E271Y64GSIAI@^w8*v-nGV-vRstVrm}i?OO&v0k>vUMU98j{=?Bn;;7o-!x0MK-Crl(z&hlLHyrh5+gpaR;47{@?(CyeU_JbW^ zguk4fdLlbxxAl-)YGzvIsA4NMEl5kumz!Q2kW zGwmOV0Oa<59)ix%)=tq_7O8p%RILm21FtYo(?=%rt~KFTrTa7-DG?>B3frh8wBVw& zM5lMZNsY%wU<&i3AQ8c zoAT{OG9rG)EwhnErBX3oDk9&vkXokM(Q0*=s9|Th;iTk`<)8*Wmw(+h_GB~t3S1OZ zE&Yybl&iHjTi4LZlfjH4e-G8^d)<%-ly%{#V;V*$h6T_&w4PO$K36x@_JxvBKXz)0A%CMF_-3gp{=U<#QEwnXs3K?$Oc_y`v$TrQm9}DZK6D z*l^Ivm;ms^P6H5-c|wbjZE;^u`!_rM_}8$orA(yo?hSCelO((tS00A}HnUP0z9~W~ z96$mKAuf+vT3`W4X4fXsFOGAZOGLLR0B9}L8M{c{r%yvElR zn@Eob>IVp&g0MyB67p=o=sSmAR8x2J7UG%o*N;I--EC#pvb1f17S7(6g_RNF;zvEd45Q+FPT9`$M$BSiW^b_B7%^Nd3pJ7>gofY#Q()KC2hL9QgBc>hgGeAtO;AKJa=`9^@X| zKqgx;`tfG8dELM`K8NMgLnLQO_eY;daRzO_h3N%*863A1y4mnC%+4I@6G`)h<$F_O zgLcgQ`-YkSMVtam9dVOvK4wF~jQ( zm3PF^4+-khhUkDEtVymKqRB23mK}5X3d?orhx7b2K`>8OZoiX_tAaZBJ8Ht(P~O}D zLT#T*eOC$7&|3GUyCEwASzM7VL~kKFKhw@-mYo!}W0faG*dA(z!2^?>;Lf>`9AGf? zr$2iy(J%yy3;H)P!`)58D5~)@!R`i6Mc}Lt;;-&~kg^XN{#mn!IIKboI@-URxv{>N zDDMg&r(UKvq2iY=q3-$TILjI+wjA{Vr78X*`qe__Nuq$2&*b(*eXuNjk%!kyaMxab zFy}`Egc??O?@QPGEO6Ya3&>=QYT%f_ngE#&cuH$8FZunuHWxmCDXxM6JNGx1;UH72qi{d!3ACzu+@+??A}La7edxiQ=a5@Yap1rHxdfkkj- zOGt&fObV~gQ(l&^OX(34K&`be4})FYu449D91UHJV#XeiWFfCspA zqLwNFv#zg<5z^ju1;rHcE7QGOW0eAOWMWwrav;-K5;sGGcT{cEKBXQH97|oUP&Bb{ zp&&nl5yDD}4K9-LGL}gz`FXDvyvyKvGv_vFvEG(nGH)s|s{w9i;`&JSIgMOf0-D=V zG%e>@mNDH4%y%lpbXisMffnt3E3UgVUEDq3q?yKxVi+#=n#83jkjvb*1vt01}7uIijRwX z&RDx2`_L3XQ;@uG`|w;%p0$JAl*^LmFwWbTkl4=dY-(Q)ckt0W;CBj$=l!QM*8T_B zum5x1*A~fw<99<|!J~#b)y3KpJTS#J&^1RT1{$kqCaN&i=hGIChRJ9l8BcP!37sAu zsrq`>IWGsVVy(l=Ug7P5y|fxf2{%%uj#mZgANv&A?~1 zp+GR$>ImK{f;>>$nZM*i+jrS-GZfN94l@Zs{-2=mY&9yoG>!L%_~J`xCavi*+zw|R zoi~U9UN#KKG1+Yq(V*czbX>4s!FReBMS9`1TPk#Sfyy_*IQrlM%xwdBpL!8ylo<(> z9f_kG*s5_EMHz$o+$ViN)%hM24N!xj+p2R^Q`q5>E^sjc+`RkvpQ zyYjaB>^Jc&Mw?y%?W+^4-P6m_TGzm(}^ONyh?e}y_5 zOA3nDe}y`>zWo8mWmgX=mmwFlr5=!qfdSgZ{c0}+KvaG8T#E-aq^wdElQpieak&zU zezYpHRgr+{6)&cOE**zXQ^I+}-Ngvq10cZ9f;3`mJ{XPk)NIJU;A$ok>oPiA&AWN3 zF76VnN|2+|8tbVu`>CneiJAU1GLhUBduF=#%K_#i#2xm|L4(*W<`Sq4g4>4)tvl)0 za&tEGa|YBZsIDs8@5WqOHqsv>QMp{F@m(U3j?~TbRhU;UHn12Z=gVeHst34Mn zg<7}DT`lmxCoAa=yz&WLWe%PT5t*kKa2%2_rNB4Y?WBxJ<2=%AEi*-;$-x_~xLGNw z0z+xpsfYKzkhLST^5@+1`R zK{~G_-BtBA-8HgwN%%SWD|!R>6b`#JkN?q_AP3nm>*n&M`=T9FQATYDj@h$5UYK<9 zxDo1)vs7&b4dXArc7>#B=P{4Ej40qYWpHOv*yR;OWmKz2I8S65>HyMApbcRFvNg-C zFkuH$W()Lv9@8ToC53K+MQN_TV;>X7N4L${3bH@zkuB36T^k9Vs$zu_5>0jx%L$IG z-QlHWf2uy9xm`D2c1(4sk_*ZhI&1yT6m)IoK{DCxj}BkheF)Heh*tWq za#%N(&Wlt(jDqhCWNshA3>$rDWXAPOwYW8a(&gkIq5D%`xzlO(wgz(Rgc`Xag{Tl0 zFyt(Gi9zR>ErKpC6C+(_hf?A0Q8azIrMV(O#eYHD--aCcl-I6s?tN}HX4)36zFNhA zSBwS_a5%!Rb+9rV7k0Q>O9ko>T(DAY1l+-}E<<$4R*$z%J9P{@+Dx0aUrXk>YQb3U zCIO&?4R_&g!5Uw-uiMMmcz-)QbrEqbKb_5K1F^NV$olsRe%0rv&fBKJsmpp6)WVAR zDL4m+C#TL~hxW`CB0tC(0;IH(9RmC%?E^?C0H~_yixs!T9b^Ykxz8ut z%V~3NEVw1iR%Qx4{5;c1&G_RG0a`u$nl$Y$>|jXSYEC5vRmd~u^Vk%h&{$CP#quLz zU%7K*#5Uo#%^0PQY~qbdj@dsihrc|vklhOjmewx9HKxYC?b&pax2+p(jlfh9*@qBd zV>C5oE0dgFCX~CchJXbp??ox>I6~v$qWXeBYZskvRyBK)`az6AaS5eT#@p)^2yvhC z)CCIC*-}ls+Swr)0Enb9OCzNXF3uhmjqD$o`2I2W33-Y|0pp~)?h~y;K~gicCjn5AV1cOc$vu9JLnT3Pe_#Nu7qS+RIKG};uC(a= zEiI6PbGsAnDqt6`+^4uzmw7BYbA8fgszp>*6>WL`Qd!nScat0O`&9JxA>UhxlcY(A zrWl_UB9|_IjIG4FMw^{(p|jFvEtbud4V=J`h^_HHqPgTgb=T9PfO2~VdG^trV~~b5 z3ON*y?DQB}7-$NSY8wS2Wd`AAMRuBfM+QoOn}`DPAS~L15ZEN_^JwaV{{+$=d(eI#=@Dj8yCqWZ8>zi3-1;4n%|-Z^hW zLy@3t$Oyk7(M?%A$h&)G)?v_?FZOT@&%q6vUMcxI3CR&_7LS@_eU)AXgjXcw%<8F^4n`KOVf!wcWX)4h3vYEfDf0GX2> z?xtEkf1iI7x;zGF^Z@Xw>)FwFIC8Byx2l82Q;u~dD>-*`2rWa00n}R0?uM07%OodB zLT(DooW%c^#fY31P5$^#L+T)GZLzy7BItK0Y95>|^#RKcPq_a#eN8Z`M^Awk1^o@I z(z1&^;6VKD?jb#e3WHkJPBgGWbdH4e62Q$;!R4$nWX_SDvyvVMb_Mtb%bJbZJ!cPsx4%%+R#W7Y%l9G zBTaaj9F73ksg8%I;t8?I_C7B7H($2b!*zL5GxhM!94%iLpo3Rye7{Hom)Lm&Rgm$F zp-n7tYMme>Ww#|KoSYOs<1sQ@d6m)nw4HLLDO<9_=gB*EXiOB5W^SZ0OD%x8MvA*n zo6S?JFG(-?)gBB@c#HQ@8Ecy_qHUgAje`fQ8=MLlKAoml{-wvM~6=?6tT$LCj8DW;tNCS!2L3eMz0M{J_E<{$+MpKnrwS|J`ex9bfWW+A93B zt}9g2t-@hjFLtNtQMT4cx_T&`(c3DDMrFvQrN`E0)KFwmkMRCbDrFIAx}uov1}h3o z*68klX-OrHlT$MR3v6r38glCyrOSxiBWtNm211a0~0I?n5j`Vsi?Iu;2ju&EMh! zd^!36_st$GiK1t8J^eTC0RxQ769t8lR#+=!1x8-1xWWxFc|=bIjqu|M0Odnw%$EmQ z65V!ESGlm2qI8jzEFWm>RZSg)A$?dyy3UFsPlB#oQO5BW6a+4&kZGcd=4h<77h%mK zLzC@Pr>R!t&Fv0rp@!}FA$P8HcjBF4G#HNQ;uwy&c0xaGip_j~fwT7}UmP+)wJFc01(VK!zon0LFL&K|gJDLGJ#<^NJ=HN;U? ztx#F&RJ}X`B|I$(Y{gjx#{=vRv?t>Xmq)INI%IsZyyOw_k6#Cb!)hULs}UdJN@rsX z4rmnj;_!x|{cd#CAFMT&RcR@769k_G`2KYE$GAB&D`AqVubXX~Lux|FSh5lrBrZZL zOS`dERbpP!9014GW6s{LZ~rFoN6A>&*PeNl1h?MAC9~qDLB~1C8S-B1FwLWrjnqZy z)w=Y_)TORzLFMy!2s&f z01fwTaABuq@Ft_^_a2kOo=~rsP`B0tDTZsyhK~&mo~Z<_0pnLbeMl3`_-wRRZFX8R z);sgNrDCq6HV)>*m$cw1tYF0gWMeB9K_RF8LwHZ@fuFe_GSSpL^;A&jzub*1+2|8? zaU>*UIDr3tPv8yT`2N-5t6dP)V936~M4I3=ZYac*7u8AChmbART%bNEfM}%eXCeN( z=BF@yg56p7TZ9x=%A>POic9X%+DB;77o6scqeso=Jmx57Sx30(c)$Bp0-I#=Hr+UN zUd-qeI?goNFRZ8D+|czv-{SKz?eeTQVZ{JDx4?>r++Tw zUL+t#c2dPwuU0mJx5gB#GE`J4T+i$B{#P9wFL)j9i{1yngRWf0bxUcV3%;GM(=u$w zckv2lTbrLQ6ejxU8)Rb3!EaAsh!EL%P{O+oMSo2x7An^h`EOD^*5d=;TNq9=!^p#v zC@7G6)rCP!yuXEQHKk2VW6o?``Se8DrXLT6FLxV2e9E{RLkF^6gVl<|o9+8qXLkN< zBO8>@u->HB0hec^-?RuP(zbiIL{_unRAfP2e{=k_u_(XgNq+v;Zq~-x{80iG+yUBf zCMe#k#1gfzNm)^SMIGe+JTC_u(uK+%YcGrsCIUtD(!d=77OzZ%l~r5aOM4S-;d+e= zS5e5cw{kl@>wN3+KE}-YU!OHop+^JO?WqDaL^&E6A08_c@pVf$B3!t_ITykoA z+4EW|fd82S#3jhlP~z4Y-@LG$Lf?$=5zO!7d%Tjq-ii3+@nqGC=|sFh8{E96s<%rq z!+*?%b(zAy@rA`dpMAre40= z7n+wj{a2^&ik6SCUs?MzAzBk&14*jLjVQ(4$=%O|80r~KZ^$;?A|I6)ZL2w<(KJUe zvf9;tCC66D#JE01E0f<7eVe_hU%rhO)yp^E(DB%Gg#XKe!OWT94~zCc{{7Y;oEE5Q z_uo@0#^3WM2QB{3WJLWyr<~KEbJ6bvuy)aQr!?idKdW=l{e%jp^*cFSfd_Dhl@hMA0 zH#M8JCFga$u;9?}(nZMX=5pFl4U@nyAsVGz5)x&p)aU_5(O4_<7*A3+Bu7 z2B@w1Z|#rH-(0g@?XBHiiy`%VCuK=$MWZr+7(VT-O{<|wbPsjJ7t^jbEqvgV{I37i z-z7x#n>0L14-LLTzPjc$s1IzYw(UofePo9XopqG8zaPoV`pGmQcdA8`OLlAYcy<*U zpXy7Qr%60*HkiuMM9t-ht+ zhUi|me-+^EFKze;%YJ`MZMK1>5k9|r1xKh-HXWuDT2a^n1jgOAZr_z5p`rKdY4`a8 zg#>PR8jX;%_uF0O5GYyJkw_<+U>+p5$z7XM4BxW}`3OyUW=9%Rl1G4gI^FAL(f2L% z34yXO!TC76Qsu7dr7+eJ99Y`v7@fAgBAE-8xNz)5E3Th~@+jKB=tE!H}%sx3E%^cT%j#0vRkD zzYr=$^PcxqSIxl9O)cTNQc9I~I!0-virdY*@Xa$+5PyIQEgmHRW(so)cTFSV|8jCF84^R$O+uaNl6k>cG zG{DvS?3ubqVYzWH-<Ro0_+3b~6wrs}Acd9ZW@Vd)vvkS*hp{9&yX;d{#JC1OYdmgQ@n2qUK3zdTavz)H0YVtD?MFBb2MJp)n(kT;b%`6U{y~3W>0#P)=cHif$cm z7FxMVS2ji%yVLDm|6FL5*l%c+H;`WE;cgjRESSb+nI&L|jyhoxK-_M_0rhYJ1QH&a zufd5$6f3Gzj5$r47|AT260b6wS&tbVmzL3^Vn$eBM(ZC{O;nMj(YfX!5KA`HHq*(1 zrz_PXRClW3N!xP^#q;Y>`5fU4@s&Rx@^NLfR6|K}qp5El>TCNJx8A-H)U|>KGD856 z`Hw1(vJE(&K{tZC1y`7~q_8vD?z^Xue)ST??Meo4)ipSWKB-{59Ox0v7J(>1Mg%mh zs8??1MmJUwmfZh|yIGpMzz0 zJLqS>#ElELGUc$srfh-#)Df+#&m>AWgzaa2iUNDsdOLof0 zPvvH!R3Hv8wTe+e1E#1O)KCHy`H1x=c&#zuMzFe*4ik`w^liW=IWcRK>z;DOoo)6! z6dG^+rz>9)c65CPY6RZ$O_8OO`h-{Pv`CG7sfqE8f0j;Echzm%0fF%+~QruZKW0rxX?6O8&%27-)0THsDw zHOm#sU3Lo1<~k1V>U|D|mp3D`r0A^PtW)|Sg)6%F(ZiR)3Pu%vK^|YJv!hk>?@Tlr z3+(tDuN8H-XKy8A&|A7im@iJkT{6}ROsUU}My=MbA}d$hsQYAx_a?V;-jR8c;Yovq z^3Y%389StL1Bn~qU$@QrC}~?Bmvl+%=vkRyO1*oFJZUwjsy7#V9+AP+FpUhSf-hQ0 zDXX#089>%cH{FC9+#7A06d zZ-kI=@m)UZyPAaa`?SOP>u?b$sfW?kCV~9>m^`2!Q;;Mvod9AG-H_E8V=~BzHPU-|i@P>ZWbSKLR?0jhy(SmH(t-0l%?Qin5u$u2<+X6A*0R z-n4bDAWDZ&R)BAtVLS)tX6bQXrjSL9Q{NuqGexM!QZ*t{>P$%B zw#f*xc7x@@t4z zR7W|xdI#>9xcMWf1_FpOwh7U=ivhXAba`{4Kr_M5K$9yGx+{alJ&MHK$poiKPrSTq zPd)hHbz`C1Ezq$OM!@?BiC#AiUA2lONVZ&Glztst_r7&^d;nI@nhmj$_f?J0f)I8v z9Yak4oNPHnE{7hU-@!Qg5C4?X`YF>|Y3$igM~^|N2J1r4VxcgBD`5{;QZ?xf<$<>` zdBK6#X%L~9=wPZOVpQ!)dMS{vA}+3cS;yN`pS_oJ|+@r)NHAnx=lMLfB&C7DlnDN*fd=Y75g85Ha_Bl?WGEgvt;lrgnXP^41St8P*=nx0 za)&lXq*6zbx9Wt-?pQ4$o&Jz7J&~{cfg7*sh`Lbv0}PD}aqj_`9Alq@DKJBSY99>vX0NUcy_FAa%Z zZ|=O~I#tnxYNKbw6MWY!R~#fZEEI9V!%y-p&2tm?6mEMlvWajddQ6;Pcw6NW%XP{8@mJugn9%rZ_+M-E&sMq%o#hnjoKsl+Sx~10;J3`BS*Mu zShk}mD+UfBjcP%9doSWOe~nF0R1y(~;IIlNIf@iW7%y;zi_4L9(tH*V0e)iM;JLM~g zdbaOy0ryFSpS59Eo!!!fi4^`S*(l7cbZ``-3a`#-nK>unbbSORORqH3fM3}*%$(<5 z)Z;RR`CY7Ltr2*AXCa%ld*`?r`du-aGOD+o`>u3u>^mEg;%P}4iJYxS;W<$R=L>nl zi$CIm5%p4$jU~n#)(AEf$vi%eOY!``pQrP6sm zul1<^!slOl+nzAs7eCf;nj`Dm*IJA0Rb2LvorB=5?ZAU~?NLmN8Yv+OMGWkd+3=WBNh+nAfZJUV887gZVx{|3&X=|Gm!=zR&Jd zxx()}r|;i*Y-bixizKq5bA7Qk)w5k@$(S(VE3V^_iDjw!#~Up`A0^Yi<+>owNlY*n6c~i)-5k z^=hacEeS|XaH&}VJUHJ-8Bc|kAfq+O!vDk8I|k@|b+qP}n zwr%d%$xd?jd+vA7cdG8K>K|RzwN~|??lISxV~&vtwHecEM|4ixA5Z&+m*y`!ZR(wv zubL5Hm+9Ky`##)MJv{EK$jR+TWf07)dy^5Zn6mm}=-qZ+mMkr3n&wp+43Q(WND|~! zfNOb)a7`!0Qg@pkl_oK1-{muL1^BiX_Ja23WmEj(@g`v$8I^u~GIK+(!Cs;FIFgHeLJjHM70;CvqeC<8m@d z@*#NF^7-VNt|{T;QmOUACgo3V{YR(ui)@8M!c@Van<+t|e7*8Dh4;8it#(S`QUkx5 zj2#_ujpg36bx27PalmIluc4GP*0R<2Sz{zq*V3Wc1}MX<{LK_8il*5lHQUZtV%Jkb z@tAZ-n%6BpEDf$+!5L7R*_{+-2M}$u-b#a<90L|60p#r4`xf+;DF=Eg`brpMp=H$p zRs#aNFrjY8=F#ML zVam$Hgw@x>9%5F#pO0fhk9LiL&&QS3>))%cD1iDE#nx0?*3@ILXNGw%F&nwp* zvFiD8CacP!wqiJXJz2RZ3`aX^BAXya9m*|kXhKS}59%tfm7&e(i}vr`!Si00r9h}e zocbFJQjk-yGC5ob!1&+@X;Tu4%Ur`QGV<*PSu$$-(h-U)W=xO`hO}|4KU{tR0RlUY zNM^bh-)BS+4aa>s-i$XixsXZ$Q#p!{+=UaQ1shh*YF@oC89$U8UnJ%H>JmT5aoB5b z!0?DE8CQye%~Fo3Bo^DUn^?`thP6VdWq7k7(1RB&HGIqAD;WC+u)sgi=5HpWjQAIQv(Hp9~&sfS07c@=* zU740z&Ph-StHbTM-;)<&<^1^oUqt9KUVioTJ}L-mM74B8h;<}2P9*-mNqC%?x(gbF z#9j5X7qd|uV9UZ4FZu_O8*}swMhdOtUqP3^<0OH=?WbMOrc2J19~f055)zw-o*vRr zB86Zxj<-0(*z04IJhzS^k7+fk$m2ABUqxEvkCA)aA9-wq$CV5j4+>-XQ(iwti0#eQ z6m5{des#v31bP-uXAC*?wi(dlcbb9AoEY|e$f%zPkVH$rW8or=spjK~uEQIrIoG-t zjHwU#=tYu_vTbe1|F`GACwUpcAe)P%kkl}vJWl0D7UZ7LdK6so%4nD41+fMd6Ec<= z69Eal+K_{9D*=i^pRaLzV8RdcvACCSGw`0^d|Nw;qB7J=%@22KdaP z7;4>s5q;p9chv{l36+n|uN9;Pk5&X6(9&=Q zW3&1OgWwK}vp(#GU1AP@O7{%`1rhlD?S>d12Mfd|HS1p!!gIZHuSH=b!T5`A{j~rB z+mkxP(=xH6bz85PozYiQcX#Z6#Zt#LfA#u04g+iG+CPbL0+W=`N*X~wCY+c6sV=MD znJPg&56P4NB~Rm2M6cNzV(-mJZC)*%*=xU>03P^Kf=fmNffU-&mO|!`q&!ovGwHP# z>69;tmOb)>*AVZ(_rN*^HjVN|8wh~UO14*NW-7Xb)G*a-RQHQ_Y;-263njCzgiXMy z2fRS`fv&*QQ=6xLrwWe;gz5=s)T*33lAhIE_@ZGRb6Vo34>BrRt2>u=D%!WpM=tos zebBVC7N_&y=^Uf8zyuv(0Tk1lYq)V9L#&Cgb1Ir;c?%;}!99!~mXBsM%|oZ4p*)|m z$eUiGh;4L@ZS-|zo$iIi=g99^bF+7%oiys5oNC)NT8uVwcjZmsZ_zi-|BY}gtXzbQ zg#U5F;N|^qfMaH1`Y%h26wIl_E%pa~gMzH`P2`!j@tVnjiA}9CU7eP!d;LGlXrxA@ z)l|wvLJHY+dwxQsrdEmBK&;p?H{t@wbO=$F_eVRgi0*Z}rCDO=>SD^Y__-L4Xd%DV zY1zflPJcIgtTXUKI5vNr9F%F;H~9o+*frKuqU4Kk3N*WJ`POj*hP$JJzq7)+3~r6n z#iKk(bI=Y-X@7Ms?Ti@|j^MKcwENZ7=yRc;o5v41w@s<0uSVwFe|qP;@FRX`Gam>f zj1oqolj^BWC}ssZ)v_TkI}B=)cwx{GMZ?Qtx2wa&)IvP<|Dq$m zQ$=Q!QL;maHzM}}T>7r2H!@rAi?K=`@|tw3kCNu;%)OzP}MxfNLYN>(U(hf!MXK(d#Y-xY4aSa@o&X%7lT5}av6B0aU zyL4_8@h?(a<{3^C3zGr~0MES-IJB7wmd)kdxSDvro2B?;t%34!AuBaH$Ajjh?%!L> z)UouGg4(qJ<^q3LLtJ7s$BT>IWx8h_G_MRo7#%`;9qlGn8&1GYsDYi;j%4*=dPR}$ zfVqK>4yd&J?9J&7;59ZNq;9mK;C;czY=#y2I`pda&8Q$WZ>hWYm}3Vs&)Tqc|O>Z zubK;-dI@go5#PnW-p@?1-ogEY?CZJZdow}?Y&0V>t!b)hTovoYQ+A?P)4!C<=#>0B ze+A(gpiKU^xnw&Eb?#24dq5y@GQpJB>3llZf=6$yM?n+%>r4$!y>~Y&2_nY`(}WjI zf6Y4@QHjbeIC&ER7b4mwj>uV@umg<%kNyN}hih|TAfFa@YuK26@f}hVjR|#sR4b08 zdu6tF9;&&Cn}|E&#F@3so)qb7eAU(&X{)6MU>~dEP1*@R@`alu+N9BXZR)9>!~MH` z$TOko;pCFo@l`V`so_i6Qi@r>(3URe-1C@}S>5v4YmJ*Ch}2d2W!Lsx38MQDOOEx} zYfNU$dioyeZ;<}ARerHX6QJt49DX0S(i2s>!$bV}xcmO%Q#e?#yYWo` z6rWuS{5>1O*|-g}t&=~~CNQVmx0dpMk#+V~dY!TUK^h|Kk(jk;ayRJm&=JTyy#Qz9 zeHnTWxo-6aQ+Yvh>o@aIZ)sI8%DqppU>G9>$V9}W<`M|aXehYEELb<2)>{)?Uthfn z^mXLPgy+WMdwYmq=R}8ee$TjFHmK_We7BIQ8#K!7FEbPk+GFXxj0o76`uH?vk!~qg z@S=a173=ncM1@(8(lQw9Il`v2ZA;`#I zwxQ@R^ib{3HZUp25ct$x=1Kvj9y7zMeC_pQJWB2MldYk19{J?h(~sbSP#p|;NWF!x!^ld?PQhwc4z%{O|Jtu2MqJ09 zWTcs_IxoC#D)mt}r-!r{m|#6+&Gr~@MHXJMN5~W@C~*%($^L^)5dcs>j%dT{%u=7U|usy!Qro?Ve6FRpS!?R2*y1}}I{3eAUeJPA4F6RrI z;YjY;indX}!f4_Q9QsHMv&+Zi(DB?Z6@r6V0LpCgD>VM15tlG^WLlX3>k+)yzL*sZLZPc_Hg3`fGTVyEh>zp>XQlB{D%i?c@$$@z9=OhZ|f zo_E1`w({AWvNrJIj2@9*AETjaE%TH0CG<-o&gAB%$6NO`hI)z^!yy{anX3Bz1fxZC zyRD@$JlIWiV{{0~17xEig$CzF??u-jEDEv_S{LN#gio_ueO!nKa2q~0GGDQn=E;0b z$<;b}vJ3)3i)5D*pi&?nJpQEIDnC<6IYc^z zd!vqh)Z-^iqak9;FhiAYi+d{e$9hc6pOqmHZ#9RLiy98AT0gWoMs}21aF(-ch;OP$ zH8jKrP55iq0e}1=?pn5j0J%2`-eibIU`pa{E<*5Tb_<7?wzA@T#- zA`Jch|EQwa(vP{EklSXh$ov#0=AQ%*=@p5c?u%h+Kc{cs-Zx5U}iD z>ZLjep%b-45~$-F$3CAgeo4lQtZgRYCZhJ=j27jc+f`;Q#dN+eb=}_X`o5)`bBuJZ z4`*d{9mS|yP13E<^x7j_gB}+}u6i9DE0#eMM(^f&HYR}eoxQY*NWb2%JI9Q&1$P0z zPQBVgS+TLv`(ww7Cdt;XyZQEqw$ht@FyWhkvMQvTXxZ-yW>-ob3&)e+8DgV&e*zp& z62@d!TzEf05x?&1wd*Ke30MI1aMdoY= z0bE+BbPr9zpbFrs15)z#)XtklDL*Q$)u}Y!S+-ebTKSV}6iI#YEa|;?k zebN?g_JEGSiqkv=4HRHmc|1IQy_YMWu~|}Wta?`S>fEE|mDmNS>8k(OkVoa;%ZxK! zx1{J{&^FIzc=zrZH~Ii_5k)mW9%vNs!L8SEvl2v*tS$V5bXoNpkEd=z`MND#biG)kRQXhAu9+TEUDP z9J3oQAZf**$bjWk$gRVcNYc*q#1c{ORbF~Q?pHJTK%fTNQ#*@vi;?2%=SHN9oxt3h z@fI$xj&&B17qmf57cfGLv54PT_ibj0Vtdfju&JPR=L&A;q`|RiVF7h-n?o$O2P7H8 zBkX95AWjYG*HPy2D!jp0f9O!L@gaJMV$3jFae=bD8UV|JgY7xj8sQKYfym$yq$EVf zf&)|+3dCpPWd=QznB8W$Jw%Q03gj3m5n%)E>m76BB(pMs2VE%MRLSVQ7?%9+us|O#xN5~9D zp_w#b0QXLbfV+NZdTW0Z{NX0~6ZN5_Bccc{H~#iZ>@}#;)5FLXT3-G{YI@|#=z&yg%3M@p zZQ2P1MhraI(H~g)L0cEr3wVGu;?M&jKNEEUz-z_eW{@b0cxypoPoR~^`s%e4Nk&2m z#T-s(fJ6CMhu>O5$@yzdxJ}LR$s!gn{5DNLI>?0k3UjxMIDgWO9TvzDi*f(Vaq~-f zSs2E#YxC?RfK&g%Z9@B3lE!5&?a?creThkXSMH+#9kOKDH)MY$mr{ucL2F@fvVI*V zfS?+5pWAN(Xa|SYPw~6FVvvZ-n&8Wj*(*39JZ^P--ijXKvyJm!KA!Xs7}x;{aY7;S zJvdOImkv-Dg>!n*14Qg&zV^DM!<90|H9=yFJwkZ@J*hTH5ZA%vUD zjHhv}qU=5y!4zm3)2=Ml@R2iPI#R$PKJx%`pER@dj)I9bCi~KdIdb zU3goF0vIs+TN7!z<0LS2dHj!CLo|>#;0J0H2xQs`+i)<15O|nH4TVEq`nwc&?2tAm_p-$(q7& z?|vw9e`{0waLB%Gu|0koew3e#+Gh&HzrIS7Dgk0e>aZ#atU0{EAC8U6OGFHg3{8xe zSvB}IG?Kso%jyMSU493mM{iSXWmRltQ>-1G+(eI?@hhN(H`2D!aZ_q)gHg>g-Ku@; zC)$Yp=G&vjz&?}UlUz#~aJLj00|5{TKuIgWBT9ZKq*`UNk&Jp!l@QRYh>61BGrbZt zvkEm<3F>TL^&GZAa4Pj}&%LazJ!Kw~OaOJ0!^8hhtU`EJZ;ywqAxaW~6DZ5xU4%$( z>lbCl7Jh7;y*1~qXPO8$Z;BJMy^*3#W;g2vi&+ZfMq&)^@p?c2_=n8ZV`tL(V_7Y* zSqx@7D&O+oEjORjK;CQs_3Lc3E5So?y4KdgWE_4NQ*XJx;J_)rl@Y+ywT=+@-si)j zui9p2x`^ES@A-ZQ5>RsDW?}2WS$v-Q2<6;u)}BPzyISwn87nhc{S{P~5a2sCT?+mf zJe6FTw5je;j%2?9e17_of9H2_Q{;H5LOFd%o&^3V9sT_HWGx?HD7>zx`H6U+q;Yv7 z{6R`~E2d)WY_?xG9OihGYF0a1Sw8B?vHpGVvWTFCP6v}3cweo&>a2Z_6BA@*cyq`M z_?wew7?t)DNVlu#ToypD9kmNxaPq9?&Z{I-$dR~z8la5?=nOhLXCbL?wg(qV z1On9pt>zwZ0?zr==JbDh@=bvigmhe3{+vXZGVn@1qV@PNqR%O`5nqF{1*3tFwUJ)~ zdu5cwu`@ffz^A~5FvwhUAjh5+9b&=tsp@^!rr65BpYnx0nC@-)r{Kn@Ih-Lko;_9? zv==bavJXuJ)L^{DGY_Vzn&GJ1*VE4<11U-T^`=k#YiVv_b$g(xMtN$(b749cj_R6i zuchS4$*1-BjxQVF`c_e9|k^}g3J15$x@ zH)OF&3Mk>~`xPXJ!2Wjk3uibxx&MFEh5xzz52?n&o>U--n&i-(27^`y*!j7d`6SJ0 zLhiAF#Hy6g_5L3#{(AvOQUMtnFxP((a3z{M|MYeLu>c|FLaxc3tv&`uj_aa#3e}T4 z8>GNeWq-YwKX!U8;~3n5fCxkf*mYM6b7<4xFw|klp!WmscbR3*lhRMUp(aQrtT|?u zz2}}j^J#0%gZZeHIgVyM&>@S}YN?BGCZ{6OuXv_lc%C3sU*(ujoYI*AfG{0{g@NRF zlrXsoFqj=&lz)-Uf|ji>c=^tE$CI8lE_)Vc07IaZfl$t8wM%b-oN3y~X=Ads!4~tQM!Jj7XFoTJ>N0LpMRlW|s2K z{(@qC1H?jvObUVaC6dDdV)}0(X9|zW2%|+zqPafgg-n!j(@fZ%v9zhFayUhti<$RT zH6$fs-CpUFrqj~ZIlD=J$C*bPi8W=?g1*dpz@@T!-I@6Cn*HrrH9?OchtL|Diah*E z@6r0eM=Uo0BFuGyLkNVppv3MDYZ4#!78Q-L5<2${)z>;Nd1T23)ORb;$flyumN3 zbbyqh$2^AU;((nl1z0m2SGY?faxE~7Tk0b684;mC@Uds_2gzzmhOIXOuA18-)vOe@ zMHK%UfX#rK#unZ|Wf-v45AxQYxq!=xVGvL%jIow2m3i6%oZJ-ZCxN3|ErE=71tpE4ovd%Q+{inAB5qKZdV=PLsgQ4_2#ie-d&i*;VyVWjKA_KDA!9f| z`C+lSsKxUu?wN*^aWSVNeft z|47NcUm(<9uN2cj2$y<~hzfagNqqT;{NrgceYhmHQAB&qz+-hrU_;J0rVQtyb@-3F zQH9L_oj7In>vjD7zXNdY7m{)kf9XzJZCNy^{k6IJh_T5=;N+-Ys?BS`))g=>0DauV z2y9uy2xJ@Kh}|Z`=?D~8xsT6R1{sFd%{1dCVM|9j!{%2!jz{f7yfF;dCiRz9nL}8Ggq~E>YtH*pwRZo-*=cPX7&G=9TFb0OaQ4H>#A> zYc=Zi9DmSU>i~OPXThj@+f&;-%32^Q&ohG*zk*U7&e)$d$7U$2v$gqm5l_K1$;7qw z=hgrF_)(y&0unAW10K^QqT`C#x#E^~Wf+pTgGt8N4N2&=a$j|KxxZ2hP&bpdOy(2UaxV3=D_gRe<CeB zoh>aKzjMFA{hEpw-jMT@Ukr}V0rF-YizvDM6lq^sma)|P<+_CYliwQWLnMLED&X#M z(A0uj%=)7$lt#O+qK8NQnm@wOUQ~yF?3?%;dYNosMp~ITWS9-TH&D$Y|3(x_MmAd8(yn>2eEM;DyB>(CACeNm*PLt; z*Is$}S&9{0f#J8L(p*iFfB*G*KdOQiIG0)+cD6(TjZNgDi;AlS$Z$}orF`A9STEI3 zvY(0R!0t+3XGB?pL|cylp?;v43l#|-^a~nWH@j-h{VKTHB-rUk_o9T6n`k%#$vUqS zAZthG#3w{rlL{0iX+FM`lp#c3%k*pOw=Ze;D1T4ObQmB!Bqd#){-yo910BASq{Jdq z-Bqgr-r8s_a{<#EaJx>oM&dX3Kz(F6zmvMg=@{m+wr?nRJlfPKxDnmLX(cwhaZ!(VY@e?!gEhrrJHmBS!VEI8K2NKP?4JDR64xM=3$5i1vSv-H?WOkr*DeB0a@+VF$fWOI* z%f7fxgE&nTP(rmq(8V>RD(~mgLz$$u5EU!C4iwfx5<6?jz@5BOA|)K8|0sRf6&~Qo zQR7)6TR@3T7?Xfv4AF~)IaMA|mK#g}esS!?W*@3tdhBq*yvjV|XKRI9J8ygE`s!;b zVVz*+bMjBxpW3B8I9Rw>Y@VYuL9ynGs|H&Lm?^^tM3S2`9qCGcD97?EX@1Ro<6o#_sY}c$^1HE$T3QkGu+o<0v&bA;_Tr^E7GQ)Yb9O1D+IZo5<4h4XPG(e7ko`K@SAl+ zr`W>2tV{B^%NMs3yg61v1Ad0tTkc92VC3X#$nPcwOlwc z`gPO^GAwl2${p9QA;_&v@#}(*9xiHOxYP7}XWs zG^cb!cxAc$5`+L6mGP(p<+Ku~rYX%Di$#Iw*~EB$Rc>m}6)jBh+T0RbA_Wl*{hr%3VSkg=|U- z^$oP*=-$KUhU>wy(3Z8Z=jx03HpULOGA5?Mx?|I)CLX15l2KMr5uF8X>8pm1Z%A=O)rN$`-iv~g@E7PkJgAONM^{3TBtJy>fc~}@5LM%S5QVEI#*)G(q zg9)>|GYT)EyRuOTo*80okXT~6Orsd0kgV9NP9x~_){ZUNxy;9!|K zny!3ciE9eFPELn6t(glN&jq8$Cp%)8h#`#h=k-1*-d1b0UuNs|sfrMp*#&9khJSY# zX2L>PimfaDR9&a_gIZK+QL}ec;&}zVSKU&pwCL9WvpH8fhf!84xVOTf)A3b5DfiUK z8Oj$prAVu|qeFNJxXU8a&IO>&unp4L{=nJhg68RChIOK>YR8e!MCe4}rE4G94$|nXr~C z?5>TAgI#Slfcp%$S#CDK-x)#2sNytRWR&cTyMfzbcB9sFl54Al^9EydRmOYkw7U>Vy*N;6Wk<(hG6v9BZYg-?$@SGsyNDdIFDQH8CtSQFJ#Uo3P zTxX1q4DpYwBIb4jE5rzqQQxga1m$!Odh4Ivo`ctwYtNM1bMR$yCr*tn(&hGwj;uM4 z&=aAM_GjktLxKqqRM;0J^KS;u=hg#`K?#Ypm0ec1 z?xY1IH^1}xZ%C-Z0hUCtx`|DBj8Wca@Tio{4Rz$tP;N`vG%10_Lha*r^uE7_Pk>&l z#VjPhV2soou6iQ&3GfEAiUrwO5Yt+P;Uf^c#QFy?qShUS3GY>X+$&V8O&de5sCx?e zm8J7Ish(nUY;coL9oP#sD3R(fpLCjURb`U@j?{L2D!(JgUc*& zBK?nfRpFFPm{Wvw53+7^OU#d>GfHSpxZ@^Ff=f09ty}7ErD7DAX0wyk4$zrtDbG05@D4irbhE~r!aOM+hz9*IU7tEvDJ z^e>=X1EW7$-!MCiMweIi=9hcY>r#}`j<4R+&0-N;xJQ9u8$H@&`Gar)a-X?r<+L3E z1RHk>%xcavveP$Mxy({4$g6!o#9l@X-pO!>2Y|d4a)gLIZKj-R>L8Dt`Y(+m?B?$8 z!vfU~f)x~<7RJ6G%^i!Li|$v2xnMq&nQFi{RU_?Ger{cjTaSW4IL07hzu~%x0guy4 z&Z%I>As73TiS6p=kqsNscdT+ADEXgRSJ@fje%LVemGtR&>(wRJ_IcO_8`Dy zkNlf#9_IJDC$tZ4sW`F*R#ALL?DhfMl!jKbfY8~e^zM7=NxRzN#g#}Sb(@rr2jhr0 zQ~w^tJcJPx*y!Ps%QN1X3fgV{j6rOElA~nBH>E`P%N3H#5Ju@Gim-{AkWMdM_!@mo z@*<}m#$EVepCauP`Yl=j*k3qS!6ow}ksXI^!VBjQ>Sw=4i_2_ASyoJ%=~783v4lcPK4{9R1fKX<6h}- z5vz{zpM=`5+-<`whEfaSz&Pl~hpj66QPv}E$G{U5D21vNw$^cSo%g8HDZkzG&@LSQ zo}F0-Ar3R*ti{@V#`#4$V=&?BZY5%C9?Vc{A^!)7b}q6ZMtn;IAkD1aD}%mT^%R^@UijM&G;b_2v`mJG@H~zeD$>1dXdciO-w!IBgbVg=UB!dpiog8 zQf0JD;lXoCPL2|R*IAUf@I{mW6!O+if~y0(CulL4^M;TmSKC`n#1N@Umh&dbG5HYd zugoH^ToTMcBg_&a5-gKW+)z=q*6Qh1#VC42MRDI%&Z-OoFsnkXX4-&a;wPmpDH`zz z6jyL=s`46wp4X`R*KItHra#;kG3`p3*@2EBK)IhI(hx-HAABG&MY(e zm&CH~Qabngb>afn{0a|ofY$_^tfcnBz8jW%oQtN7Vk|3iaJ@pKXvd;mSfZWgc}$PK z@$5}fC3C+J0843cB#gHha;8(_iQe-_z_~+F-0e3k*TDo(W{Tll;$Qy&Cx>>CSwDhP zPrTWvU>}*4A{ND&RUCmn%np9OuTRb^IkbnU_SR)4?iP*KiTz!WqdsI~iF`MOMjrYM ztks5y+PHCG?cU4ec549;nEm{h4>%d(&WAZ6&$Ef2gfD=Mgd=j16wtvMa# zVYG1Ej!YRhCsXb>GeON#o7Jo>M_Q7qMr{p}6V{hn{7Zhr@lwnv9SVz~;VI);bc+n8~e;7<9g-Cx;fdTtVZr4ImJuH zJ?*0nC~jdqQ1hFo>c@jW`q2BOAYvW2F>Bo6`g`J%YmwQe#gDt_QHMn*PiEu%K|)OW={QPv z)p0X18jZ8yr^0e#0-?jf>NKzdbML^0rp%25ptQdtD_IR<TwGwKQ9S)ehl3@+c17-{ABKH znca#LyCo8+^bZe!-%^dac2=dL(z&-5FRlFJ#=_a8QjyH#TVhG{g_loQ;^E{>Cqw4RCCtUq5j9uhsW9QXX|#W&+5x9*7eRMk2%ntjQVsY1uHWTMmdjV z@3`%MS^VU7%%i9B&>n!tA{Df3=K6k9SL3D=&>EIRxYmW*)%1fG1R#Dbc5;38q;c3w zAu_EFq06JStJ4xwz#r+yxiYO3{sMkXn(&#ELe;o>bj}s%>wXY6`XOq2E}{9uBek~% z-$I$%C34 zflMQ2nmc1@%y+@Il-x%n`N4~VrblC}d6lN4cID=1dG?{Z+^!%G3Mjx*+0z(pGh7cP zfchujTMB#S=6Tz0C`Y%}QLvSvE0wCf$ea{px!ngcYR=JQm z_g}?(V#oeW2IK+w5kEXz5p4-qt%5O&Y`B*=w*-!oS$5Ns=DSfU-&TE6tnd@N2BSWR z$rq*<3gLqjwRzNTO%Vr&CZVv-Bwmv#;Gu@@>ZGiYQLNws@?oj2QMD^ma>N~5Nc=`+kya`h3`W<`87 zC*ghW1~69|@$+nmDa7Su@dj8=ma$H<*3j=KpcE~)uEFKwk=U_9{+4uTS*mNs5jlnE zAT$ns8V4L2u|peRAPJCd!mCDgx4q7=9Mi>GJJ_Lc>MiNQzoIjBdHjB)WBd7;f=+2{ zW2NOc>@T+s4<+DTg2(&pj#})UER`QX# zsY%gB90-q|H!sQvUgLX0lO=9JW24u8uw@FLL!x%l`w2%9HUZEWP1*qE?NJ9Y$$1~e zhcLj+lf#X*h%2j;ZFrbY&mThE22Rmgy#%GR^@3TDH$%KQubRl|3r^Qn?8GNurBqcj zx_9n|nnw_^3u-o^;YG|`pX^id^@`Cfb}vOwr^Q-%R2w#~e$WEQL^f-ucf>g?{C0+ikXn4mt| zy?(&BGwm385Bvh}ebbvxUHvQG%5#?rf~D%5YlAY&;;YHG zf&0sA65Q%?BZpQdc=7oHKcKmAQi`e2gkDvI%^(Pl7yP0Bv16K4Tdqd+)qt&&NSX!E zu>yQ5lqu*rdWa}JFs=xLkG9CTW&#=1nvw{Oa}%BNu+9VF$GJRKpEIwp{EQ2U+cn>~ z9J{GDI@HuyBZt7wnMlylZFLNfFXlomS{?@*W9Q-%_mHHzw#67)h!1}KvLo8Or2~?_ zLBvoN8%Xp3fp8oyj!om(4yxuO1#b+%!8N?wJrh;&L%ik!S)~-aQ_-Uis`@7FZq~au0K2KemQ^Nzn)j1q% z2++UU_2SyHT5Nl$^B>HRTN;)DU7VkY5=th5{{h=15k&N~P=kLCv@@Do|M3{|d#yv- z23Lo%(P}fx7dv3xB^FC8w01Q}?9V6jnh_2oQTBdXbN3kMR+ny-f_ah}BH|k3U^!My zb*s|atV>E;Fm*hkZ%OHZ$rg-4$h6fey#n84u9w|&ZKhnhekiT2ac_4KnYxuP=) zfpi+qG>H5gWX9D7&>$V@%X64@m!&N!D>J=$i@o?nK$4kFMp;M3ab9bBMkOvOrib5K zL>)#N39V_;i)HqqDpSmDUfsrutt)D5B9tR5I1VJ7rkif~7bqEIq{CgQOpc{2scmG1 z?JVH(wB|_{pm>A$#@uG>eDb+?n7+m4u4~Ze<46@jQkW>c@cv0fx+Md!G!aNCBcy=*^Rh3uQ1?!`NCZxWgC^a`;IMMXMt z`_DRo@)d?SFY>6OBdUlvH zO;pTLLw<2r8>Lyn(@A-ROcLc6M<~3Kra_;6pHI_956j#B^{MgrW*|>9+%rft>ap?| z7YzZ~FQz-^xyMrD^vT~95abN2p|)FIXnK8q6HRAxfbtU9#dW<7>gjrG%4xzQpbyCE z$w=h^1t-l!BK0%mWaoMMvlNS3Vf~r@N4<{EQB5w8jaeZ^C&G22a{UaW{ffJY#OJh+ zf=QEF^;qfYO6D>re>Bt)MKDMlKN)y{bzYNL zI8RP7Aisp0Q;_&r&o3%PKarzJ#6s8r2QuDy5nGl$^+XjPq1&#ZGCp$B3!)LP%hsAq zHP5xS-_Mk@o|sy`?r@EYu9uv-1>G89NoV+w1hYNBl&mqB_N?1932Bv|0-}_IcnZ|u zc4p;$!(^>&F4gpr=#Nz7WGWrq{ACXDVxh4B05VnjU2L1RKLBC{Mq7A^rj!;7>DG1+%niSJ8X%lJ7^BHL4CZEg#?peb1dzr?(%=d5dU zfNb@k5I%qQ;R#_c7Y!PHk>+?I9tux=`)HA4FwJ$xJvhsn)M8W$Zz{M97QH;Q{2$m+ z7;rJic!M}RvV=pPY`3%a?|0}l=SjthL}&edNW(-p)rGnAQBe%ohi^&alGEH`Y1qPM z|Jfo8uhzzd+C?F=_tWXTReGAe+e;Zcz;?R!c#L+X=rVGNSm+gHo;^y5nSrV+gnu7O z6|vn-CIIhucm}6>rexKK>v!8-&TMcbBV)};W0ggwFrJ)65#fwDZyr1rpI$Z+54~oC z2eIYCR>5Q!gZl!`Eq&|42lr-=wuHmnnWM_sBawaXY11WJX7Trr@wE>}ea^@@AoT~# z)^Df+q~Blu;TWpo>ImbkU6krwM-AG3Ts0lPi_Mby$y0=wJ4iktQYqH45a!|v=G=$r zU+Qw;S+vBfe9zSXV(Of_Gz-^cTWQ<2ZQHhOyVCg5wr$(CQEA(@U3GHrK0QWXtzYo2 zM-el)(}q+((mL9+uEt^AIW6HyIM;835t2}A8SLSvYwxB@NR=J z;NG_+-RiDwveDdK0gjSV>uu<X|ukwHVEaFte*mi*;&_VrdAJZAO04VkTF7$XWURP z-Ha^AKIY@;dC|{RwB~#$>8C>{hWhxuHm}}u09<8 zqCt%FN^F{ziQwzKMb7(~wa$7P-V?et5V(ro@btvqswS&2HCyz|j(DJ8MwinR(N z+4Wx$sNI5B{qGdToK_J26LQ7Kl0>vh4KVm0eVampF@lr-h{bv=3dWjgHUr z!ZjmhtMkiD1IX0*wf@VxM5L-Qnf;=TKJAabOo($)(&~RBsAK=Cte8=o`&r+nFgb@Z5JgC(kv@=$u9Id5fD>($TDDkO zv1trl7CUs=v!b-h!Cxp8W%%RP56~ojRxXl;%tZEdP4K=TmWYav!$LP&q6{in_}rdt zX1oC*7^VBP0n`b|o%R5}-90x|*uy&}1$&t~nV2qno0AKcc>X5V#1*Y}9vU454%@$3 zw`27WwB{1-N4&j~-i-Z6p<9Rm_WPZLzdEgtM2a-Cd4e1s}2Kk4YUw z-ZILg3Ok(e{9H9|UQz;3q;;CPprA%SbA**IzvzLzI6$57U`H89GWbKa`dB1NrzXcnMBTFUTvQ`yO%wqbZU85TNvCk}q44b}B z6Q+sd)UBpPbm>gY+w+4M9}komc39*$MDky1p_YaXrsM{&I*&|G zW{|WJt0P6+?z6|edeblTqx5=Q%2H{LdTvA&nlul!1A;)rwS3}g2oLyn_N4@V_a8M( z5!V!P9#_^`5!-xJUe|gbJU>=RdTS&oYeWV45f<`B567m;J`6hy$ij;!_!B-g+-7<^ zWLVMUg;oO$iXf3PS2i4B92;57#hHf?#0}!aO_`_%=#epm5@~o+f}owaUsI=36`U#w zkRhj*chVt!O4s%S)w_dS1gh7^e$5}3kSbKFbTYJj?(Mw}t2CW1P+bQVDXtF{)LyVC zt-wqb3QZI2D$3DM(~Ncw6WGrn+~~a2wnBU)T~z^cnzQtz_sr~6+LOxH7sd+ztbu|C zvc(@)ug~X&s;Y*YK6#kBIwG!?&N4S3z{Z!y{VuhD zUAozT?#0)srRK=lQp{^kS_k31)8}Th0xdz$U7bsO7aDK5bith2lFKV)@tEw^-+9xF zF$e^7v*OoFFQh6224ZXk+S_kk&w{b%9PjGTSQ0lH(@#| z+^Lene5&N8;DDNZ2^1oPZx2SRhyaFycSZ%k6ru)9btci3Ko;X5=6wXPgvdF_ia%0nO~vXV1mV@@_;+dP&Cc^0$8G>H`yATYe6sGMxq)#>FMGBz4rsS z`78`GGL3i-A|TP4tuhr@R`QPu*EP7D7D!;iZBpkd?Sj6FDO?0!S@y=%+2|-^$*c^Y z`SPMmp27*!@lgJ~l`$nqvSC)!XbH^CS=&p8cmf@C7CLwuaGV%Y>Hv8SKBQL-k<`T8 z@C``|XhtNyUQX}X%pdgoTFwNTRJbzgCy`ps(a=PBJ|;E@UTS8rD5kRg&YkhL*uLuW zlUl22Wd)qS1iQ&kW~<22uVd54eR(y&PCAIF0UQ00{J@gVV_Zuz^NV&mgl6 zqQ0^YJpc$8Qj-quykjT~xSnxN6Kk*L2UlxRh?1zOI{et)0W8&RQXQ!>t1eV{5JyO@#TI=(Ia8H+!CX{8KPT zV$psJ#mY+@k$JQxhmp6M6V~+a$5gZa;ZA0j(115i=Kw_C{1s`j>=b0Ma_mlLaP5x@0vd#U7HDkHl=HnEeT1}a1 zy7ztH!=TRvH>U3!gI*b|=u=vwagMCdJO_goQ3P+qeuhdkPoYKUztdy3h~990uQYr3 ziU4LX6ByvK$5t^Ytf+9MK!LK0&|g@^?3(FEPFW8ba=faNsPL;kLC_YT&E$eDyL+x4 z4-tgB+5Jf1o*N~EQH*T<8oYFfk4P_izzMBIl1Q_Oyb~{47AW~w6#=c7*x;U&P`^-{^CxjG)xz$ zX%;yUoN(`zg+Pw2tHoq>OWi@_Xy9VaW$hAt^Kwj&X`;&`gkVYbke=u*NWn;GCzJU= zc>ZfmVuB@|s=V37O2$C-_SpeTE|z*8{GiP0=(WXkt3evmBnN`Dk5P;;> zFU3R%K^kTt+NEQNX*ZfC$>ek?TrF%!ZRqSU-$`kywCuhkwUFh#s!u&7^azw#Uh=_V z$%tzjPXg3551CL<)bT`6@VZLd#tPQ$3CnVaih@F3^JEgOW%r`c^4rjb07P2ZV8UZ6 zNYzbc0my|9A+WEV!%OY1;s6oQ9>?a&=VIrz{@_n(>`6@eGhA*n?P@@1fN zqL)+mw8u7$sLw1UKV62iVTPwgu>=E+JoMJ~xsH}HA@ngsfOJ4s<9M=J0S$Y~+J)|P za5eBP1?mU(xtUuPzx)+67ocHZ-%yg$k8+~kHtm5!{b)+$qb3R(hh!=vjX@_;kvwfZ zIt?l$`xrN_X>2;9lwRXB9ed{TK$m>m1xnz&-px6Gpo|-{A`tStb(|CunI@J@(|8s1 ze8jojglnMzw?NXrt)P^XRU)q(%a_qWc*}LAUXV})H+M6Iebb-N#ow-v{IiHYQ@s06IbSYJqvWs{zGnK%{bQ- zeC(%}hj&|hU%Sp%!N6+NWg86PI~1Urzy18f;1Hc#p=ZDvycs=D0N33@ZW5Q}v)O*v z?`rDZjH%Ctv#&?%FQBw9c}|}3%hN{$V+5I@u;U`_$Os zh-^|qAP*Wrt^0&pef>wd>&MsE-SLkx({u7DM&40JG`HiMpyzUNWaQZ5y8@|>!GX5_ z-J-^CHt)}t8_!9*_=;$Fp@IP>>KhCn@^9Ss7s7!tPFdwmP{8h*6bU?=RlTN@ucaJK z^~yoo#Eyo~{FHyYcy4uDVky4HJ;*kyyQ{-ld!q=pf{1~InU22gspbAe88sC(m#Z^x z3%q%nxCx%JFUWQ42U0M;*ZyMe^B*n!>ejiKchLeQDgtB z$7I|tzCiyQ8GxtZn2A?pIeg6S+Rt5+?b49Neh^b89SQBtH2Ge8WbT|2^1}p^ta8zw z>$X4`nVWA85sKj{KRz5I(Bdn;@E}lh#CI?VDz6)haPXctbDd1IN0VrcQs*F66c%q9 zY`z{@g(J|pBXZp2T5>uZWN&%gCG<1X4b)D@PC6-!4q%Pf%|){^sLfPj9DSzf6!K{q z;Ao8v!BK7mNKWB-nmGNHR*m*yt?HlRSoMlF5jJjE!C&hZmgZrYl~i)N~lU0bG^iZfP*;~=~odCK8o^X%r8dGorB84(kKFNn((%GNaJyk zluQR;i-$_9THBx;uL6IwOE<5vWwYK4A$MA;E&%xzui}}|QGZh~T?YeqiP3{}szT3P z3(#(Nxnp+AX`9QlBz11(&GGbWOAQcMemSdta#zkz!0gRWNU zzbPcGO&+%uo3%r!HJN2CD^%B%+W-vg)%tJGc_tz6*!MhbA#(a%>(H4+;ayB@y>I$d z2JpW?F(7c#|LF{XS-Ae|-eUh>Jo^7$2nWxARjIA{=r*ZZ5$uiKu@alZa|#93F`LD- zbe|llxZ}Q`5AP|pl#k8Nd#_L?7Ps&9zwRl^+RnLp5F~CfBwlP0pX95P3OKIl3V)I* zQw1s!$&E^|)MK zS^B#Kohu$^&mTLGqVZJ@FFpNCqOwlT7M-y|avY4g@rcMm(A16z3964JqSYqadx55G z0fBy-^R_kb50GQ7vYc8llQ8wt+Dq?~*ZBV`zFTNc;&nGpl)C^C5R?OF^ zj52!2h+CgAAf*AqXi_ST&ks9Kz(IFpYgH8^^uWaR0@lhCDUH=~L~%8H9l30fK3wp0 z?)f$NnsTL^etVpwJ~FGYty)F$nNTy9_ww(06%|}{D)p0MK7Wx(g)2_dxoEfnB z3Di5~2@3y7nVKO<^K3WZn$>*rZ+r#-t@3%$!{}o3F+&1iO-y7kC4f;;6@Tgk@k+_T ztngPYhpB1G9J@-gi>X)mI=A=+$TBG;|3tHK!l6gnasDlk=aQ9Dq??p7c6s5^CrC!Q zD2z;NZ1tU|JOL)9B3Z$rZ0lz51ZtJo@T2O~kr|$?r8t+=FzgH-4K^0hxD~ zb`wAtF=c#+nOq-W2(8GP*#>?2X3NbY0b*hd9^m9+lr|lQ`Jp5a4 zRrAXaww_YvDS!Ox%lHF0p=$BiV(}To#JQ)N*{C~PIw1DWH4@+>0H{bHd=Mr%_(y)It9JAqKMs?+*MpropTX%~vmS6d}scg2>iFqO+|QaeZyJ5Mme!oqX~VJ&&p zIw=h>vLopAF7ZTEYVmAIc6-`i{Xh_5M&si93bpb#- ze8S*DZn1XVI`SoFnvS3>{CDdR`vN4k#r)vHsGW^ojK4YI9KR&t14W85-je%pAzRgI*NZ75B|Hm=ZBPct67W_0Rq zp1R!#UuF(#N^-(R4zN4RvMRvC%TortUXjz@^^`JGBy9SmG>xNj3FGztv;Zz}vBx0P z=Pc+1j+4U))@g~TQxRY5BF{3#8{?9CIJ()R@+yjTUTGq=NG5Kc+LIR+Z4mJ}U5$33 zw;r7Ee(d)<>uyBh_2uFJT2~r;=?t91Yk3lrtKxSShvnBIQU03NkelykPkR)%!oJN%Va#*Bwb41{8#KmCYa$eIEQ*;2MR9Vc-1h;>e^S@ zkU6!FJfr#cvP*JepkyHH)`_=mW$6Df^%LcO1Re8O^Uid^yneP%R0Cp58u#-fHzh~q zE1#D9rr+K-^flgWzNA}9++YQh!bo?k*yi>{P>RAU0J58Fd}hm`8@ zD!5F$dH*=vf6`kD(dV#1=wn+C!mw$y!Q~VnNzl3=@Bi zv-S=A^?j$kl?gu}uD%H5mnIHsEwoH$w@)X(YlD(~7C>fGqYG!QqkLeiN>*3DX}NTs zQ{%5W+o@Wxxc>5ePb$5{mBoqYLcK)bvSE!aYM}(U=I_1PziMpiU&%RAgs1wSF7ekf^ z3yDjIj^;a#<653XhtU}9#2y|=F!;vfHXNAJXP<`YEqU|gLmrW@qYxIPWJ5ckC!-L| zMC7nd5yKu{C?Fq+vd$X_|Lah)`gm>F@+eB)IV?q!Tg-5!_U1#Oy#DUeN*8XwkKFF(yk?&FT6` zHN3jgj_5o?=8A8sBA|18c_VUq;)Yf6wSph# z8h7G*x!^=|tjeP>D&_VT4d%piq|L{X%e-zjlS;Y|F=qD%Z)qB&O$;7JFGw0r)Q2 zTx{33fUk&h_m!v%ZQ5qc-5BxPOpDpxAXoPOcQwN+WEsdqYDVFS6J08-c?7mE>Niv7 z+^iy!#au!c#_R#Q`2Qr}JA z?5q)G2Z3$3HzUVwwrd#L&6rabK(LQMkCj5#`jNfY`t--q;*Uy74-R6Mf?&GC8d#W) zM7=3~`WR0gN0tcqQ_AZt@mbNv$d{_;p30NPGe{?`!GJe~b0hHD%Y!j7ayopA+EH-J zQoR<~BuZ!6Vb{<-WDc#ePwWi(wyP260J}@*#T4UI0j-OzpvUy9mR!6IU~jy$I;>34 zKeZ;tDA|najJHO@fNF5j&nat%?gz@4*dWJri`8G%Vg2t3brHLZ$#%s40bxC+A$Pl- zD1ibA$5CB9z(juK@J0~~oJl?Ih?axFC14+r4OIdkJ=H}9kowmILK?>|`DgcjYbZrXpT^0^}Vat3JBOx`>Lgs7Xq(hj_Q^<}#T zx^-40O(J#(jo?H#huR47uMh`Y;MUpbJw0b7)tqolsy=FmbQUw$|FYx!r8=$lY6EochseKf$$DlD;~)abVD8RRRx3 z7SyRhN50@j?jKb5<|Aa+{5?OwLpG}$^evcQ#k#(qSLze?_TeIsAHCN4+&riG=IzLs zb+8aOoMx&JAFtxAnMUz#^>$|7Bqv2xIy@QrZFL5{RuC9Xvz7XBUsI-1!H29EICpbJ>yxHrb z`|FD!Ara60uwQ3akC}rz;1gj=6Fc?Z;xtan!jTIX%f#hsJ(o!b^H1ZSfNn^;WIaJsZD}1=jeOk(mQpTFJlK{g8L*dP!_a}Nr1>XVIi{&sw^iy zid801xHu7Vz^;?(NiSiMTwY|vsE|KjCQs{R4R0~Zh#JGVW5Sx*?{d+rww7Ee_=MM| zK^IUp;8W^){A!aM5j;gKz@?(#Z?-b-(CdN>;pybO((It^Ykg~=R+`sh<;$!IF=DM) z93&zYM3Q#}g@2WETE@{d5w`wi%$${*$;=BBl!3hD&?G^^78C5oAwj|Br0qP>M2P;+ zs`(d9OyW|u`-hW?w-4HQN&M6aSq|xG0yyBwQ?Rg7Ah5Ww;V?YV%LOYr;jJrGsM9l^ zDc;D}yffGQpPF9#$sC8ZYK$5H6vKAO$B^h3+HlAF;Cb0Z*!%L)_tWqCO+N-NKaifP z-&H_bbtZ67rYh}~jCAr8A z+Xag+r7r^|@j|+Ti4g8Sr<}^ij0a4n+D$>-E>No+glFjz;p`GruF|QjuY}TouPOy8Uc6oX5Ofgb5 ztSxax%fZ&235)gHOXyPUSHnou7ZQb5?z!OUClH0w<%_m<+o8y1t8U|d;3>d}e1)3+ z;^p>h&h{TBp!fXzfKlfjSJ;*l+Z_W3t1vk`mIlAh=`<)PJaF4Uyi#|MiD5e=tkP{S zfd8&5#0_m>A>^-hlYW`j013Bv$?4MhO8`IYqA8qNnGY0mQKSp_nbnjhUSUoDMg&hL zrehl_XZhB1I!w1{B^;7@)*rySbiUx&`2zQqy>su{u;^xOGH$*&t{2`#+4vKCypj`T z%H1BHUWk`vB{N1xyf70eZlx}7W99bEh^~_;7{6y%@_DxN%z6I5W9|eH8)-$;H`F=m) zqI$}Z6;u20hAp`#n)DLFB@r21TlalW{KN(ydIYTnOJpY`e&YpmjbZl*bC@h~lvFh2 zoTFQHuF`QV0~{-mQI?}oux8Z$^*Zn-iIqk`m&%v1vxNK_H#pH*`_ew(CzO#f*~5~A zcQz|pXf`wyMw21spCX|CLs87J)bk~AfJEd~_g33=wWE{furz^9XmqN$Aba?mSO#UI zW;iikP`w1l3ity_$#Zg~L8kz^yH?*h^ZhmtHe9n#*2EI~uLTOPMC1oYzbd9?1dlF>*F8Y;{#OOXiH|2$$r8l{W{pQi`)oTnt z$3y=1=Cm82*C2Ww(|Yh)fR}cX4_)OC2(OcnE97f3N;^%+o{uYhh4x*emlf7J(e88R zlwJ(an@TNLoibpP2~Xo6C5P~fRnqhAM+-JoV7t=&xuDYWpWUY{`M-@4XD|A0u_JMp zdSG`y50Il?L(M1c&+HN|*jz00-(yzu&%U_XrF8Mc)%kUPS|XD!zg}LR6}C^zXhG|1T~bv&4&Q zQVRcAihLIec_$;BM2lC|8WUFI-=TDE|Lj^Tao>nA`Brec{{)VQ>u2>2EC$8{bq1rG zAyySXEv|uc{b}bSI@R6Bk(s*VHU(SyJl;1{hHnB}KefqY(=mAa_Ky!Aefj^+FiAB6 z5Ws94X$jgOsA;N*Kx{zvX_1IPB!B~3hyaBnoxWE|{*BR<`WON6z7mql4TNY=(gGap z^HE1zoF8z6XaOAXEZahhlfZiqb>CWRm)=!n1&%EIIcqD0V@lEa>XX9dMie)+&nA%4 zpJo`T)k9hmopqCLqp(%gKczVLTvW~>l*3%-6Rt;Ht+?bD!-TTNRGt1{)Bq$Rl|{HK zD0LI?N83D+$d!kG{^#<_!R+l@(q1u8A!eb;h^izNN}-;2+Fq{7hrk$WR1*NVbYe3V zxosYU0N^qV#@97CAw;UU+tLW0fOq^Jiml&a;f-DEX;>p_72WoT+Z-isRw`^@M^)6# zYAt1n#XNKd*D`2?Ce!H$r-1FaVu&`&pv(#sg?PamJSN8c($b`64`<~)&x!7aZFVuA zTtdyeC%^bm!C}}n@u4fqht#ac>sl@baJRiP=Pe~|Kz;Sl{x4=pBR|sR(7h;vRtDBzmP@w}RAqe=`(BfcrAXY%sGzX1B|WmiAczf7hl zWRDm~A*tpWbxb|N*|bawUno<$cbsrR6NcB=r)PE8aAHp@7FNt))UAOe$us-7?05#6 z=?r+-v*;^d5VRLxvQm7bF~_{-lfr!?bifHU@X2|l=9Vk~Y|wZ1V^-SZ@W@PjvJACj zaEI5J4N4#DppqtHbwJigresK>D^)7kAwwyyjU;7b-&%lN#tEA}=LG+$a%~(P=^?Q0 zNP6AV)0kahhF>n^Im_xogXg+aJJr!_opXEcHtk8=5;-5Phcj771-6VfmF|qOQq5m6 zEWSALIITk`=wKYY;QPR=rf08s8l`$?X)gL$2Kj1gX&NxG7C=JLtb(Wf(HYS3H=F%# zwUS9AOJBidEBzb-d&D}K@B~Y(lF~>Z@0DZeA6&=UYC+*j*fwb$289hZu5#+Uw#OUI zvFbp8KirDJ{RF1J4^>1k@HNu>e88O1@@hHJmU?oGfjJ;pC(rhxBoEq{K>VLdI ze*eP1?8v^xegO1C+UN)$SbT(O<@vWHVAYoCqg8!R}665ZY zOVeoj?FTe@)toY|59!39^0nrxI>oJ^v(mxJIQFl?wn6t?oAbp6h;rDyek-!8L4)$3 zPSmmn`J-2~m19_k`8->J*u_ChSTEwD8JmT3Kq{DElMn!zGCXTc^h-Y(Gsh~0fyK$6 z05s!`s{B*QVj6o{1SbyKQoB^wE0KW;!uG;|axi>qqDzqORaS>0I^NN^%!M zZmYpfJLkamUWoutk}t}NJn>4o%=IhP*|N70%?%iG518_b~;ky6m(bt_oME@=}pK07hQq zD<4J$975uAnbLhhdl?n)(*MRDu^!2FFY%M(Gh9!+AI_4Rq7p_UZu<1xNd)K zLyyL!bh4u>5zWllB)42ns+{3}lSaQ2qI91A^loebcS&dUP$# z)^HBlu4!3KDVF2=W9BZNOhUfZlTj2t%!L3~=jR_9ohKncC(-0?Z#is^%NfwHh1qJB zQHz0TWSH?2<2|+1PQbHsWb{7u)7QE)Zm+TRj0154pO#kJ3}b6WvLnKCpQ*$MxC(<# z>Hr?SjCBsL`OCzHyjKaTmr;b@{%xH_Rj1F(uvTTMoL zi_92$HB%S$^SFE2=vM*r#q*b;^?{|%Z530xwNE4Nv_%|jWN_cc@91B)u62H~uij!X zF=n}v8!Ap4kr!D`XHrTk3yAVrYLBY(4gf_Ju2a6VBW`_~vF+My&cAQ<*`h1y)lKSG zHvNy;_sgKcH;tWxpEvCVTBBqYL$T~U+B9#m(w0HPOO44Ey7!5Sqh!rn<9s=5f8Q=q z)qsr3TH*BXOXkpOutvcq`ojy#j`!PLO00k)gNNOxt-iyvgAo)MGWzKo$2f}P?*O4+ zF$of6Or8vzD)b6<#hTi{e#=P=@efv~`Z@I{8vk}{utZlY*G_G;A06B;(JJS9pzWQn z6fxHuiW(HrU(A*>LEYlYae`ap3F?EvfNIyH;FNZ&Xc>BV^1XI(qsylp4YgFJi>mv~6s5FD=T|lv#K*twG2{BeAURstH*Z-9AyG zuiQzeYAJlagmQt^7z-cV83cq`cvD=&49Y88%DU*VDIQ2j5qvo#oHeHYjDUFJ*D|ov z*kf9f=lFcXm`{z%#i6K`7Ly6L`;;R!aRYnGo~LMk&ApaX_<;rKkX!P_{y=E@$}U|K z?ftY9wMWvl?-vq5oO(qY6c}4%cb;WwT$o{k(gz)+9mS;uYk%j-3wfo{$0)26uMEip z;oliR9~^;xeI%|P`tG2$E`W}ACBL0%K$lK7N!67fx z>zEP}o+TceK9WmrDMjy~r8*&5JEds5W}2J|wTdCpP~GZ}#;hog^)ip>AJtPRm4oDV zv7PRm$&iN->oT#E=URhk16RGQ6H#^=lubmdGJZvsqoPu;<^D{_3P6kMpQJT;drq3T z%6qjU8q~G2{)uWAR;1&O6N*-vHy-d>a!A9ZsA0N;GaF|O9XFq8&M!O=14~VCEf=CF z1=MtP%$E#!t@DrQi&ee~5-~&d1al6X$#oa$rX(5)Ubg-92|riQwrqfQt^MiLNQoBd zm})M3MLur`+q)L64M4!oO2{U$0g%!rI+WaSw-g7aqU9qINjJ2!1B2Q?Ln)UcvU@VF z|M{k_uyL9Lc~ApgNTQ@x1w*Ct%eQ|d)9xcc_@6%R8@WG^;&GJ~Bt+r3JEoy{-Q27% zd|KXVo;txP0eV`~;e*{yP^{b8k${G@MfByCRTFy&4*4gG0Ki~3VMp10ln4dTuvKqj zw$;1E6n}7?@XXTr@nYG4`_0lA5N@`1-3@uY*-SSp`7r+-WLE45=_AV#8yzG#4Tqo) zUT`|d&2l3S$h8|cro2Y*CbZjI4?XNG#oMrekY~8i3xr~5jC-`wziue!PVgHNM+#;} zblTs}JfA?22P7rhli!t(lt~VX4v1~B*}*4M;}-Tg667u(Ngaf{Gx{_Ai?;<{mdefd zhR~NJgi>+XR7clO5uN}^r2D9qww)RZ0?0#4z>*8A0ec6V}#4Z!Qi3CL~$ADJ&a(D{5Kjec^ zf_QJvD##6#+a!pIRlrh{QqxO`%rvN`Mi}ic_p!;(4_!do{FxdCkae44#%?)8lu1a6 zAu>k-0J!ibfNnF&W?b<3*4mOs;P?+?l1@Y&e5(c|UG(*&!Y-wFwzOX*NQ2zJy9$dn zv)W;SMh>Fiu+Wf>+?(d&3VcrPUfSCTjxwHhkZ!^Ui2WfVrQ{k=SE|vdjG+4Ir91v{ zI(^^k4szQTuCDLRLA$5%uycM)zT>VOI3U!r&E+rh{8e*flvOF^wJR-_RrUxeOOl=v#t$R1n{sUMN$NWQ(^C@!$F;|r>n5*CXL%5$AtC?aa;7wp}|*P z4e%_n=KC$h$Pu@`x5f8{%FAVgO#_3TG$jR&J0Fh7eGze~U_kl9pF;(P73S2n9(1Hw z!V>E;wQo-{VG6s4%B89nNIr@hG#HwFuB9A|^V<4pxHK^#;erLrZ>+ zP}Yf;;KRhViOPqh(}*5w7W;{*(V4hBX<~|1^;e$`c58)}ZM>A2@1;-OJXJZ7Om4d8 zg34KQgr&UHPry864#5;|*{pIdf1vB(Ql5t2S$W`+wc3$1LTiIjwe${Knp(vQ_ih%M zuo{QPnr73EvTNRD>5Mz%9$Fe(#2*F-#aIx1QpnF{sTS*UXKAD;P43f5b@ll_@W_AU z2eoqC{YCe<7@Qyml}bWO3$I&AU>g-vsa3Sgp0`ESxB)z_mKI$X-MkwSE_^LPLoI(G zU8y+y8v@j&ImbdXD;wL3&<$lm9CxiZizL@TT%@N7BC>yM)iPOq1-??)a$4o+TG`qf%J5H+(I; zt)FA&u06kxhn3@@4*##Z@mbFz3UJK(>P(duf*DUGtD35X8PE4<@|v>xZ;!`XJq6G7 zvn<}BhduO*N5Rb?zrV^auwueIXts+xD>S<eg(zYsBLgF&nSxcT6NSN}+Xlg6HGI!F0mcc{^w6i^7Bn{gU5pc{vNzOJd zeNUFo0%YAp^M;NQId$Iht_~DO1`WThM0=}iKApD!BWHw-m@szC0!vwivlutuUoqR6zfA4}fNwL@ zQjtz2jUBT*y6KED6G6#)`*iP!A|NTp@ED7JOLhMFz*uo+>L&=IvSHCsZLi&`HD2c?JX9El;St|ckc24t2#e{A)vHQ+C1^ukWUzURt8f} zkQ=1I?S?BIY~`%6D;**eGmzXXKLW{eFp!+qvWKvc0HI)r0=saWm35K_p3j*+>xp0( zyf6o9k8s9(H_u$ll@14I(AdK$9>C+c4x1oK30)7Va7@o#^j>Us$^+qtBn=PSR9ab~ zk5_Js=MNbo#ie*#ZY{U{UBqfhp?%RmlDz$4KKq&fOfk7K`Mc`Gc0=g$XaNU6Q6-V`$yU~n#bYV&)_ z(S*xOyRZ(JK$aZ=XO@a1P_2T(m;KQX!RX^*f_-I1U{^a`&;eh~x2!xC^Fzg~o*XbN z(f#bGPQD%@e~`5sx9?kaFw8{{b%mt{Or;GM`o&jWGximyrKS<4>@65i_C?k;3#?qaHgi3c|-sfhyWVB z6g8NSJ;kKIbE0!^z5T)&APXEgK^_mNMix3OOB_SeE-JpKy z!2`0p`Ekv3JM1A-*rnfBvR|2=YA>)1?GZIKhPtJbK+QCDcAqlmfUbjI=U3n{_^=!!X{{VEXJlDZ~Go`eqk*Qg4 zK8cW{&i;uGr{1>C{skN2J?8%@vnXjqbRcNJEFAwGBLOuUTK^#h{m1s(3R4X?3|$eF z82Caojc z(%S7~J}!G$E|?-)?Z$CbR{&9-G#%$7w@I64)kT5UUcE2R4|Xu1I4`(X(r2#7jDHCZ zdOBSR0OvI#=w&sMrXMWZbjDQETB2H%qC&D}ArBiRmd_WHL#CjM4_+4rBqSaQ2zR0pf$cX7C|ym!SWj#mVwJ9iIIrJ93CS*luH`Q-|#`sh})#eXCNcL~awG5)7UiAm-w5f1BmAg`MM#U(VWHTYl8m;(CpN z-ODU6=>#5;#IGxHOs%y&iC#fPA&34qxy6T3oWmJaWbHLViJnez33MW zp!Ij{kM|Qj^9H)SMM$F`U93NcF(N;_44OY&LWY+kqQfpOs&wOqd#xKonDhZG?zH1i z=fO_BZG&~^+n6GPSQ`;FjY>%*E!}xj;&!Q)0t8942#2IT3Tz;-6Dagxdl62;2FLu@{GI;N%$xPm6-GfgEt$;$&671P;3_D zT9~#X{)<{;1)2}H9JZkMPhzWFAA=~TJBExv>}i!;!QaL5`+0TVut*N?g$ohTKI8`g~Pw}t^1jGJX*IaBH@8Avz97s=j#05Qwr z+8}1FG%Zp^E1JD>-ZE~|#g3#12`JF1z&{+50wy-d$(&09LcN3VG@fVdwQ##6WWgT9#a8s)8Ytt>b4w)?dFw zE}9#`=Gq|97LyHROspnIIKoXDSI0io@FSHHpklv)(RQrT$Fu@L2E?ynoLh&$@Ug{O ziR@PqX)ck>>H-zm8|MVOcvl2Sp2ST3WncJO#D_!6Z=@GDmsXDDV|A{!0mQJUofkVj z{I#FJzG{Zw?Fh7;)5BjJzZVo>m-@Ryu`%Tu7HQoS)%ptxi(s0*b5VWEYDg!VX>qc> z(_;%r8j@X4SSo)X;eoX2e2hY(yW&if~Z_j8CNznu})p9-AJ%l z3O|9Ylbm^YUd%nO1*#7gCU{95-~ya-eO!wSC!F+H$M z*z^if&yiUVb5_EVY5s6!19$Jsijr-~;E6hr#fAA%IVC z;<+U6i+V`$#8m%LRmk6a`s6gs@gw93@yH9gL=9Mv-4ws_{b3qKnHkoc@k1XOd6Npp zqf#F5mJA4|TG$nE>&9eX|Mi_9l2{nGMl2HxDD-6hnQpqdSlnuYjddPMaDHXb07sqzZ}hay57y=IsTC? zZ&zI8UJe&nkl8~c^Qt@>5!gz{$n_?b#JSU*FpNxJcQ=E zpWYBLq?>ik_~!qVfLdBm!OiOqra5K3uzR5*V#jD#4)gpUX*PPOXRZ`ZfYK+5##iM(tD6aCuwXD zXlc{!y5w~qV7)>TSmOG7=Sd=oRn-82`;YAB1h$z&O?nEpxzK zgC8D@#UeoES9>!I+>H3^gRjxzvh?F(xaYmT`{qq;K9jrYWu?|MR6p$Kw#DeLc6?pq z^E$`H8spLn94~9#bpp77!UL3*A_3Eu1)vAsLIMJPfX7hx!LZv`GrRaapofgowrSuV zJJufitVSxh#?x*3<3AwvFJm%B!K)9X=?wH4sM?Ro)4jC8-2lt3&%(@xL_3&W0J5h$ z6=nm9PAV$vQ?mq#ZSRLZ>1ye%;*f?3(z-wx#aTp#EZ>de6RH-$giE@@V@a+*RzfBY_eiX zf2*IN>AakR5P}bA)(cqu94g&}>Qns`cF#;JuWCyXt+zlJdJCuu77(qH5&)vgj)$Gp z7&c!U&Z^OxRQk*E8VDB^EFBF@k}9%~hpJP-h9C~H9M42cAEJn`F1J`wn+Ne2@q`9b z!ZfF?*Y^(=7*zM3PRdNYVOcD=LI;L-3d^2uig<$_)Hu@Ubg4?|7(+cD{$^x|EA=iy z_I|@QWP`?X;1}I~Bw*iz4UKsTS`(Ez3SGv!8X+_KIiqon%zF>x%F-*AdFKBC!azO0 z&{ogVR_bZ`K)-sJIrFpOv|(+y{cOC*2|RDww%RM(R^%CN3r_$Y^(>$mJqy;u?B@f8 zH$PB#^8?+ahH_Nkw z-M3m#Qgt=EBu|K~TwR}k0>d5h@1_7YD-`qj3>fb8hpuD`PHl-dAKu4S86jO=U!Qmt zzRIE?g7JLJyS(VJz2Q>!oiZSZe8V85DT5S%A5st|GyYQlMF^Wb#iux(RwPITUa{$+ ziHph5TpWWd99=8p%;B2j41GI}vsgGKT$_8SkmJKLg-X3P*|aVBU{pTO2I{L*ohNWPs+3pAj=Vln$4TuZ|69RBJPHM#9Ig&?s6r?=Dk>Lb+SPM!- zbW2sW7^p|y*R#ZbPSlg3%ruplel%7jZ!*U>Vsy8>Y&<}ZLq3-vL_z_;+?JxJh0+#& zb7pVrUD@#A77?l-;MX{9s}1;6pyW=E-D-=eBw*-WQ0;1#A0bsoiIdA0iP=NM#R+D7 z&PepLAbiNT?<(110VPoOJ@FOlITrXXUoPlPBheYEgwjEOBjyBLP+F&>mt~xe2+<=g zJ};G0s#b$o3sA~~mIB%ZnD>ITI#>Pj9O1TvrFQ)g(8Kzw zIpD>{9PpBEaSnKNl|UA%2tYJYsDvU?qDk>^W+U`)l)!3tGxC8VOnrd+CO$xVDHkUK z?tw3S#mLv^lj|M|qp4ebENgZPlIY^15A#4Iw=9x|Lm=U&ehH$Ga{~!RZotNAZp6`N z{n9owzfAr{`x7N0Oq!EHcM}0HmmvWH6ahAuvDX7Cf9+UJbK5o$z57>aCI?Y75(ALp zS6Uy^X_BUsriZA#G#w31K{lt9=#r2V_1AYl018wo$8s|rA9^u?-39RQcJTmNjIKvw z^ycEb#l`d2VKU16EDqw)Vm*>V_~ASrC9&|MFc>XXqu;zBo&3J|@%ig{x$PH*31`?WjAI%%3lcQ)=uN#Xw`Fhq5wIlovox@)z1&V_K_I@frU-?txJ3zOF z9`2ZNzps(fJN%W4%3X=qJ zoJMgnjiR4MX9lKmd_Mo}D%a|4`hzHQ=?|i`qaR(p;{`rGH{f9Uu~n~+T&>O<%{GL@ zMwj|9jG20hv1DgR_CPZJJL<9SiN%Mqe;@iuW>6AQs$D|uEsN?wNtnq1b}0`hA&I>0 zZljvAz|P#9$U@f*JE_p&%Y_aBX3;@!d2wHWl^ecBj?RG>A9XbyZ*Q*#nyx z%0!V@#jdi4aUPl(=5sIK)*H|n)q?PZapDnT2zdX?yLTMX)<;A7i-HH!Kn}ACe^v$B z9dT+n0_PZj_vxmtaPkn2E09>DTu1ZNd%I>MFAWVyaSp8@^YX@+@~Tn!YHzIWZlEw) zr8%n996)qJ|Mdjed-?9eE1&I)ZUv|01_bv+0U}%e(9YiCWs(FyO{=&?hb{?whXc&L z!vTGone6s(;LVVv-uSp)&4A60f38AkT`69nQJ8TA%sF5$GC<$qRD2X7XlSOM9Agiw zaxxbl0+BIry<$7d2VMqlVW5FF0pEP5Auk&As3PqUsjX)-MZZ#dlY+eM@@lZC>kTNb zQF$sGZsQrChVFC(^a*HKt43{g7i6~vJvwmb3pWlsU$-HNu5KreZbQ4Lf7^)_XJ{DR zh8CAlc5qQUdCkq}r_sL?;2sO-;#T;K8*17B>1)AhKd2#$Y$%5|e4*ZJi|4d9_uc>ceJD7whw67HqR_MYjplR|wdx+r3 zUiZ+TpNkx2Z&!AFDyi_@*e(GrkEqu#AQO-P`B6lYZS+pV`xz9>e|hi2Xy<}KCtffE z;$#z!yuqxZG*^JRV&S(^y|&NCB46PaDMO8d;?jr>v3$eUfN|j{BcfpBn++NdUkdYA z8$z+)mK%C+^;a8yoP`#Ha4-xlC%Wa}(5i;3Rx{gfHNk^un^*f*(b|Jmg;jwSB{IhF z>T|xitst{Q6*c&Oe*!3}IG%SEmcV}IJlC^lAb4jpS`q9GqWyUeTuuS>@fCdOg3-5o;(LkT;D zygr3I0OazCBH!fgAInzd%ZiGB5IIs@u?DD&A5`A@x8=-3x&& z_hY~?B}iH9r*H}MaPg4tC|-66F;n7g)pLCmVFIh-XZpaBF(Z4Psb#X4%gZBc$L7pp z4?rPh(pQupWgL~I;Rlr+LWrXLgq6g)%q8QlbKj}pT|HTqdE~DC7oe{zKv*SbD3CoW z_eqc~yoYI!6oDVeuOULXF00T#)#X0jak)tc6M9;OI`kw%X{qIPc2A$J49D z#oxkfqNbBUcM}0Ilc7ix12Ql$mjPn}DSy>iTW{+&5`Oou5b_ckh*gogSw+u7x@`|o zbh{{y`_vYJA~CkGvgAtgNwdFx=SEpll(Ytl1@^%ZIWr`O-&|?m**m`TarO0X^~HB# z)6>nIm-9FAdH_tGdG->Z4+UK;MD{vYpk%zwInKXfL0sIt0v<8pKXb?4vFF7Ms)io3k06zcOi ztIlSs(4y>cq?PK-@2JWqwSG1Xl>gR&gL<<~?8+ei^F7MCFn>ItpG>#<_|H!}+zT8a zyF`ZIV8g|NN;1uoOf!*zTTg|6a7S7xUwc|5Gw-D}O+8!F)Us#)a+*5luYZ1!;JNs< zp4HT4T~5twS+AYw!vg2-FWCBn#b2lv?bWxt)$c0>t9?fec`f!Kb%lwOA6LKp<~s#2 z;Q%j4x6U((9-UA@MhgQNSI(!^PeU@Be>r*j zQ}B+NuzRb>vnlrnU~jUu_TA5D1UPLE^45bDcyJ^hJl2#rVVZ^yU%=N zKk^Y+4I+C0*OQVxHpm9i)Ul_O7~|&-G+i{qYqLxpergu(iKS6`~6LT8PLucT0wc zj9=!adw6QvhrF6C9O?FAvi9}HNWHmezoekmZ{cjN^9xIeeq+<-+*fqUu#WxZzD4id zpO2>QyLbKOeSbk`nB~Sv)F&~dMr~8$J@|I0+!~H;%bZ+2)PLM_FsE;r^k{f~?l4@D z0(grEMGH`{_F|0u!E}!9jM5Pio=fbPP*RpC>|adXfkgKu#JnH7({5x0H8^eAp9^&C zKu74f`|-T%v$n@AQbfQ~K}VBk9Ws>IS2$E6i72fajxo;4HNe4BSZR3FJn^@H-3mZy zLBCULzz^}VoqzOaI*nZ|rD2JqH&HinjW413gk!56Ws$ z7QT<2X+N*gD4Qi@NjnhLAu9&o)?{^7y>y1O_R#K7aDU*|%%&Ki(IFEO`LPbzk70gl zIqjE)Dew+Db+Ls-R%O6rgf^=UxY0p&cs?|hvFg~;u%v%&OhG||m8IctzSxos0pz`Y z@r}}lgz!d1&=Do$-ZGn|jz5ikI8*_BA9l4OZo#;RP`VzN zVShM6r^1s`wvl?0xcjy&m~?7N>;Z+%WhsVIc6kK}ui@{b>_F!N3Z{^{jjFZ$#YT7u zHY&}Y@vtolBe!m_J+fE8MhR;wQn2xpVjBfpDYhtZ0_Qjy4jP1|sv5M{v#jf7$JQK2 z#Z-6{3Oc%2SQbsoE>h?}jm7RC_~0YbtAE8(pmBhyurobRNL%=3BHkPy%UXIg!19ML0QpPlbWDWhR4D3K6@dtS!4nc7HVevoZBjYdci#OY2Y7 z>7@gN?eo8wRr%IDnby?#sOW=c9{2pap%<9sC2BJ+c?r7=sbUyv*C%IrI$xQF6d>Mn z_sI>anl?My-VzwLAtxFBJ|D_lNMa&30S?FmaJZ_otINL3s`5Xkpw`=W|5aBnORgiH z7vV{!W_U*V0vV9Ex75en@|;mbx@}#^4*E?ysHq(;JJ3H5WEjqG#Ji|&2}^qaIEp@c zb3xwr79Zu`?pFT=mu;*-lRaDanq{yQwj0T0by~KgRNZeR}9*(4Kvj4s_98ycIW!HA>HkajNhQr}EABUr5&S!@? zZx_F87SG-UiIaI*?8nY#>u|=rAdHl{y3+}8r_p&G=w|2cOR%<_EZn>rQ5*&Z5rScGm%N0-EVSg!?TCF$p@KfZM zmrK|o;LP2iPbewmb_HXxs|K3*d*w&2sCM$m0>KFDryx!Ppix}�&h4obC%T$UDRD zN0|-3AEhJwD6-*4*+A#XH2m0Ww@0FW5Zyp?=n_rZ&<8gc*(V-=x zgM!|4RvNi`DY~8%hnA-Dw!YjA^2iMOD~7geKkrEbhnR~*E~d<2Z4Z$Dr{0pC>1z(YHrSrkjEU!=QfzdKY8`&bNpHLD7*0+L&?g>qT3k@c^zX zfY=s5geXkicUzjIt)T-U7SQuES9E$xRGk#XUeDU60b=xWAgyvB1qCOJ->d+=mnWyM zJ(}N)J6M#P@$?!3B3j;@{<{Vg5+9)HCH2&$OM=Pefa%HQfU&Zy=FR1JiW8~3Jm!C^ zUQq8aZDQ|}q#Zhm5l4q91|&rUR68GvGsgT*S(>C{93d-LA#>3Y9s|||%~Sfo$G|2A zPN+jbD|Q3KWq^ECsocR*!)I+`%9M#wNN+n)O^{yXSvx2%??06Dw~+f0DNolboTW^EUK|LfJv2BBOd^ zvZmq2XiPIHOdN3&&#Nwyy{0%JBmih_!aN7a51+vsN@ zp&#J)K|ucgwaWbQ^3K%!(=Uq@4hzF9wXOj(^$Mg`H56SZ_S7Ycn^zaO{`U0cigWI6 zw5oYzY527y{*MdTAr8H<_#A%%0_WssEaLj!VYvoRNyzMEjM~;agF<{~W@2XIj_`q1 zR_d2PzqAq8jJ5RA1=_`A@RQbpd>LOojdG(9*;liL-Xem1^yT@T4d3 zoHD0!P8WY%`*^B_Xr zI1s)2D|E92#0n{D1ty2iiVPY7f^jAYk{s9)Z40BtBhl08zfVy`szuqI*uiuzA}JP& z^;_2%!axy=QgV4K!q`b-;zulS)`j!gy%v1`$%8Fd@Xq_X z{`2W;mP`(Xg!)Me8V6}cmB@mB=sQ3*p2)7W@G3~uKRohM^m$kAW!W~?*@=$neH4z< z%#Wi8kH2kt(MfL=u+-%Zj>4mn`%QKnmql5NrdRrhW!cEqmgil^@AOow+P8fv^^wF~ z!V|)Pas;f@%ygdLD$l}GQLR6%H%!73rXi4m6 zXe0VkUoPG4>UR)IZ%o@x3l{RNZVT@xm3LS7c z2*`jTMYf_dKZ-KvvOEgENgBYa-JBnt=K;}9#o&2NAY-OJ3JmR!A?(iwp$Y}7}6vl$v@3}z<3)NIps^Su!aqf;J+aI;#6fS zd*ntX>MziO8Go5~(_rS^;m3pzSR>|?xy_-zF+ziPVbo=2kZW-~^a3Zy8cg=UeN~AH z)#PoxKS(Z-uTWR;6MWe0MN{@L4Cj2!t6CN!P1DNux0eN@2QF=cC+ZW|MktK6kS0Zz zo(gg(eoI}0ynwiW2aQ9wwpl3?h0YVuQ~XLRdi9Oh`%3iZccWB=PdFk?0concB=(Fy zRyYoTRb%R!wi`MWjZ`nu-A0v_X{*VV1h;-MEqY`9H41X;Z)DWkvg$(9z=l{M5Gxtl zJ2pFGvDHqkh22=KD*~&{p0xC+>3$(B5$ZGHBYZO9VPju^@go!kS_oi_#NyR@@$Z6y zAaUsUc4T4ThnbVti_c$)Q@|dm@>!NTw}WKugpf!{$Y5SMe=XiW7zX%0wK_N$6o=Gd zLFAK|PTr^bX*vy|)H)bIx=~YKUhG7!g8maCVkm(BJc zW&$ov!O9DNs2CtynPij&N#=+2e|a#kccwaR4o!aF+@+|h-n?iggm4`0Ml#HCZaS;s z81gpBZcaHxw>o8BPMbXRK-)&av;#PEbHD!T zt1)0~?e4?K-PKjq^3i>wMA&iMW{#T#Qwdp2= z_kQ8}z{`L*jY-hV+lD(o&0^+tZmXvMJxGFIjXwX!=oZ&uo(J$7;vZfDjJ9Fm=SlvU zDEt)QK&ZT0WFHY9(88AtvGA=5bYQkDAIF1qW?IGYefex8M6-*=mBlmy_>vuUf7X?k5V z~?;C)@OY$NHV&w&mYaR}NI7;)J&3( z*4;7`dPR7WO~zz22YzLS$Dl{&Av5% ze?5ISkw0Pi8HZ{Jn!}cWMuGJtHhSW%b}{$_LOuD8RiykpWKPeUtx82JT%cA2=ylsy z&4G7ln~s;2{7%$HK!0rQ<#2Qx!;3*X+&blm9f-3{W5u~Jx!dUCcu$H!hy|-)9Fh}M zy53Xp!Gf7ZDuLK6P3=oTAD4n0&5?|MlNxK3t4*_lzcd}@%rt!s;c z_(nFwKqxVHIta_|he-th4dXNc@*Jw7l$?%l}zJxb2+_IqQRPfk|9k- zDY}7T;Ib4BMp+8zB}T-lYRFr#e|_iQ-toS4j`I*!$YnSO`-Iv0aKS4WGLC%Mq6aYs z&^S=E<3vqO!vPv33q?f*&VhJNzM@#5Eru2T3Vk|Qfe!cbds_hze6;}*>P-}^843LT zT8lh;cLN{QRjFOMp2xe>ksQl^rh&y$`N2|f)q~<->;XKMKK5p6At0ZO8H-N{=%TfqTcbLNIrX!g zq6INSaoxMy79s-ZB_fdJC?a6{Ajq5`WF2SMJN_9Z2<)6-U*cIQHe(-ue~Hc2gX{)g zLv|<9>frZUj^$p{El1N=$IiGf+(y$((qO7c{8*7|@Z3|YHoDyQ;O*|tMT##F(>zaOp2(~$Viwxd&p(T76+6M%G7_AfhQ9NhhK9zlI zcyG@`0UV>j-Bru5Gt66mrYQu!gn5Q$FCuOjg)2=PB>56iYn`! z;(4g;D`(LTDu||hOL=SsNVFZArLJA&Ox;YiBk>R*hTKgI32ZL?`O@G&j|A7mHp>J<9h%Gf z%e<}?Q26FCtIMIz=*Cq9qZcKfu`5S0x)|`o_=Wwh8v31+p{eK93*)MF6(pXH(K1JW zA}V<6;~1y%XcmwFp9CbK&?pTjZf?ajzc=tyrr>2wCB;&dFZQG;c0DOl?tuj`7-Wkh1rlrwl86i688qrH zK*z&A!a3n!G1O_^l3xLHfz?e5UrRK+$n5d#?UF);l z+}YD&eYi6^$c%Y0ce7!5Q;lDff1<$VED7P}6qvzmE2#skAuV10TB!23ML}NVzwG(- z)6f$s9>1W#;vFyd_Cg{k@r`mX0u_^Q$T4c<7=X(|FyS(y;-#+$isyPfT{4uCR{&$2 zZAG3z(RvYoM&u(IY9k`ve0*@VTI}(!4Ujy~9I^C9C)->bO*;GJFzGd^gmQXYqFrZ8 zhfcDcfn8tNKJH8Ds3oLsupNo#2GaD-J00w2+Oq{Ih%;8grnkJ({8QM|iTW$74{cRK zDT~2cWQknbel)ML2pBApyKy0sN=w|ih0r}W8bXDC6b+HF({OxSDWC0b6zcAG(op7v zp`C=FZCO#xs>+MYL{w7HrCrH~i|f;Xk6-bQOYb^o!%$s!cAB_OmRNdZxEB6;-@6g< z>IiAJq4NYWSV+^sFCwy!!&V?4vj8^vn1ypaBHet90*s?Am%Gd-o(0pueM1Va1rj%| zdGlI-Fs_M*JA8fMZvmkxACHh*B~&AYD}c&8xF6{-nu+ z&!LnrsM4CkRM+MN$k46up{*hed5F`FVe+E^~F+)Pw6KEx$q*R>2 z17bI|Nda7SZ) zFRT9pZI1Y*lc7HolbFwf6Z7?ZyPrZe)q4?>lGJEawNEl;z@AKkY~r)fYBvFSI8wzxU-W`Ckf9*tglWL7_@W69qpP;owyjq z^g%xbf74LWFvA+qC>0HIkr_&q(a6vW3o%i0uo{yZ1ZpH2M9~nFWEVA0x z0&q5O0we_H81fKlbjc_BWqC%<*9Q=X}yVgQfYRzXW-Mu1WWLe!09_&E_V`H=>vGx98KRf6I^V z#EeT7Pnb$2MPKSEtW8%?fmFGH-x_ebHQ-u@@#f4PoNopvjRXhO;VydsBilS~O<2zA zQDfS`gy>|zd^M;Jr`?a;i|!dZe<d$8v^ULnIU!A|3AHJOSvon9zzrXk%KHtyn7_&zm)fhaXdd0+;^NfD+f0_9|^V-r7 zi(>OEyN&&lvNw>TMBf0#lA&FoE^}=7b#8Mld1F zsWEg>kzO%9+_JD%Q|?e_G`2wiYGbO`E*M)*_Fr)0$9j#uoK4u;k)tjDs;S&RHIZ zf&YI;S2h>@B0Gk?Y_ZmqZPuDGutxE=ReyLeHvT?fJKhAw;IRMGMlfUZuZ;u5$=gM@UK zUHe|J6T9|NqLtk>?AIA)yGqhFFcFS%>>A0sMI^^|LpZ#|q|KyzGob4o;ShfFK@nh zdh^-4SZ*>uOQK}+bl!wP;EOof9FoA7BHBFVoA14E8kO&Uc>3FC@5Et*8wa6(NP&<= z5&}_w-ULi~vlpqr<$ZL(9RsD0fehd;+`&rhU6jFr^eR>FLg~E{Smk-q6-}*5nqO6` zD&6UpvAc%gd12JC)HL~N7fDZ*H_b?@&S{}*i^}0wx;8+VQJOQsjV|@6)A^WCTOjEN zd=@-uABKJ=CA~u~zZ@*xCZ7^&>Ym03N33ATfO z|Co1<_8biKeMdhMeijn>rwedbfF6vwD-Mab)hOIg*DWnuO~Szz&!wRiGvap2-iRqV zAvQNdfOFGUD9t2IhV!b%bhJA!TF|@!l|}_`R)ka*hEY&q@rw|%%CeV>Zc%5_gQwN$ zf}_MUx8t6OAe@X22Hk}*Pfc}gYF&4KgucD1?y{vNWlVD_6d4EZX$VL0&I_;(OsA!( z0b8q|3FD>cE=+?yKot;cTD7LfcUVzZya7Bl2<(COYcHE+-p3$_N;GnWT86+^(I;1( zGP)af;s!KCoR{E!bPlqJlK^F57|!=HgiV44@TsXgRq*7cDD#tQb3T?d0?$x?&%Cd@ zsIJE?*F-}OA@Ev#E!D{~RA!#KbxozZ;-t#*l@N}ve`-b;e1^b_fs?szI@=F=djNre^ zSjdBuF~uE8YEGkhkQp)XxonOOR%y3&5`qX+@X`>UC0U(iz(qSDlx2f|n_pOitXx2? z&7Wp@K@|I0aDXpn82rwUQ6#5m-|uCBKGn(|f(^W4P70WjjLqZVhXB}zi66xS-DJLJ z%s@MG{3F4!5<2w*=7I7rz++pnPDeZ8%iy2zZx=?H#~T0m=orXSdHa@$G?h&xoW~w9 zyXPyqK_~rtFW=KM_F?RQhe7yTUXDJRJb5}8{Qx|S-wiW}H{@a6Lax(uHNNT0FRQ-I5ow)c!aoUqLo- znOXUinU1@EIJ*`irFY=K+4U4ij}szW=nXF8%kWECkC%JM&k<|-LY*0w=ZAUgpzBd zRS(RB<+_Jo#E_MLcT9&~I9w`%JBKMJ6bHK1 z*LG73X;(=D-W|KFWCnG|#V(7AiAC@=UDHykF8MC8r`)cB(#n|As+gYOfag~K`=;v? zB~B2g9*B%XW-`^S?22p2=aFLDyBP){kB!!ALYlM%sOpt;WjuU4lghG!M>ekJyT=)XyXMq+4`16>f7l5y}IOv3yw=9d#c&d*y{< zA2!U$uL{7baGE(rrl6Tt9{@z9b4q13V7%Cl$Sl`?hxKV6i;GmfTr)&x{Q5L?yw1kV z!n}~>O=UHHC-OtLzh6&-EQQQjT_&AIW%1y(GVJX&1f&Z9gpbVPxknol1GQ!lR-1-^ zw$U*;vZx?!BsLL*%16NIpYQh4@p1otv(~3T@1`O189IWcHT6}Q+Wt=zhW!;o$~N)q z>^%&Br+No-w12uy7*3=F(*Zt6DV+5Zx!pR(?#4Hv5iw%C=3?twaBx?I$R5R1=ZZ-5 zsW&xKamluCBJ!t*;W~r#2<+C0QFD-hOtfYaTbGh;iNt-L@1+R6zfvJOYSKFU#FL26 zD^GGV5!~Cu0mVt+Wd1MEL95|Hx-3OFFDK-Gq-z0F+k6BbS(;mdS@w!}NgVtp>i_et zbq5snjQoIN(_#X$(X2cL6{gj$3vkq2noqshB6PS;%fq6@;+h5=gyxN@H1N})FJ%7w zWmBJv=XXV^KU{UaQp;qKAIjL__x+oy8Pa76)4gxpM~BEhZyBRRAYE1HJPM9RO+v|k z>KVkSo-wH>dV!pGH}su47lc5@31RX?lkv|BIBzvnJqDtX;=)t*HKz1LMBii4Ve>aW z#NHQ-r0@XiviVvzX|C6t%jwcIW*J26+sbjrhJW-JiK?&)Qx~o?F~?h^Rh+!eI$K!f z-tU}4+@1cUBhth>-|7=7DXzD=yV=%%DozxA&?<65=FWC1=N+UGI;74w$Pz8Hu$Ns_ zMX6d^v$AvP1`ck_eEY?Y2P*L#KW7Jmi702|sL2k^_W91m^PtAnYIMx2e!ai_fz$`nE?d{onaAo9NE z{rn?AzZHT<*R=(gCrr)xISyBRLHx;p80{+m5$pQj5=L64oQ|UDojRw(uEwJu6&598 z&*D;ni<{Mj{M*O)dUtvk#66dt50*iRo#asd>)IJ3A6l5zb79y^O$KABjd5pf5mzv= z*sx1&#U`EDCg;q=CRfFVi1wEep1Xqk{}!A3e)aU`XEKpB`jbI-69F}sAprst0x~d{ zVVeRff5ll@kK;BHexF}q^o!+Stmr-h40GQNQaDDDT(@F}e?-qbK3adR^VeaVyIHVU2Pw|c=GQ?G zPc|=pUB{m1EZc3rT&;uHbIP8+!%@;ebe(vw=fpsxqHP9IHa0CBBfB@NAa=x1wvDK0 zdM5_qPVe;=Yd>-Q^aFgYe9x)GfV_o?BbprzXufUqe24dksWYs6=g4E&Ru1Q#?5(}9 zf9+r{w0ruJ5HL7&C6kuT(9-Dbu`G^!ho(cRn64k`Wp`@fX2~bK_CO4jY>~N9l7Y~^ zo5wLpUG6RTD$uRk31dRBE5){wQ_Tqa9IAG!0j{NJSOcA{lJjsn57r5dR;?8J%mAqzg?7-lHlmh9sFcb}rWgr{QM7g4G6<}0gv!PiVPXbMMb^<%EB^$ao z;nPxxg~*!ZTl>vH^3dRZM4BX)KkVI@$NRL*U}&tR<@$4BsDLU0>5^%XZw55v`KgAwOFCnF}CHZ1t;V_hIv!e>mFxCI~lZ zcX*Nomi?w5ARCEphd_sEXviBzIe9J)EYA(2j8%e*bDsO0mIhf>Jqq?g}{v zI);l%J_4!W$<7ZIQKN%lN(DwT&Ao|{dy_HuCOY>fR94Z5qh-Qb*d($+N;yQrk_HL3 zDUi%ijdJKQ4(w7vSaD!;0>2DN6L8IDZ?(#3OVe5zTieWvdz0iD|BE4y`B6 zoT}^xntXed%3V|KZ?KAlJLF;EP8 z|3dUoHZX{8Q0(OqwZa%j_?08$tOZj$2+~c@jT_8kFW&<`Ds$zrGnCNq)~Z*g4J;~< zlBh8CpPznt`9GQ~p`s`i%$a&Skki}P_hAN9BntuFG!sKGaZHWx5;K%sBcyo4C$1f2 zLltZiC>X;qf7dXETsGm?gb{z6FydAei7*VuQY_RZ5)K$c+Uo_%RKv()49%+u3mna2 z7=Jv5k8^~Vr1J7lF)3-FH`i;>6z{wM{bar51nW$f66u#@x&Cv%niXSm>7zlY8nLF zEk01r1ZWOR7=SdGCA6+`XKUKe1863b2flnUK$@1~*uK)joF*eD4naEB4Kd;S#ekgXBsCvBi-zzu7<5A;m9VP3->vU$N2 zTu&2YbLSfoq3dV93TJ-I9{;Kr2RZxS!tMVWrjDDbmzNCU;)KUH zq64KQpf36DM1wEsgKs&!1ck_5OBBZVM?;0;e+(_6%0@eZm3Q28K~qVwqu@19px0|u zkwM}=pUW&GwRm@@NMMk1-^o8F1XtWcUTG?U=7*g`yL-sJZDTX&X#rr#;wDVSMKRd> z*15T8?Zma2qD242U~q^OOmSsDgvlLAvIp;=q-L$!S<7s=zp)RBi|@@ ze@DZ+!fr$#>c{9SniJS(8^j0p&D;*W@5{r!tnM@%Fnt?ZYxN!*fpeQFo-e+-{^h$_ zR+>}S7Izvr6kptX&98T0tEYnA3k`~3_9_g68~od81D07s(ge*-b$Y_8MO0ThINb^y z-`za>3kn``Z3<;>WOH89?v;G9LkNOUYz7QLd}B!9m% zoS`f^N?TyDFBUl*4u^9e+M7MhyxHI1ykEaLzl`Ep?&e95%+{Nk?|E(*C9^c~+&Bzo z>vHyo^HGU%@$dCN&o9GtfE#(fn`S`BAcZlaynpeSG~gx!+$AF~gA`%3<)U5qp7U_n z$)?kz-KSsR(i?J#ggiHkb0YLjw5Nv;8BG&6&jQQn=dEhH#WD5ys z`L=+WXe)7FGfJoETZ1&*#WD_K=L6HxTXm>Q8W*Z+imGHXk5#uFQI01l8#aJ{;Be{t zZhs!f#A(%NLnw$n+Kz)#bb>~IdR|aV?M`i7xex9;(%DFI0pNJ46$Q#|nRuS_7yA6^ zg=wcWekSyt#BLf#cJJE>>JiA<|1NRye-H7uDHvbaZzhQ?gD`e|FB=Q)Lj%I~ zB1bDU4IC9hOZ^tceh6Anhlg!HVT`>%C4b|nTlkLRpeJUg*BT)JNbo^$9%c)25r?jUL!TXNYcxqO0L zZ>Gaj*-Qa+yg%aV5%&pkUsfBWx{)nJ0`RR6u5T0(8pGF;hDH-G41i8Ypq+T8!GFEQ zQOzRqfJ;AiWK#h>+JN4R>-$#W(l_LI!aah}4U%AJWiO2hB2N(XIOO5XDV@dAGa%8i zu|=U9Wzkq`V!xN7)#T1qbK>bFI2xmgX$y`$Ep0TAU`{o!sKz3O%d05%R; z{JH4<3AJnQ&jMBS)q7b~n`fFlZmVKTLy23S_Oh)o5g8ZYIICr+$22hbpT^-$t9Fw? z7}G7j?FgJ=3(_b^7y#B?TQv_Foh;3ql`uk}^D!zcr|toavCyiTr2|wR9;|>_4kIrn z&`!efO{I5ipc^a2LUh2!iNUw>KL@EhS&lW}PKAs$Zu0Zkcu9+5!U;){#t>@Y8#$r` zvZ7=3$E|E=gsL<=;Doe^qkm_0n4@0srZ`tk{Y->N_XI1L97@}K3kXh?Y9{3;Y9Nus zkar*khQxZ{`Hq$ltx6hO&I3qhl_ppR;m6OM2T3CF*bHGspsv2*kE(d-7}!X#fYnL} zFR&LcVCd1o7;5M^V0emO8%J2Lg={frjg&%@Vwwg6}1hvk%~P<0K7DR$-!U29HLxX8H)7iP(xZWfciro}~* zTv_sUEg5RGiRG(d4`qhp)|w^|^FSfbghI#CShZ6^wWm)9(hXJ9b5`=4rf6~aH4Nau zM0jLUmIP2OFG$9qB0h4izkK}omT~U2Y^kb2hrsxcV2TLCV}H>9E#Z8lQ$LHwkx)6+o{;Lee&)7H~z-CPGj{}cU^O?@r>ubql@X70~Bg2`#d{L zE%y|l^hx5va(Qv1=nL?Hc4dJjVUTi>`xW@6>V|-P+TW0i4JaLkOtirY-%7H|3j*QZ zO8DwdQGW5#Q8BSA9$XiT6K-CnLFhn-3o*!P2A)FZe-W{(^gi2?316#`|FL1{eP>E& zUh6Z12zVI*z&VNuB=rBQ@lLAe?rSnKmf;rVWiAG`sz7v*6Jk4*4xmA}WNsneTsTP=jvss#!^_p`oI;4nhJ{U|hSjN0eIDvI{gh%_%ZARuW3`@aRS`$UyG}0e( z4b{Es;(O>xgP1zHc|rXa1#3c@y!v=Y=okVI;)Ef|?1Vva8poQYGwm=rgCcFlqmhVZ z1jhyh=paT*gxXz)*Jy!LDJ*^{bsxmF6YDZln#*Nd8_AS(1bb8(+BBL0a*Hdnz}j$@ zm0pricW2|jIPE|+kluq@C}iMju;q)HJud4B{uK#1MSAt~T^@upe-X)rw4E2f){$1q zBS6;yHJHlI3W5hWqd?bwTQ3oKS&pL+bFMrB`bJTZsPuv*dgaGz=}Dizf@bG_&n95w zZ1yE($EO-{%S`{7Lj)#+Z&+lRUNbN6E5+-0$9-DFgx!A5emsLiF$XhqdwM_HYtGf( z)UElRo4J5sbn_GR=2cJ0(yOZ8sO02ky6sdw-ha;(4gLYoqpMhJ=O~6<`b0c|ZEd>K z_u59RoUvVmP~j-Ah}mLkhC^YI8|X3vRyfz?Jn-#t4RNFIMawVOqCPY2YSw1gaU1!W zYS(5OeNJLgF)a3EqTsDHZOTx>Y%d8$I21r(AF@zK_T4y+?#T9XP>6qUMSxo0#k3LT z;~@{E9LfpFg%UyoA06s9tI*BoL+5cD%fQQ-qNtMA{gKWNfg01Y`xRl4iTd9Fkw9ix z%7!XP|2NHni=hRg$~#%CC^-hU zLRJSFFRQ-P_1Va*ck>dGG7!N<{F)o!_$6lnr~x*1FEb4amnK3%&Z#-A1`p?klLDc7(E<@!22H3d_1)HQ(`ExUMjH0A%xTHI3|I$oZCha@Fvx5YI z0iBx^<|;wb*)+zM1;O~OQ^kZa9|jm0)ug($W;vM@-;|O+(UEeFrFLmCi}JWaCCG$N zeAt1p8aF*2vqB5*9p%h0<0QwRNg1}388OG8v3Jhr%16vp4%Ou)|M1=P8d++2bHRe? z8w+02);MMHG8}FqUL?iA$e5}nKYFDIh{+$2^_ot;qgbwGTMf_Pg^JjAP#mc2xZZTS zLX0nj}h<&a(eh@sK#HP=rv8TUH zdS&r+lb5SAlPRXl?qL@>wk!ID-?PA>4ej< z{9%W~WZm{=dd6%maG3QAFfsI*<}eD;s$+d8bH!SxOj3GpHeMCP(Z9oSRNaoO4jL=b zL623r4C&n_Ey#K_YO5&wNky$Q7(T1&Q=#F4ikscvG@OfZ-*F3`<(=36csX^~!b}YN zxK)dVtDa`>J0F?{1(h*Zf^0BrsIoBk_gt(NTy&qLaiTV)!(y z%S|mr)9NB}lAAsQ7e3Ce_-^kZkugz#eBvcHv43JR-$bZAaTlpEUBR-wCs8jyC5 z_SBxT#Ow%H7c6v3V%BASBK4P9OTEA&P87uoRD>p-NgzKNP){sk#|Csrh6XC_{?L^_ zBX}~9&hG-rLmykY-Z6A`W_L^IKu*9)k5?VTT;>+8@1l>;(v>O-^siWQ){}cf<$&Fk z+&%f@I>_H*R$3oJK7n5`B*@lvNTvy$IxpTdRODbk>GyIdk@DI%&Tph}*R&VC%|(W} z$ZE|u%695^00t$PUd_Y1s|$w1 z>-ncHG;d@(khMVu?w3X(6pdkTo)35}cR@K z4uM7}eOL_{Eulj-%iJ=IT&rY(e0C&5JQxXfemekMAFtf$fb47vwl2|mSCY_M46Zg> zYv^(+ff_KEg8nFNA9Xb zq1ORKTV+`-NztxF>t#1|ISvnBQeU0?dbFzTW=9x_`@)9T{p zxu&(#-%e;-E&L#DNATL=J63n7DMny7y%6-YY&2qL&k=PFM_(&}ZdN-UPQeey<;O*n z`Fn~MYW&@gPE;s^e)^U^PtB4UGWtr`BvpW8|6f0{n3lhk4GZDd^r(2Ccr84O>CUFh*A0i)hE9{qQa@mXl3m|XL#-!}JoRVQVrsNXa znpOuJLT$EHw`#wDYV8&(uvK)@hKN*F0p-!3E4+^;{`11g;$oP!6_+ znrw7oIaal=ms*5{Lx{abIW-UnA1RMA>We|-cc$pwB64|TYaxXdI|?L^6>l)Y-^Unu{0zh1vujHszZzpa7dH0|#wZ#hqfDSEo-7RVt?puKfv z%G}H3bV&sBE$J6&`;RW7#EZa?%Q~GsGWvxb#aA+d_q@xuZs1SvCFh&d>ZN873 z1CM(pJhn(5m@mxQ9yg;eFf$;EkqE@q0_dXF{onb}&pbc8TkLgvjeC`=p(Jj_g}=Upbsl^yleGJX7C?;Nrmri<`W@B3$N<}=?C6v+AI@71n$Rvg-q|P z*+FB&dCVc|((1z65_?J{q_)ebrCi;O_S6hFTHHUvS(ZGgtCDZ_k89k4&ix&m6V)9h z_R1XQBx`Vkag^@>#0?*h@2`F(>y1=^aw&kCcT>Icn84bYa4{SORvtclg8#b6wYLau#QEY&U@MQ4N6Qr8Rx zacbWKxr7_vma}}}a_42OBIT51hUC3`+uR5X!fSJB%7%cPrL=`hLU_HbgtnYkMEcB7 zv}FP8L^}=40HK}wsr^h%+QPZ=MM!hu5BfD@ADEZuy{%r#Bb`iuwV%4;m9VRGCsZj9 z;(&NgQIXSMKqicPnBg1bN0+a+BeNbH2SwwplV)S1GJ69PY;{a25wV+T4NdE>%`7uZ zlqea`x>lXZBNnv2w?L^uwnI=XTg-QN6@j~UKr^)E(A#f1$mRG9HXJ(Tz;nK@tUwrDQ2zLx3`sxpNx zyg?|+43O%r>|Jpi#e}0HRh3ZeJFKgEsEnwN_p(HnwYmFF?F}4xGK*#f{6-a&r*e)j zoCRYRQ@(Si;eMX&NFRV6eZZ|XB%74c`?Tohg*cWOmPG=?p(K{Rf?qME)X1%?vqlju z!RE)AD1CD=nX{kjZ5F_Pi7y?(AjM6nVm&~X25VT!G+SN zJi6=d$?48xap(F>;Tx(x#qkDbDn;C+84f2wf5jU~whIzN4r{<70N`yr+X_taM8U;L z4?vW#@0R14&354Ig9IeLrsXj3&(~_Qsm!{`8XD#P^0Lcs#~nhhfNH3VxeuIUkJcS0 zg2Dz5j=xFPulPODA$%->T8%R-ps^TM!R#B^%ufOwNAcy*2#y7$>3^IsI47*qn%ECikTnw5ZicYKu zNhZ!2uqB+304iJp>d%B9Hy_EI&RQtMrjE)qtInymKMVR?0Os)I#)EVSjc%Wn1(*Xi zIycYBS^y66!p90;ot&oTLcULjN5pU;@ip5&vtlcpvH$FP>6L%~%7pIgYLx$`jRKk< z#Q!sS_70RH$Fpi9Zg@7)o0O732gmZ%Ws!780x0qUdj<4W3=r#2>Xn;t=c+@LhA|oipPD@f0wl*Y@G~|KIEXCn zf$^8H#`;wEBFY{0((F?QB;Rf~FPC`6TJ8q!f^)g4wMM<&TzCji|4EeHzBW|oBudS} zJea=+K|1ghX256kFRM@d_Uz-l4KT^V4El)Ui^5FOvE?BebN>sDiBmqH0}%GzslmQx zH~7rMX@cBl^9jVJ(|PrN48C$^eB3xKXzvK<(O9fzb@qulmXA8_t8V?Ld?EtE9(1ZG zIgYBJg%uisxs>GQL}dQ432jFxnx#9<;_y$B&)A@0Z^ixr!^oAcqYjP#JZ+aVP13im z#*^%!s@rpt^^nqccQiWK0bl~VyI6z}>U2Jg7nLuwNbSJ>RkY8 zDP^H;dn4}~W3wT6-kdQtOvCyOiVrG9Y8ZA`0OZ?c;;%6_{Q*l$2Y{npk8=n(5=SGU z2C^{fkR)cnh%E!5-uB^d$H<=Ss_){`zb%#tkOhT$zSb@D5;C)9P>^QkplKoYXj*;8 z+yGX)QUA7>5G`@6$Z?;skTz0h$0P{BiU@cui~O_eaa2i>OPW0BS`Z8g z=(GDo@;d=Y2(q?wbU@0Nb@#A*0$IbPJ2o%r&PF2#*7>xWaF*Q~aImy2&b7}RTr>}ZdzqcMD#GipZd>7FXd)eMA}sVLpaOVB$D`ScNhdviG@Wh zZM#g6YhlN7J99zy?@xkQ>h~IVBa2cv9Qu;C7(@ zr$H-QO=h0x=WEU-DxK6+mQ6u5O91w>L~F%$o!_#`*g16Gan0e*s1H6y^2@v~3^Q}H z|GCo@X*iPXX<3;FBh%-02ki80^XM;TO}~X0w#kbc)8tmC zh#Cl*#B#+f*(>J5_s~1WO0znQ@A#H9y6qpaPR>LO(zPaulZmGW+oPq&xp)qpY(|pI zk)0;qly<$*9!je!_w1Xs2?~~rFCbeSx$d^Yxc!hOBCELqx5;{uP*&vXEX4n}?KCZo z5P_-Y;*yus`7G`>Pxy*94PeLqmIq4Y?U%OZNWoiDtp{f0(-eYVhG|TZa4Yvlt<~;! zJsDbf3H8D6GAPwXw)vrJO}m}S zTeUlX6*w{8D@Os`EkbA>e-`S#EGaCpsB!-iF<^-r1|vsTKEVmJ3Ii@qafcCvuAw5` zlrJnai#7ZXE;JpCHFx^19jDhvQdi*EI%_Lt)VIF#TH* zSd7hRpolNw?v7SN`8cq~qNjOY3(QRKgwbAJnCWffU95SL~_B5x|$afk@jy<;VW_O$?cjoUV|QgP8xs!vSl-Y;saq3G@U4t7ugRkIEQ{ z`eG9ty6;9WoGZ*K1KvPf?V%hl-H^TP>rcoIo(9VKBifoQo0`_I`&YWQbw>5EI93sW ze!i1?tE2A^7N1PRXSnq_SC*b|=Xk{8L>lKOqLs8OE;~6~YpC`1I)w!3-|(;|>ifM4 zL8`0b4jHcISZ~IyMv-^ zuVWIfxH**7y5**aXLfpS=b|EXI8zI1mOs=HRvOe1&M?fEZ@GNBOq!R|AVFs^QPtQj z3QXCYB^*Wj)0YFtl&JBQ3HJwD!xUUgqfv!|1HeBwnCJOLOGdtWyn;Tuie{;Kzy?gd z>$uaCQ;QczyqtTzYqAmZ#^G?M< z445o3^e1-r;iIP8F{WCb9c5Q&z%}WLCzX?knaH5-U6rWTY>eN>A&ghx3PrEV)t0_` zb8oDoYcYo_cA)LxAq~ugoo^9r{X>G_3h=W=MlWi{Ss0`#a8O89OpFh5DG);YM%z&f zB^u;sd2L$~k@0>6SyVcP7jZr=O0h-;H!^tuMdG-k7tq@?ksjAq5xkJl78^pVj^2Xr zAFbYYJpQfRpG`z!{XU9R$3L(#)8Y#L8uk>O3+`_?jln#6EWSQwRk1+{?hAx94Y*rN z)%4OKutrWwrKnSuER4BpR5x8iDJyQ%subVo5qVZ@VxhFF5P%>3;5@;cU6!-G?>%M0*)))D)DLa}b@h_tnWVRj_>yOhw$DrQ6S~kF%U5Oyo_k; zh;~xek}dR{c35$aHHQN^e%Y>l|IcI~Q03)b98ARgNma?`Knuw^L4n}3NAbxIbmZI0%y zWwY!q1=Cz!5}kV-(QQfSFbqiI@B7{r&-n##Mmt*PYYBSF_xEsm1=nByNNQQ7hL*C# zIwixl7#lVqd?c;8TMipPy>BygTp-D80dEjleJg4`imx?^3-DvRRMkU=beCJ#40WW% zK$WHmD>iBRO+XOIyN?)mk~yGrEJQQ_ngMuHxsy;>0l;o1P- zlb8iWDSe8K#8Q54W|C4DyUQBEsBhAT-_D=pcREP6x*iyXbAvT%M@C zcrlEt5VtF;gs+=EJD@0 zeBMK=#zXKFl)YD<@`~r+4q<38RlskC@L3O;zr5MDC(Er=#qqLatoety#os zF1Vc{m=uY{iQ$L_ip@~MUDOGEOc{{~<52Ch8f!r^@t`~R+93!1F$MRv9_<6<+?D@c zP)KsF?4k@sqjnY7YdbAGjhe!w2dxZ7=Jwi(ucNFp zlYKmca?B}&R^|3me&cu&)yT9X?sX9NiPF?fsp;SpH|pjb4)#XXxt1>xt0z%de_Pte2?cx3IIn_M`8j*kG~w9bWDtyrJ`U2_xW(~P7OL)ph-*+WcIi53Qtg< z9-zHG1YP){dYtQ9ZsL$SldqkcAR8f=+PeDw9l^l&!3jxi8wgVZPbe2sIp`H{n`y!$ z!y!xza`w#pRiRb4u2vL|ln{(20+am%v)33qOPYX*8fhOl4Jkx6I(q_)3j1===n1Cx z>}0j^wk{3TE`a9*r+Qr5NylkOI+8WRFGfXN42^5%|6W)&iNfRXL?3JSDAj`cpf?i< zDs&YZP4bGyM@Z8GAs$7+XsyD<7nK1^F| zigc}FPeret!3B1E;*tVL)b#@EX0_G4X^P9_!8RX`Wec$$Lqq2oZwW0Yg%jIt-RHP> ze;z_9zq6jnsg(-~LDrXVR%Z0f z?s9~?YvU+c5?*w!t_Yc57`Vhny0SK%vHX1xXb_8&LdZw{r3I{goYcL#d9uzXugx?u zV6t~-v3JF{M#EXEUOONHGmk#X{2@FCRIJIIf`1@zKv#naI$^0n54KLq(aaDdnFBG| z%=Bz3urf$iI2{a_ISj1+MZbdML`)KxlvUvJ>U#x4VxzBjMQ|cpVRw3Ix=kkz2sGsF zz>04k;?!ht^?Gs8?wSMUHYJcQkOrqVUF&zfGRV@5;GR^#)ekxVfd}6xU-+%5w$5Me z;_JHjo1DZkc=8|W{MpT4nWvd?zQc*VPwWC1Jsu*VAaE`K@~&Y=*ELjvvVa&}je<}t z>T&n#-286+BF48WUg!q(+|IdJiMU3Z)oxsbNi})Qtn33^$V=30BC9`k*n_RKs_s9< zzX-0d=B2dZx)7;1Yaf+ier;{z&4htcoca5dRY#W=mQshjlq=i4&I0t!%;Ekm5)A< zfkD~N(}cx^)MsR5A*`Lo6OrjRM(7+K=VFBm|B<4H?vGa}{I=#pW`LoYg?eT?a;ocUWQAf~P|-}yR)5vw8qyplem!redpC=SJ(;tpn-M_{oSSCnDkEyyNLxSCztgd~)+KN}kg>oO*109zNb9VX_8-Q)nKQwre3T z8uHnh>SpsBv%6G7BSJCc)wuL5QcNxY#z&n#!-6q&!P30+E8Q)wsU6MD)(#B{mTW9= zmMJ@gejn;URiudyI1J3p92-OaP_z1#ZcB&2pHB;++goi}@~e@A)Z^JM8rxf6Usvnv z>x|cV@r&T8E@mgakq;O*Rr3urMfvHML${VXj7mG7y{hr&owElV_ZX3O$+kxTy`=Je zLi%jSB%_NiH^$pT%wxMTjy4J6K(2u^AgOnJiai}T;vY;etp!+uv?kW)KGRz4r%8SQ zq;XbbGWI16OMr5`wr5!|Lmu;&GWM(ht?-7jf!B%S44e0y>y+*ayW1MyxCASyRylX0 z;egt&S_LpLKIhUy6eC&2UZ>S`%-ov3Xri|%PZvtvK{xLpBhm{a!SLx}oi-?0eTjOecV zx1iYJ3)E6dTMTd~#q=Yvo$ff|TP!~(v}B0?;CCYb6`&^hwoGK2Cx$v>Y*04?M_pz) z-}JbjyKHyg$IV@n&elNwrq8$6yB}O&WpTsm92t2z`%!VFGsI;^)7a0uwjInKbhUx= z<78GLOam@-KsAPVgxK?)j_?5Bu5VycpT4Lpn|rIi<%l!ll$k0nz|Y&Y8}E0fRdia% zE}d#E-MwSK^OlR9prBnr4DW!fPzH+n-$izC!b!>xus&VZV|cRG5Goy>ezDf>t@BdT;lMzEn8yInS+^<)YCF2? zYUMaB$Gn9}*)`kp%7eP5cm|J*f!L18t}+^(%5Xv9af2%2B;8v2!<0N-O}u}GGO``5 zf)s+HX5HKppkFf!gY?+yBL>qgcdm{Hd$2ww1JEhMTMW96-&Kx~f&!wRg=)o)I69#A zF#Bp;5xEMlfb-9xDbfHjHq$%5-EO5KY1KBc(PwJy*0hWsR+olO$ki(zaAh4E*up0& z1l?^Br+>t`{~+ZtIKqM6+10w(Ej=2%cUt2;ssG8ar;z+DY6E>&-XjY)-@NH^-2COR z*^_O`JFMGazuTpKFu2=#`HF=M5l7VEfK7HKzKtZgjY-7xtAHK=;a88+gKX7FceCFV z6nK7O%2v?i6&G<-j_ev8FtUkbB4NnHpXwOD0xuk$SV?t9WP78zr!-;g^sOI&euUw) zlk{kbDYo9imV?#qhWPZ?y|XG#QtraIlv}kaTMwzNnyPWFqJf`=Lv*cBer)fM7{7_U z`xCPu_&ul2K3if!??mC3&}ya(4t2{V@r&@J|W z*E^$>5f4>ubSII{_fFW&%No{BaXC>T(&T{N)|?kJSE9(Ed(?7M6+(;iIji$imbm$_ z_z5%WUZr2?f&i9i^OzTyZBvJh5X z3Bdr8vh@dG$=KpPq04FNQW*+XRj8M$-c20e)xF#a^*QRps{(r9(8rnduHMSCfA6Lg zxk$BXQrq>m2swWluI*1NwD+2udBJd*QnRP=bm{TgB~J>q&1649b#@}XrMil}CjS7& zARZ%uQW!p&KI7&Y_f*+$Vpe@!BmT4`3KIYOC((6)ifEcsS&G*>1eX z1)3O;EEDwFGsQt)?Zkb)rnB*tTLRq$v!;wKlNO4>E~--wp=jy?tonT1Z!-Bj`qcg` zNK|M2Nj($lWwO)b(vTTz#K0%kHo7ts!ojTxPTDTAB< zd)mL|b+y@5A7dNyS^QsAR=rr#Z}X@Wh`0UHgSw4%}qFvp{A5QMG=>q0s{? ze%Qf;!JjJyV{tk#+>nW&sbNE097qH(tXElp4xG@RQ!dG5XWraYTC1l7R^XqzwkqIl z#Vm9`n2@1~4V9nTns=yL9NLdkh!q4&bby_OGHOHWD&eAgpiyy%F6q54u{#Qd+|Bp+ zT)0DpNfwFgG>0&2rj#L3-1}ijIE}Q)g=^58HxGH341Z9c zR?6co9^(`N=qgTq-tZgfT!kNC%fBX$AL&0AE(}5Zg4GiOX~)wYvNDVc{A~Va(``!^ zGCPqx0-uR3CveB$hKr@Fg#n*rDrdN7{qSmDuxqMa{;(y3gq>A zElhKU0~BT2`$)TMin!Pm?JKXlK^B(97IPu5U!xR(Cn!q~GM}$m{2doFt9X;hQ1h57c-_5cq`uirmhBShE-eIA!}I^mvsNSFl6 zi8JZ+;2s8Wp;Cf1p3f6Y-5B7CXS?(-{R;Su3NH!=Xit)$XnPuG!rs&Qr%CE8r`+sW zA|F}#yBS-oogbww7arN!^blU@e*#m~yukkdOI?Zb?vTJ-smuf*KcXJ?|1UyJ#-2#n z=eQCu*d0)7>SWhQT=cejp8b`+CS%1B8j~nnza%c(SQSCnM&`-$`3#GcM_}h!;(USu z9YCZHCZtt~KwI}V(*dyG-UJ{NsvnuxMQE;n%E0VG8g8Ni2}=Kfcwop2I#B^~UQN(q7nIuV|4PAHkTl%aTuTh>1Bf17tR3P!T?gWv zt$9?Rzr0Y%<6HFp_FG$+n!jx|2IX+NZgZg1KaA8nXJ&4=Y(l0Dq3ne8&X~>-T52u( zY#la|8kenH#M>Hrk{0Lwq>7#v6UJT2$`^+vl}d8cB*qwBY&|B zN1V4SxT=S@nI^QHGHBi9AfR7&cv25OY1PN;?G0lSf8K_<;%MF3Q5000?3eBC1D>GXY%HMcOi#J^j^yn-uw%?XOKM{Ga ztEhnsA#3yaVCOH|4|*9w|P#=&D6H)a!i1Z6{9OchSM=S=_z=L z>y|;KsglHjg>qw+s;beGg{NLjY+DpoPH ze2qU_-kYYQ`opR^Y!c5iFW+A=hEXtpz!YNGP9a314dSE1;UO10zNAhu4S3zLL(Q>=ETC!-1ckb_3Ep7&DC8N$5!XT3r6N; z>EX{#2!x<+@5=5pQk*VOYaE-s)xc^7vlc-{92%bpHBUwz>jHI`8>PFX=rhlw(t9Sk zox6rAa9*tmQW@_~P2fv>ssC?wh;z1Eh13tJ(f8%F0&c+EV2FX1fWey|Q7GjWnZipW zW7lCXnJrQ%s->fuYanPRwJ=^^aycRd2uIC2l7C<#tXa)|xtxdrglO%cSXj3q{Vh*D zL^`2azNkcD8!4ObXbfAk3b1BUX*EViYRqJDmt1IsHqGal2?_TV`{g=tXms-s_6ml=t?PQ%bbl2 zuhWpRzD^*U7IcM0Z3ipPEI_V~#*nELWH=9omN90{mRABG(ZJ3|J-&Q^v@1JMp>YAu zmPz+i!k$)wG$>&H&uQ*n(LZdw_CwpV0jN5PULSx|dg@FuHIN~nK_{Un^O8`U)(OV;vP9DFw9+0#vHs&kUhAp2vo4Q^D1^}Vqxs$t=pdG z!#hEnqA2LDdN>LPEN1d9-ud6zdt+fdhps-W4~%37FJ4WB2(>zUh?;llkJb$%>j{MCf{CYp-SAh&3SA$BTks2=k``lwgNYJ7v$Y&$i6}lc? zF?|siy0)HdN79ev>Fg3gB8he?j+5kaVF~7qDC@^BBOPB)mugK6d_%f zR8!D|Pj8Ydl3 zHLv{^XvGV*5^HB7ydi{*-GkLDegY$b9EJUiuCW6m5LIdfjO)$_)@yN-8Z8D69Kwl2 z$mMyt@3Q?51&gXytS{)NI08l*^7{Z9EQx;A7Hb!MU#SfATq3cq|Ia&8o8&K%ot`Y{ z$RvUo^NY-KCb|AYF|-vRBUZpbv3axaSgf3jEJz-#+$4qsY!g3_Z32QGI-bG-h+&l? zU%{lYQL`pkAU2|Vtb{HG)K0l@AwoZSddn^&8=*)6ql#xs}#vS!6{efHhsDL zmOnT39MGGL7T7;Ab`?YjBS%5#NF}euJ|RuL1~oCQIn+|(KCPRAI(>i?^FTn~9!GF@ zcbWDDCCU4GK22Ik`H&XqMlk94aVTStk52phAHrhMAWMwGvJ8mI_BP}S|6;juX+&BD zlIs!vzuv@#>{;urA)!?2VZfU1e*105~;#MEtpH+qM5YO_C zY4BS2%f(GW#xdA215p5CWGPcXR@f)DgaEzzKM|iwqxS1ULL_M!yF)H57jdtr7RtHI zdzODCOX72fwS-$#BT z^Hen}{b5YL;5a$;YFh_MlrYf)>rghsgi*_A9adlF*c!^F#?iJJlMn0A_(=g| zu}|pG$t9R@?q{)sf`3~ncVYx}5+L&W<#L4Wakt~RlH-DHXDHnPdE>DQ^za{n)xR?T zaqEZQx*6}cCYXREN^2?`MLul5e?V}*W~tb3&HD3)F-erFv+9{raQ(S@+^ z^$oZ@H=UH@K>}AozgBPCxifb;(N5QL%nxwLfT*my*NMzJLU@iG>JUlgMx8F$kU=i# zZG7^#<%&AoldJV)(PP&P@L4~68i~}bA0B7G#S?#VKqLT=#NPiC1RUk|x>5#R2)-al#d$Mfm`WqgUq zo1y?;MqTa+|Ne5N(mVe*aGh z&i(%i!KZL064qO9uWDv(xu_#$k$fm9?Uy^6s8>qHv5$>AN{GS>^F`xfgguvE-yUGe zM)S9&X;O*(?bvWW?JNqW98qokJn#0W5()j5UrXR7=%zV1-Eq;y^A+mlbHt6x_ot?e z?s=s4&RaMEue--&k4&y*{albNL3ahLkYZja0BFl+z1i)vMz~0ihG=Kq{VDrBu58<_ z&aDzfu%tNyEwk<=lHW5r?5mOpv zfLb}#?wxK9QCFbBBB&6A9#2D$Hv-R!C()Jr&W`<>VCVHh(~VHC*3`{GEI6Eo3Y_!n zvB2>Qa9b1m7^W+;Q&Y>Eq~j*h3q*B5b_p<)grup%J_i#}4d&PqOE*r!vJ9(bm9e2s zY3M|LeW(5}eTcFODvw^lqrl#)cE4C-fG}4C_==mzQT4S#r;3D=$Vgn(FOSxmw{a+6 zZUflAjm)0m=Y*pst`wO-%JI?%bOrsEc|!4vBkiWvGy$B-Xq?GA z-Qn}4-M@R=8k)D*(JQIhTC^h7fI0347M@oeVFKE@SdP0z&piwXM?GNXQN4{10Nx}o zHUzwiU>Q-Y_Z?VD<4*m3i3CatKI98`;mBjZD}JMwlxIZ_Jx~o%!A|~pnNub>q1$8c ztZRj4T+O$`k;pg*2TCIK)20T>IS8955}>T;g!4mpSlqwmBl6l0$`lU@{V*OYB)06@q28D2~3VuTbz#1SKl0535->pZgNx?$?*UWpjq znY%i}!qn*+P#ME+e8xWhsMh@=igqNFHB@@XMtHP;mAQQN&g*FK5OO}!ki-u7YU{YG7uvHg&eh`Lc8eY^gBU*X9nSVWUeNH*AkEbuL*xZ^$ z5{Ro@eGS%}R|vT`1(Df*3-lRJ;C-A+#uZywC3dNtXomUHY4e&esnYZ zihuMjfYT{axuMsB)lQ(hUx_3jR=r8#E`p}@+#Qqf>__{?_1Y&Ky5ZcWqSdr49#2=L zH3W6mtrH-VfX=VbFpaLje=7|iZ=5`KwA}BRR}_FD&6d|Q(T~rd0i<`zOJn$q7p8Ri z#{QB(hp3PNFVZGh=sEn6TWS!8%i|um_NP}*nAT+mDqYSpaXERyEH8toW(SJ2f(Oc$ zN3;l3gQpdbZy-fGeBD??BQp}Ij@W+J(V$RKOP>rrqzWt*prm$jorS{Bh`{dmU+G9$ zW`#DZoi6zEM{|CX12Emsdr?&Jj=SbYY>ttC;7w4uH7jRzOBI7`)YE8JXh9 z9nXFNAMDe!p`$lUC)BY{mN4p-ht~@ZTLNmuqMQ^v|SFcRkW3 z9M+w}&)2^_cR=$+QMj-yK$4W>7U1$K&uVO3|u{8)L~YY(xXT#_+B(vvc&?DD|kGp zTLFn^nO2{;#Ej_v9X)8MH7gi>kf?5s;Qs)pKv=)3?`G#$|GY?YqZ@#N1a%=;I%yOv zl3wY&L{O10W?(RRwir0hOW3rEdT)-3XSr=>@~QHT!=aI-1+#gV1`ouc_-q z0us<@wE}WIPe#H$2%xg;cYyD!1HtcW<4$9Cw`+Gntzdy4r88~Jmdx-73(}to5D~Qo z8S#*sZEPjU7~_#f-VmW4Wv`L6D(0BB9vB`UnWeI zu>UJ}HVme8M^k^wljuCLnsCN|t;WQlk}=;aDP!U5HM2^%^Uso0j%;w>Ol0h1?6sYJjJ6LcDnSyzq1P0@^G&~|?V500H6xuYf;Y9fw>l#-@^ zuosR7OILJ^?`12lFOH_chek)!&Vz9vywY$#Tujr@EEl2hI&(VP=X06@r_aM9Dh^T_ zH!?tB{)WP(_l(BJ`s?Y1M7bgh23`n8Tc%4fYjdh=s;;zF-SSj1fVP zh6Za7^oW9^odBoy8Wzb>;X9QH7SyH7G>C+OFbrjsxTUz50axzDvej^tUt3pn7^&pY z9iO_qvzilNQP_sjPKuSAmspm(dOo#IOyZHXe`J6E&)0bpJbUrC=d0=M#??fR914y& z_uV_}Dy2S|icv2#`UMhHX=ez}ySk}|4~`$MS=^mj)~($`4u5&|9UaNvua#1+*cSGr z?(!{>`9pm3isbeh?`(^M;sWVYPncc(OR%_-eiI)dLIS5P8K;;{^NTWyN!@}uom`T~BEMbe^xRk0UV7Jm`Q$#*7WmR~?zw8ouHpOb z)r%M6MPkP-TM<6|hw^|`gqfb($1~@gpR#|ydByrk8-x=cyTezAySBG>fQVswDuZ;c z{TJn=WY5LH!gF=vx(x)bdG1pNxpbOvJ%RfSPcgdLO3oq2MBuK%@`IMT^%Au^R&D(+ z*HJr#xNF!ii7GDK4yNgj_P=b>m$n`(`?jJcSQoP$l$FDhB?2BWb;>p%zHJ+ z##e*PHN6>^Cp?m9naTTskF*q0E+I0@rq@q-m-e^)2Zf}+HEA47-9TnP9&hoT>+VAB zSfVucGwpD{28&%7r`I5g|9gs|w?lu;(#HLs^B0n~aWHrOm8*YU5|8sRDvK|Cg8hlZ zg#EwF;L@a$u@?Nqm6v36Xg+xnG&Mc6z#{#k%0qbFxvHDxU`p zfKR_-=k8^=a6ePS%JjqhcCF1h(E|zRQ_-A%8JG(xOi2Elo)>fFnNjXIi@JZ`qMc0^ zmU%+zNStr{VUB^)*PA$uBjp~ttJALPtz-I2SaMQdD+GkxCteT17MJ$STruCtXZVgs zH%=v#ELaCeyPv=MzIyp$`Fbz>NG$paW|!e8&cdQBzb9zpPb6{!Tc7I2^mArMvyyVj z{g6HD3)X%hnXX{JH-J?3aTyaivrzi~iO(9S`#!&U@^6d-O)Q19_B48vs79dM5Nhh14KfXh9 zsBhVBumyS|Mb2<$-po8wWbw2hiyv>k-`>3c7)FcKOXDD3YG+eR@#w1=cA=s;)M$39DOO=yZha)6;+`MR^r)kOy3%387l8;!80b6jtYMq zU;Dn7Mv)CbfkBXph}DA;^@r7d_vV0v&`WY#|Q(lmMtn7qn0j5H1mjFhGh zMm^OI>ah!>{_eu4RaJwb-nAI&nZZy`5JRg=f=XjZLxLD~O<64T?7za$)E-F_I5GAJ z4I9{^zS!q=M9A{?&gQ)Mizxu$2RMIDn!2ezfG7szu+Wu_F@oaFj=$6&eqo z+l8XCqpk70Ys+o9YJ@2ObYN-_9Ko>Yg|J@syc)#Of(o7=j{RV4J47yJZpqL>NV*gf zga1-NY`r!-HQOn8eczivBlL?#{ho*ORNE>gn!Lz==qBqS*7euL#xLl7n+~!$1@kjuE-37qJl}1p4oqH)-#=4V*r(y zDA;4k8~!JNb=q@GBcr)f&$WlDmU^%YJ5e8c2OjF2m(z-7t5szc?$wWyi)Saw*c-}?9g?&-9CTgv5~&R17vYHm2jct!<6|FC4R1-`QcGFde>b)O`>;hnv!|^Y2rf@$ zn;)a-;zL8OGDUyEM-?XFUUr_e09tekS6=<9n0IPiDzjD9+zf-Oq^X1PoziSYQ!Ris z{}#;hLYVgnqNW7rgVt$G@9MIwUqJKQ89RQ`)c&+U5Q4zp>-BddI-YgBE06hoIB;Ns zX^k}QX+ZZpP^|jtzO@SQ$3{kqnxuW7_+FKrwKk)ilIwqzQ?2ZM4WS7)^rdl)8?6$X zMy!)%8jLh9Lp7~+2_yLXITQEPZgSS*ML4c#pw7d_byQZ1e2U>+_x=kaXKKh6IeQ&* z!MvZQNrvpI_U_#7vj8}M(Ce&h?%EliHpk0B6aykX!~R2dJ@(G^22g)>a_Z*pDvG*- za^g|fofRQGLpAe#a7i^7swP*e#^egCXUS(QH2O>Xu)X;QVFrtFlYzt(lWxlt12i}= zmtjEzDSudPZ`(Ey{+?f9VE&K-wnABcE!GWL;;tFiv`CC$#X1ZI9KKuQj%As>k*m3|u@h`|@=~wvdi$7+gnK#u=fvm-FHuepd z;cPkz!*<_oQwGnSG6pB2gd=Ggyy$B~xUT@_4o+PZ&lf4GUbZAbS@oJg4y!lJswd-w zqJKn<<<(P}tZ|0=J4E}8L(0We$ky)VDE%evgPDda^A)gAow_!)iqS#eb0YgE+()^Dq(+A?mwr&on0a9_6xLtX`0x zRdf}3Rd5XrW$N`oC6XhZIVZ;J8gB|+B&;UvC=s>I9)quQeCBhU9ibhVQ{<4&{9T{e`+FR38E5^-YNd)hFgSsuJ@2)xXPSBLVqab z!?I7!P2pZytq{ufS~#LRl0oi+t>D-rs-|b;;Y5lQF_IPBboPc~<&bHItR7$szj%ez zbFc0$Z-diyQxhoOU?T}OWDd8whO!(2WRX11H_H9>ha;9+N*aXGL9hyMg@FzryP;h% zPm0t7qHcvkFqYX`9+*axLo}R%!+&&UzY1`7DCT&NvIbF+;hs_$pVeik0XT%9HIMOO z+Lpx=%5#jM1tcb>L~Ba6zL=pHCVEnw;jP&|c0!kNYClgMEy#_b6r=@}!Kk)Rar959a>yxK}myMr<&aCk#VG`B?Kh%wo+NII3c!d4=IjQ6S+N8lYb7BJ7ntt$Llop z+-cn9eyxT`hGUGFQpHcC&^hPcvi&{(krebqqAmbDCB-H^rGq!Qu!c$RNZU<0atmA{ z6kke%MNbz?B-=Z}Q%Z#|jE>}-xGH2+i_kMACw^&|Z zF6Q^$AdhPx315R?5FRg;^87F@;#7r&Jo8@PG1V8ws4007Oy#!$MgBdh+tHsYugv@0_QuwI>LrF_Xtb#1hiE;DMEuWCIGrjb`3Qt+Mr zjlyB3z+YUZ-MEl%wR9`Hf%^>}YTt&_UhS7r{hTk({s)T*qmGk-#1jEAmq8^06az3f zGLs>QD1YTx?Qf$t82{eC0_pg0CpE-CAW-czaaXbzwdpNoQ>Wd8yx=rw1dwsk_P?Kv zd9ev(N!HU&+b3iD@$>q7UIb7c6`*`~@gcYv&nA}QYOZbAO0ZIN05o%AD^nY2mT4$K zr2O{wCWFzt--92=Gjl4?PJpgW9m=RAnplkF0)JGjDPN#Cl-8aw+L7VdnmaM+$CNSP zZ;~wC#Ob?{4Zz#?d>QG+CI4cV@L9T?fX~3vnH**0+L}Yv85z3f>JI1k<_)Lw(})s+ zc}DmiZ`0->P)0h?T+6MV^dE9I&v26`h;NK5zJ9{lE{@{#k#BcsNitmUO}66eat$$D z5`TpGwjh|&S2QH!>t|q2(R0ogegM;`y~+M4%A0=WriMtrEgEfLB|l47@#7Xl5@(fr zS8;;0Qymbj(Lsi-zD4ONjnTChku|IW@KljL#Ys|e#0Zk=w1xnw#i7da!0hBb`dhIg)ZuI3`Di zgu(JaSS-zSI_H%P5!+WhBld|SNMM*lvgV}Uj4C|76a;OwNA;({<)DctO{qvQz38yYo9cCGe%0m1B)@o6l(Ealr1&402w z#xq`xA4Q+!v9GPHwdO<^%rl!FGF*kZE^C#mFO{xT?piq zm$wMQYcKFsEnU_QX-ia}Ry466PH+t+M|f9)=CysJ-hH?~!YfC6<5%BXsOs(AJox^w zJIabZl`>|YJ;{Xv;_8EziReX6ea7=!-fhI%Mbc-m17p{!tQnK>m{A#kqI!cvTJ?Hn_B3CFDicnIsJDIs!8 z@-5jz9*qFpAyG0U-DYiwcimp?^rGf9TK-x6+q`P}gxJ3iwdz{WqgwT4=YOh|GpyiQ z?fR?h%+A-`ncXkcnLCG^N$dGKk#k5}ErT$i9XF3+T-Ph1P>eev8Y&j8{U6H^F;=bI zOTikvk#cC}-Q4>_T$i%Kt&qDMrLu^VSol#)uF)z^W8S5v#&1J4vAOd-7joC5*% zqR6N9&x?sxAeo~ ze>y%p=Z?>f>T<#h9l4?CAof2tRqsJiy6@@v=l*bO{s`8qA6)ze+Du?TlYzt&0Wp^` z9s(2sGBcMU4+ANGwO31X+cprs>sRn*a>imnfX|us;Kp{RnWob=N-uE^Fa=4R;X?(X z*#7t3#ex#4upYZfFT!iF-2L$FL(JQH%=>xq(`xbNR%Big7Aa4?)y9h$3q_oIS<1ph zaBsEtKKXGPd|thKa~mfkNs*>u!8z!$GQTU`SG`efsZe--!Q3ZqR*SzE5lopEowRcv z=6URu&EnH%=B?rIod-un?mbx1#*3pU%whra+WWBh_WuCG>*KCC1IQj zGVi^T?RC}k6WicoKDo%lB98`-u7V`-zbG9iql1OXw+hw*_cMt1kNRb z!HZBZr{ZHTw`vx}uTh=Sa*FCe$UBy>wKVcFSfG3pRxem``a%{}f zsb5BaFeZ^R>FYp#&ZJ-|Snj@9noi?7vn<2?77)@^={7ZOmOH8CAe;NW(N(*JcM+WX zRlBZAX)0te-f?6`xrbd<>?&O$3b(gjI8SZKV->Yz!VW@_S-mW zRdx+fV6E1)fzaW2=#{Iclb~Z+80TVmr#mJxx!>1Mh|J?DH@F!lS%eA2oNE))cn+?A zC4;iz%T=@29deBb=giu<31A8!-Z93@3aU7YJkbd-pgj{_S4;asOD<93M(-h6G|Jc@f#pSj zqL4N(XsyuM$5QRhnPL)zWOi}hB!mEeGca7MX7pg|7Zs?RN7+Ez(Z9S#0a;Q+#KDsT zJn@j8EZu%s(r95qMrw%u1}8j58lLz$DOV**$jKIWqW5ks+`61d#l&r@b2bYwAXh;) z?I9H#TQw_d!nlwQRg@13zD0>Oe=t~#HGZ>J8{YWiHgS57KXYH1Zx(qB%_2~L;D2qQ zIZwiT2(*9e@SpFZ-*(OZU>xE1$~GkvHS^v@B20nN-=!6fau)I^`X0UT(HkK!lfe+7 zQ{WKvujG^6+dy?JWp7CEUiP*M2+V4eyS3bIha-6~SW_X=x6t2Gma$hhZoIcmFIGCV z9?LhXu>Bb+aE*wd6f;vnO=UA#Ssb5I%_XjrA??A5qyb7yf6z|acI2@bxrMv%Z$N3N zm#ulC4Wu^o=FmU5e+jS$r-RkC>i}TaA!2p6r2B2B>Rm^B%6&oB;pLnkoUu5ZeLi5* zKLenyl9PeN69O_flc6OP0X3IV3<4>CrUXK|aRTdq8Qvg9 zmK(u40Bf zw^^az9kPOY-_Y+1q<+C1O{?mb+qyh(>)5{I0g!YhrJIHkY>)qt_6H7NAFbO@GTlPG ze|Kz098&ODS?JhwblEl^)yv2AfeM%!!_aWz$W0T^8qV!z>m{C3!nSp`r;e&?^?{mj zEI8M>Di2wCB2ruN|6XImcdENa*MDui&`}7N%4yulVOm+a&o6@oXrgC-Y=U{S?Fdy? zEkMy21^6OxR9@i~J5TGiaGYWg44hsGF( z>D}og%5K{0O&HSlYj>i5#*x;ytjDbk-N5fuubV}>_kHO!`p=6AGSKs!>PY`!d&o{% zODtL060{l*g2Q;O-{7M|AP*i5M@Wbf(?&|^Y+t?FK7ZcxXJAu%uozJ4j6;!;gu*U| zO||iaLxz^+>Mm!FtYrM{l!-w$i*f9N)gm_nz3uN+4M9U2ErUgWwKZ8i3=NKJ##q`A zY`-&eq_dgh2%EX#u6P5o;>i+Z`?D@&odL|=hw!rNVAV$qH|mnJ6%$_h#e&*cbCij} zV~I6N+MAqckvWD#!wbEk;SphCcR;ClM9~lJ1zWzc3#3qpfW{BM{A5Qx2RyD&?Re3t zozCDnR^!0v-U{J=)ixw>_^|fNW_g@UIS&%NAz&2PLtI%7HD5C+D;)JWr4XGOHYngIO`0C@Y86gwGa%oYBq*J|%J-KXFvPOUmpqX;)o3=*ELp~hIl=@>6Rsb8l7<_D_rT)=4{HM^zRSz z6b&!)B((e}GaPy$0lM)3-H6eR2k26tvTtPl4H+6uByztAf!vT=I6(qS?0B;*6kwkLXm2epj*J(ebIhvpvGn#d zXOU09wYw@WDwtys_EK6Ki}`j0f5rVF@KEOBiQwusI~6TVyC)ZIIu22ys>s^DN4|jf zP~8)M36L!BDQDF*pQuPo5RI`q$EwDQqdrUm^ld zn0r>5AU1hUy5*`nvsE`6E^oOjyCt`Ph ziEe0QjX`#eex2AV3dtBH?5zQ3p+lj&8^#dIur_NULNvUSNoOz(uH@Ufdgat{k8t^i zFCf0_2gx;xZlTrZ1l+CkKw|kAph*vC+5wt4jk1_cp;Z>*fh=nVkfW?VGr%18tUm05 zvtag*eX_gdVADL{Nq(4uey+pHdy7E%emB;A@hB{pV&FCsf#<~I?(v>%^IB@`jG(Y3z z!(~%DC1Ewriug%?v;XgQH-7{9v%H#1)`K4qclL7}_FGY}yteiK;}`P5=7c@u7&0oW{d2VD$%!kGtdD z{m6R|Z|xE9m&w!1$=S;&@iISSA@eR*UOy|)~cCPfQElY)7_?6peB?~i%u_z zm7bTpUMnqOEx>bWJY9%d=0#o9YfYoi1p@6JwYCs^bsEOg4}^q^g4fa&+q2|bDOzR7 zy5*g#D$}Z>p8lTGUA&Cf6;~46!d29gx5_`?hHM^$aAf#D0*=K!a4=NBF{V8X^By=D zE8tk>0tf5*Tx5Ul9i^sY;0;9gY#O{#H4)7tfMb3T41g=e?%A*3**nXU9-`NAHcWoF=Gbc*r34%0LKR4WDkE}`>=p`+cX;7*ag?T!6E5B zxbeRYE&#)Zm}XRC8UjL@k^SOJUNt4}MziZ^woO4Gqbj3Ao(&Q|r6%0}@N`?0OXU+r zK&x7RxjsTqmbuJ3F7-sCkE0u&x8;oOf5g(t?JGvm#o;?71w z%ubn0XM@>wQM(L>d_2I>YSZyg%EcMAryz=Eco2Uq69QaOuW#dmwSIQz{yZ71%xzt7R$eciEzmADTPt}r!aCEC1*sqH!&0Ny9coIfg_9STlTVWX3?*LB7s(XfC`&VM zQBB@|B;FD>!54m%rQS}FRvv{Ak-YnFRgTYBMJ08OaMVG_H<4x3$S6yEnx@AXsoM%R(pE$)@u4i$sy*l3 zqAePU;eEVqa9b06-6;gJ@YXU+0&!-oVal4*V2TE*sSd)~w9PT@?({^ohPDy{qVrO( z=E^;q6Ny%K898q>hYs*z!e7#SQ^7A)JGJV^I)#o{cR5D#dbAYb9?;#y}Kqlau zS94rn0x8P$CAPA*oe2z`3V&E^>y`rw5o}YW<;1%7@t8+c)m2wwc~%?FnK^$NujX0Z zXVaA+z_92T|yD$n3x1#LtwT~=lN$zSk$_3HU^Xk!yHy`BCu zu=~LOU~^yPsI0EmWNCn0sp=>NZ+Na+;X8NzG4#HHG2ufPQl&f&Og>Pzq0yJXAAQYG z2L26_&yVSofy5J+@vs9G0XdUlaVmekS#6WsHV*!tU*VbSOy!xiSFe8QG;@=?>~?y$ z*WP5E4>wIGr6t;CB8fVQ&U*Xn3lN|!+1g~ioA!$d0VMbUAOT4B2kU`9_~FGr7B4QZ z<76-&&nMwzuviTO-ycWuWH6oh<0J|Pi)`?V_upKbSEU~Qy7<@Sbu?{FkNtmOJe`3q zJ1?H&lovj0cOz`!x7LiJS%iy5;S_na^xi0w%g*wnt)`Rld=|Q`7Q-mRj-zK@1Wp;*9H>xpRTzc8a`V(3y2nDe-VMHT&ZYc`+e6Xup{{Qhv1KRE-4fj&i z`TcN`cnl*5JMu!8X49DvcjS!}4Wee@cs!;^y_TyX3}TzR(-(y2Teg2x>s&0)xG`^r zvG2XTy1X7vWAD|??bXo@scPB4g|HF1ti=AHRdD-Hk#{WJt9(L$RGvT2h+rOjYDJ?x z@JKXZjmU^zN^>V=Ne_iAma=Ym)<$ph{VW_4@15_504eZf23Cjjuxm9=eMy4@bH33C z;`xzNe49kh_lIq})FpqM%5DOXWdp)ojtVJCKAvnm(o1=WwL!xH9Be-dg7G{_2*yLf zf4Un0l!f!vJn>|6KYO~LZeXrT`Ma$3SB$kw{w13r80-B@|6w~tmVMF6XWZdRtMZ&G z_a!4)AMwh@*qhw0A83B_u(`mq6}0^GO#Va=o>2pLY>G~8#-)F!yN#^b2&4D0BjOYG zEwVN$b@g(Yi}Yj5BTuiEGeX&@-z79+k2mW-;8IoP3T;4_6Gkp9*5|2l^~D*~0DfoV zp@YM%pI_}&F7@^d{69gH0h>kK#Bq@8`6IODV&?WjF-!*xvU_f?L<5w&>t$h;raqkcj#3mQIS_=E9NbW3e|xB z%ZvyEmkTyn0f2bodq1v-O_teSix_vxY>3Ku1)Rvz5Q_{wK({;KfkmPcO(V05zS5!W z`Uxn>N5 zx%~F9*80ir-}Te6r*9?S^uNE}BV~`*8u#riTvT(nj-rwrMJ3^=Bt21yIV#CMDv66q!p;QFku!lq z&TM~UaL()r%3teRe8GRTYhTsFVCJp2*fC%wjj2Jx(blin71XYbDp!o}dS;`sr%z^q z_cK+^82hbMR(pkR@=Ck@!WxRKbuFrmZ6$mBw$Dh-cYR`!eE@F-ScK8FP-R8)kvPjW zF_z|@7%5fZakE{LB(?buB|0DThdN}#6Mlcs*oz9G%7ciPgQynFtqpS;#he}QDeJng zZ=wraDC#i4D{E@C@W8H_rK!~kEXDAgfbi{w1aL332vG>_6!%;?mltAx&~AQSC{y=# z8-=h*VG7~3ZsUg)xB$r+koBQ;K*^ekj~gO%Asms>5?w$_Q$$x{ElFHaKQr~3LNk9+ zGsn zs{AO8J~Z0AF$0B@*nVE0fjQIhWEOvsuD=aO6F3kz8sBh{YOHRe@pC9q=oK9C0J-^; zYB8B2M-r&Rb@jn#?lTL?Z~-q2`lhA1DoEM)BO3n+99%`9UIUzO3Jo283#n!5W%H0y zQR?>+gWlHrs?-mvMHJuQ4=($hR@n4QT4BnG*3V#to1o3+eJ|u&D}(HbTkwAj)@|Ue z?|tTc_mYNpel%U71PPv4Z%h0fmCLd-H3%O8=)~F+KnG+05>`8uekKnF@!j58t-#3iA zdo!# zqNR!df@n{>#?NWar6<|&YVqO^1ddlwlYzt&0W_0gvJ(O^HIrd+D}PwsZ`(EyfA?P@ zG_t)=89%WHg6T9)l9t?gQdHUV& zj>n^kwYG@$>*(jjXmagOt+_joyvSOtEJ}#$2az?6h#UHzwMeZGc1WC0i?@^OAndI4 zr=dFy=AcKe`6DZuUw<;b6)Q&s^G;tHwvgVC6P;_N1(yJnX%7v=QG;1rgp|&NNlk) zZi=jMD6!X^)l$u%WzpPsXAwQcGUb72zync4-EcNjc;2u&segFc@FF*?I9OwPab}I_ z-1Wn#XHH}%+8k*LOoeugqF6PnU7pAfNnx>4v(1K~xTshX*9}fP)aKiR2sPyn4eh-e z@H}N=_<#y`O}WF}tE$*yXmy?F)2SPgP&-3-;3EkM{HR)O80*j6fckoIoTo}RV4*X6 z?SOq_vCA3*9e*y7)KGUGhH8Dz|7EH2G|yEF{8aow_3wGJQN0w*%xmDKeks)vQ%@og z=G!8jRFG{u<-su%TR;TI1)Ie+sN$h$gTv%y&ZHulX7FcAAX zg4jd(SsVZ`A|eu^9IDYP)x5jAxj}hTz=>-zX2>rtP`V$M3Bo1Yk;(eD$a&6<OABFv$>0M_s@y)i}k#Ltr`*kQ*WLFN7C68iADojWB!A2m`M> zFmx>WI)96ohKlRgH@8=pL$R2#wXt&X{_YC()NnF^;$g;k#)@6@J!0;8DvoVOI77*X z@%6^s7Y+gwU;n(z`|MxvTpM07Qv`_{C9dmsa+MM0-dsgSH`HHO@@mqm2oaet8ipEf;|E?p8xm&uqaockan-b;1G}~Fm#n#G4Cz8AVr?Vt2iF<b)m&+S=UWqT(I?Mn^NkW0Ia1%V;2SzHUgQ3(0-3G=+u?Zd0|Xba^@ zfvO*l?>)oQBXuCiU0E8_;tai1u=TCo4YD>XoHN>V0dTZYH@t34TtkIp9&g!sz=>Mo z8Q>ntpfx)ySS(tOPbKf2fY^6elWS)h*ngtD>D9p{ln3Ir6o4jW+{Q`?<>(X9-KzWn z&Y_%owhc{jfZ7Y*Ooq#v=|rTh&4p2?g4G4y@%INX#mkH*z^Vv}uL2ArQ&c8R`wl@P z>Lk|rzB#0R@#$yBj4nct#{VuBFJ+(jGQfQjw2xsi_mL1UV-Op`l-O4f4PO097=LFv z6{V150y?!>Sx-t4_&$y7zf0v9Ih@*M-uBWJE?I6%^-Xz;2%QaI36(2%sJK{Ym#6(G zRp&9=p`2r)!}42JFdLq1dXXcnTkopgrh22S%FP!z)<hkiPJY^mU*fP2n9{MyR?Fp%s6(Niv`>RDbrQT9h)G z9(f|i>Y<_13vQ@XdpK11QV>cCwFk35%F;3bs+y%M%w3AI;3Bok(OWWtOhvx`BKIq+xD`Kayu{r?~6 zcO-a|LGKioF&+XG0Xddq0xEx%SlyGGMiPJDze2Ui1FDKJpAx#dd+^!oE8jVZ6U%oG zNlF=DgvJXD9>6QzUw_@x0|E)wzK30!{+^zmo*!}+*}_@;XfyBBYQaIv+wYj3^S z9Tu+R*nY5HY}Sq)`rcxfE`GD#=dyYD+=?GrwftlE&lhj}&A=pZTzh{Lfj_Mqx~OvJ zmgCE09IKJ^j5$3k zR@Xco%bKGR7Q8vi)LyQ_$hCeh^E0tolJKf`*eM@mp39{dT2G?Ph?OZ;9Yw-&Oc|0| zxvsqpLrShc4-C#A_0>^wVPOB$?qq9*H9hMjTnBhFGp#t5~|0AdQM;oFr9ZjH&aO$IXfb7xDND)g0bOl>~$27ukV(tH8jOL$x@NTYEeIe5yhM8)njO#h4 zIDR`f7~p&Sx96wIc)9SviQzS}YDCjj;cxVSf!J_bv%f(D)=20P!E0n-_#brqz_%TL zJ5J(!>kf_nh5t;n;8R)-x`R>Dm5g$a(b(at1KYe`nuG@>dhuz)hI~US$7H)q#hMsFj zp|?niyWjqB7AXiJQ`_H0izlsGECM)jo4^M;UwpXxWwyEL3Lf5#F06MQxQoz%gX4#j zSMcy`L?c@d4x8IulAw*})Z17u>9JdG0_#bxUJHM?H)}ZQOwYy0`uEaxU5hEf;+&K2 z&*jMU)j1bss`QnoO)#BQz+9{wRyM?Yua*JKmethQ`NR`FTV|^oL=IpA_y4J?uHI!^jha`2)kP9fTg`w6(dfSXMsU++poDO}SdI$;% zDIhQx5y-^C>bBxa6kw}M3~r&d2(aK}_oBc`WkY0W)#oCXdH0q8iqebpHXE3eC9i*t zhtjx;Pdk|q{Gg+W;0cfi5JatQQ^ z$%cVdi~n-cp!7no-y>w|JTB%w2%#t?Vtq^=kpJ$e(*hCh4tY4VW!JR8@8oC-T~Bi@ z?3)=R8o0L8ND`U|?gfK##DSid6diwRBP}#a(0VvL(@7A7BV`DHKGujLzZw19&Zg+* zUch$#!c=$R>QZZpHHHFddvnuWWMAfFlVF16SUEFa#*Ga73pR5e+fp?3oG@08vohF$ zdM1slNeBD02Z-}boCa>YGRyfMPXBWO_kfJQ64R_2mEj0KeKF5v0T^+wbNSXKqrsC%@lXwsU++*) zrDr$Wo6klY@AId0q~h4&OfsZ@oBw^Bv*hvq+An@(&nLYH4KyB?ODDrUex#3;r8{B9h%vo1D(A-mETZscH-CAe$ewE`p+!x7iDvX!8nq8 z&P50x-sO#OI)!@Qh~)9Pnxf7#twbH5*i+84iN#F9gqS`Zv)N+>(~p0j8pSB^d|yJ? zJu2fG>aRpM9jI+;jz0x7^6F#{Ydo5-&n#U}YF(aGWY@hEOcvl`GVfORiu({s-bQ<99Y95B&7r4%AVnHT5 zcOpA|vp-WNgog)_ecLc?F!woaeBE9Xk&$%2^i3=Z=i=0m5oI@H6d#LRXZo<(w%vc% zU&Ac;BK;rrPzj!sL3a}YG?yS50yUQr?gJ{9U|<6Te_J;Y-QTa^7f_rhNx;aW4ZJH5 zq*=5zvM^GiC=l3%?EvZD_ly!dlCNA)zA~(ZAU+O*VApzz)`>B$$&b3Jr!~ z0bY)la5n^Xn9>LUXM~Nwi;gHzEzyGEY9&D?)ozosBC;T^Lo>A&5X|II#u8D?+82XHCiBNfhRZuio8!A5y})@5RW6K5DHSF0s4xDJ*X+6iS&r- zXn}SbGa%wEJmv^?+bjpsZdH8p2!$HVBSu?<34+jig`@~pID-;g1m&TL1v3KHLMe-u zU{+!@Dh!R?KoL%x&d#RQ+jL=AZ%Oadf9kj2|3KK6EP*UFSGf7=%jeG@r#El@7Ys!* zygvvwSO$SHu#`-oJq9Mtq2&-*ddrOl*DTF)xONA8etmV9&d$>69R8(Vz70E%DAxN5 zj1l(Z_ns14{=S0k`n?DCR_|`EKmEGCOBZSN?(KP6eOQ0JOAk|h`1hYRIxhcOe^0BQ zG41;5?iS&)nPpnNU*BGTx%srdjZpg5^vn9szb}8f{+cc}>9k|{NH|R?xBd~cUEaV% z1my<4#a{al_PuY&*D8>;K1F_)?~W4Ne7BT%Hea3bMQ|_Ui}XLl_c8W9GFW2x4PCG!HHW#O=W@N&{e0GcmWeg}c6b0%M!z<;+sP#h(j^E_ek(uBo69_s9a57ei?UM>5cuUvb< zjAhW{&r7dyPRQ)(8{Zt4$u8p`O?I$9cB|&9G6q)m+**GDFt%!@eOY5Km?;sco2F0%e8Bpi{nehsRxKt_bDH)Cj0_m z$1-f+4%`Q})^ppJ`1XMn2PU->J9}(?%`$nWbN>VD?~mk@fy5J+5gG#&12Q%;ml1mb zDSx#Y*>2>>?R~z&Z>1hbe7f{gcRc3@OX)osOUsaJ;`@7IS{>9UO2 zljNybEUJoRkt~vOE{+$@#b4k3c=PW42S2_@?KJYDi<`rR>o~R_L>F=7*rD%T+~gNu zt+*T`h*webBro7b+M=%7ACN8A%6@Y~r&L|h^|`)8qR1-i>PT}~bL||yKoZP?~%X}S1yO$`UXPN84y;+vWf(;efY=3KpNcCZ4 zsVviHvJ1kZcKVJd8?*%2eIt}rKE560N`@#C15|-d*6HFQ z=!{F7ZRm(~Hk-?}NP^}ZILXxSaEct`IQ6^0NsZs(5*i*{qBh_2I6F~nJ5ECDdI&y9 zg~12My?i~1isjRqy|ibQ=^V{Fj>$L3wILj7fGH9HY+|q|#I+g-tbZK5UF+-4O&r+( zpl|YteEQWa`H}MtSdQGl`dM{~R}W0)jiC{-DqjsE|5SKOKoSH-F1g#l2RX_@*7i?~ zVr~IZ7N??X875I?ixZQ;mPnqe1|9d&fJq>PWR(GL!`x-J9Fd-5nmzz;>ZLU zM}AJ{8b_WiEgTu_k6yPGhaTQK&rgiIdVV@_S6o1M#c|DDeSasKxGR23xq{E`isPZF zPrRZSG0SQgG0AF>u$BeMYAAtOF-VmBlCRr%IX?2^DE4p8 z6upS=#0yhl3J`zPl`0v`>eIQd$p4XqNF$V`%HL;w)4QJE^|Y~PyQfo zYRQEGin4&!cz?sG0l#oE&TjR)H1qHsIkdM7z`lhZlozZXT$re5O24Ka#1HD3Cg{WV z9;;`?2PP@g|57hqeFkqY_3L$Wv&Dq-EJjS<638Yrv1^p{24X>I@!D;~rWG;1OrH4#4x z^RdM~AJ1itMOL|ijm?4bXMKi918HBrT6O%|>K7CxiDcDwTIFxoT3;25D)m2@0p$B4 za}rY>i6g5iF^WkzZ=0=f6~XWxVrk%5Xd-EBo$9tTG^bNtl~0RLnaA~Q#Rm$pv4rkn zwbGotzkeneKQqF&J5^{0i5#$R?psMDKv)BUthbyG38DjLt0UYWWTUUq{Lb}22-ny_ zuS!%P`MG9hZ_M%mkX--aANKb zVZ1x4ELW@)>UOkKABw|4wU`-1U@2u;qh=p@8Gld55i2{#t27f;jNCU`-M2z`N4*MI zoRUUN8bk3*Gna<~QxPd)=6R;rg85C`fo#L^5wh^#D5#LD7$UKYpV*>SwIn4O;v z%?q? z1b-0i`YOX@kFms05Q*@?T&sfV%(j@!w?bc2#+4c?K-|O%R#@hG)`41r(+nq&8hhbw zfoD6x(46}TWN3a=4W@xFWa^P?C(aPFDCdJyMoXuY?&NS|Z3t6a09RR2Ew(e#z`Dxw zqLasevPv@TT*tSQAe@WF4+vc6+;UR934cs#YdUB&v1F*3kZ56l$rwCw2PIpx`T)b_ z5*d$(D4Vl5NO6X0&0yF281mAE*16GTizQW|Lu#8;}T+TITi+$N)0^>u{4{5#-;ekv>tv%29us6>FJ(hzU18EP8n|Z>@ zTSa#5nq(WKpBD4DK!L;M2OCWYX&T-2O+~H+DKw^8=c2mb45zF%r3cNynL)^0pg+OYV%#7;IF10Y5%&_jyk-EIgK=iw zsdWBKrt+@JHgki)uL@aZX#qf^W8YiP!2j!DBlVJu&m<2W6G5F(^0z0U!?j9KYWqFZ zmgiC*C;6xb_g1%Xr+P?J^M6J?-r`zUWcM>kVkGQTI)9EIAWig;*@pRq?U4VP@f#LmkGtZAd}w|q1=J)k|Bs}#6L7;{D7n`k zz~kFJYQ4(6G>2Sw$W}6Gf)ae##*mAC`f_dBn}GjV@yN#kP{P|s+Q%JKOFz=Q2>;F@ zZxGy2iUK=V`1&A~{PV(1hQK=8a=i1EH)&u>O6$YokJd7-KKl!Pee>?$YKLF*lYzt& z0XCCivJ?U_IF}K70V#jQSxb-OHWI$iukg(>(Cwz))***UGPB4ciw$-<$ziiFXp3%Z zM=dF$+#T<)-zrv7qSTte?#v_ygJMIz&lmspekkki-LI$OAF^5f=l<_^@59s?5($5Qoo--0BO8Y(@<#9q zwuNPcGv+qjggEFnh}L21)6hdvmMUNG>#8d%Rdsqa(`3~&S!bJIaq9=`EanNmsmuD* zu5JTA_PUzdUxWzClD>U@RX(@ z-BFS7(<+EPS)PBm`_RhsFCqpIV`zLL?#{fdI^Z1gRCahWIMuE1!|r3+eci4i;oX32 z6nMn}Tj4ENaqQ_|PqM`oBH#Op=KO~#;Ld5wI6k`q)wr!Z571*mfSd{-~fMZuF$=W_K|wzk4O1X72PT4?ygnx zBhPcFc@-u1$GO14`y)N>Pwf+KP~mPtq2Cr7!VSjP74ACk!^(l$ag+qYSJVtq@>+8+ zSX^!kKdpS<_rS!>F@uOaA_zy20J(<*SkFh*GTGn?B`H__P$bzS z(!hV;Q1+=nq-Ko4Btpc^TE&w3b^GOT9b%JNa$7#<*T$wO5H>d9Ct{4PK_K$80WhSx zfMI`xiJ?3dl0IA*uy1_JFvuk!1x86=&_ODoGlS`8!zx^Fl5C9CrD>3=pMUP3+lqzc6OgFupCj^VOLzflzjC z%ohQLExA{cI^LMLKw*Re+n8oBknw38W_VqfMb0@MI3`^s={Q}%G@TU>IeC=S-EYd8yk%Kct7oeiUXiq)?-(NgYIxz&4Fs%w7@ z^@ABido_4)7g(LaE9xM$?&s-_o(>l26JYJOziR;Xb$)@%)sUz z98}FF2*fkA$t8@v>h!oX#slBRHGqE!Fx=_$86#85pw)}m zdrK7es^Tnj|1Z23{rHY2?1(C<`_LA%8E&u4r7wX>zOY|Tc1>sk@VL<-fK2XYPo7{F zZd;|By2{CvfYe82)7&`#Q$t3h5my&iurh$JZxFk9U z&%~_US!uEoB%|mJS7a+lU#E`85xYM;koJ<-*eN3DM(qo%_2%n{-aSoKM?vN=aoFKd zoN-6o#;rj`f3_{{YWWJ!&Mh$xZA_6Qnhw1a#T)*xS=!Ar}xAu{FH{#9-IAfX`e89i~WB@euY?9bP$bY zIhSPX26_5b7G3;LU186ZPQ!4VPVug2wu%h8P=*98$3MQInmZ?Ob}YeB1rtY~=b0ZEvEwO>cg2R+>3@qjsEF@YfHv;uHpOHTR zN>jT6_UC+&fy>!epLTzc_?s&e zjbJ}(>KibC?-m=UCCgSheYnggX41MT;Sc@(xo6g!{#lg_VO_Dp>QgsP7cM@QFzj_! z>CU2GQiG2EE-Y@v%sx6; zYF~c_i4ZS3Imv%o7Ozvt-F)1&p%A9fs<%IR)|lGt!`omYdK_K-_;ofzkX>vsKQh8j zsJOxvZpM3l5jn;=VJKO9v_I`j%f~zWYW8}6a_-T6fZ6J!JapIIp(pRTVUlpNPZCb{ z2~_i386;G?Iy}f1W>q8hg6D=M?4xTu9}6t`4ZGAejm&>lV@%YnPz|%pSYLmkbTn%n zP*0TFD`tqolvX!=m`2(s6#D?8h*!mtm?5PC5Jc(@JNiNNMo;!}zHp9!t z*#sDl+RU^@ZTQ7%o4bchUE}xE_LpjH$ke~7QtmE~Fh3vF@GfRob)E_^9@N!C|G$QF z!culF`L`SXecpLWujn-ZgUIlXaY@jy?YsLo{|98uD=m|O#1ofsbpsRwGBGuiQDZ58 zy;)n6+qMpV&#&0Gm1nYw?v^u?Ig_-zopf?8(`-&2+D=MKw9TwUsk+4W`Sk}NKw0*x zt-aIP7YhV<0X~obNPAc7EAQ%u7w_(0yt)hLR||KM1j*I?>dN;#H;j_2dE&Wo7+l@w zS3f&(H2d}b$5(ezJn9+7shfBq%wzh0{HLh8+uwWjPf=s%7alKRzcAVxjlKyZ&kVl_ z=E$T;3bFirH2OrldEze8z%KcDBfE`kW;bCRI9-L`5T}p@vo?}>m0qi^&n5B2PPHW1 zs&2zPVqAZ|rnb^;Cq+)&YDLUa>7GZfDqdI1nIAjrS?q{T&4SqZhHZ&ffSxyhzV9yL znDqUIVo~(6bz!XUIp53G3_hYSI+!+yJ!1ua?`HGJdHdnxt$PB;F^G)Eji0!_m(nUq zcl$zg=fn73cd}vKX!WJ+wo+Z0?w-xc&`suZQd;a}`vsMM`O;>hkY`wX;|H+ed>a1I3^J>eR#}JJ*0e2Q4vDpy zu~1sF@&b>}NypJ?GF@~&1)SSo|&VNaB>@BeiEGIxPa9?-}=PmIH)pj(WNxc&|m$1cDZ4WRR07P5MO#R|{K?Vn} z((HsxXnS?|dJ8$J;cFe5w{Ajv>f@Fh(H91XgpR0t5tQ zR4q`1!Y*8qfJD$I8)oM4g-j{3&7Ul0V$t{<`UKDf+#<_l-62GOk-o0$z5%xc*H7Ef z+x(IZth&- zH20cAubMaQ zKpL&*oOshg>6X}3lG{`cL?QN7-%;Oz$rT1rTU8V!Tv}P**{Qk;%??eJM$Sg9H?)3g zls9XS=9$=k0-zXR1$`3M4Zd15kd>g0*qX_b`SAe@l7veVkhG;J3fqmURLrY$-xiw_ z5_4^_^hRktjK>hk0@rn?^!-~Myi$ck@XvPeoie*MNu4bK&9)f@fYpjw;Mse%;gCNQ z@+Z0~iOl&nAR7 z^%R1A&1dCy*Gb(TsuXY}dp&4o2W?|Ge4hwk{5QfkQuS;IKe1&V)w}q`3ylE-Xq@syYDGtf*rPiz0$bPt z4Slyt=X6FnD&Qm)jp3XD9HsGIxqw(>u>~f7PI;|B9esTmYoIdgA47Et_D9J{_aEO6 znzpA$-KOcRk>ZfWd!6A;==e5z=vy_Af$B=<%D!nFu(-f$^C6p^@2;O@TNOPk=f&)m z*m@;C@k)H+m6*K}Pk1F_uf&5_V(XQd!353;n7|=0$2wRr$4*H&dp#?(oR80g_AQlv z3w`H-TZ|iH8Q%^)2V%yi%FPwjcmA!5J--^6Yf5|4c~#lOWei0Yr$|vu z;Wh-N_VwhgDE~^?PiW0V`+x)-mo+h#-JXcdq{N*Ig)}pirmk=wcKHF{H}707lt70@ zDU?364#OM4!<&vdtzu%gpVC$~xCs}3375~MLacC?t=7!1bjKW^SSKqWr3N8sH3*Gb zC@iGem%uMLtx)4DKG)bGMX9=G@(+cQP@<=+a)mDzK*DWh#bu_IteJS&P=~7IceAQg z#Hq!apTKH!_eH`efU<&Lfa@w*YPTSZAyNuWFTYjzEiQQzG1bmKgKy^%i6&0VP zUCmK%kHan14ipdA7fU597Y9!)bcf*Ba9LLNdZRR6M8)BNizVL^MrZu6mHGL}#_8Wc z@|#P4hlR=bY%d}@+W{U}KHLADEdujsIQf^@A4Ca11v^qV4Hx`;(mY%ceBVJ_v;ST6 zt-XK_cRqSfQjgxb%^jZZg0Xjhc;z0Riy1qPg^%vg$b3T|dxsthjEkZn=+|EQ>}IN_ z2&{!uV+@7{84SeO;Ltwg0G|v7&cR^d9vO^P+KTv(4F=&Gk{ugtByS508e0=N_N*S{ zk%^cI5nyfJpA6baqdw^J!%Onb$@cuHSgkK*F~jD~f+Xon{RJWVy0=1M`Mm?19Y6 zi#-%txe?MxG_CS&Rvt$3XM07VmBg;u>(5nQbW1|7r*J?ay!D(kwgBa#^)w3rche zj9xj8l>~nQ88472uooiFL5*Xbxjlx9{a!hN6}r(0F4fil3tT}Dm(OqoBe(+Nx4-D> zTC&U#s=z?yGgQ4uFo4Q8Pz58X0*1;rPzB!)6?hsB5lVbQ$PFzo_DOF2RTOnD)nr6Y zMraHQLtp0s1g8^Oq0#k+~?uR4WVXkmZtm@FJ!6+@b(ZUlL<2(l6qk?f-#Zn%mt!;9Gld&T+7>{950Px6Cuu z;$DBHD4weWcG+ZwEZfoE#_S&qez~-eih6p_Uh4fr-wJ{==TTQt?PY#FU;px9dwcV4 zJ-?oR+`PYAZ{OUlf0}O#Daz~l-*4_{aqAr+obx9#V!|z47_ft`o4d{S_048Ix60H2 z(u1-ZSrwCxYNvkr4rqW~HV>lBs`CGh&HR7;tB>D+$~U9&&-KmSeE#nJ?dHedhr@-8 zcj8gD-Byn@cw`7f!-GbO{nJ^7Dfv7Jttk^B4V(70Xic&i$Ws&cP7()>V><(EiJaKe zbt&&U{F1M&#~I>IEhVz@X)HspVR za0}U2m{PaKkjxp`IQqP-YBuy($o+xrM>=bOc5tt!vuR*pMZ zJQuW20cgC}0T_+z>AKW_56kNC(1tOKP15?eE_)|x6gi#Y9Lmin1KXuHzdoB2I!S}| z6GYJxenDb6(ODX|Ro!N7{=95_XykuBOIyizkdho zY;+RZyw+3&)66XfTo;d5W&f67+Q=~IGYzCy>&?|~R}M(oGpBDwvB8W1<+Ql^^x2;6 zVG$HtUJ}n9HES{Rpjc#k)C|Ml3GSy087B7EV@kN8ji-O6bX~YweFcy)7m5nKf0aGuyXSS-UnO5QH zJm5pJ4k^;(P)CAYS;3Z6M5%M#qN09%c*H~$)$LZi>qOUzY_J*F?IqY0m#x4GFf|7Y%H%p&tmP{5!^I78?V*3KhL4+rY@lf( z64{ReC!~?CTZ^ilGQ5_9Pziae{w7B+2H;J7lH4R8VA(t)T*k6fISUDQEbMJ=)XtVm>|~ z7(f(Fk7DWCY%p_Hw6cF=0aeR1`_;Bxxrd7E`Vgp)pgNj>`;n3r`1&2NcVq3K%2_mL z>sblqxaT;xFRhwJs=5Lus3{Y^88E_N00tlyLgn}?FJPYGyRMYVc6cY?3_a6g{YM|p z1ijL#D0G;Fr*AnN>u)*D$GYM8Ily6}k2K`ZKpZGIOLbw5!g+t>Q%FAbAr4=M`r`2% zk5Uf@qyUyM5Q&5Vu87zkwPirmy&#eV&3iZalN0~~oB|t5DLV@*sH#P*X;UcY@#4P2 z4-hqNkZ%m~7MJUQ{yt9Z#fxQt;RX3AnioXU34{Y3VTnT#wsaO0WJG(&1Tj%ypeD<* zmJw=P`5w0Y4a9$03vuY{KEkujy#u^`%%-I6LtyojuKNt|Ay4dDIb4(MnA!L>Iz*rd~?~rfVTI| z4FQA4W0mvJ?2E42307>RmR+%vETv6_cYmI&KjZhfM(UN4C7ZobqCrBVH2f!XCL98E zGpv6IL>TMd3`agY1cUxh4(Bk^$Tz)MKyAXnL6-t=@hTVP7h+B&BnX5v&vclB$c{w; zs8svFrAU8oTGvwlEIJv0httYtEQ>hiIY?hhHOR6;l%3#6v`t}#Q3{Y$1^CHLnXVny zR2kw11$YJx3QABr0i&+w4v$_tb{>YM)KNr}y`DT|>3Ks)ez3BP|8QmcFkqmn@d7|d z|H=X`7J46(Uv}>~9!jqJj;}a!uZ~j?!vAa99&)8)Efad=M z(6?|?DV{%whDT7)%r{P78t&ETGXZ}dGEdo<{{o{mJVrjlaX$lLd`Z>hr_x{@cG{W> zGtGg&VJ~t_l}gcU6*PKs@~c{F`mgH+pp%u;Y*U@67Ru$J-Kt}T&x`t@rTrZfra}Y0 zJN^X&OM6wglYzt&m*@%s6az9fHJ8yd11W#qS>12jI1+#FUy~=yvmYSl9Oit`kODxl%q6laW8u>AvH4`4rhKd96IW1ccrfW{_5@B zs~_IS`PFi<%%be-ZhI9fwTP4KD$mp+jial(&DAeKn$3Q@`{xhulhl)pvwQ)9iba3^ zRW<#ser!%XioQ~^0jyEpnt2@Oi&Q07^C(9mukB9j-u9JQ9dx_1^{Oj%WoGkCso<|X zgl~9Ux1YKZRH~V)en`~jo7b0zJ7zYf}Qg)TrAU+tszsM)daS7`f$8d z=1Ht|yQ=KL_ES3i{W96FwYuKH=}mvV`O@K5w%&e;-JOmvY$yi=;ig?}PxVN=1e+Jc z>O7~d@HD+GFWi3j@1NiKQk^;KR`;-WB=-L1_T#&0C;Nx~Qovz*^SN*Js?uxoe1K2& z%l?+FN%Vy+X|oq(&@0m-6PupT!5AMcY0dFhl`1956ZjYzW48UO+gtqm(sqB@c{@JC z#_ldXlZfu`v1e;5gE{_Ho_?^Ke*av=_Qvk^{j+Ii|1hhkL49rO*KeGWV^)avPNBVO zILyUh9M5S+nJ_-<$CwIw-Rm9@ioP zh^ov+me&`{b=&I4j_1d=nT2U^Z#Pcd)>96@o~0_dpG7IGzFy4cd8~qepk2i>IGn29 z9udOvQk}KaT!|*C9%hTAkaBPY5J4q4bYG9V4}kO5mf+<$4$#IVjsnjcNM>*F+>Zc? zK3GhB}n+oF7R3Hlk zUXL>`VL+fenv$*9Fxv`)!U8zWqMUIGJnx|R>FypBXP~Cze3&f41SJF!90Ui6A7Y2` z6J?5A8)adj`yM%pB26c!LlR!HIPli;x(8cTypn(ilyYy%PgsAV2zS81Oh-o5l)5)U z+l%xI&INxYi3)Bo6_$yYKhZKK7YjpoLTa1M^ihAA59s?%%m;ZfA2g8pK-rnvKnr0u zv~@_KKsuC+`E;8`btKB;p^oreh!=U7$DB+sUe=K)Uk2BMk=HE5c@2}b=<5K*vIP&7 z?S#Ns_gH>1;5UDObm9bz)CgdAjyHZ6QWSuJMFIQ~tC;-(B+Wx-v3+9k(RRSIqGpWH zc?8*IWk>Np%+{jh)RCWnBD)uXb~1>Xi31FN{~uH;xn%Ek`}H;IC%jGOgYz_6TjWFi zEOHkaB=$U3MpM`dx#f^HazA_<^x9{r7d^QIC~MI-Eb)J<$+Mx2lf*AVNy;?`sIKOu zkN|g7xq#@Kf#0q9-L_P%U?p0BM6Po{@D)RXp1NKHMH^Z;nK(&kfDmreT|Y+;sV^9Nz?`@v}ntuWFUcy57X@|f+<#!YZ77= zit0-TCSd&y9UfR5GMMODYBIEE??JLB zte7AS9~6}+PANU=og-7;!dQZPO?m1qn#To27~p@$j;DCnk_K5b4j7Z1@`?MfqMrv4 zUf}E-Y@ZS-qA_eo7debxiwJzYOyFS)Ap+OU@%|WG1G0>SP(U9hep<>t3}X<1Vpy84 zV>$6Dubglsynu}E89pf&M4WJshBLBOQQL8NgPID?P#|s07H?q<=U{?99;-)clw<`@ zI_`hkVJ6i=jglHg8&SXjNT0b!2(MJI!A`ieU8&y=w*dH$0t8>9Hi#~Zni)fPiW$tL z4X6M#K!Whyhsxy6Dm+v1>*;-hr?$LFfhU443I|s2him< zmSzXWqwe^=%B9cAU2l^|1gamgN#m0MiH3pwX`Gm?&-y1$ z!LXLT{$X!j8~^lW&>T+{ql()6?eMH1lp7ISe1t+%?(b#=bcgTl?$jE@{kPwx6lz_q z;DP@QjsGoWWVmFE40*V=VHrrA_F@q1X4U_(_q4Qg2|@gv6GRS6BxC$*T{n0 z>wAhsl;o(R6&dM`U~21L6lmF%8(M#uQ97a;?<&G?#3>!;+1oLSmU0ZNAG+5}8d^$z z_W}idA@*Xipvwu#L)h4OAXzCm^wdBRc$ysy=ML7b%WfXpjJ4A|p^%RY96IjALHO`| z$)i>978x>tIfNt_Ve8b(GJ-R|*b-=d_J*D!N#x=>^bM%e?IP$%A}^Vc5BGnnV?0xL zoU(W+%9Lyrdp_!f(J-A#5q#^-f1qLHR{?A$y}@#@Mvc%63_h|V-@&JEEB^Xi_uAHC z%%!<<`}+#<2aqj~Y%-S1rfp4kY-$M<7R({iDK>-O`m0CXHV@zNgGW>(BV!Bh3~>Y) zmyWcTNqsu335$g^NH7BCVEunX$6w?-f5~Ov1f=2h%b!pHCL28NpOQ!_S5X9eyW8{j z=y@s;g-bzT!yDp+j|dF(67JzWy$wM^Zb6vgEeIX-hQHhm2vgVj6@?tZ(>qisAYxVE zdvEIJSFT!gdYYvI!sL7(^7RHCPQk|lUd0}ylO?G;nS1|4{5m@E^N4>1gzU8?iR<%F zpzE8X?D6)InHw|dW3PLQ!kEhsjvbFB{+OyFyq0nAP|y*^uJ`2+HYkkGo(km`h>(9K zz;1P~k0PZ-d-wZ^f5Gr*$ENEnJP#He!?zTni42o?VWT)ak=D{;9&~+Tv?0~&M5w>y zP6Vg!jRSo@6o}?v|8Rdo@}m#3hIR$%ez!u7nRM#6H!&`W%clB{B*uo^OX4`pxtk6P zm&8Qk$3Zb9F%tP9QsBSIP6v8(hTJ71aaeKAVSIg(W3l`XY5Z)XNKs4~=-|E~fAImz zD0hzpocQ@ms3I6rpa|J8b6qSr?FAM_5M*TJ zuvrXx$d*J5#TJ^RXD463_39?6VF1fcjJ=4}Rn?EGu4gNl9cRJppKspo-~8|)PG-CH zF5RTF{b3dc!8(f5S(XOtB-+gO#q8gUpDWXTR4=A$m;c%S>xU0fHkc6y;W~fY!g9o# zWXSR+kPT+5C`i}YZaZ6TGMvI(xvr{a3AAL9s~UlL@u(SbR&}SU>V>fvbLlG8>Vk>t z&}z%zbJ?DlC-0ipoXg)G(*=&(FzL4-2^uXc-@}yrv|nz6h50QAHpdm770$T|!}Tsn z_-vikFe_Y-$J>l2w&v27ZKba!j+7A; z2|O4pxRYScUDcMWi>hl~twEeHSiG%N{lwJA7ycIdump+%<{QqR@@cGjexNfnUoOGB zld>wOJK5~AMbp}{J~I4y872#zw?=4uUkJ%21Roq(t6a$DAZ#Q%0M>sjH*nuFqpYvU z6xQwUAwUW>9cU;_MMD#Y|7}JjPVlJgLzAmpyx^YL+3sm$QOKkpxtiM>wRk#6D z3cp5HxVmt=fXzgfrnA;`b-{izWQ7p>{j`w`wNdFq`_P<9{JlvdlJR~$X|&onqU_YN zXfTr4#sl{HI~+i&V;t?tVA=3j6$Pd`nqlNi8Uo;CZ27yXTUCF_Zl)>Q($s!K3LV24 zsMCpPAlWF|a6G}Uu>~dHO-B17D%Uk9WMpgk>u9tCGFy#t?pPYP&SAumE+`p8-fi44 z2{065y}`SwCpte8y~1b(AB(S#U)FStBn8{c!I)ak>8li$+n-RA5rhj-F0yeQ0sz$^ zK(o5&a$U%rADMsn88=r|r+G+{0B^v<=d!98vifXLXpZpA#Nq;xcbzyi1h-42TMfle znk?>6#;vHBsnZPbTp($k zHQwz+4rMvX!^AO*vXNU}f_^O9C*aEie`~|v`4WEQ3MGG&&Y7aDEOoK0xw1gz-|DSR z_jp@$o{C#h8ja!>jUB++OE&{cOe3GL5mt4<0B7ab3{;g~bY7z2Q`HK~mBKi!BDe0u zZOr?sWG+_z9m1kl^#5a?aEEKYPr`h(PZ+h+fNBy4VkuOW=dyJOsQgrY1eNK!Xl_;2 zr$)M>ID&tkp>|O3Eu;lR&G9&MhS8nzt83F8PY8z;Ef9CqwYJb&@rZPXK%tw`qEX_& zl~@S-5^ExI?N7QPw@CZQLB^gzw5)nZk?a89LZk85nwe@wK3c7w8eu%CmWe~wlv%UI zibo-TN{o>boMm6PQC_KLHRU%=dBDrheD9G-?~#9P#gekD5BLp_skVkMc_|a^9Ib4( zK_xITHx`oF#W>T11&_8Ygs3Ta`pq)R^vF_DG^UJEU+wNUpV0m2D45e-B0`7)G<^9Y zxonUQA%^a&tMiufGGe(ja9u?_)~aAyw`^tVV`tr1IZ1c z7_Wbe-WEpQ7H`%;9QjTPWUz0Q#qf!NZsIW_4cFVim)ukx!7ja}(@rPZ+*upK6tj`a zio(FL*~N<=i-O80lE0^tOsg=6*4sE4i^g#au5)ZTJG=?F*%w0_^(MAmaExH4EBo8_ zJr1s*WNB6(V8Gao7>|f3i?cY$ak*5b!?J&lUsZY>HTm5Hp;*#(0-?mmusLHmD#t#^ zAdWXfc8t%XC^u(rN$v@TtBbbPiy!$^&x~|qKq<_m#~O*}_gVt|-eGxA%O7RnL_^etEwK6~FauizFGV@EFfu)ziLH!qQ42V7&ij83%uh zPw($|_+goW6@R>c&qHJXHW@;?%UmYRI}d&G5Z$Y}jK_Yo_fTzYd+J9X`f2`$fve!; z(DM?~kN)AIM`)YOxgUDy?O-aD^w2e&#uz`kms%48$ROdnSTcD&TOLpC=y2ALe({i2 zP0yq~^nN~Bu;IqoP!9A72tWF`gk*o>N6&h&^s|S4oqyf4#n-)DMM?j-hw$*_DoVEQ zF*fNR_YmfqIdKUV8M$N1Tr-r7dOx636+EO5UqbGtZs}mn*}o2~P_1L9W4l?=J^q<5 zr-S+r3-Gc&^d;a!(_L;Y@ZO2%M;nO01>{BU4ycUUMAB8qK0pwT8|Zix1ZaPL%?wwi z0g|Mw0_bR%X_%OpLoVp?#PEJ-kmsxib+poBOT1E->)`;(g zxZ}rrtf9ch24xX9#@MXJA@w~nKMY~WtF(hMA2ygjpUPGX?dnB1nRpRi#pqmeq01E| zHF`}JF)}8?{m$L9Hl>(dHjIDEyR?6v9@cP!*X^m(r<{0!T2m&*7xlhPTu;T4Z_b30 z7v%d&a$KP<21Jzn_HGgH+&)0LDLw)XTBGo><2Y!RG}xMYs1y{Ju4Tfk`+&5z%%4Wc zMq`Ny0cf(j;&yb{h~cUaMS1Mou^v5S?rPw8H66Eqh2-;c|9k6u;Jtr_3yxtSw1+qd zM{N`0sY?TVZtB*WN|4l~0r0uRc91y~dC7P+&*(~ynuorh1D?LT$kLDuX~H?aUx7u6 zzvaI(@E!TbYzyw$@>l-z$mFSbD-JiL`1k`b>Hx~6J9f6SXN46>18F% zmg>=+3Ci2ae;9qe8*msShL2wUxvj4=`tEY56!(3D#&D$fy5J+J`e#E1Tr%< zGM5p111f)QZ{xTT{=UD$Km*tYVnuJ1hxTMUu_xcX`F8#0>egFMR@N$TgULFXIJRwhelS@E zwk14wvW_SJo{4b&pY=bkZhbMJ^n#@Ygf@|U%*%iFz1){wi==OC-oUiLYY%uAp1(ro zh3i}1(xD|DWWC8%(r%hG!*3*WHCpUQ)Ma3;LU*!oTx%tGjUQ80%om;rXB7z4X2q8N z>T>Ri*%SS=S(~fo5`IE4lQgFHq;A$=yPC;3Rxxvw+@^{;X<28#ltn9Z-mPr1HYS5d!53I|$dan(ww9Zn ztheCFza6-oIc|^(?BxYBV4XW5cyQ6sfc7nqeFa(*lGv@m+qh2-4xLoE%hUG{=IWaQTpsK&)zj7E;)bl34^RtMyo5bwmCxZpaT8pS)m%Ru;*JAj=+yVpa8-VYoO6wFX$;Dx) zk#pDX0}MyVn}GzgEovF~v%e=aRFo~VRVvCb^=QY00n~V)7V8WwlIFLytkQohYUu9} zC`7~o5Ma`+PT8lc7;o?_RWy(ejgj)4ykEuN5QVCmtEyq}|65TM@o!c1y*T0C!>;0` z3J$Usq70Ty&ajP7Vp4K=wPk*s`w-GPpLiJDg=wRda`B4K9NU~y;EaH7wy0!Ls2sB@ zXuKp+^e%7gUFi5r0f!IGI1YbrkPydITM!apJEe(KHq?1gsyKB_4D5bBI;qOG=^2ju zH=>8w=5y5Z4%m2n7JB9^gvldpMBr*{U`AsDq(|5Y#s(-fHnHk4qlSnyFFz!MTjlOZtB@Lrv{dR>Txu z9MHH(Nj#VyXe28vJY*qFuyJq@mz-uGPBA_3>IA6wA1AN!8tIc(%nlkTLIJmiyRfMsM zII@a3vWj4$f4#K@P~XWVQP({PiGy>jZz1WW9m2os7@pc z*K@|HLtoYDo{e*+?HZMIIrX(>o;%~i8$M+g(-bO8;(8|Fy`z7ChySOPwsy@0;3Z4m zSANHGQ+?pVy+BgaJ858C3I_2^r&R-XPh^OBRv*iBOGGY}W0|mnOL{{C+Shq$UEUxr z!hLby0@C#z9;5d+#Gq45;QwZddH32I_Q;s#jC9Qzse6AY^IMkndjI~25}V?oq0&ZU zyP^v<{x^W)c!qy$x*9n%{0#ych^Fv6#kvI)()T@}&~2nQ0-SwX^Olhw1+!|hb-O@BW)IrYnh|9QToeaJqCl-5Gi8+nyjAf z0WZ`b+mwP3&~QNHal_>)(CP{XS_1q~zI%8pHOny#2<>khyzG+nv7N&zhrvQ(9FWFNtM`ZyCyj3*CWlLwm3J4M%S1_k!lu}P8a+u=4H==6lff;Zs zeUQNTuzZDau&Y2hPGTEnGT*Qy&D5etCodRA#mc9saKY7GkJx^guUvW}IQ8`Oh4^wp z*gLdBXUTsFw*Gv^`TQ*$eV;kDA=z?1NX*TGUJClNtv~m6lIsUNuKU|bPPs)DM`JWqpfsWFMHuTsxDFw6W5W&f(R(T4RwTm48wKkOp@NMX-2{^7I2Fmg~BMn?+c zMLnVMmkPt=TbdgytY@xs%-T;nb?;d`@X!;Em8*YZt6yR?+So^V(By}LdqItJeysw^ zZ?Yme7f{#_LYlqD;S3BT1_k;fC}G;vuFTignJl(C3Bn&i>CmIcfGs#YTEQeeTEQS{ z|Ka}qd-~JxJEmeENN}>O!xt2;rq6V~0bEU2{T{eP4;Nn(U}OlFxtzjuS5=C6hENFu zmCt`r^(;00(yUjZlhZ2$O2W@)w1)YC8-~&Ja3rk(E5M$l(kVxN8fFRYrXm~xp|iOB;0)UEE(A_ zgare?KU0=g=&}j^L@(J|F6=0?w*JEd9NYJ$jH!IXRD>g_GPWI>uxWMP)Z-~Hlw>eW zUH!mF-K;QVSu@&DBQ7it#j^qQ6^qC6eE_pSOus03t-33|(X@+~#IbDUrjnRNk@U|C zYMXt3)2f|?4~?XQw`}yD8)U%WOCqdf^jU6M{rOW3aD!uCB*h=2?Sp zhIRq>iWkcPxvDetiqYOi?6(HLTv<4(pCXNBmwNxew}d!S9@pBHvC6M5Zhrc>`EdQu zn~ST9PwVgRZZ@}fH~+fW?3667E`GSaqsfgvmqIGZ_awv#wQyoU4r^WCtvBzk*Ebhd z5g9;wP!=PpI6agP%}-}Q1LUfHlz2(|o!Gqa|C{xjUjcOGR4kXFA^{TtFq5H36aqFh zlTl+Sf6Z50Z`(E$e)q2sG6S`NS|LSAmWJ&iU7c=2lD3I6Y-o#swrE$FE{;Sc_I~{i zZ?dGw>AbDO9t=|FLZ0h)Xk@J|WW5=@nh#FTUC#>b(06=mzOpbvHgSDx>Lc4Djx~?0 z52JTU&Mzr1;_dj;{O8kiGHqzM2;0*Dj+3HZe<(x-NM8V_BP#$|-xabGfA;py;Z{`PuycYZy4KfFsB%}$5EoLwuX5Pd0bfYT=!*`XIU z&Zx!ihQH0uu7|_Rw^#EYhjz9U?2pL9;wRN7zH5740ES>Y#DO~GoAJa)Xmpi7s?8%) ze=9BYreHMMsV&ddT9ul2k<$o{N8$>*&%~0`g1@Gml}h2eiCULRi%fACco-wBoRmC8 z4pBe3Puf8U^^Z1*xe{NfRSM&3VZz|qm344<~ODI2BJ;3W;=+r&} zuX|ZwczM>?)#t0UGaR0Zw%R>I$4?GT>La_N1t?X40B9D|+*S?!a%MA--n! zReVV|FFVy$``-+TDF>6Gx&nr29(^$6m+c&M$e&b5Jz`J8@K8k!;j*WffK9#mf8hCs z$2?(A^7yV`QM}|VGEJy^X_XhIcOSHop^r4L$Wu)#c`bFY7Uacc>*ftDIWuv*Wa)wx zjZormvDd_w!E8RbA7D5aS-1vNk3f8!z*?q*51)_~0TZsaNf=mp~X zwAx3}b?fMju{VMUY8k4S%>V*5lISaTsY;y`iZdBaqeXP=WZZx)Vr!2l1O=m?xDqgy zz<63!i4v1d(m13{;)p3$%_(@igbbR#0HE=F(~}_LK{FJrWEocJ!D^(w3_^ghm@muRFue`G1Z3PFILQc3S5Y9gX6UJFF`=WR*XtT#PR)75SgldiDa zAELD%XrcRgQT*O+|Et@J3xlS4a*)>xT8b~isbi^P>NT*&mf>k>ofP?wCX1wE?ukBq zd+2Pr-92|RYG1ld=z<+~W2?Hn!8|{^xS5%Yo>xxdtZfD9HDML6f1!Hq$2j7j4~+RW z%c2%*etkP@aeLH}jlF|D-$ilB4+ii{0;@P-d3BIo#(%K8DvNnLG$)(wNv}agXT$&= z>62{RHj|{=3Qnj>NVJ2i&N(Z_7>(8dA{ku$Tvr_G1`S?N|D7?>!n&ysQ^GM*;;e4l z8oS`LMl9L#8K-d;e`jkA6rY*eJd7Q0M4_@Z9vE0zXg=g%lh7TD3|wd^X&_0>O92V& zr~fw^5z}T*U@p2Q^s>K?ag|_4gZGk)MkSa?M;Kx%zZ@*^N*#S3}`P_z(ZZ9gsnu8Q2_RC4v&bwE?9}6M-`ewTG1EZ>Ip%NA?js8 zOb)~rCR@hij|e$TP97kw46h+3QssFgIXtn-jUb!ch`q{<6xLjs8zolivt@4jhNda| z4Q(ey6yg6Te<}6oIu-#+=y=oOW|-GL>zUNcGfx(9;f84s1e~@X4h<*&hEt8;stWW%9Sb1?F96|r z{R&XxwCpRge-x$dznJ)E^1YqVZCrk>jBDK6{Wresf4-_OZu^yXtTQdB^l)vxdAId= zgqzthC@5463X0jTP_Q1A+8@plQ<%7=+ns}oxF1*GX1c4_53afTbh0px^WW0I$GyVUdn%azLHs4 zDCG-cwrGA~HfhbC`9Z9w&uFZexXAH=3)z|8GcS(ZWKNqsZ>BSv%$>a4WGj~A;9*Kb zhvj>&hOr|{WT$+Ur5x$Qmdh;{I6#HisdBb5^5cvhv)Zi9mOQVUrM=Jr1J!2vX&Qx& zJDmlg@7!~V8h6t;aBhCRzg2%{04ryn=O$r@)-ttBNWhf!)FTet=kgjkhi$gnBKeOJ zab6i+uoDSu2hiJ6WS`4Io~`I2)&<%?HuEAk^bF1?v)mY@y~HyJtYj(Fm^$Se`HgjL zo;F=EP6kfJTr|v_7aO@n=5Ak0DZv zFfhaw_$(p>eFl+^>q0a-HUG5d#fl?)Ey^A8J)>9R(CA0jNX1lUbQZHlDlSUnmXUf0 zW+_N%;IJti>k7H79y&rRXhyi(!^wG8@DaW)Ak2cm$qLDpzc>1-1ff$`aEaEZtk|Fe z1}6y8td>k8r`Ss_51fA&Jsp|J+$bnGIx>6VfXRx~OxPNAl)6Kx;Kc*y`uH<&#lYP@ zkT>byI?9wZTlX%P-M@Fym}qWaS!~9`zRos#!QDfaLYRz7YOrNh)|t#y5aFdmZn57j zwL4meW%wf)?J6R?gBLcV|D;M*}c_(3bVt3fNd zt07*=b8`2C#F227N+eUk6m$opyfw4bNs(HWc`3{`Ce#ZfYWPJdb;1angfVv(e@+A9 z{B?_?-gS+>$92_6ePi6TBjkJ&VL*&8_5D&~H#8y8iJE@hY2ji+s2?W8^}_EMDMz@2 zA5~5n87$|+`+k4Y$yQ2c{7+ihN~u|lIyy%bHpxJ-7>34|N|>EyVVpR>tc@L|97$9N^qt>8fff6j28Hrs73my9owRAU|mfY&}}?EIvvnm!=4MwlYg zJ`R5%-*1{UxUi3l&nSM>h9n6P5;}KDV%o>IQ~0#ieeUp6O83cT4!b8VrL@xss(4c0 zAEw9^HaYIACSx|iWxB=FWA779T(lE^+AWkeIKIg1s`3mTT-mJ;ZBV;CvR#$;F6d*w zILlgxULfcKK~OV(=!$^57*Jrk(@ z1ODu+L=>gi>8`A!;8AjIR5|O4i0hlOrWG4Kk0Mvu5+<$}&$|XeoYkFmRv4mweAs4^ zE8<%Hd$#6lk|wQjng&T*o-UX3pfz62(-8F^-CQejKVZIpp1AZ0{NY4xk>hjip{1e*)3XUZ_sX&|ZxJm6E?-+;-7IzTHu75` zN^v>3&~adyyArxCroN)oP-Z*c;1iNvS;(z2>(bbG8d%_7G9hhz@<(=Vdg4BWm#rfU-H$Z zI=N1(>U!TUEfs2;u0ipUfu*t-6~8kY?k+2RfhJ zU;OcCde9HsozmmM0ipmlivySV!PAe{Fn8XWOCd*l?Wb;2NKLMNJM}!Tc^XefR(sju z(?-4&Y%of@%l2dx2c{sor(Dq5GJA^{VZAOQju0XCPhSvR!Kr?zNmiMH8LFOcZi?yuibchrj`ueLMn6OX(*^7!2Gc%Vsd~>tCDLT@Y4*p} z-DuKK8QYFE31Gfb)_1hXe}zpefUMt;9g^_So#-)Cc_`SDx3mtmV65FV7AA70)+q3w z+4<4->?f9A4u-yM_g85yz7ZYqOs$AkX{Lmd9DA>^`QZoR7UCNRc8lo{Z=DELJX3=` z^c=^UdOjGYTMrGJ=Z|gSw-5LCG*g($gFLq7lFeJ(*}I2Z;)+D=e_%H)wrksHhD{a_ zG$6YzQP`6o)--U< zx%iW*TxkZe4{5w6DCjJwaGKb$I@CVkx3B((gWA)KMfqOf6vj3g$`~OD&q|kYa$7A z&I*#Etfxu6`ir-KC->+LJZSOr7acdU>d|Zdn#y!-LX_9A$>PPkFH`u@hTMxnwSzV+ zO?x>YbX^=D!tVxSyZ>-|bvKxd`)}^w-(H#{Jm-=kWkqqqwgS%8a0KCX!!gPr43YO5 z8#CYO2%4+xe`wQxPZZCev=(D{~dwuHmheHh1t0WV@Ik-aIJ9TN=lvJ(jq8f% z^EovGtZh4ZSZ#AR!GNBx$#QB|gjc-?IqGOs@L-cdj_pPy5gur&uk|D;>QJ2yBO-xx z;7-Sox(Qeq)Kk6^5Xi}^TDQchT)&OeKGN?we`TPbZz@ZR{k&lAU|qshmEB^U;FG+S zz-rkvhbL2(CXq;%#%E@Q(<5F#zmE3RJ6@!6O~%fP6NDOPkHkUoS=HW4o71w@pU`r*k-IKbkb<@ ze@fdm0SRN3Mu3+WIQ_p8xx--=hEOsUd%}y<+;Zhc_0TeB*$Q4BvJ1B=BNf+OY!-dh zSEUQiNQfvNH37$Ei34-BLn18i&#hJde>4Y*^&C|~L6bmLVd?Ux?$t`ri5UtyWslT> z1(gXAs>|505a3$J?}ytR5n7l|6MRGuqrB$~ywd$d* zRkt)&_araFS5x)Xv;W5|kZ6$)j>qD*$8oGH3bikKd%MNajN3aKbw7nJd~e{7po zR8dhRzm+K+#%)H4b5|+sDurF8u#c4kuj7vOxcy8f%CV@wat|Ek+9i!;fK<9|p4n9v_rUsi!NqN$2Xh{+#_Z zq~A9;db++Qu6{a|A_fi{;Fxy)RIt|b{TQdw2lF|4sHNtU`SYu_;eqpfkbY{l8Q#=# z^tW+oOR)E4)BF|uXpbg}#~II=TIa-brc)2Rik+Cpb6qlN+ScOc@9-Ixx3i0X02%S& zmzSX;0Tcl;mw>wi6ah4sQ49hpf1MazbK^GdJ-@=UFOg?rRo{|#rVqK11%)vzLi$?kAQk=dNSz>bVpm`4fbNRI$!v{Z{=mNQ|%#>i(IrCpmkB#;)TH9f1S{QOK6#fTB5FY z2dzrq4`3l}MbRzzR>|XT4mv$FjS@^@SE~#tx{NlYTa_JwM%&7+7S*Fl2a1nKgeQEo zvd%NW4;`zj@rkrL^!!P+j|8P3zZLllt+tPn0G5#m21`v) zF>ygdQ^{2Q?l_(yf8Ns}%v1p~{Fr;7ft**GDHF<6Q|01CX249~F158L5%W#(MlgVn zkrQXKU`2XKY^A7QjVWoYz~5Tr3n!v5K=%Crnl(55tEFYt5S6NI!0;PI4g?ErNeEdj z@XjZiHHS*pY7f|O!IVH{+gt%^5L?a5epBX1J}_(muqmIBf1E`1`wmGA%f(^8ku|~P zmPc*kOhEAnkB#Sls7y;3Fr$GHkYN3k8og{3QZYQKKjny_PSlw@mSe#+y+w}vfx}zn?~%bF-G6$ zz+B{We_M-nE;jP5Muyj}@o1~kkU*I13LL@nB~KK(KSgIqVM7`dE#+R%~bb*6S> za}Rpr5z-{tqf@@?T9o<>!J|(1qTZ>YW!F*%Did&mUc7;%1ZMw6H!q*lk#T*f4mCWr z_n}AbDI1`KyhVIXh``*rL+&Q4P6&)=bby(3f2&TK9k{K840CGxwF^d*=Km*Xb-KF0N}`z905F{+vr|C(;?GMMz$w zzGP5A#}Tw8o@q<2xju#l!Bm>QsU3Zbi@pPjh;xi4I7*Q+Di)svVWHzgb0TPJ>Qk}fA?uY-rM z2C$9;0GkNR3URF(!YYMs*Lr{y;V=P!zVQ)0`e3&F$oZ!K5(4X!Xa((Ve+kVy21Z;J z*<#8czYBaN{A&n$e-Fq-;Da2w;=RoaEfKe{VA>6YwJ3wlp2;9#l#Ea)kir`KH7soy ztKVKvzP_|~+-VLIYHSB_U`!hA|5dB!d<;#R_hABR>!td^hn4T!%VqbyiDw5kLY}#& zWja;i6~}E|?rBHR!l0s|gM|_%JAbTo4+&t@6k}yBg*VFO$gaqRMzdo{oSBC+Ln`jw;m*DL>#KM7 zuiktJqr1&|6Z`Sq{llH-y6Yf}?~>SEM}dELpWprL{G+VfPpxWH{rBv={Pq5CZ$5tn z$zW3Gdg~;m6%BVBfaR4dGVCu2atCu(K^kDv%1=P!sh6r~^=S4)QWCE>sc$9SFN4S_ z+EOi7ewsL0%fIbW2yK1lM*T1u+1F)#X}G=1nq}xZuc^05oKvk^%X2!_Rrx%b%6pt& z_RG?boUAFbo!!&9saH^lw!HGZ^(KFcc?>TF-lOi*7cd?{@WWmLH zVwABd#VRY$UwerN*fpOusT8{|l(kLLbz2rE(m)6;ZMHg;YOAXJC6(_@}5yAUm)WxmM7=%=9cQbnyVZC5fZ5{gGP+Wl1V1ODxLDi_+XT z0HWUsVphS%hY@&iUpI}?=emDlr(nTDQ{*zJ%5o@-EF>%imiq#Cs%j#=6F#HIXe-1R z#?E75WKe6T_?I1NjzJi+7GdH%T&jIr)D=_Be!^Ik564y&N^6%b>*}C|zlH(ajYR=y z0~E|`Icvb?298!0R&+zS%LKd8X$$?e8wNH6{h4%V-et`%ZsgLRHxqvyV{e_hUCaUm zAf-pTk#rQ{7Hw!}RnDVqD7{963Z1ukUcf*`|9;fywDR0wol-;}srFDe?9MTAHt+;_ z_PI8KdWfYC#|UPc;4kfiCsxR0X*M5G2<)|hM^u!>Ssiek&t+k$Y~!gjSQee^Go>E1 zLZ^6O%A${93#J(Dh{Jyd8PHf5*q2^9j&cj;<_$wcQ=e61;ym{xcyW9V*<&=4*K<)u z8=!fv^GPWV+<&r|;4T}V8kzJj<{VJV82{;9W>p4%-VozMmQ9Y>7S%%^=C}HC?t9k=Hl2ACiW`n^%xfD;Xah9LA=g9+F7s3P8SyI0~hM{2}OMe(Q)g9MZq z8D|xxsk4BYdA{d)&VpBIv(HOHgxN8qx2=f}oQLP4WtDBQqh?`3$jbLqhP#hI>|65{ zrPLKPynE*1Ts?n4RCXy_6flABJRVgeOc2Oyg=Pw$D3*%xr&PIg%MhybGKsaxLP9*$02e5o#>tcnMvy8MUln^lYBm zjML;s@~SK|1`K8uGRoRg1EAxxm#^nG|33#CCfeUC&9Oq24+f$6?L}zkRtZY_veVh= zT&lyM9#wR_vn}~lb!BSaWRF{nwZ;DPh^Q5iOAwnaV7Gdo8Dw;|E>_*<#i6fwd-9Ok zRP|TWA^v}g$ooBI&4Fv5TPo&HiX0red^YIXG^$KNH-#|K_jT1abtyzs2UFuqfr^_s zG834_t96WIEBO1d;%-+m6Hiw%lgB&*q#1nuA99$jP3RyI$f0jhQO3FX5@K_fx8VeZ zUz{B5(4z_%c?h(DNzkR}_D`}OA`!a1d=r2?x?6vyq;3~e%<8Z%8iTV935ObKbSyAhSaL%2A3PI^I@4#t@quh_piA>un@bVkr2Q^gBq-Lf319> zGs1Q3cIP$IEvKTF-@?11LBd?Hkvs!}S&?aFQK?z3lzg*9g!e+@9cX$^|Wh-jM)*&HUHo4f}`khy;XFTfzWvIby-KQq{sT$ohNopDor1@@Ll z$-lascBb^Aw(%hik{RCU=hF^BAM`SNHd(<;teKYO`IsOphUT7RZoHk@o$FhGo z>BvQfz&J_ArcDR10XpgEd=v?ptRqH1dw3GD;45Ea5F|6hRwrC;Er7t5hoyq^)en8h|PUm7y`}} zz`0|<@rYE800f9Rced&lG`v#WswlE zxtc#66+y8XOSZ45-35+Ie71tUvLvN)H5M^<2XhWF;aEyk8g!?lm^ zgM&P*d~Syy$=%K2shM7ASq%o7s~RP@{8v0L&XON)QMxC*&Su9PRa4^Z#ti)=sauWS{-XHnL z#_!k6+FODR{<9$WEAtg1R$q3lDc*CYdvjaIYwLRUe~G-mfAt@8fewiCg6N$mhF!J1G1ZvEbx3YiOmiZ6!#B*f!u%0hHM>Q>q z-Ff^m+kzf%pl1;V0V-MqOQeyyR=1gY-=s2ABOO=PE@O9<1lERoGkp;V&)Lm=FeGiu zn#Z=&9(cx2o)_%9nn!I}aR)!_&KDubzfz>8%i6|HqtHX8a`38Rkl(Bm0lsjyb-spzNx}cVwS~{6Lmt9M9dt#N9E%lB%%ZRzLysovX+7jIk z1Lq}C4tjr}??0TkSizi_ZG*OubzRN_;T(-JpyaZi`-!vH z1-cQ(4lEtwG`Y+&J1vtNl{L>`u=E{yn)||06P$lmrw@Jqpo^lH*M+hS*LA1t{YwM9 z)0sl>pB&&f+N{<%agG2q`(_LPQX}Vq=ls@tZQ~hJJTX*p6Aak3kEn9Y>){AyNdV9>r<wV~5Aqc#WCR+q+8jj$D z@d!Q`8^@vjBz)pg_{3iUAFCgj`eX>-v1gu7*&o^#){X%K`l#}XYgwaB?0E(l1U9n* zHMK_#CEM&#&I+icBpI$5K+y&4@L&bG#$pRZRQb6EbBfO|vIZ*i{V`P6VBae)x_^Iv z)mz$JZ*^Oy(^|<(74M3)g&ad8DvHCoWepXmDvPZy_BL$x3%4(NEVEAz*IU(;S;xkC zf}XRm{idTq9Pv%65CEmqp7I=&^rImO)1K zOtPwH8ncj@DYGtto^e^B!3Rhur4`9?-PURf(VS3%X-VSbJMb90E9mku({lFQc{tF7 zGT#!V%r#LexmQH0(gSyl0mw7wSfpThkkaHOQJR`rZOY&7nwlsld73;X0i81(^jhv^ zCGVtD#aZu+;dqvB(VY+0NZHkW;_4mFWo7Sz!s|;Gj?8~2;tOilZ|9IG z-o5S*7&jdcz`h%t{fF_!oSGu=7Iuws7zX4pbcPPYv5OoAIynrKi^D)2IgF>Y9nn8_ z7?>}JH+I-?US^myjwW-Q**vHt6N?lwz`i|Lw6Tx&V92@T0ex}%JuK?cd=KmWRzTr< zer#8d&lfSESQKbPPy&BD8{BD;UTazGO)ZBJLFw})_#zf_WQe(uER5cN^X}`fX=LE{ z?VWC5K{1uGW!vAkZd`l=xSFo|GjNF>EuesD#bEGsDyB&#f}x5mRN@h+#N$wXGNFYe_xdFBD!V!ielo8mpfHa5ytaRI6V8oW*+NZ@;eh?+ zf?7z*wLYO+bpa_FJHF=`^ZhV#qg4zFToJEG!QY7ExyyJqAmdR|_|Hfs$a9a#Mr7ef z!VLs!^8gZ-JB^KL)URj&RMMOXFQ~ElFvtUP7+VJIV%OA^!340RH^3Wz`TVpmFIJCy zd-VsO7LR`UTR4A2-$RvC<$q*lo<|@ktn9??*(#T9rt@Z`IYpV?^VJY}Q?t_{EsE>!tfOUNB5@5)Im{6x4hY~mZR zp!e{2;yv6K!i|=ReK%~lK&^!jR8M!r~ zR)8`hJlaQtbh?pr<$}^rGGQN5?Au=f_~I9e$gviLPNVmQdFe@Ikt(7=)HS3+9?6zk zc0a_&7;MtAK)J1Axd6{DcnLMnq#1unHZ)taRj(sdc3);zHPoBQ2cQtj2^6Wey&MSx z&levTRolXv`yD|_Yu=ZkA^{VVVI33%F*h_fmr)b~DSueqkJ~m3f6reL6a_8;8rR<+ zhwb6AwL^zuz`AsOXp6#UD~VCZPA%u!d)ePUQluQ&=cJcmKwlzCq-63Zk|JYIH&c81 z+hn<#Jb&p2)5J}d8g4NqjAw&DqkR9OvX_XPfU z`}#GU>@W^J+fW@hw0xiKx@qQ)J=+|1qH5(?`+v^c#a0Y)HSZt_tt58!9o)OPZ!llim|quW4+zf(ZbFC<$B8=20=F36Womc01s%0j(^Rt!QX|Gj|+kb~O)z znY0Gl_v~G;`U@wpqQEn)US4Fi=X<8rIAyDmL~}gfCxvl=tVT*(eH8Pwn6ItIHL}{^ zdVf8ualX_BFM`CLt+vXuLC1yTSV<6&uHbi~!gyk&<+eVQInlQaXOV;77}v+5`?N`S zq63+}#vY>Zz5r^UwCO_OBCK6!mTf_qj7*2AY@4FmAnneIDhJ(Lo;!>e5LLQkN&yX` z9jilyrfFI0)4pztY&$rpg&>z>;HC{Dn19u~{h<{(+=b`RU8wb3tT8gvL)p^8-P{e} za|eyQG_l2u@E<_sW1S!k~pV$iFmlFHay5+yDTn}1 zB?4WjEJaDj5K8cYx&oklJ3Q&MkAw|#q&1cx6Q5u*ljPs?#HBOF6664}L1N@QSAQ0= z?I$ev`rLJ)S&0>Se9BXapk3tqPSVS+IORNpBqa%?)KwuNmD3|-M!wo72cksv{%U;x z4GmZsxyE*9uhzt3=K?yQ_<*%N z1STZQxijmXMnXLWLHNepi}tm1OnnVa*)Ve-u$c*!&RBM=_?;;@SUMGr5Pz;H15&%hd*4+Ms#j7s;P7B+doo2UAgwPyOk;-8=kJJ1fw$&1zG%ftbV?WxoC?w%c50gTyh^8TYe&4CFtZ&%D_RL%315No2|H(F+};XM73+xxMHuYVLN*6^Mk&*YbbYT%H@ z$EoEWQcVNfXhKvVC{CUIi|a#`wbW?BY~R$V z_#JfIl2)k6#1qSU&wEt6dgR3h@QX2<@HQZf-Nb0wu(@lnBv1^8i?P^0N~BWOSpiuf zr}=(ic3CJ;<$tpT4H;g_kts1^(x7J9q8bp=G>%4Xc+N zKPGHV}Tl zzhaeMb*y?z0AmAD`*2k*m8vL}qD^0tsNz`fE-ecyVDE>j{_maf7}n;v%aJ@pQTt?j zJRaMhXFiX?n{8&^?3a_DmnY9(v1pdKi3r4Oxt{r+=dw`DBH_851+(R9_TCX<{&D&1 z^H(7^G?|E8;U{26>AZiHbDuk#S~g8ym8gH>=~-Y3VGLY!BNsu0LK=Tj&wbC?9Cos7 z8*BKmgmrl4isRYBkKLGYGPFwD^lmu6xy4AhNgQQrvFdA5HgC9N%-x<_q+ONK=) zeBVvD-ix-wJtuFd%&Oh~(8`rN*r5f53)lC8BQCcSaS@?`i#Xx}a)k?&8kee` zbMCnF1>?+Fs_lsmjJfa7K0wlJt3$D(p;wa1dQCnzD*|#71JM}+4%!hJAXj! zN>4ziJ23GCCqdvLd`1(+0ttNk%ArVAKS#dX6k(YnHZ`!nN zKK@=BJA{G8vk(&7>is#4s8(j*WkBP9EpXVQ&b!BcWf9(!&qW@5_aEg zC3r$j4RjPNYYDz5ao{!jhSa@VUD+>8qadjC__AujRd|$;tDwkql@afHz;Tvu=P>r& z<@Dgos&aol4KVH-fI-9D8@EG`@xTC#Q)FQ|0vOjJh80-U2hR(Dh%!l5@)F`)&(x4o zrEMw@M>uJ6^nDqKZXvIyQCQ*|be;@IE7AUg9X1>&DGcli60H#rtn|ZbI|ooUiPF-R zNGfD>JB&EmQ$h1!$aJnMQ#b92-MHu2 zGn?y#c5)%iB0(A3>0qK%nm3nR@|Vk5EEdg{dkiha+m?$LxL_wBS>Jh$-F~jWUvL>_48z!wdAId)F4q zvI^o8{0pzaESJPJAYa$jj%s>%>~v&+UVt4{y;7V8RmE7YM9OC@q?`irA}&!@D$82r zZ1c?)O^x1=dYy7eCWS0F>cowNy6t~DEtC}X7*7&t_ICr+ujEK#9r&T^3EuhMzAElk z639S!p7R40{z!T)xEpcSjrv4t&4nA=H})yzIMoe30H2;Ndd9uPy#CROa*7MAQCwin zj0>gSklct1Y6X zz8kRq?3;X}bJfA&G494k$NHWu4wKKw%Ed`X=bjPX#m99h$^9f0P11$3@Po+plGxty zNTf5r^A#58BLk6k8s_&g4!xTtOgp{JC; zFiaJ*{8kosG}9jT1EA=o!yDHQ7&8EZ@Gnd}!M6iR|DiHi;Oa25wVB z5VCKJ8uh!xe!SQj@46=Vi<5S`E&rql9 zynxNh)kLtF33hk{oAqEb9a_)}s3YZ3!{jPZBHS6_u3-=DH;hsv+?k2{`7!Yxp*akB zy){CZJ{+jmzIp;!Al@Su%)?9d0Pg1NJ{{2K|3QBK=$StGF?)HN?)HUz{O_4{yfGLQ zVgI(pXpPC%cNC$ot8`37wMN;dI(;I-8sd*7ekJPk@zFyM9F#~})QcWuWTHf~EA`<3 zJz#_46V2(&V73y>v8l=pGz zZ|@8_)Jj^dH_wB?5jh;rvvrvB$Ktou;?g}sHVLD)s7!T46WNE%6MV1ABBk3TTIT`RK5%T(B79z7RQoL`j z)cIbj4=iTua<7-X%kP2U`1AaPG4~hWtOcHbU}36&Nh0ym93Z*r%Dvvx_dpBKz~?Mj z#!K@M3cec)RQdi;$=7i3Q**5@NgAh>ma92ob6Vg12(4SGCh{)i7B*Gc)V;e%pjLwD zP1Ejwk5z6yel^See}|?*-!jW3Xl?V`5$EdS{dsTAyjJ3Cv?`i<6IAkM^ccvs?<~$& zi%$y<&rE$|kY>TQY}=T&ZA@d@wr$(C@wIK+p0;h<#lGSwQiJRn9RUHLRtvlwNn*@Zfj6 zenP){;0kNJkv&;)4H%Qx?9;*+ww5>f{#Kbw2}NkaS%1^Nr(EMWpwokhlG$`#{|A|} z?b-mu-!Xr^c3<%vb~`)>lAAe?L{{|am27udxgC3nIkLHq6njxSN>;nh>FZ(^3iaP<9fq!8EL9qF(Kl)qFyh(H%x8un3H%@*3nwl zVrflut2O9uniF4~N2!Aam!(Ywphpjkc#2-)_0+iGp5cLm>!45e>0@E3!5O^Pw4mDR z;vKFOElTr4`fnauA}g312yf*jztGmHFN3yP({p78(s!;d9$=t)$uT^y&MBF+G>EU| zb;9T6U&$W0;CA#KADq2rUp1ZGFFYF9{xbMgkom`cL5L~0QRI?gQh&=1@H#^@u-L>? zwi&A_D^Sk6-ZrCG{jWs!6~Zi1X*$Q{&N~v_0+-bL)kq8#$&4Yv z=}ZIA^&W70@N5cTcWs^ocqv@4!WTd4t}6)pa2|Pv5%I2JPd^21DIf>k(C>Cck%Js( ziFU|nUPKl-dlhE#jiLY@`p_JnEIhni| z{Eb!5Qj9I5H56`QXe7w+l!^VvpQq-f=HjuD?ztMtIY;yv2Ky|B%U>@}^QJ(-;F~;Nxq%$b z7Tx0;E~6pO7ARDYAz@R4W^^%BQ&N2;LC6D&UyL)1CjJC6!pZG!Xb$Y6d#^wFkS)1x z+?KLcmBcC3s+If>s8>q;7@xke5}NI9^|a`o;16IDoK`@gX#wPw)ScVWM{O~g2qSJA z%=Dm44(T^7$cC`9klQiq90;FKArdJ$qk={YUTUl^e>K*L?Ug-D`o&Q#$tIZdFj-QG zI4u?ecbgS}B*|vRrwJrPVP2>+9W41}jbIcg&$xO%r5Vpj5B70PGat29-kp!zDh*B0 zyp<}9c}Hs$=GdDdLYaF=SDNU|A~d4D^M+F|fx1IgLFK%UwW?l78kACH=~}$i?;jRY zLy9~D{-n5z{>MWtMIV$Bl%0(uwUh{y1u&&9V~5KI*ELf!OFtVyOr_`-FNE`=N+|AR zZgudBG_rtSAEOzx=({`iJl2!xTyS4wfR|Quz+-QOM8rZxONxxeMgj~`YFp_#oPC=+ z-i6z%f@PayDdbrdMQcDQA#J~0!YW&{uxRQApRd1$!Yay4N|%sH@~RhS04yql6hLh- z3IkyPtr<=`sa{~o$#Ozb@`5Vcv=t?+Na!$$JmgFP=c&&eFN%wxtaI${(__x!gCLZQ3@N7PewGeZY(=9;i7hYEvA)2(UR7v;SO?0zyb_G8haQ>1Z%?At?uGfPW~M$T-V5 zOfLIL@D4R9<^Yh0%_tUB!fm>mCrnLbvk4}1Mvh`c{{c1&O`6_-zTWV%ExFZ?mFwpd)g z#8BpA@BT!NJU#+{W4)%M=lyQ)k~Ooqzq+(o_g?kwk$o=V{kVTdCjjt%wq>*O4O~2Z zyunO`8@)Ap^mMhqxW0OLHJ$5l&Czer1AN|2_q;e^b#A7UGcW49a}HorMoMW_46-7UjZ&4@HLunOkf zzkWWylM`*rf2W`R1{l#CjvcIK;pzy-tYC520CQaOpEE&n{DDXbuoZoR)3>hTV4Wml zh{13BT2-<~ z#b^B=T1!J^c6`xEt)QR!g>Ps5yoTPT+pa}cL3|Xfc+Bgw{S?WbWZk4 z^B83IE&E!wO~9?0m5S^B%(l7fbM3RVOTQ9iAG>VInUVfYTJR%BFS3a1;Gt)f%&hq` z*uLCtzy(fm&*uRKj-rKOSu=K z*9@m-^2=>q72vUw^CZadyJ3B#_hR+Cu|`{AvXc>AdD=i*R=^hn<(Z5Z%2L z_u)VJmZBxC`FErR>X+o~*V{m8OE~548HFc%{WF1Q`gC#Jkh^SFqua4d+q}mQ*6`?hwAy^=*+&a! zJ>fQF-Id;@2R3)N|CXv&!_!lEI^2x54sv0heXa-C$)8W3D(SPGozum7Oopn9huB&i zlYI*DsSe8B&|xcF8xOA}v;=(hJ=wh4v+GrZZ0IJnut>?Mj`Fc;2s9CtyDQiwh<59v z#SvKX8!1iEKR!;Gl+KJF z>eK*sASO0z=Iaw;e}jS{{8lFLL`rn(Zz1L)Kc=fFHllYO5v0DkE&oYY^YHU-z0lzd z_D2)@Ek>6@BNqgljOsW*%r0+2rIJt~$s4b3Tb?8}qQ{NP4~Zw^XgSmbOxY<*Q}mQrP&>d6t)phqyJ1HbFyl4>^sX0 zd7BsZ2l|xIOtlN!+)bv~uds3+FB!{*B5p;-ZfaXC`F#Gc)5*viNTlAW3H z>V`bvTGb~Q#fEYV%arEgn{;AzvmPh5sAnF#ms@n62*fw=JHrOuTI0ibRut#AXgz$pK zw&R7ElL_N*AWDF9Mpuf451?ijvSdPMjtd34K&mTL;JGlm_vQj|ZZj`dyb5KE5?Bi| z*GZS1RFhF7d(?{2v%zpfo-7{hUKIg+=XdW@n7;L%8s~gqg0oh&ioDbpQCF1J&P&Ga zv*o83A&yoWUEpD1BnzXE>tQES7?lr)L~ng_i{Ja)!`720SrEn4$jdRIxUFNNH|@(b zGF{e2e?v4Lq_LUi$F07`zc;jt;J8PNZF++gdH+dUu!kuij%p7xTq30IZw&=dJ|WHV z6ACK`3M(|l4OKDvi?s*9e@HT#JOY42I@^B*q-f4{#K+IbED&{w#taOJiyKq;A z*{ztalWWsv{U%O~$}u>8{BvQyPdkO}Eng-bf4d@_ZW9)y+~^c|Y5f&lvLma?;_`eF zb;c~=ra)#nLQD@5QM!mUg;Y%k$4W>p>r2VW#Lbq*N0y>P5TN4Vq73=A>%IwS#$=)6@Dq?IG zoqzx-e`h0go~(>-B>@8Hg9ITD_o!Bg-Xzj>y{U3i}Z>DYOE>*Oo3vEKSsy7yLE| zZJdEwFDs}|9IM4X9Ho=_wBqTl2Q*-{Ga#?YA`sQFpF%R}aRc|pSZNU(Ms!w2Kzr3j zm#S#o1)$DrXPo!M*euihg<(Z8u3p&hmx?GlDFe2Os#Iu7--rv2URW{%3 z2^A;p2LQ#3%|z*%zxr>)hNdDylWRP#^e~I+Gv2JT>cdbIb8G{MPTtAI1uvc^&k+)1>y;+0a&QTcOvc z)G15QC~$x7runD5etrWX*g^ZzFOvU8Bd2r(?ABkIokz-HfQYXk2Wnz*I*?Xc18%PZtqx~j=L4!qo39#A zw(r0xA9?a<&foTCbazfum#<=0=(H&wg3;P~VLuX^o^tI@vBBc}h)SUWK!4qg7GEn7df0U4w&}>=6r>DDBr|&aVuBmAJ!}nY9=rX^uTuJ( zaIA0EInPd9r|QPTw~M7t*IQcYnBY)x&~)0(sOg_Yw)%o916>o)Acx-mmTcFXSA0R- zPPFlCUBX0L?%louDWE;7UWQFGr|@suo9Wuxci>>E{*~GUO?aiyWHQC)2oRuNQHktzSs{EVxpFF|4CN0W7(dg9~76Z8{x)1>pTt}-YOvynY zb)Yswz_|19lUv8aauEBi8GemL1A(r^DBpz!YEy|R9F0~8ro|X%EJT=Q%9Zdw3iPYT zxOh*3XSZ|%Kz318*@QGe$)vkZU?BFnnl9r{o&W@PIC{|P#!S-at8dD; zng@C?EKI8lkprYZIBBDGB#f6)e?(|58<7VVfJ*~+u~taw z0R9G59VdgY&Z{L~HZTB_BY%0lAFTfhK_=U+vX(;uuvy-yqOUr%S@7%DPJXZ{l_%%#~-B5;XH86T|7hT7T zwAS|?@PswQjsS}?YUSK%`{&=|hFXntWx9YUd66K5EOLBE>F<#1O9jXpNC8hw+}?wt zw6vmG${^)xm$|wd9L9nSXJH>>9B+|k}%D)4-iyVYx<7wPsrtnZn zoPl|CB0Cj%A5b7d!wDChe>t33EhwR+*`Y#60D}-ixBB*?($RT$!Nja4Sg4ilA(Yv6 zaY6(UvgyQ+`4Svujw1Z52ju0DwfRh)a^4-s@7OEyIk=TIDK*6F^nDp#!+LSm|jMLyf`Qc z0CVZLcb7jy2F5a!y~{xd`ah4G0(wmpVMW_Vh~VhXtfrFu>f3-cIGFJ5yxM#R5kq77 z{9^_ErTIhU=Dm)Mf`o=0QhAHGN>84t@6a0?Y-YfEUF{A-T{A3IVzZ~CKnq*q<% zJ$Qv{uXqPc;a|$vZH%pYL4Id;h#9W!L0PsCXW#j-Pp=oWd=J`O8~!>b>(#Yu<;{a< z;HUM|27n5?#BvaY#Bxt%5sw^9HRjPHWGIRK%>CO>ou~5&coKbTYG#z1rEcXhKqUN| zt!HHtNB-J4xPFLw)S9;gZ_4o4On{%$Vb zFL;|H$ic`#^PeLnj+DNGKGMA#}+5a+e)m;Y7DIltcQBsQ-zKAo)ksQI7VX zGQ<`o&fviFP(|xjpuG7EKzE`1xZ%gqau1#N0?Z9pm9$(cgPG+(^k6agoRvcCgike; zC$~4cDNpQ%&r0@gkPn2-wHE|_j^DM%*Y9aWv{=Mx4G)7Wi2x}-zO!Alf)kkgC{UB) zr;$X+hu+)IS@Z0!qL~i}C{PL*Zl>{cm(8DQ2LO)1SK9v{v%=I8Vqk<+2fZJcLdHM; z4c5$7{lB?4gFH|}(8#}t6EUHe2Io2)2CaH zWCarOdn2*NVQ$w**T-XWf5*a zuoV-rGmh^Ru+vMD`u37Au{nmJ>Eb}8Db0$MLx5a?6;rQ(`ZLUE-!%}xc>$a)Vp7js z-jx}YxzQ$Jajzz$g5-Kor3>r=Bu2##Ob!n|A@>dm!9oRdrn}^xEKfy}LL>(Lw>>7t2rz)nxWE}!&QYOg zV#+AynWLzDWHE&A{dr**H~^P#W)>`gSdnRZb~l~AtA8Pgs~R_nMzFyn-ZI+-mWlI( zUv7p_^i1lPM!#tClHT%s#h@mN=+0ok*{-y4D=r2pT4G}1BkmncApn7|((*n{zpZJV zBDITXebdE1e3T%SUkG3^?7tNicH8PSV9WHlLaNZRI(#dRx(AiXd}GQ5O|+N@A5@8M z8TCOlo8qjryjuC-DM!y;VSe`-?qTG^1Y#ZIeq7-4GUHIT(=)NCGFM6ZMK6YmV&Tv} zvB~IQN3@1wfw%lg*8(U5vu*q+4q^D7qQ@fJ-Pu(`pS z&m{|?qp4X9K5^`}w?F8HLHs>G3jg56jM+907?Vi_FO~}0)k$ab@n4)xic;CDRvBpS zs_j0Mf)jnq3TfL9u$c4?NQ`bKUTb>PIX)7_UPh9L53h3e(eAHH`k8<2d4tHtE=5vK8ZvT{_c&lOg~itXv6obuQ2$3R zl(Mba3v8lK7Flum0uxT8Zgc2=ZphMXt@Xs>=+q$6IAB(8tfKsUiFstq_Qe3(A(TqK zR(3s%dZFk8z6Fp{g!Pg=BEiQl-zYS_b{PItbH{K|?C@1#`jrFMtjUV4&5NywL3foj zX=du68@FFnUte}Cz*mjA&pF-Rm%@j*`LV>XhIDms6%|f`>{j2`6HLE5_%&gW^>*3J zdm+uje!l|aflhzq><%110Ly@ zt7U7QbzWgnxyh7$59xK&0SNZPs)bvGDQ}6m6ly2mh-hBJu34Q$2d0^;ljq?Mm(BQm!}BQ8 zjbCv&fy_MUa;M+U4s)?WIxih+xZJy#N30x_5M*m?=88n#bN4kDA#wnjX=+Y?oVL~Q zpnRcmRR^qgvv)ic00+vIp$rkqD2OU2(1xV|0ChSaO?kCs=$9fL-6)XZ$tjU;1Yya* zcfsIgKkorF3yW9Opf~&r*mKWYEegB#f-mDTJ~G)8B^u)R#22SGx5-|tSauzX@bbC? z&D%;gTmH+x+1lYgk9CJrcqkq^bs!4IDj}_rGmzT{WHmtoJZ1sASB^3g`YZ5?t`ziu zdXI5Ue_^|oBt;zKPKv=TaT$SRcy?lF5M?SAw!%2Q2Tza6d3;M$9}TsZHg?m_A*a$q zsbBu~r{QZiL3NP8(LLnc)Ns1&iJ}JoKuyBl_>OJX48YhG4Q$eW45)t z<5u2!?@T8d@$l7Z(fx8ZKVyNv=+I6FaFgC$b_(w498*JAxwWE$s*N!vRwo>Y98-hu zjNObyuR3jRR&Di~%1ra3<7%i{VQ&=Js>%Js6?MI`H|v5%MnpAnLb8dSLa6UEEuU

$w31_zEh5YM9A?RZAeY{oQV~$hQWW@>D(otNL8cNy~EWauNhAgSma5p@3UC++Hb>7Cf?`b-EcI-oulPR1r!dSVuS|v?<-(C>~K%kDJiUi|6 z``0T&cipHKQH|nYp25XDV`$V>p_Tiyt$b;ErsqC$F7tT2yoZk2cjAx8&#aSOOZVgU zeClVW4r8LBzIw3Ry_IU$;rUtKyoE?+7*U}h)ox~o@Ho1qCRXOwo)zeKP0O)eGuzBe z3&x66sic@Lh(->I@YiY(0RIwP7B|F*7B$Rncf9?&Y-ctVwA^gsui1*;?wtN~A&K0V zhr^d?o43oO=lgvsH`W)1oNuUSPxZBfQ%%<(c9#YF1in4ZM4q+^R#K(`u)Qf)lzz0I zM37v6at4NIBD-IHI6@9a0LmZ4oI+Pg=@_pNX0Q3PVoN?BF;B)d( zIsFAMAZNF|Q7%TI6U-|Gff3Mea-=kVLwYQSv${Y1bog1ic_RiCxW{eMX!S$b)0h1+ zbx&N$L2NxWtnFP`4maf8{IdQa@4tPS3K_Ll;)Dlko;XJ#721=He7B) ze<(YR%9v~fb@Az_1mG-$QUj%&v5L{)$DoFe&BEjDEZu)zS0(YTgm%xSl9P}(r~5hc zc>ikysQgoW5-h&^##Q2-X)Vg z2u`diBzqv#mojAeJE{_$ECI5I(_HcdnlqRKJyY%=0=4DmV~XcngO*S?Xj|LG2=Mvc;gP)T3?247YEamt5#}u!e$9 z2}I!G1X2zIU$zOoM*(HRxHf9(2xG^~g`a zndE<9ndi*C$5#xWOsc-q@Z?E^8~@s8gewAD4uZuut!s1AR(Gu%DPgvO+o*vBvv|;z zd*GSU!DeE0aM)|11)YG6Z>!UB6TjF7au8ZDuF#x1=TfOoW3@Wn7-0B&Tv$25O0=mu zzM$AfVW_9kJN!b*W9s>SuTGQJ<|sW}*Q0u+{y+@u9Ipl`BBJw1Lbu7?9|#KR@HqG| zqf<5_t28XeV@fOkHjE77{2nIEArm@>;#J9o7&5mvm&}ONS*H=3r3l`=vr!v{JOTrh z6Y;bFaj|#@C|YdF5b$@!3585ELp{8`Jw`10&*sSvyN!SZ=%m8dSO0a-%j2@gXG zOjU*0afuA%A5pm*ltBn^t^H}|fQ>S38fOdR+7?OI5?_(1+2K^#AB^i>k-m!MYtm22EFSLovM}dLZ;hxa|>Qe+OpB$F{<_ZV+|e0 zJY{~SYAs?dX;gl?zcGWc>Ei1**1D;Pb(h2+Z2K?)fs+&jluap#pRyLBL^Ro@Xc4=f zE%x~V!c>v|f!OyFzKuHz90o)VX`gnE0ZP-EX^yhyNPLSc2dc^n=@-dkpS60J`m{i1 zp!24-4N5v;&ER$my+IH$Wj^6*WPPrnVhqIWIk&+g8&ZS0%Ewqx@k2H8t3g143kA|I zM$|We6U#o32D%Cw^PFarOlTzII%g0>X>%Kk@v5lbvCMM6|4;(yvK7y2f1YzE%XZH5 zr-ieZgEvNLmqCD(^+agnaUP*3Ko_J;PTrImo$GiAHwq!Rbyj;cD)|UIqJi3uY~G)s z42FuIr?;UW3pQm5W-_0Upj;YlEW4>Dfe>v06x!)5*GP?Rd`&hhuWt2E>p-pOI~eB| zJL=7IT-_&;*v7G~9dnxC)b8-5dGf1&Rz_*&{M&9#oX!<}j2*kX8d-*(D3@%bVSMt# zj`{ud&8z;^Vsm%m?3U;~SuokOHwE;K}%v?BQNJKwI%?4C&W5xjqXL9HCXmyE9Lwcz(n|OAf<{zC;on0R7 zx;C|G%}C(G7l764$GuM1nq|eJg0ZF&}*ms6Q2LPhRU)_plZOihnt@ zcyi_TbORb*Z>8d$zZnxar+4zU>>@xxAo0j_ErE_?yoKePRohsTdC%E^{-6Q4AEg{< zzDYw)Bi3<-`+I{S;m>vGg+raOc|>d!BunS;9*eoc*>DLMd_d)L)_5mJat@m3|6xn! zlh7V?hw`-TkZ(}fp2S+Vl|Re)sAf9O0?>ViI;V|=F6T5pnZCH$odTXJM@PJ+Om*~L zFt|__qWf+E?#EF!eJ%|O{m*h-NIuvspRHlokJ{YuA+FijL}o%p45Y&-#)g;_9E428 z(dGkP{<}9o4cf?Wyz3uYWW{n*@${3)b5aN+U>_Ax+j}-ZGlP9xk9L0DZe0I^@gNNU z9Z&>eW=g%a2L4GQjNNDc^|h^sgeSfsxsruPVG%eO3TlgF9_)AN%PBi5v&E{YE196X z2AGL5%OYR9%JGB()3Y4O!P=N%vP0XRM%jK&v{OxFYcV(=^F@ZNYgzYHgwhMHYY7V` zDDTy>>3m-BD$K0N@=^bMIa2-YIiDZ*We8nTxhj}HDqIV2h>P~BcS6sBgw-ZV-q83Z z^S6EWlE2BU0FVV{lm22jw*I#(eJW5~nyr0_*-Ba}QAlUXnE5l!Mp}rbv~p`9%7kxk zw|)A7(~PT_ZZf2Vt${LwwVnOIltpQdnP#%9oM~b6#a*QppL-M$J)+uC;%=fq(CAOP zse3RG0^KPU{Tx`Iq@y{n6ef&{bn2oFl)xj1IIj- zbRFv>Q>M({bM)#>tUohQN1}E|zi~Hun+}R0*WV=p%c|U>+`|PmPZFGeSpo{vWHBG5 zWuQ@w^Mr)|PQTs?P_3)n-(|oaUBm-g>HXYHx z2dSc1g&m9qN!G|>{9gSe_(9FhF5{V`fxI`80{Kcxgps9JVo7vTD?yH_+y|vW1g>D3 z41jq6ut5!_ZqtTZI>I8yr$}^z<&`dNNcqlfNV(EZLA8t}1ik3^+s!c$`#QyJl$MN5 zG#eGBFz_#~ya{}lW^)hmv0NotcK0wmr@{nH78M_1y1}BMW6a*+RBob2A8pRQpF!o@ z_sJcCZCpxZbP8l?6|x#nXAy;x59P>sDtlA_6%0y{y_1`7dX+@CzheX_(DW!d7wy3e z^4;oSx|-74fM44Xth=|}k}2C`5$L*5{Ir7L_nRHLA9qEIkpfc0Zz_5)d$ddFU@=itR@S8x`!h8wk3Kt{U(Sr}uVB;Q^6iE1gr_2D2Z|!+X84SzO)# zvy8@Rgs^LstytVHap-DPb`C!Ho{NPe$pnmizJHeB^Gzt`&r2bSzb}(Jft##y`RZNH z(~NU)QDiLPs7r_5y97;ETA0tIc4yCVQu5{ zboXi+ZI;noK=A3ey;S{o^RRO(m*MeBC)7U*zlL(xhv)q3&q&My4*R)}Cy5?iKtI|U zEnaevz{-v*yy!x^_Q@Cj!yC=U$ArlUHp|CMm(esv=ESNRV+%Ik?h3cKzgMZ3&Us_g z9CWUX)3 zSr_0;6_Bw>TBI$0zF7POrZa`$#ex&lC;`hEK(K0G@%qOqWqVmgfab1P6*yw`c(<_& zxs)Au7d6&CV$H<9aAk7D%w6Ad*Z-E*qqRH8qP6py@?__g8Q~bh8D4iVveZAtd$1^ z!hHUa00FL6Vgu~iT97sM^*(JcuHkqv)eb+4@5xwB#1U&3GJwTocg}cy{FgvYt;Sa5 z>`)-*X7C40h}A98Tk}%!dcQi_*p)tgR7P8Q!BolF4tzU+ZagSsQpha0=_*U>Dh&zh#; z&b)h#xyseEO8K(zW+R?VV?w))v4|Ip23n{jaiV@5D(#&ehQZJI7*%_@)mVO)>=KsT z)1%*8T?u_#&$ffe*9SjogBu`>HJX3Ui~dLhXuL9l{ zfuZMu+Vtdkdo!WR!PykFPXyTec{oTK@G_O(?UuO?A5EI{)WqDMoe!;pm3Co5@mEr1 zu*CfQ)1Z|Ji7=XQO8-rJbh{gHPoC#Yk-#YFAxwG8KB^%r4bVEsa-XE=vap=uFQgT( zCov`t+Sj3A1QFWhOZtongCNf`*Vw=Ui?n23Ex+WD301py z()LmV|4cV47K2m)@C&M6Y*?zQPhPU-J`3!Wj9UpK!xRjdIuR&o)awqt1#?V4lg@%` z69;a3=p1Ytl;SJ^3&O#024DtI-Qzdj4x^Uel-h%=T{wWmhB4Nl>9-I*cI|;kUc4BG zz~j__ZbO(HBzj!={16ZoN zy9`~!&zf(?tNvn2=XiIuzui-VU8Z9oB>RveQ+BnfEvgal{;`9P)Ym7xoAhGPvZ4>b z%@qYXN_KO5JYVCsS`P(C{6+$imOupw<<{4@`%!9AG>l0gTwAf*P@H5lsJK`oGj!X( zXlBT1!R|%QxAu?nn8>ZpBoKlw(beXz7a5nxAY-l4SgU^&InO1(Z-@6(;8}vJeN1#btkGkzXsmXV2KbmMd}PL#^WVOdl&$*>#!Z*^O()7@^+J@ zx>_|cE46V>Y`a$I+s^7ZwupX`-_GH;jloAxdh=r8+@cf}F`QH%&X4*zY1A+hs{?yw z@P4bp8PUz1fziWt;!MRjQ6@DOL!Q{}c>mDe;C~l_zK!s}RN;p^m-GkLYoRG_WTc-( zNq{MMIU0B|x_pSM-xOX2o-YUTZ^5O=)$&< zU$^PBI)OV`kl+sbaAh%COjpReYv}Ek#ng5So@gi68hJ?ik(fVNNB@ESxKyJZ&P}3y zu!}J}EUKp?dgX8Tt`3|^Bw@+gEL=bQV*17uacBOrv-t*iRsH^&>!S#d#>3G`TNh1j z8%~0crsJ}3PPcK!%2)b}Z(Dd4=GYY`<4;y|`tI9D1oVzFt=HITg!Q0t#-Tj|kTC!O zl0OCf9ev9%A~)$=@ZtBS^fmA)E#e`&}Zs~YmF5%<0gOS@5-5uO=GB~eR+SisBubQyg|4K`uQ=ZgQ>#MxZuXuy4 zNlWAXZz=hcD$wzha`L~%^Id9N{}~DeJnIn|gBya@Nh%VgL|*1w%@=5;8aG7pFpK1g zH~y9;$RTAL1N3m=TPQUrEDtsRP~=;;FCF_n@{<~zlOAj@9=z_a%ZOR!T<{_%lNbnQ zlaC*>=|Pk5+`E%X#|!qZJ}$g(+~0?XT6TtGZ&4kIP^eV-5`M%0&=QqEYxA*~rWe{Vx6tPp6s=URXW-)gSnMDE4BBK zGzHIX8w9sYhTZt)><2o>Kseav0v=0fjkS;JFTxye;r$RQd4L+3p7?-JeYS)EqZP6y zRn>VUrqw_kg7n-xZ=MJ4d(W-;-^%BEv79RQZsSc=D;`ULjJUIg(&yHa=yP;KIS^nM zPZTyVCeEYArS>V!#Dn!?3g=wKRR100jHdePedMc9@gY~%%qh7Ck64}zUmlM0`#s_b zlO~IfdYh$9);DA3A)V9-l>PX=A@7@Kzd+)n8=GMGUUJ^(tRhVBx5+HjH2aiu;8Wdj z^q84^(>Hv;q>~xz%jejHeoQ8M?8=Wn~hs18L%6&dHR=dk@@NYHiy=Zn33G=^~PFRmHgOr>mqDU2K1{1eAp|8vl7@U_DYI3lec zq1ro0=`aT6+9SAQGQIvgD6}zryj8l;M`@!ujbZcAMP%0SL}leLOjxBAouS*?!@Trm;lWTFt83J6h@r)c0@zet^epfroNlsX7zPEpuD0tf@z65>njToVQyk5Bct|}6;+mD}(L2;_BAiX0 z#ff-S6?9amFcDhxS$d{_S_u(FR9N24x!cFOH_Z;P&y(%JX@|*sGVN;Dp#{}n(oj8a zg9y-;;sGxYwDkoMUI5isL+qh;!I@=SZfhg9{W=@f^ZmFH_)Amqho<2w(9dccByARO zk049Z4!r2c7>XE&BGT-cn2ZpotwEf*A)>N#m6IR3if^J#KrMPUhTucMA6RpIA&Bl) zFGe%hGG))FKA5x_0bEFMUvrLRHgH%HXY&5h(xO!|Wd820 z-rweuQnvb>k1Bx8jSLydkZ?s>#TE^aRLJw|X$m__^ertT$sW(FP8M&SQN{t6=n58! z1`WiCGuIWEGuo|vk89A57HQck!d%UPVz5tr(&WjJA428PFY`l!@eG8kzE*Q`{xo}o zv54_ViSET~49ZS0RX1^9zRZW*X%8_|3mC4j1FOVZu%~nm4kvF09<77#Wq|Nn8s#W%6HrWiCy>)XDBLBI@wnxmwhC_B*s8hMsMff~RLRs&t8f_09K} z?%^w=AePY6KfQz@4cfci|y3ra#ilyD6y~8Go~E`-?iFL&Q-0Kq8&8o$b}ax#epbX zxH8-zcw>|Bu6alx9VSnQXDT{GnXdMDB(t;F=OEU*@Ks|$4PMRxG0Xl9&vq`htI&}K z&blRRcBdU&gW5p9CwAwwOcJ}|a9;W`+is@PpNgvU{FY^34*4F1_*7aPz5j5k{1P_5ztPS&C z%#@?c6!0k??|6`Py}sFAC08OIQ81cIskwdOc{KIouJL&`x1VajIkCkJov>!fbk8#b zUuc{{o`VzGXWf+Zc~msE_q-$*t0!7ljAa^*Q^c`4$9e7R3wXzE!uPP=@HWUWlhF#1 zC^`Neh?>safqoV{cY)F}KRDIUTlx6oTp38{AiNR|8h;7VQ%+)Dc4=|eh2h0!(o-DI zrZ-quXf9u$?n`5F=b}~}-efgVq9#h~S!$#s4 z7uQ_4=2JZhkAli2$SNCmjag)NrPjliH6gQ?7!HAbNZC^Yg+_*TGxC(@0YLD}2y=kc z5hkBh!5B5H>BN6+f!_;OukXypM}@V3UMnY-YOrSA4S*AsPq`XF$<<7Ao_!(QbFJ>U zM{3`g$b3Gi71Nvm6;Fysk3zb(%4r!@WtCiogr>+$M~BKjL%k$;6~Jsip7Q`R7q^Xe zZgjRPEQKpt#=1_ex&V}Azur4H;}k-oD9Cl@A*(~J!n!gz6gqoF*9`~DHqg=Dum+T#fDwE30Vs}+25}AK)K^zZNIL$nploVo1 z*4CIJGa&Q=OBAzH9jmH|wB`v72Txu~Ch(@05uI=Sz8ZgyNn>J)w*bD3hg*&Zi>bjO%K>eLy z6@^rEZli=(Qr|Zk=|Hw7?_TNYAMn}_iHh&)C~Fi!e8+e&WXrbV0d+MQ$TvMO7jUg- zZ&=oCu{P&2kaqVT?eca;V~=+B^h&jL5~f!@@fOu+$gfnoDwqWG6EdLeQ+glXn5~Da z1n2@S@UJBnd7cw@o}`Mwgc1+1t5>k6CK^>Z0{n^pH8~}W-Id6Uk2oNKO<{^D3lsz5y}gP0@Jn3*f-6% zss#SZ2itX}HhVY|?R#RXU~X#)m86{N2k4q8c&j9({RDEw!j%(*!5iyN(b4!vxQC+g z;I5S?4~o|f<}CkDgrd04DXu`NsB8mSe|M?=`Y;^pLG8h2NtZx8;CVrq97X}{eH?d~ z(ij$r703qOMU>jQ@@D!ckTX*e=K_?edSpUN+^Q9cW9;xiBO&5pHZGypc@ zZmZxgE!q`_B#s)^!J=ZJ_S@Q-Ju5tog0muZf;6jZh#I9WRe$s++_Jm@=>1gKuu;ErnPx~W5VD^++)SAp^ARmHZYVW>OPvvDp>sRCPV}1zqiojS z+zwd;jxtm6ud|te47r;)Ur|$!b&33BHHX(Qezb3K^L_o;I!qkP(KM>3d24>UE(1J zcC+23u=!L?YS$*G?l05>{>|jRqkX1EA_9L%4$8p^AZLERgy~i>gG0~rIS^Qk%84E^ zf`$`;k7IfTU|1c!d@Lv0m%0k@-K*k3*t|#h=lZrA`prmmpX-GE1!T7w%LEVBtA#af z6T`V?gSqc2MF{G3gVO~u>i3A6B%wp}=fR%7r}o1&ljo@~OlZ1k?=NXKqvce3?o0y_ zbm9_+0Gsuw**E^?7LZyDJIgC7D6NIoCZe^L?s}m-(*gf|idsaTO9QMVfvoW>aM|D5 z=N=xF|6^-e78^1?5P9f8%w0n>fWZV<&DARgB2soMXk`Fq*oy31I5nm1)}7G%T9#xu6NSXo zG;Py}1n2+pbWY)!L|eCxZFg+jwr$(C^~LU(9ox2@bewc-+jerY_kR9!v+Aax7_vg4z#8OHcLw_Xw+ZdY{{swO1?GgJj8>6+c|arKy*`1NZ+q{27iqwR)MYJ zdLxfz5V38u6lq>+7(ebWeqYu0_)yKO{Yur!s=gvnPe3vvZdA*OWR%-m^lSFU*{Fp@ zZaS9)Q*c<5CRn<@Ht>699+P-4iWmTN1&C~h@k%7p^!Ek=BGiDJGDO$plu0GKB3(8V zbYxXd6##0T`%c|sAyD=ltXrRN6VV>T=qU|Rgx~qVQVyOlZM_KNPpBY3vNv`tgRSuU zm-9*rir1ov`>&kLKMSoACe#Y3m#C~ffenLCKlH#VV{~}x$#G)YDC6eJ+ATm2W+hB~ zt$F};^rD1>cC9Ixb`ta?Vr6ILHbm%@L_-qRIu(i$d7+xRX#ONgi;7RnjOOdGsR?eX z*a4l}^TLXR-IRT|)E=v+Wv5#rq<86?8=5A_)!bdj+$Og)s9E4ppqyP*L&@sCGDNq! z-+CD+k)6yeOl$?Oqie^d$N>OlWhDS%oYf2(zaPmd6|%F1zvZ|6Y)P9vfu$;IjKUi} zLK?Fm1yMAR7&2~T9y8(SbVW6n=DjFoQ4HVV18vYrjm`wCppaAKLuBh?)_#c{JKq_w z>2*w~0ckOms>&SLv-BG#z1#e`w+|3eQb86CMl95FCNFXkL{aWtSUe!x+OlC$<|1!P zUVU(TKe?q7Iy=a{Pp$LP?YaN6&O-8;YcfUx&~R4eMIqXy5@+;HXIv_mE02( zRDG5`1QcX|RKLv@F9F!G?SM3REDDqQ9_lKe+DfvLadZRXnII)oKr1k`09$aV_3tfQ zl`tX5=-R!s3{t@G{R=nQG$9W}nsP-6MuGn(nxL7nR}!f?|yC@<0Z|T^*&U zf~Y*OO&Q>#|GEP8hxn#rLToB)LClMb`VkrahSB!vA~Cay1@pSv$yF{_S9Do9MUwPs%uV?b1m5COaVjf`l z$&hb#9*TM--T@%LtR_yr$~-7zEfSm|WCM`Uo}1Di>ePvuK-oA5`3v_Onx}ZLyBUK<>Bo) zT@xzi#DQN7=(%#wjj94pZPBg*qi;xhvX8$?-?Y594DEk6D!v@NNz^`hGf^3kpITWA zN^vuk%E4Et;Kjzx(<_D`b6D!w9aD~#byu8IO*;hLXoYkd{>gFQzvvTB$0~HH5g=0l z%Uv);TLC~%H!kL#D*&!N0*#I~k7fW}{!=UA3M=`O30wQesgW|qt6CHkso(2HJzKff zm?{Ph|17Eo)yacp*Qcb$rdUqcO}6d6&VsISeV9t)IQK#@qwBvxR}Mu2n7QxhVKc^F zEn=n-hOdec_~^E?KDOv`%Pd!eK~0cF;t6NzPywD)M@H^4$Vj1S%NYqlS|f6#gUs^2 z0c#c~httAKig=K^Vkwht=?8*-Si~DNkm~$w#lZ{ZSjxc#M)BNaAbb>c_|zm#N(gSukcL%qYq`&zOQPN3VE;Da5Y>kNV;@=_?Yw@^^Z z>RKT?duG#RajffM_A0QPzzJ_o=KG)gDS&N&ekJ<{s$64m^iaDxf~ii9e}W5@2_5Sk z0cW2J1v{@AWf5~dy3DuBp1}PR7?f(083mBO%jL)Gh6xYk$2*D#M8*NMmDtYV$bVIg z$@p{))V+wC-JtHLof(0Yo*v2@|I-Qzs<|Zw`=>wu?;%?3&)USoaZ@Ps#|LMT=BqVX z?~@V4?{LJ%#D(OSBUE4#wnM4Y+G6ODeDiCq6z>7B z72QoDC`ovRC^M{alzUi;%jXd+qijZS4*WR4V}GHNvhM-LI&>sa5uyJaZFh;yKhX&l z7(mF6Q@cvJ9?cnv^mc5kqKhQ`VAH*e_a2mPzeq(sneWR+oVU)&`6dB2Lh_>tc6suiXFPPbdHkBszb`Pwt&*7DzQbcl^L{;ViC z>$Qri_|C5^6G$(KHjAGOF|811SuTGgc9FN#rh%MqtLE7B<<@p8iHx)^Q#k?*=Q=kz zZbmo)YR#|GU`<5HoC|2DHo650JVZE@|BPf<@iG;@-4{Bl#%9WUDC%@3?=ntPa}JiG z{Au^mo?o)Qr8+QdqCusya7mwSTtfaA{dA4lE}NZ3gpEoN3(IEYJ6=W3xp0DfIzd6( zw)=tthku@H3FBW7cq`#{=2HmpWP89fpYVeOYR?YR0@&LavN_l=j{NOs;uO~t6|(YI zN>CjLAF;)!D3pHjy)MK#V!3h)zGFf&J+&ub%=;36Ph$gmp@}{qg(r-{NROfCKzZNV zvL0UNtp>0={VeEzmkerN-8w<~BMtQugqdKdMq(1t!W9Id{8+f#wqG2Mz@Ka8qWZ_DVBPc-Jfdm7QBA(oHMm*SS78u_4jO^>?l zw=4FoY4*K2KJvF?Z@;42oXL_fG$b}3g6zBqnaUCGg!EXDWjwwcq9A@t`v2MnH-bD> zz%oW*;i4n|HDV|jMi0QcxRwfo@!x}ykR{)SKyOkJGUN}(yJA>{I zK)IFc4MakNayUt?Wfv(arX|wpAiNcD0!3PkJ+Vf{w!{j2_LaB#WV4Hc3&qVMg9$`(31ipBY_VhW)m8lUNW-8*~ znI$hAq~%!}5ZuTz%Cg{{fRa?5jKRi~HCUw6)1;;*bo;x&eE$V(-kkmIY}3JO7GAnY(GD%Wz*zjhUt` zGrp6a_bRTSFA=r6*A(l#eHFf;rwnnEJK#eDGpBsdr*1O~YLJN{bp2?f5Q_37{1@*X zz76v&-~X$~QA#ox4WsJTMGq^rbPo%6u?tc~u9aDbxV;^r)R_x%MwD1A5H*bNxVBlK{Gs8aMI15ul(s6&nD&)=ac0aA!`L?b3y(92O^0-1U5mLD zFRLN|7gfGd`UqztzE%L~kG$~bdVM{?wtyZ|O7suiW!<->?(%&!{9yllmoa%8^p*Y? zR(W2G-dg?2XO%VLVS-F4^xL}jy~QU6VM(^X##2^rCAk{+@?dpqs=neYPZ$W1?ts z20WidR`pQEW3?=i&NSN8f6k5`7SKJI4GpL)+nWI~bJ$APSCp+jzcqIJBqT|1AT9v> z3ilq(o2I)Hz{u#{5qlFAcmL z7%@%i&rceU@qZtrZY`ZSl4cbDTm$6G30G1S+h;N>Qv6hxfJUfG`ad^A1!@YdEcGWc z@|}Z>AKn$ZhdpwQ@yL5)?rQBFx-}EWqE-0n#*dd%8sV8Uy^(ur9df8CRS2UgXvR3= zW7cUAcDNOb`I?_-xLdti-@Y$b_YMP_lB_7so$JB)6pbcl)&7$g0fD|`Qw$Dd1)ZVX+Tai*wqGwPUn z@!ZgzKhDLf!c&=DN7@(Mw^hY`@%;Jkwemckb}1~}B`4gbqmATAFBMGhYS9}UI)Mny zJ`cnArri}l6DoRJ;ru1{26*UnBQZ_nn}0W^P--Tka9LJMPh&gPgl({Ruo}*dIQFQi zp2Z*RBIDhjm!nUfXEEN*g2troHF4_hk=5yPqXwiOR`Tvn_M3s7%T0Kr#l=SdSQ2M~ z52r+j8glM_fPSPYNGv?$s5mqE=)eokEk&$Yj|(lpxkIHF6nC8mUF%w@e@7L~xHR#* z%lKM=!ibj1873g8EF;^mnsIbElj}@fdV#Y2tyjJJ zZL*go< z_a>yN{msxi$_9E+9uy*wEdP*zrX)9&ceiJN>k=<`d0c3@56mV`8u%ce`HoHF=t0HUAcAgk zz#p^RGO>oBR&)Za0FIO2p<^o9V|WB;YuJsrsoPNW6?-4dgwMLLYS!z z6C4`U<^@@bVTDF}e*Coe1v-d946unAaw7%N=hm?zQR7VaRB^hJt+tYP--Ejxx;3?h zTn07stlz(pyH+!lbIadi*MuLni^TChUtI8JYRqYf23yr;%M$z@qt;y?^*a=ByLI-o z%%(q{ON@DePE9;$Xq!)Ac9^u73d6k731(`jIe8e6naxbz&Z$l`%v3c)_lT!*0y2~L zkMKM~%{l_BWa?b43;%IPjapwdR!KK$J)lJ8D zvC0eMS9t6$5whz}r99GzQG9L#`vi|hw4qh!(kjk~wXwh*ROT+2z=3&AiX#Rg_12p;Q?xEGnY_DSIu`$1(AT zdV>K@;$F^?6^1sa1Iz;eV4Okj6Qq|@^8GnG=(j8xpQJJxu(VKV37L>-mJtH;Ss;1| z2_d>RmipkQDJE}I3E{tXCMb{$IXkLAb#~s$^yOL48SD*@e%Owkp5Gqf_h%&l|Q%J8=CPV;Em|)jTj8^JRjVNRpAiJk$wd&qx9gO>~}Q< z?)LshgZBwIa6(5x?u14`CLsm6hsOHZ>_p%vK#7x@ES=!N(I9|j#b!D-rOhxf=jfAi z-nTjaHg^9l!aP}X3x4V6rLma}IkN;V%#>c+US1 zWoBY#`p>l`&Cn1O44}h-w7FfogQ=K>$psceyVlnUBJ@X0hXj@cJqjdHZv`R#%Wr05 zWNE*G%1q1=BPeX4eQ=j+uw8`hyu3(VMtKmk7@tI*lqp#h-$ZUQic4CTXCyU*m2I$f zxQ(LP&H8tunnJZx#n4NtYV|J83W~`~RvIw*k`-P1Acz08K7i>eGAh~2iCV5SY%vnb zkpe5Cl*@P@g#{`Wo~3%=gekbR3G1W3E-19SpD}2ckvkxWtOA8M966d8$$CZWT$4D9 zEktyhDVU6#2X|=*S@ZlRwy!Rhlzd=oH+dIX98{`U0Y0BmXOb~yD=95e6E0Dx&!-qjp#OAU=hk_SERmsCZ> zXabJ)CPi9Q73>IDPB0Us7B>q-$|9F#aIWGk8{C1}K|H$c@-3-59AgoyDGpqyk)a5# zctinPh9Hv0WJpjAURa>MuWSNBYzX^D*e}j1kjMCfC8TT<8TL{~yD`BrS0|=w{nAQv z^zbV?ZNTT%;B-`{`n3ZE*Dg$m2+#n6uc8h@sicmKz-09E&IJ zz@F-nWGzcTyVGk#~eFDt_0c1K^)*Az87S(keBk5Nf@JIF5 z#-{&^*Jpgqzq6_Hi6-yXuaEegRPX0!1Dg-WPr#_R_Gg6IG6&)_rOZ9`{MqH(*VFuF z_~WPU^HF*3Qt!9d=iueBD>~MBYT*E(ME{3RmAfA#X26Wk=9b@O=H@fM1HKqLO(LLw zf&D3=yyOqOgbS4Jrb|CCHpqUR#joIo<_((9G~G^^OUqVdGl@lp%zXhoZt}n{G^+-Xy1LjeH9gcTJS4O_B zmH5DF78)@4K(XYc?JrCWSp(ax@xWAuI|~7w%ymhaGjgFd(W-(t9@^A-zj5V5?Jkb8 zbm)&PfHa_%V15VAr61a}L$OcwY)^GP2mzjjW!&Da&cs~=Dy|ToPD2(Gm9l4m>HlOR zgazWriJ$v_IPumR+8NZf4dW7}C((jcN?>Sxoj1(yq2qZ>&7%a47|ijkl%7SBodpJYBH7w!M2z%Nv$=3VYW^f$9J_ho)Bzhn z<2w-Gt+HM7qkV127FVU}nVT^@d}E#&roPsRx5!c>5)Xlp{p3!l_7*@i^ua^iQ1mB4 zsv~^^56$O0u!}fa4}rJW|E$Uh_x*Md+*NMp+A0x(U@JUJ9XtkdCW=zYlKiQYKB34F zKbz27A9>!>Cfru@PRrr{;LqiqGQqDAIoc_D^uqM? z^(r}Oty%m#p(LMr&S1s2aK`CumxZ|sp8@{{jd{CB{Erxe2F#q+&-nBBukC~SKLD-SuNK$=mtMYV&Sonv6(%_dwuh!7QTr+(ug_=3kQs^jgGd%Wir=wD}dJ< zUmU_BzQn$dH=e|+MILFD&p`%Ys>f6;2ryz`d9n`*8Jofpa19{ci3BxEKN>dOD$T4B z-vw@b1~S&@m?no&c{i32RfZ2{#^j3mn4IE#j$nxX^!E!3S1Cyy_$+ zE*{&5wS|xp0$u{pnKCMACdEbd0@li2vO((_Ap!9*Xl8a7#D}cOt8s_%C&_Ti&6pfv z(%M!HR%FF1a`RxTx<=#^)!*2_c?XKyL-u)rlwH|RjP%Q!j=)8F3gqr-v(rutn{@;s zK#I=Ca$uVoj2hRD`V!hbohTtO;w$bNJmL6AbR!P*YdOrq-C*;SCey}ipQ8hZ+4>D#WX0+6b1LiGz z-r~XV8e#$T8D!mYTPsmL((!^^%Ms+3Q514Md{G|_U z$)^(lMOS=C(QBlZjxu7T3aeL^eSA-)hBGX^9ZJ+^YuNo`bDmsfD0Pm>HyEPy3Q?N+ zoZKRuZ&!rsDr%=s0737@P=anAnxQ~L_7V8S2D#Um{Lkk(+O*W!3)f8{=e}g_F z2nHqjy#PTB4nK4~*EgmIaaHlTgImv+A2%r{I_d+58OlOze9DvoV@k*fZ(Yj!g?1kKkRJ8a+b5DN|+F&bx8iD(7?$~=*@{kxH5 zlRqarBib4VznOqV;32UByCmmZ_H0A=xn@IX&rGx*cyT^LtEbTO-Ct=chag31gKD+&nF@ zU|dLB{4hPhOG|4F9;0V3DrmeZByH)e=GYh}bOm6p_OZKHhG7}p^|RWf3UoaIa@hFInLkOXygBz&_WYxCzhmE8;Up-(-Ph<3}W4LreK zwXYCv8sb9n%F8U9a~CN1P~RN#zG9BwhkS5UWe03GnXWJ*D_yMZk1t z^j1H^XOF~dXJ^Iz!Tf{MQ?F8L1qV60V?iBX&ZIE!Up!1` zRR0uJzfMNp zSAzP@81xLBZ{m!?62EWg@d7&%egnJu?WO&1YH|He$d7&^A?oRGz z>?#^3U53bQ>3()~dEauQB`wI12>hYtK%Gv<44EU1O{V|>H0UaPWzii6rY|<=&U|Zs zz3sUn=`e)E_&9+8){;#Jln$b-J_&KO8er+VZcK0sHS9BOX|h|V`TAAOGhw1U_rxOE zQQ&=Nz;rC^o_u>Eurixp^|z|;`5yfXMjPP~1m=moR>$9nXmF8hC=k_do#OH`_^!-W*)ivOVwi*0w~aFqoDPa39Zqg4vVzfffU0zkY0gaD zvi*w8^=qQ`xfxm)>^u^&>&zN#@1%Qk&{L4THV!NG6gt!vNJHWIG#0-cZ4cMZSI^p7 zW=H5fPa-)1q)9yEyqjaM#D-tC%@b#~;HCrij5cf9uc0bl?b8}smG8h>v8buJoHd_A zzb;D?YaT!jR1`v;_1mGJXj$(m3AtGhAvgqhFzDcUC;fn<@rq&BRKZ7FdCm3Ue)q?e zVj0M79a&BdW<_Td&BfBK)YlL8IOF1sGCP#3{dHakT$TATtV>YI(7i|aYnWH#me;Of zTiVJW^PaN%o$Zv7w62pPB0>5UIvwsKvqf6qLMH(WI-xy7cIpsY{39_nUP%s+k*-PY zFtGbcY@29Zx=bpq)c)2j41`XK4Er5nu)T8oyJ_Kx9zV1jp<`d z4v>=rBvB*nYRN>{od(1-@@xVXZm}HInzbhuh3*BbTT7Pxjz*#a zl(*Z5s3O!+<*gMc7vq zlp(E2w3BD}RBO{5G?K5&$gCS%b~-{&w)(S9JfL#;Gn7jQ)6-6=%JB^Q|D;Ra>k`9L zkF2=JPLiRmC+XotETZ3E>zN*G7l_%p+rJ;Qc^4Av`iCpvCE@Aj*Uq|tr;IwNt`&t|N?H&e+K(Z4*ejg6&)Cl9tE2a> z;u2?tXn*UCpwV(n>T#{|zM8=|0xjd~p@!?-h@eZy^NRRz`3x!Mv#vo1TzAq!+tCDn z$)s@=$;`Upw1_rJqZS(>jP@pg^1}JB;}YBpgYisU$AJsCueUzrfK0*Ph|~4uYqNX- zeB3_wIwwiM*()(S1A>3qtF3fb7PD^|PCEhIVa!jVGM&W-q;ps_d}FNg^z?BIVHVmc{!dfh=+qShtD=D&6zG-q=A$Xt{YK}}LScRa3f$;`35p*xzgabtPGU<= zm?uB1Gz8lnnvE42J%6KsbWaWjAJbpuF{fXYICCt))c0&{aj}6Hl?a zim6va{w^$lm3XWy4Nv)nNqk%45w|DL;6TLKr_XPB^<{vaa$1sO9mzlV*e;e&t6Ij|R&rz|M|lyTN5F0Lqr;^U_!OiCAtdt1*~#rB1GfApFtRG0_4D=7 z5$%g_tmO-W0#lAnn+w#U$Dh`}PgW$$r~SeTBz;^ic@#+x*waM}er;2j?Z1(rL>2<| zk5;z^Vi+S-B~w|VrOe?u9y}`}`dcO^Dz084u|9&J1E5Y{dqY?+5R}+CLjb^G1p+QZ zJVouc*jB&?NRDuj0keC}z-@h}mfH3MK#g8@Kc!!W+OOuYtQ)fd6Y95dR%S#LxKIbe z2!m4YzbzWB5zVr-{7SKID4p{q=GB&V@lLH4?lBQp_lNCUssEgO)%0u>zRwx}NSsL3v|G7h;5qe09lZUaF|`w&4F@BHW0jft@Pg zIX6Ll1Z6z6>1q!|)J^5oG1yHE!6?P(M`o=|Sa;&?vW6BJ_pvngjE7xgShwQDbuHSv zs!XlvGRwMcFs+;tQ^7>{ir0?8lsR}rJOk|@h8fQ(v#Y7>msDXtPXUCmI#Nb`UAKBvGG_y*S6$k&-3A9}^e6T3(Tgk{G zRw)~_KrH;B`t^?8<$a3b9mZVWnDJ%R+Edv1OYo)>q1RU zuH)tLF@qj%xkt~G8Fvp?j*rHM{w*N0Y1^v)xJZehGoXDW1~kT^GRV6uPu-FC+zjG! zP59|7G+5VE(KO%t2M>z9Pbog|WZ-|r`?v7G>9uxtGH<>j;R8r4c9)syk}sMON1=5N zUKF2wv=+5C{~FuaFvWn#M+(5QZYjRKciCRd#6y7vwJmUG;774;QN8|kA+@+I&v+=! zrC1WIX^|8Hg+bogTl}*qV8HTT$a}1**v5(Bnm4NVrt5F#%PUjldOJAe-)0T3$m5sd z_iQZqpaL=E%mZlX#W2{*FU!)uW9?G|0D`4;uLD}v1drP)6C}i z*B?zUCKKWKRZUk0pc~U&#;eJ2u8PMimEM_mtY6dD?p)?}Qn&w>-R$q%n91 z{3KQ+m@v>Sz#Jvlrh@~v-b1x8Di1CMR>xKl(}16VQ9)R^((>ED(2<##|4-6pCS>Ad zXZ``OBY>lWaj~*-B_*g)0IJ$tT#F4F>9Kk6bZA=a)>|5bVt>x5pW|XhYV?#7Z}ZD< zd(|hm{<{4;tMl7))YC$3sx+sf^hnpF`(Q}A;$gu2iChrchX>Q!9D*D_ASk6eva+$O zI~%tfW_AGmX8A9IggpHj7^{1ILn|taJMbM4YoIw0Qyx`7C^(>Ra%u`*0s*Pn}O^Bk1hH*)@A!IMwVf0VZA_@QJC-;l;-@p5Y-}og;IL%j-HQ zrcXdhcKPqhRROTCwW-T*vA_LeUk)Lc2HOUVWIh&{7Ah1pkeGejRno>N-$$p$Ru^{) z_7;`B_5t0m+mb9kD$4-rx3p`9NrT$x`jl*zKJb&>I|TqeDq-K`_-g;i%Dux?uOWiG z`gg(ZnXQ?{tpVH#kh~zQ2?YyIUgNz%dhg1&>v8WH*oVU+4iD#w=a)_EXK%q*QgBK% z%j`%NaBRk*gS<*wZ#!Mp#SYf@FElG27at&&`QA(O8iem%7f|lcN+H$nNw`M?lo9hM zclI10mOKC#ZedXO#C9@J#WzpNudid#FM{|NfauOQve)-_A>_+(Y(10v8{mi5slECGO=ACe7L?oRmHGngNOod<+lAF- z4;u)jW2JxDH94o&-2wff(rQoF2ATYA_vLgrwv z(0}zKA=f_xdCq_H1wPPLWdX(ZLbs=9_Vz2D+i zGRJ|BxO<5VpZeEHQ~H&m0LzPInTS`Cwv>`!wO=kkd8fkK03hLlq<=N2W)U|K6|AEC)o7;qE}us@g3ERuy2wG0qArQ zg-DPDaYk$Rnj~4!Q@$U=cdAw#nKa1$L_d(KrJEFI5ZGBhbAYk7cn8=A6B|{oo7uSX z&#(Uo{yXez(zZ2m0@qXczZY`Q)FQIikI{3-!4e; zDGG*H0egF?(2xZz><(Jv}tpF+aWo@CA?oR$oN&h^vlX%Q_t=Tv>GEUgt#C2 zq+tQqKic%zD{Nc^#I_xFg}4c4ZrcN~4n`8VTmDy2B|!2tkvOh=k;+Kd7I3iPj_xpu z{n-htBA!C4O!T&Wjx_nA?D|)(mefMHy(TsEy(XzOB`mrgBbyr<6XG?BQ+ zS_N)Tp~G6-{W4p<`@8v$!sBPC3im(C+Blk`Tm-KEssA+je~h=L!T`n@*XGMg=>_b0 z^m>K)rq2yWs4A-7RD6K!*Vivh4hSZ@{N$(vL*zLyImzdkS{39|0<_Ha@_L`A=5+2_HMG z%=w?4zo)t)N)fHx37Hg^6fn8gEF;-Oxo9)~h}(Ra)IUd!Aw3 z!doVhaCqKiJ<4=3TNg!}yibcID$C@{7D>ZY|4eA}hzc#Zf`4r&+o4&==sfX;dJzql zBk8N34?8r!8UV)BQ>A1s)YmdcMv<2{z6@2CHz#=J6$1ApZxA&HNHSOB;<9CWhUQ+f zE*yHs`E8kV3vXr9K^x8n#;tYVpIbI9-&d@~cx%0{$@+mr6H&FyYY3xKy(^w!Gh%0f zkg-%o4F;{5;?Ue9GKHk9bROeuIP=^LVb<88P^x?nH2^3^R+dqN`?-lXq?zx!;~S9d zTL+B=J9UW7$dp0YJ8D14982R~rtK&n_BsM!1p(B!b1mB*D%?%IDsU6_OFx$dv6Ber zxtlqxbm@t*2E4ElPT~U78Q&GSUnBS7I}-~+sXUbQwW6at zQN@rYH_|$vk#!aPgI-*2bIE=(bdIe*N=|f&roY zw!;&8s$-~XWl$oF(08tzQ)Z`vk_7B7)3fh)DuC(@ws%)^lFkS=ZxvaVGX*fI!)d=A z?|9$OBhLG9ef1`!6iPSMQpPyoviR6Is(+H3kG9Tu5tdiER;!J-Uv#_!B@aDYcSK9O zbS5X%E7{VA{G2+wIDuQoeJ@p;mdiR480XRwYBgZCw~Kavs$+T+rNigP6=Dethp_N5 zh5>aktJe(?i}wipA*cKm@o)L~tI3%PR7Mod^!l)K+Cf#o@fuNCwaxd#9f4CX>B>Ad zrL-PFXuZAFG}-Q1ru?nu&TLS8A#`a`EiDvnMUJmm5aRXDG>ieHDbNt@l6O2lVK|W} z>RbZ+Up?hB2FXdGC+-_weL1 zo9M(yW{5+=X|{LM>E4tZ1)QGg7^#shGm+Q8kbCGKzHCrsfAge;pf`seT zYESr_JyV`si9%-x5X5X>?^5p!Re(lL$1r#$uH=UpmR1O2R)>$F=S8=c-S`_wPf>t1 zE_+*>-~DUdiWB`qPoKe+Ply|_6}Laa4yv?O1ftvv0#cn3?$f_8w8+vLl^;t5kDnnF zWHBU7->)c7q-WXcqo&o?U$%AXLdKF^~);d z^s+dd>kY^g{k&G(a16$XLobY#qz654v3pAa>cRGL_ywr^sg%gD*IzmbZPuD<-9xAJ zOgBh!Y21*0LqxLS@4=rg{y$N#sVZA#?IciUU6;!cCP7;MeL-f0AIC$p{D8KQi_vO4 z_Km~5q0x2%*`N|4m}Wug%x9LEXt3_;6iAk%^^mM+;yucyZ9NolI*8QCpW&p+3* zzu0BQ#+^~3Krak1As$l1%RP{`y1o*WEY>fmb){f27-Cd3q`Bh*rDju;O4k_XO_#qw zYCq^^1eQSiQq=2`0(y0uh5*H+F%z(1n3^O*3- zlNJ-^g$oQTiv62}NjhSamfJg=ypqQ?c3y>MY?}k>W<7#k(r=kOQ>`59fkKeXc|6dz zMgG#QZQsr&^M0V9LVtagjJOR_`4apIE{9f$jxx~OjA3Nh@dT%1S_h=Uc=`!)8v)?z z9{S`=h2y;UXzY03@ppw+fq>z1TkaY)$O#t<>~689O(}1GA<&%k3=QNGty;U=3;Yw> zSe+u6M1Grksno01-^FUClmJ3EeYf3rvXl_KX` zGit7`V7}Az(xVDd?#YGGV_*=_O=~PGW0t#rOO*vxZ5xzPRT)&^XhZO55mKoN>JN$DI0MeP7IKkZce3boP!|?m%+#O zBsAUk2R$DRdmiW4h?5eVwNBSp$A(7Vo+gx;-?3SE-0w zX{_EFtQ7c=)p!8%hS+%1PQcs0<*SJs#y8etREE|ww-W6hu3-<5s#9G=Gr=6NM`dLs zVi>rI2hST&U9cIU(ZszCnUSjJi@v0p>mN!vW7j3YkxV$Q3I!6k0F=7$72}5L@G0P^ z#ZF+UFpBC6Ms}cbItHEda*~XiYvRuYgiOF-o zmW)Ar0vIhw~rK^NJJCVFa6*PbA5RFeReHl|z0FExx) zv6T8!(qDLfuQ_b9HiUHa2^i5%raEmyyO*IZ^v+=%n^&&0g2L@&X0@_e8#XQ186c`K zbY&-)BLEnG*86|n+i%WWek@!#VYEi#^P*ZJABrujl63k4T zNG=dp$mvpNaF@myPVQS)GcNwHCS0?X%`f1S_l`~Ul4%DAVf0jJ(&S3fV1(4@0+=T;;Ql=@0q6Zn?K%vxjf9<%sP7^eg|#ITnZ8 zgtWfAs`y7#rG^9`YA{Bwyd1@}c(7G(^h&~{9}F=$1y4NLj)8{#n`Hi8$4OBNrR?>=*;3ePRnO8t$$B; z(M^0tQU-vRVx@y=M)AJk&)vvb7)o7JwgW<2yi z{vCe3K*bJHs=;dUH5UNzo8G*Ds;!|v;kkIrbR0yNb#=gD6zoP0?7BRG(a(R;y41?C3z6Z?NYF2=pawQ77*FHwy^u}$Q)RKkvNyy{fC^4q{}r=fMdc2 zruMzxw=S<6%)h?{TN=yq$_Ec^n%8a+x=-`JIy=U;uj}tzEU#6N4>be2FhA7SsZ#~Pb z0d^dcr)uiFqTS0cRc|+F46}20M}p@p3=-qdgOOV z09>=JBY8M^1}3PTG8zDyO7s`gK}E2d*>y_n%NL~4op6%%{|{0?t-onnFcQB9#N=LJ zOB9D}IJB0>EU$35a*|JV+ex5hBE4~yZC=VTxpX?Ex$wGEEKMGFv*2+{oku*N{33f0 zfPB(B-801eQPYA%*E4P2|0jiNB(HFGNVp?SmX!da^7Fi$cpV(t=qT>bf3qa5qajKi zP=9|$`$C0sF`Zx7f}E&=SsWWKN7<~2@2sb^EN(5g`8R?(tLH>e-FG_utsfRA zurebA#fnQnp#A5WMCbX!n>|piWc=wy8?N6^rd5^$?lq>86e2@10!Q-lqBi9ZhmE`x zv06dr&dMTSeFhNob0%~Oe^D_=K5ReP*zUWzk9dsVhQuxeqWHq;p9Ku$fex5d?HnLC z?>?&4__mYegsmw#DY;ec1u51Co)NEX`l6ohm4~2Wb;3{+y)nWTe~ya+GyURus!k-W zi1XNC^#Zl4^DJyF8GKTR8G%1K5OYEFM0Hfrv!glo@d$M4LLJShU}(98IMK#;JYcu* znvfD{Sb$et8Wd3igQG$%#$-JD4)-Offvg)eGFMf@#mGfD6>@X6U( zC>bV?N#^39HZ5Qwe;(NWE7F#I!>{LY#D*69sk45iMxHDnQuuiK^(|(sWbTmU;(FhJ zHMQQPgY`oFZnUzcX8klyZPDCo2N|e}4K52U=2NLY{yyL?GtmPQ-dFVTCMiPoit&m6 zBV+!Yb?L#ftWn_u%0!{0Q%|^SvatJ5FT*VncdbkuYigmJa%9u7IwtVO|0B_NN7!_&u>C6PP-<6^P7ok0xH(XJ@jKK^LlC z#*}&{^#`Ise-xSuQh86~7|LN+Crl_6Y0w+C+5xjym+|^t5VQq>lWn?%uX$_mm>vje z8-cjJ61PXp?q`B(KdKg5wsl~WQ4$(`PPm}GQp84la0d?&O(eR}{Zfx;p;oM=LMZka&>)0~jXJy8p0s(^Tpg)4(GSwD^evG=X9o0tE5t z$~DfcQfBvXI}dW9#dWnY}l$r*>r&Ni7HS7VXLB2MI29*a8G+jt$-_2iMzu87^)m8$@(rI?5oA4QUI|AxhJZ@*Bb zR)cKQS`Y^EgoSADJ3C?$Ggv3O)SzIA54H0Af4P@QlY+XswCjRz92_d;Sqx}{7Ij3@ zUe60#0x?b#C#6^_hL@#Oyj)NEaWeU?^X+TnrM*qWPO9`GM;4x8(z+jh?9TxETHGh` z_jVc`<(>r_FH0b&3N#J<_zC3hh?Z?QVO>4<=eT%yLXsQ5>kqc3QSck~nxZHTAGnzK ze@}?fDA&dbx}Fv1@4oR%AfQ>r65#5SMM_4U7{nn_j5a-e~IEfth#UhebV*eJ(4J9kj|l()f`|Rvb3cz zDX%Mf4^v-#rPR?|7@OkbbqIzWu2EV>6(;V8x|L-!ovvh&T%Jof@6F%WDkS36ejk!7 zZL4YI*Yj~UC^^~Z%@sRV3Zv!K^J@H#=@xc|HaC@D@Vdq8mdWl1>%XK_RfW*47;s(KQV+F^6B`oFfzee0@*;~LPT?eGWYM_Eq|er zIPMALg95hkq0ZmaOPKHH+!uU4e|fb{%g$26zDd#J!R@C;b{Qco7yue3lRIoJI_>6k z0fqdAtr~u!W;sPLibT)UpFD=x(;#bD)dKt9zGz3LflFX8Vlm0+SF-Sfl3v&jQNs1g z_vZou@b>v$SAdYi$tqz~E*Y?l46;>?jnAvcE5(-w{C(#?4; zrRZ14M?cHhW0Ae8=&^7PbkCuJlg=)YadvMyrI$S|ykp74e#xl~}HE;__XT?&!L1D+1ppNI-cSAH|rhpK?Q z0rtCBi=eKgw0=pvu+KV z=NbZEgXKYZ2co?a`Z(2jEFnV^Jr!rrxv0D353Y;tGg(sT!DeEDE=y6foaZtJl^`MO zC#^~_tjev*Jkh?b;!sYhj$pkboQ7RCNVidEc~BB>s+4UiBeZyVjXa$4gIaw%8kc>p zF@Lg=#Q9_4>rl#sf6>B*P!=7c&SsVR5DT*UXbB2|t zwZtr3?Fh{}&pL$dv5mIE>YW=@F3MH*#g6Dm9wV2RuCd4W{?2WN0|?PQ3`JTEiO4Ue z2{K!q6k_TY9m-SAU0HUfeEWlAIjCls&jS;G!7@NIIOaQ;e~e~JEnre=gJ>r%nIa)l zU4CcZX9}4lFD7}ijNca21wUtOHr@=%If}J&}v~?WO}|l@bSf3qR77g!0Iu zGQXkjrytHRf0~s2MLg{w*}`Fr9qKMTeC)M;+!E;(`fBSAWh-X0*yRtAg?oYyhZ-3M z5hu;1mxNb*uO;5hy*cDjE8|;#f%`rb-yuN^??~0NVq~FOw5R|~+2|vi|NOiMzRdh* zT8vmFn^>VZOXQ{J1J3A@;qg$UG<8-MIBsL4!byi3e;5_-6Ez*^2vv zxUHS}$15%mz?U6Wia=I;ifHMm_z_8%Y(aw;JW6=WDiJtsD3lkM zU-A+cu5vH^A1&P+dUEhvKh>`cRUCS*75!0cay_L_(b-o$l|uAW&k2PzL1Fy&JswHo z8ouA*fA~r}UJfdge@Sv8(&x7o-nChI7*=RGfkstVF1kNd?JuBQSixIwT^6F$an(eJvObSB zQ&FDXxw*BzQNx&liJnu)@BY@Jn}g1qc>AN*h*ex_)beGFnlJtH=2J_KB?Vt*hB;~y zt=riH(%>i~VAIKNbz)%cnCjll5)?aiBuCZipG8%QjWN_r=iguv zf5sYV3FS+py;dH!cXYV3%`(#9ce)JarXZJe1b5|m=j1d{6RX)fWhAG{lmLFstnD~z zPhm**Yr>y`6nz~=ZFDb>^sDSBpwOcA^Y4}w%g^SI6cnv2*gQcc{n%g=XtKrT$u@@K z$WCWAx5u=<2xiQgK|MW<7fu6+#S3PP=% z!K9Nupw)if7^!2$DvCp%+ox*Mf6yKID;tb`@UBF?3 zb(N#%s{3OPUbijw;|>#o`odzpe=UW{v#f@8?oR=gXcX3<7;@O46>dq<7qoUpkQ_pr zP=4o7gDiz)3yy<3v-3w}SsHYa`}Vr1k7D?Vns45))^6xjWT~vY79%_Q{Ev=f_O+vY zScuPp_+}|du+Fb;*KJ1p?i2c#_(tn(ttkQ{`_c;xH>S^ZH+IlC_zb#Nf7>`B5%$}c zBvaE`olk8Etf)L&*^wUTpUX6#A~Br%td+3KCR^+H8oMR)L&G9V3a+p_w~P##?#&C4 zA;<&9M1?eZ!J`J61GhVsn${^jsMa~xzvHKeE{hjYscBtOs&p|MzsXCL{ zOOsK|j8ny_E8Cr-Pa*X0xm_>Wxcm)dhYQ3$Uu`v)l%XWqUiO)k>D~MY$3eHHEpk`{ zIif%d&~Q3J=MD5F=_P?p>G99YprZa&;*<}_ok&fV6HBDan)>04e;YE|2uoRmY-V*Q zcFnnVt{EXQ_l#B{O$3N+ov1J|Q61&hUzZ^)eF79Ve$HJ((I$Wf4S1&2DNd1x&e%rz z$AaNX=2Pvg$P?#|&|pQdsCI6us8U|X7J319snc%wOo9CJ-UZpZ<2rKYe#y(S(&lWD zogY}Z41R?*=N_%Kf1IU{INaO-=HOv&Ayb6A!Tsrhu}d4V?>Rps2F0jOKGuuR+#sHS zl7>}A+m<;P48|%@$zN7Ya8;Yq2}bb(2u3Q;;*oBJKD8Ra-H%HWMHB zQ;HkBBry%r)4*=3I#CP2?Dio?kBLJN;g;mHj?_b~oO*0Fs$b%XulGaW#*r$GCNL4f zZano{ZVkJNf29;%x zR9QIa^{Nj3NTt`H;uzt7vK)N`{n&-qg-x(sEd0Z!wd5bO_)9s(EqG6LD&k{0$Z}eJ}rxJNlNj{pM>hje^Z@g&W~Z)&5*rZHR;J2clHaG2u+cN z6a{uC$y;fTCkZOrH_wLk7zB2p}%;$N#pso|*uI`nmn zBghFZMAN{VF)*Wu-p&k&yhD^Zxpl>EX8&j}Y$hm@&JpO9j3qdiX(mrVau<} ze+!g^RMe~_B0;%6LEIw4rSNhvO#h&K;Q3)kcnocG#01LO#an&Bt4vKff`2XKj9VxJ z)oO)ArWVMt77L}Vb4$NpwOcuy=$7RExEvl#(Mq=)ti73`@|tV`e$=?C_lc^rOkUSs za>+WLy@y*|_luRud|x4qyu(1UQ7IY^e|eJ#BHa>-o=C@lR6I^@P-zQl_WB4tQ_eKg z)~9vlXlGdgU+o@;MPr!78=kN-36!Ks5wYbkU4e%DemkvMP0dSve&Xi}&NgDmmXqmj zJ1rF`$ZqRbLVB$bd}QWrQSYD44$|kL=x4!`R#rYqQ~w?Yf&v}U)R;8>-xLQZe^HcE zxE@9efiW6LF0{CGG>6z;N0dp~`mpPDo0x+N+Q78aa-z1{YKwZ$N}#1*Y8 zoXoT@yslWff=E1p6WGYT>WmpUx}lqV=Hss=VeGVkR9wI%%5x)0185u%A4GE35X_~>ML0-9;AQTtE|T~9Ad*_|K3wdrORBS?ybe-D4O!n_WCh~+|k z>2rPdU5rlb87$tlGZR`#0vWAgA&bEDLm-pTEfX z_&nZ-C2#LwU8MXo#mq~EqCngr0%n6xTaZUb<1Fh2#p)U)j#2fA-pVd1}Nn_|JR9Q%Is7uM#qnzH8KbO;!;+lyV+NHIUHZUOxl2 zJB-HLv6p@zkwY2$&aZ)tjFk<e4a+f}KN z`&W8uvv=fNW#G>Ev6D+C{eY*SUpG4Fn|mR@Q%dWdWI8+w>Il;EIBTGb zhEyz@N*}rncVz^YzNGgdT4MV335EHn5pqckwb5QrB$)8;S<|`^n;P?AkTs?V1$4K}TrL%1s4{anTR~6jFm#l)AlkfL+(4A9c`y6l(B`%MUX) zXii4wf3UPFi#*W-BuL4faInffJ|WD7f-xOUbj?bxu@xRurI>^fpl~pl z*WI^@9Itd~BB>Y*lr`;KiRQ4>yB%{BtxwxXbQ3-q1Vn?;$|-2x!`C)}l`#o$L{|K6 zNZ=7;D4AyHT9qb&$ocQPtpgiEid7n_Iy(v&f9<&XYs0(#i6fqdz!c9CpDW_oxT&iN zjGI3Dp(CvHi1JCT!!`2qLyo~>GI$`fV7SH+pFrr^kJMN-!->b_x~pHd*h42u*6OvD z!IFW0M$Cf`Ua4;7t*7}%6rDpPeBl=z>sPs@Rl$%g#i#bo5tS_>%3FH~Qz#xk ze=41{zF&;9TG7j(9pE2Y4bKF+N?~`9S^UZsWDxp^BYGQ*AG=ywpm<17$^hrwM-n*b zGLi4zrA*Oj#N#r48#lf?Zv?t9CwG{?js(<-op2$E$-uv8lQSLiS*V&z+84!?*8h|o zQ=><8Kwdn&VuSO}rOR>Yck54({7waGe?NR*xVb8E_(5%RAt52dDomue<+dyLNz3YS zSRA{VB~9v8Lt-|Qcy=^VzM2kC`o>i8SplhZSdmpx=;YGnE*=$iNS3FZPj#FeCHjd; z{wgRJ%ceSHgnk2MHZw{frJ`3d<4PfRDV)we4hI~NvSap({teqUn=nB})mn`c^m!Ji7w ztV5P2(OC~e<)M6azlTv4S-uB%e-O(X+aWwpM#Uo*iPO_YkS$JRb@V(FC6bPA9{G3! zn>~wXO5Cyuc3$35M@SZyrAd;7?#NNEtg!0@MCzlE&=?Q)XwEB5Cw9;d;-JzK9_Kc2 zPOQ~M;pbL6=uDA>5iAy^zB(%R;vniHKc0v2jub74yUT(@z$;E%h!+`&e?P^~SJqu! zA5j+68iIxYh=>?I&LI#)5_anipiO*UxA~93t*jY(2pJYZ&avx_e@n&@)91cRv|wu^ zISr!125OEe+h%SPG>o8wb;>uGak}lm@Yhd*;hc%Z6Jz3fKo%Z&uxy+_ib&ln551UC zRK;UCuPjleQ7Pg>`Wrt8e+#e*yNa>8S7x2)e_Z*0q~7~CSi}iX8iw#Q84gJp;irv0 zF6jd8>mz9l6$fgyqjAg=v|*c*Ut~BWM#%REw+W6n0IKn^vS@eMgyUUfBXZA7@JQ)fKcGAMwe;p!#ry5$ZwCiz! zop4&w!Y&exWHZ+1K%v!{Vw$sqbhCY9giA-2Ez)*;?L>>AoVGx2MOr!yO6+iO+Fa@) zEwfckR_P#sQZ;!1A7kZ|CSg|mcUi-44($AFJiM;*UL8`y*_A5zn!@@0w%dr%c9S&Z z;kbz7b%I>QV=$SNe~QU7QPEtbC0KjEdEDrcmLOtk9=j!yYE4iDG_@5nshin{vm8bF z98(&yU%-BgPul^09G1J3%HORpY6;5_!Y*5&sh(@3BUaaj2%G&7Mw#3T`S$jr*a%zH zc5dTf!^WEKM<>h*7|M;sEjHX83}~p0tq0L7x9(vLk%@ZGf5iGr8E*}Tw2f`gaQ|B9 zXAy=US7)pQC05ErO7Uw@*{?BdbW?ab#U0U^5R{pZP>7F>gQQ(G1NMAsmd$p|E;Y3n zbtfOLk!$v-B;I9`2-!@dpdPKgre8fPg_k?glvooKvDt$Liv5|`+&sv*4@NT(ZJq9m zzrXsLVJ!&Qf5%dd!b{}-SnijgB`sIhp8)&xBScF{1ZA-y4@yhi__{R?OR%G?< zZDWePQc+Zf*oad_z`4c)T=4jd0lkaFu?6BsVlKZkE^)t%QO>Eq$tQbeBFXiDQ8N4_ zH%5L}sHDiuPPxHLi8Y-VFQ#D9&bDz)jv08+f0T45b`~jWY%Z@16c<21=8c5|cM?yP zQNszuc*!pc@_yFcMS)fvw@m%}HQDjYm>nk_kkp^*bCO_?Jt~TkS;qj$`v59^%TDPa zAotS_F-SRgI;$b#0K7FVTEoxWK)s@uMhEl0_sxRmUbEJ0jz4#gd7` ze_<<;@mxeiZI`v3A%P~*+V3-+n1`FNKFzowR_9|#JLwfmRr3@y6lm)r62hK9H%!Mv z(YBn`Y3}O!p3yb0vMqA%t*4@{D(dZoC%~6R-!wbmj*swGDcWx+eo~H^pOOtjE~A~% zdCuk;i)ahRErVx|)MkX&6osGfTfIVJf5ozyHJQ2q`AfR2*@S1)aM?ejl?xtCa^@PL z><$IlODh*54l{C&wL&VL-{xz2V~PCDbjEn!uAeO{elxtMIDA)w-6;DYe!xqkLeN~V zpc?E%1M)JHWhpP0cD+>#gk3<0ncd@EirpQhns>Tk`9odHjslAQ6)?$zBE5P(e|@1< zG2YwsuFV$xt;*IioTIPT;;#5ksU03kZN3(#`s{jiB4jXqi+2652A;m)gs zqCwnf$dA?Kvj+2x7-9Ag!>yP`;#;`*&cnGAGWOLjDGT-Y%+dE66KRJpZdC>AnUR}h zGSCvkQj~5}6*cK62$ElsUhtY!f9CK{yvNcnbZwe)Vl0$!WC(8txG=)>*n{-GP+i9p zccayZ9``P_LVxCl%>PiDLxQ~tf{;!P)(A=QZEifX!e5{Mj`*hG-|qc6(?E}r-{Iy*O{`xmiycK~6qdvNY4>s8vYfhnp;F=%ezlBE&T5Li0h09Ye-;@qK0e`Q z;=k7GwZe+Xq2_%3W}q#qS4{uovVhw-T7aXPc5 z+>^FdF5#_(4JyFbx45JHe?T|4E3+oIU{fMcYUE9fx`Lq0z6$wp{C2k^xA{UR`_&^q zuAr3@&cCs;Yg+0XrfI(qJ=L%9Qt>lr|N?IBOc&sl$Xf@IdVv0kie+Yur>sDDE6DSLc zEvEDg+in*<6>$B(hRLm`6Wx;vH^lGn%5_rHiQN7e-kjjQCGYE}_L%UrakcZMJhbm2 zx%j|QN?Se_b+)Zb3I?)Bg?doB|He^mjd>2!kK};KI0kJ=;`}Ct$7l0N#b0uWkB_c* z9^8zDa!AdR__dE*OHkB z`=+C?jf0hlf0a*@gq97Y%hR5jkx3DZyjA-&qf*i-Ygo&S)r4XuPG-hSzQA=Y%pnQy z3t97-{;dON)P8ySP&i}eCED!LHCrqtN|**Tx-Svjm3hRq$jV2{?3$49V7)na;!I<+KgZ!rE6cpJ?R>;VEMZ(A)e@{X;u^juslN*jjHvHwsR<1RG zsApcjN-skS@2Wij1_4!{r+8HFJ%V8`+1L41hO2L-&t$AFmk*Z2R&s{#2joWu&7&Q*UuoaF-7|Vrf3>X=>zri# z_Wd?oZ*xTXFcYen3hGCiAK-uL36!vGCtHHInhdPlVbCBVzkYQHPFQPI?O2}7KD?%= ze=r=oRg~X`>#d1LvX=;DG-!>YDDbu+IgTfh;1 zw=|t+AqDG^Sy722;SY3Eq1G(_*sKcre^B0BVh*SOIJT>Fykw&?RK)U;f24z7{)Cy# zeA;OC##<&qbM?cVl?kFA#BOoUFi1?mwV)Kwc`tnDsBqldZ=5LypWID~IbNmZ6NeJ8 z0(bSf@{8|!1S|6_-wElUq#NclY|k;o(+I<1hmHDM$ zEiyONuMLeeqq%k~Xb1Flzo^$4&btE2VZwPEc$M|M>6i3{_JDyMGQ>vV$k;uM4%TEk zgMsN~7lB`mJ=5us3zsgxW*!<~e~Z;7+-lQ3^74AU>KfWuHf$5!pWj$qb@i^7AWrUA zYPF?Y%F^oWRoB}1dhGD zLdU=I7`bvK_r@jz_62Ude|nYPAF~>~Fag-$@0BebhPcCjD#)GnRV_5HTlJLv;T zxcZubeb$iE&=L9v3bcX^dLztq@no;cl1d+96%9X(e09sfjTR)5;pP@Me`IQqc1C5)gMPUW=G(&D`#Q@dqfA5`_!Hif2qBRwSss9N?((i zNkFGJH4Qlk&^8o^Tc!qoecxw zfA7dwy75`cV@t!dnN}Ur7*v>l7juuuKvx;TIFwe<-A9P~dW1rS-9?+Nc<9X*r;>7YgXXCwRVQ7wISdBtR>Tu^s>k zPchKp^t}cVh1|OS%FN)fbr5JKS<5tv>;su6jF8ViYKAVlg|(}Vf|iKDN|1f|1HISj zMRO#K`0H06uZjc?XCoO5&35IubsDXaX%2zH_%7Q4`!8uKe>E2%4c$z|YlSWbv!D(< zvA{-pbP_HY`mM{@+*p?%4v`44e916l${5U&RAC*|ktxy$=DcBVGxhezVfWB0a+^|y zGGFnA#lZ-f)gvU=7_&0C;qMj!wez0h4WZR6VFGS5>#&cfZ{r1L{GtWBaqLDD`6u$c z6{eWs=Ip0Ye{{cg6h{zTobH%GZ{XLgrzs;Z+;MFvg~h+_i{ve%KEvCPXQ{Vd3=2MIw{=^26>1<0cf{lJ)SySaA z9o0ti)=QA8t=zzTocXW`SdpB^g3rPdX=Dsu7eCd?f4$^lbQ0vseoVP2#BVcMn|H7q zlwtUtNmqq5{JJZpU?k1WxtxQ3E>L)Q;7BU_NUvADvD7+F7TBth5dxeyS-X)PQNXR8 z{&1fda~v|Po|juq@$$x1LnK>}Ek|`EKS{LkWHdK|zEqJFA{vkNUc5(>%eXKju3ng7 zL2;$Gf763+i|j@OP#(V3q=j*~Eys{4@$|ZV)kwfJn8Eolz$5T3NaruT= zbS!sBdG75b%A+FA0B;yT1D{Y^C4`5c{XI?r(d zi+VEVrGrqTI`pmnuv7K+22+wGk#}TZl3y8wf44b70ls{^MpI#;-~-%m)v_0(6Z*;d zymdu8A-o$lBiWzYr#*iGm3RBaPKGaev`4DVqi-GY(%W%AUP=(e>IcY_6Y&$cHy)cB zfzE66KD{hVmvuiFJcFf;dW}FkO+jS#BZ@sJP+lTM0Oc)MKV;W~y7(whwJ18$&0_%$ zf3Z0H9Ix~YO&)+*6H|5m7`MvO5CnZZgmB8dT0fgGu-OIWKU|7|QSu?u+qVdA0odC( zdj4F38Z*_FI^(PSuzje%Ab2TUFor2z9c1*t9RswoWSer!fEJkAF2v6&T9{$Y{Yq(; zuZT;|!#>L0KkUeEziyv_`{RGk1|N$#e``r;6ru1PjOsUZ&qce}boxf%i-W)sxbzx} zib*r_8~0V}6m<!zQf($`skg9QU1Gl+#OnjSjV90SDs`N>AnOV&sWym90H_N3~udrn;&&GAgE&k;4Wm}iI>6S4z> zhbvWun4xh8zEu5IM6Slt!gB0#Q~9~vI2FIQ=k42JL1qHH*eiJy8=q6ffBzHu3I+9j zQM}a>*P$GggBjy#SqH=vM-li(#wu&vt%Yk;a|m3o?+d~qJz)WT9@M=tsu;O?7+G0Z z_PF9LfGsB?LAHMf0=y!>#Q;2ZC5IpUS0&9o5FZg z`}xa`H~G4%<&L5W`S(8Cp3uQQ-n-J1(k;9-;Rl9fLdNjP6E!T4{s=tz?cjHeErn?A zqzEo%3pa^PXdU8ozZLpBQl&oFZX>$}u82=p#Db$4BQG(Y4Tr|re|4R}6Pv>Bz8T5> zBVeM`QW*%tvRKCf}Gs zX==iVl)*|OEDwKGf05tWGv26sJu|-LK&r}yZd8A_?yvQK49|0u3@y|83Z?}W=_*x> z)PaH{dL|0qWxXU66syt)Kk`8eyT7`SLHoTS5lBm zOfI=sf~_>a=l058hS+#_)Ef3OlE?y}J3n8Z+-lAnx=v!wD@fesdbm{kujH9w^kMc7 zTzm`df9ND!BP?rUi#Lg=6V^>L(u-%{pITMK<6khvgrEFlJj$@H>4O6hRUiex+zNWT zYmzIye;)aTz8KV`S_YTLp6Jya(meRc>%_`!t=U2NniyG31&L6>&p=M{sq%T-HBKHd)ts++S z`qFWG2kc%s>;kEz4hTGLi&Gtr!w<73Wujg{e*t<2c4`+Bu$Ejl$ccS5)6ktK`_K6_y2p!_YOD)GLn#Gt6DkOU#J?+o+J#GU$ek8 zfOt<)9+(bWdqw*nd22ufHf;4Ef!-brisCj>cy%l5@QJwPYs7(y&<(eTweCO5Re!<0 ze;*ub0MB%Gf6e@0J*9R^Vnn}O8SjITy2PA;em~G%uF}P%2n>5z8CBP7@f!t@r~M|$4GU<=lgz8M@S5Hd}&cTb|N)+cuKSMf3@(= zHn&8WZvRHbwwoz#sFz&J+NZL5N|P-^WAZ@P+-wtoaXTL6Ax8$CJ$seMSPA@IMAMfjL?~ZoBLw&9Ls9PogSz(xE?jjrce-a9)=*@z; z9xj=Y;tka(o%q)6*e#!9VR84EnB{MojpWVY<$z>Zq-Mk0%N4arvFOMRCNY8Eg-jS3 zaQ};qVHczqBgLHxRzUgKbLKpzI0BOcXu-#EinHhXhP-;95n6a2>m;V=#*rp?nD!Dk zEa9I3O$c)PAEc-7`rP)4_-g|xSmLs!b0A-cvnZfV#|U7J^Z=qew)>gkJn{N?@UHvOz$Fd zEUdS-tF7|y0ASH`KbOe$DuGGVd6GdpO?@6k$uvt)fArj|lEeik8(~5d z2EYWyF~K6PaB~?=h4P4Ll%z+tH|EOmu+t=s)wlVAPn;A@aXHfV!?AL${M*j}5w^Vk zQp+l@wNyygrf~K~^gji)9k7;ls81ij|8RiLlB#T!kQ+tMH4(5TIJ} zQkLE2gG%@<8%1M9uex3pU}gsFXAaFC!1GiVvwMKg>?5APZI7EzE_Znj ziOLUW)}pSR89p`hD9I0)b^yln|BzEUa1E*aWz=CS98d>v!}a%o7p z5LIN|!OQX-e_)bfA&!!4vrhgWmmIC{N|)&Q^OL(JSn3m_vTkcYQ>8acK~es{-;F7F z-ar#h(aJpXDCtM^NDol$Qi&5xeZ;GhPncc>9SX?inJs_ja&^(_LY(3lhXS|9je}2< z9xm@}GE_4zwy4#Ud54|*gmDS@Gt|Xl9&P%TGD8ijf0Ppa;l!T=c#*POq=M7K@W?=2 z7N{SBDm+y!iiyHsD@;;vKnsXXpmde#pbS2>l|?qpGC-1wR}oDU)(a@8^mPd2`Cv?1lgePI#jwpmv_BX{ZsN%~ zdLzELf2eXawm?0`p*u1YH*ph+Lxf_xV}4wJNxkb2=t<&|*80-NJrgc(lrE-y7hd%` z4GIFdtEL#WggQ4!*(MK6%GUCw#5aXEN`ZPGf$JzUeWTQdKU0bf9CGrWS()$p%PTsU8osW?hF`VzW<&L zWk@JcN4oVw?b~g1g?uF+@fBKk>7Ef`*d*?3Wh z8qT7~m&22%ZvN$_m57$F{ zxC9ipi+Thr370P(0u-0ag9H)-Gcq)nQ4R$a1T!%kcsHaK!}5eJ}wlew*psDTrZ8=wX> z28aTU0L;t)CVwt2E;w?4h^?KwgSn}h6M#xZNsXG8_Uk_-f0+Ob-Tzbb>FH>0Y6GD7 zd~pF<+1gnHZJa(s{I4CAfk1$h84zG%ZUqF0C@5-3$x8sJB;-{95?- z+z23RZUnS(1X2S`Y#jhr|2P1QY;BCq|0>Oq{xg=4BOAZ~;AjUlGXHb~x)}lO{!)Df z*a01^%^e*--;KEez}no({r~0kuhwe7f1nk%wKD!!os^ToXG?@^Oh0L1q-Xqx(A-hn+zn`~XzpZW z1~4(O`s~-=aupk6po5jU4e*oKzgr5RV`60d7u|O=e{&;Co4*KP`-ci>WBjl1KdJf~ zJcG29oQ#4Z?fYoA z?Y{(nf2oa}9UMLh{`>NOR{fvnzh@o@bORc}EzR2+@dR3=r2TTL!pa&L71iqLVgers zvMa3po|ofWVcY4G61vG%s{dLUL|-?~{od?8cWn2zD^0UE)P-q9*_i}9&&Ky6rS8u8 zvPRL$LA&SApj(Le>qITm^I}$Z145IXQFU)?fApJ@Zow-Q!FVf+1I)z(wJ)hljxRdd zy&aObQF6^sj5d@y5Y(#N;}eSb!-spyzTv@v{?04N?p-|E%%8C2JO)_aiO0kVPVV{+ zx3xy^kk2k0b|5Ol&UTv8OCt2K#`P_!awg?#G(Kqzy|m@(^jmY4756vRa*3+`I+4QG zfAiCGAsYMo<_JJ)V^WEWA)i%Zx*nqHoghMn_wV5*IT+a(svxCV%Bq^E z!c4o+!j3@bh#-n&+*o6VJ@}Z}5-0Nfstvu_Q}-f(?YG@Wpxna2TxSp(sUC}$ zenZHHP|Nx1CA=_KL{VaOtqacBW0XE2e<_*VvcI{OJ*Y0%hYSZ(z<;Ac3EuL=#!(Ne zN0)CJa$^nU-;?CNu4i%6RZJc(Tfn-*VU3$F&!hj^TTfEIH7%oC`{2X-SO~zO|MLWj zKbt=#OM6E2E{-e$EM@lByJLJ2<0B}sMf_&>hla~^g$XcYk+3XTG#{{C{^zhStOZqk*!KNSVK7!=8b!BG0&S>p^FrDdP-_Pjr)u+bAFk@*2rldg= zJGzQ6qY2V`H|ZQ=uuCo*u}&?xt-bqJf3Q7R#H~a}D@>{M*M)4|b<6=0={eS1g_W z%{Z@)YBD4EN3xld^myT(e=U45e;4$k@1+}LN5m28T}YAP629VYb$x54o5VOsbEF(M zsi|oLEymYwv)bku2#^Cvz&TQ;qwh9z&l<0sg58_U|JRXUmDyV{#xB^yi=~&X_34}BTb`>TnZB`2kOne<+y68 zq^hG@pb+{d2{rUe21&Pw!XOD+ro=eH06;*$zkwq3<2tzumaY}s(eS0i1aS6^cV9`i zQB@~IUL1s)ed6;WtR|L#!c>{8v*7<#SHm2_s_cdbUga1^YW0w)!go6o z*`k?&PCvb;CllZr$z;IrY$cie2*T2PZ_8k|HeiW081?n*m4sT{k$>AAe|C{EhQk-r zTg!P?8MlS(Aje?6JM6M){B7tH;@}|6qhC@#-6;Tw2vZ=ZY~un6)?U7{*heesNKyeO}{tlAtm9q-b9A7#*~(knvk%+K&Jn7;=H>UM@EQl^?1CQHyX(b`drq5|zN zd_{g%(dAPo&vLINntu$B^Xb`C_b({PqG|^h2zXq_kE~CH=mmJ117zTSc6}SRVf?6AA*Y`=c(bWJs@=DSk^fq>ioNH6idloY@Tkh4qybIKYzveh+!&{`hY#tSVe}p zp>tZA2mZ#1TmCzF=s<1r?2H;^z}mJs`2NvTN~*SgYn9kLoTxp`KO$OZ{fkQ^8ou0I zHaJmWyKq$1aBcXnd@RYJ?d4jID+gy=sB&tVjTo{N@iEKB4(+OTl8_B5IGO@KSqZe- zXM|a3-{0G=Fn_vj5_=NA*kC$#V8JJ%NHR++I}Zu&<6FlkD2q`VFT1vRmLH_m=%4k2 zuyq^GwkpXpdXFFSqP4gks+BLE+X?I(xx-iA@Qw2+hM&Ax@bYL*4x8N=3sg@4gO>N3=Ty?qAS)OSJ+!_`}{ zXZ+D_=85nWjmaT{@nl7w*A&!_3jW8EZJ2_95*t zl6QMQJbyJ&v?(un3U=5f6lDp%0#^(cSMHXCBB3E?`#b`M*y~i1?&S_V!BzxG=U_+@ z14_6FNvJ!Q9#h>CB7q}?>uV3F2ljc;WOp2I=uyU?2Cl2wm|fw~nIx#vh40jNUnHH1 z?S2mBCX$toL_&xlvJ%qhWxo5MHdf33G2H#2E`KQ=t|{I7@u#R?ux7V7_d_>X|bngBv2g&YQZx-#D_OW!+^m7ID$;?tR{8!aN}unGfM&Z-N1^X^=BG; z!I87DJ`l>qROtL>W7^|05byxI(OHQu?9`UNx$xzlp{IOVnQH_$O;Ln(1Z zbblr6wa_fneGSevLai@@v5Jihxi{T+I_D$eS&~Z{UYTteb_2*GM>$7(u=18$vHP9e zLT>oZe?Zx+s`!cJFVqTufq~0TFfg~%)hLZe4PR3cJx%+x`ufIr$!K28rt3xA`<4%~ z-qjP&)~9qWcPUe}2M5$K+mui2(a~fe$bTmMu`>YF-x=et6rI@pW8Y|xvOv5FMP~wR89zCR9e*%lj@h3^qt5|5r9t|Ua##S}i-@%1H z(jN5xDDzMZq)HK3)e!yD^^P`LWm!AE(=yJ_Wqkl~2Y-+iM zC29Bq^aknSLmhWY1xp2;ee-zx`J=tTy41WabG7}J1ChbI zmIHx;r<4y08~{B^fJ^VdSS@37RDXBLitloiili9r3ZCQyTb3aZPVQM6?RIlGe_)n| z!6gU+p5(^+=gDlq!_Fc%PhBbHnh{zzNyFZj2duThT>pZ+`xe4Z5<@YXa7a(pQ~SZL z)4asbW}Y(BVw=nMC2?#jLYbT13a}=~D3*QFJ_O=4O&=Y85T@_S%hkT|@_*h;^R|`s zT5(Gc524;tuM?2C^f$L3k0i2;RR`tbzeBfG1wB;c*CVU)0B5RIbNCuRaPLuwu{I9L z+YL`0VNdO&k7Tykh_Y2I0``*>vZ~j2Ad@tI(}tU_2E-lA94cp;#Ym2hJQwk6f%Y!r zzXoElLH0|*>OMQ)0Ca^%cYky`g^Lx8B@SADI~WU2kI5-uNy_y^`KAu8uu@)tj|?Wo z559~y?JuanALKnF`BQJHQJ`;}161d9@`G|I6u&@j4LbH2qej;VjE;4@4CoCl@JWHP zG_s`9`KaGtv8RF_5?PYH8{Gj6^F3?tmD;mc+o3exJz9I*B&)epJ%1;a@Bw;Bf=Yvn ziexOMEk;h`NyDnG55uSs62|F1vBtmPo{LV$!T!u}uRzx*hb*;NGAKA8hf2xfeUmQ? z0K*)@Z1Qo=<$u4eA^ot}@Seu=7`&6wXjva(rl~w4?JHiWAV|EZt4QDaBh@bHSN<>6XvaZ^XrGN}q3+!Pv70+*_7_cR zSBg3hV@u_8z_ctGG?O->*@tr$NIV~QY(ZBZYC9D#{9LRNVeB?yKH^vH13GSg?2~YN zp{6AG(U~3RtDjiSS1dI@x>OVM`>pfS`dt8qZ2lcE6y1=an}6N`I3tuZoMe*KtMOoO zCQC!)QN(0k-q^zNmily4>4;j_%d^&Ruaf+hOf8;CV$VZ0_Fx{t;vc6`u zH}M<=H?R!j8{DSy9}fJ0YMu=EN|r>&(#h;4D3t=0evfwL`Nx^Hw<8cf!iB)Dd|Vh< zeMc2VC|E?tGyri4aijuq10CQe)Q|doZhjhhW#Ng(HGknTKSX-n%(++1I(}2`<`+HK zi&~UD6+WELA#*k0MRYfVv@@u*2Ar@fTJ$oNhirFuf)@t2^1&>2g8f|6ipctL%r@8v z0eU5IX4zw?&>B+%mk|M*z#3D1Dk$={0t&BJcU{`QTO$_;&T=-fWv#QjIUapC#kxO+ zzc;j@2Y($5l2**d_NNl~GnWP8>(~RGB7Mu{>s)W6nq)^JB7!gyO@;Bjin@PmCL|Z) z`5>+(=Ei%~KywH|pd~#s=xHf6%jj{G&4&8H+J)=bxd5US<18ees3C1Kylo_TJZ0*} z`a0yIgAO;1a>RA`NIY&q->}!I-xk3{|9J8Pr+<@;53YXO*x3tI#6rGr&!Tfyvi>6s z)f{qZ^?2-kT(;(xya7E4jC#i#{+gVp7Pohcwmr_zr?yO<)#5u(skX{K~8 zatz;UxVTsCb1k|)aLmFhV1yEbaN&GP@tUa&sYe;jJIun;iszh*#KJn<3v8^Y%l0tL z?R$|(EV)omGyXt2l$!XkyxV2+t(@sln15&Xa07#P`lKgy4<=WB=64iqxFs3({?RIJ zd=(xJ@m`~7UX7~`Ms`jK$&;+!77bF^(SczGq}(Ymp2YSM<>gm;fLcq>1VC#$yG=)7 z;-@Ou9aL2i)YlqDll^$BKc!t!xcS=O;=fT*gT+Dv&NJl!)QG?gDlo(Ar#*8Ii+|da z(d1veuk|X5Qr|wCfrwxI&GjfmN{>UBb9qCeTUT9{-n$}~j+}+Xw0H0S$YDpVUk3)D zI!VLSSGvCbZAz@GSL}^W$=Oq3DV-#wtGxhVBy>_*n4U!`Lfq>dYN&6M?hAj#$OvE_ zIP`^W3UxY&JQ*@#OMj^8@Z~{cwo|Tg&txn%Z9#^Dz*Z#au%Ow}41PeU z==e=vHJVGZAVohxt4ad^lP{5t6@#GRE^`h`EM(JjpENgya?1#Rk1O$RpihZFOJK>#qao3m3@Oy zW;V6Hy?g$l{;dA)uhlP~Uma*~oyNpoM*oABby1sgr4fZ!gns!Hdt{c_@Y9-R!r zS3(gRrT!=_Bs+x5Cc5E>RmUKK*J3N_~a^Pb#3{=5kY)PiQpi}~|HPbim?Jnk;N_(FtHjhi}R z1WrDJ-s(v@E{|d+sQXB$Y)4yWC0s`LNdya`v1KLVv2t2~#50n^uFcy&eOx%5#99r{ zmJUbVsBPW@1g!=T2!9B@GmY7&ug0kc!e35Kawm&u0SHKT=N7h3FC*W@=IZpf9%neS z7YX{mc;Q?kv75L~EjMr4<%jO_7y3Da%^icnzOV${<*)ho_&XZx5WP#|;WxMuww>wW zQa(DEwTP0(j=+D-0BwANbba7hhZF+|-Kb#)n&3+sNkV8Q&VQ!r@*{<*gNrw$o$EoO zZVX;XCLuFjvPT+*RDp0~LHB17c3E0k5*+|88qqof50;FF_Zf_MGKzh8R zTO22h=zqHxhdLH1sYZK8difMu_UbnwGoqQgj&l#YOOSdIpw5&<%K%eP;cAo_Gs&fA z^`)KRnGroZWtPFRNOexWz!xDt8)!c*kG`yx(PkUU`w#G?hb6)B7z+E2GKVvw;viovzs?whuL3Gko_k*W-wV2O0MYKTh{ zf=dB_tfuU0SmXwsXWGWP5?{#ae@5}qc7GH2Ka_#ptT)lV0Rs|Hp~<^=gqRy!$afkM zfwC>qz+0+KzQrMjTskb>VctgvJdd#*a_wxI<#i#Db%n0rR^n2JZ!sb&Z~Zww@e1Wt zR`AJiYb&pn94+L&rTAE_8@F8*G%rqf;V;@dkB8iIv_JUfoI67owjMt?#@p(IiGMiI zXW&sUO=DX8_4FrbE3-9)v=UG0K!Mmg0NC5hT614ZOyRZgIRe$9A78R{rB9hF~aw4m5dxsxgU64>m!Z&2pFe7-( znD{#sj9GSuH#)&NKN_r$`udxu&GYFaOosecndM$OdbPQ>8-O_N1K>M0@^iAED1uX>NytQ+n5UFZoNM z0Z)|0BE1{Qp;G2o<+h331pjM)5OP?;Gte;g_}nKi|ap4a6@ z^xds<5;__7tlrqnZJEd_dVkc3SDLGKjLFuROt)ZjP*QD^sz#E79G$z?C-)hr4W|hH z_Ean-Ed$Q8@Yanoh3;kB#Z&a-_8gdwvm7{(c7A^`S`8Y6-xgHyDhb$uGtD2R+&eH0 zw*@w!9x26VYJZZeoGph@m(kT^ z`5LoA@`4(S{{47suIMOda+hY&wSFZbzgaSS0*v#zhe3aBB3C5f^6HNA%i(arjfQJA z2Y;lW=GdgbPKxFaD65O^Tw*FNo(yrmmpUsr)bZ_poBW|il78z&Q^$V*r8P2rrX$YqmAOsw&?ryZ-#B+ z6WK8B7xQ7VW~)4W%pl1wJc&zLuJb>w!;ncAC81d+U<2pQW`Cy2ox2{8SL>Ifc|S{u zg<+_qe=0^nTn@f?N(OLI@s(a3=Fjit+n#c49_AZD3}O*n$Iq~1a019Vb*Vgf8$*Qj z7{p;t@w9sizhSj=d7G=taW}s=4H77ZJ;lRwQW#P3pL#1CFQfCz(!sh?sN1Pk+gU&z zPQ8EzM7O?Ld4DZo?;@v-K3vm>Daw6W$1lMYSFMs$h z-&1!t4h6+_rv_mr%N=4-ZrVCN`bQ900u2`B0kXwU+^RS)lvr(7n7*T}l@UAkvwn|O z{l`b0u7=}eb&K9)wFK7LTKCXiHU$z`Oq5_~RWV|#x8_0`&N-KUJEiErqmBB@y6`9EwqPB2D~OZI#yO&4IiVs0V-C@ z3HM5Q7=Jb1hguk)xR1)iEzF1VD<5Gibu~2)5Q@RLbYI!p6W=4mvF9ZiPfWsFgK>e; zJ;H z*l#IRFR{IwzdU0Nq0o%we(gJ-PnkecNKe97;D1??AtU0;ru%+H`FbbnSP6FsVN9AL zta-%=|HA4+h^7$4VAETjJJWHYA!Kg zx(VwxHDm=(AD%;=Q_^g*n%QsZVhw289#+m8+qhF z^2{?vC^@3!?@t*mgJB4~@$9?}e)TEWmh|P=@DQQ$^?LN#X_1t)7Kn?G%`9JSDu3S; z+4V*!fLsgS=~auKdLVi-Xs6_M{l}DM%2SKl_IHYmu)nU`ov*K$62I@y@A{vFu)$Kq z!sr+4?4lsjq!nWZ>6dwAwm3HmUkIpHDZYO>^OuWUSSeoeIF6^!Dh|%%C7{TymH)O+ zd)w!X-9@?c3yoY6x~)?Ks{Rb0w0}@wwgf4+6F>duSYa?p=~fvOUUl;EyC8U@ zBLNEG&BYn^I+5(i{M5tvpNI>B_vW1A z1y`Q*ySn&`3#F$WM%V79*kH11)IC56h7CBiAWHcnTkrFe!u#TpFE|FH0(+7wT{r6} zk~+l_eG&|3>#=!Fi_9J#I)8N$g@$xx%ktz5bYfH>2G=(`qIN@ngCLymw)EG28S;hqtBB@ zf@W7O0r4;^owg?tio~s309&TQ%TAETZDQedt-OJR1Ac+fg%bG9M|c0c_kn;`7~A1= zOqg$IHrIN>pAs8Y*ilvtg3#C$hlU$}E~|KH2Nc3H>Y!7l9viJ_!_f|CsF$5#ePK5h zZNDBp%OOz`Tu;3I6n~`bj*IZ<*C7RU#tfjo&|D{+h!BE`H8PhO&hsxKWWFz?e`>;{#*l*r>wQpxA z*!xp1uz~h#0sD1BMKw$@Xsonl2Preo=M9t331xM|Wf;9Tu75vBxHAjLF8_FZLV&aSYy`&fA25lWLLMm5AZtS8uh+QNr9$woeG5(QqhxnY-?Ns zN6Ha9}a4v*L@jX zA-%y_F#1~Fa*CYQ^DVA7{~QPV4wiyWOiszcul$bSWA(5*jKPsH~8?h_DEZ$(xa z=sB+JnVKFCe>l_nV-Q3jmwy{}L}=KUCUIX?s71^Of|-9$r|Zd3fZD&C0<{LP{*lTY zGOl4EqaHTFO>NQe5%Qx!=kcZE`qr=nW~q}r!${d07C@wW4HZE6)8S`5pKxyfV`>p( z;x6CO(|-k5q#dl}^SXzP3@O_Y_{`|M%m7Y;Y19j>xWJa~_3~3IFHQ%*mAyi7(Z(4A zcq$J!RJe;x^RQl&1n_x5gEX}w#HRbARa@SLPW8~pMg60%As0*$8`)Xc0?@oWGK-Hk z!Q@t%*@+U9EIWlYW?^WXLuKSRU?ng3b#HNaw|^E;3Dx6O9UJU^u=72CxiicwJ^C(N zp=bsLk*_HBo6p&u<2Cm*sYS(4MukSsJmLtZY))ogd1jE0S9NDvfz8fDQA`IzT zhi6YeCLwM(xKq6n)V^I`3^miNs;`nL)9;?wZi9$4w~bdhep?O*&d-n+WR6i7`1Wk2 zv46{CGN}49q)6x@8OcoQykMjfJ|SA>uufiow(5^_N**qIh=GCA)VEQia->05tVg6Z zg0zh1943sy#GT8+U5W!KzPFk0YaEPguS#&(-8mxGMI=J)&DRhQRcLC0jkTa1VwZbs z#*D;N2u4L)3+lm6=tkQX^BAN+WQ)oZjek+wQ!CbHy6~`zBgq7`gLFQ4xL6yfeN&ba zveZR((n{!InQ8LZr!{T0@umBlCI!;{pHb_qp{}kb?Rsx zV?@gyWM`Ycb4v}xF8H+46$GRA-Er# zp7q}VF~KD8ydPKYGrm^P%v?etFGM`n)EHZqs=?-c_MlAnqj}<10>2a7=O?wSwQB0N zYQ1(9Ewpn+xh833xAS0U-ikaOYJ3Divsf!J^iS+>t75L*JsD|3Y+<7 zDE(!1?z1;VEdr8T|MZ`Cvko}*F`8yM2wGthn<#B$2h77|aVB9YX13|i1YKwq5KMzF zX)lXj$Icin5C#Qjn#^`$Pvg~uI`?AG&8}Q^VNk%MgXbFOegWHDs?PVN%zxO#rx`*s zIm_G%Z-rtK`oqlrD!D#|Cd>$go952NklXCdFvC%wjs+Xj`bxn$VEMTqrS`gnixnAC zf0xEdt_Ki}Sm1Bfr$|y<{FuUaBu1CGzAd+^=kF!IOLSmXzum%11&upMK{AOLdsc_k zC2#&dzo-vBNSSl@i0kNx!GBqR&V{#z^35l3zaFzwnKqVT-@PwX`~&J8!*TNIIv-S> z*cDq$2a%7a4FICX(^B*xemz#0{PSr#LHn>{Kcr(^xIq%+jxJR(j9TgSY*0WjCytCR z-np7V5)+Bs^IU(B&Vo<};vOl2u#P~Adnt(YHLnpFO(vXwwS42}n14-^S+~W+@~2m(xf9<P|_P(@W%g3$kjR2RT$&UjNPb) zWReWm?heJw4T!O^#($-E!!9VoK`Hu1JZ*&wpF6h?Pig1I!|Cmy%Ucn4aaEIfd~-G7 zOWyLM%(2&>H8s{z>cT%9{3w`Odonu{`jd~Nd|Z;~12!9BX=BVBdW`DqrPPhARNrRK z3A^cl-O}K@vYCMW;LryG8?XV}RNeZuO_CSc?tb?mdY85 zYk6XsmY`q_)aKEdbw@Dttz7g{)mt+{_RG{5WcFbaE9-G|6=;3FMFfR;SLL^`0KuTF zO**Iq^-&Q#6KTOrA(d|kKbp~!1pR;FLs;V@$b!!;p6uOnz{NTza9g9IpR+wBsEPWX zqrTuqcO(|KihujN28D}?or%d^5;3Q<7O259g!4Rf4ra3GWI4#Mz#n3eEzdar>J_OM z0vn!1V_qQ=2|VhkoTzQr+l$fHaY~Y^_wO=#56U`!RW5!-qnrOumW>a^n<)LzHh_iLb{lgyQltIheMI6ctgf91s(kZGU5inZiI2D19i+k~~|IQB!r$ z0adck4#T8)CPE}xVx4d1)hra4p~3QG_`TJYPg|k7l2z&39FqT~F4F1Rp9b}QPXTro zPn{kt(!le@PUX1-EV0?Z!|uzNwGefABpF2t=ab2kR?%xEFjte7P@@{%Y<#sh2t?C z4cqJ2U-$YJ=s|?o+zRHfd?z#Cj$DgeL}HVg-;^^2o{pVz+rJnU)ZHOKMu~1v&>G~X z8h^e-I4lPYpN+#xiJfxfF5h9XKbtpdBeoA(VaL`m*F`GR+hK0xL*!yp0QnV>SB&>! ztG{IUgt?B?oF%)u+{&(V@Yn*QZP))s+U5 z47m@)+|9C|R4v`?%8~6xlM+rLzJbvT7Ju+avYI07E*-E1XRnYhuM{D@eA+>3nyZFb z&=d;N&{}{BYo8f}eWQ?B3edNbA0RG+ZkW#T|GL;s%X(o$yYAj@*tyG$eqKhS(YnaK zipm+lpg_^}-BT0>-{q3A>aE>tQ^Z0q=#`Rdu_T%)Pdr^HHY%;+50G%)1Y zyN?`(%-j~j(rY1ayRnMtrj!&%F?do2ii-%z*K8Z2_%o~Q9o699uO6ph!gIeznW{>y z3EGB=+K*~ev6mvUfrh>poPJ*bwtd0I@wNm7({oE zyU#TVtfnvscR;kwe;@w*QA$B8mGCXy09Ag`VNBD(oh%_K{oq2{i3;JlDS0nmyy+fI zuh()W(@bUY%>fZ+GnbAqZaBF*Y9dqjG3$?)mx8PUx@w6rcz3SP?!J1}jDI5$hT8O{ z7YBJNk+o33HXy5PIWuQ&l02WK47Lw2>+_O_NUW74sPbecBa+Ko7q7tF2Yq0--J3&T zz#zJil)IKz92ssNBU3TXHGIRdl8WhE6>0bU(BWDo%u1Y3c=l>2YEIjhB7DcUCtNsM zOxnQGmVn3U%D^aV>m?*;dw&xbM;_(R{_^`;#wuUv2z2bBDG1B)(TS>Y(6OnE)O+)~ zxpgfl>g?U2l?c_2xq_1ix~;?W&Eq=FG=S2u4YC+*H8Q0*o_#}1I*j)kd_Rm{?;h~0LutHW)C41dPgrW?Y%)#oy+Jd;5z%RMtUWqfp7}Y(Q|d>U2a14} zt-zt%WI`bI$?R-<1b_G-1Qa@ZLqO+q)oR#fba~ZgIP#>9XpeJ#8x_RQhaB@~do@G? zqWjpf?S@|(*XCFV1i_97VF@N!c)SG5`qJf5&rg|}+ zh?OH1ko|aG9uC>UoYGXuwo?y2xKeDe*5~b>zDNJYJ#)QXfxLO{W&Wgz0Y;e1{I2X+ z1xb0s!`U-_+6)`Cm0b`TkA?wSw&&xf>il!6<2hg;(bwpDu-nx~(AzWXfDO*0ac*mz z(|NWbxCe%sXMgH@WsK5TZxyX`0W^Z;)+SLry!?>bdJlU5xe)z|IEUpijzI|#Uj=INSwm!5UGP*xC^$SupYX8{j-=M9XR~r!Pqw&lMuezCfuZUiDUXK= z`&dGx8+CQn)K zysC%s^MC6W5vGtu56J7qP1H_1P;pM+9ThUO%Zx2nEhLY|dM6Mb1;;vY`sKPir^B7? zI^m^^)<;sWa2FTDIUTd4RhEKG)=sv?&MxokYv}H`7HU-^5f_RwdoDQ=ds!#&wQT(z zG%&CqG%01MSo@!}^8PGZL1R8hg1H0*txM)6zr47BheG?=zRS9E*-r6X!)|zP& z^M8`hSdsU8QRgNZ=_Z26lX5th^YXJ<`c+b zQ}8LqU?_XP+%Yx~2W~1qIM%8j0L%%`J$LEB*fHH^1jm&HdR`uqfCDe5mjZgL+`)&kb zT^G{x3M4KkRxTLfFMsp0?4n}gj2^lu@oRl)&BmOY7KP3+D%VUg9KnwxGnkz%>OHEQ zm(Q61O+iuV^r*y@BFhcqSR-|~?s|3!-Mc$IC+%Gqbnn=SMZ43*mf>Fg+Ol3(BZbCj z_kRHLdseuY0rmkC0W_DOxCA5vG&V7pQ4R$Z1u`)+F*B2qRVRO}wqtarUAHA1I~6At z-?44mHY!f;*tTuks@QhLwryLLq=K)W_wCcC$N9Sdbe|vB7}s8y3v=x?HW`tk3Z0ON zoe@yn&eoZZiJp-gAa7w~}kXCrUNB}=CaG;;y`m9xQ-k%>404V^9QY()*7f!qKM zpb0<}XbfOx1~7kdadE+s0YvQVJsd5}%$)(0YRVc^G&HpTDf!0)VC3;1n!lb-7G|~p z^1nZ>Kx;dD8=$T8Ux@!}M-?Ct;A{>Am|9o^0U`>DT2k^707?mYHGl-r7U*bb4N!D3 zvbHb=$XXZ!ZJmHr08=|hfc3u*0Ao8_6N`UJbE5x?CFFkuFa$W+1C1^Ix&hsdf%gBX zXaV*>M;i+#r@#LI3nze?qoJ+y-yS&I0W55dtzAt1N#L*C)b3vi**n_(wXpfC`wOOM z=j7~U>}X-{4EP&WQB?fjc{-aLI{y>f$>OgXU}yT*(!|c#<)4!NrTYu>SLptUJI924{3n8wb3W1Csn!ZG|aD^j+mb^s>E zf6Gl=?EgdO3UvHegDC%*8LGcY7@FAGT6+LYfTn+N4Dxo)e?tN&|L<6)|L-IDzk%Za z7J~m<=>2~q_rG%Vzg*(~*Zcfmp~YRSt>q1E{tm#ucMRa~k}BXyGJo;SMxWv~V^y2bdaK z|LuR-zvODRCO}7P3tQk{ZvWL*038z}221;q59XE{S>M+wPibFo?y%LtPJNmti0h#(I5SNOyI*I z_CFg{iwpg0?0Wsu!*{tV4c==*=$odwKifT)&h0-ArKyib`!KC3dQ*Yd1$aIrRKI@; zQMSlCIcSao8T5W4W?X1Qd)+L`?m%d>GpZl$O)4qtmA*saPj|97!rc6(@+WaE^hYOs zw*Tg9oYoMB(S_Uuf?8K}enFme`umw;aBO6FsP_)?*C8%VZX7Hbk0F+C$~jT8vxkA> zW25mW#$Jx zSmxqHepVz%v16m?2L$-%`e z?a%}hNp(g}4%T`c0WvZEZ&8AE{$mx%dx9k~dY#Tb1TcI(Ak}}W=>zpS z7m9Sld=}tzF-*s9k&h0%jDmt%mZ8)a(a+Ft%H^!F0{gr;V5wV8n8FoPmR0k^Ymm?a z>CLg-D79`f*9T-QZ`ffdl3O-Sgxt|md1MdX4=H-By+68p(#6;U5f=muW={H>WJ>p7 zJQ|0!Bzvwv%4A^qW99RGSyO+sFFw948r2RpHPQZvI@Q^&#LeyyPR;6#WZzHb!OsFb z->_otle-G26{LueOrhfsza3?1AWqGFk`enldjQ(Z2<6eYDazlVcPIg5GiH@ z7H71&=O_CVCf^+rLWm5 z1r$qbu0+SaF~fdy#uX}iBQ@T<*vM+sxCUP%6#^7Zb&9`RsaYDg+&$0LUDay)SvFf~ z!VV})rV-5}<4x0BEnz}ZsX62)*-#>zBU;U7gKQHJTBaZ3Uhkxi{Osx;WRK4DRH(=z z1fmFN;d<0W7Dajxx+;Ixc&R2vgN$Uc05wtmt{$+{OUezH~il9Zq`83Od^X9xi{oGZQA#O-;XT*o9TI zvzu+H{-7<<50*Na;`6DifX0)B-+eji+9s$~jPJ1lJ>f*<;NKNBvcRT44RvC@i4A}H zIz4gHYt~?bh?H!<|CIPvN)x|Jj#Tkf?&+vnmq7j9bDFBka;G@k$Bu2PGO3zbjfsPu zr|@>O<3sQ*?#+Kq;v%aVe+rZex6g?MgK1;)+^0b{6C7+T!V-^m78_?Zie1<2lr#Bv1)QM{N zeSYuKD8W!SWJtOVg07fL;MufbtAtnB+jtrI#hpa=2L3Q~`1Y{FuZ+2vDca&lag|iw zGQ9{razEC&dMgj7aI~w>S}O+Q&@Jx%ydmDJi7e&A6T>R{p)p&G{kGR|$LAD>m!vTt zD0H3nyae?!kQ!$JfvbAj;$oY-x_;<=y)^YLi@z%jHGywCj|T!Ydv}HO*RwJ< zS+~L}hJu}(3DT=HJUp1Mq(EjjN_aBu&SU6ZA?wFW^@SRZuP<_ihVR0X7AV}gBsAo}{2R;I6g%oI-%w-ucUQY@Dg88ClUkH_1&D_Zj5Jkvn()G!U*vP;w~yl9jo z@ORo2MeJUypphFnKNdKt)sW#^zQK0VJn0pGeXnYGVwZ`(wR}QoVT0@J=OQ;FQFDnH z<2GO;zlnZ`3Z4|Z}Yy9`i&?s z;_R+@KUYVa8p(_#M3a?`)O`Y_)E~-R5ACJBM%9V-JG_+CZ8}#wTmA2H(YwX&;1XyV zO=hr3>B|Y3*zd5mWKm!Cs;;8&=_Y?C;&)--%mli64ACX~vtHO59?$v9KbcVMaL9{; z{~%^C?Nod|@dzE+f;`Z3DU;)YLDqKKQNMj%d;j|2YS@DbCgj?TdG$tevs`~fCu#Cl z!=_W>0^Q*m67+ zzf9TV0QKt)d4y63xcA;rNWkhLjf~L-66 zhF<6n^HrO3HK%dfLTb*Vbcrq7elsYuP7T3sYlK|t@ayjba@$NZ z>ZonPMx4Z{F@qruln1#b8FGK#>%%%=SKL=ZSej4+kClVJ%r0d5DuLM&Pq8}N^=?X>AG&cylzuc!W|0HmTfV((15lHZ3)B>X z0Yn$dxxfydGoBC(Du60PuX)8@+%YpO)nkIB1gmB8KsxV>P}Mx>Qkj3a*eG5{BCYTB zBw+6&HPfPldYHopj02N(RlNqWzdUe8;$Xo(Hoi zeH7*xnX0h+|sQo#GPf;QJMVH2DLir zE8|s!pMSWc(RwDpe5OTK1|!|cV-hvb+8fJoN7rZ27B=-rGcdi8s*VKGW+_kRrZsW! zP#`~LneQ>nmh6S7J)_xjR|^}H)y%D5BX^;;`K%#C})*N#UVn^_vbzGT%vXw~dEC=y;{ zFM`F`Si*!QuDBO+?n4i3X4fwS(e)5S3MbWK&8yGs2OD;IRlgqMU%8u=mq7BWA z9+7!ssE%%;JZpbkZ16EuMt6JunYkKC8n5ruy6Kshl{rjwMGEOt6~ zRNlSNEa%J&hwI@v&BFt^T_=E=Dz!DL9@EtWifj9jWVcYElB@P;=f1ydi({H!y!$hf3# zlzxRt88Ja^v{JodZ?qo5KxlQN0nDatbcKkXmWr7+1w_hdv&HbYtC-%e#GXvjo<)(f z4FUY~7Vb0o%Nvmzd~-2P@(FIqLG_ihGO6-FS~o@hA9-MTC!pp*1SRx+{eu#i6o2&T zz`I`@ttNl>q$4qD);h`29924^G_i$Fw0@3zU@el$6$yy#m!}so z)U7Ht9e(e!{6@s&m>=bmTK|z$affp6<`1>5YF)4qzO<1peFluiXR3a_T=-uK{GEP8d577DB3A(0TLh;ND(Pj9koz-I`)KL_a#_@Rnp%_ooOs-_^@L$CIls8*?dfxVJ7 z1+F7C157t5t~+K;xV!r2lVc)QMp%PY@8b-9=@d;};tqr50hF9!`$^B-9KVW81}1W0 zpILvwFX&4vxR^IPYgsa`QD@HuMvbTP*`U&h1KH@p6h~usYeM&#TUM`P3Px2)V2?-Z zprLOsh(PoufsEyE^@uk+n@J{bKMR)~F@ow6PO_kaxnU)QQlwQqwc$P6h0M_HBKPG- zJdmC%$S;OG9AfO_py+_y6xYKWB6G08a4otPjOA=5%P7#82*wtOatV)B9k zG>7vS=+R})Ia?sc4O9{kw|{5UzToG9;1Wa+(s?gwb5~fdi$DJNaP=NyvNHOb_@9Y? zY4`)yhWyG}l1cZpz7|eG`VwpVh1gj!$JW0n&8yzGxnCxxn2wAl5}y8&rQe_$NAO zc>$pbJj7S=z*bMse{t{VDoa(t3qK8m?O7RSY#o@|XjWb#poer={X`BOFbN<|PbiJ( z#*;HUBhX%6(LRL$j1NX&hZ7NdZ#af28F^E(<(Q(SMY6)v(3H32Gb)7rbc)E& zWG^+COlNe2Vh>6Lfou?wQYs();?QZsnznXt$-rqYxmnqgk79B_<13gDt<~xdb`(;a z%|mPADuA$nSX{W|qmG|Zb}3i(i{>@TuOTh{mg|EBJnwdyde1~3gb;sNkpId3Mh`PR z2p)PX8I}=dk=KUGca;WP=28bp=6QP?vY9w6L`Ee^&I0wA@i}f*1bQd*GGShOo9^=~ zJj-5HF$3Ah30TS zKU)3w@wA;y=Iq>>l-WDev9GwJWqolm1iw{9W+)N3-F!^fMm|s9vbLrhomW(Vbb~#a zdj87i1r49gJDhv(t6N}`4Tq-^X*V?@C5dSu)+h?&VeiR|RNH?=0Y08Cj9#!2U1?MV zNh^f6`!TF|@$hoh$n=C}k`_CNx;8GP-aLB*cEH7D4#@m&kVwHpAjJWFkN{;sn!orR z+#8IZvSOFlP=yBVfv)a0l9BJ~ei6xEw4FB#!MJE$-`FycSi7pSgAYG_manq>IlijZ znNXAWz*|hE!;2AwPVEwA37(ekWz`Z|FMz?>ahcaP00b}k%z6y7!ui#l;#lXfc=gWt~OA*ra2 zH6N|=g?u5SwVIK;&rSS;j)|lGMBZ?-d|`W&#N7c{*H8z>$z^YPj^lNKKL%=}&K=cH zUMf%CpFBAaVxC)n5Z(FIO=zFCRv)UEc$tjT{UL0$uD z;J4N^v8+vPXs0>~it5Uy@|%k5!xVTI4_vK!VeG>REP2BY4o@0%S5UN}7) z@Z#U5_I%vv*8=^U1P#pyiq~S}30d08dXdtKR(%lU0+#o4BJ>r1sWD94(7kfI9MnNr zd&mKZb9`%mK>bKSR0jJWjlmG1;6s#Wmc<#rH}x^QZ0A=Ar+M-9r1AN_6OV26O65_L zXg*VVMrVkBU>={PZ@Thmca(+)2ltC0F|^;;)dZ(YKhTuO)+bOXc!gN#>sRnDU0}!{ z;l5GBXP)tCVM;FWSd;AgWq#jnQ;oWNRMPD5#=@O{L$jV0JKLf-yyxpZYRELTP^T>O zkeWi2!S2A{KTK1ZCDyX~48 zDRj%fOu^g(Wi9_oYCIfjr(4msVXIIj}T`t2E= z0bb{SDc&xl-=XEG{TO{&+S`$XlI>DDqm%1r&BP!+7|Qo8^?5Y%(eJ&F+bp!%AZKQ3 zC#c~l-q;82fPN0sd#U=$$BTL=fgH{|HzLaMMI~8TsL#X9UO~e1d-m9!9}4b&&{zy3 z6b0K=<}cO5tVbAjEY4jM*Fj5Q`oHW`_k7%c_n&bfngtQFDGlMu7Nb1AZOAOmz?fK& z)Gd`6x~EwEPDY|a6~GSrT#0Wy;;$V1Z58t$w)xG1fFiEw@D z?W6cdZj(=*S$M4q3mytlf->SrWh@-kAa#qCjrl}Ib=hQ@NvQrR|M+WemG*Epn2kPv z?KYPlvcP95>PkCu6Glq@M_IG?5wS}!+QiY(io6XE84l3w&$+v9P-F_!SZKoTwM367 zQMsNK*y*rkzFl^BU1f4X5xKz|VkGJPQW*D`!pp81eCpx_h-X_Kp4;x-T#q=0e&L`N zqg$5!Sm}~hk%{Gf8(VzCT@|+gUT%zkxE{KW#XIzb?h`DJ_qrdJ|Mm+MqED@}b3&b@ zt#>g+h==(6!|XmiX!IQoM8oAL_hehFp7PfI8cHOVM1rqn9uXcs5j+h>98-0bcnfbI z{Plu5XW=P^CS(^>BuJ~q^6O?{jVeqK%9T5vIgJvYnrGV}+L>Ni%NDma>UkP}=Cb{# zsJKyj{G2r5Z|e>D_Wds=`88M}$xfCH*Td(|rIt(AieJ2@2AuUCh}pI?3@j~+mxr*o zs7sM91;sadny{f8hF4Q*W1gpkh43ryb@nPu_}z8_PS8GETvBf~0~FN^ed=Yc=_(Dh z*i7UnoZzDZgRR}!o2vbP2#r;LF1Gq877~9f&_xhsx{eV%^(Dtwo` znAfD_;K>>f6CQxmY>?n)Y4TSI64JfCa!4x^d>%+N+s3?nuRU1`d3J36vTC0bIX%W$ zkh*fq3ihMXVyp@iVB|LL>vz$KTit@eE;sb90eJT(V2nA%7|y{YsFY1;&b`{xu~9PhVtTboR%c^Sgg z1v%6H&t>Zu(Wdxj4)yPUK&qVY8|P}fWF`Xcv!vLDX<8doz$>`H!cc3&2dAKT8hK1$ z!$&guf@ISo;YBSqfy|hnYTC9D2iCWKm$b21>y4Z1Y)da>D;~=)2A?jgf`&OUN=2%k zc~>(GcU%&MsDC7CkTb?d*39T6!0J5MjZ1l-iT7kg$YfQ zlLs9~V<}_R(^XMI+Ki~e@fep|P-Q3#k-LiW22(8v>W9&pXQ-?oRYC8c`N4_n9-LD0 zB{RXX#R>^Kg1N(gu^1Pq{9!s}!FWjPQ?|4T7+Z~ye|bW|>M;{{bA8eHc^R7)IF;{C zC_6art&_m$wW|AroSnTX6Q+5y5_rqrj0P!_r&g+CEkB3Ij8}Y4wvi~m5PdK{Uv;#B zBlmsJDNmny`Se8h<~ze(o%N{A1g${+g_DKY#HI3T&xA6jTG92)E)wqVQACH%KW(@zzK!xFT9`E!JSw&0l`u2ksL6${!O1AVjCl`KqJ6O%g^o7 z^XO4x*3syHDjc}(-WWdbX>*BufZq%gWVE1ZOO&m4DNow{zT%aLq*uf|pUS9~7E%r} ztBEEEsXjOBh^0yvmhp$IQ|o7H#`EKm-8ao==cpH0{NPxbdm6{+1Rlgz`K+2yRE z`SK&o%TI_w!K7O_5)HXZ6}7R4L4?YV^q3S~!4o5Y94g9C_eyJIQf>S5GQ*AYQ|e*a zGMj0X;$7Dh63x{lJ8*%Mk^~$p3J;u_3o5#ZMykuJmtsf-2W_}s`{rq_ie#kxc&k}mNZmE*Cwg7%YG0N814Iv>e#Bk|6k{Dh$G2$Qyd zh=sCx{clA+X5P5Ty(hP_rh{N-zuDfHw^b8|ZzutpatyX*ud7 z8~m>PxksF@INkye>R-Ra!I0I9;Y%99+=+=p%hJh=W4CLCv;UN3kLtfzOzJ8f;>3L> z`GPx3Fdw`%D584jHsGsB9z6ef^O5d<#9SX3)H6R&JLJ9rYpyt|D_;|=waH=*NNJHW_Qyd z1&)R!?-jfc?eL4x7HQA}{!HWCJ(dV@2rN?COL8O(+*GvZs-F}M8e#UQR$`4Q?MmYv zo*&5rqBN_bUn=-eS&=kD6vzug;gklUlEDu0Ri7kXc@-D%Tld*U z3?;g%{xBqg(oep^RzfW`O@iwZdT68&VvAm&X~8ghEZaUv5)LTz z2#*SkY#QIqB{U17&IHU5eL&rIUPd`~h;&|KzzQmG9zAVD4 z@;PF*kn2*_pTU?&NoWy``lhlKoUAV*9k)F>lHH`F3uI7jRcCvAR1iJWBAkla@#B0( z)_qFc%NVHNO$1qVm96f4HDg&LMP*x(XNc^lh-MsEBAahjiNQM!N&ZjN43t zxRLUflZof$n~JN(CTK1OzoK$tBXEp6dIm|R3g26&l=CH=8=V4R3UV({VaR}jz0-v} zCHivH7<+TB{e+k{n|L&>SuTs;I3W>CH4Ax#Oce{(x3Koqf*S*W3nb@v(CX$wC55r3 zZBZD*)wM!cd;SRjG>#zWPx}Ff)ta?8tYi#p-=3qTPQ;^IzKD;B_|b{JO+fa-LAG=4 z1u=AYVf~mOyRQq0xVQIVj~@SYxJtK#OF6YVd3JV?)d8jhN*~ft|BGx;OT;5CDrqF4 z&JH81^Q@?n0BM_l8Pw!8x-Owrsl+FAP8;bI^|fqU1*&lZoHy6Eq9a~awN~qF8RL7M zG1yqeT5-56F||-c?COEwNF64>l5$b<_F{i!lU?bF@xGVZ+x)NBp~J1)F0MZg?ypay z@+~V#5CQsapQs(d?a0^*Lv-w)-3h+>L(#%KI=QgtOug=Zck3qOrlH@HT{hN>-cayJ zr_x91sqkEiI$8dts0V*$~x1Fkj5KTwI!V z)rU&=n<#L9O`Ct1$aZsLw=c54_3}~XC8?(IuLe!#yx5}JA?zf~x)R5r2goY@q^{-Y zRnz`PA6s&fLpX zQc*a)liw!B3!&pOdCT4?r}Bc_Ux>Z$s)uBS^K)c>C1&}GVkcf-()n1||-Y!Z~7n5a$@zkc{C((@EF!XeKDXs62 zxzAC5Tt?&-7f0uz&uL_Kom!Q@MwAz|mO{3!hdgLpbK~&TM)GndUni9B*`;iQKlCzv z<&9@Kf_|jg=yc4(m2l?!jq{6M>)rBuNzX7!2kP))1r^&J^@$%Kxtu2HFOcLDV-k|H zuTXjca;U!yB6}H~CrUAlCr(If^Pg~IX{5k^_=td&r6d&tS{A0jl-671c9iomO%Uxt z?H?|dnYa#w9{0%m|*0aislalF`V2>^(H zy>&Eko?6K-FCLZ>&ns&F+&uIjM@aO+@rV`h8K%tS+;_~sj~kuY*6_L>k|xAW@?Ngl z%6WV#%6qw-WK?E^;2Iwa-vudZX~VdMe{p{~QBP*I@!W^f`xH@LkB|NEMuPvHCVHO2 zE}&XcpSR!#7Wmco%Pq%AK!xzxkQ0A@ENGij^CaO5fK{L!uZWT;7Cex?VeT^<8k(^WrS?VyfsjH>8h|@J-Ao&LU~0m6_&Ja*A!>AvwXwu| z_E|@#Z1^MTYb7x{&W5zHC-JuvZWN3+0>09)@y1UYYIBd_CmsC#IF?k`mCnq6SA`zb zTGjBy#;0bg(jp0Y0fa$w3sz>cZBlb z9>MEgFga?!S}x=_^b%DaBjIW@2@nH!WJ#V#)vxrRHRR7Rt@};Zov@`3{uf`DK0Zrbp}!5tkA4V=Cu1ZfzZr z#D1GX;J0tD-?ShFX}hW%KS8`VZDzA79e%jE9#9Y|l2-MhO{(1%6`E^NgXNdMIN47I z9Q_K}pf`wbX*iR>f)l!!owRW%G`Steyns0gu+U#!&~Q_w$=49&AEdc|EhFxCqNv|B zspZ@NCbAgk1$jE(v}(3Wqxg;nV|moBr`!l2C0M5=+5WQXxo^iRJ3S7qDouitLe1;R z`5+9GXq4;HG3uGs9>V(`Ags#luT94L*}$upKXt2P^qRw3;peml=2#1BVP5I- zaCgxNue)W$0$^A_&=4?xE5S5kcV{sZ@VjFb5f`Y==!(d0L`w`V zM{kd-tX~4fZeaDDod=y+iMbAps{RGkFB}0)XpjdSXNZZ}|6vM2tm3Re9oO0Dp+O?P z-Hv@}r`WVsy?pQ|&><6bfTNFdw3(suy8Ppr)YL=_lL%7r_9sbygw_^1eP<7I=#0I$MXND8F?Qq4n?;a;&RPSQ7dX^J@6dY+O2VFo>YI z7NgC0aYbei2JpLo=nJ4UN2+9pXa@0^s5i(GOdI~z-3K^CLmRle-kJ01U^k%=3Wsu~$ajd%`OE0+d*PdrcD}WNkB0B0P%+${mO=Ot^FoGP;=5_nZeE>(GqLQ_Lb4weOa$VM$p?uxk3|GR0Nx>`8d; zsUd2JGS1}W2nAPFuXP=Nbknt|KW8OWa?E1fM2OaZhl%8neW22gHfwQ+Y9`VIP^VKq zvPwfbI5v1JQ#`#9`%O+n`O03Yjx30!esO`ArCW&?d%vcK(8DI&yE}ZJck%F4l-G?} z((ePLl}1n{A`Q`(QGv#PQt{MZ>Uvh`(}M{8)g|aBY9Z(`;1KU$Wv!{V7T~d%e=GPSnK+p^uzrX zb{BK#w%SdwH1x=n(^>%p+GMol%#)BmH@!~cw@$TH@DkX7Td)NLOA`3HECl=Av)}Yv zUY{nRYZg;B=OQtNYpYCht_n@Y72X&e-Qo9tELNLJI!QOLl5U-M|4xkC(ZxsiS?D(D zFD9bjeUmU@n}8YYANZ;A=;qo}p%vYiw@DmT>5r!^=_~Wr3oBK+u$1A=O|nATFu>K@;JRI3p_!oHCg0; zthB%83xfz!k}|(N{k{0*7)WdtLqm1l|9fNxs=zD4Mtq{A| z&#{~O;FofWfOFz#28`;=`gIo&+AKB_%#!d~xJS#-R_?0LdK+=P>{p94*MPEcsL^8< z1cKZc;pl{I2fu^(aIj0x%0`os-z{jF5aqDldW2xg)L)>L zvLx`Y1a%2~m;1&eh_0}KA_nLEf%vJ*V5M>y22y8Om^#F z)MiBKYJ?QMwq^#@RAib#HEhmfU5R*+Y%^xEBRwOOQ3opZs5_LBl_MUmUuOt^Ey~3Z zaAR}jp|$g6se4g3yw1=#Kt@lcx$;;Fq?}8Dm_Ass@2W{c`-a67pIolnY52=N?agGnEKH`*qoV$*+{mOoC`^f>X`rJ$q;~B_SpVi#Zm` zzmsYRH}Pk%WZZiBeq(x4-`~Z4>rgRh5A?Mi6qRVN{JDnm@~4oh%|$i|EG0dK(s$Bh zW})b=%-w_O8OL6qwME+ptF0#qP@z3EUD|lXY&hepOr)nazM|Jk{)jJsG?UF+9xciu z=&fFDEQr5W3LyP-yol7~oN6?HG6#pH6$*^oc^ABNRnB5WO-%I3zmN_-lc-ah(OjX+ z9Hq21G;)C|rjopS=%j0PJo35NML2v-mDpl-q_>M5DII%eOB~+tkU;;aTDBwp(;ERg zM>T3_I)&-W>>Z*8qHgBzRK*fD9>8`uI=GZlQ^Yc|Dq*l|A{KaES1=1hsh-?u03eO?Lzli z(;qn1w|#ae3owDyo&e{vVc``e4{?altwg@6Xcr)&Mv@Bxa6lb@h&=G4e5J*t=V!}t z#sR9lo5OylbR3%KT0T2^=ihfH4q__MOp_~b*KMVcDD}g>vyOw$Sz&!JM`g;xfE#D= z)D4a3B`%7O8bBTV9@bplN>7^Eu*r17S+d}6yYZWz0fOIXIE+@LFD3E{j>UiAg=>t8 zE}G45Q7~VmD_`<|<8*QpeKIvi0Pc@ITS@;!Zd2f-32e$fgm$$j(+WL`poL({^N?fCQEG!?_lDUo7A>fPdlHjbWAoBNDwOf)yGqMJM^*_X5NWE_Q?4?1m2mA~0 z;c_D(#Ws~m({I+!nJUk^(Ma=tP}LrKWW2MS)RR+D&v34a=X5hnPfvM9HXfefZ9Qxv zPN5huxFdyUKsN}0EIuPRUL~iQq@>D6aQ=M1E>u5@Ypr%#|DFJcJ2<(N=QzgCmp833 z?XHJq6~3N-$_q)4Ph=H3VKrhP7tGl^B$1UKuMi}bH=dgY=9ol}Ar77rWz%IA&HmW` zex<&-Iu$%`T4qwQx~@sxwcO6znhDn%x$~^~bfx+`BN^^mAX!e1?-wp0ovPSB=R&Ek z=#<&iD6gzwk1^AQgO&5_O34c=p)1W}2A?^#%ks>BEWzIpS>b7q{7ui!r(Qu!{(76* zFnmY9*>AlO>+Ki0@<*cB^NK||({gJ4!lK{T%=a2AYDpECozw`f?2w-pFdWP5_?L*3 z%b}C#WvbC5W^is48^`sPUC=IcF`~&Eh~~w@r+o=BY-K{8CGUi&;quCuO(HKgsnz8Y z5pnZ>dc|~JS*GQ1SMDKU@NmR?;bt7n+BliP; zBcAhz)`%C>S#^DxAKi$F?TF?_I9^=B8Cse_5ojb+44L_2R6UrlCwCIGKhw~%(ZYZb zfPDL+!u5nWKZ(X+1_ON*A1G^l^tB(&JuXJjz3!~ga^Ln|onqBOw#dk;Y0MslHOW+& zjauK$?D}&w<@Ys&@U{~i7H;+P8S)C>=lEr0?bb zF5yBNbh9c#a9z~%WwQm~Mn3bFG@Mz6n}c|oLFWjoV}l;o;XP$4VhG_uLx!ge6m}Hh zslpYq&Vt;PntNicv^Y9T-=f1!%yX3_@Te#Js-nn6@d~m2utoBkCWqg~@L()|GGp{b zhoai1+Vi5mrI%xv$ElJ0Tm{*0gi?|TV<*FBRnEyG)TQ*uZ`C-(css%IB39|WR!5Iga^X>~L&ExI&Knl9qb9*q}x=nUXwOe ze<>c;G)I!=?%4RxH6vJ(T)lnv_>0jxBN0e?_B_LT(3E}iX1F%G)!(sJiOmg;iTyTH zIP;!JO%w*FZY}El3#tn1O!w$}N(!^TV^n;)p?#(0JrX|hoeg-(_>||5yJaJXC%yRS z8c($-AnS&|Py zjua$<;x+?h3VRJ>+^sdEo?vu3Tj`4%jdfa3J2a+q<#{1vO;$X*?cBHMvNw4ZSuZP# z2QlRCh-yIh5n{Ze(P%s-B!N(euV7_g2QDw}<1_quj(0C!=;oz%63BR5SavQu`TaB1 zZUxj(73M9_xI-Q;7~)>^84^7lqd2Q6A4lB zb#qxR=2eS-t<+~oQO^OAe{p|?ZI>c&P1|;bL<)6)Bxoosc|KV9+pN|#9XzT6?rY+*K&)r&w*rR#j8&jsPkm@0p}yEb)hCPAhR5&> zJOuquEG-g3C#Wxv^t!X^@ae=G_uaXTIJ2qzHleS7RZZjRUoAty??Oe#Oy8Fq!KxQY zvitR2K9?1i#`25N3NW`0I&l&_WCR~NLY{T$SA1pzT#bL{3wSE*Kd%dcRqSbfE`i`? zxi6y18=1HSF)k|H6`2gJ+3&TXEW=l>VREPTk#$utxhP{*v&$EHd@Sh5qYnohdz7ZH z5f7Mu2qCe1H!Ty!51Tp9%dp^^@?bx83lp}@>Sgh_2kvh~_7Jj)08pV38?esohU(d8Znq#&d(7*ary<;pLt^FajbAL2WJneVOfb>8;}^S$!f8qLN~AQ8d^oG@2wd@( zFiHPfRqK7`!U6#R-mB1oL}oarL+53g2!li)dZB>EkrQ!^C+Vy`b{lw`3~X7f$y8T= zD%kmUkA@4oP2bp#n)b^a!QpBGx{;hgWgQT*^t**A-09zCE_cn3*pXmKuw z>}>S-=+Ua-tO3^;X?6pi8ibKcp^y1<4JM8fG^lWvyqdHIE9tV+dqhP{{q7Ib z><8@Qrj&pA^Os7f1~aKj1l!)iLHh2Brd~#sd6U?9nr|Czof^#HxA#Tev`Dh^^K9`cG62&2ZBww%40w|TR9Ap zMNfr*#tE1;nu^ywO`MZY^82}d9opZ}D`9yG>ulQ(Y6lFv$O47qw)fzo_|K^n zp+n5~iS{&XL%eVtDqlanFX!8TB_a-s?JF`)>Y2XBTxGl=1Uc9;-Nct3VX z5~sjOhv>dep9aVI4OH9KN&#N{d-p+01@i5l50K4EX&s$A)L4^RoK1{>Q@Bjke238s zw~^YgrVr;UEXcLG&TX1B3Tf8U-5hx)zS(!AWgU7y(a5~uCY3$iu zR+m|cD;pmjEya*{rqA+nMTekdsx-ptP4s=Zg`?qJYFuy}TWwOR2l4?EGIp018&Zxu zHMtqE*UB?%TTpZL&c}Zj3BmJuOqMYPcgZ0Zj|UrFV7X$# zuq_GT1#pw2!r(rTXU(BQ^8ngK2I`jl^RqgOYc<+;RB_)k6pC75JcfB?#Gbl7MigjG z;ZDTTm4MZ?p|oIs@#wbi)M)LpL;Lv|6`8YT<-vwtWlZkPmS2!j9Vl@jjEFk*TSzs1 zA^ywA-7X+r98K}vs474!a2HH0cb_s5#K<@!$c3EOM+Qthr$I`P&DCI+X0cxfkG0w8 zf>75#ymuk`L3k5tZExlLAlIaC$#ms>iSn+lwTguLvH3)QKmMCxaMdTZRz38HH4!Gn z724S~X1V+#5(K88I9g(`v~G=8*-d7F12uKEp!!9~N{}AO&S;x(wJ7&Gu!S7y+YX!0 zZ&qYsokD56UCJ=LWY|5J$NbnegTC}a#2*uvjWC2BWtGhi<{l@wwcb<#O>kuRShRF| z--$L&-or_M9NWTX7}pvX^uXXh_t$T0Q>zZEIi?DZ8eDV`OE%E81T@m3?kytn)`aA` zh!XPg@DziycegSOXh~i9Q||{t+F#X&R;kOJ^O(4nY0sw&la0!`7qk-*=I5vncT?7O zUslduyAMFRNdtW3i-jJ^Lv^32kQ7IW*P2P&vDmVI*h`ELysmW@#DW-o#eTb!Dd;07 z?Dql^s9VKYu)(+nz(vp%$^m7Pq z(Rw|9V37)A2Hv9{3am#T38yoZ#^Hajo?MqWnI|pNM)|q3Y`=EoixhW}u11f4nOLCI zF2`fso1Io}DU-;FVfQ?$()TP{esR_+4Gm+6ccONY8xpimzhtanfqW1V=Xmm6|6AJc zBKvF{L5?_tr+Tv#ar@0wmc>ZKPTaM&8svR{p`Y=SGq;MS3b@Tb`sF4hWpNYJ*m<$Q zUDQrOs9iAjEJ1|yLpjc^(t{4sN^cmc%P{8;uytG1>Y{!zg^a?k2Z9-<@Sm5_c*M5OHP;h=h}bAc2h$Pt@= zwci^r7|aU^t7e_O$~Wdl{F$0CtE0{AtjnF`hEL5*V)DKOG_L8E;vIphfFXWhnw*j$ zoN+8*j3l3zzl9#WE4pr~UdApue)30|+2#jO<;$Qb4!x}_cEpt~<1Aih;)tg(5=<)R zZ?ixXSdFP=xS2uZ8c>GEYAC-n4uv?wiZ|$p!L-R-_d(yj?7}=G2x7Tp4%TM7-Bl5XwjRxYK)sFz z6!k;}Gs~K3GwUc$eEWD?%2IlA(?7{;B>dqhJ}vsHEHXiubfa^JMK3aC5F1 z1c`{$99cyXc;8k?BGb9;bxke1`-ls^Va?dBA2X|h((7wW5PS)bM>?wTwC95E8_ROR@j2WTht;opJcD^CgzN0 zdzaYwn+-J-(A8<|-5;l{%}9GJt~{<)9JBxdflc*Vy!b{O72BrVw9IB>P;WKNPnTl4 zKPY!m+vFq_8b2e-I1&f~YN%DS>-@`4$#tx7>-`P5(-lH^*+oZa#ee+@Lp0D{i9Jm&jcYbsbZroGd| zz5^Y<+^^jS5=)fg|1Ud#62$FOSrw0k5Em7rf6fKx#6N&-CH=XE>E757^J5q@dn~x@ zEZtctDm<&}PT+eMpcz2sQxOx zc0%lHk1EQa=?Hg+xo1XPdYDw?L*E--jLozm8qq-IB81$<4_`=s*C||8V5G&?IfZI_ zHDO+#Ocq@~%Dwaj_E+3|h@GeY9VR2K7+hf>LC=slI&k$yeNu#D=tvVYmepxq3ndw| z(I}P+!&(R%%E;xG)kPOfm(u-dny-y}F*e}cJlLGHen~1AH%qYS1l2W5aH4q!)jgY1 zH27J;CUj(iUGY<*XvbU>LJZC}SGV zXN4QZl^89%+Rbd25vqMMLM#jmi);2u}}27)h$-7<7G?=Tqb!^Szh zZyHDtRACF0s7tv?K^K7Zf)BkZ=5e6se468nB|lq#IXI~-Zy471L{O!l+t@?ABiHT@ zSK1>S5PT@=I%P2|4um$WT(aYf3W}7;c>dPg)ebBzlZHU~dv0dXqQMIB3h=A!-Iqw< z4n`0DEqqgffnai6+VE4CB_?;0GX?#NePSXYSsp~(#1oUn;=FG!Qgva=x{T% zC}PQ3G9J7htj*ZM^j0hcSHZvgxm~741gVIBTB8AxCnT9Nc~@x^9{}sW*CP4`q~hwZ zngs85GiI1XvVBA4zR=SIQb2(s%H`qf(1H5H>%7w3M+d#Sd-fd(-*ir=9CU=F6A7@@ zO1W)**tO2}ww!=kwIhBs&=5E_CTmWPi|FZc zvvKjLv4Y;Q9S*VdbaE^#0%7Z|N3#XnARlJB3d(quAaKATg%FZ+xHPl%d<|j|*d|>C0be5jfF#$g>VEFjqyUDBw3!y&hW$B-jiIYS&&gBXw_?*wkI=pIo-#}`>$yMw$- z#c$dEM=vq3lG`F3T%YL655at{(+#v7nO@}cp|3>~RgXrzmJh%n%+!NkWBzaco{)!x zGe4UTt0$e}>)SC(;tKHyEy)%#K@pJqT%lsBwWeq2W|xuAHPzlfdmnp$YwUVupmMP{ zjJFH`tWvQQW$#HD^QsqgRYE;15nKU_Q@+DK6E@M2uq~U6vbVK?n+rAXSf0U90*`-uGqiZJ3;DD^ZN~qe`6aMJy zb+ZtZl=wDa!pZBxf$s5tLlw^tPnRI#gA$AyIu6(EHU(VD0hddJD(b6XvKy69n*w}u zrc|jysE@$uVzs&VryB)@yZlbAZEhRF*REHav>`m2bRYf_Hip_R0W76d5qA;UbD!)h z_X0cqZm%Ne_P3G8wXXe^D#Zw6=(?)-Br~{U8lYQ%7pfxU<_4mFD%iS59hMf?sY+67 znK*Y$pZSdT0I2!zfxpNq32sv#Gbxu?YEKe+2I+Q@s{y-ng?HTqz16`$*;e?d1w^00 z4JSbykgfib)|ch6f;>F4%^zw$29dcUKEZ<39kz=8DuJ&%&KI*mDK*QWq>V8@nJ@aQ zFb80w?)<=K^gS|vs{>MLQJ7I{q#wQ7no|x@yQO&POc!JBr-*}`xfirs+Xp|E>SRl& zZ^ag0-=63(J9I2ZMVqmYqaUe(%Ze07EiNopwQH)J9~C4O_b}B0*WJCMqjav7VOPSJ zsZY!$+J^+M7-sJq{Mhq%*yIPnasUhnxO6SB0>yokae~l)j15*I&F-oU%y*8qJTo%p zYG;S4^$T465G)H&`1$~A&089_K~UZYA%n^KQDSa&zUOP!C_yW%#!Npf|0f3v zIHuZXXwU~Kf~!QUteS);&yZo%N(hEiqu_{msVz1^tV5z@((!UF6mR=V#Tx+&#G^b2(~#9h>90`Z8%~KCA#j zvC+{K`T$2`t0A4a^SyyfXz{_5BMPWc##@vl9^&dunr@+9cedj?*4i5n14iKYhdZP5 z^MJRd61RXKmmaF}0?){I;Ag+=J^OkSvN zv1KbaVF-EbDlHgj+A;6i&)r+%-vekt34cV5eAq*~1 zBAhF;pj79qmPaB%atsuI+tg9zeX`Qv7iEJ`T}=6+(c-8Ib9c;!QXLr|=uYMEj6`DSo^7*5y^?Puz&H7pO@%8O6M zeMJkVWEr98ZQU*>(1_7R(e@CnnFj-uo<_LdjkV6N;prSJ&@4E`NWtLE5UxJeUhg@a zp`g}btUQFyZUiEal{h{pMrC$?pF}=5xVMRJ&PTOOTt@Z~T7!3Pba|1tn6aL-PP0Rp z%b{#kNb@~mMa{oTwF+0=cj5D9O?+q@7Tycts8kayTmMnAv5sS_VCEYRR+=$Itfc-H z59fF)TOyHu3Rq~D8>*l?r0d@XA*o0MM0LAH&!1>3+5N9cByJIu>mU+;E3i%e`Rf5S z13Y=R;BCIo8La)N{P_u1k00h&oiDn67*MJ*5Zo&Ylkk_M&eXzRT*>c2B;nE-B$~iB zQJPek0?){_JH3ABvY-=BMs%red-JlvlV1A?>j6FB*6?dv@VnmPL8-72h^fFkrBgSr zyIzxP!>oN21Kj0)F%2w#xB~3VM5W$8Ah5P>KinMD9;=u?2%yMdh08$xej?adTyyPn zQMcblD<6J+uG z2FEMT9J*gA<`%SUPNn6;!)NCnF6zzq7p5Wm8L0l^?CvJe1)o!YzoL|z^3@QD|4S-m zx##PT;fUpK>!#8H1iMy3JO*`80O(e|sL&#qVYB0)zz;=**W?|-c@UeC$8!PG5R;d8 zH?M@VlpU3S@H$SKT^4gOeJE?f`rTCC&+V$jl9UP#4H@Z+s>qje`~GD~Q)tZ{eU3w` z0YkUEI!BS?SsA2P_LMX1tZQg@xP*A4(EVUpvkJtD#H0{mEAr9OY|L|j!`Wck zDJGhKV>ARI(ahfJpE?5*vVDrAu;2ilc3+1PY(EYqLb);?O#C`Agc9z8DP02Yaooo% zr}_WkzV)7-2g+YOb&dRYv}2yiHQ&KBL)Q9?uZq}+wS#lPMr9_8HiL|4slc%@ot?r$-G|XzdmL;QZvx)6@h$)2vOg+P({5=;g`@cV{)_g{mII zUZ*)r1sl#B*5(>p9x&6vy3;U!BPi6OiVliIzl zo+Pc5e`QsGCPwbyy=M4Cn}!8W$w_{H3og#c%P^}Id4ZT*gme5e}``f}M_u`eb zuXA9=)6ZGtdBg?vQx0z)Q%$5IT*VCEW{Duas@leu&gAgy>ZsW)n-Z#`5iMYn(u^^< z9=%6p;UYO9)14zmm|=b&l%4|#e|d0ubw6k=)#pZaoY!@fvps>~2?Q!_ZRF@?NY+cC zKxad54<{D^EvTy&^>frlAfn0(mZ|;TmfxirejhVk(GP}R1*p4!wLqO;mZyn!>jIms zL!Dej@HozZF%e&PsSY$Q;DCw8I;fi5zdu4w$26WHPSDt`%b>0c1SPMg-^rH&_5l+D zG&z@{xC9lKKn?{B1Tr`@Fqcsd1r-D{HaRtukyR*vcVm2=Z?|U5#`aFr*iM?pwv9#r zS3s!0JKV8tn~lxJY|^N)ZQHh!N&oMhbLRKX%$J$->3QyjYvEe=+WR3VRZylEG`2AW zirH8@(lawKeFeywTNyezDA`!a*>KCyD*;WN03UL81afj=d!T`%xsA1mfg|uMKpkid z5CIwiSXcnef85;M2;=}^8(TMfb5k=%0F|neIyEgV-G52`ng9&l{zLQO>0oYZ4WRgV zaR!2HY^{LSjvo;J&yLDKAi&WK2rw}R0Rh7D3YwB~;s7dfIaPo-&>CoO00JmD8G_7> z05axAKx+peHNeEi9sv5+0bpcfZEXIxGzW$cEI|i=e*wV37HDMt;RbXy0^0sn(E)6M z_EzQ&4j=CTa|eK_y@9pkM-Lor0Or<4ASdI$34F*+Z2n2e*52mB!s>QM4BS3qe}LKAoBxxBlY_an>3?NF2e1d48rU0yfDR5HFdx`|yYpXl0{)lk z4Qy>eZvS}O{A2Z>IhZ>-06``U2+S-WF^wEQVw;*$PHi&G(ljLvvK?ge+i)ae`A^9zmMeq28#b%2>x%O_y3RF zf9L3bxy1j!_xazU#hgGOIRmSY0r=OB0embO18cy?o&m@J{w^Ajf&KsHV_;VU1v^M_tDn2Otrv^rK6)_cM725xO z$K8Ec(GY99tTogXW!coP|76|yC@ziB)jQ{iS7f?vZ#ueZ}&&$T6KIi=p6XbQlifEWqTTg} z8L}_Pwzy8EAkVkbro$&Cbc4H0|D`I3p?>V^TeI8jk?re_6wU6yA8Zh1M>6m%f0xjU zjJh)qZIz;hlXlmiQLh*&^;kX9<9tSD9ZHLXNo{v?L{Ukv=mmyotcBGc?);wGm&`fO z7xT-VEwZ=KkJ=clR@8bh^y>VhV~T`>`#Z{>!T!G9j!Wpy9Rk{{7Xm2-f2uC-1kZC$Bwuc$H!zq}Pg#jg-vz<9nFQtxW29Zq zLV^*aSqkF$=tzcy$5o{CYFg(cj~6(WPHOqSrdXyga7UXX?$t-kiKmbiu&=$LsZj|? z^vtAd1;-gns4;P&rYdTxMevSuven@8lZ)~pM+j8=4*pEs6ex_+YjN}8{Bmo@12Ra*N1R1}DlG8iFIkpmc zh|&Rf=WN(p6wdsrxyeIF!LH$!$kWli)#y@#;J4oyO_@N4Qk5F;wE&(Ltq5FgliG*e za8WCW7{i54ADNfY6)f9wh@vh6nF+1Eg) zKMfv9;5eF-g*vu%skSTQ&M+Cv$+2byhL!_Hl|<^vP~aFUqkL_O4N?T9uG!A6Dwb<^ zG8u})Hb5D2^++CRPuh+OabvPFjb0y#+CrI3kqUMzR4c#WlJ7yTH4bX1ch0T>wwTPf zc?zt8U2oR`MRv~EtXUntTf3TLvu#ESx?ROAoAPy9(8BYbC>9u?GQDrkbmod$^Ho3-fDg*) zW*y1|>0A>u?TYM$Ty2$RF9d7N$Td?7BTuLONzs$i;bOr4e@SoM&BJYTXw3X&MZ;$e zetN<5@O(|OD_~XRm9<*B;Ar&JuWo<({!gZwmN9xc(@V5pdnjosB(8#bI>gwUfljpN zXMjfEJHteHi2^B1= z%$yuNc^50ce_sWjVxC;YkJB57M!~5G{y4B=F)yzidDY6KK|&0MSrF1q;NdSsuufF7 z)3SpSQoI)pI056d+cn001^FC^H-y<3@^NnP#(|Ir%!I<6v_oMX5b>#FC0u~?);7K& zV_p^v9;XTAo~^z(odg)Hx;9qRZ`y^?wEpuUD-HOjf5N}l65#W%kk?h7z_#tAfjt=(k2a^wifz}Ey3 zQ`_!UN9IS>!fOY4bLKWT1c*_RR70-JYPwm3O!G1WM)Zo`jhziK1^J;f(Uj@x`@2(Q zvm$EYR}Go?=RXG|Bps-}LyuR6_$CSTKmgj1yzuV%&H!5Cu6ox!%6s?jaFyAy))uDK ze=xXkH9y0%oCH% zPrDy~4gHDW*~K`0V!<~Siv3eZUjeDmDKm5kOF@xzj3gbz4A59RoQb&TO-axBdSFPN z6wvWdCQ~D3;FN*pKDuaZtGV%dOqlnFfASf;eJ$J8v2452v%KjR=b0IDw>&huIZB|d z3)XHvZ;AA_MQ|3U49*0VTfZ?T&`(_n3v6$wrn+wJHyzC&Ll9-t6*aOIdc=mwbEcym zUtyEaN#7j1Li?Aa`LRICV`i65?UJd@F9fN)y4|!TH?(<~I-GHu1==aR#^>;Mf2)!% z!9+ih>Cs$%I+|al@Q3rgT)m;DF)cV^mgSjRLe{~+mw%V^Fr-^0QzoyrMFoAYU^&Pa@ma~#fqOhHJRp?uwy$N?E0ZCr6X{!!KEM~pYAUPLmfKE9teu{#{70UA+nON zzx)6`S_Y&yJ2b0oJ4LkM@5WfVe}8n;KNOnXp2pgrR1P42tMXA?j-(Cu> zpPOTFw*745=vDqziocJ(P^Qs$hlNTd8q62T03*cIoS^6)6Lni9y^l+Q>M=wd#X8GW_2XkT#U)BOD)e_)RJ5+dHh9{Eo? z?%veAS_o&&ggD#gl471ky-LP1T)Fmx042=BeM_r&@Qgf_R}2=4Qc=R178NOCQDy^B z5oejXIqZbuvyrlkVMax?Dm=AB+@NiajL^6}_U>|IJGv}beO0i~x6iuCXe$VT;tFA9 zJ6m%+4@@S^M0m7Ye?|OQ$g+>-Cg|*KQuuq@|!Hx)JRO02J$V*HH&=2PQgr!0S1Z@bl*I*Po{Z$-b_nx zdCLG7t6ER&(m&rGDL}f3fah%rN<-UY?L7Sy5xz`t{!q zJp;C3rpP+bUGB%8)j=iE!?Ul?vKxld7_uHGrv`EoK}$bXl2irZ=oG~nu>YMR9sI1Oh1DK<@2C8?Wjm(Qie!o_W1gQGLdFrz`6ZjLyFwk2? zT9nr#e<GO@?Ln-rAy*jXzTon$s?hyN)Wr#*^_mH^oHlK z65|nxc60D5c0)MzoKDcb-Z?69(ia>0zES4-I&dIaVwCBxgwV^%@aU*(BuNe(l6u0XK|%oU{K=pVM#v*{KoEMQBsJ+4 zK-n(qH@tCc6 zrDgD%AuM!IZ-5bJO5_C#Zsd?5DyVX#e*qjjwGq<{$zI<}-!xK8>$p6~JSu84+41Em zjGluIUCOy%9P@Ix`>BzCkbd`$Tm+SCrH5B&SnQb-4^7mq@+MBniXX{qHw!aJPDp<} zp$f*il8?y!VzWPfd_MGZ*cbQek5EPaDOFe?p!& zyDrE+vzf6jp`nKg@e`u6RoWG{Vp*vI`^zHn+4Ckpklk}aKKY*OH<@mcN>oDr=>k=g zIN92=I#3SJ?Zl$!%}UC(8@- z2`fE>FY0f$1V%LOaf1~(o_M#pF#Wcw5O5RKmccqBhw3<+F9s&^z4XYld ziDa$#kZ(7|pdu)il&vt#C$#FE`io}#j`SxhTd-eT_nxnA5O^Z71)blJWWmm^G~_#w zLhl!CMdkvZ=|2DL%?!5EiD4OE#-Dn?5w8e-yDX^x5Xi zLg-L&xFUF`S5AMX&Mr1!(E;;beaDAH=XNnNbmgzO|@xYTC(Phvay17P<#O zq*qf4BJ48$tgEo8zb^$MRAZvxtT4!&Zn%`@y zbY49g5~rVHKah=U3PE~>e*hb>-Hots!r2{)Tf-d?WondYU{aT?qYKOHYHJ=cR>+Gl z*OpW?BcV5IZ%7RL)X`8N5*6eZ&W&y5o_Pl1I7bh;RI^sMpksyn;@cTUMsC zxzGH~ECOf5czEL#KgEA$Hx%J8m!@^mbRO%IS%|F#TAwDd=%)N9VQ94C29ymXTNcdw&{Qh2)q!GZ=4dRCga! zH+=`!?Vc)a8qI670E$?(*oeBNDK;Tqi#6ABMKx#MVYx}RRRtO?*YSyRX{oUuwm78l zqr4FJ1Kg-Yn~Rh5e>!SDKN+u^^-Z-aE7EN95%`9YLB8r`6h2X$sj&Ne)K8mJ$1Gd$ zUefgx`ahCu#ZS;7QvHDx8Iq?wxwS^4!b~)dU0JJL@}eqxR1Rh$2~P-4LqD0Of{5j3 zxPMP|h(6*P@^Ge11pQ`3kFc&J^(ehwWS!d~;cuPC7#hJ7f7%k>A$78mLino7Sro0A zO?o@OhcAG*GO1V5zQ*OG^lkkeg@@kTsk)@!qG&K>utI|F)bq=?B63d_Xab|KMOO&b4w-RS(TkYy3lwOIZH9gr(p5`GC1V|XgaE?(H^cRYC<&D)7Hr1HWR=& zx*xRVVe#aRX&*79YBR^i3RyzwdqnS-#0mS|;f$)Gf5#n~^9asYQaMI!7IT+pVOmCF zG&|hE+kRZj&$SN_$n^^wG5O`Kdb9f6DZtpraD6RF5E8gm}p?YBZ!C+M>vH2Q5w9IcC#=dDM9pi8@;XoA`~n1+u}s zc624QRs;JC>YU~GubKw*!RTLRBaEr4G}+nr^arGLT%FIF=!*D$$B$Y}-moFreA$W+ zyuokqQQ}V%(7zWEt>gJD=Pr!aHF9>+V&I1$emI4N|S}GWTEz30r1l4~R476(BRcreY_miE`{~Ldo6(S&Y;OUI>4m zPBUI=i&T6ib}b=%!$C2RSkDXhd%i_%?*-rIg#`rK`SVTUW-NnUU9k}UJCntrLf8CFrULXZAe|~~4EH89)@K+{Kb$Lo;4)2nmj!5^4 zpUzY^s11?E3xc)pW7tvZ0$V{Xwt;w_frY!RN-tP8yAl(?!eC z*{r0Wl>k^O!#rE~csBni0o3@@3F4dmCc8zN5XtTD`i4s-5{9U8@{cF1}@mZ`cXq!-a69+3nz! zfr$IgX={7DC*NM{*J}EPV zG{L}()s=NPm5xPAgM`qAokcz5us8Wke}Fd*tuOIQ?UdI^p9t!_zB#5)P)X}HZK)kX zyL_kq;tfD)aWk!IC}f~3QKn0^StEN{T=QN%UD&M(c@i7D!P!jYe=LaSS$$bdA4hu4 z6m95O52zv8SHE{+$PQGN z0nGv>VtT)heA8R$jyB1w%|UVd38Grv69h&eV(!m)CT41=z=AZCKXL{yB3iJ>H_TS% z@vPS@>r?k0*lp!JI+SHwd+g9^R{&4GgaBJ*l_Q>Up?KQ5f5+amPd(6%*0GZ5U7^L2 zz=)(1#Mu^vTFEOV#CBN#mv+HaA>=^niT}nK<;k zc~VGce^6-4w2*`Fyj2B{!OMOGo1gMYmioGJE|x~OOeWs5K4CV>Y7+Uw>a2z_PnJkz zm%3k2xGx}W1M!XSjhU!d=X*(oo9x0Ej@cEOuU`(?e_qVx^}9;%wR*p0tj5y%G*=ea zl5>Wtv9CQvHXuHo!bje~oez_f+u|`mSIQVr&O|S>oFmo}j%>C9eE3fGAEP5R0o^ zW8>%1e>|tn_RG{C@2EJxU-o6M5|2U8OO;}RKR{rg5+|%W1e$)hwV@wg2|O}2 zbyj6dBlA|;(8?KX<{;J2k*VgjmKxE+-Fh*)&^;Knp+YK<2n$l0J8EwSS$W zCNBb~q%Ht6yq?)uipTI4UD`#=H4{MTGA9#~f1)`CnfrgM?#UuXV-#;!KOFf)K2i*4hekqiBd%{AbjS$=D!!4`b53aP%WhYO7( zqr=uH_1tRL!HgVGibB0NYn6?J4(_l)XA?PL-3e_iqA(9Qp~D&>7}=?9-_gN*@yp#T zf5g&MdT*xh#V@7>cDI~I%PV6TKL06yqg<2AVEBkDm)8i zw?FEgy(YAUTRuZs93YS*y+eXqJBp|2e`Mg_yZ6wumu=CizPK|JL5)_cefI;c$ZtK2 z=q9$g;@doJAzM$@gKxZ5pIyEkNmk=S7e0Ale92NZ_L;X|fQd7i4;;AJ*9GTQ90|_2 z?hC8Q2mV47s<~wr(KI-}D47>7euI4Ae|62qsezDazWn(3e*7q#p)*-$_J@7fA&6+78e63; z3~C*v6k3Z@fVfYUvJTmJ=pFJe9PiZmsz7MR_S*qRR>hShg>qb)6bB2&ia;7q0h_E;`c(tW?^)q5yG3}dk}(7b zTK3`>fea?%z1q&W^kY_9yLyXB$LGh{ZA1Vk|b@7yY( zx1=Loh;;#ib-13p%w&dmRIGVpO*;>k0`=1KDa9f-tx26)ukhw(`Wy08f>h9B#*zky zdbm*SE-%S7;P^6qf09!CbeU7J?>U;0O5b?4OT{Oin#@;gk*!A&n`^kRzkP5DLk`X9 zyk4fKuS?a{CGO_p3gh;6u0>iP7eZFRJ39X)?yFUpK7@N0?IzZQB#NFg+;CP~o%jOz zjKXoiwaI)T>p4LHoaB=vd!IZle@0gHlnUFdUrSG+WlVT+ zeaJW3`4u#z%`GH;T*> z^7gYbZ8pyl@lo4Ueqh@F^1t-W`!e{sHA23|pETW7 z@+fO(!pEinz-{YRFXxl{P5=|Sp(_tzxkk0j5_=q15WXD=`Ob4?+m6_bp+Bd!m*}87 z-gDxywpw&0Pi8!=sv|A--9DC#I#?ItjTRw^vgA)Ye|7p?7l_OPCn~6Wm*1(ez#jiN^&3ki2`diQfLmX`e*~ulXjV18W6NiH9R9jgJT6?j&`k+> zj+UeDTc_iSVhwkw#+@E9Qe8g*BbRX02bbp#b+r|Unk4r>F=6l`jz)A6R_yXS|J^$0 zbQChkqq$gIQON8G$XT&E^c4!}_%%_j+atKM^wlM8vpU~~DZP2Zz)=;#qJ>*5o_m8~ ze-v=!9R_a|RVH_-njpe}pv-P>LSs60Tl8S_T-Zn9P6KEf@sP8TQ@W2$vKy7xhT#ZO zisTZi?yWpOUxcturSmFZfUxqB(dyitPyVx8oMC9ZXGQzx;ESq^qiH(1CJJokC*u0< z85C{Kb{0PRDK&k~la4)A#dsHcU*4pMe^X|Kd|{(j_6emWLf*!G8;ga(FUs5(sfLge zcvlT|R{LMg@tIAQWr6TNLnX|80#Tx4it}mGH!JD7F&^UMQ)LX2S}T*_$Igi7nh*g&ls&=Y zQGEu(XjJpuoeZsH^hIJuYs)vz*NQ;6;C&-;3J+)0qDl3m-!)?qlAlOzzCY{a{t#C# zpJhCj`PrWq8LElQxpCs2+c7;C@-`~U?6W%i${p->Y(c4Abe`K9sc61(= z2ewIdbHG6(q9Lu%rFx+@4zOw2!>{k#T8hD?!3H4P%N^)OGDzuajZT zlT;mGe%m+@MT)7P{DTha5R%@!fpbw0NjS+x;*5BZT9~aKl=bdSha&<5IwvWxTlh9x zTCtb0I4cE{V(p01gH@y8e*?BOkj@>ygV8B^4fNxLOlqd09C5XgQOd*GM+<8b0l7ai z@HeQ1J2~2dDAFNn5J#oRA3ZyBbvs3w*zgJ8kG}99ms`%ngaakU!ju8QxT;5}l(qe@It5i~FtbJ*^#4 ztW1ZY63#T{(M0{;eLuA%H9KHF&pl18i+qlQ0vcxr(l$yJMEWn~RALU>M)ZcW_If-7 zxVTSNzt0YI%CL1Cg*i3rE@4ryAFxl&%e1f@R7eZAYdLREFz(qH`_jq82|AQeQ`2@Y zche}6)zkD(zCfyLe{#=?eDaYWMQx^~_QyRaomcquea3~IycBKK%ZHRv0&&LMGtw6# ze!@vkTv-$e`CA+mkwU1=&UVm2$qK?wF_9TMrOlaMQ(i(!^_XQw<6R!Io3*n_qZ$bl zu};g0;!#9}IT8gqkEwL+!I~{1EaZ2eJks+>_KJy;#hC?jfBXmvCT)a3XIwk*Z3R^; z7kiE3R#LfY+qgfgo#j%Wfs-f}o+m;tev>!DhZ*Jr(je7J2O(-hon#qp_DjJs2kr%4 zUj*)QH6pzU@;s5~rEvBJH6aslf_vQrL^xRXtp!qCv)13eKl@MlQNwVD?V8#0a@E~5 zNkB?+YEImbe@lMj4F;-@$r z7HI|hbrDc7(PW!EF+USOfAvv)SDfz4B%F zNJZDLl7r-&i)xQf-vUgTz4vm3pkT$5?a`MyWd>%gT?ZVTSa#g9k;Zj9@ajD`lVBTE zHAY0a7};SqNj&dSyHzbEI+RbxLL0iOD0P?E`PJi6dJWdWX741Bj<;qb>IkJ=+kP+GUdjZUNFHi4!EFSY1Nb&-~qlSz{-i^?%c=DJ~8 z!kBu-X`dz?OyW>0(TqC;XS9d}MpDhm(sHlwjyP;DB4wO$EPLppd;j2d7V9Y<8$o^dwECKf9G_J z{#tmxX&hquZh5$-%l6Tz^s5XJva6Rk@mm}>xXKsBu6MOygG*{0*M*$GUE;(=$=Eu~ z@?2l-*)&prlYR87Dc@dmp-Pke#GMy-)@rIzDEKV=lj{<1iE)xyF3WoXMvfAqA`!H~ zC-3SBELA67*h_L|vPa8rhNbAafBTpI6F00y?CUKg`65pwwsp}jgkqs)vFvh8D;L}T zJVbLaS1vHj!Z1S0^g7UCYHIkaiRCx`*;|lcvKY<&H`i(4Pe7mS{`@!a3*-wgWx-3U8(P zg?}d=)kK6tgXw%O;(30yWc(_Yrr5Vsm0D|yxPNAD8^P^cLpHl61BYpcGb$P5y}sSJf)I_BMCAg_UU24(`?sW9VB~^(It{>`^JAIyBAL5e@n%pV8mHHLG&HI z@6@+ZZ*Ul4o{tAD_ST}OX{=;Ll3en!Q@;(eDihvN{<6l{e1dcJQcW!ll-6Rinf}XxH&CX=3ngBp_D(nW0QKy!O{X{PxClKnFVjcIB2|Je_`o`v(w< zk-y!+un3oQ#=D2s#H4c{&K-nZSKg5sBE6sEUSKmEJ~^Z@7z?+Vr0KRoE7_dmX5uWV zE*R`jYtk0q&+!Rj=Qx=it@=aT`n8C~Ij9b#Dt7Cih{o7gf6<`R$;UA!x63GlAW$;s ziL!#Ow>;60#9O{ss=CZ3O5-#)eA#CoXL|9PEpBC}cIHdI>JDmt1WEQ1YNz2hyU($GQ(B`X znOG6ED74RqeqV6?ZAvJnUyFJnVW_d(hL>xIB5HORi}v|d=B?K6qg--(||<&siN zQeq>|UR{A@tUp)<^#G=`R+X%>zrg;=ncTm8zyn=Crnm1geGvi3RvTKhTz4RU<&;O+ zW0P>5cwhD)-n_EZozV)6Cz;IDwg6Yw|KSEHx{h+Wf0`c&R**6rDyVJMT1ijREhyqm z*!;~y`5dk~7jY{gqMU&z(mr^Tj6f(|ha9o$P4PDCJ2y(7M7qNtOJ9GI?RA|>Z6e@X zyWhOxmo6#4lmpO@-~I8SxFzCi=p*_?lsW-vZEO8 zpLDX7e+`|*SSJ50EbnI$rIBR4BF8h{IEty%Z1Ag_UCM7QvPH3NNGnsv4P2e*^KLC9 z{g@%_H`D0USL(^iyLAUAALP2#Rh;O^n>>%dOmwMQPYrSLMd>I0H6a4?ZgZ>EYl*lh zhm2L``qlOfeDik~$IZ$5k7fFKq|YT$f5r^JfBAwpUm~if3*cp<15KBN-ARnmhQ@t*nuqkrhYGfMXWz ze~szSCmp*c1t`9~t0tyteBGxB{Ku=jE51eL>M?o%i^f6I}y&7D%zur5~Rc2_!q={Syu;1Lm}E3+i*;(Ul)?~nfbtr-e>!5q z*ulT`Drc0RWl==jTov@wWMS@mcW~|XF+#O2(?yId+qJv1xF;?Vy|AOelH62+l1C!lWW{X%-CS_+hf}!96i3f(ps52(i;+`7Q3xp}r{XTf}X1rF*}I;qw7&WRioD z#D;#btH*xSdb@RSOBTO6*~oDOfA|+Y(6d-2n1x#`+!rtT_`Mn)ft2Y(<@|#|8ATNw z6lUR(Vk#m5B_p|eIU`vnsuSiQ?s&q_9bi>9Ol@5IKKNIOu7GYLI<- z^i{P9MZlHcEnoI9-E?$Y@NG+s->b~jj3kcc)^`vymxt;sa||l<5Vg=Tf0b8Snb)+d z$!U*~ABCd;qa|vFz^d2`Sq_(a$;qeOb$i+zwD3{J8X-yDI-yKC zX4ay57joRmJp8(ncS-M*+j>a<*m?58BXD$1`fzPd(NpI^r7t;Ke^%J{(HO=ToeYbu z=DjU*?V^qwvdy~-liJKLU(@?HZYlJQTPC_Yk@m*v^ZdO}mdkg(6R}A!g!{$JBz-zp zk!#bUzrtA1Qls!vI7JC&cy=S9UWv3n8^d!<`cfW?wmxv_>rA=a;5T5W$x+K}cO|IP z4Aw&Z>5;-3E}n1we=wpmfw>9{NdhY8P0VNKiGD2Cf`R9T8LiXnePR^e6KU&b(_Q(o z{Ki9(5C=(6A3l};XP9Tuo#l7rY2vn)upT7Mf$VAab*FFw5|~`?pirS9ljENVyb;2z z;Z!<=j5vb@!t8qr*xYuJQCbgAQWM3{>=olv)5d#btVBTKe|olc90yz%wuAEsjeZw? z9ZMEq?Bsx4+H+kV*RQ46iZ=Rwe%zptQQLqVNHDFqT?HnM({b!SLi%Cg#78|HDCeL~ zK!@V`(8IEs>iQ)KInSVS(J(Ez>M|-Pwdq%KQ&`T+w%Pf+=ap2yJvwpJ3p31S-6P!_> zr}|JIrmG2deDxcmy2QzKjU1|KOfyt+d7b*v*&2!@e}btWA0&rKPlChJ!fRE-@NNn= z8fjQmb)S{CB7c(E*BjJ=Bh2}Et*+7Ou={?DVURH7sFZqn#3CispNv5KlU}sn4z_wy z|6|d@r`iVjx40Oi#J5VF@m&m_SCmEzodd#6j?c(PzerT9kK zS9hNrXDUbLPSxJ}hY9-opxsLi#G1*AoIvY~i@eG8U<`N!U5FWk~s(AMWWtIuu!`%M> zyLBF+mjU(x6PG|G0uz@ENCgrDGdMMuAxH%l12Qu?laW;@e|lqdrQNb_Y_o$-R&3k0 zopg*9+qRu_$F^kTZQH4&( z#LfsPZfEOE$3)M_4Uo66F>-NIwzHA9J6lmh zXCOB~184#ee+3!?n3(}gTwGjmWB?I6dk;qoGjnGErJAw^6%7sTzbt=k0T_Aw6Zzxm zWMO6tApi5=3beMfw*lHZ|DpIFJE{PI0B3U`z|_JT2oOu_r;SzEJ7y_K^fyNep+<@-J zK>NQST7W&!(Z<5b>CZF3!U`edcG_f;w`KzSAu|G6_P-jC6 zTPJ`sf6(3euUJMvfQf~Zy|tmopV)uM>>VxsPQ%5?!q)6x8PEb8fo6t|Ce}bFr$01* zxc@qxf7J>2FV!2`+gp45?QQq>uK&!z!r2LEZAuTv#QZ0wvGbqUW)`+^41e{Dl&z^9 zfQj)Rb`ux-e`2mc$G;DV@~@tu`jdpAiJh&re+R$>XbQ(5Z|D3cB!KdNrZWBip2+_T z692CV{J$da|DU-3uF-$F#Q(qd`QNF83z(3{;;Lo5jv<3W`H2_(_U&F@Q z&=K(0z_Bp?zg!J%EUZ2LJLiAjtpWT;*8joz@9;lD2-%wbQHYL-jh^ivW(y~A3wNN2 zf1-u6u{prh(E88e{cTsXH32$WTi62si2V2Y{&8Yt{5MS1+``z(_AfQq{s94PP5!-x zKf3*00fUyLh^DkE&3`j(|K63J^UtARiZ#5zGjnmv8Z5~S}_V0Vr)cd2oSk@Fhf62g$ zJbWJ#s=j>GP4W&7n*Bfqy%NNifSZm6Y|0-=Mxucd$6ZTs~6y zlep&lV~{@BBl#Mq)W>0VqBMe_)fSwbl7ByXe4rQ{8yOzzxrXf9!=uTLgC*lJ#P&@( zA^PF$Vc>YzVEh63;>zIy?}q4wf1dX4LK0w0oN6ah=Q;n(>`&QIavLTL(+Fz8KWCL4}IQ8Z&0cd)O+Nb;jx9OxjJ9e=(gujWUK2-S@s(HY)BP5 z*v0p3UTVSDB&ECkV+f7df0(Q4;@_|+O8}h&FR|L$JK6Fy{^B=!>=Thzexr&8Z0v@a zm7samP#D>Ad=qN96r6bT2qi>cgVA<)$+kr>;sr}k+`>_es3Jcs?UpZ?tlMx}UQ=J6 z&pJjemfQqz%m*Ige4XryXM)U?fr=wM%UFO1Kf{R+J} zzQ4!yQ4yMloEst+F4!XF+jzOc;57f`3|f=Q&o?d2s6;YgMSh=0eb)4J5t-bI0B2O2 zv~S_HHBv4`%t;<0f6cy4Rb#D4k2_%#CaxT5LQno87Yu#$W3EnTFc)_j!&lfE0*h-4 z0C2nh`^ZX%8mUEhl?;YQ6`sq!a*Zq&9S4}tTB@-g;Z@^6d*-^(aev}5sHlx#9xT*2 zf`Cbmhk4`Y{ICiTzMdIL?FHw1tSpDiO=#{n6x5l!y^&j$f6n#*4Nhp-<5{MKA+@HL zJDcuPsNzPWR zHJJL&4AGubf1u7r0)FYVLfaBXc7~odRchh}mNCk$VwiQPBqQgsS*xt@=AxNkqQpd7 z8WZfHyAba^5d%Aj)&>)~BiP`#wcmoORu7OKSRhF+d8xV8!AUvFL!7yKu(IGb&R|2@ z_IkN)2Y46^K_-8A%~6I!UGT7Ve=V#Vi)T%Z>=t#2e-#q)*PUwIHq@hSmhvCOY)I=D zNwaDS8F-)EESQyL7^%-wnvkNVOd<{Rr-V}={H~`)_Jso881rXR`uYKqcqg)kJoo^AzLHm@@#6n{Yve<#!!s!GxZL*hx&{@H$R>?U@a)Js5XX6Y!lI)%Jx%Hvn&D3{S(1RYsVN6iRI zIV0Ym``cE7RZr-YrAvumKjvMPUn#>i4X%>EsMD?o8db|BI}t#qx=?MCSlfntgn}6s z8m{ksVq}1cvn6+tyYrpTt+1_)?U|YYD=seme+n-r3lP{Ipzr%=E0kceDRCzni4<{k z%0Hf$7G16S@lKOUr?zD#TzoG-UtF67-yrATvDX!NQprk$2uvbU->MEF@*v=jsT|E7 z&^cpo=@Q5K4_*THOUK`UrYspVXS8HCw4Ko3I<9rJs3MS!D{OZkBd#M}jqJFcPnf9t ze_E1d(*}>RabOtnGI>%J>Pu;QRJkU}o4%^nVC?j))cH)&8(qRpcQ2ZpWDM!hd!#Bk zN(yaq>MGd3yb+!rI1)kpWL-o*nmqd|lP`dpd=K!2!J_~9YON)offvY!58CqeJ^pJ} z5LkS5(Lu>JV!*GKoxCCLb($|^>9e%!e@aoN%3)=iyv!p}xI}n-8gh>l&BCyEpJ|uu z)e2}{I6DM9k$Txv9G-n#%+Ea(b))TzmeSa9a0_>PFEV=sWCG5-Y%{HVUn;pcZMO<- zt(Rt6@Zro=o6eEi`P8sA?55*B3>^%Fkkm4)d<zR|KB2=g^empg~MN`Cn4(c-) zadsc#QDvtpW^tnxrfkMSgA~`UXUXylyaq)nl{{p*4G@?>q!#yUX1GTHOhB{08emN$ zr(;08fuS0g2w;3A8N1+a>f%$@427a)$bWEKrbsTZ-W);(LYKKBeDcDC!7OfQ{H-Bqs z%7DstP2y39%7-4G=OSCQEP+cHLrq8qn~?+d0AK2prsWehpnFzW`df%ClJ$(Ho^1Qm zIEzX9ai82!Ah`|L5$6n|w9c@Pm-yQ-9~yC6@oPdal>Xk34mNp^@OJxeS>_+uRyKTa zGqh-B7>k61y{sY}kSDVDg3D_&EPtSP(k7{-rrqZncd`CrTcCr0Vg)iPZ$>gAs6ru3 zl(!{OJg?6Y+<p$SwOz)oOFi7k zt_84{Z|y|yx&_B?U{SK!z{ZMnPTLMw%>}#`i+m_2WGc>m);dQ;T)zuChVm%;+K=sQEQ2e`0H)>m_wi5l*s#(`(W4s5EYNHO#`Ju^41)qF z`Go^d1e`*-4~6em^eDdIQhyfpPI%bmixqY)O>{;<&7VZ>-6~bL&#sMlAv!33|=~WWt)PVPT*w^s&w51xUI!r z=LU}Ptz6A{gZW}EoqtMN|KyXVgtW@P@&1Jb-3Th+S9R3&CL=9L2oEfpD}>0~Rh2>R z{iRETW*W_WO7WI#(1$?#d3l142Hi+kYv$jr;g`Begir^I1#J1X+GE}YLuxq-ZJ-^Y zO(l@%J|jB;<@QoBZ5OPwp#Z(9>UnXlTEI*iu!m5zWAmFz4{!LCP-2e5~M+sW%~J63ktVzN(Zm;08i zQa|h-NCXU4Qi63B3rbOqi?A&?2B-^3p1aEk)5K?W>gLdGnZbeOK_vR|Q;c~qEfm2p z9-W|HJ3mqH=YMk^KV>i4=PW|;X1l!g0)_d>K(b2YOW`uEc(WikS*#)3y}w%ZRG=X| zDt?p>@hM4{%gSHh3v4gcTNxBp+YFQk@`5kHRntDus^|J7Cy+Wiz;iDclxi@BCFy_3 z(Hk~=r{MkdMjKdEy7U1rSb)CxRWLr{olXE4s%Jucq*J+ z=&cHiyF_cu+B*S0hwS+Bz5MBeoNK=uqgh0YoQS#ZVWr z)D?i++r5OdSEnf`uC1Te#_6>LP(NT$owMVh%$gGba34)XLNl)r8k@$6#a!^TRA4Lu zCy*43h(z}=PgH+JUWMchN>hWViJQ&TJQZTki+|rlU&O2BjS0i~p-QOlE0n)@GDamG zyu;MSEIhJVGkpzSoOS3E*Gc-NJ@?QIUdc;MEqEzx=A6@Yug_kKnZDum5O9JtNjP59 z==6JA_j}3GW}K!tMP=Jk_b8dItKfUy*$|eq^~s=vAnG^}nG9vIqLs}oK>ZA`(2H$y zXn)13^1(g#NR^1fXyXzaeeahBw5$(=y>2?^o>dHa&S%lC2r!ERAZ(E(NlH;w7=_W* z6a-2Q4U{4d?M_!NN?nF5$6_^A!;OaR1&f1ux;XDcJjb*x(FHTg&%5z$cQ64XRZ)rY z@OOWLM|1*6L|gN~VAM3X$l^|@tcVIV~H#;m`rZ(1qb$CT@suAutW7!P|%~T{xpI1*@w?Xrx z6yBuAjtT)bW?s~j@MCUkNY|39nzrnUu|M~Lhc-!#dIe5aS9^jf*e_;fRItJ5rnn{E zKH1{w2*F}KeMJ0OOMCerRw}Mh`hSU|BDOMWD54$TK;PpSk1gGJ2yhY+pLHDb+hKNu zb9F(#r8E0yEq#4v-aPj;{W-_7&V3kWV_E9qrs9%W=WSqolyS)h8^zos`WE6z;cWVg zDYQ=hAk7%Q&s=qAZ1AzIZ~b%lc>OY(hF%;Q#vq!>-@)Ng+Z76N=N4`LMSsaURh4C3 zg+zrYis0tbt|;A@=M-(m0zCB7ja#@OUHJ7vHR+YiYkS1}>HIR1Eo2Nv+aMpbJ`r>= zxC|wLpOqOG9ucLQzAsj-jXBWwrlfW(ZF1p$rQwT;>;&%K(Ys%nilpgvY&~>IE8PLM z1oqUk`AJS|aN=y`5H&c}Y=3`@bF=IOe`}&JO(QGRTy!1o+k@XSJrl_9;(LUhup}42 z_sH~p^7S>G@B%Y1Gie($!>v{MA?agC!rGJ4*p`+;Hd7`{u-;(8t zm&A>vuri~x^MP4kzk9RW7Jnc;*w5OjBL?YjZ5qX)(yr>GP3}`B9e^&q!&pLv-M z$roxSu_i>pUC-agvLE~4HZ^vo@s*=yulCL+jHCL~8=tSb+wLEud6A?H_XPNz*~Frd z_l0BoMS96XJ8f-p%c)MHlG|c4E0I$;y_^UIffRG2LJ2Fue_4+lYUBsrABN=P;y2dWy?gBG;7)i|K>VK~O_ zz&E~y&}L}RHjz;ihz)X1g1@evn(m}T%jQ3MLt^CToGul^>HtO4&-NXNSB8pZgtWwv zx1U7fd5G@V?0?Vk11E9D?waMUFD4c{(=|)S{Tw!a>sVnG=T;OYhEnqGtlR+ga`ShVa^KvOq?B2<&)wereYQ1kj%|M zLoU^`^;zE0M!bGP&bKq{*z5qk(Z}ht)A_^@%&sXnx_QoT8gz}{4b!Sl*<>>{G6F4h6YpcHhK z=a$h`H)p-Y0#v@mZI+u3@b0_9*Wi?Gaz>TgTW8lrhtSO-#u6O8AYrNZ5{qeb;^~nO z*6|GjkN5@>Npy2uN;zD3mQi+v|2< z9{K*9o1!dKvRN_)F10blIe~JoPPWu%Cb6oY&cN;)M|z2lBe9|E1-4#4cGy&5gJQ7K zoNI5JU=H5J&6GW6k}>aO+H?^if2YS?A2AGJEyiJ z+v94izsWUlM~v9bFXZtaz+T|`tW|Q*{P`X2NrD_)#GLk|) zH`9@r`itAZr7B4=xfNVXQ=m8X}@#>MZA&ZJWj}NhZ3#Rhb(qZZaDF}i_4F@Q}s!cC9 zBGas^#m}tH;ah`Lc59O`HEG-5et!U+26bncxo;=zUZy|1<%)HL11_ z*?>)1nAL*1yU-W#;^||!C+@=~VpG<#(hc1=TNmw&K}2}8Nr=}&T6>(f$_z2Z!&|CT z(J<(IzQ9WZ7jkkYvcUp>ENHJ-#xB7P)L0)GH{b!1Trj%UD(_fkpR!HL^?#l5`D|G) zYFPZfI|5w4CuFmvG^G-Cbe0c}!Kg(oO{av2EMZyA^+@WWG12WdUJOP0vbo!@T0Jnp zYux5R`an;FSZ$&i*Q&wd$s2 z!-$M)13|bx6H*Y@T<7QKynhtwQcg1j9gvH)NTf}rBwOoLPfotUxiyXrDoxF%z4HidjILzaE9*(3l9iDRQTWc27^*%{BBtT_x20fpEU3PlD|M|#@|c);Pt?zgcgy$!`*&;Xa{<*F z*>YJ(#eRt;#!kxv6Mxin^G;AS-x|_JWP()g30Vh87zs0(7>a5vv2vABSak93gnV)I z*>7*`t^g;grUY8t;3?g*r9P*soYZz)_^1W0C&@{KkJCU_6^6H%T zeYR~#;OQQp{Y)n(vQ3}-kd@(QNQY1uDli|><5F@@Nyv2AM1FDunNGUFm&MOyHgsf{ zM&PFufUR(YHGi^Go)pHB0=36Vh=Z%&LOI$aD|B(D#-k%=H^VBFG!7Xc2k9Q4Vi%N4 z@s_=%T0&WZ`%unSB@cf57ON->b5r`6yK1t)Vumw~+mfbAkWyopL?@|Hfw?D_h!y}Z{5@DLTFdkIRyHy>)4S(tAt5crA}X>Im9C_^tHl*ZN96QY z?c=scir-k1?bH3a5*jEA{qgZDz z2CJ;0Wq%xlJ+$vOJ$kM00-*v!=sW(soAV(ote`mj;>#$`+P>H1!fqr7yL3~T?aPCh zDW8Jb?SNy28?N)|_ub;{dMAS;z-WWa43!1(>n|EO2e^RqBJ$O&`!N|48JeFV3X=RA zr=Zi;4RuC|bqwPO1|v}O_o>3y%XRp3fLRQQUVr9v7jA7CsiCOK%Bpe|2~Zur>90*_ zzQ82^@A_llm?>J}mE=9r>9AYsKnJO%svDdb+Q2G#5En{?T3X=KYjH#MuyC~)s&f$!Zt&>E^#p)J+0G`+YhIre4k^zh&>MlEt7w1%Q! zYlCn$8go+gC0ER1@|yHIkOB(PPj^)j7vbhes*X+LN`nEi(&m{e5lx22UkwGHEyL{6 z=tM^KV#VY`;^;J5GO0uZWBqK_*=c-mTz`n6(Ac)N=X(*fKiQu0t_c#DGQL$i<;tV} zm@=Z)#yVTsQa<}t)J@Rx@J-^#Wq~h*yk1D4_h!+#zL z&Ie*rQ?WzDUvnV(U zT|k9CgQG57ww<>9P#098$a^uNe5+myTOCIxKQ5NN;cU$KAee;$z z*XWi(Wp3@=CSel@x&3iC##(NWLAJ}GUUiQ5trRZ_-ydTrR|so9!z2XAa^+%F=UYMh z#F}9hWBSF#7~!Wij!DONHxt>u`*ek7h*d7k_sNA2z(Yr*$A60~<^>e@$lm&ey3AUc z#ojyz))y{eM!+!ewymGDB+aeCF0fek%UrHw85D2c@&}|{gP=QHGy@4R=3YWDWPLP@ zD97b=9$qzp@_|N>i8iFaP0R6C5EW1uXWR7WVpC+eig#N`@}E`_gjM;k1lrqG zW1D^FVnjTtUw=`Bg4Vk#ynlg3qG$)1n{4tOLp+z;2Nd~L31g-7TaF?$1X~xp(7U>9lKwqx{M*rf;zkYek=?r9TerYiH1oH;eGK!8hhsd!@6OG;5G&$iiL;RC-vROv+|JQ=I9EX zGT1EX@(FgyIs^eC_ob{|S~<^m%#~|^ZUeGKlj)Pm5h~jZq`^DXJg%mc@L?@YJduhb zY*-t^uYaYy-4+7!6X}?ijk7V*KVhYqXojL@RmoKJ2NLmt3=?M{d6NvXc~U|8k{Tho zTY8qgY2>ixg!juz82&&nFhf~i^K=Q7(uWhoRw5t(>$_jd+3;t>+r*vUPsiP7`HF%2 z9sZwhY*NPU2Ca1+-yS0#?7*~Uq2gcY+V$GHO05E(hEDo z@q-?mOOQ64RFFhLuWJwqOXTbR)r%s7mYDa%hTTbNpT%i1&O`ql3OeCk&|=o#k&Jvh zx-+dEynjsoLdGB!=>nVh}?Xo+QBNL_uT+6-kn}!uN2BukXe#- zoD-z^J{)58SW~Nk(Qh>YVOB~hCde%}89_%0>-x1BU6e+18c}>%*@K&!Q#KJShf6pV z{Dtqhdgb;xO|TR7^Z2+kv`)|j>A|766@Q*OEwj;vC2NzopHdG&RqIuM@dswZVr6T9 z76{Rd3k;G{nGMh$cy0$+BAxOe+aue@%@nj;k^I0kx5hbz82bZa^3Ewk^Z{GM-(=nj~RR=6{pY zigAIo2Oc_^>P|ZC7i@_*01B{CYh@~~M#KLBoS}_7?@n|#Aoe28*-p4hk69_@DvEx2 z?aJBtZQCpl-u#!0Y&KCWB>#e6CsI8``Mk;}OWc`OOStLR*y^c5s{jxndF4SQB}z66 zscIp9fbC1^K5{|{%A$6y7@d34$A4l+!kJ{k%LXP9o7l=J5$$}c&~H~XdOiZIxjIRS zipGXH`+k?U>q;i|6(*dR${ng(64OPZ+j0`b_R;YSG=Vr3Sxo25#}h|4DUwRjQ95*0 zl`eI&&m0KmesJEbeIw}tW8ze}Yj&C_O5<0E@fT=f{GQyKd|w<1mQW@S|< z=f`tDP~ulMsgHQ6r;7UkYE8^eK%$f{hvVP1=(DsBC$At;^^8glM!dHN5V|F{9K+hf zGv#DDSan&51!!7z9e)gk?tjL0cWa8D*5dnmwKSlm%m|jLK+>A=ojNi|l3@!PKYJg7 zw-}X2Ku_w7w<1l%X+==-L>yA0r-hsmhihcH{5OByL2LqBT6sg{yf0)va%CG1yu`-b^} zagwdccEkcMgo8X#F@LBt?4PnVhz=RjEVdgyhC=rX8R-$d(p?RUtU~ixN~ z?u#wY;zke=+6$pDqbRz}sDCpwC z4oQ)CrYoTjM24$NG$zeE1%#kz=$^T|fb7{MA%uNjndUtpxL>h9Xao#^tQuuNm|3Q# zT!(Y<)@9DM^;*)TK*gu-&ih+vCQpZ=Pp0mz;&nvRHfSbWurvhuZUo_g@Y+Dk zYRZuld|GF)U4QQ#haK7%mM9h2bD~Jxw6zW?TilXk)~~-;4>?@%w?>LGyR}AK`c7jR zSiGv>Wt1V)obiPOYZsZ>uRQNszp_=lp_(ap4@xOHS&M~F-thUS!WoVTyeeY zeC!g#W2AWM#%x~TdXQ`ClB<0K2P*Tq#|^7$TAYN5qkj?gt!p6PD2r1Iwd{@pGhgZdFBFSR!7d*4q|Lzfqo#ZP;8^ zd93`j8-F-b@*tkB4uVMbQ*8?v-wSFTqvWfZ@pdupGrX>aCWQn{srdW6KPQgl^r|f_ z?#rq?f0J`ef-#U~vXtu{zfWUJ{+i}2=3V_jpAwo#l5S1gW=@0noa{4$h{FcCtz;Kf zQNSt~M$8-}=Gr;=VQ^UEv~@RSVnQ%H7e0JWt$%NV1OsNs#oXL3UYMS2V)+!TJ4JW~ zt4i<@YSg3ZKS26v??q>GWX5a;PI2oZU>NxHDI>v~Q6Z5okX2$W8gd-@TSqPAq?_*L z%8rr2aS819K=#f(MgY6K5oUFfw0v)81>7@Q3Bwq zCk=v>{O)3&n6NfbHQB-2poz+RotCPs@_$^03@w|&e6J$6$6IzN@_rNrcN36d#^h_!@MP8qQGpUexD zez;?^=`Tmz-F*_#Uo!SD34`eXg{@6o^}jR4x1Tse)^;eNjFZZUx<&_vos82dqk`NaMiVslG~ z{rnp<_V;M)w|=OE4dF-A##9F{oU+1&ojhpiF>61iv^v8}pVpYdS~lg*Ag+@Dt1vkK zmLM@m(1mW1%~i(Ckmn`Zcz+vh*P;FJY=8o2iS=bYCr^yH0bv37)DNjwSR2IYX!JCG z;JeyrtDMd9G?aMzt{7nzpRSQB{!7NMJPiu7qp!)o{fRj5;H^z_-vQ-Q`bcS=32uuZ zI)Y0-vC@amc>`zG$~&hZ>=kZUA+bvfvfmMt_)!aZ*`aGX*1)KkCe-a?pOgC;EvAMnh6{mm zM#pLbqS^!bh^1!y<$vI)6!F`6fWItA5d!YL>Vz#%4MsiEKq^My5fQv{n@@O zPSbpS{t&b^PN+(cRKB|tZ%j^Xi{j_;oEkZ-!3<3$3tmi51KEw5D;3`jiE7IuM16Oh zu;Jj0q|HxDig@O-dd~;h5Sukub!$Tua7!l3P1VSb!hsPnQGXE4d;{V{km=eJ{Nr}F zp#^V^P0v6{T<%)g4)4<6dtutj{4YGxMourCyFqfJe0WL()93TU?u0j0Qou}}pIbi& z`LSz&`QHd6$#DgrE-Jco$syatff&1O$58`{msaD)6-+;oOS7<4@K@F99>z0xrcl!H zKJh+`B9P_!?SFPfJe$T}<*%SmTg}(ve1jLIB^%J{_kc9_Z(oi*!eQK`^Om4jQ)rlg zB#CBtK;Q*!rlLX^G}4i}rZfUSe!_NgydYv&<4}>;$$Z?qE*hh`GoRq$7T@K}wea^y zdn4fsL?LRNdjY2RdlTotJKv(xGe&M5UB~sKD@XEe=6~svhN2nUg`G&y!ti_@CzXW2 z64Vb^Cpw0?2OmWJ9~w0=M~bWSY+2!io^LZ-C)0Rs$2(47wjd=&?d473jk2RnpFstn%r9lSU*Z zf!zEIdLn^~z}7h8^k6I{-*~Sz-Cu^)-9FuKy?@eW$6oSMn3H~Js?;YMKYiw#VQ@L* z)_Y;h;RcvYRWv1E4tlRhL@=zex2SE3hy^$GjIT#%yFluzJ>0Mq(B#=sZx|5cvg$4V zqF{+OL%4qnmHI(}-KUWT?qoERFH?WJ=wr+F!Na*|-7S>SI%Vtap}n~;P`%57HJAzA zy?)w(c&LqK!0GB zLDbcepfcTNN)b+u6VB^LP)8x%$K@e}isWD$LtaBhBtj>Pt+R}PbC1B>D3luo^*Y>$ ztq;zN*qKT{qk#!Hl0n(+iwR~H#_AH{PpeC{7setE9ht5TiT~oxgQ6kcu;~qEg;Fl) zwwd7LzyJj)H!@exIY>ca2SOiQgn#j|nSV~QefRk?frSx(AHVE49Sjrk4bZqUr$uZP zO~~?~-xp{E6GD{vp!=LD;KQVb{L0t-L8~YcPIFZ2jg}wzi)X*GI+>s>+M{jCK;)J?st)ap0dP3Th$SE^mj*i!M44}UTnam?mc zLs@9@bFy*CmZ@W%w)3NH;KuJHCeoGVuJ2L|5v@ zm3@^i3*WuA;p)JpLE)dGUL`B3*)Z@bi8hQdty98i5Pu=tZ?NG+Ohzz)K4NgHAQCn? zxY^1h82-Eyxa;fQ_3|0d`+rda-j+&~aHX5T;DsP$qBtA%ri0Lw`JOBPuu~nBIpxgm zZePZDWHBy#uIu2)eAWd8hvZsmnPE0gA75()57{AKvQqh-J}QPGZiT!SprNbK{ss5X zYeA{7>j*srBuiTX46a?iTd5#&O$2v6yzu%?e2YXv2LZ%n565T~WPc-Uk;iIFm=YS? zA_WpCoJ)>Gpzm6NqFD{7;;P3uyO@tR+?N?WT`eo-q%N5OucVJgiPZ2x5JUq933$bo z9HFRtw!09ov4F1W(6j21Q@8$5FzOfPmGVkgDF+IQJ`it>bNqY${Hq<=x3)<3(QMhL z>?Ow#u)x`^(ppSm$A4il1R6sq7_`CR>7yOC)a<^Fl59v~zHTUCI(%r|VEVNrbRO!B z40b57!Ox6GoZgk;GDtX*={oit9BY-Q3MsZ+Fs@0fuj-ETV`8e%?`d-n#j_fA9`Isa z74yt#9O-+TDxTZ$->l#RoVJzNwvkl zU27Dc8|<($ITDnF{P~4}T*+x9H{*4>4s&zo@Il-JTR61hZlW_^(B{8ZyDm225Dthx zxW(%z4pp0F`MJ3|Up4!PqImcHG3$+Bh}X9L4VP;XQiaQR+eJ>%&si zGB0qd57MpnwJRG&IEqFlli046X|}4cG7WvBzepii?;nITv7Bs4w}W@R6@ZjCgthe@ z1U+QW({plO4CmuEcBYiu`AmQwl)*U8VZV1fn}qzpJ%3{Hjtl|Cy@OFQTVm7;B5v!y z*PrNEBs1hbY)k5KqF(MC5x`-C4Tq|*U95wR_N5!@P<>Jy@t;ZnHEliGU>a<|KR1V? zuomv$BM6VdF(s6cehWy7zhO~3x+axK-BVSIfY!AY>I6vZJz=EO80+)G3PN9p5a0G+ zZ-lHz6o2ncy%{fH&zN@jX&%^>LK5iK#d0eD%&n?xne$c3>t}*b>gjF^%=sc-xxyco z30V|Lkq39oZekYgQXpiC|HT!bA!9+;E+u2uR~+}^7(+X7VU_HvVGJw}ed*ST$a&#V z10hOsO^j`%y$ z2A0HwR2eDOQj@X#vOI^J52?$JHXY^&aCa`g1{c_Ei=n9XfT>HxZgB3KfIEtg*K2rN zCV#2}Wfx|7YcgBD?yT>0`CB~oz zWsb2aD3P#p05hQs%s>B2fZ*jq5}p1&gMZ!Pc|eB=@!q72Q2>rpoN=uh+(<^9EYW;_ zo@`=3$HE#8dvRXhraVH>{lQm5@*~LK_ z%YEU^jkwZor2S;XLxsFM`w?nDWh*>oRJ8WAQp>bo$-pR!)b?irPy__U;!R>bnBELl z+!E8Nz(Wx;bz~Z@{F^{{_;S{=A%EC9Or(h?5oP2ZDNS9r{ut}uF!>d?UM56M15#6; zHD9!GS>aBmT}PoqXqlLn9gsjqIS^ukRDH zE|0q%WEgOB_Vz-%-()SrnY5#x_h2R`aGj{30ks5U zRAuMrQ{I%5vwjDwXr%Rd=zpM~L`y8aRv6!C8fV{Y)nh)QP6>Zp@<=A&2lXUHF@i!# zq=)BO-yp+=vzUHxhH{s4CdBWjK)DVMl@E)+R+}cJmJOMTYo!}ime9E#1bPwisP2_Q zw0J@-FBh7Z?B%Lm1`*v?)Q)0D3fZ=<8v~<$#b32Y<<~0}6qrRx@_I zxV#E9W%u|bP_J05)_cdl>>^FbSD0lsK6UjSi&ywzSbR8Q8OJY0(n9Fq8#+pzg)%Qj zUHQQCcGs3|lw)8ourKBSR2`uOGI8smk&+*D;aeGxiO3ew$_t_w&s06>&a~3W<7#(* z@CW%CC}{g%S2e;+8Jp?TTm^meM4&J?tK=|Vw-oN~2P>jj-z$AT=FqSI zKj6ppbqZx}WS0f00S^K-IhP?B0w)bQISMaKWo~D5Xdp8Z%c7X7YY zF&|qzn6qy{P#{a)Ce79)FH4Q!L6#X?jVw7@(xkusojV*-lx)#~OI0h2}(AyAE(M%;Q!C*WVV1s2U25Rh>mXg|drWM8> zFh;G>FyKyYCFFn=?JRDOl4%cNAu6V$#O+ZtBMe3z!3rP_LVpA;S^_FC8AHTH4|+W{ z4q!~6uNavL;5G`uOvET7#&4wvs3@>$1S*KVF5hCAY+8}L>grDY7jM9i>B^1nTvqxB6x%0K$8*VN+n=g z5gL$6lUd=A%FWUAVxjaur=L0-TOSJr_qbAH6I~%-PaBQ*XVWFSbBFPLL<7Q~ZrdlKV|_xS z0xS6>q<;bDW)&lJ0(t!Td^UPnF4+O&&mZhF{;K@4WKCDEzMhr%VR&2)_dI!+WzY?0_!VXfal@C|QK~9=#3c5CMA%sd;PkPOe8E zV;a2ox*#Jt$5gv*L#w6IT&=Nz4m5CGsj*U_2!C*|{u@ic@XGJf?xsT9s@~9UOQ9R8 z{$}mQ^V;>_tKD!7?S}JAd1DHz?A02(;EU+v)fyw>7Y-B9l^P>N6u^Cbcihy`T6^E9 zqo~g5h@$g1=!oB)PG^vKz-SUDNHm96rO#!^Wrd&S@2Zr!RJqi-G`Y<3LY5b@ypZK( zK7T?cDP&4$&aTQVFJ^f$%ZpiF%<^KE7b|%*S68LXrOKtwrOBnurOTzyWyocgC$l`6 z<;g5hW_dEplUbh3@?@4LvpkvQsVq-rc`D0OS)R)BRFC}bB->4Gu{sW2U3zI0j_DoC`un~eD- zxAdwOwl|~K^AHXUQvBA^I zO6bCwE)YEi2Zh*3)0qh{0CcY4n12Dm!9Kd1ZCasc7H%9#7B*V z3fAX^b+Cz`3R<=6U@)89k~WNhQ-BB)3xa@I#9-pmP9PZFR=BJ&C|h{l0-+t|k=+=S z?h^xo0j5nY5wMWd*C8DGz|x}wgX%w6YIul%QRZN&CCoy~+u@;3=Tw9NVCs_4jl?2F z)8er!PN^HnYn4Mj;b^N2N`Ju0L-~LeZ0rExZh#3yYUyOdgt87Gx=i8*vTK??C|)%n zj45>JNb6MWJ*`u)L(CXWTBo2T9XjHa7X7EUlI&9GCcRZ;m!TuY*0O(XNZ28*vubV7 zylPZOwAAVbn6MNbUBiTQ$SAtPrRmc-vJE89M97wyx@Zv$voxKH-+w+akYlD*FQNsN zm6=M7*~4{V2sfY%2{V*-tqdiQ?scqrY>&R7X_*me>w%sR*=qanvYimyqhDyO^$k7f zNn0T{WmVdRycg0DA*}5mMA{5Nn%{sBv`yZ{MC@M`wELkjh1cq^k-&8@;d-=(rc-a> zAOImfVljcT-Jaok41ZHb%9PB~mWZaz8p}}yFtjCNO-Gn=<_2uS0E}>rP0*%@?V3Ja zpN2_m-;j1i478$YJx+T=Sc1SyJ23Q^M`&XU>zRcm7<#UZr7%5-u*#zwe@htZPGO!l ztuZQIB(i?h5h`8m(<&=hFacIb;gYth$U5P-L3E@MzR!4_Eq}mxSRt&j4jQym6S~q{ z-($?K{n22dLvK(R+PBpv?bL+W#f0k9HFUKrLaQ%KqndVXX;*}HaCH|G`Ucbi2E0&f zb--t0S8D0|j8qhnOh{ppUe;)sL4t*~U3J6a)9ap(SNAYAr_G~ zM{?9KNc55Nc7I@q{f8>;X~WFap$aRmqJxF75hEV31KMT0>J#IQw#`Fem?T2e&S&d8 z9>{J#b#K2pVO@H^Cp6o!9k6r)+C`juSt5rtzsqJc?C^MdT+4SqzIR4l6v@7P1bCX zjQSv)>3>x^Vjg2_Yp2#otx003(NL}@Mr+MwEw?RzUVy9XbiL*zjTh0p)?{0Qb=lT% zgFV;%1>>$UwmE5O99m3ir)W@lAD<^cw406LkwDE}J5&3l!7o zJ?fN&tpA#rYxBG*@?9~AW^(lD)gqD0_OP1awSW5aj)v$Ob=TJ_6Uo=8ZEH#~RySsm zu1hl7bH?MvcTcJ$qd90&)uK^;qiE+VBgl#(9+EOpr{5Z*p!2$2Hl((kL}puP+j?w} zo3pBQmG$JZeZ9FS*F&z?zc=?}h1I`pTaS+LK4cM8S|zrur_ujT>q#f=zowGIvLpL@ypXWe5EJ@a)%ee0;J5LXRB2tbW^*24@eK!^wDbcX~W2 znZOEUS)RVeI%>e*=6j5C5OFe`Q}+D>zkkc`@%#J%|C#UeU(%Z75&w-p=1=%j{)|88 zzw;OTC4a^L&0q63{4IaShkUpgjmOLJ*lgAJ5AnQ1BCe^7ZVboboaMlYitBJ}DOqe#)nOI-Zt%x;i~9=Zo?2 zl+XAK7tZ(@z0R4Sq*?{!3`l23{A{vX@K5~Hs$49`!1ZZ0Tb4(Mld7^96T^JY7kp8E zMxTrE7hVm0$(JYdvgFIZW_-n0Q-3V^7Ngm`%!vJp=s6hsi+|nVBgObD^YQrg!$%MIGaoO9-L3@=_7puqqOWnH)qiU?JdJP7 zMmlZSP*U%3u3*<(&?iDIE?#U7N?&JCj~+hx?b-7@s28)-r?dEYk6usSF)kO_o(69z zT16*XT8^SUu5`K{mxw#YMc*c^mF(oMsPQmIi|4IKF>KuVXzjt%BXW=04nDRl;Zx;Q z$rDqp@k=L7cXxEgpLq1*WD7~z{&`>$TUy1)qcUQUM7<$thJxnXnMi+|U)$I8Q>H6Bhj z_%4U`wU@&_&U2-$tBS`>0NMqbZT?7xF(mc6Mor@dP(dl{u zjCy+lv^94`dBdHNmvQ&BlfByi%C?tPE_TkfDq=5BUn<5gGV8{cH?&|cm~nrej%G*j z8*noI@S#K(^sUT+N`D|HSgy2P3#oD)D;no)d47&9wOg-4SIbc^98VL^QV6K1%ADk( zR)ZwROuW!2tMMid6PwA!le1T$Eyble2Gr3YMXf66)sd}4B}Q*V;B|7`ip5~Q z9cb18?0n|*=hmEAyVN>3wKDEH|E@`_=LbydVJm3n*`S)AnSTs!BS61D@0qO!8*~xY ze{Z-b)8m2N%bX35P9L$RFR1p%^Tm>!2j(>3kB9k0Qd0S5e6&1Sq_1I9+u9z}$Ez2{ zj4ouIS@SkJwT;fW4Ro@FPW6FqXAZlK%xohIs)dYB8ep~$U|o6WHa2%or?Jf%%`pwQ z&1lQ$#>#NpACy{VdZA zD60f7VRn|oUo5aIiVQWGrA7A9Ys z1;)$o7LAn8jCe6LDoJfY_A#_v^Lc};7`z*+6XGIh4x!WX&(=A9qsUl&(w{>0jrm2O zgP}&~6bI!H^*afjCMO3{tJrEiQfbLnV?cz?C6I2Ly5gbqr>f!r8p~C-=PHC~UlI`E z2tJbE!QZ0J7%*5q*H1gWQ6&a*`hB8%h5?s?k-=gZe?}toVXUxhh8pIYzjTy%LnXRc zG`i|9O4&b2S{BC2>oPy%!?qlEQF-~Ea!HQ?KnAsuD}`uyunRa2@}>(;7k9iyRdyhl zCuZ}Tev@PZ(Xtp)!5oTsn9y$HbjxQ75zTnYsCcc)fu{tcl_Nthd>0+g@Uf6UHPPsW z3TXdKmc3*~uOXgp(9{F+2a=OTqs|N~cpDn#6~C%KG5*@5(iJhz;X+WjXmQFZE+Yy* zA%e2QEvjDpINpVPq8ko-uEYzeWY6$X9WH-25h~JvS0Dm@wVBSkf(cZLMYn;S%D)Lu zNhV}2V;d{-dOe}CKxD6D9VZ`L|9Y7JsjSGEysyPz=>(!E33=;A3|H(uEAw zHidkOh)IQ2aD9?D!z*LwHP!2Qw@8Ry;x8!QWLpvACX3Y;yPO)VCLx8+wfj|~a1U-@ zT+YYqi-mHE=G@%=wZ4V(+f$eG_1mR^Lsu7rGk=*$(x&L=%ckG17PcQiceshlG7x=h zC(pskm)wkL8pN8CkLLI)bmk&>IyFuqYIvDq7M{?D z&(E78*8(n{7>>CWy0%f`!fp;N>HuAUXndfAVbJiwLaEj4&!4>$wJ8BUWU8H2#&U##U)pch7C^{S5-HD`E(Rn^|(> zb`Bq7)_kJhY>N*b2z;GHuD5Rzk5E7x`6;Y_SE#tuH5its3GH7`XSM8T+Kgy64kbp1 zq!N;v3kS>*%}dH)@nHKZCndl8V5n`AVv|mJspwhM@{BnN{_KEa3kxaul}4_F#XaHf z!wD~aEMX>h|6|P@y?vzHqR4x{lumV>bSVM+B^r7qBoDLsq&20;DdE;-(47=?$^K;j zLqm>o)Uv%n(7j|(hS*H!pFdiiS^GEq$<^e%c6R1v`)V%cVO#0EV%Hh{!hzXM@~1Xb zod*?7hh>g>TWSpfqw@<@7sZpyO${RT7sch@N*kKF4@WD$?KwDe9BQcf3%svxpWj#Y zpPDrLIlo_Z(Kfl<&@fwn(N_KqTGlYjeK=F`4e3zLapE6cE zMEv#t|4iWp$f93Pu}x;zQ96zvB2`>ijY|cbWYOgi=8FgV)f3V zTLcWX*VG8i)hr68Y4)kxM7r0ZfnPK$)G4@XI!21;&wqc0wqD8sfSM4X!>qz!vRi*& zHQBeUVMJDVW+u1gfE+c+t;J9=QQ2hM(uRmER!^Dm6py{T9J_pd|6abIkIVn@38tzo{oZ`m-z|Gs-x0$E;sgztrxhNEKdG|OLX|xJ{m|t5_~+r_{G#PieG+#?bycBK zs5o1#|EaM@K&K)7vGj+gW7u+Z#QVEs3%NYNh%!R#&-wi}^vdDRv3`k0q@9~l(;rE~ z+*->$l2q6JI}>A|_{CFcGan?@dGEI6U64%G)OW?eG0ded$(Yxd4cV#Ls}33R2Ky^N zs@FJ0y*sJty}M$Qv$PxJ62WVARFYA+1maW`(gzP|rE$^y+{O55WavTQW46W^GV^d2 z*8p7a_J>PU=(Ov$6)(nu1Iy8+iyg08?Q2^)AGwgg`H>X(9o5d4wf$R9X>Trpd!PC? zmS-}97QkqF6qzcst0cz0!^OHC9ijItv6;FzS?8lUg1aMg znddu815B))V))TZ*KtvEn-98&AFB!{T-#Ox3ie3qX5t63;>}~cukZfo2>QFVO1rm+ zf4Oyqrf#07nyWe%&p-F!>&8xCs)zV^*BAKQwJ@r^I(1NPB6A6tU^P~9gYF;RADz}P#sq7y0a8MtMsHa*v9_VEpcK%S#6tmX8z0|U>66=3(UQ=T$n7KBy zU~V??%VDK5Op7!FjDfr#8g28o-f!{n3;Pw?&MWl`$&i<>w-;@RDN-FRNnF*DRFmkoxOXm5fZFb z?~4ruaSG8pRb&7;zX&(@mRzDmqx9NHh>LeE@2}2eFB3~PA`JF7GE&sADE$BSgQLe5 zpqaU$iBd73(HL`5Grae#>44_U0au~zaup(^MUKY>c|IbA^z9?CTShpS+aT>;+d->0`f?O>rE^4=| z@4AaNQn9zkPMyW~D(PiZIW2{{m_^G8hYd}}cOuVMrVQb{1O)}eYjHoB)2OOa`*qy1 zQv0b3H$ouqvSbK&eZ%%CXSU&|D#b>WR4ZVPZo$slX~C12KE3Aw)~9gqGR|V)Zt}I+_PF7Bq-CSS&+)2hj24YKslZZI z1xVMol}eUfqMbS#-)FQ%J~JXeI*|76&~;nSH~3vK&o%h9NTzJMlHua|mVIs*{N3z3 zw@>K-BmY7-;GMwYX(FUTj#TKxa)buM*S{R<(7KCuD}0#B@G%ufn2`k^46YkYC zN}6A4ZYUWT)^JFb9L3c*SM&b+zG92L91)_vlDUQyE)(eJYxW%Ion@yoK9$vIb{D*d|+X%M1(fK`l7D35O!!51KS8gKL`=&7aKi*}b+rtuUCOYf~x9bIip( z8cW+Ow>AwjNr&AK-hD+eQL=ZoN*bbpFKum~g-=~t*(!OCt0k}#mkhHC6l(tNGu9a` z?Y|_EopXsoo17h1v`@!@4!+tvD~Yxzx6MkniswEu*SsNk^a%_uz(nAv83BF1ggxj!}yH!w7q79~H3?2<~H9eUy)j}OF5 z%=JCnnBUbjFtZIG^NQzkvK!+`=<6GA4ZCZh6<;xwUe(=r3w%UP4NPHAJ%s|Fr9Mvv z;-^X!qWchl`1tsQ`S|$+1VNl2zSQnQbh7`AZ5E;z06|Z*!vd9tQcwhkR|(?g?!h1^ z%=h1{girK8tR%)z!+BAd=-aKq37Ep3%PpK96%7zlR3hvc*HrQXvv;`#SJaGYneNZ= za0v^pnzQ27J3lYMfWHc(BZ(s;8e>|C-pfGpZk5mAPf=pl`8+#wY~pJ5T5ih&bEV>+ z#?1Pzzt(4p<@T9h{m{aS?Gd->f5> z_p964E-wkS+A}vEPEIyBdH3otxXy*2Iu(t!W(+HA1MAu9yR&9(zg1j@TkYy*b9die zuOnygXYb<~x$kAnJACV5=28Wxzt-ybi3hnrxam+bTNd|^=`9mz^^R;P>S~YLz~sGy z&pO;7Hh$`nBqy|~XH1$dtar6N!*ZBcf47F9!7?Fxe&fF~gZE^wn9|6t#6uu!3>HSB z#&3#)BmfphH?brrQ>w}=ArN?B0zy!X4OE$=51dkEW`0xrB;qxxy2HF8P5Xj}t*+cp zSPW%iLZ6x##49G1>cLKecjKcJ!ynlJplo&+UNJTlW9sv$h4=(u$U@xR{!NNa@CuK? z1L_^6x?O=_=-x;iLeStBUU6%kEyz?9@J1g48)a$|8Yc^w@;Js#+b%Fecvw1v9Fz0` zQ%VrBH^NB3FlJs`>}sgJ698R-TCYn7`k7}Ds0vGWvf@j7`MNO@Zx^#D>=va{FDHs^ zd!$!=#4tFW;3M|Pci77jysjS3lCc0f84&lqGB&eBZfzDaI&E|c6m=nW&oQr3?{3%dPb|bqyy?`HpM;7Kjz>VDtx6L2c0q!uF#GVr z;rsrEGkO-3;?e=Mq?!cEmubbe#K5%T1)W5)40T|?Lo(o|?}}WhQNY4w^KA&D@@zI| z9;34Otv#J!AlkFnRMHMm@$RN_P4Kf(?O`(A;D+!QqE&**SYP3VjCsP9*c5LvXJcW( zMcuCPeH$EwC1jIIyA`q@upuCO?jLBxBa>Ho7G9&6A5)SJS=*-#<nFMiV->DdG zg!hwRpgNRN%Ugb~bpME$gxuzFozJ{6lN;Jqu)wL&|>IgY*?3Y-q+zSG;I=uK>I)KLgCs|C9O$@b>N~!ECj+ZJd>@4s)?EIpp7=Kqp z1V46yLJU!ep|JpNOi`Bg5|`%31q;&+rPPcjc-<0wc?~w zoYF)!X#{^{P`2ntZOJ`&eM@SaJ$n?xs{(U(EbV8d53fiS{UR__p7nY?nhnwT_pkHb zE+8S52Vj4gwWC#?K6gbjP|c%oncgYrX2a+H5bS+*wzW3X-rJjczqGKhkW2q%rE^N@ zurKQAd=Fab1m-w&MolPPm%@Fx@_D@PJwM&fz3-)Mnmf*!KcYV-9B3xQoEL5mFe0nf z7pc(0dCzOkRpP$T^tC!*VQV|+@qA`d7luXEp9|Sp3vu+$U*WV4uc>z_8&3-Z96l^?Kt8ZVSA^Zy`G(9IK zJEeN_+c?HAL{pGc@mc?j#`9jmruCuI)%oyLY{Bf;)MtHo$wY zV2@eID?Pj8Hkkv!y{-4j9q{S$FZ=R$pvw=^{BV8mx>L1m`m}RGZwdqYee1i;gEOVA zb>t;9_VPAjPDeB4Eo!C=&Di5c2w}tm<d}*lq3B2u?)z&ukhdh zE>KW3wYwUfkq{&(W{Si67UE~a!1rXQo>rriI)em-89)p=IJ_!Ow$A_HBLBHnU@(?c zkdxzA5aoL%pa9|%6_giM6q0)-&-Y4938W+^D5$_M&G3J_JU#M1S{r^Let|^BPwY^Z zG*f$1L(1^WX03!`mCPcQg}Wvd_a}M9)YH|Vk=Ue?*tDmWAqbhwS`vmtc|NB^r&Ugu zyR-ZV%QxHAL3=tBCQ9d&v$N>sih~goYf})$;G>d4BT~>N(UKkzU zR_10itB_1FtB|TuwUt8?Kq;(n=$)h(>dRL5&0;LIyzoU0w;inaabYWp#;*%$7{Q6`f>Sr#`mJk+$-;V)xjNzdAx|ef!a0ma{c#vmbi_Vdm!7 znfUQm_Izh_HeN#RH-Y%zA(M#GZ|t@~+7}|Kzw!MBV-h4ZeNbqay;BykETO!+OwF=K z&(|2owT^^aEqnN%Gc>Clv9DQzUTeC0essaom4RV6{qYp1t)O z)OI8MfluTRJQH71rJxy`|AUgPr1h9>`nzVFgsP@|9DCxXX8b-=Ql8xp$dOP$x@Bb6 z_5(wHw4jFO^7!;1ue!v-&9ij;!gBeZtHJHK9*;waR0v}hx_Oe@;vF{nk50Smr z#*#WaZb$P_KC+~~{thR7;9W5$x zr}finiZh5;Hq90kfX{g5M@dC+rJ;g5`3apuIa4|&%Eo39FIosv5aLj9)24C6j1Bsmm&tlH7)Ny@rFvyf z;6F>KIL9!JHvmc>EOs!j9zFO^ZwaykpAJy^^T3a)!;nO}{+L;ek8#{gasAwn!Ctf#P3Ik0*Ii1eo=8Oj?@@HRL{6(?fonB_wW^>KWd zKZH)q5`x!d3dgXH8^3MfLqGoL?h69q8UK;XzR7=zjXilllMRf$p)0?FxXdT4bQU@@ zG%G`5C+UoRbk7A+0#up3Wx%HccUX2Bn)UelBL^`g+{(TANHjhb1-%g zl=WKohGLpdTjdr*2YvWkqVQy~lw@8Yf%TRlg191p(&dDs-Z|MB_TDzvUvI?}jiz!) z1O>C~k2sj$f2#!9(*!mHlm|m&ssku=5#e(N;?u`;<7?oIVe<4jk;~F^z;EDu+MKN^ zZEjB5w`+XIk>3NB^aCGSjMV(0a18Ygue89&^d7%pcN!j7y`8%vb9~VOOQP9#7hbwm zl&dte*hZs4r&Uy-nBLb_v>qp`l5xFwRl^70s>|pvT%}NyTS9HS9=<`T`~cD}5hD*L z0$Vo#9@m!dw3wl`^!VjusiJu6pijLf1o2B>=gc3gc*OUtaZCPwBRHcGUo0{_web`~ z^#~cDc8bJY>1IpvnzDV2H_RqLrgd9lL{QR@yZp6%q%}xIN5JMx8yltzXui0J_N-w= zm@l%nI6?}Mqm~#0*K^P(gz0ID8iigo$!kWc>m2h&3Bv=e7xRcQg6+qX=j^ApRSFgI zQ@QV$@i#GPj8>&Bq4~dzZ~97*5e=>-aMVYgPij_72uxyUg_M-RAtGZgsf)WEL%kPB z<>}a40Qn~_l-jAuw`TW5(k}wuHGUeTt(7erv+jc1!Ic%DdxJVehBz-?D8GyDO)*P* zOOf=23ngBWvA|dovUgW(Wccibsxo=-r%r7OT}e7myNo)I(_Ex_t@2m}abTg7*)Fx` zN)M3u$9f2Sn0J@Df?QjK!!-Ym5OTeUdOQJ6?OaAbu=zEU;g=b1ZaW&a`dY#uYM8w z#KhyH@O+(Pc17 z{9xZXkW9nqP#EMvscM~L0pV^VY(RuQwQ;5ZgKp1p+db;~jB>mhK|2wY=DP!OFtB5D zFr_;Z{`2NMMk3{5OZi5(5y3{kKb4V;>_6M9N-my1hb*c7eE6zGt?&2PnsOP}G~tke ziS-w1iqhydJ*3TP_o3A+4%B2~;M1QX(3DlX70vw*lmYt3o(<;NjOMpfXk9i26=V@_ z`8oD}a^n$dU9PDB@?5oQw)#=m0M1(Gn_H51M)bx4g=TA&ovoS>!mItM)>~Nyn2J_H zm@UXu9CcF*WXPqUBL1o^*kTLFNdX17t{%RE<>GRggT&Ai-~K!NI|J@qrB#KM;{Fo? zd`pqmhL}b#<^g&BKcHwMjZ2A{Qvyk~2f}VW&eea^*X|x}HkOY6Sk6`sIPT;gmTn$C WZZ@_!{33ipAU+%x7DX*3oc{t_wlshM -- GitLab From 8a1ec52547e3916b6f173ba39345d151df4b81af Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 17 Jun 2021 11:47:31 +0200 Subject: [PATCH 153/154] Change the pipeline R version to R3.6.1 --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index ee4c809..fe0e593 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -3,7 +3,7 @@ stages: build: stage: build script: - - module load R + - module load R/3.6.1-foss-2015a-bare # - module load CDO - R CMD build --resave-data . - R CMD check --as-cran --no-manual --run-donttest s2dv_*.tar.gz -- GitLab From a8437f1a8c1a60f5e514b669664bfbb210b4479c Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 17 Jun 2021 12:38:53 +0200 Subject: [PATCH 154/154] Comment the line checking the coverage of tests --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index fe0e593..cbe09a2 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -7,4 +7,4 @@ build: # - module load CDO - R CMD build --resave-data . - R CMD check --as-cran --no-manual --run-donttest s2dv_*.tar.gz - - R -e 'covr::package_coverage()' +# - R -e 'covr::package_coverage()' -- GitLab