From 7b90a72039fe551eed669ac48d8512993f2d5f82 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Sun, 15 Oct 2023 16:12:07 -0700 Subject: [PATCH 01/28] adding framework for calculating HCx based on the root --- R/hc.R | 102 ++++++++++++++++++++++++++++++++------------------ R/params.R | 1 + man/params.Rd | 2 + man/ssd_hc.Rd | 4 +- 4 files changed, 72 insertions(+), 37 deletions(-) diff --git a/R/hc.R b/R/hc.R index f1be7ce2..575c7bc2 100644 --- a/R/hc.R +++ b/R/hc.R @@ -68,7 +68,7 @@ no_ssd_hc <- function() { args$p <- proportion dist <- .dist_tmbfit(x) what <- paste0("ssd_q", dist) - + est <- do.call(what, args) if (!ci) { na <- rep(NA_real_, length(proportion)) @@ -87,14 +87,14 @@ no_ssd_hc <- function() { censoring <- censoring / rescale fun <- safely(fit_tmb) estimates <- boot_estimates(x, - fun = fun, nboot = nboot, data = data, weighted = weighted, - censoring = censoring, min_pmix = min_pmix, - range_shape1 = range_shape1, - range_shape2 = range_shape2, - parametric = parametric, - control = control + fun = fun, nboot = nboot, data = data, weighted = weighted, + censoring = censoring, min_pmix = min_pmix, + range_shape1 = range_shape1, + range_shape2 = range_shape2, + parametric = parametric, + control = control ) - + cis <- cis_estimates(estimates, what, level = level, x = proportion) hc <- tibble( dist = dist, @@ -106,16 +106,24 @@ no_ssd_hc <- function() { replace_min_pboot_na(hc, min_pboot) } +.ssd_hc_root <- function(proportion, x, ci, level, nboot, min_pboot, + data, rescale, weighted, censoring, min_pmix, + range_shape1, range_shape2, parametric, control) { + .NotYetImplemented() + # 1 proportion , multiple distributions, rest all 1 + # need tidy eval and/or function factor to construct function. +} + .ssd_hc_fitdists <- function(x, percent, ci, level, nboot, - average, min_pboot, parametric, control) { + average, min_pboot, parametric, root, control) { if (!length(x) || !length(percent)) { return(no_ssd_hc()) } - + if (is.null(control)) { control <- .control_fitdists(x) } - + data <- .data_fitdists(x) rescale <- .rescale_fitdists(x) censoring <- .censoring_fitdists(x) @@ -124,12 +132,12 @@ no_ssd_hc <- function() { range_shape2 <- .range_shape2_fitdists(x) weighted <- .weighted_fitdists(x) unequal <- .unequal_fitdists(x) - + if (parametric && ci && identical(censoring, c(NA_real_, NA_real_))) { wrn("Parametric CIs cannot be calculated for inconsistently censored data.") ci <- FALSE } - + if (parametric && ci && unequal) { wrn("Parametric CIs cannot be calculated for unequally weighted data.") ci <- FALSE @@ -138,15 +146,37 @@ no_ssd_hc <- function() { nboot <- 0L } seeds <- seed_streams(length(x)) + + if(root && average) { + hc <- future_map( + percent / 100, .ssd_hc_root, + x, ci = ci, level = level, nboot = nboot, + min_pboot = min_pboot, + data = data, rescale = rescale, weighted = weighted, censoring = censoring, + min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, + parametric = parametric, control = control, + .options = furrr::furrr_options(seed = seeds)) + + method <- if (parametric) "parametric" else "non-parametric" + + return( + tibble( + dist = "average", percent = percent, est = hc$est, se = hc$se, + lcl = hc$lcl, ucl = hc$ucl, wt = rep(1, length(percent)), + method = method, nboot = nboot, pboot = hc$pboot + ) + ) + } + hc <- future_map(x, .ssd_hc_tmbfit, - proportion = percent / 100, ci = ci, level = level, nboot = nboot, - min_pboot = min_pboot, - data = data, rescale = rescale, weighted = weighted, censoring = censoring, - min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, - parametric = parametric, control = control, - .options = furrr::furrr_options(seed = seeds) + proportion = percent / 100, ci = ci, level = level, nboot = nboot, + min_pboot = min_pboot, + data = data, rescale = rescale, weighted = weighted, censoring = censoring, + min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, + parametric = parametric, control = control, + .options = furrr::furrr_options(seed = seeds) ) - + weight <- glance(x)$weight if (!average) { hc <- mapply( @@ -186,17 +216,17 @@ ssd_hc.list <- function(x, percent = 5, hc = 5, ...) { chk_named(x) chk_unique(names(x)) chk_unused(...) - + if (!missing(hc)) { deprecate_stop("0.1.0", "ssd_hc(hc = )", "ssd_hc(percent = )") } - + if (!length(x)) { return(no_ssd_hc()) } hc <- mapply(.ssd_hc_dist, x, names(x), - MoreArgs = list(proportion = percent / 100), - SIMPLIFY = FALSE + MoreArgs = list(proportion = percent / 100), + SIMPLIFY = FALSE ) bind_rows(hc) } @@ -205,7 +235,7 @@ ssd_hc.list <- function(x, percent = 5, hc = 5, ...) { #' @export ssd_hc.fitdists <- function(x, percent = 5, hc = 5, ci = FALSE, level = 0.95, nboot = 1000, average = TRUE, delta = 7, min_pboot = 0.99, - parametric = TRUE, + parametric = TRUE, root = FALSE, control = NULL, ...) { chk_vector(percent) chk_numeric(percent) @@ -224,23 +254,23 @@ ssd_hc.fitdists <- function(x, percent = 5, hc = 5, ci = FALSE, level = 0.95, nb chk_number(min_pboot) chk_range(min_pboot) chk_flag(parametric) + chk_flag(root) chk_null_or(control, vld = vld_list) chk_unused(...) - + if (!missing(hc)) { deprecate_stop("0.1.0", "ssd_hc(hc = )", "ssd_hc(percent = )") } - + x <- subset(x, delta = delta) hc <- .ssd_hc_fitdists(x, percent, - ci = ci, level = level, nboot = nboot, min_pboot = min_pboot, control = control, - average = average, parametric = parametric + ci = ci, level = level, nboot = nboot, min_pboot = min_pboot, control = control, + average = average, parametric = parametric, root = root ) warn_min_pboot(hc, min_pboot) } #' @describeIn ssd_hc Hazard Concentrations for fitburrlioz Object -#' ' #' @export #' @examples #' fit <- ssd_fit_burrlioz(ssddata::ccme_boron) @@ -264,18 +294,18 @@ ssd_hc.fitburrlioz <- function(x, percent = 5, ci = FALSE, level = 0.95, nboot = chk_range(min_pboot) chk_flag(parametric) chk_unused(...) - + if (names(x) != "burrIII3" || !ci || !length(percent)) { class(x) <- class(x)[-1] return(ssd_hc(x, - percent = percent, ci = ci, level = level, - nboot = nboot, min_pboot = min_pboot, - average = FALSE, parametric = parametric + percent = percent, ci = ci, level = level, + nboot = nboot, min_pboot = min_pboot, + average = FALSE, parametric = parametric )) } hc <- .ssd_hc_burrlioz_fitdists(x, - percent = percent, level = level, nboot = nboot, - min_pboot = min_pboot, parametric = parametric + percent = percent, level = level, nboot = nboot, + min_pboot = min_pboot, parametric = parametric ) warn_min_pboot(hc, min_pboot) } diff --git a/R/params.R b/R/params.R index 3d820df5..97926d18 100644 --- a/R/params.R +++ b/R/params.R @@ -103,6 +103,7 @@ #' @param nsim A positive whole number of the number of simulations to generate. #' @param linetype A string of the column in pred to use for the linetype. #' @param linecolor A string of the column in pred to use for the line color. +#' @param root A flag specifying whether to calculate the value by finding the root. #' @keywords internal #' @name params NULL diff --git a/man/params.Rd b/man/params.Rd index a85f1f5c..258cf48f 100644 --- a/man/params.Rd +++ b/man/params.Rd @@ -171,6 +171,8 @@ remove them with a warning.} \item{linetype}{A string of the column in pred to use for the linetype.} \item{linecolor}{A string of the column in pred to use for the line color.} + +\item{root}{A flag specifying whether to calculate the value by finding the root.} } \description{ Parameter Descriptions for ssdtools Functions diff --git a/man/ssd_hc.Rd b/man/ssd_hc.Rd index 9e91293c..89d8bf1b 100644 --- a/man/ssd_hc.Rd +++ b/man/ssd_hc.Rd @@ -22,6 +22,7 @@ ssd_hc(x, ...) delta = 7, min_pboot = 0.99, parametric = TRUE, + root = FALSE, control = NULL, ... ) @@ -61,6 +62,8 @@ in the sense of returning a likelihood.} \item{parametric}{A flag specifying whether to perform parametric as opposed to non-parametric bootstrapping.} +\item{root}{A flag specifying whether to calculate the value by finding the root.} + \item{control}{A list of control parameters passed to \code{\link[stats:optim]{stats::optim()}}.} } \value{ @@ -80,7 +83,6 @@ hazard concentrations(s). \item \code{ssd_hc(fitdists)}: Hazard Concentrations for fitdists Object \item \code{ssd_hc(fitburrlioz)}: Hazard Concentrations for fitburrlioz Object -' }} \examples{ From 666c1c28b8cf23ab3167781cd9e456b4f4555e92 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Sun, 15 Oct 2023 19:57:13 -0700 Subject: [PATCH 02/28] added root to predict --- R/predict.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/predict.R b/R/predict.R index 9d512e37..50fdc45a 100644 --- a/R/predict.R +++ b/R/predict.R @@ -33,14 +33,15 @@ predict.fitdists <- function(object, percent = 1:99, ci = FALSE, average = TRUE, delta = 7, min_pboot = 0.99, parametric = TRUE, + root = FALSE, control = NULL, ...) { chk_unused(...) ssd_hc(object, percent = percent, ci = ci, level = level, nboot = nboot, min_pboot = min_pboot, - average = average, delta = delta, - control = control, parametric = parametric + average = average, delta = delta, parametric = parametric, + root = root, control = control ) } From 4fef856a44577df0ed34e12c0c1654409d23ac9b Mon Sep 17 00:00:00 2001 From: Sarah Lyons Date: Mon, 16 Oct 2023 11:22:21 -0700 Subject: [PATCH 03/28] reorder params to be alphabetical --- R/params.R | 131 ++++++++++++++++++++++++++--------------------------- 1 file changed, 65 insertions(+), 66 deletions(-) diff --git a/R/params.R b/R/params.R index 3d820df5..ba60008c 100644 --- a/R/params.R +++ b/R/params.R @@ -13,96 +13,95 @@ # limitations under the License. #' Parameter Descriptions for ssdtools Functions -#' #' @param all A flag specifying whether to also return transformed parameters. #' @param at_boundary_ok A flag specifying whether a model with one or more #' parameters at the boundary should be considered to have converged (default = FALSE). -#' @param x The object. -#' @param object The object. -#' @param control A list of control parameters passed to [`stats::optim()`]. -#' @param chk A flag specifying whether to check the arguments. -#' @param data A data frame. -#' @param pred A data frame of the predictions. -#' @param xlab A string of the x-axis label. -#' @param ylab A string of the x-axis label. -#' @param xbreaks The x-axis breaks as one of: -#' - `NULL` for no breaks -#' - `waiver()` for the default breaks -#' - A numeric vector of positions +#' @param average A flag specifying whether to model average the estimates. #' @param breaks A character vector #' @param bounds A named non-negative numeric vector of the left and right bounds for #' uncensored missing (0 and Inf) data in terms of the orders of magnitude #' relative to the extremes for non-missing values. +#' @param chk A flag specifying whether to check the arguments. +#' @param ci A flag specifying whether to estimate confidence intervals (by parametric bootstrapping). +#' @param color A string of the column in data for the color aesthetic. +#' @param computable A flag specifying whether to only return fits with numerically computable standard errors. #' @param conc A numeric vector of concentrations. -#' @param digits A whole number specifying the number of significant figures -#' @param percent A numeric vector of percentages. -#' @param pvalue A flag specifying whether to return p-values or the statistics (default) for the various tests. -#' @param parametric A flag specifying whether to perform parametric as opposed to non-parametric bootstrapping. -#' @param min_pmix A number between 0 and 0.5 specifying the minimum proportion in mixture models. +#' @param control A list of control parameters passed to [`stats::optim()`]. +#' @param data A data frame. #' @param delta A non-negative number specifying the maximum absolute Akaike Information-theoretic Criterion difference cutoff. Distributions with an absolute difference from the best model greater than the cutoff are excluded. -#' @param average A flag specifying whether to model average the estimates. -#' @param ci A flag specifying whether to estimate confidence intervals (by parametric bootstrapping). -#' @param nboot A count of the number of bootstrap samples to use to estimate the se and confidence limits. A value of 10000 is recommended for official guidelines. -#' @param min_pboot A number of the minimum proportion of bootstrap samples that must successfully fit -#' in the sense of returning a likelihood. +#' @param digits A whole number specifying the number of significant figures. +#' @param dists A character vector of the distribution names. +#' @param hc A count between 1 and 99 indicating the percent hazard concentration (or NULL). +#' @param label A string of the column in data with the labels. +#' @param left A string of the column in data with the concentrations. #' @param level A number between 0 and 1 of the confidence level. -#' @param ... Unused. -#' @param q vector of quantiles. -#' @param p vector of probabilities. -#' @param n number of observations. +#' @param linecolor A string of the column in pred to use for the line color. +#' @param linetype A string of the column in pred to use for the linetype. +#' @param llocation location parameter on the log scale. +#' @param location location parameter. +#' @param locationlog location on the log scale parameter. +#' @param locationlog1 locationlog1 parameter. +#' @param locationlog2 locationlog2 parameter. #' @param log logical; if TRUE, probabilities p are given as log(p). #' @param log.p logical; if TRUE, probabilities p are given as log(p). -#' @param lower.tail logical; if TRUE (default), probabilities are `P[X <= x]`,otherwise, `P[X > x]`. -#' @param location location parameter. -#' @param llocation location parameter on the log scale. -#' @param scale scale parameter. #' @param lscale scale parameter on the log scale. -#' @param shape shape parameter. -#' @param shape1 shape1 parameter. -#' @param shape2 shape2 parameter. +#' @param lshape shape parameter on the log scale. +#' @param lshape1 shape1 parameter on the log scale. +#' @param lshape2 shape2 parameter on the log scale. +#' @param lower.tail logical; if TRUE (default), probabilities are `P[X <= x]`, otherwise, `P[X > x]`. +#' @param meanlog mean on log scale parameter. +#' @param meanlog1 mean on log scale parameter. +#' @param meanlog2 mean on log scale parameter. +#' @param min_pboot A number of the minimum proportion of bootstrap samples that must successfully +#' fit in the sense of returning a likelihood. +#' @param min_pmix A number between 0 and 0.5 specifying the minimum proportion in mixture models. +#' @param na.rm A flag specifying whether to silently remove missing values or +#' remove them with a warning. +#' @param n positive number of observations. +#' @param nboot A count of the number of bootstrap samples to use to estimate the se and confidence limits. A value of 10000 is recommended for official guidelines. +#' @param nrow A positive whole number of the minimum number of non-missing rows. +#' @param nsim A positive whole number of the number of simulations to generate. +#' @param object The object. +#' @param parametric A flag specifying whether to perform parametric as opposed to non-parametric bootstrapping. +#' @param p vector of probabilities. +#' @param percent A numeric vector of percentages. +#' @param pmix Proportion mixture parameter. +#' @param pvalue A flag specifying whether to return p-values or the statistics (default) for the various tests. +#' @param pred A data frame of the predictions. +#' @param q vector of quantiles. #' @param range_shape1 A numeric vector of length two of the lower and upper bounds for the shape1 parameter. #' @param range_shape2 A numeric vector of length two of the lower and upper bounds for the shape2 parameter. #' @param range_shape2 shape2 parameter. -#' @param locationlog1 locationlog1 parameter. +#' @param reweight A flag specifying whether to reweight weights by dividing by the largest weight. +#' @param rescale A flag specifying whether to rescale concentration values by dividing by the largest finite value. +#' @param ribbon A flag indicating whether to plot the confidence interval as a grey ribbon as opposed to green solid lines. +#' @param right A string of the column in data with the right concentration values. +#' @param scale scale parameter. #' @param scalelog1 scalelog1 parameter. -#' @param locationlog2 locationlog2 parameter. #' @param scalelog2 scalelog2 parameter. -#' @param pmix Proportion mixture parameter. -#' @param meanlog mean on log scale parameter. -#' @param meanlog1 mean on log scale parameter. -#' @param meanlog2 mean on log scale parameter. -#' @param locationlog location on log scale parameter. +#' @param scalelog scale on log scale parameter. #' @param sdlog standard deviation on log scale parameter. #' @param sdlog1 standard deviation on log scale parameter. #' @param sdlog2 standard deviation on log scale parameter. -#' @param scalelog scale on log scale parameter. -#' @param lshape shape parameter on the log scale. -#' @param lshape1 shape1 parameter on the log scale. -#' @param lshape2 shape2 parameter on the log scale. -#' @param xintercept The x-value for the intersect -#' @param yintercept The y-value for the intersect. #' @param select A character vector of the distributions to select. -#' @param rescale A flag specifying whether to rescale concentration values by dividing by the largest finite value. -#' @param reweight A flag specifying whether to reweight weights by dividing by the largest weight. -#' @param left A string of the column in data with the concentrations. -#' @param right A string of the column in data with the right concentration values. -#' @param label A string of the column in data with the labels. #' @param shape A string of the column in data for the shape aesthetic. -#' @param color A string of the column in data for the color aesthetic. -#' @param size A number for the size of the labels. -#' @param ribbon A flag indicating whether to plot the confidence interval as a grey ribbon as opposed to green solid lines. +#' @param shape shape parameter. +#' @param shape1 shape1 parameter. +#' @param shape2 shape2 parameter. #' @param shift_x The value to multiply the label x values by. -#' @param hc A count between 1 and 99 indicating the percent hazard concentration (or NULL). -#' @param weight A string of the numeric column in data with positive weights less than or equal to 1,000 or NULL. -#' @param dists A character vector of the distribution names. -#' @param computable A flag specifying whether to only return fits with numerically computable standard errors. #' @param silent A flag indicating whether fits should fail silently. -#' @param na.rm A flag specifying whether to silently remove missing values or -#' remove them with a warning. -#' @param nrow A positive whole number of the minimum number of non-missing rows. -#' @param nsim A positive whole number of the number of simulations to generate. -#' @param linetype A string of the column in pred to use for the linetype. -#' @param linecolor A string of the column in pred to use for the line color. +#' @param size A number for the size of the labels. +#' @param weight A string of the numeric column in data with positive weights less than or equal to 1,000 or NULL. +#' @param x The object. +#' @param xbreaks The x-axis breaks as one of: +#' - `NULL` for no breaks +#' - `waiver()` for the default breaks +#' - A numeric vector of positions +#' @param xintercept The x-value for the intersect +#' @param xlab A string of the x-axis label. +#' @param yintercept The y-value for the intersect. +#' @param ylab A string of the x-axis label. +#' @param ... Unused. #' @keywords internal #' @name params -NULL +NULL \ No newline at end of file From 5cccd264ad052b5790ecb220b0ce33ed109835be Mon Sep 17 00:00:00 2001 From: Sarah Lyons Date: Mon, 16 Oct 2023 11:25:11 -0700 Subject: [PATCH 04/28] moving second shape param to ggplot documentation. --- R/ggplot.R | 2 +- R/params.R | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/R/ggplot.R b/R/ggplot.R index f8c8cedc..05292b68 100644 --- a/R/ggplot.R +++ b/R/ggplot.R @@ -52,7 +52,7 @@ scale_color_ssd <- function(...) { #' Uses the empirical cumulative distribution to create scatterplot of points `x`. #' #' `geom_ssd()` has been deprecated for `geom_ssdpoint()`. -#' +#' @param shape A string of the column in data for the shape aesthetic. #' @inheritParams ggplot2::layer #' @inheritParams ggplot2::geom_point #' @seealso [`ssd_plot_cdf()`] diff --git a/R/params.R b/R/params.R index ba60008c..0745715e 100644 --- a/R/params.R +++ b/R/params.R @@ -84,7 +84,6 @@ #' @param sdlog1 standard deviation on log scale parameter. #' @param sdlog2 standard deviation on log scale parameter. #' @param select A character vector of the distributions to select. -#' @param shape A string of the column in data for the shape aesthetic. #' @param shape shape parameter. #' @param shape1 shape1 parameter. #' @param shape2 shape2 parameter. From b08793f2e95819b8ad6818d26955f5b624d2aaf0 Mon Sep 17 00:00:00 2001 From: Sarah Lyons Date: Mon, 16 Oct 2023 13:41:14 -0700 Subject: [PATCH 05/28] Is this where this goes? --- R/ggplot.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ggplot.R b/R/ggplot.R index 05292b68..5e8486fe 100644 --- a/R/ggplot.R +++ b/R/ggplot.R @@ -32,6 +32,7 @@ ssd_pal <- function() { #' Discrete color-blind scale for SSD Plots #' #' @param ... Arguments passed to [ggplot2::discrete_scale()]. +#' @param shape A string of the column in data for the shape aesthetic. #' @family ggplot #' @export #' @examples @@ -52,7 +53,6 @@ scale_color_ssd <- function(...) { #' Uses the empirical cumulative distribution to create scatterplot of points `x`. #' #' `geom_ssd()` has been deprecated for `geom_ssdpoint()`. -#' @param shape A string of the column in data for the shape aesthetic. #' @inheritParams ggplot2::layer #' @inheritParams ggplot2::geom_point #' @seealso [`ssd_plot_cdf()`] From f54b6908609bac122a5a2aea82aa0c586923b78d Mon Sep 17 00:00:00 2001 From: Sarah Lyons Date: Mon, 16 Oct 2023 13:46:38 -0700 Subject: [PATCH 06/28] Is this where this goes? --- R/plot-data.R | 1 + R/ssd-plot.R | 1 + 2 files changed, 2 insertions(+) diff --git a/R/plot-data.R b/R/plot-data.R index eabb7247..5f06fe17 100644 --- a/R/plot-data.R +++ b/R/plot-data.R @@ -17,6 +17,7 @@ #' Plots species sensitivity data. #' #' @inheritParams params +#' @param shape A string of the column in data for the shape aesthetic. #' @seealso [`ssd_plot()`] and [`geom_ssdpoint()`] #' @export #' @examples diff --git a/R/ssd-plot.R b/R/ssd-plot.R index c0db70cc..18c9eb17 100644 --- a/R/ssd-plot.R +++ b/R/ssd-plot.R @@ -41,6 +41,7 @@ plot_coord_scale <- function(data, xlab, ylab, xbreaks = waiver()) { #' Plots species sensitivity data and distributions. #' #' @inheritParams params +#' @param shape A string of the column in data for the shape aesthetic. #' @seealso [`ssd_plot_cdf()`] and [`geom_ssdpoint()`] #' @export #' @examples From 2ba835c4717787f37eae68245898573117f64bbd Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Fri, 20 Oct 2023 08:49:46 -0700 Subject: [PATCH 07/28] hc root getting ready --- R/hc-root.R | 22 ++++++++++++++++++++++ R/hc.R | 8 -------- tests/testthat/test-hc-root.R | 35 +++++++++++++++++++++++++++++++++++ 3 files changed, 57 insertions(+), 8 deletions(-) create mode 100644 R/hc-root.R create mode 100644 tests/testthat/test-hc-root.R diff --git a/R/hc-root.R b/R/hc-root.R new file mode 100644 index 00000000..bf5d2eba --- /dev/null +++ b/R/hc-root.R @@ -0,0 +1,22 @@ +# Copyright 2023 Australian Government Department of +# Climate Change, Energy, the Environment and Water +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# https://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +.ssd_hc_root <- function(proportion, x, ci, level, nboot, min_pboot, + data, rescale, weighted, censoring, min_pmix, + range_shape1, range_shape2, parametric, control) { + .NotYetImplemented() + # 1 proportion , multiple distributions, rest all 1 + # need tidy eval and/or function factor to construct function. +} diff --git a/R/hc.R b/R/hc.R index 088cee71..3ca2b6be 100644 --- a/R/hc.R +++ b/R/hc.R @@ -105,14 +105,6 @@ no_ssd_hc <- function() { replace_min_pboot_na(hc, min_pboot) } -.ssd_hc_root <- function(proportion, x, ci, level, nboot, min_pboot, - data, rescale, weighted, censoring, min_pmix, - range_shape1, range_shape2, parametric, control) { - .NotYetImplemented() - # 1 proportion , multiple distributions, rest all 1 - # need tidy eval and/or function factor to construct function. -} - .ssd_hc_fitdists <- function(x, percent, ci, level, nboot, average, min_pboot, parametric, root, control) { if (!length(x) || !length(percent)) { diff --git a/tests/testthat/test-hc-root.R b/tests/testthat/test-hc-root.R new file mode 100644 index 00000000..4420dfba --- /dev/null +++ b/tests/testthat/test-hc-root.R @@ -0,0 +1,35 @@ +# Copyright 2023 Australian Government Department of +# Climate Change, Energy, the Environment and Water +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# https://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +# Copyright 2021 Province of British Columbia +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# https://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +test_that("hc", { + skip_on_os("linux") # FIXME + fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") + set.seed(102) + expect_error(hc <- ssd_hc(fits, average = TRUE, root = TRUE)) +}) \ No newline at end of file From 0752e52c2c74f3c3f0b1e5eb894f6cf28f9fedf4 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Fri, 20 Oct 2023 09:01:54 -0700 Subject: [PATCH 08/28] pass in glance and tidy --- R/hc-root.R | 3 ++- R/hc.R | 6 ++++-- tests/testthat/test-hc-root.R | 10 +++++++++- 3 files changed, 15 insertions(+), 4 deletions(-) diff --git a/R/hc-root.R b/R/hc-root.R index bf5d2eba..474cfb97 100644 --- a/R/hc-root.R +++ b/R/hc-root.R @@ -13,9 +13,10 @@ # See the License for the specific language governing permissions and # limitations under the License. -.ssd_hc_root <- function(proportion, x, ci, level, nboot, min_pboot, +.ssd_hc_root <- function(proportion, glance, tidy, ci, level, nboot, min_pboot, data, rescale, weighted, censoring, min_pmix, range_shape1, range_shape2, parametric, control) { + browser() .NotYetImplemented() # 1 proportion , multiple distributions, rest all 1 # need tidy eval and/or function factor to construct function. diff --git a/R/hc.R b/R/hc.R index 3ca2b6be..997d4278 100644 --- a/R/hc.R +++ b/R/hc.R @@ -123,6 +123,8 @@ no_ssd_hc <- function() { range_shape2 <- .range_shape2_fitdists(x) weighted <- .weighted_fitdists(x) unequal <- .unequal_fitdists(x) + glance <- glance(x) + tidy <- tidy(x) if (parametric && ci && identical(censoring, c(NA_real_, NA_real_))) { wrn("Parametric CIs cannot be calculated for inconsistently censored data.") @@ -141,7 +143,7 @@ no_ssd_hc <- function() { if(root && average) { hc <- future_map( percent / 100, .ssd_hc_root, - x, ci = ci, level = level, nboot = nboot, + glance = glance, tidy = tidy, ci = ci, level = level, nboot = nboot, min_pboot = min_pboot, data = data, rescale = rescale, weighted = weighted, censoring = censoring, min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, @@ -168,7 +170,7 @@ no_ssd_hc <- function() { .options = furrr::furrr_options(seed = seeds) ) - weight <- glance(x)$weight + weight <- glance$weight if (!average) { hc <- mapply( function(x, y) { diff --git a/tests/testthat/test-hc-root.R b/tests/testthat/test-hc-root.R index 4420dfba..c52a4929 100644 --- a/tests/testthat/test-hc-root.R +++ b/tests/testthat/test-hc-root.R @@ -27,9 +27,17 @@ # See the License for the specific language governing permissions and # limitations under the License. -test_that("hc", { +test_that("hc root lnorm", { skip_on_os("linux") # FIXME fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") set.seed(102) expect_error(hc <- ssd_hc(fits, average = TRUE, root = TRUE)) +}) + + +test_that("hc root lnorm llogis", { + skip_on_os("linux") # FIXME + fits <- ssd_fit_dists(ssddata::ccme_boron, dists = c("lnorm", "llogis")) + set.seed(102) + expect_error(hc <- ssd_hc(fits, average = TRUE, root = TRUE)) }) \ No newline at end of file From 1808f6343766b780dccc6af1f0e01096a83215ea Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Fri, 20 Oct 2023 09:39:12 -0700 Subject: [PATCH 09/28] seeds for percents --- R/hc.R | 4 +++- man/predict.fitdists.Rd | 3 +++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/R/hc.R b/R/hc.R index 997d4278..fb4e91cd 100644 --- a/R/hc.R +++ b/R/hc.R @@ -138,9 +138,9 @@ no_ssd_hc <- function() { if (!ci) { nboot <- 0L } - seeds <- seed_streams(length(x)) if(root && average) { + seeds <- seed_streams(length(percent)) hc <- future_map( percent / 100, .ssd_hc_root, glance = glance, tidy = tidy, ci = ci, level = level, nboot = nboot, @@ -161,6 +161,8 @@ no_ssd_hc <- function() { ) } + seeds <- seed_streams(length(x)) + hc <- future_map(x, .ssd_hc_tmbfit, proportion = percent / 100, ci = ci, level = level, nboot = nboot, min_pboot = min_pboot, diff --git a/man/predict.fitdists.Rd b/man/predict.fitdists.Rd index 53fa45ce..31a0bedc 100644 --- a/man/predict.fitdists.Rd +++ b/man/predict.fitdists.Rd @@ -14,6 +14,7 @@ delta = 7, min_pboot = 0.99, parametric = TRUE, + root = FALSE, control = NULL, ... ) @@ -38,6 +39,8 @@ in the sense of returning a likelihood.} \item{parametric}{A flag specifying whether to perform parametric as opposed to non-parametric bootstrapping.} +\item{root}{A flag specifying whether to calculate the value by finding the root.} + \item{control}{A list of control parameters passed to \code{\link[stats:optim]{stats::optim()}}.} \item{...}{Unused.} From 12eab64811a768809dc226348481fbbda474c64c Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Fri, 20 Oct 2023 10:36:13 -0700 Subject: [PATCH 10/28] add internal function wt_est_nest --- R/hc-root.R | 19 +++++++++++++++++++ R/hc.R | 7 +++---- 2 files changed, 22 insertions(+), 4 deletions(-) diff --git a/R/hc-root.R b/R/hc-root.R index 474cfb97..bf16866a 100644 --- a/R/hc-root.R +++ b/R/hc-root.R @@ -13,6 +13,25 @@ # See the License for the specific language governing permissions and # limitations under the License. +wt_est_nest <- function(x) { + glance <- glance(x) + tidy <- tidy(x) + + wt <- dplyr::select(glance, "dist", "weight") + est <- dplyr::select(tidy, "dist", "term", "est", "se") + est_nest <- tidyr::nest(est, .by = "dist") + dplyr::inner_join(wt, est_nest, by = "dist") +} + +ma_cdf <- function(glance, tidy) { + wt_est <- wt_est_nest(glance, tidy) + + funs <- paste0("ssd_p", wt$dist) + wts <- wt_est$weight +# args <- map(wts$data, + +} + .ssd_hc_root <- function(proportion, glance, tidy, ci, level, nboot, min_pboot, data, rescale, weighted, censoring, min_pmix, range_shape1, range_shape2, parametric, control) { diff --git a/R/hc.R b/R/hc.R index fb4e91cd..616b566a 100644 --- a/R/hc.R +++ b/R/hc.R @@ -123,8 +123,7 @@ no_ssd_hc <- function() { range_shape2 <- .range_shape2_fitdists(x) weighted <- .weighted_fitdists(x) unequal <- .unequal_fitdists(x) - glance <- glance(x) - tidy <- tidy(x) + wt_est_nest <- wt_est_nest(x) if (parametric && ci && identical(censoring, c(NA_real_, NA_real_))) { wrn("Parametric CIs cannot be calculated for inconsistently censored data.") @@ -143,7 +142,7 @@ no_ssd_hc <- function() { seeds <- seed_streams(length(percent)) hc <- future_map( percent / 100, .ssd_hc_root, - glance = glance, tidy = tidy, ci = ci, level = level, nboot = nboot, + wt_est_nest = wt_est_nest, ci = ci, level = level, nboot = nboot, min_pboot = min_pboot, data = data, rescale = rescale, weighted = weighted, censoring = censoring, min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, @@ -172,7 +171,7 @@ no_ssd_hc <- function() { .options = furrr::furrr_options(seed = seeds) ) - weight <- glance$weight + weight <- wt_est_nest$weight if (!average) { hc <- mapply( function(x, y) { From 2bf3f15fe5f52eb3f7ce000f5531cffc4f710e18 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Fri, 20 Oct 2023 12:01:02 -0700 Subject: [PATCH 11/28] hc-root to root --- R/{hc-root.R => root.R} | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) rename R/{hc-root.R => root.R} (64%) diff --git a/R/hc-root.R b/R/root.R similarity index 64% rename from R/hc-root.R rename to R/root.R index bf16866a..1770a032 100644 --- a/R/hc-root.R +++ b/R/root.R @@ -23,20 +23,25 @@ wt_est_nest <- function(x) { dplyr::inner_join(wt, est_nest, by = "dist") } -ma_cdf <- function(glance, tidy) { - wt_est <- wt_est_nest(glance, tidy) - - funs <- paste0("ssd_p", wt$dist) - wts <- wt_est$weight -# args <- map(wts$data, +est_args <- function(x) { + paste(x$term, "=", x$est, collapse = ", ") +} + +ma_fun <- function(wt_est_nest, fun = "p") { + funs <- paste0("ssd_", fun, wt_est_nest$dist) + wts <- wt_est_nest$weight + args <- purrr::map_chr(wt_est_nest$data, est_args) + fun_args <- paste0(wts, " * ", funs, "(x, ", args, ")", collapse = " + ") + func <- paste0("function(x, ", fun ,") {(", fun_args, ") - ", fun, "}") + eval(parse(text = func)) } -.ssd_hc_root <- function(proportion, glance, tidy, ci, level, nboot, min_pboot, +.ssd_hc_root <- function(proportion, wt_est_nest, ci, level, nboot, min_pboot, data, rescale, weighted, censoring, min_pmix, range_shape1, range_shape2, parametric, control) { - browser() - .NotYetImplemented() - # 1 proportion , multiple distributions, rest all 1 - # need tidy eval and/or function factor to construct function. + + f <- ma_fun(wt_est_nest) + root <- uniroot(f = f, p = proportion, lower = 0, upper = 100)$root + root } From c22c3497792addeef87d9e16bffa986d5bb5061c Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Fri, 20 Oct 2023 12:43:35 -0700 Subject: [PATCH 12/28] initial hc root working --- NAMESPACE | 1 + R/hc.R | 5 +++-- R/root.R | 21 ++++++++++++++++++--- R/ssdtools-package.R | 1 + tests/testthat/_snaps/hc-root.md | 20 ++++++++++++++++++++ tests/testthat/test-hc-root.R | 29 ++++++++++++++++++++++------- 6 files changed, 65 insertions(+), 12 deletions(-) create mode 100644 tests/testthat/_snaps/hc-root.md diff --git a/NAMESPACE b/NAMESPACE index c8890554..3776a9f6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -175,6 +175,7 @@ importFrom(stats,qlogis) importFrom(stats,runif) importFrom(stats,sd) importFrom(stats,setNames) +importFrom(stats,uniroot) importFrom(stats,weighted.mean) importFrom(stringr,str_order) importFrom(tibble,as_tibble) diff --git a/R/hc.R b/R/hc.R index 616b566a..1268ab60 100644 --- a/R/hc.R +++ b/R/hc.R @@ -140,7 +140,7 @@ no_ssd_hc <- function() { if(root && average) { seeds <- seed_streams(length(percent)) - hc <- future_map( + hcs <- future_map( percent / 100, .ssd_hc_root, wt_est_nest = wt_est_nest, ci = ci, level = level, nboot = nboot, min_pboot = min_pboot, @@ -148,7 +148,8 @@ no_ssd_hc <- function() { min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, parametric = parametric, control = control, .options = furrr::furrr_options(seed = seeds)) - + hc <- dplyr::bind_rows(hcs) + method <- if (parametric) "parametric" else "non-parametric" return( diff --git a/R/root.R b/R/root.R index 1770a032..2ffd7e23 100644 --- a/R/root.R +++ b/R/root.R @@ -37,11 +37,26 @@ ma_fun <- function(wt_est_nest, fun = "p") { eval(parse(text = func)) } +hc_interval <- function(p, data) { + right <- data$right[is.finite(data$right)] + left <- data$left[data$left > 0] + # TODO: improve bounds? + c(min(left) / 10, max(right) * 10) +} + .ssd_hc_root <- function(proportion, wt_est_nest, ci, level, nboot, min_pboot, data, rescale, weighted, censoring, min_pmix, range_shape1, range_shape2, parametric, control) { - f <- ma_fun(wt_est_nest) - root <- uniroot(f = f, p = proportion, lower = 0, upper = 100)$root - root + f <- ma_fun(wt_est_nest, fun = "p") + hc_interval <- hc_interval(proportion, data) + hc <- uniroot(f = f, p = proportion, interval = hc_interval)$root + + tibble( + est = hc * rescale, + se = NA_real_, + lcl = NA_real_, + ucl = NA_real_, + pboot = NA_real_ + ) } diff --git a/R/ssdtools-package.R b/R/ssdtools-package.R index 6ee8881d..be7f2e64 100644 --- a/R/ssdtools-package.R +++ b/R/ssdtools-package.R @@ -34,6 +34,7 @@ utils::globalVariables("where") #' @importFrom scales comma manual_pal percent trans_breaks #' @importFrom ssddata gm_mean #' @importFrom stats coef complete.cases ks.test logLik nobs optim plogis predict qlogis runif sd setNames weighted.mean +#' @importFrom stats uniroot #' @importFrom stringr str_order #' @importFrom tibble as_tibble tibble #' @importFrom TMB MakeADFun sdreport diff --git a/tests/testthat/_snaps/hc-root.md b/tests/testthat/_snaps/hc-root.md new file mode 100644 index 00000000..6a5d257d --- /dev/null +++ b/tests/testthat/_snaps/hc-root.md @@ -0,0 +1,20 @@ +# hc root lnorm + + Code + hc_root + Output + # A tibble: 1 x 10 + dist percent est se lcl ucl wt method nboot pboot + + 1 average 5 1.68 NA NA NA 1 parametric 0 NA + +# hc root all + + Code + hc_root + Output + # A tibble: 1 x 10 + dist percent est se lcl ucl wt method nboot pboot + + 1 average 5 1.26 NA NA NA 1 parametric 0 NA + diff --git a/tests/testthat/test-hc-root.R b/tests/testthat/test-hc-root.R index c52a4929..af58827b 100644 --- a/tests/testthat/test-hc-root.R +++ b/tests/testthat/test-hc-root.R @@ -31,13 +31,28 @@ test_that("hc root lnorm", { skip_on_os("linux") # FIXME fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") set.seed(102) - expect_error(hc <- ssd_hc(fits, average = TRUE, root = TRUE)) + hc_dist <- ssd_hc(fits, average = FALSE) + hc_average <- ssd_hc(fits, average = TRUE) + hc_root <- ssd_hc(fits, average = TRUE, root = TRUE) + expect_identical(hc_average$est, hc_dist$est) + expect_equal(hc_root, hc_average, tolerance = 1e-6) + expect_equal(hc_average$est, 1.6811748398812, tolerance = 1e-6) + expect_equal(hc_root$est, 1.68117469404437, tolerance = 1e-6) + + testthat::expect_snapshot({ + hc_root + }) }) - -test_that("hc root lnorm llogis", { - skip_on_os("linux") # FIXME - fits <- ssd_fit_dists(ssddata::ccme_boron, dists = c("lnorm", "llogis")) +test_that("hc root all", { + skip_on_os("linux") + fits <- ssd_fit_dists(ssddata::ccme_boron) set.seed(102) - expect_error(hc <- ssd_hc(fits, average = TRUE, root = TRUE)) -}) \ No newline at end of file + hc_average <- ssd_hc(fits, average = TRUE) + hc_root <- ssd_hc(fits, average = TRUE, root = TRUE) + expect_equal(hc_root, hc_average, tolerance = 1e-1) + expect_equal(hc_root$est, 1.25677616485866, tolerance = 1e-6) + testthat::expect_snapshot({ + hc_root + }) +}) From b6a8c41892f588dc002feb55c2a9cb3772e746f1 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Fri, 20 Oct 2023 14:03:09 -0700 Subject: [PATCH 13/28] implemented hp root --- R/hc.R | 54 +++++++++++++++++----- R/hp.R | 85 ++++++++++++++++++++++++++++------- R/root.R | 29 +++++++++--- man/ssd_hp.Rd | 5 ++- tests/testthat/test-hc-root.R | 1 + tests/testthat/test-hp-root.R | 75 +++++++++++++++++++++++++++++++ 6 files changed, 215 insertions(+), 34 deletions(-) create mode 100644 tests/testthat/test-hp-root.R diff --git a/R/hc.R b/R/hc.R index 1268ab60..86fc99e7 100644 --- a/R/hc.R +++ b/R/hc.R @@ -105,8 +105,18 @@ no_ssd_hc <- function() { replace_min_pboot_na(hc, min_pboot) } -.ssd_hc_fitdists <- function(x, percent, ci, level, nboot, - average, min_pboot, parametric, root, control) { +.ssd_hc_fitdists <- function( + x, + percent, + ci, + level, + nboot, + average, + min_pboot, + parametric, + root, + control) { + if (!length(x) || !length(percent)) { return(no_ssd_hc()) } @@ -134,6 +144,7 @@ no_ssd_hc <- function() { wrn("Parametric CIs cannot be calculated for unequally weighted data.") ci <- FALSE } + if (!ci) { nboot <- 0L } @@ -148,8 +159,9 @@ no_ssd_hc <- function() { min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, parametric = parametric, control = control, .options = furrr::furrr_options(seed = seeds)) - hc <- dplyr::bind_rows(hcs) + hc <- dplyr::bind_rows(hcs) + method <- if (parametric) "parametric" else "non-parametric" return( @@ -211,7 +223,7 @@ ssd_hc.list <- function(x, percent = 5, ...) { chk_named(x) chk_unique(names(x)) chk_unused(...) - + if (!length(x)) { return(no_ssd_hc()) } @@ -224,10 +236,20 @@ ssd_hc.list <- function(x, percent = 5, ...) { #' @describeIn ssd_hc Hazard Concentrations for fitdists Object #' @export -ssd_hc.fitdists <- function(x, percent = 5, ci = FALSE, level = 0.95, nboot = 1000, - average = TRUE, delta = 7, min_pboot = 0.99, - parametric = TRUE, root = FALSE, - control = NULL, ...) { +ssd_hc.fitdists <- function( + x, + percent = 5, + ci = FALSE, + level = 0.95, + nboot = 1000, + average = TRUE, + delta = 7, + min_pboot = 0.99, + parametric = TRUE, + root = FALSE, + control = NULL, + ...) { + chk_vector(percent) chk_numeric(percent) chk_range(percent, c(0, 100)) @@ -245,11 +267,19 @@ ssd_hc.fitdists <- function(x, percent = 5, ci = FALSE, level = 0.95, nboot = 10 chk_flag(root) chk_null_or(control, vld = vld_list) chk_unused(...) - + x <- subset(x, delta = delta) - hc <- .ssd_hc_fitdists(x, percent, - ci = ci, level = level, nboot = nboot, min_pboot = min_pboot, control = control, - average = average, parametric = parametric, root = root + hc <- .ssd_hc_fitdists( + x, + percent, + ci = ci, + level = level, + nboot = nboot, + average = average, + min_pboot = min_pboot, + parametric = parametric, + root = root, + control = control ) warn_min_pboot(hc, min_pboot) } diff --git a/R/hp.R b/R/hp.R index 04ae2d04..56bab399 100644 --- a/R/hp.R +++ b/R/hp.R @@ -47,7 +47,7 @@ no_ssd_hp <- function() { .ssd_hp_tmbfit <- function(x, conc, ci, level, nboot, min_pboot, data, rescale, weighted, censoring, min_pmix, range_shape1, range_shape2, parametric, control) { - args <- estimates(x) + args <- estimates(x) #TODO: checkout estimates args$q <- conc / rescale dist <- .dist_tmbfit(x) what <- paste0("ssd_p", dist) @@ -92,8 +92,18 @@ no_ssd_hp <- function() { replace_min_pboot_na(hp, min_pboot) } -.ssd_hp_fitdists <- function(x, conc, ci, level, nboot, min_pboot, control, - parametric, average) { +.ssd_hp_fitdists <- function( + x, + conc, + ci, + level, + nboot, + average, + min_pboot, + parametric, + root, + control) { + if (!length(x) || !length(conc)) { return(no_ssd_hp()) } @@ -101,6 +111,7 @@ no_ssd_hp <- function() { if (is.null(control)) { control <- .control_fitdists(x) } + data <- .data_fitdists(x) rescale <- .rescale_fitdists(x) censoring <- .censoring_fitdists(x) @@ -109,18 +120,45 @@ no_ssd_hp <- function() { range_shape2 <- .range_shape2_fitdists(x) weighted <- .weighted_fitdists(x) unequal <- .unequal_fitdists(x) - + wt_est_nest <- wt_est_nest(x) + if (parametric && ci && identical(censoring, c(NA_real_, NA_real_))) { wrn("Parametric CIs cannot be calculated for inconsistently censored data.") ci <- FALSE } - if (ci && unequal) { + if (parametric && ci && unequal) { wrn("Parametric CIs cannot be calculated for unequally weighted data.") ci <- FALSE } - if (!ci) nboot <- 0L + if (!ci) { + nboot <- 0L + } + + if(root && average) { + seeds <- seed_streams(length(conc)) + hps <- future_map( + conc, .ssd_hp_root, + wt_est_nest = wt_est_nest, ci = ci, level = level, nboot = nboot, + min_pboot = min_pboot, + data = data, rescale = rescale, weighted = weighted, censoring = censoring, + min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, + parametric = parametric, control = control, + .options = furrr::furrr_options(seed = seeds)) + hp <- dplyr::bind_rows(hps) + + method <- if (parametric) "parametric" else "non-parametric" + + return( + tibble( + dist = "average", conc = conc, est = hp$est, se = hp$se, + lcl = hp$lcl, ucl = hp$ucl, wt = rep(1, length(conc)), + method = method, nboot = nboot, pboot = hp$pboot + ) + ) + } + seeds <- seed_streams(length(x)) hp <- future_map(x, .ssd_hp_tmbfit, @@ -131,7 +169,8 @@ no_ssd_hp <- function() { parametric = parametric, control = control, .options = furrr::furrr_options(seed = seeds) ) - weight <- glance(x)$weight + + weight <- wt_est_nest$weight if (!average) { hp <- mapply( function(x, y) { @@ -166,11 +205,20 @@ no_ssd_hp <- function() { #' @describeIn ssd_hp Hazard Percents for fitdists Object #' @export -ssd_hp.fitdists <- function(x, conc, ci = FALSE, level = 0.95, nboot = 1000, - average = TRUE, delta = 7, min_pboot = 0.99, - parametric = TRUE, - control = NULL, - ...) { +ssd_hp.fitdists <- function( + x, + conc = 1, + ci = FALSE, + level = 0.95, + nboot = 1000, + average = TRUE, + delta = 7, + min_pboot = 0.99, + parametric = TRUE, + root = FALSE, + control = NULL, + ...) { + chk_vector(conc) chk_numeric(conc) chk_flag(ci) @@ -184,14 +232,21 @@ ssd_hp.fitdists <- function(x, conc, ci = FALSE, level = 0.95, nboot = 1000, chk_number(min_pboot) chk_range(min_pboot) chk_flag(parametric) + chk_flag(root) chk_null_or(control, vld = vld_list) chk_unused(...) x <- subset(x, delta = delta) - hp <- .ssd_hp_fitdists(x, conc, - ci = ci, level = level, nboot = nboot, - average = average, min_pboot = min_pboot, + hp <- .ssd_hp_fitdists( + x, + conc, + ci = ci, + level = level, + nboot = nboot, + average = average, + min_pboot = min_pboot, parametric = parametric, + root = root, control = control ) warn_min_pboot(hp, min_pboot) diff --git a/R/root.R b/R/root.R index 2ffd7e23..be66cd46 100644 --- a/R/root.R +++ b/R/root.R @@ -37,11 +37,28 @@ ma_fun <- function(wt_est_nest, fun = "p") { eval(parse(text = func)) } -hc_interval <- function(p, data) { +hc_upper <- function(p, data) { right <- data$right[is.finite(data$right)] - left <- data$left[data$left > 0] - # TODO: improve bounds? - c(min(left) / 10, max(right) * 10) + # TODO: ensure safe upper bound - use p as well? + max(right) * 10 +} + +.ssd_hp_root <- function(conc, wt_est_nest, ci, level, nboot, min_pboot, + data, rescale, weighted, censoring, min_pmix, + range_shape1, range_shape2, parametric, control) { + + q <- conc/rescale + + f <- ma_fun(wt_est_nest, fun = "q") + root <- uniroot(f = f, q = q, lower = 0, upper = 1)$root + + tibble( + est = root * 100, + se = NA_real_, + lcl = NA_real_, + ucl = NA_real_, + pboot = NA_real_ + ) } .ssd_hc_root <- function(proportion, wt_est_nest, ci, level, nboot, min_pboot, @@ -49,8 +66,8 @@ hc_interval <- function(p, data) { range_shape1, range_shape2, parametric, control) { f <- ma_fun(wt_est_nest, fun = "p") - hc_interval <- hc_interval(proportion, data) - hc <- uniroot(f = f, p = proportion, interval = hc_interval)$root + hc_upper <- hc_upper(proportion, data) + hc <- uniroot(f = f, p = proportion, lower = 0, upper = hc_upper)$root tibble( est = hc * rescale, diff --git a/man/ssd_hp.Rd b/man/ssd_hp.Rd index cf923cf9..a4417d26 100644 --- a/man/ssd_hp.Rd +++ b/man/ssd_hp.Rd @@ -9,7 +9,7 @@ ssd_hp(x, ...) \method{ssd_hp}{fitdists}( x, - conc, + conc = 1, ci = FALSE, level = 0.95, nboot = 1000, @@ -17,6 +17,7 @@ ssd_hp(x, ...) delta = 7, min_pboot = 0.99, parametric = TRUE, + root = FALSE, control = NULL, ... ) @@ -43,6 +44,8 @@ in the sense of returning a likelihood.} \item{parametric}{A flag specifying whether to perform parametric as opposed to non-parametric bootstrapping.} +\item{root}{A flag specifying whether to calculate the value by finding the root.} + \item{control}{A list of control parameters passed to \code{\link[stats:optim]{stats::optim()}}.} } \value{ diff --git a/tests/testthat/test-hc-root.R b/tests/testthat/test-hc-root.R index af58827b..ed6633c4 100644 --- a/tests/testthat/test-hc-root.R +++ b/tests/testthat/test-hc-root.R @@ -51,6 +51,7 @@ test_that("hc root all", { hc_average <- ssd_hc(fits, average = TRUE) hc_root <- ssd_hc(fits, average = TRUE, root = TRUE) expect_equal(hc_root, hc_average, tolerance = 1e-1) + expect_equal(hc_average$est, 1.24151700389853, tolerance = 1e-6) expect_equal(hc_root$est, 1.25677616485866, tolerance = 1e-6) testthat::expect_snapshot({ hc_root diff --git a/tests/testthat/test-hp-root.R b/tests/testthat/test-hp-root.R new file mode 100644 index 00000000..2da3386b --- /dev/null +++ b/tests/testthat/test-hp-root.R @@ -0,0 +1,75 @@ +# Copyright 2023 Australian Government Department of +# Climate Change, Energy, the Environment and Water +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# https://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +# Copyright 2021 Province of British Columbia +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# https://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +test_that("hp root lnorm", { + skip_on_os("linux") # FIXME + fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") + set.seed(102) + hp_dist <- ssd_hp(fits, average = FALSE) + hp_average <- ssd_hp(fits, average = TRUE) + hp_root <- ssd_hp(fits, average = TRUE, root = TRUE) + expect_identical(hp_average$est, hp_dist$est) + expect_equal(hp_root, hp_average, tolerance = 1e-3) + expect_equal(hp_average$est, 1.9543030195088, tolerance = 1e-6) + expect_equal(hp_root$est, 1.95476926846743, tolerance = 1e-6) + + testthat::expect_snapshot({ + hp_root + }) +}) + +test_that("hp root all", { + skip_on_os("linux") + fits <- ssd_fit_dists(ssddata::ccme_boron) + set.seed(102) + hp_average <- ssd_hp(fits, average = TRUE) + hp_root <- ssd_hp(fits, average = TRUE, root = TRUE) + expect_equal(hp_root, hp_average, tolerance = 1e-2) + expect_equal(hp_average$est, 3.89879358571718, tolerance = 1e-6) + expect_equal(hp_root$est, 3.91103597328257, tolerance = 1e-6) + testthat::expect_snapshot({ + hp_root + }) +}) + +test_that("hp is hc", { + skip_on_os("linux") + fits <- ssd_fit_dists(ssddata::ccme_boron) + set.seed(102) + conc <- 1 + hp_root <- ssd_hp(fits, conc = 1, average = TRUE, root = TRUE) + hc_root <- ssd_hc(fits, percent = hp_root$est, average = TRUE, root = TRUE) + expect_equal(hc_root$est, conc, tolerance = 1e-2) + for(i in 1:100) { + hp_root <- ssd_hp(fits, conc = hc_root$est, average = TRUE, root = TRUE) + hc_root <- ssd_hc(fits, percent = hp_root$est, average = TRUE, root = TRUE) + } + skip("uniroot is biased...") + expect_equal(hc_root$est, conc, tolerance = 1e-2) +}) From c911e1d5ff15b1bade199b019f75a84f017744c7 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Wed, 25 Oct 2023 17:01:12 -0700 Subject: [PATCH 14/28] man --- man/comma_signif.Rd | 2 +- man/dlgumbel.Rd | 2 +- man/params.Rd | 172 ++++++++++++++++++------------------- man/predict.fitburrlioz.Rd | 4 +- man/predict.fitdists.Rd | 4 +- man/scale_colour_ssd.Rd | 2 + man/ssd_hc.Rd | 4 +- man/ssd_hc_bcanz.Rd | 4 +- man/ssd_hc_burrlioz.Rd | 4 +- man/ssd_hp.Rd | 4 +- man/ssd_p.Rd | 6 +- man/ssd_q.Rd | 6 +- man/ssd_r.Rd | 6 +- 13 files changed, 111 insertions(+), 109 deletions(-) diff --git a/man/comma_signif.Rd b/man/comma_signif.Rd index 7ecc7dd5..5e0d90d0 100644 --- a/man/comma_signif.Rd +++ b/man/comma_signif.Rd @@ -9,7 +9,7 @@ comma_signif(x, digits = 3, ...) \arguments{ \item{x}{A numeric vector to format.} -\item{digits}{A whole number specifying the number of significant figures} +\item{digits}{A whole number specifying the number of significant figures.} \item{...}{Additional arguments passed to \link[scales:comma]{scales::comma}.} } diff --git a/man/dlgumbel.Rd b/man/dlgumbel.Rd index 341fb7e4..d6e7fe1c 100644 --- a/man/dlgumbel.Rd +++ b/man/dlgumbel.Rd @@ -9,7 +9,7 @@ dlgumbel(x, locationlog = 0, scalelog = 1, log = FALSE) \arguments{ \item{x}{A numeric vector of values.} -\item{locationlog}{location on log scale parameter.} +\item{locationlog}{location on the log scale parameter.} \item{scalelog}{scale on log scale parameter.} diff --git a/man/params.Rd b/man/params.Rd index 258cf48f..1662acea 100644 --- a/man/params.Rd +++ b/man/params.Rd @@ -9,28 +9,7 @@ \item{at_boundary_ok}{A flag specifying whether a model with one or more parameters at the boundary should be considered to have converged (default = FALSE).} -\item{x}{The object.} - -\item{object}{The object.} - -\item{control}{A list of control parameters passed to \code{\link[stats:optim]{stats::optim()}}.} - -\item{chk}{A flag specifying whether to check the arguments.} - -\item{data}{A data frame.} - -\item{pred}{A data frame of the predictions.} - -\item{xlab}{A string of the x-axis label.} - -\item{ylab}{A string of the x-axis label.} - -\item{xbreaks}{The x-axis breaks as one of: -\itemize{ -\item \code{NULL} for no breaks -\item \code{waiver()} for the default breaks -\item A numeric vector of positions -}} +\item{average}{A flag specifying whether to model average the estimates.} \item{breaks}{A character vector} @@ -38,141 +17,162 @@ parameters at the boundary should be considered to have converged (default = FAL uncensored missing (0 and Inf) data in terms of the orders of magnitude relative to the extremes for non-missing values.} -\item{conc}{A numeric vector of concentrations.} +\item{chk}{A flag specifying whether to check the arguments.} -\item{digits}{A whole number specifying the number of significant figures} +\item{ci}{A flag specifying whether to estimate confidence intervals (by parametric bootstrapping).} -\item{percent}{A numeric vector of percentages.} +\item{color}{A string of the column in data for the color aesthetic.} -\item{pvalue}{A flag specifying whether to return p-values or the statistics (default) for the various tests.} +\item{computable}{A flag specifying whether to only return fits with numerically computable standard errors.} -\item{parametric}{A flag specifying whether to perform parametric as opposed to non-parametric bootstrapping.} +\item{conc}{A numeric vector of concentrations.} -\item{min_pmix}{A number between 0 and 0.5 specifying the minimum proportion in mixture models.} +\item{control}{A list of control parameters passed to \code{\link[stats:optim]{stats::optim()}}.} + +\item{data}{A data frame.} \item{delta}{A non-negative number specifying the maximum absolute Akaike Information-theoretic Criterion difference cutoff. Distributions with an absolute difference from the best model greater than the cutoff are excluded.} -\item{average}{A flag specifying whether to model average the estimates.} +\item{digits}{A whole number specifying the number of significant figures.} -\item{ci}{A flag specifying whether to estimate confidence intervals (by parametric bootstrapping).} +\item{dists}{A character vector of the distribution names.} -\item{nboot}{A count of the number of bootstrap samples to use to estimate the se and confidence limits. A value of 10000 is recommended for official guidelines.} +\item{hc}{A count between 1 and 99 indicating the percent hazard concentration (or NULL).} -\item{min_pboot}{A number of the minimum proportion of bootstrap samples that must successfully fit -in the sense of returning a likelihood.} +\item{label}{A string of the column in data with the labels.} -\item{level}{A number between 0 and 1 of the confidence level.} +\item{left}{A string of the column in data with the concentrations.} -\item{...}{Unused.} +\item{level}{A number between 0 and 1 of the confidence level.} -\item{q}{vector of quantiles.} +\item{linecolor}{A string of the column in pred to use for the line color.} -\item{p}{vector of probabilities.} +\item{linetype}{A string of the column in pred to use for the linetype.} -\item{n}{number of observations.} +\item{llocation}{location parameter on the log scale.} -\item{log}{logical; if TRUE, probabilities p are given as log(p).} +\item{location}{location parameter.} -\item{log.p}{logical; if TRUE, probabilities p are given as log(p).} +\item{locationlog}{location on the log scale parameter.} -\item{lower.tail}{logical; if TRUE (default), probabilities are \code{P[X <= x]},otherwise, \code{P[X > x]}.} +\item{locationlog1}{locationlog1 parameter.} -\item{location}{location parameter.} +\item{locationlog2}{locationlog2 parameter.} -\item{llocation}{location parameter on the log scale.} +\item{log}{logical; if TRUE, probabilities p are given as log(p).} -\item{scale}{scale parameter.} +\item{log.p}{logical; if TRUE, probabilities p are given as log(p).} \item{lscale}{scale parameter on the log scale.} -\item{shape1}{shape1 parameter.} +\item{lshape}{shape parameter on the log scale.} -\item{shape2}{shape2 parameter.} +\item{lshape1}{shape1 parameter on the log scale.} -\item{range_shape1}{A numeric vector of length two of the lower and upper bounds for the shape1 parameter.} +\item{lshape2}{shape2 parameter on the log scale.} -\item{range_shape2}{shape2 parameter.} +\item{lower.tail}{logical; if TRUE (default), probabilities are \code{P[X <= x]}, otherwise, \code{P[X > x]}.} -\item{locationlog1}{locationlog1 parameter.} +\item{meanlog}{mean on log scale parameter.} -\item{scalelog1}{scalelog1 parameter.} +\item{meanlog1}{mean on log scale parameter.} -\item{locationlog2}{locationlog2 parameter.} +\item{meanlog2}{mean on log scale parameter.} -\item{scalelog2}{scalelog2 parameter.} +\item{min_pboot}{A number of the minimum proportion of bootstrap samples that must successfully +fit in the sense of returning a likelihood.} -\item{pmix}{Proportion mixture parameter.} +\item{min_pmix}{A number between 0 and 0.5 specifying the minimum proportion in mixture models.} -\item{meanlog}{mean on log scale parameter.} +\item{na.rm}{A flag specifying whether to silently remove missing values or +remove them with a warning.} -\item{meanlog1}{mean on log scale parameter.} +\item{n}{positive number of observations.} -\item{meanlog2}{mean on log scale parameter.} +\item{nboot}{A count of the number of bootstrap samples to use to estimate the se and confidence limits. A value of 10000 is recommended for official guidelines.} -\item{locationlog}{location on log scale parameter.} +\item{nrow}{A positive whole number of the minimum number of non-missing rows.} -\item{sdlog}{standard deviation on log scale parameter.} +\item{nsim}{A positive whole number of the number of simulations to generate.} -\item{sdlog1}{standard deviation on log scale parameter.} +\item{object}{The object.} -\item{sdlog2}{standard deviation on log scale parameter.} +\item{parametric}{A flag specifying whether to perform parametric as opposed to non-parametric bootstrapping.} -\item{scalelog}{scale on log scale parameter.} +\item{p}{vector of probabilities.} -\item{lshape}{shape parameter on the log scale.} +\item{percent}{A numeric vector of percentages.} -\item{lshape1}{shape1 parameter on the log scale.} +\item{pmix}{Proportion mixture parameter.} -\item{lshape2}{shape2 parameter on the log scale.} +\item{pvalue}{A flag specifying whether to return p-values or the statistics (default) for the various tests.} -\item{xintercept}{The x-value for the intersect} +\item{pred}{A data frame of the predictions.} -\item{yintercept}{The y-value for the intersect.} +\item{q}{vector of quantiles.} -\item{select}{A character vector of the distributions to select.} +\item{range_shape1}{A numeric vector of length two of the lower and upper bounds for the shape1 parameter.} -\item{rescale}{A flag specifying whether to rescale concentration values by dividing by the largest finite value.} +\item{range_shape2}{shape2 parameter.} \item{reweight}{A flag specifying whether to reweight weights by dividing by the largest weight.} -\item{left}{A string of the column in data with the concentrations.} +\item{rescale}{A flag specifying whether to rescale concentration values by dividing by the largest finite value.} + +\item{ribbon}{A flag indicating whether to plot the confidence interval as a grey ribbon as opposed to green solid lines.} \item{right}{A string of the column in data with the right concentration values.} -\item{label}{A string of the column in data with the labels.} +\item{root}{A flag specifying whether to calculate the value by finding the root.} -\item{shape}{A string of the column in data for the shape aesthetic.} +\item{scale}{scale parameter.} -\item{color}{A string of the column in data for the color aesthetic.} +\item{scalelog1}{scalelog1 parameter.} -\item{size}{A number for the size of the labels.} +\item{scalelog2}{scalelog2 parameter.} -\item{ribbon}{A flag indicating whether to plot the confidence interval as a grey ribbon as opposed to green solid lines.} +\item{scalelog}{scale on log scale parameter.} -\item{shift_x}{The value to multiply the label x values by.} +\item{sdlog}{standard deviation on log scale parameter.} -\item{hc}{A count between 1 and 99 indicating the percent hazard concentration (or NULL).} +\item{sdlog1}{standard deviation on log scale parameter.} -\item{weight}{A string of the numeric column in data with positive weights less than or equal to 1,000 or NULL.} +\item{sdlog2}{standard deviation on log scale parameter.} -\item{dists}{A character vector of the distribution names.} +\item{select}{A character vector of the distributions to select.} -\item{computable}{A flag specifying whether to only return fits with numerically computable standard errors.} +\item{shape}{shape parameter.} + +\item{shape1}{shape1 parameter.} + +\item{shape2}{shape2 parameter.} + +\item{shift_x}{The value to multiply the label x values by.} \item{silent}{A flag indicating whether fits should fail silently.} -\item{na.rm}{A flag specifying whether to silently remove missing values or -remove them with a warning.} +\item{size}{A number for the size of the labels.} -\item{nrow}{A positive whole number of the minimum number of non-missing rows.} +\item{weight}{A string of the numeric column in data with positive weights less than or equal to 1,000 or NULL.} -\item{nsim}{A positive whole number of the number of simulations to generate.} +\item{x}{The object.} -\item{linetype}{A string of the column in pred to use for the linetype.} +\item{xbreaks}{The x-axis breaks as one of: +\itemize{ +\item \code{NULL} for no breaks +\item \code{waiver()} for the default breaks +\item A numeric vector of positions +}} -\item{linecolor}{A string of the column in pred to use for the line color.} +\item{xintercept}{The x-value for the intersect} -\item{root}{A flag specifying whether to calculate the value by finding the root.} +\item{xlab}{A string of the x-axis label.} + +\item{yintercept}{The y-value for the intersect.} + +\item{ylab}{A string of the x-axis label.} + +\item{...}{Unused.} } \description{ Parameter Descriptions for ssdtools Functions diff --git a/man/predict.fitburrlioz.Rd b/man/predict.fitburrlioz.Rd index f819a0e0..2a3d5fce 100644 --- a/man/predict.fitburrlioz.Rd +++ b/man/predict.fitburrlioz.Rd @@ -26,8 +26,8 @@ \item{nboot}{A count of the number of bootstrap samples to use to estimate the se and confidence limits. A value of 10000 is recommended for official guidelines.} -\item{min_pboot}{A number of the minimum proportion of bootstrap samples that must successfully fit -in the sense of returning a likelihood.} +\item{min_pboot}{A number of the minimum proportion of bootstrap samples that must successfully +fit in the sense of returning a likelihood.} \item{parametric}{A flag specifying whether to perform parametric as opposed to non-parametric bootstrapping.} diff --git a/man/predict.fitdists.Rd b/man/predict.fitdists.Rd index 31a0bedc..25a60a96 100644 --- a/man/predict.fitdists.Rd +++ b/man/predict.fitdists.Rd @@ -34,8 +34,8 @@ \item{delta}{A non-negative number specifying the maximum absolute Akaike Information-theoretic Criterion difference cutoff. Distributions with an absolute difference from the best model greater than the cutoff are excluded.} -\item{min_pboot}{A number of the minimum proportion of bootstrap samples that must successfully fit -in the sense of returning a likelihood.} +\item{min_pboot}{A number of the minimum proportion of bootstrap samples that must successfully +fit in the sense of returning a likelihood.} \item{parametric}{A flag specifying whether to perform parametric as opposed to non-parametric bootstrapping.} diff --git a/man/scale_colour_ssd.Rd b/man/scale_colour_ssd.Rd index dcf56a16..ebdf1947 100644 --- a/man/scale_colour_ssd.Rd +++ b/man/scale_colour_ssd.Rd @@ -11,6 +11,8 @@ scale_color_ssd(...) } \arguments{ \item{...}{Arguments passed to \code{\link[ggplot2:discrete_scale]{ggplot2::discrete_scale()}}.} + +\item{shape}{A string of the column in data for the shape aesthetic.} } \description{ Discrete color-blind scale for SSD Plots diff --git a/man/ssd_hc.Rd b/man/ssd_hc.Rd index b4c823b1..9bdc4845 100644 --- a/man/ssd_hc.Rd +++ b/man/ssd_hc.Rd @@ -54,8 +54,8 @@ ssd_hc(x, ...) \item{delta}{A non-negative number specifying the maximum absolute Akaike Information-theoretic Criterion difference cutoff. Distributions with an absolute difference from the best model greater than the cutoff are excluded.} -\item{min_pboot}{A number of the minimum proportion of bootstrap samples that must successfully fit -in the sense of returning a likelihood.} +\item{min_pboot}{A number of the minimum proportion of bootstrap samples that must successfully +fit in the sense of returning a likelihood.} \item{parametric}{A flag specifying whether to perform parametric as opposed to non-parametric bootstrapping.} diff --git a/man/ssd_hc_bcanz.Rd b/man/ssd_hc_bcanz.Rd index 387beb34..4494514b 100644 --- a/man/ssd_hc_bcanz.Rd +++ b/man/ssd_hc_bcanz.Rd @@ -13,8 +13,8 @@ ssd_hc_bcanz(x, nboot = 10000, delta = 10, min_pboot = 0.9) \item{delta}{A non-negative number specifying the maximum absolute Akaike Information-theoretic Criterion difference cutoff. Distributions with an absolute difference from the best model greater than the cutoff are excluded.} -\item{min_pboot}{A number of the minimum proportion of bootstrap samples that must successfully fit -in the sense of returning a likelihood.} +\item{min_pboot}{A number of the minimum proportion of bootstrap samples that must successfully +fit in the sense of returning a likelihood.} } \value{ A tibble of corresponding hazard concentrations. diff --git a/man/ssd_hc_burrlioz.Rd b/man/ssd_hc_burrlioz.Rd index f6e9853d..7a403e0e 100644 --- a/man/ssd_hc_burrlioz.Rd +++ b/man/ssd_hc_burrlioz.Rd @@ -25,8 +25,8 @@ ssd_hc_burrlioz( \item{nboot}{A count of the number of bootstrap samples to use to estimate the se and confidence limits. A value of 10000 is recommended for official guidelines.} -\item{min_pboot}{A number of the minimum proportion of bootstrap samples that must successfully fit -in the sense of returning a likelihood.} +\item{min_pboot}{A number of the minimum proportion of bootstrap samples that must successfully +fit in the sense of returning a likelihood.} \item{parametric}{A flag specifying whether to perform parametric as opposed to non-parametric bootstrapping.} } diff --git a/man/ssd_hp.Rd b/man/ssd_hp.Rd index a4417d26..676f8c9a 100644 --- a/man/ssd_hp.Rd +++ b/man/ssd_hp.Rd @@ -39,8 +39,8 @@ ssd_hp(x, ...) \item{delta}{A non-negative number specifying the maximum absolute Akaike Information-theoretic Criterion difference cutoff. Distributions with an absolute difference from the best model greater than the cutoff are excluded.} -\item{min_pboot}{A number of the minimum proportion of bootstrap samples that must successfully fit -in the sense of returning a likelihood.} +\item{min_pboot}{A number of the minimum proportion of bootstrap samples that must successfully +fit in the sense of returning a likelihood.} \item{parametric}{A flag specifying whether to perform parametric as opposed to non-parametric bootstrapping.} diff --git a/man/ssd_p.Rd b/man/ssd_p.Rd index 008154c5..ba31c306 100644 --- a/man/ssd_p.Rd +++ b/man/ssd_p.Rd @@ -82,11 +82,11 @@ ssd_pweibull(q, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) \item{scale}{scale parameter.} -\item{lower.tail}{logical; if TRUE (default), probabilities are \code{P[X <= x]},otherwise, \code{P[X > x]}.} +\item{lower.tail}{logical; if TRUE (default), probabilities are \code{P[X <= x]}, otherwise, \code{P[X > x]}.} \item{log.p}{logical; if TRUE, probabilities p are given as log(p).} -\item{shape}{A string of the column in data for the shape aesthetic.} +\item{shape}{shape parameter.} \item{location}{location parameter.} @@ -94,7 +94,7 @@ ssd_pweibull(q, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) \item{lshape}{shape parameter on the log scale.} -\item{locationlog}{location on log scale parameter.} +\item{locationlog}{location on the log scale parameter.} \item{scalelog}{scale on log scale parameter.} diff --git a/man/ssd_q.Rd b/man/ssd_q.Rd index 7115ba10..a8ccf77b 100644 --- a/man/ssd_q.Rd +++ b/man/ssd_q.Rd @@ -82,11 +82,11 @@ ssd_qweibull(p, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) \item{scale}{scale parameter.} -\item{lower.tail}{logical; if TRUE (default), probabilities are \code{P[X <= x]},otherwise, \code{P[X > x]}.} +\item{lower.tail}{logical; if TRUE (default), probabilities are \code{P[X <= x]}, otherwise, \code{P[X > x]}.} \item{log.p}{logical; if TRUE, probabilities p are given as log(p).} -\item{shape}{A string of the column in data for the shape aesthetic.} +\item{shape}{shape parameter.} \item{location}{location parameter.} @@ -94,7 +94,7 @@ ssd_qweibull(p, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) \item{lshape}{shape parameter on the log scale.} -\item{locationlog}{location on log scale parameter.} +\item{locationlog}{location on the log scale parameter.} \item{scalelog}{scale on log scale parameter.} diff --git a/man/ssd_r.Rd b/man/ssd_r.Rd index f44a1329..67c4a5ed 100644 --- a/man/ssd_r.Rd +++ b/man/ssd_r.Rd @@ -59,7 +59,7 @@ ssd_rlnorm(n, meanlog = 0, sdlog = 1, chk = TRUE) ssd_rweibull(n, shape = 1, scale = 1, chk = TRUE) } \arguments{ -\item{n}{number of observations.} +\item{n}{positive number of observations.} \item{shape1}{shape1 parameter.} @@ -69,7 +69,7 @@ ssd_rweibull(n, shape = 1, scale = 1, chk = TRUE) \item{chk}{A flag specifying whether to check the arguments.} -\item{shape}{A string of the column in data for the shape aesthetic.} +\item{shape}{shape parameter.} \item{location}{location parameter.} @@ -77,7 +77,7 @@ ssd_rweibull(n, shape = 1, scale = 1, chk = TRUE) \item{lshape}{shape parameter on the log scale.} -\item{locationlog}{location on log scale parameter.} +\item{locationlog}{location on the log scale parameter.} \item{scalelog}{scale on log scale parameter.} From 870b191198dae10da6455fa2d25c6f9f8898e8db Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Wed, 25 Oct 2023 17:07:29 -0700 Subject: [PATCH 15/28] fix man --- R/ggplot.R | 1 - man/scale_colour_ssd.Rd | 2 -- 2 files changed, 3 deletions(-) diff --git a/R/ggplot.R b/R/ggplot.R index 5e8486fe..b1586a3d 100644 --- a/R/ggplot.R +++ b/R/ggplot.R @@ -32,7 +32,6 @@ ssd_pal <- function() { #' Discrete color-blind scale for SSD Plots #' #' @param ... Arguments passed to [ggplot2::discrete_scale()]. -#' @param shape A string of the column in data for the shape aesthetic. #' @family ggplot #' @export #' @examples diff --git a/man/scale_colour_ssd.Rd b/man/scale_colour_ssd.Rd index ebdf1947..dcf56a16 100644 --- a/man/scale_colour_ssd.Rd +++ b/man/scale_colour_ssd.Rd @@ -11,8 +11,6 @@ scale_color_ssd(...) } \arguments{ \item{...}{Arguments passed to \code{\link[ggplot2:discrete_scale]{ggplot2::discrete_scale()}}.} - -\item{shape}{A string of the column in data for the shape aesthetic.} } \description{ Discrete color-blind scale for SSD Plots From 825e24ce9884b3ee0117bfa74b9e0d40da6a3090 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Wed, 25 Oct 2023 17:27:24 -0700 Subject: [PATCH 16/28] more tests --- tests/testthat/test-hp-root.R | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-hp-root.R b/tests/testthat/test-hp-root.R index 2da3386b..d5e596b1 100644 --- a/tests/testthat/test-hp-root.R +++ b/tests/testthat/test-hp-root.R @@ -61,9 +61,23 @@ test_that("hp root all", { test_that("hp is hc", { skip_on_os("linux") fits <- ssd_fit_dists(ssddata::ccme_boron) - set.seed(102) conc <- 1 - hp_root <- ssd_hp(fits, conc = 1, average = TRUE, root = TRUE) + hp_root <- ssd_hp(fits, conc = conc, average = TRUE, root = TRUE) + hc_root <- ssd_hc(fits, percent = hp_root$est, average = TRUE, root = TRUE) + expect_equal(hc_root$est, conc, tolerance = 1e-2) + for(i in 1:100) { + hp_root <- ssd_hp(fits, conc = hc_root$est, average = TRUE, root = TRUE) + hc_root <- ssd_hc(fits, percent = hp_root$est, average = TRUE, root = TRUE) + } + skip("uniroot is biased...") + expect_equal(hc_root$est, conc, tolerance = 1e-2) +}) + +test_that("hp is hc 10", { + skip_on_os("linux") + fits <- ssd_fit_dists(ssddata::ccme_boron) + conc <- 10 + hp_root <- ssd_hp(fits, conc = conc, average = TRUE, root = TRUE) hc_root <- ssd_hc(fits, percent = hp_root$est, average = TRUE, root = TRUE) expect_equal(hc_root$est, conc, tolerance = 1e-2) for(i in 1:100) { From 8bfe8b889628452130f39b9809a60eb136410bd2 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Wed, 25 Oct 2023 17:28:38 -0700 Subject: [PATCH 17/28] notes --- tests/testthat/test-hp-root.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/testthat/test-hp-root.R b/tests/testthat/test-hp-root.R index d5e596b1..eedc609f 100644 --- a/tests/testthat/test-hp-root.R +++ b/tests/testthat/test-hp-root.R @@ -73,6 +73,8 @@ test_that("hp is hc", { expect_equal(hc_root$est, conc, tolerance = 1e-2) }) +# FIXME: move to root tests +# FIXME: also test actual values as seem deterministic test_that("hp is hc 10", { skip_on_os("linux") fits <- ssd_fit_dists(ssddata::ccme_boron) From 40086ec99ac013e0b33b1f76521ff6c765db1464 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Sun, 5 Nov 2023 17:51:58 -0800 Subject: [PATCH 18/28] - Added `ssd_pcombo()` and `ssd_qcombo()`. --- NAMESPACE | 2 ++ R/combo.R | 58 ++++++++++++++++++++++++++++++++ R/params.R | 3 ++ R/root.R | 15 ++++----- R/wt-est.R | 52 ++++++++++++++++++++++++++++ man/params.Rd | 4 +++ man/ssd_p.Rd | 16 +++++++-- man/ssd_q.Rd | 19 +++++++++-- man/ssd_r.Rd | 16 +++++++-- tests/testthat/_snaps/hp-root.md | 20 +++++++++++ tests/testthat/test-combo.R | 19 +++++++++++ 11 files changed, 206 insertions(+), 18 deletions(-) create mode 100644 R/combo.R create mode 100644 R/wt-est.R create mode 100644 tests/testthat/_snaps/hp-root.md create mode 100644 tests/testthat/test-combo.R diff --git a/NAMESPACE b/NAMESPACE index 3776a9f6..4d497332 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -85,6 +85,7 @@ export(ssd_is_censored) export(ssd_match_moments) export(ssd_pal) export(ssd_pburrIII3) +export(ssd_pcombo) export(ssd_pgamma) export(ssd_pgompertz) export(ssd_pinvpareto) @@ -99,6 +100,7 @@ export(ssd_plot_cf) export(ssd_plot_data) export(ssd_pweibull) export(ssd_qburrIII3) +export(ssd_qcombo) export(ssd_qgamma) export(ssd_qgompertz) export(ssd_qinvpareto) diff --git a/R/combo.R b/R/combo.R new file mode 100644 index 00000000..b7da6c7f --- /dev/null +++ b/R/combo.R @@ -0,0 +1,58 @@ +# Copyright 2023 Australian Government Department of +# Climate Change, Energy, the Environment and Water +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# https://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +#' @describeIn ssd_p Cumulative Distribution Function for +#' Weighted Combination of Distributions +#' @export +# FIXME: needs example +ssd_pcombo <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { + chk_numeric(q) + chk_vector(q) + + check_wt_est(wt_est) + chk_flag(lower.tail) + chk_flag(log.p) + + if (!length(q)) { + return(numeric(0)) + } + + f <- ma_fun(wt_est, fun = "q") + root <- uniroot(f = f, q = q, lower = 0, upper = 1)$root + root +} + +#' @describeIn ssd_q Quantile Function for +#' Weighted Combination of Distributions +#' @param upper_q A number specifying the possible upper limit of the cumulative +#' distribution. +#' @export +# FIXME: needs example +ssd_qcombo <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) { + chk_numeric(p) + chk_vector(p) + + check_wt_est(wt_est) + chk_flag(lower.tail) + chk_flag(log.p) + + if (!length(p)) { + return(numeric(0)) + } + + f <- ma_fun(wt_est, fun = "p") + root <- uniroot(f = f, p = p, lower = 0, upper = upper_q)$root + root +} diff --git a/R/params.R b/R/params.R index 97926d18..2b1bad2a 100644 --- a/R/params.R +++ b/R/params.R @@ -104,6 +104,9 @@ #' @param linetype A string of the column in pred to use for the linetype. #' @param linecolor A string of the column in pred to use for the line color. #' @param root A flag specifying whether to calculate the value by finding the root. +#' @param wt_est A data frame with dist, wt, and est columns specifying the +#' distributions, weights and a list column of estimate data frames with +#' term and est columns specifying the estimated value for each parameter. #' @keywords internal #' @name params NULL diff --git a/R/root.R b/R/root.R index be66cd46..7a5be02d 100644 --- a/R/root.R +++ b/R/root.R @@ -48,12 +48,10 @@ hc_upper <- function(p, data) { range_shape1, range_shape2, parametric, control) { q <- conc/rescale - - f <- ma_fun(wt_est_nest, fun = "q") - root <- uniroot(f = f, q = q, lower = 0, upper = 1)$root - + p <- ssd_pcombo(q, wt_est_nest) + tibble( - est = root * 100, + est = p * 100, se = NA_real_, lcl = NA_real_, ucl = NA_real_, @@ -65,12 +63,11 @@ hc_upper <- function(p, data) { data, rescale, weighted, censoring, min_pmix, range_shape1, range_shape2, parametric, control) { - f <- ma_fun(wt_est_nest, fun = "p") hc_upper <- hc_upper(proportion, data) - hc <- uniroot(f = f, p = proportion, lower = 0, upper = hc_upper)$root - + q <- ssd_qcombo(proportion, wt_est_nest, upper_q = hc_upper) + tibble( - est = hc * rescale, + est = q * rescale, se = NA_real_, lcl = NA_real_, ucl = NA_real_, diff --git a/R/wt-est.R b/R/wt-est.R new file mode 100644 index 00000000..3db266f8 --- /dev/null +++ b/R/wt-est.R @@ -0,0 +1,52 @@ +# Copyright 2023 Australian Government Department of +# Climate Change, Energy, the Environment and Water +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# https://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +check_est <- function(x, x_name = NULL) { + if (is.null(x_name)) x_name <- deparse_backtick_chk((substitute(x))) + + chk_data(x) + check_names(x, c("term", "est")) + + chk_character(x$term) + chk_not_any_na(x$term) + chk_unique(x$term) + + chk_numeric(x$est) + chk_not_any_na(x$est) + + invisible(x) +} + +check_wt_est <- function(x, x_name = NULL) { + if (is.null(x_name)) x_name <- deparse_backtick_chk((substitute(x))) + + chk_data(x) + # FIXME: switch data to est and possibly weight to wt + # FIXME: switch term to par or param + check_names(x, c("dist", "weight", "data")) + + chk_character(x$dist) + chk_not_any_na(x$dist) + chk_unique(x$dist) + chk_subset(x$dist, ssd_dists_all()) + + chk_numeric(x$weight) + chk_not_any_na(x$weight) + chk_range(x$weight, c(0,1)) + + chk_list(x$data) + chk_all(x$data, chk_fun = check_est) + invisible(x) +} diff --git a/man/params.Rd b/man/params.Rd index 258cf48f..cc486f5a 100644 --- a/man/params.Rd +++ b/man/params.Rd @@ -173,6 +173,10 @@ remove them with a warning.} \item{linecolor}{A string of the column in pred to use for the line color.} \item{root}{A flag specifying whether to calculate the value by finding the root.} + +\item{wt_est}{A data frame with dist, wt, and est columns specifying the +distributions, weights and a list column of estimate data frames with +term and est columns specifying the estimated value for each parameter.} } \description{ Parameter Descriptions for ssdtools Functions diff --git a/man/ssd_p.Rd b/man/ssd_p.Rd index 008154c5..a2c7410f 100644 --- a/man/ssd_p.Rd +++ b/man/ssd_p.Rd @@ -1,9 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/burrrIII3.R, R/gamma.R, R/gompertz.R, -% R/invpareto.R, R/lgumbel.R, R/llogis-llogis.R, R/llogis.R, R/lnorm-lnorm.R, -% R/lnorm.R, R/pqr.R, R/weibull.R +% Please edit documentation in R/burrrIII3.R, R/combo.R, R/gamma.R, +% R/gompertz.R, R/invpareto.R, R/lgumbel.R, R/llogis-llogis.R, R/llogis.R, +% R/lnorm-lnorm.R, R/lnorm.R, R/pqr.R, R/weibull.R \name{ssd_pburrIII3} \alias{ssd_pburrIII3} +\alias{ssd_pcombo} \alias{ssd_pgamma} \alias{ssd_pgompertz} \alias{pgompertz} @@ -27,6 +28,8 @@ ssd_pburrIII3( log.p = FALSE ) +ssd_pcombo(q, wt_est, lower.tail = TRUE, log.p = FALSE) + ssd_pgamma(q, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) ssd_pgompertz(q, location = 1, shape = 1, lower.tail = TRUE, log.p = FALSE) @@ -86,6 +89,10 @@ ssd_pweibull(q, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) \item{log.p}{logical; if TRUE, probabilities p are given as log(p).} +\item{wt_est}{A data frame with dist, wt, and est columns specifying the +distributions, weights and a list column of estimate data frames with +term and est columns specifying the estimated value for each parameter.} + \item{shape}{A string of the column in data for the shape aesthetic.} \item{location}{location parameter.} @@ -127,6 +134,9 @@ Cumulative Distribution Function \itemize{ \item \code{ssd_pburrIII3()}: Cumulative Distribution Function for BurrIII Distribution +\item \code{ssd_pcombo()}: Cumulative Distribution Function for +Weighted Combination of Distributions + \item \code{ssd_pgamma()}: Cumulative Distribution Function for Gamma Distribution \item \code{ssd_pgompertz()}: Cumulative Distribution Function for Gompertz Distribution diff --git a/man/ssd_q.Rd b/man/ssd_q.Rd index 7115ba10..5d40d377 100644 --- a/man/ssd_q.Rd +++ b/man/ssd_q.Rd @@ -1,9 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/burrrIII3.R, R/gamma.R, R/gompertz.R, -% R/invpareto.R, R/lgumbel.R, R/llogis-llogis.R, R/llogis.R, R/lnorm-lnorm.R, -% R/lnorm.R, R/pqr.R, R/weibull.R +% Please edit documentation in R/burrrIII3.R, R/combo.R, R/gamma.R, +% R/gompertz.R, R/invpareto.R, R/lgumbel.R, R/llogis-llogis.R, R/llogis.R, +% R/lnorm-lnorm.R, R/lnorm.R, R/pqr.R, R/weibull.R \name{ssd_qburrIII3} \alias{ssd_qburrIII3} +\alias{ssd_qcombo} \alias{ssd_qgamma} \alias{ssd_qgompertz} \alias{qgompertz} @@ -27,6 +28,8 @@ ssd_qburrIII3( log.p = FALSE ) +ssd_qcombo(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) + ssd_qgamma(p, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) ssd_qgompertz(p, location = 1, shape = 1, lower.tail = TRUE, log.p = FALSE) @@ -86,6 +89,13 @@ ssd_qweibull(p, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) \item{log.p}{logical; if TRUE, probabilities p are given as log(p).} +\item{wt_est}{A data frame with dist, wt, and est columns specifying the +distributions, weights and a list column of estimate data frames with +term and est columns specifying the estimated value for each parameter.} + +\item{upper_q}{A number specifying the possible upper limit of the cumulative +distribution.} + \item{shape}{A string of the column in data for the shape aesthetic.} \item{location}{location parameter.} @@ -127,6 +137,9 @@ Quantile Function \itemize{ \item \code{ssd_qburrIII3()}: Quantile Function for BurrIII Distribution +\item \code{ssd_qcombo()}: Quantile Function for +Weighted Combination of Distributions + \item \code{ssd_qgamma()}: Quantile Function for Gamma Distribution \item \code{ssd_qgompertz()}: Quantile Function for Gompertz Distribution diff --git a/man/ssd_r.Rd b/man/ssd_r.Rd index f44a1329..d4632b97 100644 --- a/man/ssd_r.Rd +++ b/man/ssd_r.Rd @@ -1,9 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/burrrIII3.R, R/gamma.R, R/gompertz.R, -% R/invpareto.R, R/lgumbel.R, R/llogis-llogis.R, R/llogis.R, R/lnorm-lnorm.R, -% R/lnorm.R, R/pqr.R, R/weibull.R +% Please edit documentation in R/burrrIII3.R, R/combo.R, R/gamma.R, +% R/gompertz.R, R/invpareto.R, R/lgumbel.R, R/llogis-llogis.R, R/llogis.R, +% R/lnorm-lnorm.R, R/lnorm.R, R/pqr.R, R/weibull.R \name{ssd_rburrIII3} \alias{ssd_rburrIII3} +\alias{ssd_rcombo} \alias{ssd_rgamma} \alias{ssd_rgompertz} \alias{rgompertz} @@ -20,6 +21,8 @@ \usage{ ssd_rburrIII3(n, shape1 = 1, shape2 = 1, scale = 1, chk = TRUE) +ssd_rcombo(n, wt_est, chk = TRUE) + ssd_rgamma(n, shape = 1, scale = 1, chk = TRUE) ssd_rgompertz(n, location = 1, shape = 1, chk = TRUE) @@ -69,6 +72,10 @@ ssd_rweibull(n, shape = 1, scale = 1, chk = TRUE) \item{chk}{A flag specifying whether to check the arguments.} +\item{wt_est}{A data frame with dist, wt, and est columns specifying the +distributions, weights and a list column of estimate data frames with +term and est columns specifying the estimated value for each parameter.} + \item{shape}{A string of the column in data for the shape aesthetic.} \item{location}{location parameter.} @@ -110,6 +117,9 @@ Random Number Generation \itemize{ \item \code{ssd_rburrIII3()}: Random Generation for BurrIII Distribution +\item \code{ssd_rcombo()}: Random Generation for +Weighted Combination of Distributions + \item \code{ssd_rgamma()}: Random Generation for Gamma Distribution \item \code{ssd_rgompertz()}: Random Generation for Gompertz Distribution diff --git a/tests/testthat/_snaps/hp-root.md b/tests/testthat/_snaps/hp-root.md new file mode 100644 index 00000000..14987a58 --- /dev/null +++ b/tests/testthat/_snaps/hp-root.md @@ -0,0 +1,20 @@ +# hp root lnorm + + Code + hp_root + Output + # A tibble: 1 x 10 + dist conc est se lcl ucl wt method nboot pboot + + 1 average 1 1.95 NA NA NA 1 parametric 0 NA + +# hp root all + + Code + hp_root + Output + # A tibble: 1 x 10 + dist conc est se lcl ucl wt method nboot pboot + + 1 average 1 3.91 NA NA NA 1 parametric 0 NA + diff --git a/tests/testthat/test-combo.R b/tests/testthat/test-combo.R new file mode 100644 index 00000000..884c7d9b --- /dev/null +++ b/tests/testthat/test-combo.R @@ -0,0 +1,19 @@ +test_that("wt_est_nest works", { + fit <- ssd_fit_dists(data = ssddata::ccme_boron) + wt_est <- wt_est_nest(fit) + expect_identical(check_wt_est(wt_est), wt_est) +}) + +test_that("ssd_pcombo", { + fit <- ssd_fit_dists(data = ssddata::ccme_boron) + wt_est <- wt_est_nest(fit) + expect_equal(ssd_pcombo(1, wt_est), 0.0391103597328257) + expect_equal(ssd_pcombo(numeric(0), wt_est), numeric(0)) +}) + +test_that("ssd_qcombo", { + fit <- ssd_fit_dists(data = ssddata::ccme_boron) + wt_est <- wt_est_nest(fit) + expect_equal(ssd_qcombo(0.5, wt_est, upper = 100), 15.3258287163047) + expect_equal(ssd_qcombo(numeric(0), wt_est), numeric(0)) +}) From 287bc252e1d4936ec70b1505042e5de1bdfe37a4 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Sun, 5 Nov 2023 18:10:51 -0800 Subject: [PATCH 19/28] - Added `ssd_rcombo()` --- NAMESPACE | 1 + R/combo.R | 14 ++++++++++---- R/params.R | 2 ++ man/params.Rd | 3 +++ man/ssd_r.Rd | 5 ++++- tests/testthat/test-combo.R | 12 ++++++++++-- 6 files changed, 30 insertions(+), 7 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 4d497332..3faca775 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -111,6 +111,7 @@ export(ssd_qlnorm) export(ssd_qlnorm_lnorm) export(ssd_qweibull) export(ssd_rburrIII3) +export(ssd_rcombo) export(ssd_rgamma) export(ssd_rgompertz) export(ssd_rinvpareto) diff --git a/R/combo.R b/R/combo.R index b7da6c7f..6adb3494 100644 --- a/R/combo.R +++ b/R/combo.R @@ -16,7 +16,6 @@ #' @describeIn ssd_p Cumulative Distribution Function for #' Weighted Combination of Distributions #' @export -# FIXME: needs example ssd_pcombo <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { chk_numeric(q) chk_vector(q) @@ -36,10 +35,7 @@ ssd_pcombo <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { #' @describeIn ssd_q Quantile Function for #' Weighted Combination of Distributions -#' @param upper_q A number specifying the possible upper limit of the cumulative -#' distribution. #' @export -# FIXME: needs example ssd_qcombo <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) { chk_numeric(p) chk_vector(p) @@ -56,3 +52,13 @@ ssd_qcombo <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) root <- uniroot(f = f, p = p, lower = 0, upper = upper_q)$root root } + +#' @describeIn ssd_r Random Generation for +#' Weighted Combination of Distributions +#' @export +ssd_rcombo <- function(n, wt_est, upper_q = 1) { + chk_count(n) + if(n == 0L) return(numeric(0)) + p <- runif(n) + ssd_qcombo(p, wt_est, upper_q = upper_q) +} diff --git a/R/params.R b/R/params.R index 2b1bad2a..45eef6f2 100644 --- a/R/params.R +++ b/R/params.R @@ -107,6 +107,8 @@ #' @param wt_est A data frame with dist, wt, and est columns specifying the #' distributions, weights and a list column of estimate data frames with #' term and est columns specifying the estimated value for each parameter. +#' @param upper_q A number specifying the possible upper limit of the cumulative +#' distribution. #' @keywords internal #' @name params NULL diff --git a/man/params.Rd b/man/params.Rd index cc486f5a..f00f2b8f 100644 --- a/man/params.Rd +++ b/man/params.Rd @@ -177,6 +177,9 @@ remove them with a warning.} \item{wt_est}{A data frame with dist, wt, and est columns specifying the distributions, weights and a list column of estimate data frames with term and est columns specifying the estimated value for each parameter.} + +\item{upper_q}{A number specifying the possible upper limit of the cumulative +distribution.} } \description{ Parameter Descriptions for ssdtools Functions diff --git a/man/ssd_r.Rd b/man/ssd_r.Rd index d4632b97..11bb297c 100644 --- a/man/ssd_r.Rd +++ b/man/ssd_r.Rd @@ -21,7 +21,7 @@ \usage{ ssd_rburrIII3(n, shape1 = 1, shape2 = 1, scale = 1, chk = TRUE) -ssd_rcombo(n, wt_est, chk = TRUE) +ssd_rcombo(n, wt_est, upper_q = 1) ssd_rgamma(n, shape = 1, scale = 1, chk = TRUE) @@ -76,6 +76,9 @@ ssd_rweibull(n, shape = 1, scale = 1, chk = TRUE) distributions, weights and a list column of estimate data frames with term and est columns specifying the estimated value for each parameter.} +\item{upper_q}{A number specifying the possible upper limit of the cumulative +distribution.} + \item{shape}{A string of the column in data for the shape aesthetic.} \item{location}{location parameter.} diff --git a/tests/testthat/test-combo.R b/tests/testthat/test-combo.R index 884c7d9b..76cc4a17 100644 --- a/tests/testthat/test-combo.R +++ b/tests/testthat/test-combo.R @@ -7,13 +7,21 @@ test_that("wt_est_nest works", { test_that("ssd_pcombo", { fit <- ssd_fit_dists(data = ssddata::ccme_boron) wt_est <- wt_est_nest(fit) - expect_equal(ssd_pcombo(1, wt_est), 0.0391103597328257) expect_equal(ssd_pcombo(numeric(0), wt_est), numeric(0)) + expect_equal(ssd_pcombo(1, wt_est), 0.0391103597328257) }) test_that("ssd_qcombo", { fit <- ssd_fit_dists(data = ssddata::ccme_boron) wt_est <- wt_est_nest(fit) - expect_equal(ssd_qcombo(0.5, wt_est, upper = 100), 15.3258287163047) expect_equal(ssd_qcombo(numeric(0), wt_est), numeric(0)) + expect_equal(ssd_qcombo(0.5, wt_est, upper_q = 100), 15.3258287163047) +}) + +test_that("ssd_rcombo", { + fit <- ssd_fit_dists(data = ssddata::ccme_boron) + wt_est <- wt_est_nest(fit) + expect_equal(ssd_rcombo(0, wt_est), numeric(0)) + set.seed(99) + expect_equal(ssd_rcombo(1, wt_est, upper_q = 100), 19.7526836610501) }) From d06dd08d0c3e6d140d284e1c00c7acc7643ebd82 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Sun, 5 Nov 2023 19:26:28 -0800 Subject: [PATCH 20/28] - Added `ssd_wt_est()`. --- NAMESPACE | 1 + R/combo.R | 35 +++++++++++++++++++++++++++++++---- R/wt-est.R | 14 ++++++++++++++ man/ssd_p.Rd | 5 +++++ man/ssd_q.Rd | 5 +++++ man/ssd_r.Rd | 6 ++++++ man/ssd_wt_est.Rd | 19 +++++++++++++++++++ tests/testthat/test-combo.R | 12 ++++++++++++ 8 files changed, 93 insertions(+), 4 deletions(-) create mode 100644 man/ssd_wt_est.Rd diff --git a/NAMESPACE b/NAMESPACE index 3faca775..b3dc1add 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -124,6 +124,7 @@ export(ssd_rweibull) export(ssd_sort_data) export(ssd_wqg_bc) export(ssd_wqg_burrlioz) +export(ssd_wt_est) export(stat_ssd) export(tidy) export(waiver) diff --git a/R/combo.R b/R/combo.R index 6adb3494..5f52ba06 100644 --- a/R/combo.R +++ b/R/combo.R @@ -16,6 +16,12 @@ #' @describeIn ssd_p Cumulative Distribution Function for #' Weighted Combination of Distributions #' @export +#' @examples +#' +#' # combo +#' fit <- ssd_fit_dists(data = ssddata::ccme_boron) +#' wt_est <- ssd_wt_est(fit) +#' ssd_pcombo(1, wt_est) ssd_pcombo <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { chk_numeric(q) chk_vector(q) @@ -29,13 +35,22 @@ ssd_pcombo <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { } f <- ma_fun(wt_est, fun = "q") - root <- uniroot(f = f, q = q, lower = 0, upper = 1)$root - root + p <- rep(NA_real_, length(q)) + for(i in seq_along(p)) { + p[i] <- uniroot(f = f, q = q[i], lower = 0, upper = 1)$root + } + p } #' @describeIn ssd_q Quantile Function for #' Weighted Combination of Distributions #' @export +#' @examples +#' +#' # combo +#' fit <- ssd_fit_dists(data = ssddata::ccme_boron) +#' wt_est <- ssd_wt_est(fit) +#' ssd_qcombo(0.5, wt_est, upper_q = 100) ssd_qcombo <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) { chk_numeric(p) chk_vector(p) @@ -44,18 +59,30 @@ ssd_qcombo <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) chk_flag(lower.tail) chk_flag(log.p) + chk_number(upper_q) + if (!length(p)) { return(numeric(0)) } f <- ma_fun(wt_est, fun = "p") - root <- uniroot(f = f, p = p, lower = 0, upper = upper_q)$root - root + q <- rep(NA_real_, length(p)) + for(i in seq_along(p)) { + q[i] <- uniroot(f = f, p = p[i], lower = 0, upper = upper_q)$root + } + q } #' @describeIn ssd_r Random Generation for #' Weighted Combination of Distributions #' @export +#' @examples +#' +#' # combo +#' fit <- ssd_fit_dists(data = ssddata::ccme_boron) +#' wt_est <- ssd_wt_est(fit) +#' set.seed(50) +#' hist(ssd_rcombo(1000, wt_est, upper_q = 1000), breaks = 100) ssd_rcombo <- function(n, wt_est, upper_q = 1) { chk_count(n) if(n == 0L) return(numeric(0)) diff --git a/R/wt-est.R b/R/wt-est.R index 3db266f8..6d199346 100644 --- a/R/wt-est.R +++ b/R/wt-est.R @@ -13,6 +13,20 @@ # See the License for the specific language governing permissions and # limitations under the License. +#' Get Distributions Weights and Parameter Estimates +#' +#' Gets distribution names, weights and parameter estimates for a fitdists object. +#' @inheritParams params +#' @export +#' @examples +#' fits <- ssd_fit_dists(ssddata::ccme_boron) +#' ssd_wt_est(fits) +#' ssd_wt_est(fits)$data[[1]] +ssd_wt_est <- function(x) { + chk_s3_class(x, "fitdists") + wt_est_nest(x) +} + check_est <- function(x, x_name = NULL) { if (is.null(x_name)) x_name <- deparse_backtick_chk((substitute(x))) diff --git a/man/ssd_p.Rd b/man/ssd_p.Rd index a2c7410f..57727b2b 100644 --- a/man/ssd_p.Rd +++ b/man/ssd_p.Rd @@ -166,6 +166,11 @@ Weighted Combination of Distributions ssd_pburrIII3(1) +# combo +fit <- ssd_fit_dists(data = ssddata::ccme_boron) +wt_est <- ssd_wt_est(fit) +ssd_pcombo(1, wt_est) + ssd_pgamma(1) ssd_pgompertz(1) diff --git a/man/ssd_q.Rd b/man/ssd_q.Rd index 5d40d377..785cbdf8 100644 --- a/man/ssd_q.Rd +++ b/man/ssd_q.Rd @@ -169,6 +169,11 @@ Weighted Combination of Distributions ssd_qburrIII3(0.5) +# combo +fit <- ssd_fit_dists(data = ssddata::ccme_boron) +wt_est <- ssd_wt_est(fit) +ssd_qcombo(0.5, wt_est, upper_q = 100) + ssd_qgamma(0.5) ssd_qgompertz(0.5) diff --git a/man/ssd_r.Rd b/man/ssd_r.Rd index 11bb297c..f799e47a 100644 --- a/man/ssd_r.Rd +++ b/man/ssd_r.Rd @@ -153,6 +153,12 @@ Weighted Combination of Distributions set.seed(50) hist(ssd_rburrIII3(10000), breaks = 1000) +# combo +fit <- ssd_fit_dists(data = ssddata::ccme_boron) +wt_est <- ssd_wt_est(fit) +set.seed(50) +hist(ssd_rcombo(1000, wt_est, upper_q = 1000), breaks = 100) + set.seed(50) hist(ssd_rgamma(10000), breaks = 1000) diff --git a/man/ssd_wt_est.Rd b/man/ssd_wt_est.Rd new file mode 100644 index 00000000..10706422 --- /dev/null +++ b/man/ssd_wt_est.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wt-est.R +\name{ssd_wt_est} +\alias{ssd_wt_est} +\title{Get Distributions Weights and Parameter Estimates} +\usage{ +ssd_wt_est(x) +} +\arguments{ +\item{x}{The object.} +} +\description{ +Gets distribution names, weights and parameter estimates for a fitdists object. +} +\examples{ +fits <- ssd_fit_dists(ssddata::ccme_boron) +ssd_wt_est(fits) +ssd_wt_est(fits)$data[[1]] +} diff --git a/tests/testthat/test-combo.R b/tests/testthat/test-combo.R index 76cc4a17..f33c8bad 100644 --- a/tests/testthat/test-combo.R +++ b/tests/testthat/test-combo.R @@ -9,6 +9,7 @@ test_that("ssd_pcombo", { wt_est <- wt_est_nest(fit) expect_equal(ssd_pcombo(numeric(0), wt_est), numeric(0)) expect_equal(ssd_pcombo(1, wt_est), 0.0391103597328257) + expect_equal(ssd_pcombo(c(1,2), wt_est), c(0.0391103597328257, 0.0837556041052211)) }) test_that("ssd_qcombo", { @@ -16,6 +17,7 @@ test_that("ssd_qcombo", { wt_est <- wt_est_nest(fit) expect_equal(ssd_qcombo(numeric(0), wt_est), numeric(0)) expect_equal(ssd_qcombo(0.5, wt_est, upper_q = 100), 15.3258287163047) + expect_equal(ssd_qcombo(c(0.5, 0.75), wt_est, upper_q = 100), c(15.3258287163047, 32.4740417139284)) }) test_that("ssd_rcombo", { @@ -24,4 +26,14 @@ test_that("ssd_rcombo", { expect_equal(ssd_rcombo(0, wt_est), numeric(0)) set.seed(99) expect_equal(ssd_rcombo(1, wt_est, upper_q = 100), 19.7526836610501) + set.seed(99) + expect_equal(ssd_rcombo(1, wt_est, upper_q = 100), 19.7526836610501) + set.seed(99) + expect_equal(ssd_rcombo(2, wt_est, upper_q = 100), c(19.7526836610501, 2.69562395185803)) + set.seed(99) + n100 <- ssd_rcombo(100, wt_est, upper_q = 1000) + expect_identical(length(n100), 100L) + expect_equal(min(n100), 0.0295957274619929) + expect_equal(max(n100), 168.790818444479) + expect_equal(mean(n100), 23.4076753984188) }) From 03b4a8b96b03ea974c5e11608c6424859dd8be04 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Sun, 5 Nov 2023 19:34:42 -0800 Subject: [PATCH 21/28] implement log.p for combo dists --- R/combo.R | 7 +++++++ tests/testthat/test-combo.R | 2 ++ 2 files changed, 9 insertions(+) diff --git a/R/combo.R b/R/combo.R index 5f52ba06..247bec67 100644 --- a/R/combo.R +++ b/R/combo.R @@ -39,6 +39,9 @@ ssd_pcombo <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { for(i in seq_along(p)) { p[i] <- uniroot(f = f, q = q[i], lower = 0, upper = 1)$root } + if(log.p) { + p <- log(p) + } p } @@ -65,6 +68,10 @@ ssd_qcombo <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) return(numeric(0)) } + if(log.p) { + p <- exp(p) + } + f <- ma_fun(wt_est, fun = "p") q <- rep(NA_real_, length(p)) for(i in seq_along(p)) { diff --git a/tests/testthat/test-combo.R b/tests/testthat/test-combo.R index f33c8bad..e7e225e0 100644 --- a/tests/testthat/test-combo.R +++ b/tests/testthat/test-combo.R @@ -10,6 +10,7 @@ test_that("ssd_pcombo", { expect_equal(ssd_pcombo(numeric(0), wt_est), numeric(0)) expect_equal(ssd_pcombo(1, wt_est), 0.0391103597328257) expect_equal(ssd_pcombo(c(1,2), wt_est), c(0.0391103597328257, 0.0837556041052211)) + expect_equal(ssd_pcombo(1, wt_est, log.p = TRUE), log(0.0391103597328257)) }) test_that("ssd_qcombo", { @@ -18,6 +19,7 @@ test_that("ssd_qcombo", { expect_equal(ssd_qcombo(numeric(0), wt_est), numeric(0)) expect_equal(ssd_qcombo(0.5, wt_est, upper_q = 100), 15.3258287163047) expect_equal(ssd_qcombo(c(0.5, 0.75), wt_est, upper_q = 100), c(15.3258287163047, 32.4740417139284)) + expect_equal(ssd_qcombo(log(0.5), wt_est, upper_q = 100, log.p = TRUE), 15.3258287163047) }) test_that("ssd_rcombo", { From 158c0b432bc597bfb2033b57686f9449f8d72c16 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Sun, 5 Nov 2023 19:44:21 -0800 Subject: [PATCH 22/28] implement lower.tail for combo --- R/combo.R | 6 ++++++ tests/testthat/test-combo.R | 6 +++++- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/R/combo.R b/R/combo.R index 247bec67..afc181b8 100644 --- a/R/combo.R +++ b/R/combo.R @@ -39,6 +39,9 @@ ssd_pcombo <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { for(i in seq_along(p)) { p[i] <- uniroot(f = f, q = q[i], lower = 0, upper = 1)$root } + if(!lower.tail) { + p <- 1 - p + } if(log.p) { p <- log(p) } @@ -71,6 +74,9 @@ ssd_qcombo <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) if(log.p) { p <- exp(p) } + if(!lower.tail) { + p <- 1 - p + } f <- ma_fun(wt_est, fun = "p") q <- rep(NA_real_, length(p)) diff --git a/tests/testthat/test-combo.R b/tests/testthat/test-combo.R index e7e225e0..48088007 100644 --- a/tests/testthat/test-combo.R +++ b/tests/testthat/test-combo.R @@ -10,7 +10,9 @@ test_that("ssd_pcombo", { expect_equal(ssd_pcombo(numeric(0), wt_est), numeric(0)) expect_equal(ssd_pcombo(1, wt_est), 0.0391103597328257) expect_equal(ssd_pcombo(c(1,2), wt_est), c(0.0391103597328257, 0.0837556041052211)) + expect_equal(ssd_pcombo(1, wt_est, lower.tail = FALSE), 1-0.0391103597328257) expect_equal(ssd_pcombo(1, wt_est, log.p = TRUE), log(0.0391103597328257)) + expect_equal(ssd_pcombo(1, wt_est, lower.tail = FALSE, log.p = TRUE), log(1-0.0391103597328257)) }) test_that("ssd_qcombo", { @@ -19,7 +21,9 @@ test_that("ssd_qcombo", { expect_equal(ssd_qcombo(numeric(0), wt_est), numeric(0)) expect_equal(ssd_qcombo(0.5, wt_est, upper_q = 100), 15.3258287163047) expect_equal(ssd_qcombo(c(0.5, 0.75), wt_est, upper_q = 100), c(15.3258287163047, 32.4740417139284)) - expect_equal(ssd_qcombo(log(0.5), wt_est, upper_q = 100, log.p = TRUE), 15.3258287163047) + expect_equal(ssd_qcombo(0.25, wt_est, upper_q = 100, lower.tail = FALSE), 32.4740417139284) + expect_equal(ssd_qcombo(log(0.75), wt_est, upper_q = 100, log.p = TRUE), 32.4740417139284) + expect_equal(ssd_qcombo(log(0.25), wt_est, upper_q = 100, lower.tail = FALSE, log.p = TRUE), 32.4740417139284) }) test_that("ssd_rcombo", { From 9828f136a4097849a4c8b27eb81a7ef2a73b5dc8 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Sun, 5 Nov 2023 19:52:45 -0800 Subject: [PATCH 23/28] more edge case tests --- R/combo.R | 4 ++++ tests/testthat/test-combo.R | 3 +++ 2 files changed, 7 insertions(+) diff --git a/R/combo.R b/R/combo.R index afc181b8..8cac785d 100644 --- a/R/combo.R +++ b/R/combo.R @@ -36,6 +36,8 @@ ssd_pcombo <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { f <- ma_fun(wt_est, fun = "q") p <- rep(NA_real_, length(q)) + # FIXME: vectorize + # FIXME: deal with edge cases of negative and infinite q for(i in seq_along(p)) { p[i] <- uniroot(f = f, q = q[i], lower = 0, upper = 1)$root } @@ -80,6 +82,8 @@ ssd_qcombo <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) f <- ma_fun(wt_est, fun = "p") q <- rep(NA_real_, length(p)) + # FIXME: vectorize + # FIXME: deal with edge cases of negative and q >= 1 for(i in seq_along(p)) { q[i] <- uniroot(f = f, p = p[i], lower = 0, upper = upper_q)$root } diff --git a/tests/testthat/test-combo.R b/tests/testthat/test-combo.R index 48088007..510e49fc 100644 --- a/tests/testthat/test-combo.R +++ b/tests/testthat/test-combo.R @@ -8,7 +8,9 @@ test_that("ssd_pcombo", { fit <- ssd_fit_dists(data = ssddata::ccme_boron) wt_est <- wt_est_nest(fit) expect_equal(ssd_pcombo(numeric(0), wt_est), numeric(0)) + expect_equal(ssd_pcombo(0, wt_est), 0) expect_equal(ssd_pcombo(1, wt_est), 0.0391103597328257) + expect_equal(ssd_pcombo(10000, wt_est), 0.999877937138081) expect_equal(ssd_pcombo(c(1,2), wt_est), c(0.0391103597328257, 0.0837556041052211)) expect_equal(ssd_pcombo(1, wt_est, lower.tail = FALSE), 1-0.0391103597328257) expect_equal(ssd_pcombo(1, wt_est, log.p = TRUE), log(0.0391103597328257)) @@ -19,6 +21,7 @@ test_that("ssd_qcombo", { fit <- ssd_fit_dists(data = ssddata::ccme_boron) wt_est <- wt_est_nest(fit) expect_equal(ssd_qcombo(numeric(0), wt_est), numeric(0)) + expect_equal(ssd_qcombo(0, wt_est, upper_q = 100), 0) expect_equal(ssd_qcombo(0.5, wt_est, upper_q = 100), 15.3258287163047) expect_equal(ssd_qcombo(c(0.5, 0.75), wt_est, upper_q = 100), c(15.3258287163047, 32.4740417139284)) expect_equal(ssd_qcombo(0.25, wt_est, upper_q = 100, lower.tail = FALSE), 32.4740417139284) From 99912ee516715ec15a11439cd4405a46c12ab4e1 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Tue, 7 Nov 2023 15:21:57 -0800 Subject: [PATCH 24/28] - rename `ssd_qcombo()` etc to `ssd_qmulti()`. --- NAMESPACE | 6 +-- R/{combo.R => multi.R} | 20 ++++---- R/root.R | 4 +- man/ssd_p.Rd | 36 ++++++------- man/ssd_q.Rd | 42 +++++++-------- man/ssd_r.Rd | 44 ++++++++-------- tests/testthat/_snaps/plot-cdf/fits_delta.png | Bin 38468 -> 38456 bytes tests/testthat/_snaps/plot-cf/ccme_boron.png | Bin 36091 -> 35827 bytes tests/testthat/test-combo.R | 48 ------------------ tests/testthat/test-multi.R | 48 ++++++++++++++++++ 10 files changed, 124 insertions(+), 124 deletions(-) rename R/{combo.R => multi.R} (85%) delete mode 100644 tests/testthat/test-combo.R create mode 100644 tests/testthat/test-multi.R diff --git a/NAMESPACE b/NAMESPACE index b3dc1add..ca6d4755 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -85,7 +85,6 @@ export(ssd_is_censored) export(ssd_match_moments) export(ssd_pal) export(ssd_pburrIII3) -export(ssd_pcombo) export(ssd_pgamma) export(ssd_pgompertz) export(ssd_pinvpareto) @@ -98,9 +97,9 @@ export(ssd_plot) export(ssd_plot_cdf) export(ssd_plot_cf) export(ssd_plot_data) +export(ssd_pmulti) export(ssd_pweibull) export(ssd_qburrIII3) -export(ssd_qcombo) export(ssd_qgamma) export(ssd_qgompertz) export(ssd_qinvpareto) @@ -109,9 +108,9 @@ export(ssd_qllogis) export(ssd_qllogis_llogis) export(ssd_qlnorm) export(ssd_qlnorm_lnorm) +export(ssd_qmulti) export(ssd_qweibull) export(ssd_rburrIII3) -export(ssd_rcombo) export(ssd_rgamma) export(ssd_rgompertz) export(ssd_rinvpareto) @@ -120,6 +119,7 @@ export(ssd_rllogis) export(ssd_rllogis_llogis) export(ssd_rlnorm) export(ssd_rlnorm_lnorm) +export(ssd_rmulti) export(ssd_rweibull) export(ssd_sort_data) export(ssd_wqg_bc) diff --git a/R/combo.R b/R/multi.R similarity index 85% rename from R/combo.R rename to R/multi.R index 8cac785d..46393efe 100644 --- a/R/combo.R +++ b/R/multi.R @@ -18,11 +18,11 @@ #' @export #' @examples #' -#' # combo +#' # multi #' fit <- ssd_fit_dists(data = ssddata::ccme_boron) #' wt_est <- ssd_wt_est(fit) -#' ssd_pcombo(1, wt_est) -ssd_pcombo <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { +#' ssd_pmulti(1, wt_est) +ssd_pmulti <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { chk_numeric(q) chk_vector(q) @@ -55,11 +55,11 @@ ssd_pcombo <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { #' @export #' @examples #' -#' # combo +#' # multi #' fit <- ssd_fit_dists(data = ssddata::ccme_boron) #' wt_est <- ssd_wt_est(fit) -#' ssd_qcombo(0.5, wt_est, upper_q = 100) -ssd_qcombo <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) { +#' ssd_qmulti(0.5, wt_est, upper_q = 100) +ssd_qmulti <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) { chk_numeric(p) chk_vector(p) @@ -95,14 +95,14 @@ ssd_qcombo <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) #' @export #' @examples #' -#' # combo +#' # multi #' fit <- ssd_fit_dists(data = ssddata::ccme_boron) #' wt_est <- ssd_wt_est(fit) #' set.seed(50) -#' hist(ssd_rcombo(1000, wt_est, upper_q = 1000), breaks = 100) -ssd_rcombo <- function(n, wt_est, upper_q = 1) { +#' hist(ssd_rmulti(1000, wt_est, upper_q = 1000), breaks = 100) +ssd_rmulti <- function(n, wt_est, upper_q = 1) { chk_count(n) if(n == 0L) return(numeric(0)) p <- runif(n) - ssd_qcombo(p, wt_est, upper_q = upper_q) + ssd_qmulti(p, wt_est, upper_q = upper_q) } diff --git a/R/root.R b/R/root.R index 7a5be02d..363fd983 100644 --- a/R/root.R +++ b/R/root.R @@ -48,7 +48,7 @@ hc_upper <- function(p, data) { range_shape1, range_shape2, parametric, control) { q <- conc/rescale - p <- ssd_pcombo(q, wt_est_nest) + p <- ssd_pmulti(q, wt_est_nest) tibble( est = p * 100, @@ -64,7 +64,7 @@ hc_upper <- function(p, data) { range_shape1, range_shape2, parametric, control) { hc_upper <- hc_upper(proportion, data) - q <- ssd_qcombo(proportion, wt_est_nest, upper_q = hc_upper) + q <- ssd_qmulti(proportion, wt_est_nest, upper_q = hc_upper) tibble( est = q * rescale, diff --git a/man/ssd_p.Rd b/man/ssd_p.Rd index 57727b2b..995db38e 100644 --- a/man/ssd_p.Rd +++ b/man/ssd_p.Rd @@ -1,10 +1,9 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/burrrIII3.R, R/combo.R, R/gamma.R, -% R/gompertz.R, R/invpareto.R, R/lgumbel.R, R/llogis-llogis.R, R/llogis.R, -% R/lnorm-lnorm.R, R/lnorm.R, R/pqr.R, R/weibull.R +% Please edit documentation in R/burrrIII3.R, R/gamma.R, R/gompertz.R, +% R/invpareto.R, R/lgumbel.R, R/llogis-llogis.R, R/llogis.R, R/lnorm-lnorm.R, +% R/lnorm.R, R/multi.R, R/pqr.R, R/weibull.R \name{ssd_pburrIII3} \alias{ssd_pburrIII3} -\alias{ssd_pcombo} \alias{ssd_pgamma} \alias{ssd_pgompertz} \alias{pgompertz} @@ -15,6 +14,7 @@ \alias{ssd_pllogis} \alias{ssd_plnorm_lnorm} \alias{ssd_plnorm} +\alias{ssd_pmulti} \alias{ssd_p} \alias{ssd_pweibull} \title{Cumulative Distribution Function} @@ -28,8 +28,6 @@ ssd_pburrIII3( log.p = FALSE ) -ssd_pcombo(q, wt_est, lower.tail = TRUE, log.p = FALSE) - ssd_pgamma(q, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) ssd_pgompertz(q, location = 1, shape = 1, lower.tail = TRUE, log.p = FALSE) @@ -74,6 +72,8 @@ ssd_plnorm_lnorm( ssd_plnorm(q, meanlog = 0, sdlog = 1, lower.tail = TRUE, log.p = FALSE) +ssd_pmulti(q, wt_est, lower.tail = TRUE, log.p = FALSE) + ssd_pweibull(q, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) } \arguments{ @@ -89,10 +89,6 @@ ssd_pweibull(q, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) \item{log.p}{logical; if TRUE, probabilities p are given as log(p).} -\item{wt_est}{A data frame with dist, wt, and est columns specifying the -distributions, weights and a list column of estimate data frames with -term and est columns specifying the estimated value for each parameter.} - \item{shape}{A string of the column in data for the shape aesthetic.} \item{location}{location parameter.} @@ -126,6 +122,10 @@ term and est columns specifying the estimated value for each parameter.} \item{meanlog}{mean on log scale parameter.} \item{sdlog}{standard deviation on log scale parameter.} + +\item{wt_est}{A data frame with dist, wt, and est columns specifying the +distributions, weights and a list column of estimate data frames with +term and est columns specifying the estimated value for each parameter.} } \description{ Cumulative Distribution Function @@ -134,9 +134,6 @@ Cumulative Distribution Function \itemize{ \item \code{ssd_pburrIII3()}: Cumulative Distribution Function for BurrIII Distribution -\item \code{ssd_pcombo()}: Cumulative Distribution Function for -Weighted Combination of Distributions - \item \code{ssd_pgamma()}: Cumulative Distribution Function for Gamma Distribution \item \code{ssd_pgompertz()}: Cumulative Distribution Function for Gompertz Distribution @@ -159,6 +156,9 @@ Weighted Combination of Distributions \item \code{ssd_plnorm()}: Cumulative Distribution Function for Log-Normal Distribution +\item \code{ssd_pmulti()}: Cumulative Distribution Function for +Weighted Combination of Distributions + \item \code{ssd_pweibull()}: Cumulative Distribution Function for Weibull Distribution }} @@ -166,11 +166,6 @@ Weighted Combination of Distributions ssd_pburrIII3(1) -# combo -fit <- ssd_fit_dists(data = ssddata::ccme_boron) -wt_est <- ssd_wt_est(fit) -ssd_pcombo(1, wt_est) - ssd_pgamma(1) ssd_pgompertz(1) @@ -187,6 +182,11 @@ ssd_plnorm_lnorm(1) ssd_plnorm(1) +# multi +fit <- ssd_fit_dists(data = ssddata::ccme_boron) +wt_est <- ssd_wt_est(fit) +ssd_pmulti(1, wt_est) + ssd_pweibull(1) } \seealso{ diff --git a/man/ssd_q.Rd b/man/ssd_q.Rd index 785cbdf8..1e819183 100644 --- a/man/ssd_q.Rd +++ b/man/ssd_q.Rd @@ -1,10 +1,9 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/burrrIII3.R, R/combo.R, R/gamma.R, -% R/gompertz.R, R/invpareto.R, R/lgumbel.R, R/llogis-llogis.R, R/llogis.R, -% R/lnorm-lnorm.R, R/lnorm.R, R/pqr.R, R/weibull.R +% Please edit documentation in R/burrrIII3.R, R/gamma.R, R/gompertz.R, +% R/invpareto.R, R/lgumbel.R, R/llogis-llogis.R, R/llogis.R, R/lnorm-lnorm.R, +% R/lnorm.R, R/multi.R, R/pqr.R, R/weibull.R \name{ssd_qburrIII3} \alias{ssd_qburrIII3} -\alias{ssd_qcombo} \alias{ssd_qgamma} \alias{ssd_qgompertz} \alias{qgompertz} @@ -15,6 +14,7 @@ \alias{ssd_qllogis} \alias{ssd_qlnorm_lnorm} \alias{ssd_qlnorm} +\alias{ssd_qmulti} \alias{ssd_q} \alias{ssd_qweibull} \title{Quantile Function} @@ -28,8 +28,6 @@ ssd_qburrIII3( log.p = FALSE ) -ssd_qcombo(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) - ssd_qgamma(p, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) ssd_qgompertz(p, location = 1, shape = 1, lower.tail = TRUE, log.p = FALSE) @@ -74,6 +72,8 @@ ssd_qlnorm_lnorm( ssd_qlnorm(p, meanlog = 0, sdlog = 1, lower.tail = TRUE, log.p = FALSE) +ssd_qmulti(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) + ssd_qweibull(p, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) } \arguments{ @@ -89,13 +89,6 @@ ssd_qweibull(p, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) \item{log.p}{logical; if TRUE, probabilities p are given as log(p).} -\item{wt_est}{A data frame with dist, wt, and est columns specifying the -distributions, weights and a list column of estimate data frames with -term and est columns specifying the estimated value for each parameter.} - -\item{upper_q}{A number specifying the possible upper limit of the cumulative -distribution.} - \item{shape}{A string of the column in data for the shape aesthetic.} \item{location}{location parameter.} @@ -129,6 +122,13 @@ distribution.} \item{meanlog}{mean on log scale parameter.} \item{sdlog}{standard deviation on log scale parameter.} + +\item{wt_est}{A data frame with dist, wt, and est columns specifying the +distributions, weights and a list column of estimate data frames with +term and est columns specifying the estimated value for each parameter.} + +\item{upper_q}{A number specifying the possible upper limit of the cumulative +distribution.} } \description{ Quantile Function @@ -137,9 +137,6 @@ Quantile Function \itemize{ \item \code{ssd_qburrIII3()}: Quantile Function for BurrIII Distribution -\item \code{ssd_qcombo()}: Quantile Function for -Weighted Combination of Distributions - \item \code{ssd_qgamma()}: Quantile Function for Gamma Distribution \item \code{ssd_qgompertz()}: Quantile Function for Gompertz Distribution @@ -162,6 +159,9 @@ Weighted Combination of Distributions \item \code{ssd_qlnorm()}: Cumulative Distribution Function for Log-Normal Distribution +\item \code{ssd_qmulti()}: Quantile Function for +Weighted Combination of Distributions + \item \code{ssd_qweibull()}: Cumulative Distribution Function for Weibull Distribution }} @@ -169,11 +169,6 @@ Weighted Combination of Distributions ssd_qburrIII3(0.5) -# combo -fit <- ssd_fit_dists(data = ssddata::ccme_boron) -wt_est <- ssd_wt_est(fit) -ssd_qcombo(0.5, wt_est, upper_q = 100) - ssd_qgamma(0.5) ssd_qgompertz(0.5) @@ -190,6 +185,11 @@ ssd_qlnorm_lnorm(0.5) ssd_qlnorm(0.5) +# multi +fit <- ssd_fit_dists(data = ssddata::ccme_boron) +wt_est <- ssd_wt_est(fit) +ssd_qmulti(0.5, wt_est, upper_q = 100) + ssd_qweibull(0.5) } \seealso{ diff --git a/man/ssd_r.Rd b/man/ssd_r.Rd index f799e47a..f1b57e09 100644 --- a/man/ssd_r.Rd +++ b/man/ssd_r.Rd @@ -1,10 +1,9 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/burrrIII3.R, R/combo.R, R/gamma.R, -% R/gompertz.R, R/invpareto.R, R/lgumbel.R, R/llogis-llogis.R, R/llogis.R, -% R/lnorm-lnorm.R, R/lnorm.R, R/pqr.R, R/weibull.R +% Please edit documentation in R/burrrIII3.R, R/gamma.R, R/gompertz.R, +% R/invpareto.R, R/lgumbel.R, R/llogis-llogis.R, R/llogis.R, R/lnorm-lnorm.R, +% R/lnorm.R, R/multi.R, R/pqr.R, R/weibull.R \name{ssd_rburrIII3} \alias{ssd_rburrIII3} -\alias{ssd_rcombo} \alias{ssd_rgamma} \alias{ssd_rgompertz} \alias{rgompertz} @@ -15,14 +14,13 @@ \alias{ssd_rllogis} \alias{ssd_rlnorm_lnorm} \alias{ssd_rlnorm} +\alias{ssd_rmulti} \alias{ssd_r} \alias{ssd_rweibull} \title{Random Number Generation} \usage{ ssd_rburrIII3(n, shape1 = 1, shape2 = 1, scale = 1, chk = TRUE) -ssd_rcombo(n, wt_est, upper_q = 1) - ssd_rgamma(n, shape = 1, scale = 1, chk = TRUE) ssd_rgompertz(n, location = 1, shape = 1, chk = TRUE) @@ -59,6 +57,8 @@ ssd_rlnorm_lnorm( ssd_rlnorm(n, meanlog = 0, sdlog = 1, chk = TRUE) +ssd_rmulti(n, wt_est, upper_q = 1) + ssd_rweibull(n, shape = 1, scale = 1, chk = TRUE) } \arguments{ @@ -72,13 +72,6 @@ ssd_rweibull(n, shape = 1, scale = 1, chk = TRUE) \item{chk}{A flag specifying whether to check the arguments.} -\item{wt_est}{A data frame with dist, wt, and est columns specifying the -distributions, weights and a list column of estimate data frames with -term and est columns specifying the estimated value for each parameter.} - -\item{upper_q}{A number specifying the possible upper limit of the cumulative -distribution.} - \item{shape}{A string of the column in data for the shape aesthetic.} \item{location}{location parameter.} @@ -112,6 +105,13 @@ distribution.} \item{meanlog}{mean on log scale parameter.} \item{sdlog}{standard deviation on log scale parameter.} + +\item{wt_est}{A data frame with dist, wt, and est columns specifying the +distributions, weights and a list column of estimate data frames with +term and est columns specifying the estimated value for each parameter.} + +\item{upper_q}{A number specifying the possible upper limit of the cumulative +distribution.} } \description{ Random Number Generation @@ -120,9 +120,6 @@ Random Number Generation \itemize{ \item \code{ssd_rburrIII3()}: Random Generation for BurrIII Distribution -\item \code{ssd_rcombo()}: Random Generation for -Weighted Combination of Distributions - \item \code{ssd_rgamma()}: Random Generation for Gamma Distribution \item \code{ssd_rgompertz()}: Random Generation for Gompertz Distribution @@ -145,6 +142,9 @@ Weighted Combination of Distributions \item \code{ssd_rlnorm()}: Random Generation for Log-Normal Distribution +\item \code{ssd_rmulti()}: Random Generation for +Weighted Combination of Distributions + \item \code{ssd_rweibull()}: Random Generation for Weibull Distribution }} @@ -153,12 +153,6 @@ Weighted Combination of Distributions set.seed(50) hist(ssd_rburrIII3(10000), breaks = 1000) -# combo -fit <- ssd_fit_dists(data = ssddata::ccme_boron) -wt_est <- ssd_wt_est(fit) -set.seed(50) -hist(ssd_rcombo(1000, wt_est, upper_q = 1000), breaks = 100) - set.seed(50) hist(ssd_rgamma(10000), breaks = 1000) @@ -183,6 +177,12 @@ hist(ssd_rlnorm_lnorm(10000), breaks = 1000) set.seed(50) hist(ssd_rlnorm(10000), breaks = 1000) +# multi +fit <- ssd_fit_dists(data = ssddata::ccme_boron) +wt_est <- ssd_wt_est(fit) +set.seed(50) +hist(ssd_rmulti(1000, wt_est, upper_q = 1000), breaks = 100) + set.seed(50) hist(ssd_rweibull(10000), breaks = 1000) } diff --git a/tests/testthat/_snaps/plot-cdf/fits_delta.png b/tests/testthat/_snaps/plot-cdf/fits_delta.png index a9e63a03cc9110e1b02a4c2b4ad34674321dac93..70e50c5c715a089c6043619453b0743be8b22d2d 100644 GIT binary patch delta 37478 zcmZU5^+QxoxVQ95FWub@Qj$w|2}pxbeDvrbV}zve&6^0bpL>z zopWa9c|J9#zY4ac3bw8U9%|x$b7`l&{ySR4*Z)$|k75dqK^(BLZ>YOLEs=r02A*V59@Vi6FNYn6H(U64KJ)25ZR16WRT0d<$*VG<&=``8htW ziC*vh*J4!U?EeqtMGi}91G(}MCiC6_SLuG2Z%XwUI&D7_IbLnW#t?ntKqnOlotgQt z>b_{O)a*!($EFYB;)lN6(>FP+MVBgM^jdLmop1JCcHH(15OMy$`7wa3(sJXMx}Gja zW##0OqywQN)YQ}8ELHUVE(QoVP2js;9&Gyu28`D`yfeAXk;g3F@!Bl~j*Q5ok_u?} z(CqH+-W`9NblQ&N`}I{4F}g;ravp??+#opl_P^)nfX$77L=Ytko^`1EU_qZQBJ9Kr z4fD7u+%U<>6M}N#FdB7Pe}<@i)!<@( z=JUO=TgH`^K8#`Ssw?q5LO(cVb;Z%2ADDkS?LewI+_DK+SmT7P*^(vqxC+`+F8r+y zfdmRxZZsG`3M9~EM}4Zv8MsJZUS4K=Rmr$$S(%uSn|}wicRUT#=l2IApq$UCtH_zU zLeDyH0HC5tFfKEJzstI8CrgRg8BJ*<%6PWD@d9Qs0|nXite;%G3`i^u0q-4t>+ByiiP_ zo^ayMj#+RL|uG^YZHIf%khk z#W{aisi&?n3)sjjF^V1@=-BJ)J76m!otD?7U0@|^<0{gOYzxK0Fzu;><8z_46>}8a zV>>t>O9v4Nh{q#u|GF}XTAILDfmNf}kek_Qs%mQ^jAD=)&54w5OTTt?`dlYJXliKu zw1tI(tG@nz?5ltuCPj%PxEi+mCe?$cbp}mxz}FQY&!6DA-j;^$);aLW^3CLap_Jj$B;!|V>!)<5=a-(34)-?7Z5)J@{hUTeGd4a zM_jqNAzQoVw>RSx*Zi;3@ny=%qS{ zfgE$8AXU2iIf;^zfS728aPJ1tWT~5YPVJd?^mMC`H{1%fuwJOAMVF#0Bk3ZDdx>3nT9?;-hgOS&sj`= zEc1o6OvnyOGeS|LVOWaE6~p)}CD#`iwXL&M9bDe(;$;oBwlDdvGV!)^*~E2UOvsgE zNLY?g7Vfs8uULCOInktGM0tKl9Xv>CWyh@SiWQeroAoXQb8`ed2T9!R z6{6A}gf_Qc@1}G8)YH{$8r^c9iYn}R%L}Gr$?`6Pu26O(maMF~IMmUD3v~V-$#;eG z@{>fw{OIL>4Fj>NguLWrsYZP#d$HElh<+=t<%rsQXN8?dYzzt9??Fzm>L%PvE6_Uo z19NnX9OHETB0<2~R&Gc-)hzKj&B!RI5~Bl+XoX_>E4P=(wK%-BSFUWto7DkiW4M_C z2L`?&Xgj#vjv);>eDHdx-1t@cm!ow#VKQhtyU>J#l;bn8^U4AQHGyMuqETSS?7px| zIjkj5y1ze4q}tR32L-eFJ3y_J4lXL)L#x* z(ojeu9ggK5TCe9r1o)C#b-t2b<9R^0w?|3Mu2yk&^F9et1IM;rnjpctERCAC%X)eZ zD&o&dHaa3=tkg7bR@_l&Jr0U<_R9=l{QzsHRg~{Us}E_01ft0{w~VjKI*JuU7&*p{ zyrcT=j2ArWTiEpa$%@^|FfAABi*()o$b%XSI*DLCvK-^Mtr*tRvy+SV--qa%rh~u9 z)jzSAf8$Qiq_X2l7m$L^Q)bbp?y#f_pq-#{c?Bni8&Eh&X7sNV>OzB0(#6_m7fNgw zzq!-ePKTWOLABKWnI|Kcm|%9>!}>QdH4Ba$e8gXoQYQNAHr8wKdhQ8f1mTwgm&AJC z#s)rOYCmnwdbvx{den}~@c4{Gr&~q_Mw)bl2-J^^N;ZEC!%MN`MzbTY;Mq7RhK?JH z{VHCr#YJ)++Duq+Wi;voHAV$K@9SqT-_rnV)`%Z;|94N}19#htxFa2rinoiA;Bf7}6%|?$9pyXTqJJD8>twPcT zxbO=#2DYw$O3@~_2A*H|o13BFXYsMSzl)d}amR3F)RE9 zS(@yBo+8Cf)s49a!8PuRF;mi);K-m6|B)<0-(LR65+FiLFm#O z!QRE@Q8@BRhL;Doeu0$(ER`I_S|(eunY`_=y%w_X<;I$HSJ?+j-$Z`@2)Da86pL41 zA1v5{pie^mDdtT=(9%|qOl;r^W+q1^N!e*9;iHu7&3^V|-_dn3#}5^>$oX_wnq;;5 z^z@;HJ>Ao@TGnofEF%%3)BuK!Q9Ag5u*E{eATh)YQ z_R(Pz=S`>)qD>A_mITvgaL`C1Y1POH8fio|0L^c+g^1EbA%skT5QJEG z7PK3{oI zsDAcVrT!2w?PBmJjFMvT?j=DG9!Qde>EwS^~!;ts z_YNn4OR%qLUIN4k3vagE5-7XLB8Li~d(rK1usRW<_^FL(vSe@IBOzLdrtj+2zo)2s zS{s0>xh;+1JJ4WmARQ<1bs`3cFyC5XXwwAMyhjlC8?#!BPfHu@ZR(HpXsCT7xR@fVdy<)CWzV1vmb z^>>E*EzW{`CsPU4VIuey1!JJ*4n(67L#UOZ5+VK0VA$lFrg$d9?LpJjto?-NO;CP* z{_Lcp!rEGCC7)2jsZBO}I`rrpV#${;?;~@XVaZ8IP&@bcc-1=`Fi@Vm4SHe?O;Udo z2h`OZk`WOde$ZQUw;jvIfT6=(KOqg4E0w@Z>cF@?fg415R*s9Vt4#m(742NYP>Qox zXpEwq0Nyg6@G!l2Z*BR>BhHhOl7(d~Y&B;-7j#zza}kc8{f%!>&kgFXi7|3^$TMNG zWh0_>?Zoq=@_|3)$5n<=0diJUs-ZhbKmbYYfcV@!>aA9k(@FKgty0fNKldwkp*+9% zcbYB2Dz-jNAL}dc^_a`PyA9NR_sE+S#D~e}p~ywSUK|9qga>x3rTy}b)Hdv5<#4;}5?DBi_+drSt_wb;<2%{w}N zJh-vlOs)K|G;{YB8j(LO1Wtkd+v5F%9q=%`6oxL;+Ho~uknxG}sRbmeA{mas&|`?M zn@D=;^^hv3@`mg>^Ak2|e;oK+7bp*2C)LISeuP0#G9+x(KjfjCn*thmpFhP% zTBUqRf4G5r&)v@c`_kd7U_y}F=*mQ#2OsQPf{-nB#q!5$5MRJwt|tWl6VqT6VJ@y2 z#xaN{YLWKRMZasU`aVyx19oNmVCI1>tum8C{jO!8R!(72?W^r`2lzVY_} znGtvSexIInw4tinB1PBK@O{jEs!wW^Wj;7X6(d z8Fu|}KT>R91{Kf|6dX}2ciTZUBzd9xKH$d+N7mqsu5f02)Sh?jB2lD*9@<3T74mJD z_eiC?wZK5}tn`e(zLAF~QnCnLgq5P4{+Ynqi&?n)4UWBEYR|xKny;(|RfX&sosKhb zq8AFf;{qC~-~DO*sbNH*bxLG9h^IlKuUWgiOOBCGtGmRTj+7*=#-p! zhY0wAeqW61J6L-vr;T&zCo*BM8YALy_3ZZCj5xRSIloMH!G&DD6!3Z`*9AVV5`(qL zvtv|{Y&oeqmFM*8(5YKF z-X0nX#E2kNV4fpgwm6An8DB#VEYmbulp?wxNAn+8wDW zNCc=1SC!&+UPiUkNw~)F0$9MdCXJ%Yn6CzNoS{f(@q)5Ny6`I<+F*WH-4Wozpn*_i zyPva+0tX@51VJ^SZ#<3NOWTL-FBo9M?vXfr*U%Vh*iwD;ANTUT{QjU`W%0f#K8pQR z#E`H~R$eV z?kfh(X=zckile0sE_~&?v~f*X$FEuK1l7Sfvv=wH@QD?8DJ2m=ZYA~yGDh%hxry$g zei%<0M6*a(^N9szFRx+NJ?kGjRPWtz0XVrkX=J@TzH+Dz0h+N<^LKJ^x>#mf`-RbE zi#Tz^k$9veq+-W}049O@UypEvVV=UpTyj9|-+J4_PfJBoER!&}Y?&VyJOxXGc)&$C6*1!9TtF!FT(A?=pYX)o%T8)~WqpNeZ@gra3ygrt_o|+2%BI&t9#dskSyiWn|g<294xMR}B z4y$%e$PtaZM_DYb2WgQ@iT}PlEsHLPZ?>Oqwr&jHh68&X!qvL;P6|^mkkJ6q&B$#0OY_nd?)=W@tG!m}8-GsxAO_EWkW+%4V7Y599MR z$iO>m17>qsE7yy;g$aWKcn?UBJ*IYaSnu}%k-Qo`nK;q1#t>c&^NsM3Gcf~0^mo{D z?zzO{tj>`@`H84=qN3g)ffdF&1kb1<{NS9v3|52bH1-K#rF(r8V_EO`)hf=9PrXqL z1+}aNW)8Rw<_dZiwY5d1#W_`c{o3z$+8LG!rMbpSGbq-kuHl->yYeRk5U|rw7m6oUBBI zq2L$Q)SyG7%S)kp%?<-Ir3%K}M9z2T#@;WXdP4{tunv+169v7ej&n<-gn|3}l7uz6 zd5%(%tvA<;Mq23Jqae5U@T&rm%6Z|2wL`6Yc_?WG7c{j+O-*=z|BUygGO9z?hr`i` zRdsZt3MC@s6H4^2NTD~&mMs^9#3$V^`^5<*^w^Y$^p?)9|+gwFSLwv)hp@7Oig$C+tYE^TZRT9xn= zaS#2wXPO!rk@k8bAM1C;d9Nl(E<6G141Mcq`BzZg!uM|?+ZBwJu*dR89W%RqZ_nn_ zXhZvh-aP>fnCAGPsZrOB?x0H6L88L!q8Z z13Oj15WaVziH?c6SaqE=1|(LOW7C`CWtXX^9whQqMDzYgFrJ@QjegX7*FT@mH+t?) znt#{%-a63G)9XzD^>c$2w6pg>IZ%spEg;+#J)DxW7wu4S`Jp~CQLBL2>%8fR3c9ht z#u6N7p+9{Wk#D4)_+H+3BM9kuhKPvBY1uqu__Tsd*k>c0*dcLIRg?>m8|*>w2-%nf zsUc(KSUKcSHsyCb7&(=rBcJ5$ZmK$!JQo1|!vMc}7{nm23n1+otMh8DTEh|RWlzQD z9)REQQDI^)26n@JXSi0td4~#}2hAgD&-u;1D)Kp@cz=#Yz{EY0AI1yL4Yj1YPfRHcaQPjyZlwah9ED%A4aGu5-*Ie4yMl|* z8UhQk)II)&*i40Ffmk!ol^3M~g%fLh9b3&E#0xCXe4cbtgJ!vq!8BD-x>Z@KJGr}~ ziS7~Tul%pl1gMC#Sd-|(AUaVSPj{Ti7vZ{3iMmu&%=;{DuY01e z^~ba5)jO|8wLk1;?gIbm$aOFW@}4OxTORPpmrttXnsMs#qnr$W*-HLVQBk}@jZKVf zY!h^G82@!=;=~#^zE)NTnF0!}h?EcW`vxUaW@Ap-573v#->>3jnkcoBwD|q&K&6yb zQu;pJhXh~?@xUQS+sxWdQwwR3_-0VaEmQcQo%q7zONV-D@lV}E{W9ovN_*6`5`n#RU`|ps zxx_tLc=!Hjd2v&%p_mdy9Ne%lCGNq6IO;!|$YctNl^Qk7mwzWkO#z^Li4`q!y+d;|gJRvwmE*K7ume_$>5%0 zOns*w1pd7oS5-P#;}7~>oxZnC%cxuwW;D9U2nn5k04ho+=>G34%D&KyC{|TT25p}7 zBKEJGVIJ-AfToBN8AMr`Vu&RfJRb?PjdAHZlKf*z9B+t9b&|HJAak9IhQ8419lD37 zzmug%F2AhHhL3n1RwIr3!sRUH4`$1#1qF$@4Fuo4!?w)#=e_* zU#X?gCvM7HUtix4Fwj?6(*)Rp+ISL!2|phN^z5b&kAJm_NO#L%Mn>8|E>hR_eK{aw z-N@pQ$vltGmGI`SrZmKuf}i|oj7QU18`_6;*8oDLm1IJo87b<7k#vyfrX>X|W}})s|~;BhwDr3q@8JZ`?v0vYJAvl-9@LDklwocl8X3gpVk_*fAo-< z4l3pXTCTp|^}JRC8<&8Q-$ht#JstZ^@T;z(*)43GHiC3F3i$3R=F^VU*NatVK9l)P z(hq%ARd)9u3c4J7*utoTXhAWG7vd*6v@#&ojMN!(D38q?!_#>m1_&KJJ!D@#;8MV$ z^ZMicOj&(2twQ=wb?$Ou^AQ}s*XLXLkL|49B;3p~sA%p9{*NckTo~Rw+;`7o?F5EZk)QsvO;1t^TP0q;JyOtjs8dC67 zch(aA3gu{RyLuzQ+^=Ays`}|(z~x53bH`QlHm}I{D|J4GX(zH{CsxAK`ya;3jagIK zpUWI)w5ZWq7I4kCJD%x{2SWWpQ`|q^{PSbEuEwUu$W%}c#M#v!9z3MWQNkYf*Qx~% zq$VvaQIyW?TWdnv@>AI=nywge4YC{8`*nYoLseU#r6}_6Wz<8g6{R@snVxye#b&(0hzg&1-X$8xI^E*KSZFJ`ThA=Uz8_aP{>abR)`3HS}jqn zjF8rb$9-nVNmi1fd*zy4{5dwN>}m(uJ4hcj5l5W686zly>t7V0T<_!g8((t-=xH6$3$10?Dpo^i>`%4uq9bKzvS z*^@VSEMBB^VUuEYYlO<@yzo~3(lQ{azbB_AuZ;6+;LV$NupdEHOWru-C!6C_h0)z4Gf%|=ykzC>|Sxm#8UZ5+#5GtVXeja4W0T#4r;ej++Jz#KG#(t@m5y- zx|`7%x;dwn?=bS=tzxc#W->f29UYkh_Hn4S^|>gX?n)br%7H_*gzv2$O7mv9kk5jg z0Ia9XF0=Lex!wmi=f=_&E4Rt0AH~Ari|QmS$hqQGVK_S%wLf0OeSF$tm89SOWH=TA z%c@mzsl-eYVM4WF;e3$IqAPUN)u~~>^A5b+rjlu}Ki3)bD84P(Lle~oG7o)w@_Ksh z?7~bbQ|li;El<{q4b ze}KItqdhJ)Ms?Y&?B`fxx7*9pJ@3H;nd-g=7X;@7dV5foKlpg|gIxzq?t9ER{9b&n zeJ>v>LgsfaCg-m}=`O^WSG|_Py4OY+v`qmK!x_ra4~rzwyJSEv%}q_6bNjyJ$iObX zU7tud#F(t&3x=(5w+#{qu_dy0x5^Qy9=H9MlUZ?SSDG0&^jJ2(+s!aCLvJ=xz_TA^<8P;}k6m5<05U~$*6 zJx4{t4W;}JctisT79SA5QNW}u?N?~_dHY#c z%32u^BXM6~4X zO4h$_H=Mo{xpDl9d)S~@0zD{exl*XvOgdtFX z8pA*7PeAkqPrFssNUC6cH4q=;HG1;*X;8>_L@P=D+eD%sby8h>OQG^OVPs-V(v&}y z)7PD)k=%s4tR^Xv!W zqOv&8B}4ZpKonx^K(F8IuSozbKeuP!F;+Kl&=Q&SP6B^qP;a0aF`TOZqj*U~)``5@ zbg$Sn&oseA2d2k{lQ`fb3nw}_XSXIzP$g;^!9ZW7V`ZUJpx|=V9e=g(U$j{!Vb_%H zROoxJ@sl&Iq2!aI)Phd@g?bd-Dgpoe=bzh@5atk-&t6=E=)_T$`44F7Peox!SfO_Y zI+5l4(LTk(F>5t5zw3qn+@XxdYw_h`Z;mZ&k#ieD-@7k#8Hd;mwC&pKQ7&|;#oWyU%fW~y&y0|*?5%cb9R^`M( z+rRFTIZLp$2WwgctGV;Xxy-ySGUCqg=KZefaIpL+R zdN9l1?DUl*_jb$Oa5tsihueotw-4>}j{ZpjxS4cd*@ee$`>4GuQP3-^VQ>R}-oPX| zt?{vB4^fy;=B;L-At}76EG;}~hLTQ&4QE($Axs?j#z2pk@E)L#z5n#TFh@2%=r|8N z)pxPTQ#B;h7DGdR#aeMCCm!VJfO=+G*4{uqY3U0bLqRkCLP5YUll5#{SzXwsDj-gY z@ojLuFb*v!ueR;~QdnD{^;5}XF%6#-Vnq_++zdAufpw^GQ>YeNGc83UQH>%kp^2^- z?qU^eQiv9h{fJA&s+WU;<^917YG`@@b2m`Z{7c^CT))GM6JR+2EVn`>;DEezUd<>h z)te%PqmxDh2aVLR>;6kg32hgq384^GxgDS5Ix2Faww_+h*^gJl4~v6?gIm$eHQfL< zj|AA00@-J!Y~IZ{zV$@KG64A&vwYJGTlEVT#^i$=8}Jo{y*IhofYLr1%6MlXKK>ow zCnsP?`$)UsVX_<}PHFI{|FD#{!IMQ^rUtQnBN5Do>{&o+>) zO!uZ!$zu@)ArC0q#z#gangKDOe_2hk{!C6&n*68FJhn6uAm<`=0S3Hv?i~N*#NIV&*e&jPErri*5Bi4Y}D zwaXx1>k@ydlTY8k#HFete2qiqf2B5zBJM3jdmQA2>|L{Xgvo!9Dj&-&BTmgv?~;(( z8~W+)8og=uTcfh#nG~GKcEqpT?a?$QiHXfzU;*BgM!Ah@`=lq6*exHGML?~y*e zJf0PuFUY=VNF0X=KMwSy#h-pclva*qtV>_{4g6sb(3k=augLG|I*9$ARg;2xx1q6 zYArpG+-pIAsg@7P0w1(oMibWuJnO+BG0>bd*EBF-9pd`wm8k6rm2;Pb>*(=P6$C0*|Jn|hA6}5E{hRc)D~8CS z&n40>e(@siX48w=u_J>VrhGuY&S6-)YbyBn8qLP1-W_ttCF|$1;oup?9hE1qY(q@ z$MR}p4x+dvR&jk=MHMW4HGv~_m)Ex^A8@2>k7wQof%hH$30@AKIV-ke1rv6XiN92; zkONc{(@@hxa*U0Q?>4grT73RemBi=R3|Ah{eYUBiv!jPKJr>5M#c%|wZScQp>r&R5 z>j9EPE_T*Tkh3a}>HPsEXXz`7%Z9k#$}9{*^a8k|qhIUV>Dq1Bw`@W-@Fx-b(Mgo| zJ^uZ0x=?<_i*jj@CK1z1z>gygUYJ}rns0JVw$MFeuP&;wL76ez#KfEFO&|@p*dh44L75&Nt;GN0VdLT za#Hay%t*VY6(NM$ofRR@K5?eOjE;`)j)p*P+_30qAgQpDOt!|63qTO>=?;Q3SHwex zl}6EKFpObF45d<<=`h!ok`p&q)q+W@9J5^S@^5EJ+4_-~h>n977zTDif=#1?ThJow zUESZjJ1OIU?u6QK6gsA8O@Av#;liA{xuv+nZ~w&P7o#y6*#>_5J96-;n{(3FjV?6d_@VCRJ7fh+bKV&JRF+gE*f831?4g3ZDiJhYwI( z#4m3r#U*LK4l~Il(t(PVTOlMdDXfwP+MsRFA2CN56mlN|mMHsVe& z3R`!UWgcUD3PTghfcJZ!t8%}4!D5&Az&e6*r53t~bd_!>0eXKwrr@EFMQAdXJ63*k1`0 z_1(bUP|Ya#d9afp&x3hR*@yCUs`ERqyPJUUkD#FzwH($*uNFZ)W!rm(9B3z zo)9F3Jd7>aLeE1W55Dsl-*%=)ol4b(dAL9y|6iKE3xn}&B#qge5a%>^edwRec(y0{ zatC)Mb89ycjf)pq({U+}O3XXvvN|njPlOqLBrXrVnwFWtOvHD-7{C`KT@33k$-pGU zq>`qb3=UA0hnMpqV1P=acA9;yjNJiZ@u?T5jQX6pKW^83X}#RyZx|6pIza{p(#5vI zlyhvCHK{i~;z*^+RE^U|*%pM1*7o*{6#7z9Vcc8xyGOCEHHXTR`g)TQ>lzWzQy-Lk z)K;=q!XO5RDjD%2urQEDH_ml=3<$@m!)XyX>_t({&OS@hi1Z>d4(*MMfUOUpzKcltZb_N^x z;_1y47l)fZqaR}1AV=P{?l5` z>ZG_Z&155?sy4?<^)m#RU|g_#uG@^9*Le>T?LAKCyMJu-K*#TXH-js;rZBLOyAiVc z;h2@{>YK%Qvf;*enD8E`l5!96(*F!n$c87^DI;e?QPQ>_jKhZ=;CU zzjkg`M#W}U`j@2Ui@*x8p3Hahbh@ijbIuWtgf#;&&W+3rsqQ@3lncgoO9 zm{r`RA@o{msq7@XLl|m*1i^dSrdZoU(1antQe;BK4zo$@xH_e_L z^9aa`kw43hN^iwt^`aAfrM-WeuS?*}ptayWuA*N>dK*><`8k0P-UZL1226S${hF(|84^#TP;mE$PXEZa0pHCiNb zw@8EYAku3ZgG>lC@J_WY99L!JGlx7Q3p2CA>5Okm+cDr|vkRxAuy7={4>94XlNJ)TJ2Z9zs*y$I!I;C4{Vi*GLhmgHSI zfdB0ezp#~-&@A@yYZD`v)}>pU@u%`oq(-!j0a259=|DWpysp1eej@vbnF>^3924=+ z=c#;=FtSoalAifLj7nUrmf6-lIb*Sv@$^Fh%h446=Il4SXdABh*MR4T;fv_o-%xVI zkRGn2utBH*PGOIGvi0njVNoLXy!WnOj$7;V`XS*%ZKy;jYN4nIgd{$-BF|T|@(nA^ z_C$$*ZJ-jr@p?JR?qUvjEctA>RI1tpFh-Jr76#R1K7vp4y2s3T@1A>Y!8aRJq2q$& zJi+h`;@Hu+XV8N>>%(5yOoZQXfWJ!wJLkR&od4)cK|z${!OX8Dw%dhsiysMDMMu(X zS6l680~5sovA#P&^o79^eySTC&EXpm;)#7jh=G-&6Lz>SkBW&cwT`pxGoawH@u?6U z4g5RuTl0ue`fL9VIE?_Cdx!%g5&?U?UZQ{+RBClOP3pO7tkuLv*JurqH7083KWUtW z?&S0F2D+QT|BC4@F!o^)%?Xr(kyrJH`_!i3-hqh zk|my#dm&DC(dBzg5f20>Sn4SRu+!aps1&8F)lQxTY9f+&OrfmRXM!-!!T}Co)!3=( z815Zqao~0yhQ6kCQ zj(>T=$D$b(lzB7G0Y3iaFCHOs39#;Ov5K=7S(eQ<;G_$(siti3@z4;TPaL5s#u>SLb&JKnD=2!q+%>BSjXaV`=ZlRE%Ko=kW- zue85`#odMKZYpw{EMI2O{H61rcmIR9+OUHUCT1S12|En-%N#Jn!js!(rVnEa^ zWdf-yp?mc449=f|!9}{almLs<@O^(xbljbQZ|g2l%fho~$eKw6e-+ZAU&(++<;sV` zd!fzhZWq91$*pufhopl^(bo>t_Vr}%#Dz7rf`PNHM`c49um@ucRhawlR@X9a930(| z&sm9he%KjU18g)km{e~{cJU;`#CBWNf%ly1bSgh5gS@Al8jH+-su4SC0VMf?-W7$L zsH&>y&^QOCB59ePRyUh$^+zSszEdQQhL%ot1?E}v(jk*S8D?h*%3Lhp;+yk z3hbRU!}pOMIsDm?h^Es;QpxI3cQS^)Cp9WU?}0u4k%otsK%D@L&QC?Sy%r zflLbVOcop?-=mxPg1s3K&TXf3s$ZefK~|~W)DJPtzfPzu#QJT$Fy18ga>*PVSBr*} z7=a73;9(p>6y#Rrbul$HFx!tOsEdxB!XL3M`J%T9l2HopKFJ`9Geu8Sa$qDQ%_e6h zW}*zwQq=CmzMDvFB-pu7^|}Qj7+sx*g6;;u4(w|c45PHXbb+@ziTLPdga)!B0;!zp zMQl*hl^`L=kE3}rv51%o)_8RD;#*lsekPw3xVqFkPCI0zEWp`KB_r8_UbO(`H?6y; z!k->o=8r$wm=8~jYN}3Fnny=*O@w8}LS+)j(oDVk{qBZ14T%pgqrYtAJK#kihCVC} z#u3w-eo8u$V#7_!bK>{p`;Er7&I&qS+(UsYN7u?HC1f^UVeG zv&D+P6yb}G6Cx3HpQ__9bX+hN@`y>nmeAiXxy&Pl(@4Xbg%tJu8n7u45vpk&Tm`<^ z;!p;-9bPtA(9v*p{c|$9@~wICy!qyoq<35NG)#OPOh@H^8c=<}iH?x!_%k>3$Nrzq zYR|NMAmQ9!KAD1N=A&CKnEa(ufO#%oo~FM&Q}HkC zu28qaniLzchTYhyZf85Ysug$o&i!Q}a3MuKDJ3{q=8t43;t-(lND2NCdl&~ddn;fJ zwz1h-h|ANQ-H1Fyc1&~ zdV?Ws4#SGFhLKdPlZ*$aOT3FVnm*#jE`uaPRE+ zEsQCvd_(%DXW=xm&$?q$YMSV?xKU!>j(d_cO2k=QyUu{jf0bIS&+`Ayh6=8^UinVGZ0O&%dg<&1=N@b*BbG z;aTD?YhlB1k8|J0eW&jhSPxuG2Z}Wb5$1^On#M?j?-7c%7;4<5=OBsck&kyi*a;UV z1*9~C(_8WtrJ_nQLTa+4xTEU*(%R1Nv+fkr7kVqZ$7LL7iv|7%+oHllc06zc2NW1n z;$O?-ACXh{!DrE?*rS=H!UYh`3iz(_5LC1DW3`CRo5IK6^_W^9$-pSSTkgf=;gmx` zF#_p69ANE)FrK>K)?8OM*veR z^T|(}3GX)7aXLjPai2yHs?t|w(|?}Sx4DP!Ff1b&B!#2KSP&`0bIl`AcToP zG@Hy5<_ebwQdW?lZUzmG>hKbXfu!{)(2$W~3xB=&%EX$%ieEWJFZ$OAJ_g|vj$pZ` zq|kcHCmxq?zng928L9E!yn(!tlN8g4r(?(elh+#vT-S+(RD$@SByiq`U(3u;@pL(4 zjf4KfGJzIbhAv7l;R}P?MtaSZ6Dml5Urz?ZH#l(cs%7N!EmXpORp24^_apW%I{KC! z)|H-CM z(Ej)_eEFN@cCP1o(ziO@)V_$=KrKqls*9oCP@VK^GN>LOqUmTpB_63J?lp*G&e*HZ z5@gE>XKT4j&S3Qun+!DB-SB1s!E+(?R7_Li@70ODrc9EWo|(0Ed?6|^GZ)Lyb@0vI zW3oZ|c9X|`NcNpTWb^i{ifEddDxin8(KZp}77LALuxF@w)^^_L-glLD;6x;IK~h>w=Z7N;EQc+&5)|rLK-P4oR%zJ>_^Vh z_^&c^vXDE)$G0oJh zr3l|#>L-)a4@ohizV+yOKd4JF@@kR|Ennbx+j9_Ky3g=VM3ecg@7P_bJ33bH-SD4O z{Nd9XmIRfg*{sC@H!nk5&b$o=L(&*lv4|Ecw zAJ;NqwAP%f9Ul>i(bqH{M%FOAtONhFpGJo&@G_}H9wI+}piw4{d_{R`cU}Gs%u^b@ z4)Y?W+dZAK{BKu0ysN|}e*es7rl-gJGM~l?v9O#!<@vNYGBSa0;#U_ds(fy=BU%Dp zVMQ!DMLHjVEkTv1Ki<>Sy1BVg+5hWC7d>^3y1jk`)1x)P(0vnf#>lc(@J|XsY}j2y zRpJ|)ZaFE7PmOHQeV#iO!frLueMPW(-bT#yqh@CD`*$c(uJ_KVm-UQ$%R$U-%w&-j zkh@X!PWlYlwnV<|O18bKME=a~&PPUq#=FO#ZSlHbJKj(F`Wb~SML8tVX$F8s0`g(c zia~M;97X-&`i_7`T3rb{!A9# zNw5?dlaFqE-Z%%k^_EdIB9uv9uFazNTQDp5C3}Adnt1vsR1atMvy~YZh#>E(i`pf} zq-mRJzO8l(VIbTgP}m-0D#zLCa}f9~_y`ARqZZ%(iZly3Z&YWvuai^rUBTs`ziv`+ zngV{pxg{QK#m2aIW_!q?8r;}1eIlqt++fJ-zh9Rl)Csvxzqg%IRi3_9+}UDSft=y+h8kB@-zrZ{$n0X)$uCV~EN!|(T+ z@waS$5@AZ$eV^QC>g_2huMQS?8PGkqN7@f@jDT`Cni2XMi{LKu<&we{o=il)T9$t2c5Li-bs*YeM2rRCQ3#s)40)A2f25$fmm8~B zjBzhLG77pn_}=@I9MbUZwHMoIJNjsjWw_zT!-x&R8a4b*#pr+Af(}MxOiX`8P1o@l zt!R4ldvwdE`%5n%RoS->2HeWKa+kZlfIv<}G;E3fi*=C@YLFC97)PYQzvx5+4Gc}h zkhBj@%pdnG`6eM_`PawcuEM%5-pB81R;<_XS6If&=<3%;FW~I!V*3NsnLgL3{=5s->0BUZT*A6{2foE-B*ibDU!;~ zAkiV+x)j}x(o zZ51Im0`lxA`wShtr9k@i{~H9#F1EJ@{uu3FP1s3`uB~9?3n1%nGN$@&1}hxdld$i5 zsdPye13w5SxDr-GQyTpd+JYLTHO_-2l&`F&k1+hJolI&{b~AvanTCH$2r~Lr{>D{> z1^WV^8ND|p*A@@>sbH99LKT7|yOs9zqC}v5Rx`X2!DSUKks1*aWT6&pWRBznq0LiF&&9r=@<$+rF|i{*83lVG1@WSS2m4m)AQll>T}tYdHj^2&yR}}5 zdey0zw#Yzo%c{jf*f9F;PSPr?pv-{jjF@ytHl@I(hLHEcHb0V%p7`d2N}a+1jBF1s zERHL^RZ+{28P_Pm5bdgFo4h>cM|ZbP;3KqTD=1Wj{%}7m%_M*J209W{we@ZYyjnKq zdVQ$%x)z-fq>phNDDPcfEcKtNkqS|fBxQf|1&3WwDczu-rX|EYH4sd&gyJcC4ZFiK z%(r1FMl|7EPZLtYBr#FZxFNz^0dZ-}i)$}PjsI)P)v`sxXs$8q+(R1X1r6w6F!pWC zg@^0m0E~xQ;m_|@f?sb{!xrZwYmfDDhEFBMA0R4b;u-ZB#FNVgorIk*2Y;d3;5w_j zKd=V(!$;L1-*A$p=zmq1sIfKHEyq3z8txLEpz4&(LU-qsg!XP4_#+|0&kY?#bu=5R zZSGAABSn6gY7)@8u8~#4YS6R=6j3R2NGoy&%bfkB>)s*oWG z2QtCT&#xOFf{~7cnfd0Sjto>;ICWG5V@oe>MVgY$N0XP(wIf;ejhCt#MqJcF!ZC+2qyQG4e!{#q<2QNPGcY@1`$5Om9>}pydT15Wb*a?3P za~N+m00?<4Kzo~|uEv(fM^Q1F=AGS_WOPF41gctt?-8HSIvi#su6c7ilw(eNko+Lq z-buy{5}|CIX(tyG76N@Rgb>?NAvRaK>JaJ}ruiuF z?r3=5bJ6=VgTx(JZ&-xzf2K4P$`aQSTrkO=4I;3!WaDCpyy zHo)m5LB0zxuDlMiJ;m+A25eMLPHjtjGURg7kVcX7?oMU!c~q|sp|sXDq=EKBFykx= zOTG$C*XGU1l2V1j+$0bMoFoHx42s|*IZlTQ8+2nz)8LiS(531Lnm=@bj@+a}S&6fL z+tMj>SJSsR>JmVLuq6ViJR5L`=G2OBW(D%w{QopA(M-)=AI5+%_qqS3K+@c#)j>O{V`1@fF_2;N;)or&KpQ()*0(nlqw<{ z9d)_C`#k4x^)Wsg_b_U>*m5On8|bE5VASU1tO3+1LkQ&gCQ0mNJA%Baq6ahRn-Lwm zf-TVbj-RKO00{Jbr2#onhZZnewYm~)1SqtgExorrUeOg=~ z(J*n~0T*08&Uac`B~Vh3U}bSP&W0}vYp4Zl(!p&zefH>4#b^6$eSAlis~&N`Oc_i1 zMk|2{;vE*}Cvp2DRAoick-%&n)x1^1F+qkwsZyQ(q&2GUwhI z|9gi$wRxN4?Ha8DnrngiQ{~_R&MW(neu8+1j!i%k38E z$HZ|hw8qYB6ZX;78AiU~069JiK---qo$*5;MBD~L(Os7GXG8K;!%@(*;x*9LTl*$s zr03$|!fWT(1MI_)pkGYr<`JU98vf~EGc0;Z{f(SuWU+O>0>6M!uf&de0&~`{Y4Nms zf7f*`KTqCq)Iopox`2>|Kw&BZDh#x-#TAVxwdlTVerm;)vBmUH3<=Ec{07#UWZ){% zlE_46?aD;x9tJ!-RyLZN&^_|kdxW2YCoDE6JASd^5!B8QKnTNYl>$afY{?0fooHgh zRL8Cyw0HcL#d{6i@MA}HJ%EO=*lu)D&+9wpp&G1Uh+27lJ+PDAq@eHt8NN;)kYhU} zY0v!2x|fS=+FdkoO6F``T|4AO9eIIU6?9Fq zzKbEZ!=y*4>F`>&53tq8OOb-x$%0A75|c+F1BS5%@VtbmRTjRxrQr0puQFgL-znKJ z6ct%oT2jh0%M|Uv?{TUNsP%D6a(s>vyMGz*P*|n|dN!I#s?KSAR(;qVgw~Vl_QHc{ zCUaI5wF{Yix7b*FB;2}>3lOG>Og{7v#mYe|_CtV1TbzwRPvT0M!TJTToP`rRb=1iy zyf;P~+@`{a+#bi5X6FC4V2nYR<>t&YM!!#wzdkpcaVD1RG(0q>EWCMVSeEaVMZsS% zEk*;2>~oX&r_=Ka=J0bIc>rog+_qH7cmw7PHs|e#49DHc!8^KYbI44_S^StfoLaBf)}nt#>yYSB_k29OraeNDWZY4w?{ddN!d2bSLl?dX zl$tHaxOBMzrZKyK_O)lbKjIRgOJ-wap`nhvzTAlkQ>{ZZqJ_Tz9{3}?8JL^ryIivgLop+m`2=~1I zPV%v8X{2wmSyGITjado_S1}X5)4>ax_5WbY=Pz>?D-{IBhsFtlddRD@X@vh8$HQ=j z9UhcHY~@?ZTAoh@i#(g70r}EADDErQynwrY6cPf-A$*j-YDi?`7F95*{0a7EzNS5O z{EuJRsRaa^F?G`Uf?XCnT>r|se`y`0eSf6~@}Ng2CI)Cz4XMU~jLE5pPm(rpU2 zHJ?io9jCLw7EVYclDk@B6K>Lij@f%}1XJO<;G2vEC7^eiwSAw#t?-j6*9CJ7=%11R z{Dp?zM)@PB9-}oSX9rDwkjH$1_COz!su=1RU#GfrJ_4!0I=BDbGM9gcD?o8`&IdO{ z0D_IJH`!@s`H_gS2xt62vS6fQGc|B$dHB3>v#Mzv5-Qt8F6c?CtNPP{_ab-eyP6x8 zxJL=0LxQ%`;Vk5npxhv`D^b~42!R=6Oxi90Pi5#f2ZWP!CqjVXl;r@xNU32g7fki< z%5@JK*y%7SxEcftR*sAgR&jobWSZaJDq~c`t(K8q7MCC;im*ygpseR7#xLP!jc;sC z15Cdv;yrqjj6`#}3bKDNZBA@eR~DB_2lzua4%Gqzx=8-!O8fzQra_R7#Eo{(5bgZA z35MexLG`>|=TARPGR%QY)i!;|KwX`3>TBk{yk8M=jG@nQ^xuY-*<{H!4L;~NRRJ$y z!A{0_H$Eh`gy2WT>szPam-lzI1n z^)yDQbiyb36>Cje`n=+u(hKp~{l^57X9<*X;$CQ+&hwOdSy4!2pcIVcpWH6qL9b~S zG0y!jFK;=tbS_X1Bt-M}sY-8=QX9T@IL#BZS>Y(!5MvmoGKi`L*A?8;qp014m`Iw; zM@s;WGN32H39HXTL9fkXG6`-$hd$Q+cd(6qdA|1plj*J93&ys6=W;jyVNajxLkOa; zbqAV%8d4o(2HP^H?h6-3i}=O&lEN_yzvRGC)`EzQ)) zO^v3A=KIA-fQl*`Bg?h;D=1FHlQQqXKK*wMqV#;wI|+(~rKAV|%_E!p4CbDkba=h- zqotlc0^1Hk4cmPQarj-EigR?T{e(}%WX2sWE;|g7rlqr<{?1sIkThWM_9dVJac&lr zmtWZ(1&6H{YSJJP)u*V0=pmh7ahP+x$d>iLr+bTU$j$rUk%4?Oiy!d1sgOvq<$cAx zZ#iVQBvQ2hNcv7PVZp>7FhPw9SV5a$nuzY1p+^}oii-qrPGe?o@T{5b( z9|X7t6zGZ31GIHnlq1ozY}<6yH8!;nMG?(JLj(O?xDjptoRCwy8_fWOMn&aUYdC%- zwJn#H&4Y?+b8{CvYxt>IT-*$qhOOv~0$`s+w671Y-ru#j$X_MYHym$misS4(NU-DC zTSwkdct`P+#xI9ljcxP=qDX`X@JT~Kc(0jJ0$V-v_XU9rUXTb{M-L>__VSZ0K_u~~ zY}Uz%Gi+bqdvJ8sAmf_H&fSp|rcXIxk#Bxtjv%?Ugv~$qOF057GL+Bthg~~2AdM=?p9od4^~N z%zezi*-5}-pWk(AP=Hzz-nG6^d{CK^7Gj+5P4Bn)~x?lnVDmV zmFuj9i;H`YX=ew|Pulz>bQ=J{|2j+=8~J(W6C=mzZh{zEbe0my5sq3)8Vq9>u6mG3 zz{CDKriUdH2JrN&y93_584wLrf7E`UO2(S3kK{(-G!3xv$I1u(F! zU@@qciMgy}uk{xz^`urhGys^uzJpnjzLaUesczUy^bNjBR+egI_mUAe;C~)_}RItiGZ|A#<=LgaJ2zB_;Q$OEq>n%Z@*dD z?~N#gkwg@N3(ZHxcxm_)&tll3kNTR2J{RD@ zuqEMk-X&IvS@u@84vV6&MuXz+o-)ld=H?> zwd$TPO`0s{eCZRR7~Le#<^Ki+;>ci1z#`x0beb)7-w#~Xc1FOd_in1G;Yf%VDb?hK zV#!PT)MPr`i5(1~Dxgp*jWu!krL6t_nf35WNhx@iVd&h-Y@g6zoRv!ZdqiEzfR;xK+(B6Vd|$n(*wpYLO? z6gg@sq7BHkONoEZ3IKoV67SZXMn1V=m9e<`@k@bQpO5oRr8h)?R z2mmXvO(CF3sX$!$zs`G_`e{(CWLa7Fx4&G~la*Q)`vW6(nd>~RVh-o>i2a@oIqkjB zNuIo!gXr0^1f2l=P*?>!@C=Y4;c)0s}%KW~fwK}dDs)XHgeoCrom z$gV#$)yUPhGSie>a5N?Lj?j!sY#X8o(AcMJ8C1#eH*^~PL(|R=Sb=N2r|&^3JVFtG zW5!S`qfsWyPWW5R#$d;cGn)R6VD(=gbpx{xszGdFzQ0e~?RDU54Wj zX!@g{b3oHgcfjffakHzcRKbDelS1u+I=2lh;2!fFa+d2RQAz!jrpMP{qW$I6j{{); zp|SNi+5Iw;S237*Je&p1IwvV_&BBi4X+l2fjoMCjuxXiVQ>0S$A2@_VrPmN_$rKihtLfpwDF4-ej~wTP4>GMF~>p*9Tu}M#>$pXTy$et$nZ8Q zfAqpzEE>7+&ZHF&Am)ba(^K_CMD`2yUBjXtL-5V#o(PRbaZ*OffqHKTr?}=>y8?Mv zYr05pDv$RvNEI6Q-V9|ajqNG;8#L0)ZrKGs8Vm9udx@efJ|CtkfBm=6Aedcm@rBE) z`sQM(GC;1A3!rUuo9qbzB~AoTMvjTf61f`7&@!;FNCVWRHyQ?jwa0h%^c>y*e76sM z3z06DU#o`{HmyKS(px`}g=!(RM^Gx?MOkB#Q!9p2;)(827W1WB>XJJa7``tN(^?(O zjC*pBF}110MhyJ8lQ1ZkCjM5m!<9!f5CIMwyAfZ}*ycEvU#JtUJ5KwlRaq@auLZSF zuJgy_>=pP;Wa3M;tMtQca=hVzY8L~ozHnTy=CS+rpI9sbCkQ}p4M6~Zoy**NzR~y^ zm8dBC6j;X~UCEeT{jeVVsjjf>ih!^gQ)xdx;Z3hYRm;*?b7dMBu{|aZi#sO{={Cyp zrJFv`ISxSz1Xij>RQpRZS0g!SbIS1Bg2maO|LPn{+2ew6#Ra?{-lFi_MZhP)Z-9FY zPf|(>6B84<{?=FE0HTFc19^Sv>kmQ>M< zC3nC(^V1b_Yer&k~ZP+#K^_h^E|=0&W0Sz~b1rBdKC? zim@TKsS>)vdp%(h5x@<@1`${ic8c@Y*`C%bsqi`CrGq4ORw~Cb=?hc}wPDXi#8woE z+XmJfB#@~=qJKBLD#3pvX4~5OGum=6AY7^FkJM{~Aj#)dnoL_WwrSk@_4?YXe92^0 z&g*^8Jg%fkFYEJ!+N-F*(MQGH-re8efB>D}RJlB)ij8i@9%~>*#0>*e}S|ir)`wN`mK~@!rbFUo%8cA4F_V1FxpZdhT1P_hp)6NQFgK^sO1? z;*}4=A2w42zm1KL_jkWOpX-}{sCa5zGOlp1?t)SJTh1OA{&S@YWLK)@H|YXaMm&Z) zzuio0^o4LE8P9Fu7uYIftM9bM{ZLrD$`R&IIpuxTdErV@@y);{Yw+Q$QEQsdqpYV4& zsC0!lfq4dZZOvDlK)7U;2I4(((7t7+O75~6B#6bRE=$cW9Jwpny*HGz$o5wwjtz5z ze2ZydUKRa%|4uE{wrVJ?wd52KWVZz1=%(dCmH(~EM$sVuBF1~CM<>^zUp{4t{D#5Z zy)tRsF1>P>oEM71$PNaqKT84<_C#v>_s-E7`3rC0_DRwMzharf?G)lVp%0QVoFKbFfA<|L#e27!_P$i=T7pH5QD zMA}TTLY^@#b8QLtDH)9R{7JtojkNe0NlMRB*!9YT`m{lvA(1Q|IY?;;);5$fiNye)utrzxEYMxY{$QCc>G5mKj5&&8wyV+?nVK1}U*>yk{>d zisRB)GrjuZ8zx)PT8v9`da`8`A@GU_olW2t#Yw-C^ ztF+n_RpA+2A6bILUZ1eZ{Vt$U;6v>DX!!W>6U1)0pI}hbW@eWZsn@SSwRwLi2dwd= zho=-GqIaJj{sIlYQLFuTLW%F3*nOp#rA^^xkrD-v$KQ0v!O9l% zC=YOqEsv|9r?k|B{DKD#S+DInQ6=@9Zs=k%`?gLx=FMg@=)cjI7Q^vDB!cSqz&OKl z_&qRF^8y@DmjIP*j9kt#UYZty2`wWdQ{S2d5D3S9F9QZw13{**Omn0c2M2wL>ik+Tlxc_J;htZBlkFuL zqtr_~HZz@t8_y?QG*jU#-8N88z&%tQt^A;e0M-n24S0Y6C4_{8w1)@Q8>EAf>`jl7 zj4+!5miH0g7xu;`e#9TMZ684raL zS|XjDVacj8^dRDIr5NhaL|9vNixOfd3Fcmh6KAF2;BPE~?;juYfnGVaY-~@ddI5*$ znc;M9b82epI;uM$&KO79djK@hHMD|^xNX{ohOxllSnsyq6=<@B;3x(J1XQ&&x%D6o zq^#FD1EBpD%4>@fjo{jNY0f4P2bek^^fJ`C0^j2JJUH`ALi)c zg6*%&k_Y0*MN44rGGZg-Y#)ZM2Ub57iaBv{f3npmT>JYh_bD(^a65Q&S`A1zm(G0RBr3`-}1~Y3a4$w?&$*gM+1v6#+M6AQZRx z{3&oIhdgoSc>g9O7|3UXqdCp)z%L~NNocn*Kcd(4q|dV^N%kdRuQDDVdZq=Jv ziY%~!qhf}uO(5+I8`!GClxy(8qYSDB9lP;DmaV`64w}*iq#lZlEwn;#c3f?F(~03G z@5t+8TJ-P7GEaRzoUTAO2tI*H3sc02Ne1miR+GB=wChr zB62{VV3@+0lb&ULLIpYb{lFEWiYSP$ z`Z^r8O+fgEG=(fXW3BO*m;2&;&9z2Ir@OoOmTi_m3#NmjBJBr>I z&ei#y>nctD^!SeeCpD`)zF$Z=5K%W3$`fLym)bpd(B)S{Tzr!l`YWNDz~WeQ(xUUQ z$u&VBw8sIC;Pf+!clJ=8t0!4Ur=aHWHYu=PE0utlovgwz8Qj)6R#m#< zCq$?=G49cixKzV=jFNjc3r`5QhDjtS85^Uix9|SZ+0cv5lp46|jFU-8@cQDfhXXk&*Sti)r- zBqLh8048XF1j0G`TJr{(C@d+-M7J{OTR`a8O@xil(KfrqL_|>h;Cy$)UOwKkzvsdb z{FBQ0HDQG4QD|UH;`+T8E~Xj8qI~xP4M>X?>8JCNLca}%po>Np7Sg@@8&HzOSK$sc;h`ClZhL*Ys)t{XWK|Y-CJ(CNAueuZmN`pCQMp5^I z;)1Ef$TkWjFI>D04$XJ>KW}c5hJCkH_5S{90aEVa1vea0_&7SUK>*TkIIz1@v$3I_ zELQcGeJJ7Ze{_2wY5la`_$hT=@MyEMeVvMtg=OH)I06_4U*o3pWn#paq$DNF@iU)U zlTfprF_8&7Iy)&98ry9vDXG$t)u-2Wk%JQw65#4sW7-5hNJ6p^v!#Rwetd!Q(LM|T zb^yY|&CAcQzR!^8%S<5&P8+C~^}ihXt17aYk(hBmL;XIiNw#2}HBktOv@<2EUGy;< zTYv^jrf2Kd`hICxc=0P`;b~Fi<>i@gacKr{zHPE^@)3UE> z6cP*r0$of?Y2j&`c<d&d@-jX$Qo7l^K>E?&wo$*8 zWHIH7v1OqjF>&dQ#HE4a!-j5da9$>8u-k-$n0kewyB@}1n!25QmcEVhVO{XD7Xvv= z$+Td<1RX_bY*m*|2WtxJ>>8`sW(dy`!pEFAG$y%kkGi5zo#MD}s30PAB9d}rrz;qEyQyrU2td`VRpN6vP3d;FPB@%EK0KW#wU0NP&Sg$U zj}Sp^DwrSI){fac(Ta;SGsb}sCK)Cw(`);|UQ)W7!*E2GzOAO3$K>~0^8~^xohxHN z0T4eylhsVDtjWVXKDVcgcP{M49lB>@`HOOrl9D{}fF58B=476{%kRNeQ&ZFQc)o05 z$$OX+ocJC6LpkVJC@$?(2-88kYDh$NGGff6Z?Y4OGJoq6!A`@)EvoeJZ8H@=f4E_o zvnjCnfkO!**!HmN0-XjyShx#jdZz(EXYWz zYf!4ZK$)5no$JYFWGH2hv~rV%-)c;(Uc`=aBl7c7 zBx;IJ9vtl{;r)&541&aC-PEb7+%#=|lCXbh5!*kChI?4Zy>q>SYl|&0M`oWxYn*I=u#e(7QzrT$BZ%D35{;c_(z-Y#f6k zd|~}MEF3DJSWtm0EC4}QvtTQGks?=BGe5rok&S1qD_I|6>7**h_W>S?5`EPdwvn@^@~#K z8YoK+5Cdn41w>4I#S0DP1!{#9&y5YKbQ0ixd6j|o9I8%yXN>Hpz&Gt}qBjwe)Zk8! z4sWKKBSSC!0seOKVcEq>E#^aZM81O$nT90Iz(DBk)|Z1Y{{|XgcG2-ESdtu|^oyu5 zKf$>GJPCsU-qi}5$CBaex2SVFxDF7lA0+2daHrEJ58_RtDVHGbxu8X$;f+UrcOePk zBTbruK=V2J>z3^B>(H4(Lu*su_3V_!(O&>M%OK^I#7-`xzXwwhu4$NKQ9iafjx9{5 zWDEhus2h>$7ixR`RSXCb?Z|vh0-r*6OJ|(5*1~x?&Z@f%|v81J{@sz`M6ltWNcAqH+pxW!$(AC2k**|^WZw%>7cMXRSq61f`eGlTX*->0&J+Rt}J=Ie!HJ?6|&BP$#bpu&a)O8N|_ z1SbcQAfDl=t-4Mbf@3kV-^;; zF^Ia~fd_oD6eOjTSTY`ZRthh26Lj(X7wQ`wBC(Hftau~7Cb6=7^hX$ccBd?b7tQ;Z zv_I1gJZGJV)z^aJyzXHwW^&N7peD@DP3PM<0?-b z@=p}mi_hch0VD+pkpB=-^*qC&&TM~rPdDA~DVzuc>-z$=v6aVxWTVRV?YJb6v1 zh5pMwho6W%7^jRx2RP=5q4qo1&h|Sl=yp0_$y8TN@rEsBy45!tC8?x;Mf=|2sqQ^D z*(Xy+EE<)G+zm>u^~DVzaAdkp`ANzAOuxngRvLs&6AuAiWA4ZZc74UbC+{i9CqcaG z0F3=)coGwcF@<)f3GxTsmMqQCA@pz$(PdFnC=cHf3ML!4r>8c94Afy8AZEh@G}K5` z&ESH_#H_4Xv;K%t-dc)3k}v$Gc|MFNf0@gNM5HC&pFo1EpZKfO9~oA&?+L@YUM_Aw zo-=@3NR)fZz`#N&D{r?#7Vabq68V&RaKVsX+ye#U`iupGw_V!Mm+~ zDXpB3Dr+Z4oTK$@u2jo<3xTY%K;J4R&%G;DD`Pd`t9m69I~fyBG`PAi;tw-nNZtin z|JXVr!)!UH>!BwY<#69Gw`D-NM*=+m662XD>B3nlwYB{ZFEV)#pPbRk7G+gsezdO? z5^8r>eZrh5KnG9uNAbe`x1E=-XG45$7BldXlWzp@3^;0fNm%QjSy4Z2rc951vvOP$ zM8${T_ep74iK|~u>Jv05wis<7`~PH~9kN@rZl?T<=&?t=;7 z$^8JzkXaUjY_2b)-rZXZg}#YK>G1n?(k+h9Fu2W|@Y@M^w6tu_M<4d%IG&oR4yig^ zSZrx{?U_PqROv%uQC(GR4S^j<99RJSYF16w>hZYey_qHCL)b3odGB+GAZNe)qM|dM zf^cwHVqDf7a3jfTA{d2Wg2ZejMSgH4#kZTeiz9*rMQ1beU5$aFp#cMkJgl&bU%s+( z;q3mRcN`WWHIWT2!(LB?1dd%|o5jX`jbX)&O7HO2+R$-4capS|W_s88tfreUZreb% zA?f`)nOcn8koSPHC*<%abF?(=`~j{r zaT>zZp2z*Ede3eyrb2I78X+6r|1$|n@NyN%#ii`AuQ5Wu7FUloxghU8Zw#Xaa={kM z$vJHz(&SUrYRvMFK zi#elDCOIS+q7+0P>_`%~{PkbrQ4XlEs#!A)bT2?b{eWpo#%Hmgnn%|qN z`KP}R>RQLgj*JMQ+qEbFWT}q!j&{fR_&73?o9fWh#=M~yy)3&*|tmu)c;R0EL?nu;O z-RKGsH#2`2?4P%!3EP**TPf)gr-7*)bmp}JOit-g*v=RrVdQZMrh3|F^?Y`WF$;KW zIg#+uAg=wC2ec3_Vi zxKb@v&?<0{4Px)gDjl>_qnPp0t;i~&)HbB++9(YK%EOJ%J7z*p${F(c2#`^rmZ(+x z3wGq5KF1POBb|8eE__S41Fm8#2<;feot-CDGF_ejvAmj-Nzu&!@h`QzKH2X+F|Svc z-$vfVq@)Z!E!=6&q+7e=V+D95qNX4;NuXRt)A%x}jslQ1#9VbOlt)lqU85T`AuUld z!H>OCdBi-$y)4$PsFHV=PTTJ%@j_vl^T<=;MTYLCrx)dK+?-=b142Hz4Ux4IU7Dqv`d@27^Ir3wkb&*@#C?Al301O;}^^BZKwJUuv9I+AHi)*yqy7ykbD}dqkKtwH4 z>o+RgXlcj+q`7ymsty}vkz2kXaGmV zcxY!bTbIjdyL#(kH~yDKaZmA**US9A$9zua6|)nVtZ(u~6Nv|Jpfk>RNX6OU z5)~&bthB`nf)<;aZl%S=IyXGN-7bI>rm8S~5>w}XVBb;oLbi)QD!mP9qEZyX@yY@K zM86$6rhuv-Zb~z?9CiGa9R4}xd@reNqBqF#X$hX*EG4DPitrRI>8dT zjqY6>b1>5-!^MtdX*~H?8{MO!IH!iIL==5nQJj#|Zp++@R?*T^oJg^zUtmc0S(@f0 zh3l_>CBhU=w{sUm6)~i-4EPbivQ)y{!W$_XSzhseCsj}R?~`BhEuJLzmzJUp(6;t1 zM40n0R*xNxhbrC#2@q49qAifRo~*yR=lX%eZdGh{dgxnwJDgfR zm(BA@`vy3W9(an&zy`i-_k66ZZ$`CIrSB6rOFD(nfwE-6E1ukd*_PL@&S^oH+e%O( zcxB~*@~JEIGL?YVmcq^s* zFG`ei5sXT4Hked)E@%WQ;LH4E;xfn#zgaOcH(EUKdiUb*c5{ZXKZ@n@jT-Ldj<}K3{|$cwn} z=JW1wX_%DolVR06J-|Zxj0pj{ta3NcLuC=QtmpJ7XdUpXo?iGO@yAiM3i}u&z zilsk5?}Dspf#{^?(qwPG+h@I_^1U6ig&y;`6C&2XOoz3KxYQ>f zvK!5usYZ_&62+#JO6g@H+@K?qyZ7Qnq8dP)E|-r$Jrz( z9#v<{E0g?-5k@fN-jh@Azu2GxOjsl1v^-ktaD=V`ddUSUIC#v-9`6&N8gSJVnR9TU zpfID}UL_ucCXUoC?)uq-~PZQz*CE7@YiW!B<@Zr^!VsE0Q|0<*uc*!#dE)S zBxf~k3xUI<&v& zz@5Rz9oF^lt?AO4?@Z%gYFlz1n1HTre&eKYnS;3t-F99uRty@%@F?!V;W`qztloV= z0(Tvj@m?FKj83zGf{b}#>*4Bar1K~A#=b`VV3*CWF21*5SSK+At5rLKwM^5)MWd!f zX2eV_$a}F!|(67|y)nlb{5Bm3{(0j~-a@TxRu(9R4CPmwP#2G&mw%wo6HJK|J;D!lC?`0C{6obkmUV<#U(b{gwEM?S1Fm zC%g0X1DZdlnWRkUT(*6Lk%NFKbjP_yo9w*EW+&oFvUQ(xY)U7E@}-i11zn@>hKTfc zwtiGZM35$PH15x?L#cG)qF*jY{PVxpc2)GGyf45Y z<0Z0?a|n%)%k19A4%i`h`H~hnTgs+e&<#xq_hmUKq8g8^UO0JKd~J_#}dE4%xXH5hmH^ zf{zsIpube8QOsJ}lAk+Bif}U%Ay+ceTMBz<2~y@4vW1q_ec*jXFUEXM#|dk*nZ0}v zKZ~`FfAZHDnLh;=z~px)2!Sm3(jAlLniv9KE%g#sM?H}H&m<^0A|2K#JrMF4+Zoe{ z8I`}Y$%voOoHvOF#2CI;zq^BM7#DB6Q7+S>=87do-yM;b1T|n~JH4$bz^&gYeD8oU z=kR_sHnw|LsRL{8zf!onnrKBC9(fGqf9QFwSb6+pIid{-5qT<_)Mli$$Lpzh6_tOy)m z*W7YSqob>5wtEvej3) z@|~k;N<@ZXXliC9iCjx4qB$0!&pGvJR*NY=hUP(MIm6C5lwA_vtyZUF3^nCqQ$?+rR5v)+H znV1Y=laazXXgVg+WB<2Dx-^l$k?SlMT`H23d{<0oQWfHfvdGMTgqgBZbJ#0N@I?=2 z=%U(sUY5-4_?Ak^2g{@u>c~7D`Sy_dix%bu6^;)pPWSGa$}M zsg*DmooJ;Q)e zfm0!D<(0A&#N!5A4wVWAZl}%lGefn90nwodTCRS2#-!@AM!#qc+pOf3;=x@-id`(3 zFGr|{^!O{n-Gyz`1X(REy`&#en#SMTVdkCTLdWU}cw~3J34Qp@HT#z*gdeEL|hmvV`eDDo76X48_`XE)MH--$VY3s1e^T^7?eXr!HgQ z{;`xF?R8Gq*CxQR&L{DjXjY(+w7D5!43x`<^nCX6)MFn3YsoNpI_WL4jbaoHbo;RU z{CqqZt@)IxCmGHPFcouZ7UCO%y`o$;Z>xW}_fe=Zk)aY8Dh%0z$@f&`v7vU>SSJ>I$AXLb5}Zi!ce5a2E->F9`F z@`93VBTQN*Ph!>LFXdV(ft^B`{pn4gJ#}Lz_3)bEJdKF&m6nw08~qW)MpxHdTdim|45!RqeB`JY7n2 za;wv-=vUH^43jaQXG)anR&HjWa}+_JA1mbpHzy8QybZNzhT!okU- z$k4A~Bs^Z!v9J)xY(OKFo!w!Dkwx0xj@`TuosSe?&R+!%Qw70acWdD~})WCC;s4`w^ zC}9Kv(*}9}4x4tQ80)jw z$c0yrFP5PXPc=R-OXpJVEQ%HPol2V2Ak5IOg#HshbAFPNf~*h?5&7Qkb~dsd89DV9 z{T!I-9;z4&E6}uxq{xQ1^-TPx)t;rH0K`t zPIjN~_bofQTGS*1XdA316any+(y43#%nyX~!mhdp;PMpcu$VZ`_7mHSkwfL9&#!ff zf)JBsO`8I4p^RVB8qkwgSSr!!^kKlUNSakV`ITo7X1NlC_W|F?cMZNNiOAynMN!H# z_vt2Z?UF0E08P*fC|gQ3My-ziY!zcA{#=-7(XvgW_c4oMvrpGx`3XK-}7S^{OwrI8KmV!LQdwqjnVS^T z$S?-lNM&K;$2<2kNtI+?^vFGLyL5NVj36Vhc`xl(q;4Szo|{%~MbJD+TCo-Kp{FEB zfDQRu??+r2$vs62Uv|?0hbH38l`?H{BaftgaOaCeWKT5DubojH{wct8QrV;0p~n9r zVj&LU`!)4Kqm=d&l@TE)ah)KW3`O!oucYNa0~-6zJxDL z3$Z+VR^*_CTIdh|~dG0WdK{t!xlaP?`Et?*{6+P-G zOs_FhU13QZGh)?{8nO4m@mm~WH=%egHaHuvc>u5q+Aab-j>MBw!xU6}e&b`34O+1Sp`E@ATs*}!Ka=5b>T8;Ygj9Ez~=)H z_a~FdM~P|3_{m(NDYk>A%@ATQUNv8PqOFU2`*0JJM4+aNGW^)pH>W#t;6vJyj|tPZ zw~+UZ#CMtmC>bDg-Y8%K?}7>r?6pvk2252AQPoae5j7H8nH|U;{B*im4K70Mgo$NM zp1w0^jPqD`#Kq|fIeQ{eKUFL{G5PUvRnOGq9rsHdy(r*Z@aYPCmPnU-t&t$ubW0E` zpS-~HFT0&aPVKG?n(}eZ4}T&!%o2t}z_DTMMcIQe$Y=$=l7w+^x|(eX^rqTuxvp}3 z_ab}5K23i+K*U<*=|qIhyLee;|9JB&+w%7%GL#`X-7uJ8HqU7xq0Xh6X2RadOdD^h z5vv|ZdPMpb$P$T}QTkvhkG3+}eg9v@BOdS(Nsx4PJ%Hd&_Dz+7TJN(!7P$52C5Gn< fc}4QBo2qj=_`%SqK-qwFKJc-zyl7E$)`RdrNvjXy delta 37406 zcmY&<1zVI+*EI|XLo;-zba&&>NF&l6N=kR#bhm_bhje#KBi$0xDJ31^J3im@UDx~m zfH`x{+2`JS?X}i!tpp8Jf@+Hp0SupWGcSOpIeeW#b)Yn;%Tx|e=DivuVZ&Bl{@hK2 zzvJPj%QrjshRj;h`jz!vGJn&LXKQVDYYra|zPIi9mLpM{m?9Fv%LYJ95VNGArxyN` zlVDCz3>o^zx^|Oca>R<|)I4hP^z-+bolTN(_3OW)(9GMW!ln;eLB?Pt?*p>o<0<>1F<4m44$#c4)Srr*L$2cz&KA|v~Pxf99{h?@14|{1lE0(z_L;HQm zltA)Oh|0_Ds>8=Z$)S zmW!v5k(3O&X3r>PTADHOv9V#kJzI}P!3F5^9Da5?uSpB3B1KZX|55+nr_)LZpXN;! z85tQ76_tc=cun_mJ*TROaPfRKW&Y>!W|lU;4kDvfZNP-Q$aFqitf+2i7<)A-qAE0@ zFPnEo4K)-epp9_v-nJcAJm8e7WD5fFaUx#u?wYi z@JWwNtvIO{hllf@vmzn2(oni~MuYBz+Ujad@d=9QeQVzJw35f$!x^b#Z7nVOn#;Sp zmieX5b0$N)kDK7^tP>W`=EbAJ&`aX~DW}DU+dC4qzuq+^^`etcq=j zlC*koBxi|ge-M2hBT9PxOU^9Sp?!I%aP^T$jqGwFM}w>9PA%3uDJ9P?V{%mfFcY~J zVRUlMg@VgvhL2p;>`YSiJ(M41LKLkWVo%PTBbHLgLwfYW)%zmrtG%}_=Xr??j5xG6 zy%9Y*`)-I_Fk%9vdjUJqxSh-SC(3?K?-)_;d2Jf%eb?9BRkEKvnG}Ma3SRuOMJ=sG zyT@kD_8kK6xwNC@wvU~RnkkzB!noQC?;^}aN{$ups}H7-$&EHb0ZP#zv#p~$oX@&H zG_Hq)E4Gcs^kTF7$JIj6!}9Y-eMkuK;u~ng7)!lQ2Enco$iVjCeeH1!w1XOIB*2!X zSyWI>Ftp(pB4;M4W&(QmxhBwQgW&LwO85~1n`;a2o@R9?>Cf(>CnreT&@E*??(y=7@8#BQDZl=aNUJIx>2#m$ z{?}fJVJ4XtEUErFwEW!YM^-D45$n%Q)ia z*x1ApIu>gG;bxvY7lr1KoZlVp;`?33Q3Y%PKUfOFH1y zxe8QIT8Rcg1D{efbuwm=m)zs=4HZ89W%@j$R+OpA*iGWdV`Uc{3K4{WJ^{xn@40g= zVHKJbG3wYEVu~)STZxHbt0kGK9$Alo0!$mdV_5QKT{b{2)X91|>?N@%dD=Wk*2Ccqh?ZQq*?m#<*rJ)o+A{evSSJU>-j-hdZTpt~d$6gS4j z1!)uc&kp#Jxa@F-yu90tZL4>Pv01zH@M89YBpKhPPL?R1$ugNnxY=oD-QSN7$eA1w zwN`G{{!q}^?KA<7b@EN}Mo4?5dujd5ahn=4I@Wn5sv^UV$1kr=Jv^>e8};1Rr64LTee`5wBEEM6L#TEK1ddKI z0em1)B(qp#N-hw)l*w8QPFD9hKN&Xl3avv2oWnwF@0yV&>{qA>^0I^PGAQ+PY`cLx zVXXLKAR6llFkXGeqvV18G5{lDJZ~?EIFKIk82!Wa;T5NtlQ4a}(5oS?8zO1~B&|rz z{fZup;a6#d5#UaY){7eDFC0h{J}8)2mPNS$s}TWLg$_|*oOD1(tuW4~>WXoi%|f)n z%4tAiPK+?)t1K~9opCKnrazXfnQ`AAYX3+);J6#`_e-E6Ko_RLyQp1O`!G31M)r}> zvosj?qGlzaE_{Zhfsc_%xfS206H`7q4uPwk~(yi2Y? zPca}Xg?J00HZN_H(9{%hEd-7fTL6A)!JQm2O0k)i$%D84+xSJv<{4E^JWU_Fj$Q%& zmO}Z(TM6nM`6*X0w%(39dnd8X^ZcSlaEj{&H;6nCjx-?-ntpOP3*N=AlyW{Js{C~) z*1dT1E$d#GO!4m9CPb6bmUHvwm*^Vh`7)qznX7nbDlrtr9?KxG;ex%XtCQoxq4QZK z3i|fZI|L2OVr~;};GTq2P)TV?tVt3{)mK!EP(vnQfLbE1YUK+>4l1g0e?Qn01o{=| z*>7kPX|+VHi~Rj;C~sv2rXAzEi;ZUYqt z!!X47zdnxTbqTid-cNdqQpBiD(KFNut&0G@hL1|ZOd_=u%}opu5i#N@Lz%~Ft++v@G`Qi5y1&EXx}grsO?g60 z#5bg84ql=T^KaPNOdkyoe8rVXruf#byvAt)eJ{5Sb+Y>wniUbpP4KVgFJey=MhzSZVe{F6* zUi{Kbh7`l>JIw>ejY6hob$Ubb11kpqF`EMNQG=~Xu#LjOFXs?bdU#w(0VMxiu_YTESn-`a-m>$zym5LB zTsrhf;PaBd6|;dj+7Zya6EKlUge*lkp0XX?8E)|V`uuVb{p^`TtJx~5s_5PPzOLax zpSiTyb+ER{HD^xbKNm-ihPyNb77P#Q7Dn!VAn_HaAuu05P9&(s2clawKT9IaD7#`b zy*>c$h+-jvm;L>z)d#M!d9)DN`zMd&Ut0Kp&B(qH)Ebn3&(2BmN2&OWMp|GBT~jM7 z|8WSBW558e&T!lh!OD*pXv zL}P}ePpM!m|Me}s5D1b+Tz z|0)t6=sLPO8SBmmav}=tpNlE`QwZ1Mdq?8?%I|b82u(~>bj^OjrBF`fyR=mcoQehF zTEM>q5-_RhZjWeVgNp54OH!hUdwJg$xlgS9CWa`G&vucDiD?ua>KBZnhwp(1e1YF0 zuaOMMHK=JftgIBEQght&xyKXO1S-V&NwH=-nwtsEJFnu}P+;IStK)!=B~0S#?S?60 zCmihTMvk9#WX>gf8&5cA`!Pm%!d6`sXUs%oK(A_slf={7{buqCupEftEg>cd+pK0; zxe!5kkpFOhEj10wpN{qD`&K}|K<$3EW^F%j@7Mev-oil!Rzg}fgcet6Ay%9j z*m@Xvh%z(+?Qp>%sT|imL}><&Uv+<0{=i`sy+w#IgUb$uTzmxnh2v`7d|eC^e&-{E z4Ps+~6mHhUj@w`>%{ifV(i=Jd>BfF+Vfx}1OMC}VncxDhg?GZ_n4ADNM)mg5W?oqC zdP=`uFfp#8C?z~7q>dRD(t8!F>dgkSgLd97)@|oR^gbTi`Esd6n|^IFTcsStM^1pe zW74eRBEFD#0g%3k22c*+)|qE_V!>{7!(&Rv981<@@@|yqb0=X}lI@J4^txgG6M2Oz zARjw^T%m4K7N8fx2CEjr2%t`!E}k_R`(QaLHCB}6UaD&WO8MRWwuZyu+y=ZoBzFrg4*B7Q}B=NG!Yn$b~+tG;$cHH}&uAfamTtCx?X zX}s|D#Z4lrc=j!Zd)Ocqe`ovw({~as&}j%h_XjYd;leov%sso@(`U)m@ z1fe*HP{JyjYq!rB+c6YCM0aDJuc1W#tcud#sK*;I7);L#)z+i&gnHg;B5$Bpk74{P zu1M2uW0S#9l~gPmTV@k^uxu+Q6)E$q<5fOZK08}zWMq->RP280^1qlE>If!69MJ>q zo!r3XH33s)@?L%5o*d5ZMgrViZ@lQ{O7}|a$w9Cu6NnuUprYr>c3P@7EUUD$_&}Rg zUS3}7b@j1L({Z)V9J#)sAw|k=rT$-+9urVXqvqR4_9M)DzK9n|jf~F*Ps_gvY@KKmkA#Arr(f~)6&c@Hv492nehFFjr||!?A!JT zNNeBxxz;!u4T8R}6-IB~ zj+q(SKo7$cl9GaKtJ{#=w&j{UFU>kHhe)Xea$o;HKJ*L!Cx9fCO+RdUS`7~$KVQ4X zXqqB-ra<&da<1s-`g(3@Il1wx8|EGXwpO(cXc zU63l$HWNfUzKqmTPPW8=JFqSx67y4mE%zzc|7^UuiY18y($1O<%|A#%# z+ZD^b2V_d$>1XUW7rhAFSbx$!(=tkl89YBftEsC~uWs3E1_uWhv&S7vRwRvz5w^5HV=N4!2=C4^Dt{J96@vb`GEFfJj#5gHoc z4TzbAFZNmWJ#oqVVo#9qkWd%sM~6ZVzk^%n1JEhO$wEUzJue3d>s*iC3EgtJ>?;Xb zy&M+CD+F`fEpzg8vuIZjRO&WxI&MOrFNZ0Y8!WMKaB(LNykHq057D{7FJV_BMmU?| zr|h2mq>GGzrgfc;^a#r|zNqJ_7sSyTASCFM<*BxM{x)37H9}S__Ireu-}>g}ruFw2 z%Lfn57W;L_s|kT|+cL^@SiR&$1c72Nutp@kr6KGwVw9FdnMjihbab3U0$z(bB_b!^ zz>S0;_8TZ39b2rNqBZaRVxb(?UgIy3k{1&K*?Vs;9 z-8)Yh-IssYeg9=KOPM?=ba~5H@v94b5bQ~AcY74P&$MQ0WTqlef9cN{pQwiWjx$u{ zmTdS)6RO>M+L}%Sp#IfZw`b_R!*3Hk{X8jdk6bbp@OjW&+=?SG&1t^Ut9jNm&}{zZ zN|;0?YpFP)fzG)}d8eBF7~%zDI*xr2tr5PPlno@WuLUr>n$t`2(09&x{cGH>HuUY& zqp=S+8Zb%GW*ueq#6cl^>d}0-QJp<@Ox$NPTR+eoB$Sn7lfJ{67>$4IU1?|48lyHf zG|}*uY?g|8IKr6{7c{TjfcEC;7teR#<(00R_bmajQ{WO;+p&rx(3TSb=R=j_NT`Ec zBav4m@96(b7Py>Y^PFt(nug`@d;8ymH-EX#=P;{w|301fRL$N8Kn|5)Amm8N_OReF?W+r<2A?8>tSQ&-&lnMW-&g^nj9QxrJNehR% zc`}~!Y88(!Pr%Q=lBJqxHPUp10~^5KKk_On&12t?|8dm;!%*S5_1)%HvOwRhz@l5m zkRc1{`Q1^io6zv^opPDWh_5+8#I!ZCx#E76lUMMx(<`u!r>J3F-9COCyKJ#ST{pi^ zRUb1?>l9g2zTun$@+`gf2A3OrlZeJrV0|B11>n4VxB=96q2k;VYCo7T{ zyx#nhw(g0(R+PbC=7F%g29*Qac&UJXdI%S}`rCv9c|^B?CTc4HnG8pL49$!v$N zi+I*Tte1sqZ#eWTb0t}`-%Fzl;F12TPQ(Cznh+w=pS zo66#K2HLCmE||QO$spqT@1s+Ec|E37St%X3b<~eEFn5l9a=-L_x!B`VfU#HE4GcL}UH2JZs&kH-}?Maa%W#Fir`{GWb=P)mi$e_Z&g zQA)$ZgUf3uA|^(DkmJMd?BY^Yaoy7YC8ID@ZHh(X*6xC|=Ed$k2?0q%WL#Y84GRUPTa%&pQE@#H zx4-np(u`TGmfX_h4Hw8L2&yA3hRSd%aW3U=hNK1e-0smbV?f84N!q^>unf0DhoawN zpR%r;dc5Jj`f0X-%KTyq0A6r;VmOWKb_UTs!M;O|5{yb@1MTF zm7)wpsd+`^gTY{^qhqb8%uVJ1Yi}F@KNWeb;LOan(9TOFn^_Z!Jy90szXnTTjI>a<4Mhj7(TB$ zE0cKds7SXG1j7-BI8B1u~^Qt25S2D>*3yZNd(2XCOI}_Orhorn`60*${ z^NLhJdr>lb1%wum-7L-ZmozcSBa_zt{dvjhAlqXsO*~eU)u>Y^r$FNL?PvNenBM%p z{)gS@PM)r=g;kl)FIXZ>^BSqh?>j%p1vYF-@G(L(40m-IC3)&TPG&J7PqQ#HL%pn0 z(?mKkWEjS)6wrqvwj|C!!_?q-ZDD?Xt@g~Qj$@V3(FLFwd0L&?=&`d?^lB-waH)+Z zx1rsGa9#2A!I$Xxz31JH&hF$Rf?}ys_{K7?-{)=;>)xhjDqKP`!B^wMr{TFJN3S+x z&aRX4EyF(Ew(83hdZ*7Wwa`i$GS17L+pNFk@a7lMv+{PhawDJrQ{<}NRH9mU_@n5C zK2=gSwEqvlVyHGIltH3o&KzZ`F*`a}Y)kf4wXKA|cA4jDY-~)rBXPuQ za%Sb1+*25WAumTgapTDbdgUc7J-oPOr6Sf%dRYe8A^*u6eah?plyu0=M#0*ub9M#9 zK(!@c*}r`(d*8j8I8ZFTNghpM_}-82knOR_8ZH^hfN9p=!lH;(ptT6;+aKA&uPzl6 z3zwlW0ZUZ96cI~n%v$q?;CaF@nm4UTFHbh=RT>h-)kqT^+A+vS#RPxWN+M*ne9W(6AckZ$H@3Z1o(TKo5>jKs$TALY zgoi)tw?VM-eY+$9ReJ2Z;ELr*^ew*@OlqV+Y5&R(=S$p*i7RPIJ-v_403+`j#S6tk z3Lf0u>i#4jA4fPo5yPV)rk)FjsoovrtpO&|KPAPUr4(2v`OipfuRW{IW#_~Bt5KUr zdr@Mb46uGio}sI5t@2hP&mVAj&f1SwUf}~1!e7vsBQ4_@B=?Yt)3Zq;2>bg5#d2r$ zf?cU#jlVFqUG>-#_94MmFs;PkmvuN14t88 zfatbBhTwqn5wg0dWw2pB(n27_YMM7}tC_VSzW|-~_(`AsQk-_0?jI>lXU`*0&j$8Q zti#f8xRJ-Nixk&+q7VDyT>Yh61SuSoyq?)!Nu8{E!N4?S2v*0np}n@2rYmR&o7MtK zkqo;iTSHb0jSXLP!xG&Ynm++E>nqJaY>fxE1dGbrw;I3nI6ab1@qJ`MrdQ2jeH*mB zvlCy6;@+Q(cTa&;^+`9i!?k5Tzv_uCbhTESLhR)AX<$d!?-X9udp4%_<<)lvyzK`A zKW7N?Pna+XLRF|2B~gFh-~9w=`S>)4=nIK0@Z592MT}bM9fP(Q5j=qa{Q4_ynT5*o za-2XtQuDtZidf}o{>zglC5W?EA(WL3?VqCw0b41G?U zxW&{Evnw&dA)_j_3YMr32W1uizocXH*Q&F7AU{_N| z!=8Zvts@ALF=D$+g9V%5gEECoej_dp4oMBc(@pU!D?y6cT|}AR)>x9zCVMtD{hcgX zJ#rFyRqLCKZ{b)w)g5O^t_|8oUUdFXrvk*7Ifs@^MLsatbnyh7_hddukIaccTELp} zGd_{C%^v3)NgiTv-tA`l@hWr zug!BAtQ0K2f1&PUWL%2|zCYt&NOU3%tma^9zJ3a4xWfd^9m1I{?AWa9ettMzRQ;I2ZrM~U_IS8Sm;m66S z@)%<(m1oByL8GJAl9Gvdl7fu;(N#U%!h)KzZkp`T8vyU@+vJrKC;k!ZKjKU$DA2T! zodV4c9qk&-1Rk*QaOC4_B*t?>h{KlbcVGia$vxS=&ax)qj_jJ}SMJ%UXPz zI);9Ic@ifV|8e_aBNE){MY_oFC(iWBA!UaONd3h4_YnU}k~gj0+Dhu^zMrLQDX}bU ziLl8tOjFnTTy^3IR28-zQ&|nq4Psd2X$|;T&an=Sc-0v7Q}RTW?;*vs}M?%Km~Y zQlQdV`%BvG%1gFa{~zyMydFMv2ZJL?E*q-n)Y8I|_C^FewRljDXy_6Wp~|7~za~rgE<^tZ2xRPg89ISp5wGpf;=+)+AhnZ*Wt{7n zS-}&Veh8UfrO(DC3atLeS5`Zhwq>)?BxKp07)A^tF-{2d_H2agUZ}g*oN5q6?bdF& zPdU-hPUHW}<@jgZKuet_;-tvA=yzd<=I@0IQEESSCi}KK&ZK8H42a&tAHL~J9ZKc? z+382+?M}L4v*Mfdj~uw*-I(CmPB+dtiObQPql30<5eM%m@6_<;U?3K+-v{ z)0fl$Uu<#puWZdpM52UjdLe6T1~6ET19O;t25Pz=nPCinWM44y4$NjaBy!$K%VZtN z5u$?>kIKBtrr#U@dab3cy#q^Z$@5J!Gc&En+fL-bAWaXd^OJFju#h6Vanj$d&OZ-+x6)r>c^Nd`I(gZZvq`;-W$yYb z{{7b&j!aIbs=MTRZljP1IZOZcz>Y^ICZNfriAy-|ep1=*IBj0#gtcI!j&CIZnt!|i zUgU+KD;x1=m=|&<5Sb!D*0L|?Rs9b_V_!)8o0rzt{4O5SMz>HsZydp{aVqS5jDenQ zOVjfbD4rJaw1Wkk(t@m2h3}@ZnC68L;<8Di_1M7fCKLZr)}|PE;LjB@%LiIjAF}IG zd6Qh-yf-quFNud!-kvCfmzp^Z0yN_w$d|{*V)i%by)D79qPAs$kWl_M@LE(8~sR%nK){2Z1i1JZW@j zuHS%Pfvxba)w2!Qd2mq(AQG>sIgmmT@;ld7R5xa0^i2PF!w>OC04g@2_{f=%%CB~C z3=tQ|=Z@dI1V){GhKgQKOUb`|+t+d4&C=0yJh+R76DmDslx(y|w$~u4YN2V7m*aP< zEBdheIf*djcdH_dttb3#P%}*JIA*;^WRDsy>!@Nu$rc6)yf`AZDztQ}`mz!2Ej^6c zEHsP))Ad=ZTS4)F=x=cM%cHHuhYxRQxx9W`bpCyLy1$xwLr3W?At8||QNWdWap9c`?0R@Cj9d0ZF=a)~B zuU$%;fAGd4F{uXxpv3c8LOK8x>q7;1URQ}cZNvVmMEK4Z4GJ|mU_Xhi11Yk!AGWFTOZ5y zYyJP|-6NMl1M&SD#%nqFalbV!p1hGqQC6q!m)g#M6L{$u*>6xLM+-I7od2MytIIUZ zJ>r?5d;yZ!eU8Bo)P;MRx3;%-@90)U&UN3e%w?irGBE% z*p7lzIXM&9UJFM*Lpae7c6Ea(Zmu^Bd1x)h9EUc5@q`iWQyH5nClUHGt)#)AvNE=T zy70J$^WUF8=olmBmy29Lw9^a!(&fULV9Qbrv}!Z}t|?vz|2h8)GchBwkd&n4#oSf2 z<9g~Vc?$8BEbW!A{92~UBkcEbE8g@96fnNt@D)s+G2Bye5&47-CY0UDu*X$1CJij5 zU<3Mslrtq7mN}l zd|VhlR)~fXb=;W6eJ_kPg43cb+-S|z`Fe=z*S6>$W}gFL<$ygTU|m-SuaZSftV@Q7 zUO6MAtgMV+>Iy}+cMihI|K-B)QY8x?;L>q5{+hV2A0}=lOYl}#3quQYWN^3FBJ<;Q z8TvrF<}FHz9rwR07=_f@LK&G~54z@S#^nMpLXUUn9Om_E*qnO3l9zf}TvT}0N&9Sb z%nCTn!R@GJ1|P();>blT(((R=hPdX{!m-8#uwXL^ESmT|n0}8Vi+baaBB2G;BJFq! zc;m05mBY=MA|hwoXxwZjF_!tNNL5V`tC%3RQ-It%YGDXgxD)29b`}>6rPzQ$N0@3r zZ{GQjpe`;h#-x?G)O&e(a_GG1N28i5X>BFCTlb*6J^#s3s62~00kegV38%8^f->Nx zAgo8CXtbNmh!Iaa=|xunb%Ddqv^a2$HcQPnOV0DZJ{2huXRwUmg`3E^r zP|kh8pzE_=R&^(Vj0(HEyCa<6#<)H)VJb#~_ckMbtu!FxjRh9GgJDe#qZXS5=I`k| z$nzMo6qsIoc-cwYyPqv3hmOWMdJqTOEKLy&Vgn9G`@f*z9|E~FqG*tmBIZIo_zbuh z!BZM1Ruz6+H-B;TZ(oqRh*^CPKO!C?_2C@0~{^C8u>phEw|M3R=cJ(zyG;d?}`rDlILaSGwV>V9%_}8yBZsGA&f}akVTZyui@vYVCjedCXTM$ zhHHb|g{^(K@htaxKuxyHFCDnVqd(;wa>sHMgDwmAOhVKvQyx+h+BUM z%5Oip^*c6*0>l{Xc7iK6(sj4N@-sZy1BTJ-(NXVI&Ub>5vBvJMjDbI|9t(Y%eIJ~8 zq_vIx_`=YM&BX1`v$Zh5gKpHt|8y>E@JMv)^{gU!+=-;gtYQQ@7*d#EDe;DpF6gxw zIv#BpU{pV^DO(Q{c!$vxwRvuBgk~5Ve-`>VJ z+&>96PbanlM@S6y5pvDn!B_16@xI1=o<4xJ^!l^}5aH$6lbEwHWI5Y*eWu-hgxOGk zOT5bkNd8a08x_}(vr~L+n?WoMb;HjN_8W%~Rcfv+nAY;w?bk-fNEQV#7oG-#UqHqW zno2!C%onG{+rsfR7S~c3aBN9|11u3-m?1LLLQg6(M(2qjV zNqFU9lq9p7nG@eqLsy(WAJzM}Iyzsj@kT_bf+abqKWsipE4-$sSJ0Cklf!x~7Q^eP zQpEh80HZpdRAAEJ`|as!Vnzn@upR(509{{fedFf%K%-a<_Tt{4!h8CO+nq5IA+#!| z@Nh)i`%i_`pVdd^6Ibn0|GxC8Hz!+M5a)f=9@eB(J5gZ;Pln@uzno((z(Lv>M_?yW zP)CY>jsI&it(K>K&LL!AVi(jmkk)}*dpH0(RH_)%gY0$4w1CY5Lj z-QJ~DGbZ73NE)+blvfs{J{#IKkWHP%85lcsydz9fFBs7I$xMmJ|9)ePk*9cbk0gx56=d zDo&dQ6B}VKH1=%_xd=fikn7)0_FTdtB3wfJzUVMAB<7Wy1|*lGO;5TSc zr2dO+juok%Z5J8t+0snJc z1mU0Qd?__igkoEr%OX~k!sLD!o4?E6CGd5;8#bpgYus9lCXMwBekK*eAb%1%sf)hyAFt_XS2udS4mm!12o& zs|LpGLvMoYjM-(vL|-GSI2EBz&dES(C7CTSn43n%bBuHV zu88KQpkr!@!9a-Df$+2kFU+YFm0c1hI*NmkG074r*HQD|!#I~+&q3H%7Lt)cawSbb z0-UIYAT7NuQA(%zYt`xbczslVFyxGbKuj^tZN(}L;l{IYJnVX0bD3fqW&hc117&aB z1PKNGh0)-nDMyw$UM24%pfE2^Cj>sjt;zdh{X)~Wu1D?rHCmPINFf?F_krYl6r4Ox zWzJOKI(EI}>(!MBjxQGMAc|nMr4%thl4$otuXxL$pf+wm5-svXQmyWQB}h8l8ZUPXWxjFdJvuu_hXpc zV7mJ97x%N=do!hJyg^Z_k4m1yNP)Lh$pxcwFnk}cypr=}x*VQ5)cV(U49_Hx0OTyg zEk;7DSU?D2hjqW?kz^l{M`?Vc{1Rsj1y+SADDPsz92d45Wzc0Z`S)cY{@Ie*-sV1y&-J^t}z1q>24np4Z;Ep5hQuQ zFV9!1ZOloFPHI`q8M3lGwN@!b^;RPv^ql%)0-~|yZ*7aH85tL8Sb+kHNch-|@JAh? zF~3GNWjqaEgetKFl0pivW10au{wiJPL~jFD+D%Px<8r7>u*Bc{;WrjUI2j&FiU&Xa z?hL2L8LMb8?x&QrXYwhEsZ0jl<(G>7{^8f7utfh2yH*E3{jMhVJ+*~>J$w`9}N3Q4EBgl_$jOPTtgOWSV0(8} z9T&8g)L%t{-5!xTrva5Bk!E<*jY=MeJsDCEOO%I+w&o62hfWA5N>tf5hM#|_-ozv~ z^YWGU{|on2zrD!{s?ue-&$Lrp{o82 zsSOW6WiFE;V@<*_h1y7#PbbV$F4wPQt-l7b#gPiE_$rBnm%DGTCSZJlJblp=ru2LR zsv-9TUkB!m=sIbes4eU4VRwx4o678SUpeLRBes-?nu|BLNGXyX#?z#JR*T071sqBb zw-r-a`%YVavdK{CejogL=|!yToqI$k>=n$3x9_ zPtQ&lWhiezEe$6>&K7|hJmyl|cpS*MwU$yAk2jgkNR01j@RcYH=2Bz;S<0Xf1q7Vc z%WuOmVN?$M5;-5Zzuciy{20Mc1SlGL5|56KYAuwcoI%fLvA<-@tm=K(MyQd_(>8f? zjY(ngf;Jnb+eE8FY9lW9;QgvZC%eT1%Hg~XpMT0TB}z+sg>%D7{#iYbf=o}fMK>XB zW;`eC72~|f%{BHFl^gKq_c+J>6!1ce0iN)s+waq?(Ap}msP3=nc|kR!2VT2>gJDO_ zq$|j&pc6j?V<_kq+UruB%lLl+_3eARrA95Wgj>{ujcO7X)0p13G}8`w6crVyTq+@) z=^Wj+i>Eb`cXXzVzx=WpAIvId=b~E*9J;9Xw}^DKT3y2sehcb-Ml>}!tf`WufU7E{ zO=99Ez;n*-3=Rqcea{pCR0&qIyb@ZItom`(w`b9pw}KL)3a*&H2k-XrTGGGXm;B8; z!Xk81+3=bT$x9S(<4;MZy-mdV{_{+V+>h(CL~~IF z`3nE??ka-}pCG#lVTnAq_`?d>-wdRp`-@5`MJ3OlT!_ioY6|wn0CKpX7zIoLf4jb( z<>mPBd#`>xs=cF(#dbK3{I_$c&J+dDR-O6qt_}qk<%?U^QdoN@4by#T^k6l7zIZd2 z`OpZF&aQW&qD&D3+2s15M{u+U3JCeStv|r32%d>$hDu-+IUX}cV9Bko!z|!W7As<@ zj)$>&n8@!*Nhwb-aQwXu<`uFc1r6*$C@DEQN+N<%i(n71uDSd6hizV7)4(T{Vb@ri zfp`@|qtx#q(nB6gh90ALJQG7S=V9%mWn|jX3QAL-tc+0F6s4miFKZ)~vL2U3m7SfP zMV0AD{TSnjZoFoLlswSfM=ylDY_q7b1Tm5{b`yDx5ru?A;fGB~(=GvotF==_OMT5;F9>w(0$ogODz=&|L@$}Irp$JSQ68Bp){>&dj4Iy{Dtj|xDv9sBs2y;)9iFP z&OI;?ad5lBy=sd^%sfcW(KtG(kex@^3c7{slT!hOzlMsT&cd{tOyFl-Cq#$+N}h_( ziTglwg|xuTx)^EcbvfpTJd1k@yV35SS#m30#}~@?Z9Rv_IL0BYuxWCW=m0~kkd9ir zz-_#9>3~IGni3^ZzUqaY?8<(U&xiD}k@=acj4U4}*!G)#lek9B*viJRtRfD?g!bNQ z(=vC#{2#kndos}kqwJMT8YMbkC8LdWhyZv8sQ}3@h!L+s8a`$R!u*+v=iWb=6!T)q z0~0n$D)#Xf_w$ z310qN5~(k|?h+|@N41*|?~_w`Uv*^OABgD)9s@x`&GDL-a^>!{ZOk~Z@i+)TjRqS| zUzX`TBZ}zC;w`>|WveuoBKN~vXX_M=G)cP!n-PO%>3&|d-WC{I?Xw2p3 z5g|l*ijF}REhi8cSf{_E6S?qK+ypl07YVIE3R%SHgb~3+!mf-Zs=4edVC%Ertxh{c z;@GOlLg014vuBX8*U(nf^?1lWPC zBzvpjS2{duV)AE8RVme|I8pJHDyW%YuCIUN+8aU8+C|lJh4BxHgUr{FQ-28q&ESa! zF^`D}qFXrhVt;*y`6ge(!9n5PN=v+tx63FT9S!^1!AbQms?z`s$bA_4k4PmB4kbW; zr}NLHw+hKiZ%s4I4ewj1yI*QPjkuiYy9Rt}sW}lJUY#V)SBz@pHw~Gudk~rYT39B|D5;@gkog0 z2eA@$KNzN(hw7CYW!@&>vuJI${PY(wRX^1|Kw+^>?W=}I!NMA@YT1Z_$pf3&9vkqw z{YgnU-?M~p|G|!|P?+0Y+yYS)H4qxhu|GV)3Dn#zH#1@D3m~Pty-!)_t0^InI_Z&? zZy?s`82c+};_7>@8QQslmJbFfGtif)Do7n9xjMP5iTz^c_3Cxs0gYrtI z2!KXjQ_$zz`oo&mbXnZYH8vRA#+p*#c|ET~f()}(g95kzhoy6HsH}azezskcZQGnU z**2eSo@`BS(n&K}lkJ+CYJ-PyYD>sr@ZpFO3L%Rj?u5cN0J;Sg0a z@Ek|u_lBe(e;nb#J{kl=Yzbp}eUCu6Cvw24NX*Sr-GnR%iyu4RCy_ zBZG>pN{hC^J&SfY-|*bliVi-;DH{G zf3z6<3I>zgaYz3QBS556%7UOg|0Lqqcw>Adh;*PVsW#0}f^!R}7R}I~EsRE4R0MKZ zEv`HZPq3pIKtzppV}aEyQSHAO`Clz(L3dJb;^B}!ZQG9FSxAObL4PCW2sPigSS_Gi zPjYzrJ-_j)jx{|=7&YYZS+8fjCN{^kbhou`6BuzwHoiTmyn`5{s+|CDdE5x8KZ=O| z-C)~czC-HL^}v63XDe=QSeWvl1R@@V&lAQ!trOyZ2OO7XjvWo$Y|>n~$0l#&s*ZiX zL{oAB^lGp&nwFN1&Y`NPw@uN*OFqVAo+w1_Q2e!l=+Q-g153M@*AdhD@+-IW5mf1F zNYTALOf;E3oh$oUO=vA6hSh2yLXBdx{c89(3ON*#6K-Se2x2jp&)!2IXxBT@mCAd| zIXV1mTH=L>PFyV6e=S;Ku*J>BTWU*~$P^RSU*zS#;rY4U)`sh14hCSz;*aJ zshuKpkRJg!Al|bV+;$r1*TEkL9@&4c{G5m@9R-6AuFg4gc85>Jdob^^Dbc$?Ro#dR zi3Bfm(+KE&P5T0LR1)#wjRZLl z{_bIK8d3~KNi_DCSpqT~bgf>J&E$-Q+g1Vr=cNQw1XMu~)PjyNtcIaV;fU=UZjsP7s6p3O>qqz;@^D12Gzu zo;!xniWlPlG#SeISzDu6vdK6B>sLwndWAWbAmP@0b>H>?BZ|?xD3e0J>Rs*+ zqz4ycC*TeT0@kDmMxO(YxGN*pIZi-57Np4;efwPbQQ}<^5s*^1KJ;yLn;@^kc*gU} zMM_R;6t+%bXdF+8udnHA$@;`-#aSIw{Qype?lV{mJzN<5WVp!A1_*bU4>_d?Z?-rW zj8tWaxMB;)>PV7Tf5$*w2nv;}Pzw$H!hg{Couk8BMlQPSl+SEn;gcGsrY#8eOT8#^ z`C}h(#1axNuz%}+9CjZFBJ`4YuTy0H*1+UWdMt`#?FaUcO}ChUNK6+hD6!0o0p|$+ z2_l?7$CmgRDPYDjI26>fN#2z@jLnK}IGcrB1*Z12vra1*f)H&C+lAn1Vy|z`|1sdK zGf`0VamL&eLMBOUuR39a*!heJLiVl?ohfvE!D#nn@|g@g?Zm{_WD%5Scp5&>j4S)v zslHW4i$S`$V}PFvIPC@2DrDAH@ksX{$^FO2$NYfpmIgxvh5K+ue{EjRxK*2-AH$0reUI?ITCRF0b2DLvY>_@*WLjlSsDnDj=;T-EGj zFs2I}WW>6>9>axgqhZk`SnJeL&-N%j=sd3l(6G{H7)QA#`K8{PyblaXsiyN0s+c!p zCen{}iM)R@gBDePgz8hFgncj1Sl+ObBg6=9y!i`*yhHN`JLxPpPBEa7V3axhL&fri zp`UNZQiy8CxtYeKfKFkir1n6924V`eqdr{wA*%eTf35*Y%{bV2V(u{u(}fNSUpk@p zY_!lC*UK4Q+^!ss>~=Nw{q9TT;&O2Em_5$t^GFlWF{_z4(NDmDxvbL$EAo1H4be{6 zHQA%V5IO)CU5k9{N}6F`toFOsR$sRQ`}l37M^uTjOCcBCi&GNPw|VefLWG|iGKTVa zHeTD@mj+sj>G5Te<+t1IY7^%7o*{ zq<}(wVd3D$Trnt9Db2C}mynn)|F({bWEMKgNR0bCO#fR&)751d#iWhiV z|2uSg5%5aWsGEM^n9!%O?*AA=)D-)J&gw_@`_CR8eBwXxq2U~aMVB6RDV~Lq1>Rr+ zdt}%`rOvp!vet56_Bl~<2=pg-e6AtzuE_m56+R{w^v>;)Ns@}#>wNXqp%4LC&14)V z7=yMVTwzd4Q@$wwr8B_x6SuC97iZ{mo|Dtc+gP<+^$D8Bl#e^nUymS|#Y94o-NGp7 z{uKJ@C*3c|H|0<0j8T-C*dqKgdfmXCrRh2c5?n4o>}TA5G*}nupwJ!1KY6n&pLLNc zaiZ}R@ReWnLZfF{n9SJU07xl$%UNb7GEOKb8PgMq+Z1S55eilKihHi+mYJs^R>qi1eXc$Ms6&~5b-qC=Mvlx4)xa0ge^K&7qRL3o2C_#TKhrFLQFDHeRCv(WpoXM1%R{{j<0bN|DspoROL>eDi0f;Vk#BViHYPc}zh6Li#Sp zRTnMz^}%nc)`YE^_6whd8H_L@WUO=g8C`!JS>~=J3uVy>2M0GyjQP6qBT~tnnc3oh zF5fJU*=Jkxx7z{T8l(&d8M{7XXsaZZy{LE?eR4O!x0NQWsPRKNovYT?HaI*UH9=r* zyQ9?XE1k$?4=_2Y=BIPJckX%B_JS0CIx6PG%YbhV(=vyt!iZKZON9%^()qwbF*%Ig z$|=S7X|O3bja3TJYJ*3}3R0{*BY{ZDokXvjpVL-%pz9py3!nVk15g>Pe~0piQRmGT zrY-~)4MFt+;)%f`2Aig)CVFP(n}>2M(omMl83_b}A@23(S<#Wyt~ZMBMo**quh2^L zON-n04Ma*9#-n5gUS?yp5l#Y zY;=mQ)bT-hUu26z$YLiAbaa*oS0^2hs1c@#Uw;+8{vHnd)^ztn)iOQ1uBkzxnbUnj z;y0#|*3;OAIfTg2`gOrSQ7Nl71hf9Djo(?9XjI$uP#=RAexll9em7A*O0b55OX3hz zKM|(O{kAa(1@V5sabyJ+TW4v9s2-_HJKP^#pc@1?xNJK37Ry3V_BST7?z@C1A8$mZ zHB2W`2ym%o_iiive~ppKit|(RTe-F2R{OSsVHi{pde8KP0J=rGz})Tg_7Yg?zZ>%5 zM1TOd8Z2IEK~9{|f*O5ILz38g-9N$4Q^M!>5dN$Eb*O(AQtF1EQX8G_=~0peMM2dO z7sPGx6w)t4UxXKef0(8mUanJ=GH3vFoi0%S_X9kk| zmV;h60@zPxZ!Z@r)No!XEAF1n#1-~5#|L{gQP$^>dGIe$m|Hf4YnCf9ZJUte^gqL> z;~>QMf15THWN`tWJ7L6-)AldY=%B67f5UE`+*w@8z!D{oy((4bqiY#ajqK?J;#+YL zpg4Y~&;~sksI@C350&pW~h}amq*$>fi!@w8>Gb}1e{SA^WXt52ixPYKvKFOWk2<9xQ zS&20Jm1lgH4hu=_4Uk`bE-eyQX45;kH5-o&S^xQ!A?zoECy_{%)BJ*XkhsxL{H&{FgX(vC&c5pH>h*4MeHL zm$21v5q$*#1WPNxrn}CnqLHb#G=s^N0B?dNCC&G6=e~a#FmUd&>h3gVpGGAS#IcH` z++QS?vEQI382ARaH9_e6Ly_F&)sH6@_Pkz1;Aa%#(v4&C4>W`ywZ5BKoUmHd0hcF`T zA{3iC1-Ebc_3!$U4v~X|*t>W_ZCjxQttR>0QgGCr)%GvC{NBx;M6)%>K5>GL;GtT! zWK57UdIs6>bfo4H)|2FPWSxf^OwI9Ju>MZ^YAPw@m*b5=!}zslJ|fiWK!1x`gzQDk zaP>h$xh~1Z;h5;MvL9tMvy8Eh{C+pKO8LTsK$PZ5zGusTo7^(Hp`n3#g0gEGpIH}T z7rqT}9+n(VQ<_gGt6s_!d7z*>qu|!tFM$5%lu4!i68g)sKN9tmI4gmk#I+K=^&1eU zjxlg*E7g-vFh&~Mp~Q&Z8UG~B#Gkf6ib0#};levccR+`~zA>9}(UW%3`~BKOcPaSeo0I8-7_ zDSBK?ObW3ymRdE0(hvDWAV7Q#8}aHp_LQHc=P-qNPx@|KQh{Vf=2Z_f_|X5WZ*J=UTp``1#( zY;Gi%)c5DG{LYr>WwHmu{_1y|y8dieli;!UHsWqf`<(0#K6zkK!Augos!mlc^EsLH z+y5$imZA+ClTcydK#DyU)_XU>VWVo% zpW%kSeKWB1FJq|)g@Qqv%{Mps+Oi_<@87aOxPBZK2FfRVl5=ZGX5|)@H>pZQ@MXH8 zIs3oZl!zAa-i{fQ%op#`+u;UQ%{^yzlJx(x9ISzqS5X!rF@cXL0C_M zMVUoZlIS>Hjkd5tBGKG65}U9S7PL&hH%DsnH^pf(78K>><+HY5ve+di8NsfYV}Q1i z3qlA<3t5mmF$jD1!r6(8R(&|Hl4^>M!2RY2m*(sjwk?g$?^ojbba7?#Bz`!T=P4iwI%g2zna>XP3=1-aoA=L$ain9;I+ zu{R`k@ZMP}pBDxoX7SrzlQn}B7&}^?ex<7QXbHLB2^mI;QW&Tz+M~XG9(QCE@ zU6={)Nus8st*)Lj`0Yu`E+Ew0tSL&D2%RwrZX%tB+~bS^I;I3U?vMhkVOJF|Yt=?{ zV5Of{gjL=rp&CQF1WsWolT#AcTHydP%wxA?dQVaWDO~Z;^nRNxRtcRTz=Qx7zA6#u z7<&cY6Ez>BdaY-N%8wSW*9{@Xv#F5Jw!G>^GTK zS%4RH?NVcb3)BMuwA=d_z*Ilius(o?YFiMd%-}qcs$jc(&>fQ*iXlZ60o!)g^?iSC zU!T&V3)BBc7i?fO(hTV9o@M^b&Kx_t%4Go^&A7!|5>Un|qXB+Zx+pS}b2ymzP!W6W zK~tFW9BnXu9C>WZ1{cQdE!@w~bBkMHUpBm{YMzy{|5RSd4)$S5kT0y|Mtv}R!RH9v zlM{~5w*fR%(>n;ZLl7eXXRP{99X{^Sf7&mHOKAh97$NbAAYgd+8!Toa$wm{?0t^IP zumH2G0OI9?`jmue?=&NIERS>s)+fvuXAl9+_prlXmJ>Tt38!L%;Q-w(7?a-@aP#I0 zM;c1PQ(fxyZOPR#G*oy_vx{hho>A%Vk_$lm-(}GTlE$|%!ww(%Uy9_&A9XfKJlDZKx3jIhm*``C3o_{$!WZ=ZK47%C*Zm3MdUS-*` zs18J4NKY!ACi@$NgI_1$P9E_eXLN5qbz|!{y#KI!Mo{_I$t_^9>PaKKujeBc&O$~F zM&5yF)bmXn|LT7)7Nc@~RM^IeJ53VPmbRF9>z^QB+3>{VFjZ&xkisN~cV4Rc$_^vy zHr;ZBq*cP$Nj>}VxVgDMmy{B2d#u0weRu{LDUn98QzpvPmiE?73I9W(cVl%e(Gb@& zM=N>ImWCB|-V`QG4*e2nR{uKZorrbO7wjr)} zvBClYGY%g6mGa>68xii9V$*VM#qjdAD#6crcGd^HrxD3|o@d{9vU}bqcvRW#O=pm5 zpuJd!m7DpJwCUL(QDx*06zjM5I4o8b{zuC2pSbXKbDcU11v{T#<3jlvipkjqW^h=seKP3= z$=5flRt2rt{>c9bPM9o>oAwj!f>s1gfG_R|h$7;Z7P%X^S+6VoI-pwwC%Tw66GpHX-;HF0-L>OBIwuW4kKY2v>A`2O*rt9Z;pq4M2N2 zD)jqrrDy=wRR}YUIN~6vg`DCo;3Wpduu~s(t8Y(L%s$>tFUm2mFK?i&;Gx+g(&ZxK zcL<$Rz0KjagvV63SXCY@)af|--d3pen0g63mX-L%XAZPk77|32-{D)GeOc~1M3y)X zmokf3Fr=7}IM3G)Q8Z4Se?g)!%-PTzKV+Wgf5Vjoy6me9LWIl>z?+)Q!v6Voqh$|} zaIW6Z^WXzChwer|D=C})lH`!;^pKK&<^F{P5cbP5ql2x!5DHuZ#?%`XxOGu6H>vra{pZRHLJvfnJ?jBj(0K-A`%>p zz}oY9117m9v5*ln>rZu(8!j1>62Z99?(;vTGB_Fa;}H4wEo@4dc$4^wbd;6^4^X0S zhQNCl({vsc?)m6h5Fl(@Qm88NZ&6e~X8U1mueM9}z27q8DkS@x^8JK!RU>#(jV1r0 z#a#aL9-21WaNRy+L6}^ugD&q;+rw4@`+g*`{_KpFH?l)E1U6ASS?3uBJ(yrbB7n$N ztcW}we_%O{{H(t&eXjq$ix^MvM7o}oU*6nZiMNR)zz#_}4LXBqg`GW<6X?qz2V*$! z_ea=aX-sRk0i+Jt+aTEPn2AtDGu$*S(rK?)iJVch%e&Z+>p_m0K&>U&=;NSGPT&|G zA15%GtWgIAnXb@Zq6W+V_at<-S@LTxLsWMcneae+(c!cVzg{PPg~ku?-@!dH?K0BI zS$TvyC|6KQZ1cVOru!eJ{nIh~SPASJw>3g`|1@Mjc=|$7Bc#AwvRFlB^Pyw!x~sF1 zt8nwb zm}$Pm!<*3mt_+^M33Au88%5h2gSm65v0J$z-RMCJ`r4fOT(yenS-7L6qnExp6ykrF zBA@BR58SR?7aY|nTq}|D|L(_5)?B!Z-$w9ml9iW6$tadW1fqS4fZDl2&ncIt!z|$; zQE0L@&a4p4kMLyR4A`_rOx}WPk=&{JkrV#d-QVR{4v8Dqsfy<$ZS@_UHatGcK#yi@ z)w>R~!dYj!NC#HIjO3+?NcdugvXo5m5}F2$G_zNZfPuywH^|na{~6yKQ-!}FEj$Ez zz*l_X>bjxjyHxqXcxEvWo6>FfU>Hs$0buI1qoSXQ+>K>u=ouL${rm(;K`*WW0Pg+r z^0Ifsdn@pADAG(tQ7`8_K@NAX07scUbo&~$s*A~WQo84 zzygRjv>t!Yu^iF)F*t~=2-PCaTsY)fExA2zvo)NU-qR1}Bd4H%bQZm#5Cr_9ZvyVL{r&wIgoGf(hC6?OLoJ+Ilb)ddfe>V%2aPN%qknW};^Dz{b?v_m z$qq3fw+`L4U8E2<(J|=OgYHsh1L={71rb-`^@Pqia{F)#qHqmJV!UXOYnD3gwnN4u zp~l-xT|Pv4R>Zki%WSKomC_>x9;eoNAkosPH{G*%(p%XXH~nkm1`c%8^R|a4=SbA) z><+_f*a{ILN%5S-i|8#X3~l6Ze;_53uPa`5AIZxB^KP(&>JF7DDgS*<2E+4dpst762@j)XvgG2T+Zj|R z7baA3tpe$^j&`#EKkp;#j)k7|q-+RmTMA&&)JI?j(XDwv(L5paRg*Ze>^7JBpn!6>GvI4M8 zrD}sZMR5GX>p-{azb$PO6_$hKBINV27OPNFaOJ$6*(_xOBG)&gzGgQ;#{T9$>bR|o zGOv$U>NWdVyR#}h)hQgMsaD5=kC?MltPvSx*d57ZDxC$=Ik=imy(+l5$R zSP8M~B!DyiuTEW;+N@QX9)apr9p{o64s?;FAF}>mlPbABv(gvYm5_kO=RhRmQ6D@T zH3ZPo-8Blc^$1Ls_$j6-?5tmv039+y?#%u!*(sjsd-v;Q=O%1Wet$?>mAJ>z?lI)M z)G<8*vveXacB%qh?{aY_Y`ME8Z7S?U7FO19MVXR9dSA z*LnzV9=H}3JVWg(ux$QPOwzy^BP9zU zk0Su#P(&S4&p=-sobS6Q4#-y)L6EUYIK3Fh2_t@N5;A>$1RXz*y~YvT&oU@Y^*Mq7 z$st*a4(Y?cd)CSzAV8QT`b6LTdS~#s7ybKd**+U3xV2T6SEs=g)CaXf{QUh(jtc;2 zdVB*YfilgTOk~T;p#R1OhZ)0%AR_^PH&x*3iNP{u)_=|EK+5|Bw647+bdO!YEQn<0t+Syn`ZL{&Xaf#IU6q5U1>mD1=W)G@QC=`^nQrKW7|M7L>Bk} z$~qK9}h{xz6gwiXxf4S4@+&2ZdZdSinjO#e1tO7@mE{N)8R@y0J#vPhH<9ak)8~ z@!1D`mA$M5y(->aF99sS&gY8`Fzf15*q@b^l?LklX5a1J5Vxg_U)-XPEG-MYNQ2rA z!!ZX6lNf;m{Tt&)E?r7}15*8ER}uUdQ0pm&v1xV0XLF^dFTc>}J9a+P(GJP9@IVCx z1(j7)^aCj?4!3=|k7OeE(fRo~i?`H95a{{50qO&+bQ-O!5K)t!mbRU)WBm2CZav`N z1bKwIs;Vko4GT#fRDJ2Hsh%a&U%UdT99KuMwkCQ>M;o+SKa?}h3q@(}@DuOz^t&Yr z5;heW&j^w@E0_fn%*w1m9_0q4{|%gfjg>YFt&}Qej%5OT5f-L|)eEcR+!mAqX$4+{hr3 zW?S48TPSmxi3z!ZdPsXNbm*W4S^61^yAUUV=0ir{mB8tUbx?Lz+qp)2Fk{V?;3MxD zSQq0&eWk5*mqFFgK#;Z632}5*YDAgK0y%y35{O$lwU#p^gQgd$#Ol%Q1P_DXO99a$ z19@`T=%F=xEzMqG$=P$_FMBH=OPv(hOh+>s<)2L#@RAk)YFmhtHoe?ZMY1 z(o5PCQ(w6(V0TBG9O$f`_fu6ae{)TVv*CF%kef}Fh=|`}AT)3p&N%DROqMuC;@o`_ zp6yf<41jp(Yf2rn;vfNig8;r7<8iwxyOR&_0#B$ zECS_n1^LmGfr3H5{6U&n6P?tVhL> zy{8y>hU%A!T8No~2a0^%CZ48C)Oy8=UB?TwBa1bVbW>tfYp|>LMpynj^1?wE z&qPEArAP#Wp&mmu#nTM#YCN5ML9c<_3JNL6!d^4bGeCycVq<;gXwOF>&kGv! zyb%Q*no#FjFD84=EoC^If9~t9>$eW^!q8+aSljlZkeuruVfJpf6pA?o;4^xp-BWt|~Cmp_)F9u^%#mCBp z&5mj73Tuu*va;X(RoF2bs?B~Ka0h4YvC%%hjY5Bdm63pImx($*?{_!;0`4o=flH;c*=>_jINY4Cw>vQtsV~sprIj~8{m0r zWP}IlQwc`-#oACI-c(J)gGO$S=Vq$+@DZ-waQApUL(RQFFKy45(k*$>yk7?GLRWJLQ@&!V6HEiux9Cw_55tB}0{gAwNtRNqJj1;vPjkQl;e9>eSkJG z`Jgc(D&H6;gPm&S)-N!Qp{F=11b-1?PFpFn08&FM2w<_cUc?cyJ53Cfw~{yNFuI)F z=p5y`B*|PGsB3F%veY+)cO2`rz^=&SJ!LZ?4|#ff^9cnh*8Sl&C=ich#9&103ddvC zC1*+ioHb)CAT)blRq`Q8(NJh;=&Na|1w3sa^PsivHqPR6-n6uTYFVD%9ZtXQGJtxW z@izYZchySE0*QT~EjLjc@nXhTW6P3&3Do%~@B>Tfixab^L_wMOufO;s!*aZ1wE^$e z9#hA0@rW040xjAB?1K_JSeDH%Hz8*7dJ|S|G*`?!AfTD>v;I%QD;0`E2anOlVN}_z z$%E-o;bcYcZ+(@@fTThR{f9mM0}hf(r;_pa`=X43LTo4KVqKuoVX2080Z5}4xgSn` zP`rTzI%Nz0WG?1EegS@B$UQTf`3;m-tGjB|XzfS_dK|_ZRy2tmEGo+9$UVtF`ZIx^ zpz32zXP_Ubqkv*rg<5HKrLy$`02$fBH8TLXwk^qjrbxz32d_yKfS}mB0HNZ~q`E)e zF0IBh3L6@*G`=g9w@nHqN(8?I5X|AIZrSxx_aNH-bi=*ywI|ht#B#du#rPUwB1Kjk zl4OD**xZ9lK~cZY7!D0+TD+foWjsKHx>n&jl?(j~w?!%rCnsaSen|jiz4$VqKI~Qw zyh4TbKk6^yAf4NGk+QO#aG&o|)mNx7pFrN(*|}bpRum?EUq21`MCnODsOI=wp_&ud z_8hgdpu9zK8Af%Kg_$sGuvhp6DLJA^^Da6XA?J9vQQGSyztD!3iD|r3!QQG*mpU#p zGxO!jMwxd$0v8KwcDEtb@a8|aI#ek9XEc4i{ME6rhVQOusn=kOlf%xmYw#)YS!(d- zMryP_^vMLK!N#1s6Ud(~J)b%V2>9U;=@c=Yny^^1uMQ z4|qFoksPe3UDQyF$=bBmtwpr|-?(@Y2R0I)x2Y;w$@f~U>ZFrw|7r^S!#eJ9=<+N)Nd0g(`t86#yfd;Wp(?% z;{F+I;Q%B!BH-^E;jAX5XzQp5(9Pr^r$OML{I zpT5Q;d}5$g3+E63HlP2pfF1Tz4Y5Cd!XiWKK2VjHaF z(Ae$>f<_WVmspDrD2Y^vPDtnt8JI$Twxv7odSDjAcJTq)JL2xxYK`8HIWRy0P5m;T zT&Sc@8}tMB5-sIYX7!WY|ofBivbZ=4Em*u!$qTYuj0}l{NRh*I3U}vp$2ik zYe;-TyT1IV=CkxNeQSl|z_*%5nm<`ey^kM_YPX@(w7%C}^i)Vo7 zKrrp}nAm~EMj4qA)=-mjKuI#Gds?k&eN8T(I0&cIg}p*5BZu}#9Qzw3jbs^dV(>&J zv@pke=aQVtSVbs`q~ii>k9GkL&p=*!G7^zJgcbv6DPep9Dt%$J$%Mj2?r<#Rdil$G zp5b(o{(a7GVPf>o4`G~wb}cUAFj!>3ko!ESG9d6+=z7~#JVVyZzdS*#2^uYt+ zVnLa!NR;v?HDFS?+(=7_pk=P&%-(6#QkiT)R7*T#y~Kz-a*mIB&!f zVN*ksQHpYQ4&>I$y{hNjM88bEkZ3{y^t)twoj-2kzBI0%{9$t5RjMOic&Ry*5?Bp* z=!u2~@L6cY-#QPwL{O2nMWSOFK_ZDPOgNPjwGkY`lFE#;6J$?b-OGzTVqT9Wl!D#@ zFR$1v6OnsdkhG@IFg_@QaEyIw(jTy?X)`ISPrAuoMW)Pk;$1LLzUd2lq($IiPcaDt zSCl0sU!3#A_jpM$(1VY+3l5AS8tt|wAmHz6E^IVJ4GkC{%zZ51((D)OM)W zm*AieB7yqr3G+nej{l{;37W*H&(+2IENwN?$~iOPG;7PRbT8`VpNVP zMj}K|hE`shJ=^~wrw{0_r*syM<*|<^xF!h&zIjGQ&&q-Af&u0EzDrV~YKU@*;q%b_ zXioDuB&z^~zM8QcK@IGTW~*JN?FyC&i4is(>cTmmM53Z3)l~F{V}P3T6Jwhr*}88u z1|x)!%NqP|g-f?VK8xm96p93%CHP0hYH-nR4$rhhnoCbRonL`bd|7DMZlX5$0hnbKB-s_*H9+T3|hwq_F%9~-i6(00Sv;&^wWM!SVya=F1 zdKS+R#lQB>;g~(RQlE~)iugp^^Y;eX}2zxO9SS9ku&LQX-$<)X+B#3R(x|F1ScljwEAjgC{i#jg>W z53L@xFDFg__%o6Hdjt2T(FqY3CmcLX6Q1TPBcn*@RoyjESGA=Sd#f(3k#hVU5-6Y| zy7M83o=qK1tAt;(s-YRf&h!a?1Z`@Vzx#Z5bUy&m9A{awJ5GEVn0@&3-63{q_BiKy zr`i|hOgqHK&+nU#B-3zF)W*O-@o*g&S0+TiIHqNl`El$QPhe znXOcQx=Nbmz0__mx@2WLVnTL3yAd|zxidRzjM=sE?b2iHsI9G)v8rYeM?TY~6k@>e zvt};;frp`|oMKs6(AGeoKBoOO&k`ux9m>t!+wrjK3}DU81O%RNvG@)0y)Q z+o!>=uY)mJ(4#XW8FB?Zk*LB!J?QctW`WRDlXrwsW{CfG^3#)Ydowu%-I5s?Kgvzu z?G;8Imtbt5iB+p$!Wpv=w3ZQzl$YSz&xmq42^k~&38A&&oRs6#F5leGgm@saQyg}x zR#+>3($_rN&c1AEQcp9u&;3!jVuiFjLoy-ut*p{Ql6gWHe|aH22cei<>Ryw^he%8# zjHuqG!^^8!h%|*6*G8T0{MgZZqf)N05intLJeCTJrS)X z3=)?1>hQ;}ek|x3J7k^jkaIPi2{DLRB8E-`Ad>CVk+EVlVqkMclLR(JH1)3&YA9W5 zQDWEHW*$eVZf>C18}8OPnb39#DKLpZ`wX*nJGyj>tMeX9%LD?dnj{}LbO-9+;#!GN zJ~69=hP^nYUSmWT|4i0>+=aPU4-5J6VcBTJ%qI-Ba*46)2%$hPj<#G{W+D=IcyA#~DjP{^ zg&G_k=N6Z`_e>Rcf5WU7iI0T1FMbaAh{8$~K*N$yn#OxZ+4_?=ZWuPcvJl7*AXP3U z=+@f)Z>eID1C}b}{-(^5pOv#NCT9)=+q}}tP5N;7_00o&@5bWU1PJ&{h-^kE)tC}w z>4lc2AdE?}~8^%K1vl+(5W9O0K2O-00 zc||PkwvazQ7Vj3^i&JQ4^Wjm4;TgZLAQdMeiN&8s9oDc6yH2>5UCT=XsbrK-nlsDi z0SSNr0Z$IBe~^qbvy{Y)n`#zC;TKxYYfzvm^v$rl3e4$s_VX03YNbcH&(QH?oh&W9 zvF|IGVx{(&-vd7d`uBv~r129h5K#~72xW6_3>X00J#o^9AZ46q+#ub^emUUIX6igc zraSM5OX>0E@*V_>)7Dm&<;@rW^=oEl%Oos5EF(M&_+hwjRHt?4m~BIiyMxKC6Evh$ zC1*n2bYR!v>2n2%?V<{`4&^!>TWwOc#o05``8rUT>ET0X2VInC*>{=%iesfW<2&hw z|E*10vEaY$1xDBu`5Vm9i|yZ1S%`m!DRf5^#y88gji;YD?PBzL_L%i?>eRg~81Pl| zk+CJ}WgKE}Bsbh1q0iUOV0uQ7aJ?FFy?t;R&N@iPc7)k~vEXxv(?ZY_V?s z`_pqIvS{7!ZorI07B6XqQ)jj2v0pw+?l>pN>~oJMASCaH>sXXOVgzd0(i8I+wFZh$ zNJQY<)L~i`le!UPT%s8)M?}B4YY-~-sd^QW!Gd0z`DUdgLX-a;P#p8PJjX1GmrQSY3kabN);+69|V_Xk@7JT~@ z$h5cJ?8bsq-ZN?~=K&4ZM@J4p&%)Eus9p#M>0BaNaT2}@ig^86ycX5q&Txd`{ z?Kk7VxZW`V*9mFWcnF81YN1dU;kENC<>Rn zM{YMw2JwTIym5-6+Nm7>N}!zbKvapdLT9r5|6*a1kxMo;(Nn<0%<&H2hjRzo z@VH&gR`u|-Bz_eOQvc{F5{HO7$~R=Ap%6q6JLKU@d z)xVE~k-Tct@jZBOM8rCVE8&9j1WF!y4LB73*kFKuPEg`m;*kY4vicI8+pqdU1&(7t`ro!i`7uMRYG6XKTF!q*ej7E4!469l zhJe6K|9}fHe084@0`%H)Q25g{#m#ERr?KBkM}9ZrLq`2Kaz2B&ifn{-CI{oj zpSRy)$TdwlDOfS-RP|-mW&hys@TAdwk;9?vw5Xrp%PXZz6*md;)Q`P-FGmb!Jd(H8 ze)xZ@M;K)Kj;9r2j3tQbm({?Nx-0}-XYGo-}QeLD-jMvx)J?q`h1fyDG8!+)CB z3F{&*IW%VZ+rt{iw4t4EgyqPHDu)9<<(V27xkQ{)E186|Urpf{4kBIh=oL^56U4|? z{sDswVu@;cf~aay_y&ihgna045c9%kUHCR;OR8D_BCLC5_Blu4z?OUeFc=y?#qY?--BRKV8;kZ|VRol1Y!iB(C zv>P85s_k_^uHe>qwQ-oOV|`}It(N<&0D4rLmh8E$7*Hi$Mo-r*C~Qqmlp%B^kGVpY zLU~;+cH0-LfbVBvXPeDxRoB8@Pt*cexlti0cZSOe$GlWxxlsE+tN+wCZ*_z1#N{9m z@=L9=byI^R#`;^*{GUNZgF!p)|yZI}cL!C95wDiJtP1iqgP! znLFC=bMDG=a=;P$=EVfd`*%4+vDByjy_@8udSoYc4pF_1Ou_oI=`+>sXIQ zM=nSs!HLKYgIh^)taeqUEmRB(&?g*56u8`~dGcRt$Q+XOc1>E>zE4w9@iD}&?63u1 z&m^P@I=@lQP28)SyaECO!g2BbP1H$COZVze$p+G9j4D^p*VVBDbMFO}?+Z!tcx-HJ zY3b?N=`HHz(!l4<;>MNTfR8}s&|u5j`vO}#N9t8Ye5v{EedcJHl0+RN2q$$Od!~(F zmbrO6l#&V>u}vWQ9yx@ff(2z}X8JxU1T=oUxWGyl%1{rQcB!kGV%r97YIf zcv<_gkh&;0rkbp}yg#zYWD*}ct@Bx;P9H10TCx7teF0<*&k5uc612{$aF59isPX3+ z>6;~bB?zi*vQDX;pe@*l;;j>M)E^^6e;n&2&T+{aJSL*_OeNAS;c0bsnq|rsDM#I6 zZwlXNI~heCV*{%65ES>#BRvD}hmq!S)HAd6M`=FU$J?vnX)qbMH>_E6-e|3P2GTB+ z`nhxaGv6;b7zmxrT5}^fx!0`*7m4#1l_ys!QRPJSf0D=D?iLT=t=%^lICfs%9pSoa zF@IR7XFc1jk%V-&)f& z^?!WieS~&sXhr1UFCOvP%zae#NNtOm`>*cYHK^$OO&y#cDcKpe2KJLfWnts0dAcEqKe?|X!ytUF+xVw85$k%Aw--B=H^)yS?PBYw z4&?lbH~QH-*X?PVzt*#@F&B0$Z3W`zMWZ518`2JFAu0m7o8rD5UATR2!4M;5<5EQC zAMQ`QtJWby!Eg>Go#9Sb)c#5b`yCJ-$~LPzQvd*BOyiY=ae}7l!AE%}ugoA}tD+t; zT!uGH2URR791aJL%dDQN6eN@@bjjD=XArt$E~j|@3RP*1Yva9nD^`&aA;9)~h@ZAc zOs4QbSIobq%^#M!%EpNCUplBWz7n2JaZG;%_Nm^Nv8x~5#099YPd5BZ!;NVI`=3O< z%@@FjR8&;_2z81<3|86Y8Pu!yb7&Wy-klmH4X960PS5moFOCxU{t^B1QrEBg7zEojwdA%x(pv1-@!$_iX2g;XXscSj+>H_q#{2k`gVEM3;=l9m%O$r7^zn*XOvV0|bbS%O z*<&eSk^!7Cb6sC5dX(R!e3T~|%Ms13XQrh}ZZ1O)fi{DKN!L$=P(C2y2Y}RWxp5>n zm$$3eM^|A6A=Qx7XzGugbT!?tdVF(9YB0lr|#1rXAefG4+o zB2BdLYlQ_Rje~5Innt~%ImL(z2J?n%$jFmyjP=D404JWP|QzwHq7ut`Cv6lFEtiH-PF{w!}ThqgG#F4$eoj4 z`ADGnwJ})04=s%c)%Q#`>t2)h2^C@;e`V>jDH`NEdm8GmyM63@T{`Ei3YNQEr+L+` zmU)R}zV4$L6PCFn-KT6_c-o~*H6FmE{oXey(&z_(GY?;`H@?^cMZ7t4o|CR!04yN{ zPN39k9IpVAp1zM6T817pDhC2&mSMP&1LbhPQ>8;qh`PAFtwluLQCRE@nnTBA?*HGE zj$OO)CoyGWGF8_{C{*d;L5OFlt@c_`#`C0_knH3i!cy1pH>J)6ZZK{DcU>#MYhBU$ z|Jp(*>EFYp!1~;IsW)DSrCPxZlfJBTH$7U!m*d0y&g+L@qaEzJXtDgn&G|$M?c0F+ zXXZf81HKM)+Fv47_G8$7E_N>PbQuNg0jxFrJfmv3lQfol9ewc~NQTWkRcL5x38*l~ zuL3K_sGJbe&F$M_mdwCzf%MARg@k_}{4~@C(=vE%GVc)7OuxDhCs;y<7`b7?fMbB; zj$t(QOYZcSj8a3nnL>1PXo+<#>8V<&wxb^iRp>8qj6AT2z(RemfDcsf#qy)*cRyJP zfaUpW)R81GX1OQe2gOF=bM&r zAF?b-^mKocRs$JQd7EaFrgoOR>%fbxBISuJfKb^q4M!%skzjamzMY66;>_hr91;QT z6`N?+xU)Vr_-!8!eLv3L<*o=4&SI&6?s1{iIFX^a#4FxSipV^ZLwTk!RN!c#We19b zg&FtF?3E?#C2kjGn48vuG(5x5Z{?yepQhrdR6*CBTm`WTd-&mA$sdksY*!(ZdoC|y5Y^qU2+6MJ($IBBfqJn}Do~%I9ma96CB9w-KNf{%CDL?YsVF#T;UTt@AT@eKa5u*Qz#f)%v4+NlJ&G?nQzHAXR^8v_Ki zoBtvOEr^vWs~06F9{;9YJf=%$t#Qm_2y4Xd8^auQV$V9483=t))Hv!J=b{TbHOP>C zv3tZeG!kN&0%)pD9x)8Md1Nie8w7;>bD8fR+6oYQt^Q`}0Zgfk0$Ho)E_g9615K7d zr49^g_>diiNFI$U@HyCNm_ts9w7>7)=KSrH8j2|KrqMSH3Oh}{tw5y>>)R#ri$r35 zMoqA%p+IAJSU4!v6y$mOx@Dg?jsQK^2?g?c2N1%vz3{(x`d+`L^g7g7e+Tx{v%%*nXb%4UzbbB6Q|=gFvN+VW zGe-<&p>_G+>R|f>3&O>7EzM&d>Z$&HGUv#j)x`;ft;$*%co^)QVW=FD5WPB7$VL8i zhqI_(T{zY-c72i`D_X!gg3IT2{(cv%A&fPXYTLRbGV3*!VV_A4KGDXzt=>8p9ap&t zDi=x>9>WxX!u42P%^x9Mg!I&%I0j(Dy^&M${mBBYFmG%looALpuB+ z&MCbuprQjtl@c&A1U4qA8!^}J6+G-H^4r@gV!z7pq1K-?aY# D6^y4A diff --git a/tests/testthat/_snaps/plot-cf/ccme_boron.png b/tests/testthat/_snaps/plot-cf/ccme_boron.png index 038795cce50170e269ccb739b16140768833cf90..44d5e36703278430b22b560ddbde29879b3b1811 100644 GIT binary patch literal 35827 zcmd?QRa72L7d1$L;KAL4ySuv++}+*XgF|q);O_1g2s}6hcXto&@OR#C&6r^qY%2=Z-Pa;3Y5{a%eqQ7;IugVW*G(C^RgG!7jM z4Dh)2`ThCg_lKS~HiagI;uGF(fA7lqB{67Y@xJxp!{W3?QSwv7dgxLW*C@%38Q43< zV1wRwNa2@Z*hS+<*a2SKpTs+;znj4{uyc_9HcVwCutXS$(@|AKzYnZNKp&FcYePc2 z{9TRZV=t?wCK(eS;i$~~MmpOa{1VV2zHT$H8mti4$mEB<3DI_+M&q2i9gdu z+RSY56VAf9iQHK5xY6W{ z>djXo!vPx2ltst}Ev^A^J8Q%8t4X7ua(i=e_Z5?flFoGn1~AfNMuhr8yv{I~4AI2m ziIJ>)bqotj;c$;E^N)%x^B?E8&Nln0pWeY*RjuELPmiXVL`ptL|Ng1yzqC{%?LzSP zvaEFb18eR`I>#){D4iJmh)kT{WYM8!1Pbecy7k$otY#KrWceR|I86RC18 zXH-|zk%uto-NH0|t7&RbCYKX=X=-W8W;A8dUZ2O$UL&egLOr*0!R6SM%mUY%-gS6o zF57wPqu=0gvCiO-QybwO+8-j|bXC2T{giE79nP=AL1#enhX0$XKry|Vtx;oPffl>^ zGdR&0m|weRCyWJ@&gp8DWHk*su!g{y^t2CvxToLUhdOj-CQ2zek{id=CM;KututtpD?wplqF<5$?P(yVN zrj>qG-?7SF&g`oi7q$geB~qa%eM@#PSs}jJ?}m^{3*wN3+I4z|oZpqW`^)mL)CPiF zu59@}8~YmgvI(FI_B#gSY)17con6g2A2*C4?nGNUKM z>a^pi6Mwn{u{q6hAFR%Yg{$8|`uz=S)vMUdB^Qe8m6G>CyM-HRs|w=Ji{%){cZ=Qb zORy?|63=^OPs#z~O>nOH;NN{33b<31M5lK;p7!J$U`xK;`X4WE-hMX_bDLmoc^?oT zWN{)sPsKV-m%=i%W2ff&9Og8wN9Z7na`LE-AkD!p~_jb3jEg_P#1NG&Jm$6~>OTChm`=jR98@EqL)N)G8^$ z@tvi%dR$kztmmk->I?(Vx*s-X@`Qt3JG;iab8N}Q^T1%zBL!BOqHJ$Kd#@=}N+d7+ z@QmXd^(KHCLx1{Sk2vo{QjVrGo0$H| z6TTj$tsQ=Uxn#sL@O27&nFxW1Z?Nw;F40ZXZna<6?Y#>piMNKKf{t+R!^O2Fq1XfOr};j;}8&hyHz=!D^I$;SYNe&xf&v>raAok8>yA1 zR+GVGrOE30e$`>srQn1``A0I1+9)B9>ycsxn^oe^fcGaB;{g~PZs#I4`!!95-dE>x z;^NB?DYVDEDk9QBN^$xed=U1THb8c=T%>j{So5j@Anofo~>WW`e zf*-nwyk|^Lr?tJN8(m(`BjjmPQJC~(s8D5tZLth`9a6RW-L}2F9v8`yM1FJrz1v}U zMXtwPwVdf+2>CQEeLy%Cn$0rmKKC)*D^z zy6($n%Js&BLb|RdaK!QT4QcwGfhbICGkQ=0@_c3$>eBzp(*ZXTBbXY#h~R zcc+W1yQhn_xxrHe9%~8R*7Fs%r1Z;vAbS(R_IHb1zlEHG>eh{hRfMD|2Caso!L+xq zY164}-o+Lt8oJ+A^!8?Bsm(+9-beYuqVsmtLEpWNGAQ+^IUq|Ea_#XNuD`MAdF`h( zSj|#&!f~Lb|MWV@a37pFSyqq|4};Ydy$1|KF_uby!&%>(5Y6OD>Q|-Lss4@UnCxXl zWPFLOkZFyPgRIjJZ`h-*q1nqW_m?JsBLt@%Xe{{=Egl5>UQxfx6hEg%@5K;(>l#TGrvs*dlBB@L>y3K9)5|*Lu88;Jb~sU$Sa>FC zN(N@N(p0`a zM200M_mhbj8>FV8N8bDXTxr+hvYf@dqV~Lq!Aff`^_Zpek5g1-Naklc1-wa127#^ul~S~K}kGpYG zIMhkig?6hg?X^$-{cOay#}H5m!&bmuA1AqSyMdOi;WF_v4T>>h@4tP}gJq_4zqt?6 zO^Wn7-S55Qsk+e1r`%2#md)k-WASI5drAFRw010!W76{o27^A`Q>K$7y*LdKSZKU2 zu?N`-t+qN~?b2HmQ?}-AGI6A*q#4@Qd|9o>n-)wAR>F}1g56n*WgE9{{B76X;N-gO zrOS?8<>v1=p$ksR*WGy(Oj7XDpUyw{dBfCOtxXdx)Sg#tYDZY7_)H!;Q<}3Jmm@|= z)ce1$j+gluLShdoePF+YcKz*#Z^wpv`;7A=c=C6MFAxcI$^#$KDD<$Ek;PAvoP^7w z*NP6)B7&Zy-0+kG3pJU(PuK6{^82)``M;ds|B*VOO{Ycu{BR1yvlhFA>z}*9yo|ZA zD4li>Yc6qarc5pLwB0y539BimXenv+r%QIA4P!y4y1%G$V@hNam-nX@j{ponefL4n zMA_L6$pnWTzz+Sa21{$>x-IAb_VUnb;)d2385kc<X=Vpq-$PJWC-17+3C0~a$3V{yTrun<*2Nl?Xm8b z#{V(FxoLa1727_*Lp3LlJ((cnct^J5v-K-5aC)QuHnL+cKb&yX=}w&efTCYB19fo< z5)Lhc$tZ{qFy4Y4rimj76()ireY+l zP4ByRWd|;cX+(3@)^qf&C=t^aNhZEJFrD-*Tr*L2i zj|CUMlVBOC$O@%GAU@4}{*;RkVFWFb66!}fUVFuZqu&XZG zr-?na)8vkoA4QSW+k0a%!~o+2(}F6-l|{XITD>J9_Qqb)nd-#!@;uIIsIb@bcAG$> z=~5WmcDZ3tMiKI%kI#`Z7Q}ay8~Fypb7&fem?yqRN|$`NSidnN#3vdtiSpCG#vScm zz4LkgnukF4c2Tac1V#KkiZvF@ll!Yu*Yio`lRi5KUBP5H5)lJM-mJG_eyj+)Cc4Oq zP~w$$0!FbQKZhH#B8K|O8ZALNNj&tYu8LQQOTHLz4)puB?=`L}P^3V|!45t89sglY zabcnEx*tI~gq8nbtkD1SE{>GapIH-(f3SDh5D2BFegc%szqY1K zfE%(r9-J1_{)5tr=)iN(KlAge|JN2lLI_6+YSXvd^*=EEBM5j-L0;()&A+zseZWhM zY-QD^)%-UArGLO1{q|P#zqTycz)Rrx-rUXnHvlR);5q*mU28^o0quXUO$AvZpGDE>elDZ>p!A}KC#CA?TKZof zKZMAD;fsk#wEky|JQy)?VEq3d-WEZD7Wuw;f4)i@qqNd&LrIzAX*}>|KlJhbAovf- ztxf6Xl1fC!Yd2f(uV9`Jb-0}t>9#xHGivj$m;Ptu5)x!MC>D!Je6Q!@QoCf&!5!skGIT7t?4lm3nq&TdrQ6IajHnFq+0lG)Gt6 zYPZ>=Qu0lYq1i?wxx*;VfQP#CTeeSwxcvl!($2z}|J%k0fJ}7; z#{id-?pGOKI!QeF4yOT;oJP z(}BxGHZSMDtRi~Jzdr=_zP+FiMG_ySKAX3R+@o-YsAT7Eu(F4 zDx-ltxloZ1V}ifYE@=JmuRW5og)>qC%1if~AP}pKv3nAJo{XX?@Flod7MW%OaBR{l z3DH2`=bW7xp2&qr0i)5gVUx)J(dY#~SOqx;fcH(xtsl=fokZ_%WkvZWvD_3I7u=Ip z6a~8LE+2Zhh!+!y_FjgZ}d{q58I!gPsjT@O9JaMk)Ca)oPYF6jwl zx0yWtWHI}JfX6Xz-*MiuS|ppsz}@+_c;^0?OL}?N&T)K;1BZe6UA;negaQ(twT;iQ zQoTA6z{cZfYrujQcZ-}0D;{-zvw*#RGnT+Q-C(`tdKLRTm%UvYg_69cY{`RUo3)X{pjfZu1en*UI^Py*eFs z_`@Rha3Y(??Vh%_%Q#~ONJALul%LpEAdi7uLoSnTL;#vET=(W54)(e1Zq;*ioLEu~ zc-)450?^61OJ5KS?+N>&u8Cb?*|?Vkw_tQ;`*(4sXf(Q4lihYXPPiDzM44aL*VS5$ z68{nn4Qjro_Y^f6y|{oXUJocr^Qb1jg(@xe=f4lL6>78@Tuue+z5oUtqs;XsvB-8y z^*io)KB48lUotr_=qpn@+xs;D3i)=h7mUa=%!2D^Hppea#xmQxcIF8iY??jnzu0UxxY;fT#>m`Q|kcD3F2 z4G0Kf{qL@&qKMoBHCs+{PtT{d^f^qL*sMwWjZ*?PUk%BTL_afLkfL&FvS__uk1<{Y zplB(Df2dwaXvT!Ze8+t7;%}(%)m=_b%)K~;Z#vwNz~fdhcNDnby#oJT^6kmI zED+OVxo^fEXzJG!^d#luHG|#!=v|n55Ddda7hq!v}dVfAOR#i?d{{_}H zgSC4wRW`T(M-(Xq?HgC$g#{kM5%7#AuB)}bUBXhdhJ)by06>Dn&$3H5{{R-y?XYX1 zh8;t3Rl4tF0RE zu89DV0jjw$+L-i$jQ)k}JamHx`t2m;Q3w%%e3tD_{xQxvHT*Bb zpw#7Te~Gh50EvA$2biOF_Zzuidz!BJ?n_32Cyboxmw|Llo={vHOW{@8Q=NhpQ4(GxzCs&6?SsZ#T_)F7vuzlGr2bfA2Y>j{UQ^_Wd< zw(;B#GnW-2A6vY}nbVY;)tAq2&Hz>$#AZBqb2$%&`jSY<@4eUdtTmu&!mhFN^?*Yk?~?tNs_=U z&cy73LR~dPzkmRhEM#wTG$)d19{u4hS>;8@5OqNR)UTctFSGLx?#tOFc%!t&6cjf_3g0}?<7_oZVNz~W;B z-Sm3UKI6GD+fe9=k+Htxo`Bk^F|gr83U#xUCu`8kyeE>e!>mM(X4h)2L|P3360++fC#1yiYZhTm1j*!4GPoVjN8DA6eaF7iFRTO|7>fIvO2 z1<~bF!=tH@qc7lMoe5RxT_jH%0k_E+6PNKIc>UyweLU%fl4WHYpGI5iMX3^3PyGhj z)R9>NT7G>*nQzyMq#UKZ+*6n}s|sf~4w9kZqJL2tP1V&?Jyd!&gP)D=5Pn~yniyWo zh?iV+$BOxSSd)FYWNyB}tPsKaJiDVJkNG+JvW zyX-yVeDBv#?(0(C;ooE`3%jgUQJ}iUr-D00Ky{P3nRqD27tQzR32g)u7Wqr=Pf`i3 zmx1vIJJk6ND^e^q)y-CVp8xB3u)DB{VdsqfsvLl2q^$EWeAFGT0L#{OcvY*lQF$N`V z4%HK~ESjc->(w+|3Fn?U&9`7%cI!$#^3hQSYO{11>WsN#cIsBQ$mI1FIvIz*dF#=T zevE`dOEO*74Q0@$-~P)mM8dvT)D^7758h2BAfhoQ)7S*0jhyEu#H8?y?m!*x<14v5 zIa&!E8dCQwY+OQZan zC4US#W6devjPSjL*5)C#UT-svef~ZzlE8o^N2`4u>+L+)|F@Lm%b**Rt(9_vN9G(_ zC57yLSg5e*)Ut$b_(*s1O(&B<#OFvcDI2lRlvyx2q}ClwArFgDj6Is^qG;|2i^k4f zQ86G7$r%-Sc|%|-2V ziaYZDsyagW@Y59Of@WDIObj1!gLnEG{X@enId_WB@DPIB=?8Im2$O z`0CZd%;)%orFVp#S(>UV@3EBiQ~nIeCMFGogQKd^kV^b+LwF7qx%OQO>UvGe8N@}} z*)~O-!a0L-fw?1_x1xW3p011>RU7^eRAjj9$NQUIfnZv1gy$!RSUP0`1RR!uj$KrZ z?;ipiEJe)B83A_4c=~p7G5|SUEuYdiN_3X~8YwHxFZBnvJt}>U>%%Nfk3tLs%_XRk zf*~HVfVmH9U*CBt8(^VZ2!vzXLP*(B|47+_5xPT`JFUk`-RuOBE=%n33#SMlQVh@d zoDWP4{5FYuRU6=q*G;%WVMRM`2lbIs)uO@U1t3z@%O=JHgO`A5BxZ%sjQ0)$?+m*&l#|Yt>Qj z4K1eM#~XVd)id*-S=q3gxyfC(w$Cc!dp1PLRYRSJg|;{8Vo9oO@x8+OtDQ3>h6?NwRka)hKt5U@C z$%JHT1QM(rp}GEmt`YjUH(40)ot?J@J%A&5C02VOMn1dQt0c8} z%Ndl{A4r}Ks(BCbSaBZ1S+PFxP}ke|%$dCLDmB)T4BlbwUNo4ERh*`&0PQFV%nFS z?)kMxv`j*(SpHs@3>!PjCRhxNS(?>JWKSt5KaeyLc039;&Xrnw^2A4N!wq970A;nF`}_S znuxG$>ys#nR7H<0!HJR{lORBMex~ln;f?N_4{=Nk5d=Qv@T(~QP{`;GxX2)=4F@d> z8MKXxlo%Z4AFr#JVl*2RG#Rt|{bR*$m*kxnsI=H2C5IhokLal>8tcB}E7mM2)A@;y zYGIDmuTXTsSTa<7^l~0eY4Nk<|6?IJe5kxl(xJbWY@K}O>8BN)~ASDLpw*)Qv7rf@h-r&q7yVwL%?@V-E#RP$_ z5L{S~Ejh{}u3A5e*{eUNj6C2tQ$n8kOhLxBg9d^TWj^0qVQb>b@L!v1PBvx++s-&L z9+K%Q{eqG=dbBgAI;L1+WKKa+ozxn5<-5>YI(H5Wc|BE=uwLLuR*S|G0p%SB0qq@< z%FE_K7#^t=#26e?lg*4XNEC3lA8jT(GLb97)Qu>=+)}TrmWp@8={gjzL{!O&!l2yg zi^qkDTN`*n7AGL%bc!^(QKpQP>7b4a021h5b$QP4Y`)Uffq5|M7do< zpL3K1+xA5o9-{Q5@&olNXf~MB1 zLsd?G7UeR^{-+{1i~D+7+7E12tarIHrWZ*RdZT0Qv16Ce(IL!eC^4U~j(;c=kBff) zE-llmycA^}TO(&HobY$Wwv6t01Et~fR^*Tm__lJ)=pR|WxNo5m19Eu&yZl22Y#4d1 zL~n$IkRp9TOwI)YB~A=u(ApOo4$?Gs#4V&Ydyn+(7j8-?>^c z?vwmOQnP>`euy=+(+BFrr#9wS4)J|ni@EJcRAh=DBJ>&mW-T^~+9p}`3kD7855P%< z6i)n}%*}npfPH%*eXD8TfhTpsr*Bq&*Kkj+pqpJ;v!7E)De5a&G*uaNZx~~W2D#+2 zSeNt6Sc9@zx+lPv6^pZMHCMGdV!4$#%$k`J$MC6bx;kj=bH18%c9Gs;eM#*A+1Mx* zMv-K5l$91Qa)g>pJ76m%iw*%}%YSeN-#0f`o8hGL6h zOmqmYlvqqoxM%qlORQ4o?ra28MWuhci%6(*}Vf@uz@Ci-@ zv9&&djArboIp>&up`16eXt8@$nwvyW{szpP@4}k|?y+T8&4Fww?4j(4p3eBYU(rTE ztDJUnTnw}Zea6hY)vSX(Mj$^|Sb!W{n~E`B-zwFym9jB*Ax9(?EblNB~(sQtC*UP)n>TspNA3f4Qn>8h2@u=O2c=8n_>ttyO^b=We2p*`F-DO&V{+J|=%5~ZInFD7MW z>~YdTi_{A($*_KRAPNDkeR?3omOXK3q@iV{M}nk%4F4wQ?r10d8pNS&ww_DzHu9~! z%fISPp!X`JzTx4KhoB|%`(Nk znVMIAXl6-<%FhlitF)w*Q=7G3ehU`<;vR9O}Y3m8C z%LrcBLk8}oAU;WGI13#fV*v_Pc5{QHthNf$Sl71_TcL(|U2sB4exBJq?it>o(YlTX z4>Z~`!yY|Q-&fIDQM;ZU;;7PIvd{=WLarYI8RQ{XFjF*O^K(UE2bs!xz*C8I0nNkg zc+tg4q99xZd^>fA09c}IFP9rj-*$a?Q19cX`NO1(zo13){;lR7FFd%Oig{RIGWlTQ zZbGd z?{6!+hJTfpsrhsg7ecBy7jZ@WBGnIFO(_MeDnwH0QUj+9{yH780@B*@z3VH?B-!v9 z`g7{~oa?xiJbS5s!9!WG4{lo3p0Z7BC{DF!Y*%6`Y8j}_-y{9n9-DeXNtZKks zAY{>RQweyeJo0u-L(}_lLw$o0D!I(EfciX-ggHm=?2?k)vZ{%1uGtTD@q&ic)R8sw z#j#uU2ib{~zH&_xg3}gWi9}$k;S-kMOE(Y23BGe3B4KT)7N!|&5Qxdv(}RBvjz~`~ zsOSiOp0`W*SN+GyA~|2yFUfRjtu{KtHIehLLiv23++QbV0B|N*0cn< zTyq$A8)miKg}sDG2A_%?De%vdP@>1k2sawFym^!VFG%Db23GC&p|&e`y1$XFrtC4^ za=$+Z7ZqHsWGZBl}2B9qm{K4x~eT3VP_W3tS(~19*SfM6d(VTG^>pC zHPCqzYUSNjz=l--kGNMmP5q@L3n&7kYGD|r>Yf8J%v z%A4LCiJh6R`eJHPex2BCRuicipprT1HGs|No=!Z_KJ%+6ma)|<$ClYmrfWRdUnb)u zB5RDZky=e^LDPTCH{bzVxM+OA?4I>Ou{K7jR?MdAX_*iH0 zIZ2l!asK6ZHHdZH2TimD7bTV^Iw$t=(EDKrfeedY#DxJ5)1z_~?@A7|_xpD4TEU9i z4*ZE2$YFScecB_AE#AVC#<^-5u!0x~-#tn)wr8SA$3{Rp4t|ruU)q-n7~nb%S18{5 zM`S&v5BY+=mGlf3gkfcV?^`Xt>MFg#Z>_qZR(4-i{>=t83aU!I=S>vf^_t3nxxcA` zi}^n2{At|CMjfpXmshJJ?!<21M%cPRoz*_AMWr?ku_W$Q=5GfZH4`cYJVmmm8nG9H z9OnSWr*!ZnI_luz7m1cI;${@eH$aVLYe?<3Bkd;gC%@8HT8w+Myb=+`WXC#}_1NW- zbpG4JqE?(LR*wH0%BAfMT27!TIE4xa0`<(@W8CcK)xVOq?^U#o1FiKPiJhk~`zW*@ndmVnU}k<`WaP9wNd_@}l7?6mcLH#vLy-S;fBA{0S2mV|RMfBfdf z06PvN>Vy}ivaSop-=3J6BAUVS_%gC+!XHt+QNK33hRd2YmA>WhEmz3>jOFK59(_3;vroiJMxoElu$Ku}~iNQn}5f)UX~5s8Tw#C}2fS zwn!x$okaoT@e}@3Rl|k-^3|5a@ApVeG-GjsdYPL)N`RnVbrOd|b0?ntIJP+Q32yo?v@ebq{hc?KnK z+L8FMcPM0L`=?2pHLU&~%QlG`SyppjbuMq*gV^o9Yo@dGj9kT-rHmGvEgFDS>&H`y z)o7r#B=4cLVr z5S_oWAFm61P|E%NL0dDtjBrEjKo|&u?B4lWmh1~Df)<%`B#UH2=1sS#XLf!G%DJle zC56d>IC+OLr-1VtOe%b*C@MEVpX6bKcU0=LjthIO3gy^Q>jO{}u|8bU2epAMYTFm# znCNcWVyh@csF5@BprO;QWtn+w(6^{Db9b!BbuUvmt{F$4 zi<9fSQ^5J&l`8}?tjjBlpXL2tuV1E6~ zjWk3xhy|!ht_E2@b(`Tilv9MEBs1kGM-_#PjO)0c8Xq$~IVWut#Wdx*hE`i*pAYbQ znB#E{O-mpVw$I<6cSh&CMcXNwugajc`xnw#JGMv%&ipBg|Dd`K{Ja*-uu&`>n6M>} zMs1$=UC-vm7x|YyiUMPMuK!AR`p98Z2XD;3HRd`?7HTu}3u9`FN=;fZhzjwhto^mO zp<_i@M2v@hcFax>{f-6{qhm#J@_JgJklVBHcvYK{NFnaqa$MgdJt!iBkp|0kA`RCz zE8e=h8HWpr^-VV@1vMOu10e{uP|2vEyM^LjYYzoVr+a^t~V;4INV&}bG429s6kM=Ww5QcSj+Ub%`w`Xp!Ev*U{^lUdL3@hcSk@7qBL1)M z?u2*-*bfl9_1rLzx}vdgR66&Z%Bc#D6x@1kF@>Y!rJ#4F_erx^gVQ`v5AfJX>L*)a zCYLcC>${U2DY$MOPPfm6fhG1x|EZ6`DYuqA&OF*jZ+^>}IOZU7Hu_q!C}EZH!9Y<0 zNZeNq#pII`1@))3nYKIkf{Q-&*$acfB0S?P5kfToDdJ~R`6NzKc;gFgZv8Ey$UN^ z)?6x<-XVGj5Ia~xe2GL64)Q%IF9lDKq}kCdGwAgXv~xAFCeGuC|Nb&y{R3ZMBaJjq ztKOF6Gpu+SoJ{NH#_uu&=a&7NHZWQ3M!s8k0wFEU`%qNQH2toB-mg&aTIu zD3NF6i_j#+qa@2)fE8Unx<1VD`38s%`2H!RC(g#)B>`1iM#{Huyyt8$u?dv2)a)pK zq+DG#9m)5NO3lGXw*TPVC>BCc__4o8OGvWujvOgx0~#P|cud>hn+tW{oxgwgh)(@%PvKvYJ zpu&oaYX!6J@^*pd^<9Z;7=PW=1^x+09(~G*13ufX-*Rs-2IiZ-3fcoue6$SmKVI1Z0!wMxJ0hQBQ<1{N*qECos#)Rr;zo1iFZrdfa zuY2&FaQ9;bO-BZ+pld zpj(WsC=kaTf)YU~dxd#{X%?B2S)T03=_OKPtFH4QrWOAiX619{>=^~^pcuaqxJQA$ zaPOoaSx(42d!J3DehAs$#GM)THbw1)_HA$8K{cMTmiE>!-w+t6P_S$oXni8zzMZ(B z9K{CyT1!9;MrHJV`EywwDnx}1gHjQ(P*(Y;wZWSY_}27^V!az)huO@`$kFZzx7Cw* zhrRqw4}`lh5&NOLtscD(oxQbnZ~97yp7~W5vC1i?I!{n2;gbIJx-J$iZL1Xp3mO+R zcr+fV@>SLXxgs1LonIF-%WlQ=c&0b5_e5a-P+Pk;LD)HHipbDP@BOQw_czO`x|D@Vk4G`LgURm*3Rgn9PPyy{PgGiS z`6OjmF=^IdxTw!K&GUddMdUPJY6WcruM0;y`Zz|2k^t_6t_Zmc*K0~yiCow9cBVEw z(Ws4VhBW@oo?MJ0EuQ=I*&sz;}N;TaO!t?E0)&J^iw3oHZ3Ig(i=Hn zxZ}-BE~p(FVUHNGSYJBC>^Y@n|B=oWajLLv>Nr4YD0vJb$hLN zavBO!BUD$nZ`*So?vT!1tQLP1IosJ9Jy+LxS8Es z?N&J~HEQgz`=DV7-ldPL7!j*x7q-COD8w=m!pe`%a@3^$V8E;rUY7&)wF1~8}lK7Ch3 zJZ>|d;5aF=f<%_c|8YvW)Qv}b*jq55*0yqz0OEfnGda{G@$^wrtH1v-Ww)Nd#DuJ? zlptX~m1DQ=&n_>sku}wLVL{k*&4T3bqh>tHCq(u}g)VVh*Ec%mbX=S!ajPXsb{P80 zG2#JRpW^B1Pxv|RE_06dSeW*4{#$Zo42`wt9D~#Bpqgja$loYCGn?gS4u0QOrEc<7 zv9{WZ1Ws~^IYhLsr1?hKBoPFZntfYfF+mUH2k_8xuy|nadGn&aGazWthIqZ~{m|dq zRe1xm4j#94i;F&g4xH0_7M>d`w@hSW-~>JHyD6|$)Y0vpbZQ>3afViUBcxf`5wW`? zDRUku%zd@ueZoEFyJyqUt-QTweHwBI> zyf;&mP>zPK`zxidI(l!0<-JE=j`=R+3Oi2B!7)0;?1-8guU7=+n_leP7h71GP4#!j z>~h7czhk>Hd~p1vh-azyK~d=EUu2{9PriS3U&dd<{E6|JK^)XFO*k@j>4h_gS=bd7 zHnbpu=kHSccvG=#DT|jD^Bv)H%|awzp+6=*fZ;z6(Ji9Lks#a0Fd?}f?BNB~B^5!; z8{C$talTodeI=mOC9bR_BGVb;Y-w+PL`M@9p_5#krqonZ{Sy+)Z)RM&2$aq+D1Kks zj~fq`TzB-^@}$CLS*&;_jD{tkI4C=ebT%xhipfzh!!lnL83ScSYe0zUqw^bo{Kqpd z=Guru_yY+VXJC8V?R5<@Yfvd>&2`&!03f{Xz8fqxu)f0Qffbtz$^NHAjJmhg+TWLBIzLOC{@Jw zxxY?4YBQb7isgl>Iya4TOzjO3+MD+3AF&+j)(+Q(b`3ODP7*0<{$qS&a%=Cpxf1gG zW`xD=w(%Vlr?u70iIv+qL@|f_W<}9`GhY4efV_>h+zg~>{vwlQZYI22DR)sL;Dbwf zm1RO!B%Q(M)i9xn?9Pjg*2+2WtrRc>&UyK%UKbMfMqlyx=HGU`MBY`Z;8WEgDfc zd?Z?`=g-@-<=J}>90nspP>rtjBUg5bW`~xBok7Op9#6UHiGTFzbxpI8C$vb+y&icZ zBx7a8={ws@KOxkvUD|19IsJ^=IBbdHytmFk#mvW0)}FPAfBcq{_Ub2=`Msrz?j3lX z)i+X{%{%^#wPSKEHCB9Y_c>BIV>wGthx(N-q}!=y^zW*3oAtV+)N&E};ktTm|A)G- ze2c0Lza<73LZm@D29WNMZWtOwq(e|bS~`@JM!G>j8YBb+5$Oi$l9ujn1kN+>?>g5x zU(O$JKKQ|lVP@}PKX>6}z3Q7dn=C(BQ_8 zVeAeLbiz~TgvqWai1`=^!41tNl#gWr&iAisa63HTFW}@;NQjZVFX<($noLPeseN6j^v$Ybu0K zKrLdLqu%RuLzljlI)JYotj8oC+FwwAc3kyG-|iPf;S?yz&)Ctuzjr&77 z2dxMt<6)TOf*)1MOy6ykznSVNYYR+KBktq^XORs{pj%sX>WNR^uViGkouj6{%E=1N zJJ<>>S$H8F-_VxqF?+#;qEz%2ydjix1{0O-#&AW}NeFgZGM5r;9(+S2+CLFny&%Eu z&|Fu3W2=~E8$!+%@Nq&&8g0t%f+1vwVHCqAJyDLK{EitL1kpa3*-VU|p#zJNTkmJg zL-i*~ny=RkT<(wHl-kAWb>kD}MTJoGi}tZ}TMV-8RiRr&Rb?2xdlyq6|3PP${B|}| z$Y$E+yarkI-9c@wtW4<4<_FS~x#4PZ{R2gjV?ZKH@{D?y)pq?W!4R`st4N)SEqu8y zD1gclzsWrjE3`G<+bY$p8!f)h=6jrVAR9w`I@YYGV$ zO39Pr(U{-COUfZqtql+H`8?$2Ri-Zseh%86JK6~B3ld^Vz7W*;L*-Ah-ynBrk@ScG zu9Hs0$!a! zTS41o{6d1sid%5SP*w7Zt%TRJYeQ_RL7h7%EB}i#IJw!qJA|F3)ReQ%d_Akq0u{!>z zslY~e{^xLMDSO)RHi1GD_%Ebfk(__b!I2E;?t6^3X7#b1cS|w60&18G!>`@yf?lg$ zYRFPKw%bY&kL7zh64)~9d~4t!)VT(d6*CK;ByNh6DkLBNz5A)>f(`3YYVz}JQJkxc z+c3$Ge-N)FfaZyDX)s+mGJIqh6I}_Bmi)bAJCylM5R;OHYCdA9ZhW|%p{h&=P2cd& zzuhBtjlqjlbF^H)rdxtkj7AB^ydVG-qyLFjrujaVlBQh7mvlyS+s-h2cjw^X7djC{ zHtOg|1)U6dvr1=RWpQp|yc+VP3uPR!xnPe2cKzMie(|tV6o19v0F8)#%Sr@WIVnlCx)NRSvS+r|aBh19bHTfOulK^l0J?vwqle&n zdYkC79(;=bR_t=Me@@i*c+hiildfnHiQe-YbOZS~-rUF|m|tdu?gC#2X@Xy~KN88| zhuVe&=RUKE?fAf^eVmD*<|DdjO~)Yi*0r>DcLI_XDw!2p?1Kgp?%`$qhQ2(PWknuO05mObV0=b_VG1+4tKSznP00 zslLk}u!}zDopX1LoRx-p@c#M9&mzX>>3IFwG=B$dRuA}HE?8Ci4}*g__nsLY)8bc3 zFH_W8j(DyZ>NqGdTXrx}kc*ru#z8}Mtf)lt_j|$dLN&ry>e}H=!uXFb!1hl5*wMRa z0e%Hnxe=j7&yG^ZUQ&7dbXEPhwMK?)nsRN=>IIb{P90-Tap5laSS8TACdKK!;76-a z-k*P(pvrp1RD+?E;H5DGi6Rtf`71qoImw-Mkx&`?dp!eQmi7=IPK5!-_;Qgx@mHSZ zZK@*Sb7bc?Wj?+b>-YL^=CFJgIrP=u9YWiR z!#m|234O-$lGWY9~z`|wF(I);pXdK86N*8Hp0u#kmUHW$6C9vb_Lq=`9#kS!Be#|+np z<^o?rzHP1~K*UNEVUtKXHvZUKp6sDgD`xQeJC~4PJO}U3^{m4Fl{#&|a}7kdBN$*2 z{bDIC9rknFMy{Rn?W!x?zAs=i!K0Iw*7(bQoe?6sAhs?*AT-=hsHq`q=8og7u4?24||rsU*Vz$z>uqzwwGF3j7M7WG%LSJ#wP}J zqIBey^YN%Hw(9A0s>UK@EVLr&q^rqf$o~pQxcn7%8G|$HcPpeBFlmxux=m7P5u{XW zNoJi^EuS2O2DIU%CTb-y6yRfbh{-0~aj%FJQ%2lSya^J7jk!M@J5b*5Q$BY0%;MQ5 zeA*{E;MF>$p~KB+eNtLh@lER%L1d3k`van*ousu@!v}75<#X@3cajm2GCfjAC@;oG za%I;+*5u$cl6hz1I*G?755wj9Thi5!XThin8@IOF?&q!8y)7Kk!G7X67U#M9Rk8h* zPulD^#qy753iz^`PZ%EK*FAl3-$SLJo9?``-5>HC7sByz)EDA5r^S z;mkNG#A0P8x|>QQs#mJ<*Z5@)BtpW04Hw)fWF%|Zju+1q2`>J!2SQpchl<`^zorY> zt@zv^p}V8Q-&wfK$mB2|rXTBkH!N{mPL;rB*;VIE$@(hnSXz26D5l7M#J#7=OCwHi zzAnDGSA*NAmir%FZcbiz;d)H2_+5bHjL)2?(VZXDs)x0XUSGpZ&b!ug7Rg=4OC)+3 zpO<{K(tGC{geTM~y@yH`UlgLh6)huQCg11pkz$7kz&!LvNeZMW^IcWojWNBKjqYRJb8H-Q9pU@v7qnlOzXzg*h(O zLy&yyqp&dtG@3fN^;3nWalas8bBE@hY%@CgOc-^^=N`2ycXug9ph{bUF{Ww--BIj` ze=eaL8{;$*y3B0w3XBO^m#MtG39{OH6vN{hGaB%AQkF~P_}1j@ww1QuZzX-Bhw@BH z1IB2M!s8|@HT@+&OSkB3Esc-4&3oV1zg3SpScMlyuQm{7JxlmzxXqWl8qftBw4KIJ zASTTFoNAY4Ja$O8<+ytn4O?AFZ<^DG--`eIw|POcyQJ}9(fRtaMp(}FuegGI$Xb_| zIsJh_lSRb3PyQ-{{pH0I*WV73hg^}e-67tOe27`)xdZWU`s#Wrf_@hW+hV^KLp@$1 zdj9~vgem_p@_n$O>!X?QYN2}vFUTVQij0i5QCrtj>n8Nl|$+qev zpDXUr7?wUTz4+H1VQ;?>KRNk0A%cR5bSs{mOn|iecGSm@1yJO;MyloQqvUq1sL#Ur z|Kd!Oy&at{!lr}A$z&H_>6lZSed-MUD=E35HGj#HsBpG|&PY6Th~r8&eiU*^$VNKW zy6hY%6shftH=|P>ZC5^`+xRd!FhP*!NY)pQw&VFanxSC5{2{gR@N(e$w{t94yF7{- z1FQ9c(@vTTenxp(a+D{Ia-Y!ES@&esLUIWhZ1A*lupX1FAmOc!wv{TgK}%-pf4_AP z0(AH9dryr!EKfLQ*lH_gn|Vv_P7Ajtjnd}!HfA)^JCnHy=tsOv^y*Hd=+3>VgyMxM z#b1QsKb;w;S-}q99GQ=d$0FpQ7m?W4grQOqB9&s3VM=V1Ev2U=&MBkG`nNw<+r&)- zxI0!`1lnur1G@~?I>P&Qbuo>Zxv+#@E;Z$uO8K4?GKfwHvH#o6p)C8>$N0x3QtI`Q zBD(X`1GP72Q%GjrR5;V|D9*M|Xdw9$C{ z!a(?_6?C|lc^qT-pov5FNP2NM`O-A2M@=xtrdaUr(qTSReiSXe5@8Z)0i-gL8z=tnjF()_OEk%&(#eyYQdv==hs-&#Dv_D&5IDDxW7Uy(WO5HS4A@p((^W*l1(nD3DWw>v`m8 zJHq%w4?nQ|qzwC$a+%d|_LQKE3C9Vn#F<~HG^_iPFQh~;y|rEO9dUC1g7SxF5Pr1? zS^8fRNdfuOcY~Lca|QGc^&Flc|Z6Vc>{Efnis@DqHxNjxV2D& zs|!U-S|VOL1teLr>y45^`H<$7;%-ujnK28w&ImbWzm*ml+vhD{LFaq2yE*pp)vfCK z659?X*J@*vJZ?Q$tHt)u|0v;nEo=m+l?R$K2JrM^o1 zCr}>bd{k!4B_Q{}oY-hN2jmB1<4H?{h9Z$(yYM8-&M2HPH2pB)D^PO2c3X#^iZVsr zs_f0O)+IkqDOcl*;BT^D-@#^d>rkjmew3teYRZlNurcP|e{N1;vh4ZKM!V`Kz*?k= zW$Jk7QKg08`{p9@Z0*(cJ_`BfE5iFCEbD6>r- zJTE#fXpWXpZJCfLYQjH)+#mW8%=G2fTaklS#}Af0Q*UG_P5B zv1JC$_x_Z0v_l`5HF2pUIXEmXJoP?d689(CYn!sldmjBF)mbk9PAaAk`Y4Nh5;c4i zTDzh2-V8vI|M0MS?!(TdhD3JROJ0;EpQj41CqB1>odTUZ=1?kky?I3m^Y-A(&JT~p zj{Ivut$<$p709|wUA&nC!>Fu7ubxjdj*ncVAC**X?D#_VhtKSl2oDxl?B(Aq{e#-9 z6=pcZgWZb$)&SIXphH1QdY8RaeLQb!-a)jgew&)uyU3IvD(1N3nix5IH(PqET(9M4 zml2+25;H4E>~X+u{NjGzN{$s*d^q)&jrNGL<_>Xm7!&eu)ECuuy&X~)3m&FVxXt{{ zihYMK6H((;bMy0!DS7@N6CrHi{R*u7W z+JRFtA4N#pKf%@-u?6aUaiCmO)eK+Xq^4B)jAk=#ezMLxv{qdDbB`h6$SI87)>C?- zV^iR#iSCq$?)T&}X3>6~PqVrnA5oDV(}@f3B&rVbn)PPvlMvp`4ah7MvEwq6w1?lOGTO#q*U%~d!2~ag5-O>SK zI4N%{e@%Js2k_p$WLWBKJK zzYLCG!Evx%eQXw3mteV=U@VYinav0+dL#&CB0O7VP>iWfGa$^(+X9^%4wZOfx^^A~MZ{Va0!h8(06Zb0-D>$CjcH%+ z835+N^0w?=jfB6k_Nj5m&5Vf3VhS!HXS_?sW{7uYA9*I2UoIrJ%9S#)GLi;};dEw6 zq&d@erum*vzMR4iE3Z~JcH67&nU%BS<|$aCml7d_`t*W!MK>n_%!RdLL=S{1{BMAu zXV2QgiyXo$az~COO(xeT>?-7`>^~UkCB~Y+XzyArFdi!JuXk8VuMQMUMv1eoPc%k! zMv*X6=u|+u^K8sUza&yZ=$q}kh%sb%TQ2rJ%1AX8&F5dRN!jj2G*?3?y>Dg2um7D68`c#oRQbfQ%v^#|8{hd1b6RWbuBB~;B9^<;$GVFm zc$;pXjW)q4-WpHd&+!IfJlB~;;aJgwh7N(zVH{bc%N;N{TAxvT^~=|e-t*1hg)SOf zWji}i0mK@Ai&8xhetLmgTky!Ki?jXoV?D{mvrPX?Z(TZ85fuCNuZAPc04E!k3MJE#2kO& zosk?diCT=rjrFsYFotqA4$kkKBX+}oZ#c&Bmb-$A^_0wBN@He_#O+e59GOeMc!ehZ z`TI)peN*f|8osSRz)U-`ySH-=2^ROP|=jLzn9iGM55-m_h3#OBl8 ziA2aC3UUn5eE6r8%6Ud6pECjl5lKciWwSL5CzzCS$u{NH6VhimTIJM9M98r4p)65D z+U}?)&!0+#9sd1f#;s%27h}dXk#n9?E8UvG6yoIo1de3v!nOCHa+b6RCCuON){Ja1 zX<-tpKoc$Omxq1Y6tp4nU`BT1cgD-&w~Uqe3hp}j*d**#=)*E@`4}uHA#&iI&=dkA z%4j)vL&WS2C`sZ1D4kl7y=<)#W~o+-;^~*=mw{x@U|(v~PEAhm88YhMv@d3V03yPOVh7+!N>!vx4d>K{I%u zJtJh^2G6VN=sRmv8BEo(Hdou(_H>c5;swn8|PsTXw*gP|;4@a8 zT;d5L8sTZgCnddRB1URCfUUh(%?MK&7u{46l%LCeE7F`VF1 z7yq;6pvSZGioTnl8m9q+F#&uGuNuvxU*(<*QvWoy-d35Z(CuTs{?u0@-^NpLMO#(< z%CMx#p}aQRyXKnGK3>2*TBGO52=*ymJkQ6Az69nua)q>Br4w$v1HbLDg8fKIAVGYa zwM2gL8QD=jlPgZUo^t{7W;JgFp^qGd@i;k+&ng0)h6Jroyyt-R1=#AjRU*mYzglf< zwo*nei*R}@QtfwI2uJ8e{jSm^)99QTB5BqQzzH@#IeGqwJE0Z2v=6_-e-lFT(er6rn@UAUqYtK2kj4|%D~5dW5}C49ZyIqGeDG-sTmrB@P76H`8tTK)@pb3 zJ6J4GGwa^qcG*9Bjvt1GJl2?SSz0Vmu4O|7B&sf6gK>|Xj4jdYr`7Xl_6gPyO$+>B zC7oNa=WfUPR1AB35*bF1+J+iQQ1iZ2zozg*!o4o!L>|eJ{bj;mz*$TF5+lO8WRWLe z79d;ACid&#$0l{#+sKfZczQf^NRy4W5@mlACWAA97g;yiCmwM8imMQ0yOj|CcV3-G zVHOHnFJCJ$=zQ%w4jOFc^l@$K&M1G+T1oNRwo%f7?NQABO|uFEdrC)DfLm4!&9_KT3?t};GiSjdA<|8I zPMTvXlpgcW@?AWItD_7n*Does*s3y*E5PMjeKh(i6>P8a2r8P%X7tyO%TK<6{fLV9 zVH1WY&EXxX>>1w-^82gYGC|-dfJ@&grxUGYY6Cus9A@y|PcpV^(Y09FwJ5%!Dx5WN zW;tMXagP}i*xuh)D2*cYf~32IBOFANn1Xs=miPqXwT_T+$rQ-Dn+86H3n5e@{#+G! zo_{WW|3;|AxZlB$74RWgPcw`XipQ;6=w$u9?14m>puBQvAsp0=fmI3~kEWx9;+UG@ z2~1-^8qy2!j`vg~&D$YQgd8%&#TRV;)P5Tu( zHdtGxyR~%aEv#AnKi@m&=ba@?f@snPL z6Ce?~hJ!<6Wi-AB)M+#Ak8e(Z)|Jac{Nd;)jFf51)eAE+ zUR?XMXaUq(Z|I9Ak1mRqRzD$`=o}XU*+4B&gK4sM<0T8Bps;4kj6AU%i5IU*o zT0_wWsF?CBclb`~6h9gE*Qk6-Ek@^e&awVJ2lFrAcMTz>*s?;#%T=dolY8z6jQ$+tmfPUfmD#s5rcjoE|+U;a-zXh3v*erX6 zNXKXDIW+@<^tw(qwg}VUTqYJ9zF;P|sYhu{^vzbdUb#QUA{T;%%HbPg+1{@X$5$eT zj0~D_Re;t&fMp(N_PMt$05QvaQyDo-i0K`mqfL{X1cdwE?$@&nh{ea0W>@t>J<|{x zoh|g2oBRGLpHd5f8uIvi@5^ludD=Z_gRf!glacvOl}W?Y-60FqKL}c2%#7Q|t6&}s z0m6@GKr(t;WwUj3IG>igJ(0MTn$%GQ2ws2fC$gb1G!)BQSru2<*8mw0sh@$>?UfKG zXMcy3Q%Dy!Ey3SMAZ5Y`0}#6J=0z6g-H{Eh+uFMYLVh={ZkK9gv$M|hcu&=b+r@BT zPf;D|ISp=gAg|LpuQFqyRS(2d=T@e(!L)4 zQ+k95EHsDOL=37K8yXR;naAW|N0&cpGm;aa)*BXJ3B^tM+llcIrDi|MYP7p>WvPHqeF@ zom#l8?x9v$E2(vqr+p3JmU!NJWejpmWSpf5h0v#>u}|sUAkNxAz9rdZy`OQ1|H-)H z{_D^1P)t&lNr4v2L4l&V5LQ%py=Z#w^s4r~MNv+_A$|Bx8laFQ01~(!>QCK4cH!9< zQ};}ucQD7YSzrN_CXRK%VKz@@Z@Fr)w39#M7=TNg4aL(}&pMYQB!H&*Y1#iepE49& z(8wE3Q@=}@uQNt)fkl;HCY>0PDu?g&{^9yJZESz8w9S9O{^#~nwzjR}Keqgv;i47> z#2OH0D4n?Rm8d*rm>`R3bF8bAk4hi8-s z^$sTAy;cb!;W0HSd*acb9}{Hhkg%KoH}K^v33ZBY8UWWF_vrYrzk%3JmD?yvailS- zB*T39iP{lr(6NE{AciSjU5~9pPBTo{5=4Hnmc2b=A7T7jIibJ9eyg*?{-F9j>8o*$ zMV+%RVoAzWtgar9t_tk*4Ak0;$Me#^QizoSYPN;w7Z3)CFXyP*&K)p)gZfH#8z=X` z;lc$)1YL>W)zws)L5hmvC6fnG{e}M^S&@f2$t5XZ8q;qitwgpCjU`#W+4XrXzrVUV zSAC(2P(>yp;}xe(!lQjfl~?%4tsp^~Q<=JC4eY5@B|T1XHW3H54tC&WFbZdJ(`s5L zAP+yo{#&<9RHm`msvO`SePfg>(sEN6<4m>DIpx@(^#56Al37MM!Z zIWz+u-KiV;J{05O1b&3BgeC`!mCj@=c7ia38u=xy?Z#kQyfvvQ7unhv{W~Wx6ox1i z=0o$b5j^<(kHR2n@{_R{XP3sBVhm@LeaJ2k!M53|4mUHa)G3Mg1rx|T{5`r4ny#ML z^szX05%4cg%%^ghr2*g`e^;oZzXxm#Weq9*+I2%)0 z-!A%0LLvl;YF2tYa!kk(&?{y%{cu;On#S9;6E*y7lQK=nG26J{5jp=;Q(vv1V^X;p z{doK&N>_&k5)%kwyi8ao{mX49k2&(@Y?}ch`W{#^OtogSyBU0|&=^j*hXyO49LuN` zjw@1obyf_tZM-}DMUE1cgs_3YQ&H* zYA#&X=Y>%?l)@vWb=lrKB`ais*`Q#35}^5H)PlNBPzOQ~)v9lmm9)$!ci8N>)ckGQ z#7BQvde7h1>{Cq20S7fi2Ze=t{=A${(cfQE(G!gXL%@D^!kbA1^>+TpyGRQ%Z*_TE zM3keK`65abumEiWBk?Zukm=TYP*3%NM)0Yqd#A~L-3)pK^AHp~?UtSPQ<3agC@+ni z<+X4>4OElOAVh;HYIx0Bk=!n$u}f#+THv5+>p;%0Y87)phPoh!hXfI68p+)x09k68 zBLhkSTOH>|vcqN2H3aI7fpwP$l~eR5f*}OB&lKP@K46MIfJSOW3#>N?yYta6VEz?F zP&sgdXxSUJ@SzIJh!R3HLiAM=aG@A$bbCwD)@;^>0@v+ZG}Cc?TZllepC2}vc;w>c zOg*dhI(-A40#mF>#U|YL))?>Te~ymL*M$hj5Z35UY@>Z9)P5UW8d}+Of{avdrtYT7)aX&^j89ld?lsKj ztn>9&f!RB#Y-c0Qy@=aRFEAJi-U+oeyZrK{RNO=SQ#!kZA<$6I_5QvjJ0} z3M}sd=)Hbka@%?@Pdfpn1lvf@%KmY4hV|~tKQWD$e-A)BAe%m=xmps0je%0o!5sxW zU?zBDBZ%1y4)Fr3FP1)h5Urha_^Ia5@E6_ifwrZ3rBoPz8?A5TRs})z@ATP02NECP zUlS?@1cqG(IO<`miD)8<*C*>7ge4}w8U?CMJ^zO2^0H_$&kBFRgQB4V50GEJcjwbC zfacf-l5DEV1P$nFKuOL}m?1O4@j==Z{B+K&G{>(|4PS`~1%uK_idW-h&O39nmYveF zeECR{@4=jhgiA?80sn=uBXsk+AeFy>xz7gdYDiO+rz?zKul2_9zUmCisooWor)9)< zve6*>2OOL76{5*=f5w2r|L5|t8wvVF6-53cZZQsxCRljdDFqGJpOo<0i7nF>AewBr zv<#+sN#*6`I4x@4*V_?DEHj6o%+fTWR%hSL^2pB7X39o;qiF2TDBp_sE4G^{Js_R> zAE9rL7k#>`cpwUJRmcHsm)vHtMHQnsbIRhhP+Tfj08zTA`>GUUR0gRCqabGNS1)!j zi2`EjM}GNui1Ic)f_swb%3%Aaz=FkY<1VDsl&!BMz@N&@coNV6~^ti_nwz69wOPs%T(jobh@iikC;TGJ4->coOA z8Yre_bzCsd3l$mU-sPdB|1oxW%!Q&vH!_&U_xgCH>o3*T!>1^IIaCbXT4x5p$H2Pt zbn`!!1{~YtHZ3152tl9}`1003=#K@aBh2{^o*v3kP~=b`M@00^ZZ*5SWMwtl#q;Jl zCQR&7Mllb%ChdO}iBRo!C~7xn1tNG((AHM@7z+a(8o`d@L)CrX}&(J`v{y&*^mAljC1lAEM(1?g&R_x;XfJ`akgs5xOk_din~D-=rk$-2KCFLP*bS(ykd72A3X z1O3ati`#5aE46dEG~^#7awF+?$7-B#%De?Q>l^X!aX=$Lx2r_%4OR(AUBS;9Rdk4e0{fI0|v8F(Ii( z+KITGIqf;DFegEj#XKGBq4uXvl5o&r7dR|5Y8R?LY3ucgvMjpFK%xq38Td3ys)+); z0R|q}n>I*s$X2z>bUDJKqm#gh)fnKQtE7`9R!|gITDlzWaEL0i|Dyh)9=>Fh!Q+i^ zB+*7ji*;F5+H0_|8@4LkR^&9t4B3+M)z;KWfVdDy@!?q>F8*rX`#X^%jhZI;p_x+D zU9}l({bp`BFJT~Fsi~wB2N{yf0p&uoUr-OdOJ84~3n20Hw!SZv5j-QK3d=>4ty7|{ zhv4b;SUV1e?M{beSNzx@e^m9QhosQq8t^#Yy_FaqP(;b>htd2!or2-9poFpMd^LDc zB;J<)(b?HKu3u#Ms7o@2hldBo?H4E~-GowC5vrd8|E~>#nTMPN zAxu|VuZ}bix`1LrDUN&)__bOz_#OQl)Ip_d37Dx)2qJK)YM@Om^`t1DnLyiz=wxOxt74@teM;{bv#qhezq6T)${wT zr`kKCEV`rOz=ERnrRiWz$ml-aMAOr2*;Xh2 zISs`*R7R0t^iNj;K5DK7Qj(RwwQ^<9I067bfSK95+!ll=`V2(%f4YCgp^-2eaaHV- zL{Z>3N9;F>z~@0otW{Zht|87iEOr_dql++sbM3VKL@hp~jQL_=aBwholdhq6a!e-A zJTC-tWOiOCe*Dv`*gn6o5X+VkvDnXPgti$VuvQ&Q%=iE$`zr;?2PP1Qr|WTY$V6O= zVT_F1v|oVQd|$EF7nl$(B=XSA=C>wF4*@G4>5frhoIeLd^JkBgxGK$9g|X;TddM4A z)u6yW7(Vmghi^~hZGurtURGu|o4f8#sg=+^)h$paUKr}_g$gIv(7gr8WSLNT207p4{CV%_YZd-a19Mo_Q)T;*Di=@WPX1B8W-bY7Q|N_$=LjkmCtG@5rF;%7?c-> zOQr+_1g>#kk5_wc-H{4R2k46y6@+8KKw2GD2As>ha(>DxBniJm~BoN42PqMyYhVP2&np*&cR4MpeFAiXLIi#yw$ z9!_C6erHi+vq{E-+sXfQA{1iB?9aJBUZjx%HuUGPo@)_45p^$*Ar3H3Y@%x=S6X!1 zFji`PiV_x-6BJ=TR`Q(LW~M4v(8jz=VM6ukC1( zlLF9-&Hb$xmYegEnNb8B{k)E(AMyT<&>U23bc)&9VnUQXVm94GQ0i;=eK{pf;y z6oiBF!R^}=0LXUEj<)EdW=YrQF=H2h)T}1K%&3rEL%YiBzhfnbw_e4ANo?^KxddHM z58Dd}?YLKCvh9RG)JRQO&|NG}78 zjY>V8AI|(nuIg^0?j_e0ARbLlBFH(7SQ5Hd_# zQ^7~&IJ|r-8LqVWiv2k7R!)@Ei+sRPL0E#6O)s?;pQj7F1>?!`!7S02?g#TWFQpaQ z$VFnGO1(~onK2;qU(zDk*R(eGC$SC0(#ftx3oXWiI!u3`f4H7~TWTnUwvssjMQ$0? zb0bN}re5pBWnW`HeVSg>-;(mTSz*b=BqNnm^bk4wtzZZXfhe`IqgZb|5q8SaSC)rU zM3H&{5KFk_VC zkT8jGP@*Y>rjSI_k3g<2e%?ijGcfE>fR78=kJdZ%1VyMw7t+mZi|8{j+}X(!0tv;c zKG-T233H7Fx$+q{-}Nk~9#cJ_J>SFwii^QLI?ov zCP6QsIR;(y@K|&s%rRq6M_Oh-fc|(5@NWZcvRGhJC@`lA$W(!_2lHV30lxYtPqa|mjQC4RO6c57zT2e@?b4jk62koxvwgp8P^!#Ym=(d)_L)2TzqK8e-L5oz*7M{fVLis32PSOrCiJ;5`9{tRZhAkVS zkQ%$jxqEd9V?~ix8w1ZHE;t;H!W^HL#)2l$>L5o*^4>002I;pRNC@MFOoPv#gY^Cb zn0~xlxTG}3=6NNUxHns;0`9n!&*`Jc5I+GeGJ!BDiW9Y`L#`Jk-xCY`vZlm;cI~{~ z0dgpSs?^1t*jk;V%jbEttQnf700I&+$`(?M&!q!sFGxvA11Rs}(Dt$c6c0iv!l1C0 zk+G70SOepg91cu7hbQ#WO-bmj({ZX&+#3lPUOEz!nVe$*z$W|e?`~y3Tbi@(bw`AD zgg$<$7@wW(kel?t-xo&K3;a8W8=L8&h#(sJ@e!baXx9*gE3jSdC^vfK|A^MEuf_7V6>%+2h z%1Nwn8JR${ZKH|yk4X~78aD2=1#Ji@0rv&#XG&DCclTY3``t{6gY29`v;=n=z=EhWiw3!3v9E!=aeFak4 zv&6Q?f8O*B4dMRzIn0!y6{Gia{&9=`;8MgAweG`hy+ut`E8z-@V0lznwm#Sc`_b9i z2`yB>{Ej)7O3Nb@pPbADT)ldKm*7kGl*Vnv~b zFbA&a^8yiv&Ws6J1dneZ!~leYSpQ>?Orp5xS(Q-0&)yK^pz_oh6%%8E`zO=z$L;)o z{nAXdkSacvm?!u2T~&vrxi2qMLkAHdXtV@Prcbr1XcHOx@xL?;B(Zr&6i2mO^u{p+ z!m)UIlD`J>@b<(|jbGQO*2m#?o)P4||L>ZfBKs^fDou==fgcei z(cX+7BKcqkO_u9FN08HgdK`Z5sG?=7BKXVjNi2_Tu5D;-Z7t`^g?+ZLvrHA`9%!|! zKRZ{*PaD09?(FJ9li+(Z$UUcixu05#?Z#@5WHp zF0fr2X3@?MO8^HqEBfG!Q5_6|C%=Qm?YT4&x6*Mi)!f}fIB&fhR}*@MP&Syik;nw; zMf6}NcOsAlDx3*uclw*k-Cc zt>WiDpo)mK_{yGeFoWOc!VZMKIKXh2d6PZ6D)Pt+03wLazcJAs7zVEaaHVEw3Iv$} zu*%|Udw+vQOR|ggJ8(mA%Lmsp!UW3~jYjC#6+T8{1q6?57z?xDM0@*B3c@tnN z(`X03VC=S^ladMualLH>eGyEVS%}%LBz^x=P~iY{nD}W0I2ZZ=IQiJx%t1kF;+dPs zuCHy1K4OGHag1V_@eiy=o&dH+e=sJY9Uq6;FescYL2m~9qfu?f^27P6(63;Rhi3x2Zz-Ed59)}An_IzbwF?s3(_r#VGwak?XX@b4K4MTb* z=0we=TONCLsYEPL_pEG;dSw6)_A z3y0{ZD1z)JO?sL^XAto{RnxLi+)g%*%b(zy4E*M+%!AMwj+v$b=#j(MunjWUJt)u; zz=-nYT;lO?*eCnIkWd0bLO1qLbMG_}rr%rKW(lp%2vjOyIO(Mc3!>Bq`F5O%kCBh> zxk3zO$?NcBye3N5?XfOvifyUDh$2vmuee7h0t-MTFdK85Zv{ORu`9aJoeYv=vGq=C zDs?TR4~>|meSEXuZ9gChz&wldFdn09fv{NB*NI|*ZQ_X+^wqSbS*J`_%?IydYqZ1q z_6NOr*h<@$T@y0*1wIOHLKG}EE9>jAh_G@*3#KR6Gfy6F<1HywF1nrn0?0=KGs5Km zx?+D&Q@MiHyf6jtoB>1xWLeCS05St^ok)n1Kj_t^FkX3MYDpqeI(H)I_WytTrBk$k z@^W@#^gpEi+His}JP<3P0hWSjDXjnuUHdk`nE=}P4Xk!R;Cek#to1`Ag*nc@4}z6Z zPU*&gEQzOAWfp*_;}GuSlEo@iaN1W8P&bn)zj2j-fPlpYzyW}hKl=g33}|XHvA{id z0KsKI^dSiG1czVex_!O9v0!ed+~~ef-mu;sO|hPA=rDQ*j9Aow)!WnR>gs@hV5mbX zJ|#Mi%ZG%7AqSU})+tn@@B&1ed@yhQ_Noi(nfF=ohCYB^egG`f5vz@#Mai9R&r~$K!x;ptZ8>_Y%Jeqyihw&4%247q1tYys!f#W3Q;-M+Dm8+dKR<=Xmhb3(i#GBG8m2DS=<3o4cGU+*kb`c$tfT=3;-|l zr$FW}<>Mm?TXJ=*6t0+%RccPEX-%b81}Th{xMh!Kd||hpM2RC(E)(|c?QNHTSI%&C zbzMKu_T~fZ2;oEr9r6Jf=o%>b@r1)c)rRiceGi^>SDMH33qL)uGqEV!5fSZgdx$sA zb)`X_GH~PL1mm&T_jfmN0QkKIsgu|9$P9s%W~ZDEBd{2Npd-TV7%t4#ofxqhY`bm|rSgos!XM0b?fV z%S(WdHN>~VuO9yVW#rlqAd?n|s?0p6o10%AG%>3A7)J5@Q?Fbzfr zG@EmdEp7m3h4Lrj+gJma5df>6Bs9-x9*3CtQI;Ga9f zdcNmt-Ig1`vfRvWNlktKE>qTj%-eRb??r$t4xs}=l$TE1=}#VFrSOoaqym4j)Srg5 zg01Ib$2o+Jnvw5u*I3z0E@zr4gAS?Z&s9~Uc0!m+K$8AAF?y$lF?LK6Ln|;OPe@=( zS|N)?S*cwR;qZk8XF8WDkQ_UvQhYIVJzz(FZ6$TnIVb zhQ}`U?%rVbgIbiQ5S;$lmMD8!0yO8AQlv9SfP2-4n7#qndcuBMzZX0pbzVE5A+R+B z@E1RJ6`M|RtizW-duQ9@jZ~aVPV*fFKHeu85HS!MsWIPgvIT&E4Sj_U7O_hZ`~Qg9 z;194-UTf1G8QM?>vBwR}bNDTt@lC7%EX*>yq0jWxg%Q&-1-z*MO&KKSujk+PhiQ*| z;IZ8JNHH*!M*`z9^+X|i<|gI}uad`GB$N1tx`?WwK~YTSj3l;~rF?RG-CyH+t1WuY zxYKJ!{+)w1(^eHDyy25!8Rizs=IWH@*+1YQS!xj!6x8ALRtmv5FSR({JI)L>!8_Yj zz5cioqta1;@p?dw08a$(9(t06^a>M`TvMY~QyNRwmZHWOkLL;1`_4s~d8uE7JhS?f!ypVja5f!6hKK%JM(@4s0^Z z;z4@41-zIf&>3$DQbJDx-yeAc6IoycRl=DeXzwz=s2_8S=P|$Wv`D8!8}}70-sRuj2FGd8ptxm% zYIMfgN6V&>!hh-%pV!bIQ5)f*SBHw=w9Q{}9>Q#;Ks z8rc%AkOFdI&8kR3t6wW450BR6f{7k^inI|lkPLcu3Awzu7*71}-hTbNRzsoHgnq!v zS<3JGNFY`7$dbxqNXQ^eAy=i8z~t+bSlxaSoI4LdCZF%dBe_MncOpi*u3V!Tkkdt;b$3{?{?^fRoJ5 zX_O9HbSackm=p$qTH{~_qA*}*0)>I|-?9ICeXx-s@_+x52wo(1N+F^hk>Ur{gj@pW zDHEc!hy?%9Giunrdd z5>iezL~#;e4O+8sCgTk?#08NMf-b1R$%Y*94sr=dR7(8YypD)Ur7E@cf32P|;8oWo T;r{QZ8Gyjk)z4*}Q$iB}yhOYH literal 36091 zcmd?QRd5_lv@|HP$YMr|N6Z$J#SE6kj21JqWid08EoNr4n3s^$4nfON-CJ`G ztzxpM>qmPxZLvVOrhw3GYY%cnycX;;R`qHpI&v;4<(mFOUo@9yhPD~t?$XUaGH@aG z(!i>piRj|1oQZUR`UzrdhmNt@^MT@1wY&vg=xCI>Ip^Tt(8uNjobOOR7mQ{Wyo*yj z1>eJk87?Ar|DvlE3HGU%WT%L{>N7TB4NwUL>t!N253#ts+&#OhXQjdK#Pi^OB#5M9 zR%^Hx8S+zapw36rZ*=yH*;yNsUriW+%<0M@*jGv*NjTRL?88ot8vfE9=y8V4Vt^?Y zONwgYt!(>y+j5i`DvvTv|wPaK6xfr>kmB9H*bh)DV4I?X>$OZv+%f1Pd5dtqtq)ay2>B zo}oxaA$(fg+u+S$wO{rghK1s-h9BZdKz_R$dxF~&PC1S_4x2xQbhnrs^&RycNStyc zE$2KgKU-Z?<<%e_SfqSi%MsC9V&tbW2@>e(?J<#6Ji-nRL@;Fbbmc0;jKbAzgB`54 zGb!^a|AAZLbY@##x3DdwB9RPB?OnKg$qubxyBkO$Erd@VWYgvucz##t>MJX-QsqD3 zbZyQ5!N^+28{$@ny*R$(6$K%>jl$}V6tonxZlknc*y3DmFSCr2Rj? zXii&?+K8qLQ5sUr_aUmi*tmP_q~Bg~S3L?$opNBgU#R&Wv>JI(x5}ZXz~-ZzKg@PJ zE+NVV3*GOP-KqPGHleuZ1A4pF6$vKGNKWsx-EFBhAeOv4^xna*o<29wbDI#&zuuwW zsoX#I8!wCk0fO69L;AbCJOmwZ4i5ntVgUgIoIwHy0dPP-K>dRH-)|see?kA>^M4n) zpXBc$Aih9IiwUc^L!M=Q$RrZKAJku4U)K#q+k?l@accfR-7IR)b5V^($_)txlVY$9 zwM~ll6BeNlXu~P^{;c-aa6557HgPs_c0bns@N_mI=jP&aSJiepe`7=@nwt+#0~P** z{1<#**q3YWRVyd)FX&1zSdij>$bTV;k-+@VM}Kd!Ur3bt)yKmBwWWa?`ErZ@U$Zah zL%6`FzaKI_{qL=i#Bw12fA}*hY$$P3J(xzjO{T8*w>G)-&(b3)%*+Cwx3MV1ynXZI z%?`UJ)4Ad^9bRr0Q@{KJ-=oXw$gPoZ^nLD<66w_yqIpk>btp6&ER!Pf*+Gl0oGKMs zswg~rXq!IAjn`FOZ}I&RxTBrm3;Mg$Ma8Dk(X~?qT3RRvQUlO)tRW8B&49@}HoY2y z^DtFPpzHYxwv*yvj$fz1+v~$-(;(1YOCGsxv-gvu7jYCJ*FEv@qP|~NR01x0XU6c{ zL#p$d`-aD%CQ&d7ae8!0O3h+EhSWhN@lNMopu1Jo`;+;y{rXvjgak!F&4Cya<^VX< zIYHqGc<-6)8k-K8vDDalj<{=dTdc_goA99io7` zc{~()rzP>ZjUx`z)Rc+9VGQ({EmCY+eSA5qo6I*JjCSlnpkA^OdbtWv-6!&W+*aGi z9yJ}yE+Yd#F^T!L`w8JTKS*$64d(pT7cn*^4u>OpOc&vea(~5 zoHspRY1sb(jS`y|Be;?sA=p9!N8(+5wp=&3;dRknkfN6^t81Ek^0ym~WC=W9uF2lA z6HcEm5`@^$pkm+bLGQLmeYgP(knGg8>_tVYc;iD5> zm%6^s{QY#R%jsDswOlG%cyRYpjj@e(FHBw4tlX6=A@|cXFzI-X8f>neZB7IkYUZt<)1_X($d+d;Tz78|}`o3?S5C#CD1e#Xu-u1HY5 zK{wRuKuI-HU1M_+lkUnVr=#B?&&aAx1@KTOL8jTx1xskD99GFTLnD04&Uf?bqYD+< z=X6VQ296UvhfCO8Wry}6bZl~e2x|Sn=UkdCj;8LIV8UT|QLdT6U}VC*#BT~UIpur3 z!&Qpx_#@vG1*pEq*JHpR9xvCKJ^t?O(k$SzS@}G;S!+7#SZ}H$Wm|p_$B=9ILu{es z8@1OuUNIRpww`_W2cBmaA=|E3*Wr;748gCGosT;aYCR6%b?RLa&&N0LWrbKsI!4%T z6xT+q%jrUxAzmZx?kz?%+WYIJU;k22xe2V``_rUfyFAQs5EvmjIBeDFM}x8@5R)l6 zF16z#SIYmMd!#KTNXzlFe;-4ulSv-W;L=Wl!$iGZciY_OzSA_zGNmS`fRsuA$)5>= zc!Z300wKFuDq9W+p6(X)ZR!}c8~4mVl_-LgRfNFjO*yGab-+RxE}e2DBHD&K`5nRB z$vvpwd~y&<5gohH;icW6#eg?OVuCcQ=5jksoudKr9Kbi*BM8!*(z?UrGmw+8tfLbS zv3i7*dvOotuwI%fUEmIhliSPox`->v@m=9W9YnU{S4rluTBwfjwybPMa0@vRRAS!hH=7#Z2z$lL@9pC<$e@MmbdZFi; zgK4Mz`pFx{v6H8pq$;`^9-aI3cJ_RkwZ2uAB7whb1_->m*?w;xZJQP4>w%*ZDmXP5 zuxo`9>(CT`xTBv3mzei}2r$yEbTm1sbmsO6ve6T;!{!eE0F6gX|K@RXFs$pgZi*U}-}$qJ{HuMJL^P4bD)~OoAe@_?ATfpO z>L>Rt$kQPMYi%`8_D1q1`axsmP7<#mOxSV6{Cy(6CVS z^&)V5zzAhU{8);iws6#w_Hxnn?#rjf#hQT!?{QW$*oT+BKdUGdb;_HHr^(?Iouco% zd@}cyu!dj)m9>+A!xCN&d9v~_+iQYN;Q23GtGSOc9H{{YGp*Wo^FH}BWq5l6z0bf; z|8K^xFE^7tCmS9TPf-YWcymRHB&RL&71~WYV?STF<3BJBq21&2*Iixx>~Ub1aJQlt zrejmUY(#FvD!3K@f-m*Fu^On4&s3imHOg=geMX9Blfs~BwC*DG{^G>vVXv%~^|0Yp zCGc+3wEq2WE4rnRmu5~LZzArC{T=0w*VZ5Z&gqSs+pyNXX-SfC*E?~J15l4f8ph%z z3?gP4zeg<+!RMjYaU&!J*#4i8rBt|zKTWpQGG7OJeZY%dZ>Bc*3{andoMoM2Nq$T* zEzh-XqN;w`39f9&*m{n<6(wOomSo|thR{wOC3aggOiNm=$~g}C!b&0WOdmOWsdX2Q z5egB5Oz+^lKVPbPbB-TFf>eR0dLt`EmJcnh^89fiin!?4E2D1foF|sJvfKWH=WBFC zFyv$IMQ;KEGYw^)R3J3u%m>IEB4|T6k)$9WiW#4J&Mj(ML4Seq*0uwgp3my z%Nc9Zu4nS$STRPP7)B*1iT6Q9vJ`$#1fr_cKF_UELXhyUSEizRD{TO}5^Q`omp-%Z zKg{a?lk}IK#s^`=7}b9Omh}I56)B(e=(y%T2y4OupjNiWgVO@~fB07k4S*?FFaiQ< z|J?~m0$5A1o8BGH{{dOVpFh}QfBq^Or2E%4wi_7F@K#1uO65QB{6!c|304{H_EzJ+ zwrqHirlk1ZH+M7G|4=XuJkSr~&+JcS|Fwnv_f7@ab?UVOkedeTgD}vK@YJmFe{F{h zfQK--8ef!E|2KeNq(DEk@SdLK|Fy-B1ResZ^U3r0zX4#u0R8;G3|6U@6s~Bc<{#2J zTWO%553bn#pJ^e70{)}qUQ{9eoi~$^Qd#4@n@zDHk8^o8VLUlX~a?>CLepTOEsc$W!FMA;$;(8B1d~oy-;(J`uF+vV;yp zjJZ(xH-sFtX)q+$Yq=8xIZFYqFj*6G3)a`OMwB(-+=Vya5Cjz zfRYGPFIFO394}TaQ>(P`B`j4bAx9?oe6>miVBC}f*_7vtn^kVR4Srg+^3=JKZ<5@8 z*E?y{<>zZH+TX`COe?#7cK?nik!zI)W|0lwU+K%yNm&(&uE&0oG~qaq@bP%TXLZIG zem#K*zc+osjJJa%et{sxY$B~LU!SqTLebvs-lAa3MPE`%N6BK18a@%9=XR2jkrnjo z8BXgZwAPouqoOt|^$5iFe;|Jo+BTD!q&C|4omMmjzdfH;g${y@2mRi`n^ORW6Zt-k z#(UX*6YmiI<-tPvK2XjwA~tSA^nA6cX%l>RiraeLxGEwcqj<8U@3D`)`VJ&&0=AF6 zsgn%`-9M+OQgkqC1TM)Yv7P(SCB>`{CoXNavI77b5+Wyocv%^`=~4I(*|xpkuiBwT z5%X~xt>&&d0I-<)HCv*!^AAHAu>QUZ+tdSj>C3f~GK}?dt@y!M8b#gr@%Zxc@-I=$ z_yK7`ep#6g18udA`#7sUL)E~N!)JEee0AxY)ped0p8>#cnaIo2VNQWwhi4C`IS?7u zpu`Yw<9ip{qAq<;#)$b`1Gz@8GhR2|;E)L@wVP}kF!q3Sl(o*O%r@@aRt0dU)<{CG ziM2uYK8EbGhrv%?a%xq2HV%J#ogOaMjX>enZ6g zQGj>Za;wNhu>v7c$w+}3o+EVG%RRCvFNm$kzn{4-_N<`w30nD=TwdhnRl^*k#=CrmB z0jD($fZ7uKVL{&4{kYmlEsEBX744IPV2zjO`*Zs5*mkVY;D78wVTi^5{pC=|h|+c2 z!+kGKGG96Ybf3N9Fi8CU+M(&Z3s^hJzvCV+0fdlJs#><rFv(~0-_QngHd)U%&T~>3 zXYPTepmj{~;te40MA~nKOXL3-AHdz@{?Re;jL+-cq9cH%R>T9omMsnYheaV|jSUNU z-PcD3W7E6;1Hf#!sbc`g>MO=A5Dh_bE7 z05E$AVH*epIY=aeYYO&qo-7R)>uuVwu%d>3t+QkyL`LdY+=Y=uJTp580YR+nnw?iY zA90}6{<5fC?Fde!vi4SPr7;Xf;!|vT-$dyyI}v?^QG1l@lUplaBJO0N%hX7X-1K|* z>Fyi~ME$nC^!5riV@B+$@w;C(+i%{DPN?d9mH}8-=Gpq%w+rH#3jm^@y_Ny&xAKO| za&AZlgFk`@`ue5)dVtVKMLD_T4@CP6?(V^4@!bBDC~A`5+f9zE(5k_ghc%~|{;1BF3#J=KEwe<3A#{u3DkR!FsRI7Vr1=bh!Vx8`FeYnX%RzBWW`xhD_|f z<U2TlZHKfq2x3=)E4RZl%0dTGefKaxa;w5MKKZ`TZy%t$jB zM>t2TtYmv7OBGC0Ta^DkzLXiQF&mvw=E(2Q1n2J@l(1F2Mzl-}lzt$lW`_6MexB5U z%O46}sIVG7t;(^T3oodX^ggSp7?-(hKHJ=2K1ykGJ*OLRx1hGy`_ml&C);GZUaMP_ z7E4MA2l7(OSJ!n((w)y`GPny)bexsvTAn8!`&06n=w{0u557!otwB>dFAvsDt+-ft zO<)V}QtXG=4fwKaHfY^8@_AV~p~-KRbo@QY3yY1lS1C>~b}tprAxo0+2#+oTQtdjn zHv;T3_f>LvS0k-04Es`?c^U-)gKdJw)pW8i#xfl2`+Quqirw~r_mJh#3=Y#bc$zq~grLHS&Rc<_geGG-zJ%jR=>16$ZSp)bNdUNf|qV zXZP6!k{&-a^ZicplRjGQWV`(FE*(JYHguMZIyzA5rA`#rx-Y!9EgCaHhXd_cx+?j6 zdrU{2H8+8$pF+SPF3$dYF53CYl`r90TtYIE0C8X?S3H7<6J4!riO2n`zUMJjnw?J5 zG}U5-_F^RwiRTen+l*L6x9^o0_7>hxJ|154GYS?M5F&^=KUtQ!V@^h(+}`lyXz6PM z5;5=Grx6&7_TDo~kL6lZHDa|+Z;wSA3BOv1ALzekb~cDzmkeF0q6kK8dhfpwR$UVu zL&8Sego9lcb=@?HS|k}zGUtZ*{KugPA(Rn0;Xr0*FbtH{cJ_)d@NF>0Uq<@$cBn2$ z=;ZOxENLkThq5+VKVPzXn|1&6f%^WPfA-9F_qRoX5hX@8PyQ!s?&5q6B%YnLef*&6 zrmM9Op}ez*&z$!Kn5J^#B5IB9?(X^!U4-~r?BXK&*;I8}{4^DByy}HbJ_9RXURIuM zjFpY!1H-O%0;}#{qNR&$ChCHu$ugI4JBhIok-BBuV__TyM15bYJrDHU!&q57o+{)z z&e^WpzEK1*`~Gbu@dZ;DDsEn6{m`6d!jVAPbvUWN@)9L!ciS)*`+Lz@3=3x2VgpVqx{?hRXO$t!hBt<)w&i{HbbZ(?H3`N zZyMDhVS{W4?4Zm1Pl6I%PER&BpWu2C%n*GiCGvwL%6BKMh&EUYcHB%!1>Gt%ZW2r` z4nXKpKLtbfR{BOhB;hoogSb>^ruBa65Ff$*ho7OMe-KRj*rHjM2hU!_rI+2qqI+Z{ zuGOd!jFZqLaqdmDs2VLw>{f6{gkNr?`@nBVHOKB8guJ(Z!!+TVV*U^A=KoXgdu(-R ztQrD0F3C<$vnlVAJ8kfPS}9vkq8zhrtCTceP+PFy;FNTpd~A{pKVN3j9mq1eepfj10r~p|KLHWcn+o`Z?3;2xlzY zYO+aFaqSz|GDUyEZDm7khYF*G;5#dALc`QWRkdj_fWCAOxY~4GlZr_T+{)v3f=lM~ zc`3o}W+Y@g_+c=(J*3~vo1_J5T+;(N-=q9D-NQ~5Vx`2|VZU|<$-_*> z!BPqZJ}izhUm^>RPhJmm2V1f7Y{XBybb=}2RcKxQJ)G-h_`ErD|B5b6g(L}On~Z8o zlFNM|2~C4fL13hpSFwh)uq#cSQ<8Q0ocxGgmZ{g0R%b)vI;XytVwbec*+l%l%VazU zM@$@nRc9kO;(VDFn@gVUq{3za41M7510&?h&+${@_xUN+=N%*jc_PZ+ZujU$#^mUh zE#^-_FMnZ!>~0R2doW?ubtE4j`8K^99RzWA(Ki-|cSC4xdM8hxod#PJ+kImRbT6oy z1XhaNgnzt_7C3~t$~DWd&)kWfQdIefIkkOekG$RvAxQ?v8*5ds_xiWjD`;v-hWItR zN~)LVrNa&`2EjySTu6>w@LJnuZR=?Ft7{t8$B?1!@d(-BEUWz4d_m5N;RQ#=au_3x zusAj~sd*P6+1;SY;pA`|Q<*m0g4cR0`53SK^;;`br+$lunwN|SKQK%l?JQTKT?&e=oWf9_LQrk?bO9HmuoPZo>f`RX<~DE zWPaG!D3t1yq0y=MJ7zDTXNbNYS)uT#laT!`tvcVfhmv1jJ^eu1+ z-d_iQBjkky7rxsWn2*v|oZsJxwuZP0sBgR^eKbWbwG(p7xZL%{!%4qAC;W{p+Pds2 z8*+~@PIMjms?h5GV3unm3ew^-IinyOP@1dvdK~^Ou*zkEYCM?}6LLRB827pg?uYph zEH@@QRIVTzEF36@BsbJ&8aUQxsr<)mxe$cMU^3@Q#(o_5PYrAv7sD|tTH>OmKI6pH z!C^zdK6d~qCdlX6fzqd9$wbe5G1su!5*lCM0Cv6NL~vkunHHxk0_v9@Vu5Jel$#@C z{~8=A>oP?7r``s+4jw;-d$mj251kFEw~-@qxRD()ifjTdO@)vwp>5RH?Op1tf~V)u zo;hOL@J!(gEc8VNP`&E?BO*bC%f^!q^k#pE(sVrkwC!fwWi=_tlB3^@lQ2nZ^7BL_ z*if73ahzmQo7+Fhu%3*9c1Z}cz$PP>Ez=E>4FN|K^mlCoGlec^x0#C{8uZ9CS8wrc zb%EtB){y_cg>!7cmYrwMTH80)Rt=%E^`MM9_l+LwPa>UiH%Ye`wPiIXP&rfF)81rg)7 z)h?4X_z)ZB)v3~AI_oUMc&3FUV$&160sk}~JGMsU;FiRd8j1Tv8fMH^ZzH^~ifKzv z0>;|IY4P3cf!1JnO#Bnns?McVrsd6uJC>4EuY#n4p206^hqWSBhVQRZaGo)f*GWWT`&%>A04`)ZvAq?!S#2z9V#ed%k z9Lj?c71b4Y)kwv~{B*251lj-dH=y!x!l~r1$=(LYgsG4er%Oqq7-mY?NC>egPHcyM zVH-f~c2VL$^L>?* zhna)jX|Y31_e94Fm_BFw%_<$clTrR#qJo?-k`hBtvyn@r zm?ZeWNDA}KUzo)(kKQd?hRF~8DYD1Og!QSe!g#RjoVoltj#7#wn(|NSqUmK2D_NR7 za~uts+JK35(C;{B^x%N?pIF_WY@9py$?qb@Bst2wIo%SJ}9iZa0^(l=ts>c=@I z_dAw1A}~Rve>{D^L@x7Di;<&|*tD$+*$IQbA$8$iT_TA}A0s49;*_suYX5E2Zz>;^ zXKFZ`kw+YFMFI;J=pWTA=|2}c?~zF!4mI(&ZMe9H+n=qtN-OW!OQ9cTPC-j(lYK?Y zUPT0TQ+4ZQfYD?Ey^URmGWh-9x}uX3;gNhI^j z%KF>Ysl)2)1aV0PUm=aq>xDM|F2di2ekWpKOYOv#YL%e7cSR^Je}o_NB`F$7wXOZ* ziNn+cjOMNx5 zS&P4?npemCqWjz0{GAK&4=%{63t^5~Jzk%QY>>Y>@oG&??sM)y!OfI z-0%;J-i00a%@$tQHP0$C*qH43s?F8S`th#$-1jhgZh`n)Vvg?vWA-)7)5=Z@icK3X zAOyq0tqIW@1cqKX|Gj|R4k9b~?CE5wuqS?6N@96NN>)<4&9z$#E>h9w(@LN4)8UN~ z8W$_L{LC3QuRLx|@u?5JOE&#)OaFs4du7kKiD6z@!FKN2og~Xd?N18OPpB{DBT0_r zKR(jUgrvl-*~3jZ?|59Vn6VL~cD((hh`mM%#6_f_8BlwV|Rc zNK+LXRtfg5IvmlOnDcpd~ZnhZ9-*wWCa<7X(d8mwk~0fhlNJ z#CC0G(ER$Gsuz|zE^RVNExlPhU6=+2G#J73D)Jrs1)rz1|S#`vP5{F9^c zc)pUv*+SxKwfWR6#H&7i7W}o-y4bba zB+16e=nKx!&U1=X#k{`MKC+)whQ*?6N!CDb>CC3@qqf`}uU~O90i$Pk;&hfZ-ZEW&SM7C!`E+$gO?REUVjhneZQ?KQi?a6AR>6romD(i6r+oClOdYs5jl<@P|Mh z+rAs6ikMceB?meCUlm6oSTTb*9|g(Z9U2a}`MbDrP&qgDrO;2~$oJM8j?Ajj;9;Oy z(fb!V;%bv%F3{;&R{EgpZP$5^&9AF(a249^-FL7Ohr;Hq-yllbc0`wLc7zw^_|??r zd51xk*42+3CG{RZ$E;s98W*wYDw7%%8tE!l=mq1FTqZ*;;LBk=z8Zp>6Ly$R)Vx?- zenrjTK!UF6tJ-H2PWqgxNqbdafvWy>$9Fr@eDK6g(3}WS*f6ERu3a^1EwP&$WhSnk zyRf}P3n2bmpTq;Yrk3F27PPQ(cLBj24%5Wmfl-ab3C_{w<=mR4RUZdP05CCg~(V^gA}(^JdM(%g^B z87{##;?Y~p$AxOwF6J%~58&hN>xs-Xk~`Sev))#}OlsB*6w(WmI`aLbDOUb)xw+{o z>Xk6j-#MB&E6s0?tEB!UULKO8?*~Wd|Ahq&4|XO*+ec|DJ0!z^MOmy*CUp7b2|bsC zV>;qzx#dWoTYW0{hn(F_zV!85YvMYuKAkPA#1*d@{_!3(ZIeqSGXL7w*62AMaMT%{ zUiXTG)_AkLOxo==RpjDA{)FA&n4Eie+GltP=W7aahjY(~T=5@U(l}TXYTf45@}xnJ ztf(rA+i^D+h(yr#U9W<=eY`nLV2JbfLC-Gm-S1UpxPK4XXSK$hwg)JEt`VQ~h+)EN zqK39q3L9rDlgk~)&#CIO91<$1lpQD4D11UymUw5IFB&;qP)xpAzLvlL>;sSkPggp;X~lA|RBgtr_WL>t%_IAJ|}R zcr~Di!b&)BdNZDEt2u#WYaBFBTiM2*Jr(Vjg(KdT2;&VXuk-f2TSe$F zIA_>Lr!ntqmT9GZhwpQS^j9+M|2%_bE0(qzo&h2-_7uQ8{7OHV1cVzpn<8D~HJ1ok zp1grl!_*I~r1SD@19Yc@Lp>m_bi6p~GuHjav3StOoZ14%q6V)GDSA`KTkKQRGm2&f zKCo1NzJJYq(fPk}Ejv0*c3O(=qk2b+@}bUHz}GR`yB|p+YIyT=KS5mh1J_yCOV4A4 zY-E3`?;?Gd1I}6Q*wPlyP?l9{5^6%)nWGMc3~$UhH2AsOK zU^3E0G?x9EuL=p$pmbe_R0Jr|W@196X^Tr&tMu1#@PP~(S3{d9uo`u4tarm_(_Q*J zx)J|0ZrcERw|_UmO1m@3B5{xJN<`&qlbBVAWb1>;r#wNa#n5Fsu<^HfU65;L9EN^- z&+O0R6Q+wI7ArHU?H`%rAPCc+wDb{Cal(R|P?KLSm z)POeLdRODduyVy9G%1K`;2ldfo@wb6Wx2BDz$(~k5EqXt1d{2+w-cbL>RgvuU9ESK zW8TW9InB4R|;eXYc57D=1Naz|~d0-m<|ClN;6|34(WQ74{!AGt;6+INw*M+xbbrC#%{wS3!#D*IS)2_p7RYtsk`CBnaS^Q>;0n{ zsj&>p$|ZSUJ=TqEK(i}?W~F2oj4CQCdrPI3j`m^KXW=Ot4z=lhf+D#R{0@oAB#?je zh<$FSMGC}c)&a{O&5k%(l<(7i%3r{?v5XiYmLggR+xi0Dd~bvdg+Wx#L?k5GEOD2@ z2?T0A6O9xYStpTVm6%~D@;QP6e6I*kd!*3?Te#Br*Y$fXPUx4n(yUx~*m6k0A-CPW zlqfrWQht5h$03RZJ(57Ze%m*9OVw8b60QMpH5%R!lA{$rip1`ZKkh1RLU7&EW-KG|@~AM^Puk~`we?&pSx za<%zL9u-Hk;<Js|!9+wj z$OeBblnK_Hf`d}#@~^~p43^=4;KMHgmnGvn6*i}QvduohGHD+o2zewk88vMw&TlkP z!EWV^+V+I5PRLj0z*K;_fzCM=r-NShl#?}w*GTk?qMY9lL}_6n@)ay4)(q7Y;5b%; z@iYtgZD}%IA*BmcB#}d4))8%Ea3T~tDK@%)>2||xFY->K=uM34 zHplUL=apjWma4jLQV0Hl@CH9r6hdqPQ?&9n1zM`qt%<(pSBcy~CmU?8=#)lw+t2+4 ztps)qm}Q3XtW0HYod|;7GjE{bo!ZvJ73Ztb)4RCn1m;9mU5Vj8{+Q$84%ye4!yb)# z9VZ!Q#p{t5d}cPmnH5IwA9hKlBI{{BAah2%mao)SqubAXuO}eJ(xjkCD!#eGfVvjT z?KMye*%!yV>u~Wmu(uw){neivDW;A7@;(?Hj>#_uz8PXwT(`Sqey8k9nFWV~HJbcDi`dC>bhAm=C5t&W7 z8xYs0EyOve6I6#e|P?@lD~mW3!@zVKl9XEPQ2W|sj1 z@8le(W7ZF%5QMPZfzvcX(`#$*H)4AF2-B`wBtwZ+jr>Cr9T03 zn!eQyuCQW`JD%zZswo)Jt2UT@cdK7qZ|dEXtr)cnp-sUXa1Nx+17{}L))Mw#_xHyr zog}I<`5ViWgh4dMT$$T;6+2#XB3-JGIPZ15^P}eYy|t`ke-e*=6`^fFSHf09To+0m z)L(z2=1>RhitZspxgah))WoF)2*8Ch)HyToF*}Y589c(d3tC&4BV1N86*^_p`3}Zd zrqr!l?FWCz10}#+Q{XMt!~~vJ?4EyH#YKX&RyENJhVLX4@@n?cpE4S~b=beM3atvVgo)TEq`Q5=7rEPVG+gQmfdO26pDwo;JIazkJ*5c`! z;WCd}2m7enpxCI2))pf$BSqE`Ik*_MY=ihWXr8tPmIaeMIZbI!P#I0^#*YEBQ&v!l z0PPHi-E5+s_`npEY+b%oU-YwtnJuR7p|<)HO+ubCG}VP8>OV#S6>zc|Gc^w zbB|dXgAeAo$`mz36AIh8BM3M|?B64aY2%Lddg5{c@k?!dzR6DC7`_Q{sZ?qu|8mQPo~N*&w|k(_8xU*{gy&-4lOmM&NLnp5mUIs7Zc zWpZzlotWP6cA&7k!)mR$MwO?*e7Xmu+Gjq|^GBNIR{HZZVABKvPKO3fCu#i6d}+*# zWw)!X?&YEmzzn}v*>({x9003HI0U$=Qacp8@^OI5*4Qh#>TM9Np1Bn$mT00PHB*)j zEG;4VnQ!glw_7U(WTpQyW0ltFUXlxKl!EYNik6sdymBf9}vw%wbR?NqH^fjN3 zd-Sd~$?1V&@ZS)Kfs6Lg!wk7*wDYHcugwNs4!Z-(`H?KSr&V2g1~hoRl7KBYrdugG zF>HIigkJOW6;qtV#x!+~w-LLL7k=z&QBFy~mu|Dbxt4`c3R9}cL$p?HOH_A+1Aj6W z{-~c#^5k8YOq$ayfvt^FDt8Tea?-1Wa%$_u$_rR=BXpZ%CNA&b-+D_*->*Xnl>Wt9gB5cewtgG`P9ZT7R?@3m4W%3s5g`gE5pZRQ1 zXid)8XUNF?#tAlBRh-dQ%aAnRi2k_>eTpj>?Z|T}iajMq%xHbDbv0*r?t^Z4C7W&O z529P0*As!5!OqO$TBI~LSGkGloA23CP@KMf-y?m4;_Slav80!$#{Y_N?~){}0^1)f z)8O!>JPhOI=b+M-4;-u*^yiK&3Hg@{|MoX7saPab`qWB0)fV+_vS1cov+^I(eB(9a9xWv*kt( zH9uNp+)jg&FzebbdYg0_Vo(-y0$*1h*B6KTF1fI^&GXJy+0EpU1O5cwPNpo7z6l*g zC$lV}4(0qpRPqOTyBef|QT;H7r~N=~MzoqpFItOE!?`{<8Y&#f+C?KI>R^gYi6{co zd8KKUda1}ICK{+DTnC{NWRX%Az;I29hP1b!ZP#!Id&O9Uh|dcB&q+F8VdVD92!Hj4 z{AHb5A@gX}8Zc3Do;yD(+%`Xs@QH{Wiu=1GxGx*nMlVf9XlNv=R;E?BZ4AM@&$Aq_ z<8rppE|x@GZqVt<*~AurtnB(L*gyD{+n5rh8Fb6$zs+!&8qY)LFSkpY`X=}uJXjTK z8A{1qYMCKjaaad$uF!|zm*hr`**N6X=Xi%XTr<*Q-ak#TRd%&Tv2ezzs<8=2N!;tF zP6wC14{=2Qv^5~Bv7D!i;OqYWBChO*b*q!+&W}M-V46i(i3@G5?AtKjVPkO1M1zid zZV#ID#l74mpCX3tt_)=qr;=mNEqNC}LxSlg%;h+tyR9f@M-jMHieQ?qN*sy|^8Y0o z^LblrrfPP>E0T*m88>=!<8|XQ$N}t@RLZp5hLTWv>KBJ_7mVl{V-Ls$llgv^>Ai;-EI5dM4nJ-VewnGYpC&0&?I z5qIeNA5&cIA!M#K1FEPLJwTThl&^40`>ve`$GF-2P9= z6Sn@|FJh1Wwi|)VJn@N(si7HeK!m>?(2zDLwt0NbCDRloDbssVexk?5XYlVu1`TNm z)oc={oJ|URXVcf-EeKm*5V&>mrqJAA=Yag9Jh0Ao726o zWQ`;$#2>#=Wj?4{M7)rr!NZDp!YC8RGA1gjWuZMU06X2rCH@>dKp6{6u%h-^ zzs!~-4wRk%d(x5sJkmOpCN+1;qNm2bf`>{=5oXP<4AbrZF(dG40hgX>^fV`BJ<9l# zZSM?hiq!G>Xe6$hKK|zU$C8d0QDd6-syIs~2l?bA=iA-mJ`!$;2<8h$ZK77Lh;EXhD>i(gmN>>2)PcxPz@u?rL3rGn~ zQQ$qMEbEkUoyOb2h~+o<6uNi;Ik<5Rz*_BL_+H+73_Kmu;d1!85iaJbDc9su3(Dw~ z8Iui&k_OK}IjaW||7Y2~?lnx63>M4_Ah%Vuvc?_CEOr|7?B$6dV=K&kjuEdA6J$6e zF^E|Ytf#4Li-jO~r&%S}cXpG64-Z>L1j3p^s%0dMp$Cc<1O zu8zIG>h=BU;$-7PnaxDo3t$P>G)o0GV=fWtw3~5Q&Q(86^SYj;9=6mAU!hN>9|=Cd zdm%Jpkvql+`P$8hAf4=8dH@#7@-BYzmKi-5C7*fS`%cF02p=jOOZIauZI_yz!m!%f zd)fhP9$z;_6^f(vnixuLnW+7AwgTi!s8aDmhyBV`!kP)rm8oP`Df(&U!8XBLc3+tA zT9D`UV@SrEq!KkGIOGOqH(YZ+{s6`cz7#9+>{tR2E!em|<<=S=h8^PBRYuP^>-iBj zVT@i=x!J_`BQvKw$=fBRg9Lnh;eGfX{2$TdIcj@UWdxzxKLYinI!}s)rzn}RhHnRu zSV%Lc& zeFq~hYgGo_Vf4;7za(o8AUAtut9KP&H-KFCv9#wbUCZEZtVt>$BLf~`QV|-KON4Xp zk1;t5O0kjy8N`yX+z-h8WE|NWOSBj~Ma#-KK*_Y`Ja#2HSNC^8tg#|6yK!oJiMj>EtX~f@Kk8HvQ#r$8p{HP1C%K*S14ko{6mLh+w zOF%+d=gVfy50x_2(mec}5PQvL!E>tc?Yz3FBTkehP{8ns*9VkDTd` z-#wmeeQ$_$^ zT~7W*Q`EhCL{NghcGU=mb_95w{fFnQ?3uCuc4#Er#-?qX??4E!CF1dF#1a5G#s}SVYtSLi(EB8=ZBBg0yNK!>2 z=YAs^mRWoolB$2@1Ri4WM1YNNn#*dZSN3vkvi+Z2bFq{Dx`i@m*0oTMtDjr?=@ z_|NOwy1t9?0+@0TYG|7m-Og9$CAxF$dk`9_yJ5BGt2!U##%T^Q+g6 zaI(@Wj%2)ORke-t2rj1H(jq6L#JPTB;&P2+l2D!hJowi0*gb*?hPPzQBw^!$g=~xE zn)ej;8+3e!M*(4@m&mocUE0$7C`X3lF*mZ7@LBkS`@F=6{|{|%85L#shL6H9$Plm0 z(4pkejndsiN;lG?NK2P=cL}022+~M*r-4Wah_rNf>3`2}owL^Yde%DUn=WQxo@btY z?|WbO6`nA$!o{Osas^8xPh|-3hP2GrfHWin42o6JT=pHVD?p-}6DFB_ksEkjwxCh0 zRooA>?nOa{D?YLzqU?>yWY|((MX9>Q#>_0!_2)bz;;Gj~32e^{g^I1=4`YM!`oMotb5wAi{hzfqyO5 zR>*3OvJ45sXldPs^7pFI8Bo7J5UxJm{2p3;E+IRx<|TeJ-|%uMk|`55bi9ve@%H-v z_5xUD!(BcLFY06QId67KX?%7J>4l^&y&jb&!eAu`B}EYO@<3g2kqN2;(J}4DU+fm0 zCv~2TMzG_^%i9J12%K=5o6`2_GtByazV%>lG&4je{j+D3zbTk)uKlFl!x_BQ805;l zW&~h&-1Ou90AVQ$T1$wW09fSB^l>*BnfHR5lgi5zSPIKO>`Trj%9GHLYQe3 ziN3#W< zRp}KDyz=LC)XGY-$9e|&F?2>AQJv-u1!qE0dhLf+GG_n@Hrhx9D5|;d#lGVaVIu8O zLhr$)w?q77@CU&gps%#wvsl~2dy=&#ksFvuh#4=RNLVdyBIbdM`>#|+w)Lg1DIg0w z=M0tjhH95sS@kLKjDAhgE8dP+R3BVS=XYAHUTv*7PrVs^OQnP|vu-y3b;xg|^U|3) zs97|+kdNc3Y3^U9CZxuzO6o0Q4HpJEwdgyz9 zEJ8WzIQjwbupFAQ^dTH~q_Xsoh`!)`fuZ`_$F-PFxRPcTt&AZZBez3EyXVE8YC9YU z&f?92%7C<&C7hhYmq?6Tdem!YlaKq@)Q&>AZiLU@%Ex6-{w}kMSiP<`Zo12wrd~!= ziJ_YY^KUhf$k)s5Ngf>e2%f*lyO_jDgF0y6OTmEOwRT(F0Kw8+|EuPQDSK&p2CY;_ zE?e&xj%CZaciD5{4^sMOLZti51Fp9?NQ6ztVwM4*N~ws zOprss@PPVT59I}Ul3b#mJr{z~byi*XMo10oPfCnUTbLW%X%Y*2r;a2}sr?b^8q<{) zpH7>8|86zuZFwheoNW|mxmS**XcLulxw^nPF0y^+{yW zHj&YEdL?f9Mi4fwa#7jVR-heUctZW0axCzH+;N>U0VRLG{&_zZ;%4I2HwnAq7BpBn z?SfXP3cOo2mE|Ie30r=ujuch&DC!264;x~_(`y&1$W*D%flTXpPA{L|nZ1KC@haU`Z+H#k=p5OR1dFNV$@%lgz>A@tw zO$rH$4r{);GOx&?#nSoL`AvcD35qYSt^Hr4LlX>-d1#(3NbXC(V(;0#Y(0Z^LH{%qcKb5LpCA$o)P$qh5;JHyD< zqq#ux7k@#QZDO$NGL=c48pwtA1P)(3!Wlo5MyIH96$a+uC&V< z?v>OTpudBuZQEDPU%B@xBKR??tlTpE3sO0dOJ(QTXh7^4v*nH)w!-c`4P5KNxY|fb zAh8tmcIl5o=sSkn;D{(%y}rDSZ8T^65`e+cuO6H(J#5w=`_}32ywXFDw8M?4^voZ` zjPa9IW@3!Ll#V{H@aT=qDzzUmF0<$Bb~MVzq4mmcKy5QWfFKgA)soNo2fQ_szZWW* z@W{U-!Ba_Q_)@k|mF5qHP)Gj-t`I+Uztlo02Oz{f{$p==-k@b{8Gn?WLtV-4MQc2? zl4a1@Y&+=Wm@$2&K3LX}a^E}UNsu~vcB{VM*&1qkk0fMr zxDEr`d&Vy(y=AP7-?8$03rg;llN```Ku}*k3s!$XJ+)xAk|Ml%S>5r+%Y?gtJB zf4lnOxNMUKRE(n$c!|vV<`!9hIdj=%cgSI=eD;goBLh3MEHaTNXR*{?(=LBnwqt$r z(a~wLhGPqQ7MIK2vX7Sp0&2)>$YzTyt~%!@I5o7eD;Z&?3jFo$1u}^ zQ^|NmEQKfbG10>n_>$gTO^qu)<*s}3gL{X8E23BZ0u;S3|2v+ht)=$=+p=0XE9!q= zbyoek>;nx>@uVEoc9!|5H!jrN$?g2n2#{KRnI#B~OnjhS%S+g;WG~aTeW4^PH=)xn z`!%&MV9-rXX6{hB*4`s59$Geb!`~LLb!=pHL6%=KEVvp>%C0X9(4qI-Z=SK(>ZXxU z6mBMGtHoYJl0S~f-U3zCZ2qCoVu0UH{VAY{w2t`>MKw`YHBfX#(?`pD>(K}Jl;0tK z1dBOwt|cTEJ9<-(k`cd3QCS;^reJL6(@BR|%PT>d>_{-ZA|JR#aml8#aS-V<{**e5 z9!-ATk<-yZ^x%(S^X)=f!n>xzOQGbiyc#w&$>+5ovBzp z8B1_de=I4n389Jv{UJjC5QS8*rS0K}Ne=|p4xh+5P{=B7VS&%tLeAX4ZKjb}DpoW{ zi2^H39jovHxEwG6`E2D`LGM`1z*}0^1#hwf(xq#kK_fP?-uL9s6xE^_NB0k zx69YTNxi{-4U15GT%Xr}yX-@SeAve~ZWC}Cv$Ry^pGlHE?~WUu!|AG$ajADHzoGpB zvY6*_35tJlF_no_0q2ND349^4cY*Vi0;@#YpNbFh zJZ(2DokYbjehnr@1gBXnlZ~TdpWAjLBLADo8Bo#EqI0189V>P6`H>?jKaDBNAD@d4 zJ6<%tL*l;#tTMx0Yf_3Eqx@zU{_6fSwVrqvxARx8>MiY;KW9QMpIS$nt8!Hf!>>%< zr~hivc>C=tu|CVQqinXb1C=kU-m@0}SX=iz8JCzDl`ZJVd7t+a&`-|Vl>_{Ink*78 zX6lfq>(+|pCD|)p7!r3ARQpfC)hKpe=mY7Ww92E>R?BZK1^dN&k{;wUJPUciYa!ie zOyEJ;6N+Mdpu}|pq<#z2N|Ci%B^kJB+Rfj@PvUk)Gx}{EN&`d)S5NjMgL?=v)3nkV z|0BZh6PHt=XEv`|owdtt*mlnR55EyL-elqc+^P z{lO8XcQ`cO-TeJn_l3L9Lp>u}Fd`H%N}41t3QJjC2%vO^0fe-YrZoPCJq5kRsIOz} z5hR4|!wE^fhG(@Qy#guZJPR+Z*8_^@<_^>Y&JWalFPW}dO_AAWdgnq@@NCsPrs|FI zM0whN2*$mTRVWcAv6Us_TYT!KYk+ORz~CTlaVDYIF7Hk;ih3}@X34DP@V0i_*5j*6 z4z5&2I#0P1S*VSv%U+8U1=(6Vd{(IoeuGjCfp*(`{qX9_7W>;}Uo@#WhewgS1Kv}s zmBAO`Qxcb5Kv3zaR<#S68FUpsk>2mTbi5GDvA%75v@C~ukK)`ncAX+*q2M;A_?x6@ zC~l?nYG^#?Z#V63$KJ!LKc+Dl zKWLY(AYwZikz3Y}6aTeYZsY;ya2uDwAwAU%mZb5}F9R}<-alLXontlr@gA=R0&MKI z=IUPE@Ke`hR%@iVz+<8NTpV8dbDSA?ebZA7FAX>b+?3POY_&p8F_-^~3d0YTK3)=KczrN0;gabU!7J|vrH-L5PQ9j{1X#F*QG{dz= zyarP{z6OjvrtkZLz$E5u*pp=vN%7_&r0<`K3kUh`;N?avYu>V_u`M? ztJQTX#bC+UJdg_XPxx`1bR3jV?7_h_gKnWjC@aIY0tP%9wv;zzZ)RJouV$KB!GzECRZDjrLY7|TFj zM6^e{czIwWt^UMvj@k0YeJMeIDeKb&4u7dwxgxUP*5Z$o+l6`5`pr}?J^q}DO&ldR z`rVwgJ!{Gxz@8vnmF?a7G0vYJ#aPy`{mMx1B&_soUI&ww*--ySMb(K| z?YhT%VH@79q3!rggV$v>v=O}_i3;@ekdY`E<$L#03~|{513-yOd`6rZioFsu>vForw;mrpKfkGO@G4@z zUs3;kwQ$9vCn!H#&y4}s+PwskLc+GD6Q7jHdyDh_+_*ACa+Kg9ZQKg&ze}b2f0pxt z%JLGKBcO!o-X1Mgxw?0pZH~1LrN8>7O&0a)>e7BAL^SC2su1a6Ck_mq!3Qca(n;t+ z`&!${KWn*n14@#=F7JiX8&DAc=M<79PhEb>t9bl&V!fK!MyEJHtzsDS#jC5$k!XU* z=%kA8-}W9ka_jRTi^23fss7D>9lzcx79t96`ulkZO8%+7+o{f){Cu{&R# z)I066hT}(N?aN*V`~I)1yDs%!h#qKdiS8rWI`$59A6@P9=HiInz>XNXh4dubCi+N% z!+_UQKaPg}F+iRj)uNaD??2gQo}{v28!Sh@gNgRO#3#2g=x1qH7yZlK;+N{s;L|{* zTs!VWk0*i9b)IeGuk5qPn!lwfYir*$ZE7L2qwPsm*<*}uZktnL0FEUoFcSP)!uIOF zz-DSLoi$ZOc)7%T*7nWp*Q*xFBHlatIaQ^CgcKc5cX0NO#? zf6N~xU||7Jw*FZqeq~!q=&c8V2%79coS1g0pv%>Hn|!+bQ!UDO03#bW1!m9DUc>Bu zB|qw9g0yYqQXUR?H~TE8?CsB|f9n0mi{29IpLTsp%$x4jSZT^c!C-UI3~+3~$g z_XFv<`!@4$$~b_owO?xvgUeRNFl>v93G%g62xs{zHu6F~r4dB{2^ID6Fw9TcjVGCh zvX)R+mIr30EsBoW>_4=@)0J>u@cXexRcJ;yf%6UX9O0%y|6b9pF={$-UkAE^HXCY> z!mbG5jJ|Zi4A1gE{jMaK9y&%uRinx_?vnAiy+V5ELtoENrQsXsBN<5XgAj9#a`$Ha zjtC37JoXBUUy+db5LS17XlnXnqGYO2L!wFJNh8geIO&$kS4BMqZ{oRZwbm3de}@Ky z5nz`#z$EoQ`Vekx`g61c(c+=!{ zly!`1&OQe=)>(uyRipMuX-8swzwb~ZeFT2B7z-ZQqw?abcLvww=lMZ z|7K)=Mo#cz+iB5jF+krIQOTlmq5bb6mYDCc{KS4rx{YUfq+{IR=-h|l(bf+vbvM%I z4F&rzCY~R~>N_?S?9bK}I^0Po5Kl3QOg;PZ)|SK6%H2R4x*|izfF-gVM!Ysi?Mz}H zVGg`kWJjSYvdo439M~&HxH6m1MTBVNE^AXKHBavPU#b3cng>L8nLAj9&v(E`X69)> z4B;xwHkkLmaDH@ER^sW;#F&ZmbC=sl;qR{G1pimvs3(^B5jxlhbb1JnWwHa}oR&St zIcc>2#Y-C|iC(}1bef_Lz4u=Vz@wQSRF0&wm^?v<27(z(7%3m69ovBq@Rpf(tSCAu z0L`t@8-*@UWbP{u$=mZC!DL{zFw*t!&Y4;)X#T?>;o8447%30a{Fvb9*Ek9;$n#`i zUT7p{cXxeO86dxy#n6mkb00M&2owE zi_!C3jXf*Qq~fwfRSbZ?2o`&riGo9Jb~Z>LY|V-e^x}1AUtfGL2!8;GtSt$aA8Oi_T?w!_{-^`kz_PpXg-r^z}Zwr)(}ux zDHB3#5-m)JnE%vCrQTOkMjSFEjoqsQ7ArqVSvd$D;P1t}$m}(5Pk%fS{FwgHE4oB7 z;ClFQxi9<`F;f5_Ma}7;`vCpx?(+iOOPKr4w7LfH+4H$Q8hZ5hikbMz%FlBz-cu-f zRR+16h&q%1L`+@+*q*ePl1cYdC{aK2WU!VAV~P?~nzA*2&V=@p z6KXkkpu0`#`(mluR`Al+zvQ!8A2UAlhnE|FZ8u|g%CWFdbbq3@p}dKG18eLD&Xr@M z=^T|_<^wULsV>ZW{Ce==;$Al_o^4^c(EU3#8i*RKmdIZ1Z)sbCmp;4qb3L<*!urgB z+_W#o@Euz+doh(G{oj{ulP1?0x(kQd4qS_^n%{C4Q$^7Gcs~__wj?bJCT~L*PKlF} zHBNq~M=Tr>fVIU>#&Cz*Ag^f#cc)nE{sb8HsIl1#G>ELaLn(yKP4%F?>5U^@s_1LF zw%9kR(eD?9ju^|<_rP}hglk1f)0s)^gE8l~(ndB@D8t7ZyhrzoTzHJW{ekD%KNKwS zj#`UFyNLJ$?~r4(Tvz(Z1|RtosSziW=^{&WvlC$>^E0|W)IQ(3lR>shxIjw4T=UJM zR*A+ajv+&Ew={2KVc?*S&K{$y6ds$8v^;KDc~ATWFoA@dzTkVu#2CfPq^0^vMr^^e zf&;}I2~KU&QMd(3dhi$O@zxG9r2&Jv&yKat=uJ54aaVYMJX0%u{5~MefykaiHQR*x zOcoS1X5#G^srl)1^A-G0#P%Lfc`1fJ67cGUA6C)lGn92&7lT2i=_S6EKgMshM{^P^ z#I1o0W1;Wvg!F54iXJ8idTSARh1Whj;6hVS7_eNU&xV7;pU3pXrEdc|(c8}FHizl? zzRkee%4#%wJv{n>F~tl3yl9_iM|pj|mbijh(DvxWULqjg*6B{EQv4Ef42Y;^i^0+)MML*DIrI~Zxm2N*;a=V z0h_m`iQg5AF&y{x5fP2?nsy-rLv9*GQycmK@>3~_Co~H_qQUowj7Fs_7X8gpJStV~yO~&2 zh?VBXg+3G(N+a1{0}#vL_ZrJShxZAn0o~DPk^44~=`TK+#4*N1(6?W6^n1o~KY-WW-MeYkE4(I4S`ZN#L>OO*nH-8G>r1d-;J$+qqbmkpjCdGXzQn3}{WzUYTdpM+MS(%h}GIFS6hs=4m9s zC|I8CkfiJ_Wv)GKbeJx0;|)JNVj9gx?3Kp~3UMur@g+%Xkl3mClP{=^1qEp)OyWAh>1kRtpe*THN>|p?=p?|qJpoj6CvcZ@gs!o8DCe^& ziT3BYp;7Fd{GU9xCYWYuaWB$HFySr(VaG37$~E&t+QF>i7|d7ayonX`5X1PG;t;LE z71F4Hu+Lp83X$NM{GY>acqj#xP<#mA6RErU`2X1AmXDK`u8IrnE%V-Yy-FhgPi_Ou zof!cNuG^^}ilX;^ZUz*+=ORC3<*(Yvvph*+$#xk(*?nvDG=?B*=h;cQAqYy?tk=~E zQ5RdV3f_S{Q8_NdVwSvS_5#?*k3s)rV(udT+OXLE>pOXdoaWBs)JGh*yOZzegFHr3 zn5I{myNJ}iyROCV5Z#ip{uAgCmJ0qW?|{V8-eYQrk+JfV{BZup5Lzm$gkcznyXp_Tt?MM}OJxd+VEr)|=ZNiu zrLXn0uE_$Gvz}3>?9X3AxBf1Fla;n6NjR%q6(* z5a2r_Ef%n4GQoxPBCwnyqz)#+r&r#u}H7QzzVOH|I<(&aH#%DjH5R7ZBJ5`@H zn8~mud^p!sDy|zkwo0;h@dli8oj8OcKg(-Eks&Zq`S@sKuztU#0V6S%0+T&PIk@z- z1$|!u;?1jFMpUy(v=Vs6WoXs4*s8OC0l)Jw?WXph(M7-x@2Q6Pkv!T~%TY}l_=Q$z zynD538yr@UMg@b*#BC!yNCaq)RdF7=CjpC96nf;c1stU5cB(cm=1!Y?Wk8wzs5!ax zb2iCoN;1W8mysVni9mO3TP)28LW$EPwA1!9F-NT&Tx>S44LL*9>b^@~A)72de6L(c z;(HWJwN$~EWY)5$Bak9GwJ-u0s-#py>q+TTF`o;r_kM$tbq=%qFCD7QyE;La-(+sJ z?=64N4RlAN0L0`%bBVr056B+^>)zQBNxlzXXYqwjHwzORUyEF9R_n@PG++|hGDIO0 zDrmmHTy+fHDf!4q6zuTqY`Gz^!n8#jc;F(_+4V*_;VCW+h>n`5u1nBPIvk5>y8$Qa zCS_|H2#m9LWgc3&Teb=e9s zV7Fa^?lq05lTOP`BzKd~FuI4SwpeGSW7Wmy$(hTkrUd;wSkAi(FH{w}X@k-2 zxt#D6F20HqjZe{8smz0G1&1}^lTY#fy!QM%hJDT+~PH|qkElqig=uSxQ#M?I=pFxhYg zX1fp#wk#9Pre*m!Dzz*Erc&|@GJQ%24awsbxcY^_pdu%%atVon9b&kCLfi6o1~E*a`4 z0N{-Q+^#y09sT_A-@wgv?^DL`U!8m&Te>orH~bcHp#32KOQbx>+5*au&5)x2=KwI``Ju=gN*J`snWKn?)&CmgQvoa9tcsmRV=fvE-4S#_4D@^Dn>o`WMzWw1N(X1#N`# zuXjFPq&z#hR{i0VI9f%dw?d_(f2Ggga5tuHKVuAhQLtvsv}3skuq_O&cb#@-s+&F< zr3jQ{2grlt&wn$y3W*q5n&_EDHY*=xVUHaCs;K=vJl*2#?1Pd~Gh3C&85`?jZa|vL zYo`CquRRR7r^5;S9xIaigojEPgTcD-0b$?VYZF3Vk6S$POoB;RlZD zMe?@{(V7eJHW<^pbdum+X^gGVOQiPTst2m7Qnwfo2>B{0o1$p?S%>eZ0GuF<^CNoHxISEVhuYjs4etiM@QVe8 z)F~<4W8+2#HuPk@K_SJ1X3qe0vE46e=@XFYyNtmjgQ^3f+Qz>;=N;X)ir@Sh3&LZ` zePpL`c~{$|ER>`oGTL(wSHABb z#{ZIFnnPXIy2Bsdz`i{N1cnm1Ii7*MHz#jqZ7j57EIBH`yekwM4)F z(#h;*YDXO;DdFCBW1*ghH5OeVV@~-}_tH^t7=zxH0pnbL%igde{Yb{Vqqs+3Yr;bh$0t z1ADa1`747-gD34UJ$SMrYAAKn%HhZ~mp{pSe4;T}E-3o_L_<;N6G6*tKM=sM%U|5wGUQ`5F>*-UZa=W$+~9$R7?7j5i`{UNJghue@v0w35AOBDK;d9 z$8yP=-uAKWU@YnX|HqDSqkQ-zEoP1xqH?<8N z01^y4Wv`E&A+|*VAe#TU(QZ&7^&PRfj~k4XY#E`rOPBmS$spP0f#!A{sPa zeUP&iwJIHCAKG9)6|))@A~YbkgKosm%tABw@eAz`2#>s z4^M$e-u51j`(7?b?p<|(^Vi|RwFv^n27OE}&tL?& zVYAzgrX>RtaF*@5dRm1%O@t>JrDmFGIG8p8bjDkU+xlO}Y<^Cu$C}Cyq`F;G+ zfN|F%K}fJI-5OEB-)aC*b3$4BUx5q|)XASOsU9)nH{m`@R&f$GKWi*~8fWf-Q65?@ zLVxvZHBriGfs@ba??uo8vFnT-yAa6BGMzJ_1on`qe6za3$pD>yER#M|MFEe}-qh-_B|Jnw6Dvf2t|x?UqT?e&t7-f7I6J-Lc-hzoDhl zEAesUNkOpba@j zMoSj|llH3B5m%OO){5p&D_KYv@?h|k;65#3`kb3C@KT?W-zF-JRjc>$5o=;7Y#idM zX5{_jbJk$LdpvUfj5w*7ApHT+QIix2z}lq7aHmKEN|wEisEE)vmFSkx*u1 zsCW9^PU-H^2f2BJK^pb?ivNO+E(kk!$*WYiEXB1r{4BWa3H%TKhOe$}nk&CH-3?J5 zq}F*s%Z(_C7*qZ^{bzDjq{Zi9Fr`{`fB1wUI1-Tu@u8rnVF~tz1Mnge?d{HMwNO6^ z;weBvT6MxWzq;V4^%F>3Z=GF-mc1Nq8kdRwA-}*Bh>_qe9pfd&6~B*ZOqVE^ zIFl0eA8uG=B>tc8c(}OVIfCbEU?j6}NWC;c87yX*6Jkgt#K0gML&Am*sNk(~0cY+h zgfZB~Q^D>r1~3|?*MDzozkUec(yD1ccqj4-3Ap5g>ERIU1PoHt($ABx_nCugX2A;R z+a!`z{JiDy=QHJ=p_JGDyEeZuCgGBoA_3R+h8avBG~Q2S#O_c?DR(z>bJlwvh7J;D zL_<;CT~K)b8K7KlX7~5^Z@Mf3i~CVvZ+-fc>{8iOAE!4x3)P((gusLT2?U@Il9N;I zpW%1*-j6Rg%gtKcia)gfV#b_DbidO@&-^wwpBLIH8BBkDFV?VL|N39x7C7c1l~d%O z0+Z~*^%9q0MhkiJX)sM<*MOEU z1^DxC`uNcyjb$^}-O>DHzjKEL-`H4)h}&9J4!uBQh-@w0b{P8l#e(rj*-;=)U>%H- zQpA1SdP4Mc>3;iQ-yj%CV9bFgZJw2nUrwvd41unK$)L*Ams*PUmRnTGMm=_C>ZP%Ti}vdeb%I zQshemw|apWKsJBhFO2a3O!Gnz9peLl9Z_Hle_b^vjUN>aeTP~CUB#RAu{UGjF0%u>p#PpDju!he;qsu`d56p24G4u}6hLYpRE>}c z(hyE>-)CT%8F>$oWWP?WIwS0MkgzaF5+}oh!#NBJ6^_k)L2J&Wynm!{>2ZXM$B(zB zE(DL&biH!O_-cK5Dili+b#`LtIB5b^OO}{}7NNwrNzy?u3;5pc)rl?WR54TN0-L~n z&ARW|lgSZhXou$n(WUD#`^Om&gxh^F-sot;rkNMynDK4^qtEEmv#qE~@PJ`w(mB(j zzzc(mzWJpFF$5hxg~oMfIlh4!f%bsaXUeT*GsYTE1O2Ov4mcZvq2pX(v*d7%mv3}I z2u-E@c*D9Q6@6P;xZ7YZShBZSM|ebs_?T)8G097I-*V1W|Nb2%A0 zO_rVaK$YUF(Pq^?BpObl4_zBc9rDEBeN8qUGSu#gj&j&r`_P@J7=*X>z4?fp=#U!o za~5c&*+Ifx;^O{tV%##J4Eck5%D~p?H*J$eP6ViGd=;{+_i?++5|m{SE7YW zkL)rMC9hHNvT)cVW;^0Mh^yyaox31Y&|GwM4i1yh%EXXyePpbMQv}gr zGTXr|)I|$vjPN3fgU*7Bb1(MhKaiV$vUdIcFcQ0*|JmnK#(LiO5~&@y6d$B(BtsTt z$@lJv^G-eKgVvuNVJNz%nh_U_9e+GxaH**_ZAtm((WbxlZ_F_aA`>JBpH7U~P)9Qa*b2NsJ4Q5`d`;L5;QEBXD>A5l zdQBL-{5)FLkZ^nhL+O3IguQ~?d9S>&ZMMCM5zCsg3(B7$t#@1TPPO$&LN#|-u&A|fJ&&5ebw*Ij~BB5igqw-iRB zm&Dz=EcoQyX`mrf>GZ!^$qlAA0MRdsgqh+%o9nRHX(l#{c-(Cx7%b1;`HNqsAJDaU-z*R}AzJ2A8-OnlrxSBRLH|Fmu$!0qBZ>vEdREtE3bkXw?)~Mh0DkMJWw0`x zBy@Zs_Kl7<`0yUW|3J>t`t{k423tnqsAU)=co8eL(qnU6hLEoP4R2x1K2z@ja_Kz= zm35}`Xtu!qoytjqMYm;%S{548N&-VEWiZ_OLd+k<#4j7H22x20qk1u93D~W`_vY;m zfuXVYL9l*N<<{7e|2;LPY_5V`#$f zE75_{*j-2rIOdgLiv1HY+NXdytqV3&_oVLrXky2v?u_yW8aIy>gXtz9%YJdqE^|-f z*6A@9;Xy<`AY`-{_({|`&I>NujGEHK2Jzvo)vENwDhENWn1ZhAnAI|u1llF0V+j_c zHE+>P9}d;M&VsnZU?>e16CI`lZxzcNNRYUSi<(E(hU zEDYPqsj?aQ`Aa&3LQL~J`!x|zHev+|zMw3v5i!R@5GG8o+3?pO*Q*F@wxZhT9>7V~ z&|vuMY9}uR$;*;{riY^LD8lBru@*@w9GxuQg(uRLdM^JosQ2=3gDW}3P7Z zY#5a2dI6qYLoVZb@3;pLzcQ+6i!%EEf=L+?ygm^2Z?I=kreJ`r#08!Q!AM^PgRB05YWlrY%3 zaEIP{fhUR%Qwi)8uDTv|yhv#XGRXz}4x$8)kl)Jc8waJfYQ!Wo&WaEuoCUn)!U6yQhBbNU%$!?AiwER6crib|=1Mu2*&-{^*{Sv&w&ef-od(9SR^@eI3D4Vu!zd{c zkySj6#GHOz`Ib}#n2VTz)ZxZScamwauU3Kq!dwY~eSnjydamU|3E#=qfSbl*lBlV! z*RSV?4~TTt3oS``p8nES?Qiv*T_OHwe!E{=kh|k?b!=-ge4k#(>DTjgPNNA?zw?T~ zzhEU!Tm#BZTt+TgloFQ3&H0{o5efmKjO&Wjvb2Bu?r_P(PH4OU`DqiK0e%bD4XMA9 zNMBI|006ZWJ3=78T)&bXNI&Y-`7Atk7upO=Xbls^UQ86Ztq%T&{y6nu*JwS96|K?H zj%Q&rsCxI5_73!|L}X;lD)~Q4U^S9}Oj^0o-TG=Hfzzl?ey-8+W&N!#9nI9M+e=sU zKJG_I*3jj?mGZ0AW31!bX*}ox(P9%d@<;kt-A^l-_9X>hPIHz4rsPfA7Pa@%v(Yr= z`!wRLfYQ;9j(+>?f1>_lpi{LIe9y8R$Dp_^HZ0yZ2fc9dEGQwyATYbSjVK-43g>%6 z95~1jtM!6DLqlsi7x)Dmr!oCsAE!{wLixRDgCAi99NBg)^9#Fnd9dB*1g$dU54`oB zSEhaVu#%dgMsi8#lWH$PBRZ-YErwB8Yg-HZR`PPD$~ZcY55@tn^ln2=c`#ir0Di&D zT*^X|b8a`ety=-)sPsK(FYwgN4MJ8>IpQrvPjY`Z#OC5kW4val|8=wxEH~+dTWQWJ zDeMAb^jJO;&yy(x{b&Sq%46X06myKVJ$(S;CLFDUy>@?UaY!467}eQ)m!SZjDUH~E zu;_h3ccY#VSp(4!l$t@1vV)uuCNz92DkGM|lKQUHa|hpZ#Chn+t!17#;KVR3FE2N; zLulH)>96r{2}3}hgX<)Jsof6mjEXiHKl`=K%qm% zu!xAa+>IuZ;xENTKB#Bw|MUFCLeVUP-(RQ=_RZoiiy&JSkIW-W)Z^o0$GOQ>0;lU# z3=&VYT{d80O%j@mV;t70_U6)RjDte=Jb43z_bJ4ZHK+^kf=8zTB16{=Hty3t^7$M> zfz+K9um$kDEJ-^a<+E7!gkVnqh(1-JQ&sSid*fSfHCJb5CdETdZ4krV_LXlBp9`Ky zrJT$VE-x>S0&M#FM~|yxKKAs*v01|86&3MraVR2Jv&Q)~(%I8DxEY%)dw_X|?%@ZJ zg;q<#ZECnX8E%D~^oE5G;y}n%(pdAkq)5MVqcgsh?gvYd)&bB+1{~0e(&-9hzSHrE zxGMA-+T%>)81tS6^g|-sXjCvH32y^;No23bWoI{`?j7{A`QH)L`on}{)MkbyEbQ~J}b2&@0SZVQw>wQBlNB?$Og z1iBah|Nc#~INr$^7%(+uc^TdRfB$MDoeLoPbi`G1g%u|uml#3qmV}HrguIbXq>(^6 z|856gcDJz1=3-YD;BByKY#bwrc(bI5Qo{=!kQO))z=1)Zr%~Sv6!z%2ZIPI{h&=3- zM`@ooU14aJQHq$C(+D`FpqKYJQ<(eqBpbSV*nE9w1ah<(!M>UV8j+ENhhk`d*?kiy z&1CU-+&Ua_ee8B4Q*uXK$e*A)=DxhiyJX>grM#|$C6Q~xqb(@{( z$||}2Z|E31fXr2`*Kn$W-i681($e@G(97}9)pNv+YT{21y8fwv_^ox|H88X2wf~C^ z7|awQhj4?N$xU=iKoN}YXmS36 zOz|~vj&}o_LzbZ9+l&upZJy{2;A*dF5xT);-f8Nz(8{Dqq?AbGF&1|K(&0Y*O~Ba? z#=?QBVB=YWE~n1>$SQ!~s@mw2V#$+SZZuaBfGMh=Rj~zAj|pJv3rIDEk_W$=zzlE{ zDEhdh?oLzP_vZ9C;=2A`tJ1v!R$X8OP6`l!^fqp4z(NBYBu(>3H|a8;5^%sA0X2b> zm{~0ebdw_?*!VX4zgk-3Ko%t$j>rGXW>i=7JMyJg1^^=TKnya@d(t$EzqeNc)Z(Y$ z5Y5r%b&vrp?zCNABb~2&SN9#ezQ#Etmz1R&G%`_idC*C$F>ON2m*DeGgWk6i%)Cv& z{jAj;`>oxjr)orR+?mSqWcvVzkfuJ(s%A2Dit7RlD>#ecr(RRXO#t)BZ<><(Z4W>Z z0RRf!nKkTlO>NK2HyePmR0(h&Lq0yfYjnJxYQvv1*BR=4LXiYosr@NxkESrio`Ly53s1ROTcZGw5;t)o5Qyoe zp3t+4@o~)^P!gv>1+2{AGBF;t|2`uDa=*z&|Dt`Dgq4g~eY@%+DggIj$MOGp`7%Ld zQ6B`?J*8pDCpo4~jV$VKkpMzS2Zr<-lYPb}6r1*=VDHVqH`DexUW?XKJj?bxP~v!? zVgD|c8)-uy$YzS~ea9JA=E!!T`=HzIwSp0$I#bOb@JmFe{U zLZb}HpwSJWSTNfBOT}jucD`l7vR_z1)x@bOIV$^o0|e|Da0s#rvl7^1jsSS5-pVz7 zs95|Io5q=NR7h~Yd2&85(V;~dB8%NiE7OhJ{pJu1M4l_Tf%VXU9TMnW->!EN3*aZs zF_;wAIpgwjMQgn~KJDT%wJVcwJN4t|bXUjgseqSgANi?VU|$p`w}#ba5x^=t3*OCr zxfnPdcI*Hn@^p9&(g}TqNZxPrPXylkcCx<^p+g&pYp78}HC`9#CLi*HCgTZc{))lj z)0cMi8qgQVKw9hR1sKMTjOWXp36j8$L;TTbZ-UpQ2HfJX2GkYjUmbg|e+GDq!*IRb z?Oao#5Jd}++^P>YVJ=cjo3hB(2A`8>Twnp;T9s{bs!H^8O+B;?4+}Fq45llKtS&a5 z(O>QjuSBE4+FH84U2f7lC(A6F3682FAGt_pixYcr3R>$=1%IdM{L&`04RBs7EO`HG zNL(n*wrD*l?qm7zHDHJ>M0Q+Br(yll{{DX!@N4O=M{9tyVz06vFb5{Pec2WiH7%%Z zT2R9@F1ZaMCe!tV|A+&d_nW2|72ao$0cPZ7`&Vn|yq(?{&%tRYaN@n!j_t31H-GvH zDlfzT{ZU~Q@MzhtaAmg6riCmQa+zNrGJdGuRS^BA-Jj)d%qz!r{*Fh&fP>*Bum9c4 zzOa^czgvvZyYAw>rND*54X(_Va%J;g*VG)^)EIy4>eVNeI@@wvWR&ZFc+||4o06Y% zr!YVNcde%Q=S}*++Whym*Z{A(^-P>z96BbP5>5?v0?t}ZNk@7cxRS3@7XOx<-UIGH g9t3sIsA|;@`&IKZY#s>CZ)N}jPgg&ebxsLQ06wZyMgRZ+ diff --git a/tests/testthat/test-combo.R b/tests/testthat/test-combo.R deleted file mode 100644 index 510e49fc..00000000 --- a/tests/testthat/test-combo.R +++ /dev/null @@ -1,48 +0,0 @@ -test_that("wt_est_nest works", { - fit <- ssd_fit_dists(data = ssddata::ccme_boron) - wt_est <- wt_est_nest(fit) - expect_identical(check_wt_est(wt_est), wt_est) -}) - -test_that("ssd_pcombo", { - fit <- ssd_fit_dists(data = ssddata::ccme_boron) - wt_est <- wt_est_nest(fit) - expect_equal(ssd_pcombo(numeric(0), wt_est), numeric(0)) - expect_equal(ssd_pcombo(0, wt_est), 0) - expect_equal(ssd_pcombo(1, wt_est), 0.0391103597328257) - expect_equal(ssd_pcombo(10000, wt_est), 0.999877937138081) - expect_equal(ssd_pcombo(c(1,2), wt_est), c(0.0391103597328257, 0.0837556041052211)) - expect_equal(ssd_pcombo(1, wt_est, lower.tail = FALSE), 1-0.0391103597328257) - expect_equal(ssd_pcombo(1, wt_est, log.p = TRUE), log(0.0391103597328257)) - expect_equal(ssd_pcombo(1, wt_est, lower.tail = FALSE, log.p = TRUE), log(1-0.0391103597328257)) -}) - -test_that("ssd_qcombo", { - fit <- ssd_fit_dists(data = ssddata::ccme_boron) - wt_est <- wt_est_nest(fit) - expect_equal(ssd_qcombo(numeric(0), wt_est), numeric(0)) - expect_equal(ssd_qcombo(0, wt_est, upper_q = 100), 0) - expect_equal(ssd_qcombo(0.5, wt_est, upper_q = 100), 15.3258287163047) - expect_equal(ssd_qcombo(c(0.5, 0.75), wt_est, upper_q = 100), c(15.3258287163047, 32.4740417139284)) - expect_equal(ssd_qcombo(0.25, wt_est, upper_q = 100, lower.tail = FALSE), 32.4740417139284) - expect_equal(ssd_qcombo(log(0.75), wt_est, upper_q = 100, log.p = TRUE), 32.4740417139284) - expect_equal(ssd_qcombo(log(0.25), wt_est, upper_q = 100, lower.tail = FALSE, log.p = TRUE), 32.4740417139284) -}) - -test_that("ssd_rcombo", { - fit <- ssd_fit_dists(data = ssddata::ccme_boron) - wt_est <- wt_est_nest(fit) - expect_equal(ssd_rcombo(0, wt_est), numeric(0)) - set.seed(99) - expect_equal(ssd_rcombo(1, wt_est, upper_q = 100), 19.7526836610501) - set.seed(99) - expect_equal(ssd_rcombo(1, wt_est, upper_q = 100), 19.7526836610501) - set.seed(99) - expect_equal(ssd_rcombo(2, wt_est, upper_q = 100), c(19.7526836610501, 2.69562395185803)) - set.seed(99) - n100 <- ssd_rcombo(100, wt_est, upper_q = 1000) - expect_identical(length(n100), 100L) - expect_equal(min(n100), 0.0295957274619929) - expect_equal(max(n100), 168.790818444479) - expect_equal(mean(n100), 23.4076753984188) -}) diff --git a/tests/testthat/test-multi.R b/tests/testthat/test-multi.R new file mode 100644 index 00000000..5330f80e --- /dev/null +++ b/tests/testthat/test-multi.R @@ -0,0 +1,48 @@ +test_that("wt_est_nest works", { + fit <- ssd_fit_dists(data = ssddata::ccme_boron) + wt_est <- wt_est_nest(fit) + expect_identical(check_wt_est(wt_est), wt_est) +}) + +test_that("ssd_pmulti", { + fit <- ssd_fit_dists(data = ssddata::ccme_boron) + wt_est <- wt_est_nest(fit) + expect_equal(ssd_pmulti(numeric(0), wt_est), numeric(0)) + expect_equal(ssd_pmulti(0, wt_est), 0) + expect_equal(ssd_pmulti(1, wt_est), 0.0391103597328257) + expect_equal(ssd_pmulti(10000, wt_est), 0.999877937138081) + expect_equal(ssd_pmulti(c(1,2), wt_est), c(0.0391103597328257, 0.0837556041052211)) + expect_equal(ssd_pmulti(1, wt_est, lower.tail = FALSE), 1-0.0391103597328257) + expect_equal(ssd_pmulti(1, wt_est, log.p = TRUE), log(0.0391103597328257)) + expect_equal(ssd_pmulti(1, wt_est, lower.tail = FALSE, log.p = TRUE), log(1-0.0391103597328257)) +}) + +test_that("ssd_qmulti", { + fit <- ssd_fit_dists(data = ssddata::ccme_boron) + wt_est <- wt_est_nest(fit) + expect_equal(ssd_qmulti(numeric(0), wt_est), numeric(0)) + expect_equal(ssd_qmulti(0, wt_est, upper_q = 100), 0) + expect_equal(ssd_qmulti(0.5, wt_est, upper_q = 100), 15.3258287163047) + expect_equal(ssd_qmulti(c(0.5, 0.75), wt_est, upper_q = 100), c(15.3258287163047, 32.4740417139284)) + expect_equal(ssd_qmulti(0.25, wt_est, upper_q = 100, lower.tail = FALSE), 32.4740417139284) + expect_equal(ssd_qmulti(log(0.75), wt_est, upper_q = 100, log.p = TRUE), 32.4740417139284) + expect_equal(ssd_qmulti(log(0.25), wt_est, upper_q = 100, lower.tail = FALSE, log.p = TRUE), 32.4740417139284) +}) + +test_that("ssd_rmulti", { + fit <- ssd_fit_dists(data = ssddata::ccme_boron) + wt_est <- wt_est_nest(fit) + expect_equal(ssd_rmulti(0, wt_est), numeric(0)) + set.seed(99) + expect_equal(ssd_rmulti(1, wt_est, upper_q = 100), 19.7526836610501) + set.seed(99) + expect_equal(ssd_rmulti(1, wt_est, upper_q = 100), 19.7526836610501) + set.seed(99) + expect_equal(ssd_rmulti(2, wt_est, upper_q = 100), c(19.7526836610501, 2.69562395185803)) + set.seed(99) + n100 <- ssd_rmulti(100, wt_est, upper_q = 1000) + expect_identical(length(n100), 100L) + expect_equal(min(n100), 0.0295957274619929) + expect_equal(max(n100), 168.790818444479) + expect_equal(mean(n100), 23.4076753984188) +}) From 0fc58df19ff8eba546a6206f7fa9c770018106c1 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Tue, 7 Nov 2023 16:47:16 -0800 Subject: [PATCH 25/28] get range from individual cdfs etc --- R/multi.R | 38 ++++++++++++++++++++++------- R/params.R | 2 -- R/root.R | 18 +++++++++----- man/params.Rd | 3 --- man/ssd_q.Rd | 7 ++---- man/ssd_r.Rd | 7 ++---- tests/testthat/test-hc-root.R | 20 +++------------ tests/testthat/test-hp-root.R | 18 ++------------ tests/testthat/test-multi.R | 46 +++++++++++++++++------------------ 9 files changed, 72 insertions(+), 87 deletions(-) diff --git a/R/multi.R b/R/multi.R index 46393efe..c88ba97b 100644 --- a/R/multi.R +++ b/R/multi.R @@ -34,12 +34,23 @@ ssd_pmulti <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { return(numeric(0)) } + ranges <- range_fun(q, wt_est, fun = "p") + lower <- ranges$lower + upper <- ranges$upper + + lower <- plogis(qlogis(lower) - 1) + upper <- plogis(qlogis(upper) + 1) + f <- ma_fun(wt_est, fun = "q") p <- rep(NA_real_, length(q)) # FIXME: vectorize # FIXME: deal with edge cases of negative and infinite q for(i in seq_along(p)) { - p[i] <- uniroot(f = f, q = q[i], lower = 0, upper = 1)$root + if(lower[i] == upper[i]) { + p[i] <- lower[i] + } else { + p[i] <- uniroot(f = f, q = q[i], lower = lower[i], upper = upper[i])$root + } } if(!lower.tail) { p <- 1 - p @@ -58,8 +69,8 @@ ssd_pmulti <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { #' # multi #' fit <- ssd_fit_dists(data = ssddata::ccme_boron) #' wt_est <- ssd_wt_est(fit) -#' ssd_qmulti(0.5, wt_est, upper_q = 100) -ssd_qmulti <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) { +#' ssd_qmulti(0.5, wt_est) +ssd_qmulti <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE) { chk_numeric(p) chk_vector(p) @@ -67,8 +78,6 @@ ssd_qmulti <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) chk_flag(lower.tail) chk_flag(log.p) - chk_number(upper_q) - if (!length(p)) { return(numeric(0)) } @@ -79,13 +88,24 @@ ssd_qmulti <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) if(!lower.tail) { p <- 1 - p } + + ranges <- range_fun(p, wt_est, fun = "q") + lower <- ranges$lower + upper <- ranges$upper + + lower <- exp(log(lower) - 1) + upper <- exp(log(upper) + 1) f <- ma_fun(wt_est, fun = "p") q <- rep(NA_real_, length(p)) # FIXME: vectorize # FIXME: deal with edge cases of negative and q >= 1 for(i in seq_along(p)) { - q[i] <- uniroot(f = f, p = p[i], lower = 0, upper = upper_q)$root + if(lower[i] == upper[i]) { + q[i] <- lower[i] + } else { + q[i] <- uniroot(f = f, p = p[i], lower = lower[i], upper = upper[i])$root + } } q } @@ -99,10 +119,10 @@ ssd_qmulti <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) #' fit <- ssd_fit_dists(data = ssddata::ccme_boron) #' wt_est <- ssd_wt_est(fit) #' set.seed(50) -#' hist(ssd_rmulti(1000, wt_est, upper_q = 1000), breaks = 100) -ssd_rmulti <- function(n, wt_est, upper_q = 1) { +#' hist(ssd_rmulti(1000, wt_est), breaks = 100) +ssd_rmulti <- function(n, wt_est) { chk_count(n) if(n == 0L) return(numeric(0)) p <- runif(n) - ssd_qmulti(p, wt_est, upper_q = upper_q) + ssd_qmulti(p, wt_est) } diff --git a/R/params.R b/R/params.R index 45eef6f2..2b1bad2a 100644 --- a/R/params.R +++ b/R/params.R @@ -107,8 +107,6 @@ #' @param wt_est A data frame with dist, wt, and est columns specifying the #' distributions, weights and a list column of estimate data frames with #' term and est columns specifying the estimated value for each parameter. -#' @param upper_q A number specifying the possible upper limit of the cumulative -#' distribution. #' @keywords internal #' @name params NULL diff --git a/R/root.R b/R/root.R index 363fd983..93db6336 100644 --- a/R/root.R +++ b/R/root.R @@ -37,10 +37,17 @@ ma_fun <- function(wt_est_nest, fun = "p") { eval(parse(text = func)) } -hc_upper <- function(p, data) { - right <- data$right[is.finite(data$right)] - # TODO: ensure safe upper bound - use p as well? - max(right) * 10 +range_fun <- function(x, wt_est_nest, fun = "p") { + funs <- paste0("ssd_", fun, wt_est_nest$dist) + args <- purrr::map_chr(wt_est_nest$data, est_args) + fun_args <- paste0(funs, "(x, ", args, ")", collapse = ", ") + func <- paste0("list(", fun_args, ")", collapse = "") + list <- eval(parse(text = func)) + tlist <- purrr::transpose(list) + tlist <- purrr::map(tlist, unlist) + min <- purrr::map_dbl(tlist, min) + max <- purrr::map_dbl(tlist, max) + list(lower = min, upper = max) } .ssd_hp_root <- function(conc, wt_est_nest, ci, level, nboot, min_pboot, @@ -63,8 +70,7 @@ hc_upper <- function(p, data) { data, rescale, weighted, censoring, min_pmix, range_shape1, range_shape2, parametric, control) { - hc_upper <- hc_upper(proportion, data) - q <- ssd_qmulti(proportion, wt_est_nest, upper_q = hc_upper) + q <- ssd_qmulti(proportion, wt_est_nest) tibble( est = q * rescale, diff --git a/man/params.Rd b/man/params.Rd index f00f2b8f..cc486f5a 100644 --- a/man/params.Rd +++ b/man/params.Rd @@ -177,9 +177,6 @@ remove them with a warning.} \item{wt_est}{A data frame with dist, wt, and est columns specifying the distributions, weights and a list column of estimate data frames with term and est columns specifying the estimated value for each parameter.} - -\item{upper_q}{A number specifying the possible upper limit of the cumulative -distribution.} } \description{ Parameter Descriptions for ssdtools Functions diff --git a/man/ssd_q.Rd b/man/ssd_q.Rd index 1e819183..fddd972c 100644 --- a/man/ssd_q.Rd +++ b/man/ssd_q.Rd @@ -72,7 +72,7 @@ ssd_qlnorm_lnorm( ssd_qlnorm(p, meanlog = 0, sdlog = 1, lower.tail = TRUE, log.p = FALSE) -ssd_qmulti(p, wt_est, lower.tail = TRUE, log.p = FALSE, upper_q = 1) +ssd_qmulti(p, wt_est, lower.tail = TRUE, log.p = FALSE) ssd_qweibull(p, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) } @@ -126,9 +126,6 @@ ssd_qweibull(p, shape = 1, scale = 1, lower.tail = TRUE, log.p = FALSE) \item{wt_est}{A data frame with dist, wt, and est columns specifying the distributions, weights and a list column of estimate data frames with term and est columns specifying the estimated value for each parameter.} - -\item{upper_q}{A number specifying the possible upper limit of the cumulative -distribution.} } \description{ Quantile Function @@ -188,7 +185,7 @@ ssd_qlnorm(0.5) # multi fit <- ssd_fit_dists(data = ssddata::ccme_boron) wt_est <- ssd_wt_est(fit) -ssd_qmulti(0.5, wt_est, upper_q = 100) +ssd_qmulti(0.5, wt_est) ssd_qweibull(0.5) } diff --git a/man/ssd_r.Rd b/man/ssd_r.Rd index f1b57e09..c998436f 100644 --- a/man/ssd_r.Rd +++ b/man/ssd_r.Rd @@ -57,7 +57,7 @@ ssd_rlnorm_lnorm( ssd_rlnorm(n, meanlog = 0, sdlog = 1, chk = TRUE) -ssd_rmulti(n, wt_est, upper_q = 1) +ssd_rmulti(n, wt_est) ssd_rweibull(n, shape = 1, scale = 1, chk = TRUE) } @@ -109,9 +109,6 @@ ssd_rweibull(n, shape = 1, scale = 1, chk = TRUE) \item{wt_est}{A data frame with dist, wt, and est columns specifying the distributions, weights and a list column of estimate data frames with term and est columns specifying the estimated value for each parameter.} - -\item{upper_q}{A number specifying the possible upper limit of the cumulative -distribution.} } \description{ Random Number Generation @@ -181,7 +178,7 @@ hist(ssd_rlnorm(10000), breaks = 1000) fit <- ssd_fit_dists(data = ssddata::ccme_boron) wt_est <- ssd_wt_est(fit) set.seed(50) -hist(ssd_rmulti(1000, wt_est, upper_q = 1000), breaks = 100) +hist(ssd_rmulti(1000, wt_est), breaks = 100) set.seed(50) hist(ssd_rweibull(10000), breaks = 1000) diff --git a/tests/testthat/test-hc-root.R b/tests/testthat/test-hc-root.R index ed6633c4..cd5adf08 100644 --- a/tests/testthat/test-hc-root.R +++ b/tests/testthat/test-hc-root.R @@ -13,20 +13,6 @@ # See the License for the specific language governing permissions and # limitations under the License. -# Copyright 2021 Province of British Columbia -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# https://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. - test_that("hc root lnorm", { skip_on_os("linux") # FIXME fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") @@ -35,9 +21,9 @@ test_that("hc root lnorm", { hc_average <- ssd_hc(fits, average = TRUE) hc_root <- ssd_hc(fits, average = TRUE, root = TRUE) expect_identical(hc_average$est, hc_dist$est) - expect_equal(hc_root, hc_average, tolerance = 1e-6) + expect_equal(hc_root, hc_average, tolerance = 1e-5) expect_equal(hc_average$est, 1.6811748398812, tolerance = 1e-6) - expect_equal(hc_root$est, 1.68117469404437, tolerance = 1e-6) + expect_equal(hc_root$est, 1.68117261431233, tolerance = 1e-6) testthat::expect_snapshot({ hc_root @@ -52,7 +38,7 @@ test_that("hc root all", { hc_root <- ssd_hc(fits, average = TRUE, root = TRUE) expect_equal(hc_root, hc_average, tolerance = 1e-1) expect_equal(hc_average$est, 1.24151700389853, tolerance = 1e-6) - expect_equal(hc_root$est, 1.25677616485866, tolerance = 1e-6) + expect_equal(hc_root$est, 1.25677299940713, tolerance = 1e-6) testthat::expect_snapshot({ hc_root }) diff --git a/tests/testthat/test-hp-root.R b/tests/testthat/test-hp-root.R index 2da3386b..e4cb656e 100644 --- a/tests/testthat/test-hp-root.R +++ b/tests/testthat/test-hp-root.R @@ -13,20 +13,6 @@ # See the License for the specific language governing permissions and # limitations under the License. -# Copyright 2021 Province of British Columbia -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# https://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. - test_that("hp root lnorm", { skip_on_os("linux") # FIXME fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") @@ -37,7 +23,7 @@ test_that("hp root lnorm", { expect_identical(hp_average$est, hp_dist$est) expect_equal(hp_root, hp_average, tolerance = 1e-3) expect_equal(hp_average$est, 1.9543030195088, tolerance = 1e-6) - expect_equal(hp_root$est, 1.95476926846743, tolerance = 1e-6) + expect_equal(hp_root$est, 1.95449372351602, tolerance = 1e-6) testthat::expect_snapshot({ hp_root @@ -52,7 +38,7 @@ test_that("hp root all", { hp_root <- ssd_hp(fits, average = TRUE, root = TRUE) expect_equal(hp_root, hp_average, tolerance = 1e-2) expect_equal(hp_average$est, 3.89879358571718, tolerance = 1e-6) - expect_equal(hp_root$est, 3.91103597328257, tolerance = 1e-6) + expect_equal(hp_root$est, 3.9138070998897, tolerance = 1e-6) testthat::expect_snapshot({ hp_root }) diff --git a/tests/testthat/test-multi.R b/tests/testthat/test-multi.R index 5330f80e..20372630 100644 --- a/tests/testthat/test-multi.R +++ b/tests/testthat/test-multi.R @@ -1,48 +1,46 @@ test_that("wt_est_nest works", { fit <- ssd_fit_dists(data = ssddata::ccme_boron) - wt_est <- wt_est_nest(fit) + wt_est <- ssd_wt_est(fit) expect_identical(check_wt_est(wt_est), wt_est) }) test_that("ssd_pmulti", { fit <- ssd_fit_dists(data = ssddata::ccme_boron) - wt_est <- wt_est_nest(fit) + wt_est <- ssd_wt_est(fit) expect_equal(ssd_pmulti(numeric(0), wt_est), numeric(0)) expect_equal(ssd_pmulti(0, wt_est), 0) - expect_equal(ssd_pmulti(1, wt_est), 0.0391103597328257) - expect_equal(ssd_pmulti(10000, wt_est), 0.999877937138081) - expect_equal(ssd_pmulti(c(1,2), wt_est), c(0.0391103597328257, 0.0837556041052211)) - expect_equal(ssd_pmulti(1, wt_est, lower.tail = FALSE), 1-0.0391103597328257) - expect_equal(ssd_pmulti(1, wt_est, log.p = TRUE), log(0.0391103597328257)) - expect_equal(ssd_pmulti(1, wt_est, lower.tail = FALSE, log.p = TRUE), log(1-0.0391103597328257)) + expect_equal(ssd_pmulti(1, wt_est), 0.039138070998897) + expect_equal(ssd_pmulti(10000, wt_est), 0.999886924828857) + expect_equal(ssd_pmulti(c(1,2), wt_est), c(0.039138070998897, 0.0837793609527278)) + expect_equal(ssd_pmulti(1, wt_est, lower.tail = FALSE), 1-0.039138070998897) + expect_equal(ssd_pmulti(1, wt_est, log.p = TRUE), log(0.039138070998897)) + expect_equal(ssd_pmulti(1, wt_est, lower.tail = FALSE, log.p = TRUE), log(1-0.039138070998897)) }) test_that("ssd_qmulti", { fit <- ssd_fit_dists(data = ssddata::ccme_boron) - wt_est <- wt_est_nest(fit) + wt_est <- ssd_wt_est(fit) expect_equal(ssd_qmulti(numeric(0), wt_est), numeric(0)) - expect_equal(ssd_qmulti(0, wt_est, upper_q = 100), 0) - expect_equal(ssd_qmulti(0.5, wt_est, upper_q = 100), 15.3258287163047) - expect_equal(ssd_qmulti(c(0.5, 0.75), wt_est, upper_q = 100), c(15.3258287163047, 32.4740417139284)) - expect_equal(ssd_qmulti(0.25, wt_est, upper_q = 100, lower.tail = FALSE), 32.4740417139284) - expect_equal(ssd_qmulti(log(0.75), wt_est, upper_q = 100, log.p = TRUE), 32.4740417139284) - expect_equal(ssd_qmulti(log(0.25), wt_est, upper_q = 100, lower.tail = FALSE, log.p = TRUE), 32.4740417139284) + expect_equal(ssd_qmulti(0, wt_est), 0) + expect_equal(ssd_qmulti(0.5, wt_est), 15.3258029969365) + expect_equal(ssd_qmulti(c(0.5, 0.75), wt_est), c(15.3258029969365, 32.4740415684506)) + expect_equal(ssd_qmulti(0.25, wt_est, lower.tail = FALSE), 32.4740415684506) + expect_equal(ssd_qmulti(log(0.75), wt_est, log.p = TRUE), 32.4740415684506) + expect_equal(ssd_qmulti(log(0.25), wt_est, lower.tail = FALSE, log.p = TRUE), 32.4740415684506) }) test_that("ssd_rmulti", { fit <- ssd_fit_dists(data = ssddata::ccme_boron) - wt_est <- wt_est_nest(fit) + wt_est <- ssd_wt_est(fit) expect_equal(ssd_rmulti(0, wt_est), numeric(0)) set.seed(99) - expect_equal(ssd_rmulti(1, wt_est, upper_q = 100), 19.7526836610501) + expect_equal(ssd_rmulti(1, wt_est), 19.7526820778229) set.seed(99) - expect_equal(ssd_rmulti(1, wt_est, upper_q = 100), 19.7526836610501) + expect_equal(ssd_rmulti(2, wt_est), c(19.7526820778229, 2.69560596071394)) set.seed(99) - expect_equal(ssd_rmulti(2, wt_est, upper_q = 100), c(19.7526836610501, 2.69562395185803)) - set.seed(99) - n100 <- ssd_rmulti(100, wt_est, upper_q = 1000) + n100 <- ssd_rmulti(100, wt_est) expect_identical(length(n100), 100L) - expect_equal(min(n100), 0.0295957274619929) - expect_equal(max(n100), 168.790818444479) - expect_equal(mean(n100), 23.4076753984188) + expect_equal(min(n100), 0.0295662142336016) + expect_equal(max(n100), 168.790837817766) + expect_equal(mean(n100), 23.4076759062162) }) From fbfd8d786c640556ac1527c6e0ac2a462d21899d Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Tue, 7 Nov 2023 16:57:33 -0800 Subject: [PATCH 26/28] test edge cases multi --- R/multi.R | 8 ++------ tests/testthat/test-multi.R | 14 ++++++++++++-- 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/R/multi.R b/R/multi.R index c88ba97b..5f9cfda3 100644 --- a/R/multi.R +++ b/R/multi.R @@ -43,10 +43,8 @@ ssd_pmulti <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { f <- ma_fun(wt_est, fun = "q") p <- rep(NA_real_, length(q)) - # FIXME: vectorize - # FIXME: deal with edge cases of negative and infinite q for(i in seq_along(p)) { - if(lower[i] == upper[i]) { + if(is.na(lower[i]) || lower[i] == upper[i]) { p[i] <- lower[i] } else { p[i] <- uniroot(f = f, q = q[i], lower = lower[i], upper = upper[i])$root @@ -98,10 +96,8 @@ ssd_qmulti <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE) { f <- ma_fun(wt_est, fun = "p") q <- rep(NA_real_, length(p)) - # FIXME: vectorize - # FIXME: deal with edge cases of negative and q >= 1 for(i in seq_along(p)) { - if(lower[i] == upper[i]) { + if(is.na(lower[i]) || lower[i] == upper[i]) { q[i] <- lower[i] } else { q[i] <- uniroot(f = f, p = p[i], lower = lower[i], upper = upper[i])$root diff --git a/tests/testthat/test-multi.R b/tests/testthat/test-multi.R index 20372630..e34ad827 100644 --- a/tests/testthat/test-multi.R +++ b/tests/testthat/test-multi.R @@ -7,11 +7,16 @@ test_that("wt_est_nest works", { test_that("ssd_pmulti", { fit <- ssd_fit_dists(data = ssddata::ccme_boron) wt_est <- ssd_wt_est(fit) - expect_equal(ssd_pmulti(numeric(0), wt_est), numeric(0)) + expect_identical(ssd_pmulti(numeric(0), wt_est), numeric(0)) + expect_identical(ssd_pmulti(NA_real_, wt_est), NA_real_) + expect_identical(ssd_pmulti(-1, wt_est), 0) + expect_identical(ssd_pmulti(-Inf, wt_est), 0) + expect_identical(ssd_pmulti(Inf, wt_est), 1) expect_equal(ssd_pmulti(0, wt_est), 0) expect_equal(ssd_pmulti(1, wt_est), 0.039138070998897) expect_equal(ssd_pmulti(10000, wt_est), 0.999886924828857) expect_equal(ssd_pmulti(c(1,2), wt_est), c(0.039138070998897, 0.0837793609527278)) + expect_equal(ssd_pmulti(c(1,NA), wt_est), c(0.039138070998897, NA)) expect_equal(ssd_pmulti(1, wt_est, lower.tail = FALSE), 1-0.039138070998897) expect_equal(ssd_pmulti(1, wt_est, log.p = TRUE), log(0.039138070998897)) expect_equal(ssd_pmulti(1, wt_est, lower.tail = FALSE, log.p = TRUE), log(1-0.039138070998897)) @@ -20,7 +25,12 @@ test_that("ssd_pmulti", { test_that("ssd_qmulti", { fit <- ssd_fit_dists(data = ssddata::ccme_boron) wt_est <- ssd_wt_est(fit) - expect_equal(ssd_qmulti(numeric(0), wt_est), numeric(0)) + expect_identical(ssd_qmulti(numeric(0), wt_est), numeric(0)) + expect_identical(ssd_qmulti(NA_real_, wt_est), NA_real_) + expect_identical(ssd_qmulti(-1, wt_est), NaN) + expect_identical(ssd_qmulti(-Inf, wt_est), NaN) + expect_identical(ssd_qmulti(Inf, wt_est), NaN) + expect_identical(ssd_qmulti(1, wt_est), Inf) expect_equal(ssd_qmulti(0, wt_est), 0) expect_equal(ssd_qmulti(0.5, wt_est), 15.3258029969365) expect_equal(ssd_qmulti(c(0.5, 0.75), wt_est), c(15.3258029969365, 32.4740415684506)) From 3be3c733c03247e9e9b9feb10fc4d0bce858e3d8 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Wed, 8 Nov 2023 07:14:16 -0800 Subject: [PATCH 27/28] remove unnecessary extension of search bounds --- R/multi.R | 6 ------ tests/testthat/test-hc-root.R | 10 +++++----- tests/testthat/test-hp-root.R | 11 +++++------ tests/testthat/test-multi.R | 34 +++++++++++++++++----------------- 4 files changed, 27 insertions(+), 34 deletions(-) diff --git a/R/multi.R b/R/multi.R index 5f9cfda3..b0ffd624 100644 --- a/R/multi.R +++ b/R/multi.R @@ -38,9 +38,6 @@ ssd_pmulti <- function(q, wt_est, lower.tail = TRUE, log.p = FALSE) { lower <- ranges$lower upper <- ranges$upper - lower <- plogis(qlogis(lower) - 1) - upper <- plogis(qlogis(upper) + 1) - f <- ma_fun(wt_est, fun = "q") p <- rep(NA_real_, length(q)) for(i in seq_along(p)) { @@ -90,9 +87,6 @@ ssd_qmulti <- function(p, wt_est, lower.tail = TRUE, log.p = FALSE) { ranges <- range_fun(p, wt_est, fun = "q") lower <- ranges$lower upper <- ranges$upper - - lower <- exp(log(lower) - 1) - upper <- exp(log(upper) + 1) f <- ma_fun(wt_est, fun = "p") q <- rep(NA_real_, length(p)) diff --git a/tests/testthat/test-hc-root.R b/tests/testthat/test-hc-root.R index cd5adf08..039acd7b 100644 --- a/tests/testthat/test-hc-root.R +++ b/tests/testthat/test-hc-root.R @@ -21,9 +21,9 @@ test_that("hc root lnorm", { hc_average <- ssd_hc(fits, average = TRUE) hc_root <- ssd_hc(fits, average = TRUE, root = TRUE) expect_identical(hc_average$est, hc_dist$est) - expect_equal(hc_root, hc_average, tolerance = 1e-5) - expect_equal(hc_average$est, 1.6811748398812, tolerance = 1e-6) - expect_equal(hc_root$est, 1.68117261431233, tolerance = 1e-6) + expect_identical(hc_average$est, hc_dist$est) + expect_identical(hc_root, hc_average, tolerance = 1e-10) + expect_equal(hc_root$est, 1.68117483988121, tolerance = 1e-6) testthat::expect_snapshot({ hc_root @@ -37,8 +37,8 @@ test_that("hc root all", { hc_average <- ssd_hc(fits, average = TRUE) hc_root <- ssd_hc(fits, average = TRUE, root = TRUE) expect_equal(hc_root, hc_average, tolerance = 1e-1) - expect_equal(hc_average$est, 1.24151700389853, tolerance = 1e-6) - expect_equal(hc_root$est, 1.25677299940713, tolerance = 1e-6) + expect_identical(hc_average$est, 1.24151700389853, tolerance = 1e-10) + expect_equal(hc_root$est, 1.25678623624403, tolerance = 1e-10) testthat::expect_snapshot({ hc_root }) diff --git a/tests/testthat/test-hp-root.R b/tests/testthat/test-hp-root.R index e4cb656e..252b249e 100644 --- a/tests/testthat/test-hp-root.R +++ b/tests/testthat/test-hp-root.R @@ -21,9 +21,9 @@ test_that("hp root lnorm", { hp_average <- ssd_hp(fits, average = TRUE) hp_root <- ssd_hp(fits, average = TRUE, root = TRUE) expect_identical(hp_average$est, hp_dist$est) - expect_equal(hp_root, hp_average, tolerance = 1e-3) - expect_equal(hp_average$est, 1.9543030195088, tolerance = 1e-6) - expect_equal(hp_root$est, 1.95449372351602, tolerance = 1e-6) + expect_identical(hp_root, hp_average, tolerance = 1e-10) + expect_equal(hp_average$est, 1.9543030195088, tolerance = 1e-10) + expect_equal(hp_root$est, 1.95430301950878, tolerance = 1e-6) testthat::expect_snapshot({ hp_root @@ -38,7 +38,7 @@ test_that("hp root all", { hp_root <- ssd_hp(fits, average = TRUE, root = TRUE) expect_equal(hp_root, hp_average, tolerance = 1e-2) expect_equal(hp_average$est, 3.89879358571718, tolerance = 1e-6) - expect_equal(hp_root$est, 3.9138070998897, tolerance = 1e-6) + expect_equal(hp_root$est, 3.91155639855389, tolerance = 1e-6) testthat::expect_snapshot({ hp_root }) @@ -56,6 +56,5 @@ test_that("hp is hc", { hp_root <- ssd_hp(fits, conc = hc_root$est, average = TRUE, root = TRUE) hc_root <- ssd_hc(fits, percent = hp_root$est, average = TRUE, root = TRUE) } - skip("uniroot is biased...") - expect_equal(hc_root$est, conc, tolerance = 1e-2) + expect_gt(hc_root$est, 2.3) }) diff --git a/tests/testthat/test-multi.R b/tests/testthat/test-multi.R index e34ad827..f5b6f73f 100644 --- a/tests/testthat/test-multi.R +++ b/tests/testthat/test-multi.R @@ -13,13 +13,13 @@ test_that("ssd_pmulti", { expect_identical(ssd_pmulti(-Inf, wt_est), 0) expect_identical(ssd_pmulti(Inf, wt_est), 1) expect_equal(ssd_pmulti(0, wt_est), 0) - expect_equal(ssd_pmulti(1, wt_est), 0.039138070998897) - expect_equal(ssd_pmulti(10000, wt_est), 0.999886924828857) - expect_equal(ssd_pmulti(c(1,2), wt_est), c(0.039138070998897, 0.0837793609527278)) - expect_equal(ssd_pmulti(c(1,NA), wt_est), c(0.039138070998897, NA)) - expect_equal(ssd_pmulti(1, wt_est, lower.tail = FALSE), 1-0.039138070998897) - expect_equal(ssd_pmulti(1, wt_est, log.p = TRUE), log(0.039138070998897)) - expect_equal(ssd_pmulti(1, wt_est, lower.tail = FALSE, log.p = TRUE), log(1-0.039138070998897)) + expect_equal(ssd_pmulti(1, wt_est), 0.0391155639855389) + expect_equal(ssd_pmulti(10000, wt_est), 0.99991762078885) + expect_equal(ssd_pmulti(c(1,2), wt_est), c(0.0391155639855389, 0.083756266589807)) + expect_equal(ssd_pmulti(c(1,NA), wt_est), c(0.0391155639855389, NA)) + expect_equal(ssd_pmulti(1, wt_est, lower.tail = FALSE), 1-0.0391155639855389) + expect_equal(ssd_pmulti(1, wt_est, log.p = TRUE), log(0.0391155639855389)) + expect_equal(ssd_pmulti(1, wt_est, lower.tail = FALSE, log.p = TRUE), log(1-0.0391155639855389)) }) test_that("ssd_qmulti", { @@ -32,11 +32,11 @@ test_that("ssd_qmulti", { expect_identical(ssd_qmulti(Inf, wt_est), NaN) expect_identical(ssd_qmulti(1, wt_est), Inf) expect_equal(ssd_qmulti(0, wt_est), 0) - expect_equal(ssd_qmulti(0.5, wt_est), 15.3258029969365) - expect_equal(ssd_qmulti(c(0.5, 0.75), wt_est), c(15.3258029969365, 32.4740415684506)) - expect_equal(ssd_qmulti(0.25, wt_est, lower.tail = FALSE), 32.4740415684506) - expect_equal(ssd_qmulti(log(0.75), wt_est, log.p = TRUE), 32.4740415684506) - expect_equal(ssd_qmulti(log(0.25), wt_est, lower.tail = FALSE, log.p = TRUE), 32.4740415684506) + expect_equal(ssd_qmulti(0.5, wt_est), 15.3258170124633) + expect_equal(ssd_qmulti(c(0.5, 0.75), wt_est), c(15.3258170124633, 32.4740714551225)) + expect_equal(ssd_qmulti(0.25, wt_est, lower.tail = FALSE), 32.4740714551225) + expect_equal(ssd_qmulti(log(0.75), wt_est, log.p = TRUE), 32.4740714551225) + expect_equal(ssd_qmulti(log(0.25), wt_est, lower.tail = FALSE, log.p = TRUE), 32.4740714551225) }) test_that("ssd_rmulti", { @@ -44,13 +44,13 @@ test_that("ssd_rmulti", { wt_est <- ssd_wt_est(fit) expect_equal(ssd_rmulti(0, wt_est), numeric(0)) set.seed(99) - expect_equal(ssd_rmulti(1, wt_est), 19.7526820778229) + expect_equal(ssd_rmulti(1, wt_est), 19.752684425643) set.seed(99) - expect_equal(ssd_rmulti(2, wt_est), c(19.7526820778229, 2.69560596071394)) + expect_equal(ssd_rmulti(2, wt_est), c(19.752684425643, 2.69562027500859)) set.seed(99) n100 <- ssd_rmulti(100, wt_est) expect_identical(length(n100), 100L) - expect_equal(min(n100), 0.0295662142336016) - expect_equal(max(n100), 168.790837817766) - expect_equal(mean(n100), 23.4076759062162) + expect_equal(min(n100), 0.0295884248732781) + expect_equal(max(n100), 168.790837219526) + expect_equal(mean(n100), 23.4076761093969) }) From 124dbb06ee46907603f8f01042826fa9831611c0 Mon Sep 17 00:00:00 2001 From: Joe Thorley Date: Wed, 8 Nov 2023 07:40:45 -0800 Subject: [PATCH 28/28] rescale weights --- R/root.R | 2 +- R/wt-est.R | 1 + tests/testthat/test-multi.R | 28 ++++++++++++++++++++++++++++ 3 files changed, 30 insertions(+), 1 deletion(-) diff --git a/R/root.R b/R/root.R index 93db6336..3d1950fa 100644 --- a/R/root.R +++ b/R/root.R @@ -29,7 +29,7 @@ est_args <- function(x) { ma_fun <- function(wt_est_nest, fun = "p") { funs <- paste0("ssd_", fun, wt_est_nest$dist) - wts <- wt_est_nest$weight + wts <- wt_est_nest$weight / sum(wt_est_nest$weight) args <- purrr::map_chr(wt_est_nest$data, est_args) fun_args <- paste0(wts, " * ", funs, "(x, ", args, ")", collapse = " + ") diff --git a/R/wt-est.R b/R/wt-est.R index 6d199346..9a3164e3 100644 --- a/R/wt-est.R +++ b/R/wt-est.R @@ -59,6 +59,7 @@ check_wt_est <- function(x, x_name = NULL) { chk_numeric(x$weight) chk_not_any_na(x$weight) chk_range(x$weight, c(0,1)) + chk_gt(sum(x$weight), 0) chk_list(x$data) chk_all(x$data, chk_fun = check_est) diff --git a/tests/testthat/test-multi.R b/tests/testthat/test-multi.R index f5b6f73f..1904c6d2 100644 --- a/tests/testthat/test-multi.R +++ b/tests/testthat/test-multi.R @@ -22,6 +22,20 @@ test_that("ssd_pmulti", { expect_equal(ssd_pmulti(1, wt_est, lower.tail = FALSE, log.p = TRUE), log(1-0.0391155639855389)) }) +test_that("ssd_pmulti weights", { + fit <- ssd_fit_dists(data = ssddata::ccme_boron) + wt_est <- ssd_wt_est(fit) + expect_equal(ssd_pmulti(1, wt_est), 0.0391155639855389) + wt_est$weight[wt_est$dist != "lnorm"] <- 0 + expect_equal(ssd_pmulti(1, wt_est), 0.0195438776703809) + wt_est$weight[wt_est$dist == "lnorm"] <- 0 + expect_error(ssd_pmulti(1, wt_est), "must be greater than 0") + wt_est$weight[wt_est$dist == "lnorm"] <- 1.1 + expect_error(ssd_pmulti(1, wt_est), "must have values between 0 and 1") + wt_est$weight[wt_est$dist == "lnorm"] <- 1 + expect_equal(ssd_pmulti(1, wt_est), 0.0195438776703809) +}) + test_that("ssd_qmulti", { fit <- ssd_fit_dists(data = ssddata::ccme_boron) wt_est <- ssd_wt_est(fit) @@ -39,6 +53,20 @@ test_that("ssd_qmulti", { expect_equal(ssd_qmulti(log(0.25), wt_est, lower.tail = FALSE, log.p = TRUE), 32.4740714551225) }) +test_that("ssd_qmulti weights", { + fit <- ssd_fit_dists(data = ssddata::ccme_boron) + wt_est <- ssd_wt_est(fit) + expect_equal(ssd_qmulti(0.25, wt_est), 6.1824250029426) + wt_est$weight[wt_est$dist != "lnorm"] <- 0 + expect_equal(ssd_qmulti(0.25, wt_est), 5.60825026439554) + wt_est$weight[wt_est$dist == "lnorm"] <- 0 + expect_error(ssd_qmulti(0.25, wt_est), "must be greater than 0") + wt_est$weight[wt_est$dist == "lnorm"] <- 1.1 + expect_error(ssd_qmulti(0.25, wt_est), "must have values between 0 and 1") + wt_est$weight[wt_est$dist == "lnorm"] <- 1 + expect_equal(ssd_qmulti(0.25, wt_est), 5.60825026439554) +}) + test_that("ssd_rmulti", { fit <- ssd_fit_dists(data = ssddata::ccme_boron) wt_est <- ssd_wt_est(fit)